Import Upstream version 4e6upstream/4e6

65 files changed, 43905 insertions, 0 deletions

diff --git a/ANNOUNCE b/ANNOUNCE
new file mode 100644
index 0000000..0edea3c
--- /dev/null
+++ b/ANNOUNCE
@@ -0,0 +1,218 @@
+This message announces the availability of Scheme release scm4e6.
+
+New in scm4e6 are:
+
+	* bench.scm (benchmark): added.  computes and display statistics
+	on "pi.scm" benchmark.
+	* Makefile (benchlit bench): targets added.  Append stats to file
+	"BenchLog".
+	* scm.texi (Socket): added examples of chat servers and clients.
+	(Internet Addresses and Socket Names): enlarged from "Internet
+	Addresses".
+	* socket.c (l_connect): BUF0 was missing from mode bits set in
+	returned port.
+	* build.scm (build-params): Added compiler-options and
+	linker-options; added --batch-dialect and --script-name as aliases
+	for -h and -w.
+	* scmfig.h (HAVE_SELECT): Now defined for linux.
+	* sys.c (igc): fixed off-by-1 error for sizeof save_regs_gc_mark.
+	(gc_mark): fixed off-by-1 error for sizeof(CONTINUATION).  These
+	seem to fix a very obscure GC bug.
+	* Init.scm (exec-self): Added.
+	* repl.c (init_repl): DUMP sets RESTART to EXEC-SELF.
+	* repl.c (tryload): Made tail-recursive so that dump, quit, exit,
+ 	etc. will work as the last expression in a loading file.
+	(scm_execpath): Split out from scm_unexec.
+	* unexec.c: All Updated from emacs-19.34 -- no changes necessary.
+	* gmalloc.c: 
+	* pre-crt0.c:
+	* ecrt0.c:
+	* unexelf.c: fixes Linux (ELF) dump bug.
+	* build.scm (platform): linux renamed linux-aout.  linux-elf fixed
+ 	and renamed linux.
+	(C-libraries): X11R6 moved library files on RedHat Linux.  Linux
+ 	graphics library now has entry (doesn't default).
+	(compile-dll-c-files linux):
+	(make-dll-archive linux): Now converts from ".o" objects to ELF
+	".so" form and "links" the usual libraries.
+	* Link.scm (usr:lib x:lib): dynamic linking fixed for (linux ELF)
+	dlopen.  Libraries other than ".so" object not needed; eliminated
+	by usr:lib and x:lib returning #f.
+	* dynl.c (l_dyn_unlink): prints result of dlerror() on errors.
+	* eval.c (nconc2last): If CAUTIOUS is defined, checks that
+	APPLY's arglist and last element of arglist are LIST?s.
+	* sys.c (igc): symhash GC can now be disabled with
+	#define NO_SYM_GC.
+	* Init.scm (boot-tail): Added FSF --help and --version options.
+	Added --no-init-file as a synonym for -no-init-file.
+	* scm.texi (File-System Habitat): improved wording and added
+	examples.
+	* scm.texi (Top): Renamed sections.
+	* sys.c (mark_syms mark_sym_values): Split up mark_symhash() to
+	immunize against accidental pointers.
+	* repl.c (gc_ports_collected): added to instrument symbol GC.
+	* scm.texi (Debugging Scheme Code): Added section.
+	* eval.c (definedp): Changed from a memoizing macro to a `syntax'.
+
+ From maximum entropy <entropy@zippy.bernstein.com>:
+
+	* ioext.c, scmfig.h: support for SGI (tested with SGI IRIX 5.2/gcc)
+	* ioext.c (file_set_position): If a port is bidirectional
+	(e.g. a socket) it may be necessary on some systems to perform a
+	file positioning operation when switching between reading and
+	writing.  This is required by ANSI C (ISO/IEC 9899:1990
+	7.9.5.3).  Therefore, a	file-set-position on a bidirectional
+	port should not signal an error if fseek generates an
+	ESPIPE -- the fseek operation actually "succeeded" in that it
+	reset the I/O direction flag for the FILE.
+	* repl.c (input_waiting): R4RS requires that "char-ready?"
+	return "#t" at end-of-file.  The semantics for "ioctl(...,
+	FIONREAD, ...)" are such that it gives 0 on a socket that is
+	closed (on the other side of the connection).  If the
+	system has select(), use that instead to get the correct
+	behavior. 
+	* socket.c (l_listen): Treat sockets that have been "listened"
+	as input-ports.  This allows polling for new connections
+	(e.g. with "char-ready?") instead of blocking in
+	"socket:accept". 
+	* socket.c (l_accept): Fix type checking to agree with
+	previous patch.
+
+ From Radey Shouman  <shouman@zianet.com>
+
+	* eval.c (unmemocar): The code in unmemocar to deal with ILOCs was
+        never being executed.
+	* sys.c (intern): fixed (new) symhash GC bug.
+	* sys.c (igc): Added calls to mark_symhash() and sweep_symhash().
+	These GC unused symbols with a top-level value of UNDEFINED.
+	(mark_symhash): added.
+	(sweep_symhash): added.
+
+ From Eric Hanchrow  <erich@MICROSOFT.com>
+
+	* scm.c (l_sleep): Ported to Windows NT (_WIN32)
+	* ioext.c: Ported to Windows NT (_WIN32)
+ 
+				-=-=-
+
+Scm conforms to Revised^4 Report on the Algorithmic Language Scheme
+and the IEEE P1178 specification.  Scm is written in C and runs under
+Amiga, Atari-ST, MacOS, MS-DOS, OS/2, NOS/VE, Unicos, VMS, Unix and
+similar systems.  ASCII and EBCDIC are supported.
+
+Documentation is included explaining the many Scheme Language
+extensions in scm, the internal representations, and how to extend or
+include SCM in other programs.  Documentation is online at:
+
+	     http://ftp-swiss.ai.mit.edu/~jaffer/SCM.html
+
+SCM can be obtained via FTP (detailed instructions follow) from:
+ ftp-swiss.ai.mit.edu:pub/scm/scm4e6.tar.gz
+ prep.ai.mit.edu:pub/gnu/jacal/scm4e6.tar.gz
+ ftp.maths.tcd.ie:pub/bosullvn/jacal/scm4e6.tar.gz
+ ftp.cs.indiana.edu:/pub/scheme-repository/imp/scm4e6.tar.gz
+
+SLIB is a portable Scheme library which SCM uses:
+ ftp-swiss.ai.mit.edu:pub/scm/slib2a6.tar.gz
+ prep.ai.mit.edu:pub/gnu/jacal/slib2a6.tar.gz
+ ftp.maths.tcd.ie:pub/bosullvn/jacal/slib2a6.tar.gz
+ ftp.cs.indiana.edu:/pub/scheme-repository/code/lib/slib2a6.tar.gz
+
+JACAL is a symbolic math system written in Scheme:
+ ftp-swiss.ai.mit.edu:pub/scm/jacal1a5.tar.gz
+ prep.ai.mit.edu:pub/gnu/jacal/jacal1a5.tar.gz
+ ftp.maths.tcd.ie:pub/bosullvn/jacal/jacal1a5.tar.gz
+ ftp.cs.indiana.edu:/pub/scheme-repository/code/num/jacal1a5.tar.gz
+
+HOBBIT is a compiler for SCM code:
+ ftp-swiss.ai.mit.edu:pub/scm/hobbit4d.tar.gz
+ ftp.maths.tcd.ie:pub/bosullvn/jacal/hobbit4d.tar.gz
+ ftp.cs.indiana.edu:/pub/scheme-repository/imp/hobbit4d.tar.gz
+
+SCMCONFIG contains additional files for the SCM distribution to build
+SCM on Unix machines using GNU autoconf.
+ ftp-swiss.ai.mit.edu:pub/scm/scmconfig4e3.tar.gz
+ prep.ai.mit.edu:pub/gnu/jacal/scmconfig4e3.tar.gz
+ ftp.maths.tcd.ie:pub/bosullvn/jacal/scmconfig4e3.tar.gz
+ ftp.cs.indiana.edu:/pub/scheme-repository/imp/SCM-support/scmconfig4e3.tar.gz
+
+SLIB-PSD is a portable debugger for Scheme (requires emacs editor):
+ ftp-swiss.ai.mit.edu:pub/scm/slib-psd1-3.tar.gz
+ prep.ai.mit.edu:pub/gnu/jacal/slib-psd1-3.tar.gz
+ ftp.maths.tcd.ie:pub/bosullvn/jacal/slib-psd1-3.tar.gz
+ ftp.cs.indiana.edu:/pub/scheme-repository/utl/slib-psd1-3.tar.gz
+
+SLIB-SCHELOG is an embedding of Prolog in Scheme:
+ ftp-swiss.ai.mit.edu:pub/scm/slib-schelog.tar.gz
+ prep.ai.mit.edu:pub/gnu/jacal/slib-schelog.tar.gz
+ ftp.maths.tcd.ie:pub/bosullvn/jacal/slib-schelog.tar.gz
+ ftp.cs.indiana.edu:/pub/scheme-repository/utl/slib-schelog.tar.gz
+
+SMG-SCM is an SMG interface package which works with SCM on VMS.
+ ftp-swiss.ai.mit.edu:pub/scm/smg-scm2a1.zip
+ prep.ai.mit.edu:pub/gnu/jacal/smg-scm2a1.zip
+ ftp.cs.indiana.edu:/pub/scheme-repository/imp/SCM-support/smg-scm2a1.zip
+ ftp.maths.tcd.ie:pub/bosullvn/jacal/smg-scm2a1.zip
+A VMS version of Unzip is available by anonymous FTP from
+ ftp.spc.edu:[ANONYMOUS.MACRO32]UNZIP.EXE.
+
+TURTLSCM is a turtle graphics package which works with SCM on MS-DOS
+or X11 machines:
+ ftp-swiss.ai.mit.edu:pub/scm/turtlegr.tar.gz
+ prep.ai.mit.edu:pub/gnu/jacal/turtlegr.tar.gz
+ ftp.maths.tcd.ie:pub/bosullvn/jacal/turtlegr.tar.gz
+ ftp.cs.indiana.edu:/pub/scheme-repository/imp/SCM-support/turtlegr.tar.gz
+
+XSCM is a X windows interface package which works with SCM:
+ ftp-swiss.ai.mit.edu:pub/scm/xscm-2.01.tar.gz
+ prep.ai.mit.edu:pub/gnu/jacal/xscm-2.01.tar.gz
+ ftp.cs.indiana.edu:/pub/scheme-repository/imp/SCM-support/xscm-2.01.tar.gz
+
+MacSCM is a Macintosh applications building package which works with
+SCM (similar to XSCM).
+ ftp-swiss.ai.mit.edu:pub/scm/macscm.tar.Z
+ ftp.maths.tcd.ie:pub/bosullvn/jacal/macscm.tar.Z
+ ftp.cs.indiana.edu:/pub/scheme-repository/imp/SCM-support/macscm.tar.gz
+
+WB is a disk based, sorted associative array (B-tree) library for SCM.
+Using WB, large databases can be created and managed from SCM.
+ ftp-swiss.ai.mit.edu:pub/scm/wb1a2.tar.gz
+ ftp.maths.tcd.ie:pub/bosullvn/jacal/wb1a2.tar.gz
+ ftp.cs.indiana.edu:/pub/scheme-repository/imp/SCM-support/wb1a2.tar.gz
+
+DLD is a C library package allowing SCM to dynamically load object
+files on Linux, VAX (Ultrix), Sun 3 (SunOS 3.4 and 4.0), SPARCstation
+(SunOS 4.0), Sequent Symmetry (Dynix), and Atari ST.
+
+ prep.ai.mit.edu:pub/gnu/dld-3.3.tar.gz
+				-=-=-
+
+  ftp ftp-swiss.ai.mit.edu (anonymous)
+  bin
+  cd pub/scm
+  get scm4e6.tar.gz
+  get slib2a6.tar.gz
+or
+  ftp prep.ai.mit.edu (anonymous)
+  bin
+  cd pub/gnu/jacal
+  get scm4e6.tar.gz
+  get slib2a6.tar.gz
+
+  `scm4e6.tar.gz' is a gzipped tar file of the C code distribution.
+  `slib2a6.tar.gz' is a gzipped tar file of a Scheme Library.
+
+Files in these directories with the ".gz" suffix are compressed with
+patent-free gzip (no relation to zip).  The program to uncompress them
+is available from
+ prep.ai.mit.edu:pub/gnu/gzip-1.2.4.tar
+ prep.ai.mit.edu:pub/gnu/gzip-1.2.4.shar
+ prep.ai.mit.edu:pub/gnu/gzip-1.2.4.msdos.exe
+
+Remember to use binary mode when transferring the files.
+Be sure to get and read the GNU General Public License (COPYING).
+It is included in scm4e6.tar.gz.
+
+I sell IBM PC floppy disk sets with the source files, documentation,
+and MS-DOS and i386 MS-DOS executables for $99.00.  To order, send
+e-mail to jaffer@ai.mit.edu.
diff --git a/COPYING b/COPYING
new file mode 100644
index 0000000..a43ea21
--- /dev/null
+++ b/COPYING
@@ -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/ChangeLog b/ChangeLog
new file mode 100644
index 0000000..e689bb5
--- /dev/null
+++ b/ChangeLog
@@ -0,0 +1,3029 @@
+Mon Nov 18 22:56:11 1996  Aubrey Jaffer  <jaffer@localhost.bertronics.com>
+
+	* patchlvl.h (SCMVERSION): 4e6 released.
+
+	* bench.scm (benchmark): added.  computes and display statistics
+	on "pi.scm" benchmark.
+
+	* Makefile (benchlit bench): targets added.  Append stats to file
+	"BenchLog".
+
+Sun Nov 17 22:21:28 1996  Aubrey Jaffer  <jaffer@localhost.bertronics.com>
+
+	* scm.texi (Socket): added examples of chat servers and clients.
+	(Internet Addresses and Socket Names): enlarged from "Internet
+	Addresses".
+
+	* socket.c (l_connect): BUF0 was missing from mode bits set in
+	returned port.
+
+Sat Nov 16 22:02:39 1996  Aubrey Jaffer  <jaffer@localhost.bertronics.com>
+
+	* build.scm (build-params): Added compiler-options and
+	linker-options; added --batch-dialect and --script-name as aliases
+	for -h and -w.
+
+	* scmfig.h (HAVE_SELECT): Now defined for linux.
+
+Sat Nov  2 09:24:50 EST 1996 maximum entropy <entropy@zippy.bernstein.com>
+
+	* ioext.c, scmfig.h: support for SGI (tested with SGI IRIX 5.2/gcc)
+
+	* ioext.c (file_set_position): If a port is bidirectional
+	(e.g. a socket) it may be necessary on some systems to perform a
+	file positioning operation when switching between reading and
+	writing.  This is required by ANSI C (ISO/IEC 9899:1990
+	7.9.5.3).  Therefore, a	file-set-position on a bidirectional
+	port should not signal an error if fseek generates an
+	ESPIPE -- the fseek operation actually "succeeded" in that it
+	reset the I/O direction flag for the FILE.
+
+	* repl.c (input_waiting): R4RS requires that "char-ready?"
+	return "#t" at end-of-file.  The semantics for "ioctl(...,
+	FIONREAD, ...)" are such that it gives 0 on a socket that is
+	closed (on the other side of the connection).  If the
+	system has select(), use that instead to get the correct
+	behavior. 
+
+	* socket.c (l_listen): Treat sockets that have been "listened"
+	as input-ports.  This allows polling for new connections
+	(e.g. with "char-ready?") instead of blocking in
+	"socket:accept". 
+
+	* socket.c (l_accept): Fix type checking to agree with
+	previous patch.
+
+Wed Nov 13 17:11:59 1996  Aubrey Jaffer  <jaffer@localhost.bertronics.com>
+
+	* sys.c (igc): fixed off-by-1 error for sizeof save_regs_gc_mark.
+	(gc_mark): fixed off-by-1 error for sizeof(CONTINUATION).  These
+	seem to fix a very obscure GC bug.
+
+Tue Oct 29 10:47:41 1996  Aubrey Jaffer  <jaffer@localhost.bertronics.com>
+
+	* Init.scm (exec-self): Added.
+
+	* repl.c (init_repl): DUMP sets RESTART to EXEC-SELF.
+
+Mon Oct 28 11:39:30 1996  Aubrey Jaffer  <jaffer@localhost.bertronics.com>
+
+	* repl.c (tryload): Made tail-recursive so that dump, quit, exit,
+ 	etc. will work as the last expression in a loading file.
+	(scm_execpath): Split out from scm_unexec.
+
+Sun Oct 27 22:12:32 1996  Aubrey Jaffer  <jaffer@localhost.bertronics.com>
+
+	* unexec.c: All Updated from emacs-19.34 -- no changes necessary.
+	* gmalloc.c: 
+	* pre-crt0.c:
+	* ecrt0.c:
+	* unexelf.c: fixes Linux (ELF) dump bug.
+
+Mon Oct 21 21:49:20 1996  Aubrey Jaffer  <jaffer@martigny.bertronics>
+
+	* build.scm (platform): linux renamed linux-aout.  linux-elf fixed
+ 	and renamed linux.
+	(C-libraries): X11R6 moved library files on RedHat Linux.  Linux
+ 	graphics library now has entry (doesn't default).
+	(compile-dll-c-files linux):
+	(make-dll-archive linux): Now converts from ".o" objects to ELF
+	".so" form and "links" the usual libraries.
+
+	* Link.scm (usr:lib x:lib): dynamic linking fixed for (linux ELF)
+	dlopen.  Libraries other than ".so" object not needed; eliminated
+	by usr:lib and x:lib returning #f.
+
+	* dynl.c (l_dyn_unlink): prints result of dlerror() on errors.
+
+Thu Oct 10 14:05:14 1996  Aubrey Jaffer  <jaffer@martigny.bertronics>
+
+	* eval.c (nconc2last): If CAUTIOUS is defined, checks that
+	APPLY's arglist and last element of arglist are LIST?s.
+
+Sun Oct  6 16:40:54 1996  Radey Shouman  <shouman@zianet.com>
+
+	* eval.c (unmemocar): The code in unmemocar to deal with ILOCs was
+        never being executed.
+
+Fri Oct  4 13:57:35 1996  Aubrey Jaffer  <jaffer@martigny.bertronics>
+
+	* sys.c (igc): symhash GC can now be disabled with
+	#define NO_SYM_GC.
+
+Wed Oct  2 20:51:07 1996  Aubrey Jaffer  <jaffer@martigny.bertronics>
+
+	* Init.scm (boot-tail): Added FSF --help and --version options.
+	Added --no-init-file as a synonym for -no-init-file.
+
+Sun Sep 29 23:59:19 1996  Aubrey Jaffer  <jaffer@martigny.bertronics>
+
+	* scm.texi (File-System Habitat): improved wording and added
+	examples.
+
+Thu Sep 26 22:23:32 1996  Radey Shouman  <shouman@zianet.com>
+
+	* sys.c (intern): fixed (new) symhash GC bug.
+
+Tue Sep 24 13:55:11 1996  Aubrey Jaffer  <jaffer@martigny.bertronics>
+
+	* scm.texi (Top): Renamed sections.
+
+	* sys.c (mark_syms mark_sym_values): Split up mark_symhash() to
+	immunize against accidental pointers.
+
+Sat Sep 14 22:53:46 1996  Aubrey Jaffer  <jaffer@martigny.bertronics>
+
+	* repl.c (gc_ports_collected): added to instrument symbol GC.
+
+Sat Sep 14 15:35:29 1996  Radey Shouman  <shouman@zianet.com>
+
+	* sys.c (igc): Added calls to mark_symhash() and sweep_symhash().
+	These GC unused symbols with a top-level value of UNDEFINED.
+	(mark_symhash): added.
+	(sweep_symhash): added.
+
+Wed Sep 11 21:18:05 1996  Aubrey Jaffer  <jaffer@martigny.bertronics>
+
+	* scm.texi (Debugging Scheme Code): Added section.
+
+Sat Aug 31 14:05:24 1996  Eric Hanchrow  <erich@MICROSOFT.com>
+
+	* scm.c (l_sleep): Ported to Windows NT (_WIN32)
+
+	* ioext.c: Ported to Windows NT (_WIN32)
+
+Sat Aug 31 13:18:34 1996  Aubrey Jaffer  <jaffer@martigny.bertronics>
+
+	* eval.c (definedp): Changed from a memoizing macro to a `syntax'.
+
+Sun Jul 21 01:06:44 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* Link.scm (link-named-scm): fixed to call "build.scm".
+
+Sat Jul 20 23:53:17 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* scm.texi (Memoized Expressions): section added.
+	(Errors): section added.
+
+Wed Jul 17 17:40:01 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* r4rstest.scm: renamed from "test.scm".  Now carries copyright
+	notice suitable for single file distribution.
+
+Fri May 17 23:37:16 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* findexec.c (dld_find_executable): names changed to keep up with
+	DLD changes.
+
+Sun May 12 21:43:14 1996  Radey Shouman  <shouman@zianet.com>
+
+	* unif.c (array_rank): Was returning 0 for bit-vectors.
+	(uve_fill): Fixed error report.
+	(lcount):
+	(position): Made to work with 1-d shared bit-arrays.
+	(aind): Added check for second argument, must be either
+	an INUM, NULL, or a pair.  Without this, e.g.
+                   (uniform-vector-set! <vector> 'x 0)
+	starts cdr'ing down the symbol ...
+	(array_inbp): Cleaned up to work with enclosed and huge arrays.
+
+	* gsubr.c (gsubr_apply): Fixed error report.
+
+	* scl.c (equal): Prevent fallthrough on last case, could cause
+	wierdness if cases are added later.
+
+	* ramap.c (ra_matchp): Fixed to allow any 1-d array of zero size
+ 	to match a uniform vector, and to require all non-zero length
+ 	dimensions of two arrays to match even after a zero length
+ 	dimension.  Now promotes 0-d arrays as well as scalars to match
+ 	first array shape.
+	(sc2array): Reshapes 0-d arrays as well as scalars.
+  	Added check to make sure 2nd argument is really an array, 
+	vector or uve.
+  	(ramapc): Changed to allocate fewer array headers when arguments
+ 	are 1-d arrays.  (Still allocates more than strictly necessary.)
+  	(array_copy): Added check for scalar destination argument, since
+ 	ra_matchp() will now promote scalars to arrays.
+
+Sun May 12 00:52:51 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* build.scm (build): fixed HP-UX compile-dll-c-files.
+
+	* findexec.c (dld_find_executable): ifdefed out stat() for hpux.
+
+	* scm.c: New const declarations rejected by hp-ux cc; ifdefed out.
+
+Thu May  9 10:28:14 1996  Tim Pierce <twpierce@midway.uchicago.edu>
+
+	* time.c sys.c findexec.c: string[s].h configuration for Solaris
+        2.3 system using gcc 2.7.2.
+
+Tue Apr  9 19:46:21 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* sys.c (igc): stackbase argument added.  Passing 0 disables stack
+	marking (used by dump).
+
+	* build.scm (build link-c-program djgpp): 
+	(build compile-c-files djgpp): Uses new batch:apply-chop-to-fit to
+	deal with MS-DOS line length restrictions.
+
+Sun Apr  7 23:15:36 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* repl.c (repl_driver): now supports unexec conditionally by
+        CAN_DUMP.
+	(scm_unexec): moved from dump.c.  Now throws to top level to avoid
+	saving continuations.
+
+	* dump.c: removed.  Contents moved to repl.c.
+
+	* continue.c (dynthrow): One instruction interrupt vulnerability
+	removed for machines with long ints.  Others define SHORT_INT.
+
+	* repl.c (repl_driver): Throws to top level now encoded by COOKIE
+	flags for non- SHORT_INT platforms.
+
+Sat Apr  6 14:29:47 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* unexec.c (A_TEXT_OFFSET A_TEXT_SEEK ADJUST_EXEC_HEADER NO_REMAP
+	TEXT_START HAVE_GETPAGESIZE SEGMENT_MASK): definitions moved from
+	scmfig.h.
+
+	* gmalloc.c (HAVE_GETPAGESIZE): copied definition here so that
+	scm.h and scmfig.h won't be included for just one definition.
+
+	* dump.c (scm_dump): reworked to use execpath as default second
+	argument.  Removed "#include DUMP_CODE" abomination; using
+	suppress parameters in build.scm
+
+	* build.scm (build C-libraries): added dump (unexec) and nostart
+	libraries to support dump.
+	(build compile-commands): Added support for dump
+	(build features): dump
+
+	* scm.c (execpath): now a global which init_dump() also sets.
+
+	* repl.c (repl_driver): added scm_evstr("(boot-tail)") call
+	after scm_ldfile(initpath) so command-line arguments can be
+	processed after "Init.scm" is loaded.
+
+	* build.scm (build platform): added record for MS-DOS so defaults
+	don't cause errors when -p not specified.
+
+Mon Jan  9 15:43:36 1995  Patrick LECOANET <lecoanet%sid1@cenaath.cena.dgac.fr>
+
+	* dump.c (dump): created.
+
+	* pre-crt0.c crt0.c gmalloc.c unexec.c unexelf.c: adapted from
+	emacs (circa 1994).
+
+Fri Apr  5 00:16:59 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* ramap.c (ramapc ra2contig array_imap): Added +0L to cast first
+	argument to make_uve() to long.
+
+Thu Apr  4 00:47:09 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* ramap.c: removed #ifdef ARRAYS (over whole file).
+
+Wed Apr  3 10:14:18 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* Link.scm (compile-file): Now calls build.scm for compiling C.
+
+	* hobbit.scm ("auxiliary functions" butlast ...): removed and
+	renamed gratuitous (and incompatible) duplications of
+	slib/comlist.scm.
+
+Mon Apr  1 08:56:09 1996  Johann Friedrich Heinrichmeyer  <Fritz.Heinrichmeyer@fernuni-hagen.de>
+
+	* sys.c (stack_check): sizeof(STACKITEM) was multiplied on wrong
+	side of inequality.
+
+Fri Mar 29 23:52:03 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* patchlvl.h (SCMVERSION): 4e4
+
+	* build.scm (build): microsoft-c-nt support added.
+
+	* scm.c (l_raise): Disabled for WINDOWS_NT.
+	(scm_find_impl_file): fixed for getenv("SCM_INIT_PATH") case.
+
+Sun Mar 24 00:18:10 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* build.scm (build): fixed -tdll to not make archive or compile
+	all 'linkable files.
+
+Sun Mar 10 17:23:39 1996  Radey Shouman  <shouman@ccwf.cc.utexas.edu>
+
+	* ramap.c (sc2array): Added, converts a scalar to a shared array.
+	(ramapc):  Uses sc2array to convert scalar arguments to arrays
+	        for ARRAY-MAP! &c.
+	(ura_read, ura_write, ura_fill):  Added.
+	(array_map): Added check for number of arguments when procedure
+	        arg is a subr.  Added cclo case.
+
+	* unif.c (dims2ura): Fixed, it wasn't properly filling its result
+	        sometimes.  Added range check for size of conventional arrays.
+	(aind): Added range check when called as subr3.
+	(array_inbp): Returns #t if called with a scalar and no
+                index args -- APLish boundary case.
+	(cvref): Now recycles enclosed array refs.
+	(aset): Uses num2dbl for setting inexact array elts, so
+	e.g. (array-set! <inexact-array> 0 ...) works.
+	(array_contents): For strict option, wasn't returning an array
+	whenever the base was non-zero, now less restrictive.
+	(ra2contig): moved to ramap.c, as it calls ramapc().  To allow
+	dynamic linking of ramap.c.
+	(rafill): moved from ramap.c, to allow filling of arrays on
+	creation without needing ramap.c.
+	(uve_fill):  Added, for filling uves / 1-d arrays without needing
+	ramap.c.
+	(uve_read, uve_write):  (Re)added
+	(ura_read, ura_write):  Moved to ramap.c, now call uve_[read write].
+	(ra2l): uses cvref instead of aref, maybe faster and works for 
+	enclosed arrays.
+	(init_unif): Added feature 'string-case, to prevent require
+	from nuking STRING-UPCASE!, STRING-DOWNCASE!
+	(encl_array): Added range check for dimension args.
+	
+	* rope.c (num2dbl): Added, analogous to num2dbl.
+
+	* scmfig.h Eliminated redundant #ifdef
+
+	* scl.c (makdbl) Rearranged so that it tests for out of range
+	double argument before assigning to float variable, this 
+	avoids causing SIGFPE on my Linux box.
+	(equal): Fixed so that it doesn't need extern array_equal,
+	allowing ramap.c to be dynamically linkable.
+	
+	* scm.c  Added documented variable *scm-version*
+
+Thu Mar 21 00:14:29 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* Link.scm (scm:object-suffix): Changed to ".so" when
+	'sun-dl is PROVIDED?.
+
+	* scmfig.h (getcwd): addition for scmconfig.
+	* findexec.c: minor change for scmconfig.
+
+Wed Mar 20 00:12:43 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* README (Making SCM with Think C 4.0 or 4.1): Instructions added
+        back in.
+
+Sun Mar 17 00:17:21 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* findexec.c (dld_find_executable): Added support for ~ and ~/ in
+	PATH environment variable.
+
+Sat Mar 16 10:38:15 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* scm.c (scm_find_impl_file): Added generic_name argument to test
+	for cases where executable *doesn't* have its usual name.
+	(scm_sep_init_try): Added combined function to reduce length of
+	scm_find_impl_file.
+	(scm_try_path): Now tests for (and returns) 0.
+
+	* build.scm (build): fixed assorted bugs.
+
+Tue Mar 12 12:48:28 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* 4e3: released.
+	* repl.c (read_token): ',' now delimits token.
+
+Mon Mar  4 23:19:50 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* scm.texi (SLIB and require.scm): SLIB installation and
+	"require.scm" trampoline configuration method explained.
+
+	* Init.scm (load:pre load:post): added to share code between
+	scm:load and scm:load-source.  "require" is now loaded using the
+	regular calls; trying to maintain SCM initializing without SLIB is
+	too hard.
+
+Sun Mar  3 10:59:23 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* build.bat: Added for MS-DOS.
+
+Fri Mar  1 23:47:57 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* scm.texi (Line Editing): html-linked readline and editline ftp
+	sites.
+
+	* build.scm: Added support for edline.
+
+Wed Feb 28 23:39:55 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* build.scm (build:build): library field `supress-files' added.
+	Used for supressing "findexec.c" when DLD is present.
+
+Sun Feb 25 00:29:47 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* scm.c (scm_find_impl_file): Tries hard to find Init.scm in
+	implementation vicinity.
+	(scm_try_path scm_cat_path): used by scm_find_impl_file.
+	(main): Changed to use scm_find_impl_file() and free pathnames
+	before exit.
+
+Wed Feb 21 23:27:43 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* findexec.c (dld_find_executable): extracted from DLD for
+	general use.
+
+Tue Feb 20 00:08:29 1996  Jochen Schwarze  <schwarze@isa.de>
+
+	* Init.scm (*vicinity-suffix*): Now includes #\/ for MSDOS,
+	etc. (GCC support).
+	(library-vicinity): Now set from implementation-vicinity if
+	environment variable SCHEME_LIBRARY_PATH is not defined.
+
+	* scm.c (SYSTNAME): not redefined with DJGPP (both MSDOS and
+	unix).
+
+Sun Feb 18 09:29:57 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* subr.c (divbigint): fixed sign bug for 0 return value.
+
+Sun Feb 18 00:29:43 1996  Per Bothner <bothner@cygnus.com>
+
+	* gsubr.c (gsubr_apply): elided gratuitous make_vector call.
+
+Sat Feb 17 11:50:41 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* Init.scm (*features*): string-case added.
+	(string-upcase string-downcase string-capitalize): added.
+
+	* unif.c (strcap): string-capitalize!
+
+	* sys.c (sysintern): Now looks for (and uses) symbol already
+	created.  This will eliminate order of linking and loading
+	dependencies.
+
+Tue Sep 26 20:37:25 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* scm.texi (Evaluation): Enlarged description to include type
+	folding.
+	(Cells): Split Node Cells into Header, Subr, Ptob, and Smob Cells.
+
+Fri Sep 22 22:31:13 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* scm.c scmfig.h (WINDOWS_NT): support added.  But what flag does
+	Windows NT #define?
+
+Sun Sep 10 13:37:44 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* repl.c (scm_stack_trace): Added Scheme call "stack-trace" to
+	print stack from exception handlers.
+	(everr): Now processes all exceptions before longjmping to
+	rootcont #ifdef CAUTIOUS.
+
+	* Init.scm (user-interrupt): If stack-trace available, prints
+	stack-trace and enters breakpoint.
+	(break): Autoloaded.
+
+Mon Aug  7 12:52:15 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* scm.h (stacktrace): now a sys_protect.
+
+	* subr.c (ilength): differentiated negative return codes;
+	non-terminating returns -1, not a list -2.
+
+Sat Aug  5 18:50:11 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* repl.c (scm_print_stack): added.  Called by def_err_response.
+
+	* eval.c (ceval): SCM stacktrace variable maintained and saved
+	in CONT(cont)->other.stacktrace.  Under CAUTIOUS flag,
+	checkargs1 label added to check special single argument calls.
+
+Wed Jul 26 23:26:21 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* repl.c (char_readyp): Now looks for BUF0 flag to determine if
+	input_waiting() possible.
+
+	* scm.c (init_scm run_scm main): BUF0 flag now set on cur_inp
+	to indicate whether CHAR-READY? will work.
+
+Wed Jul 19 13:25:01 1995  Shigenobu Kimura  <skimu@komachi.phys.s.u-tokyo.ac.jp>
+	* dynl.c (l_dyn_main_call): Arguments to main (in DLD section)
+	were reveresed!  Added hpux l_dyn_main_call.
+
+Sat Jul  8 22:23:03 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* Init.scm (scm:load): Internal define dependency problem fixed.
+	Variable *interactive* set for invocation without options.
+
+	* scm.texi: Guile WWW and citation added.
+
+	* subr.c: logical (2's complement) operations rewritten to now
+	work with bignums.  Logical procedure names changed to conform
+	with Guile convention.
+
+Fri Jun  9 13:47:58 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* continue.c (stack_size):
+	(make_root_continuation): 
+	(make_continuation): 
+	(free_continuation): 
+	(throw_to_continuation): moved from sys.c to make possible library
+	module.
+
+	* continue.h: created from setjump.h
+
+	* scm.texi (Compiling And Linking): Documented l_dyn_main_call.
+	(Type Conversions): added rope.c documentation.
+	(Callbacks): split from "Calling Scheme From C".
+	(Continuations): Rewritten to describe new "continue.c"
+
+Fri May 19 01:32:12 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* *.c: converted applicable uses of makfromstr with strlen to
+	makfrom0str.
+
+	* rope.c: new
+	(scm_addr): added.
+	(num2long num2ulong num2ushort num2uchar ulong2num long2num):
+	moved from scl.c and elsewhere.
+	(makfromstrs makfrom0str makfromstr): moved from sys.c and posix.c
+	(must_free_argv): new
+	(scm_ldprog scm_ldfile scm_ldstr scm_evstr): moved from repl.c
+	(makargvfrmstrs): chopped out of i_execv in ioext.c.
+	makargvfrmstrs isn't really done correctly; it is GC leaky.
+	It should return a SMOB which can be GCed, but this makes this
+	C interface harder to use.
+
+	* dynl.c (l_dyn_main_call): added procedure to call
+	dynamically linked procedure with string arguments converted
+	to argv and argc.  Written only for DLD.  Needs to be repeated
+	for other dynamic linking regimes.
+
+Tue Apr 25 10:24:42 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* subr.c (make_string): Was silently failing for illegal 2nd args!
+
+Sat Apr 15 23:18:47 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* Link.scm (catalog:add-link): When feature is already in catalog,
+	will only add new feature association to catalog if file exists.
+
+Sun Apr  9 22:59:46 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* repl.c (repl_driver): Now closes load port when ABORTing.
+
+Sat Apr  8 21:35:43 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	From: Tom Lord <lord@cygnus.com>
+	* scm.texi:
+	Tcl Facilities::  Mutual calling between Tcl and Scheme.
+	Tk Facilities::   Accessing Tk from Scheme.
+	Gwish::           A Wish-like application of Guile.
+	System Calls::    Psst.  Wanna write a manual section?
+	Gscsh::           Shell and systems programming features.
+
+	From: chen@adi.com (Franklin Chen)
+	* scm.c (l_raise): uses raise() ifdef STDC_HEADERS, otherwise
+	kill().
+
+	From: Radey Shouman <shouman@ccwf.cc.utexas.edu>
+	* scl.c (istr2int): Fixed complaints of overflow on octal numbers
+	>= 2^BITSPERDIGIT.  Patch should make this work for all radix 2 <=
+	radix <= 16.
+	(num2ulong): Makes it work for negative bignum argments, and
+	adds an overflow check.
+
+	* ramap.c unif.c: There are several places in ramap.c, and
+	raprin1() in unif.c, where I had assumed that an ivect or uvect
+	elt would be representable no larger than an INUM.  This patch
+	should fix these, also adding overflow checking for array
+	arithmetic on uvects and ivects.
+
+	Also, fixes aref, which assumed that if its argument was a smob
+	that it was an array.  Changes cvref to return a real number when
+	the imaginary part of an elt is 0.
+
+Sat Mar 25 20:37:48 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	From: Don Bennett <dpb@netcom.com>
+	* rgx.c: rewritten and extended.  The compile function now takes a
+	string of optional flags.  New operations specific to the GNU
+	regex library is conditionalized with _GNU_SOURCE.
+
+	From: Radey Shouman <shouman@ccwf.cc.utexas.edu>
+	* Iedline.scm ((make-edited-line-port)): 
+	* edline.c (lreadline): Added Gnu `readline' input editing
+	(get ftp.sys.toronto.edu:/pub/rc/editline.shar).
+
+	* unif.c (ra2contig): Fix a nasty bug ra2contig() (used for
+	UNIFORM-ARRAY-WRITE / READ!) that produced arrays with undersized
+	contents vectors.
+
+	* eval.c (apply): Fix so that (APPLY <cclo> '()) works properly.
+
+	* gsubr.c (make_gsubr): Give the arg number ASSERTion the right
+	sense.
+	(gsubr_apply): Add an ASSERTion to check for too many arguments.
+	(gsubr_apply): Take the address of the temporary vector, so as to
+	prevent its being optimized away and allowing gc of the vector.
+	(This happened with Cray cc in the MAP and FOR-EACH code; I'm no
+	longer able to find out if it would happen there.)
+
+Thu Mar 23 23:22:59 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* scm.texi (I/O-Extensions): Finished.
+
+	* Init.scm (scm:load): `loading' messages now indented.
+
+Sat Mar  4 20:58:51 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* scm.texi: documentation finished for "posix.c" and "unix.c".
+
+	* posix.c (scm_getgroups): added.
+
+	* posix.c (makfrom0str): According to glibc.info, some field in
+	structures like pwent may have NULL pointers.  Changed makfrom0str
+	to return BOOL_F in this case.
+
+Thu Mar  2 12:52:25 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* time.c: CLKTCK set from CLOCKS_PER_SEC, if available.  Metaware
+	HighC ported.
+
+	* scm.h: USE_ANSI_PROTOTYPES now controls prototypes (was
+	__STDC__).  This allows an overly fussy compiler to still have
+	__STDC__.
+
+	From: dorai@ses.com (Dorai Sitaram)
+	* ioext.c (l_utime): include files fixed for __EMX__
+
+Sun Feb 26 21:03:04 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* sys.c (gc_mark gc_sweep): tc7_ssymbol now gets GCed because it
+	gets used for non-GCed strings in scm_evalstr scm_loadstr.
+	(mkstrport cwos cwis): changed so caller's name is passed into
+	mkstrport().
+
+	* repl.c
+	(scm_eval_string scm_evalstr scm_load_string scm_loadstr): added
+	for easier C to scheme callbacks.
+	(loadport): variable added so lreadr() and flush_ws()
+	increment linum only when reading from the correct port.
+	(def_err_response): now handles ARGn for argument numbers > 5 and
+	unknown position arguments.
+
+	* dynl.c: Dynamic Linking now sets and restores *load-pathname*
+	around the init_ call.
+
+Sat Feb 25 11:03:56 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* scm.c (lsystem getenv softtype ed vms_debug): moved from scl.c.
+	(add_feature): moved from repl.c.
+	(features): init table removed (caused multiple symbols).
+
+Fri Feb 24 23:48:03 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* scm.c (scm_init_extensions COMPILED_INITS): Added so that
+	statically linked, compiled code can be initialized *after* most
+	of Init.scm has loaded.
+
+Wed Feb 22 15:54:01 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* subr.c (append): Added check for bad arguments and fixed errobj.
+
+Sun Feb 19 01:31:59 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* ioext.c (exec execp): changed so that 2nd arguments is argv[0]
+	(like posix) and renamed to execl and execlp.
+	(execv execvp): added.
+
+Sat Feb 11 17:30:14 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* ioext.c (lexec): moved from repl.c and scm.c.
+	(lexecp i_exec l_putenv): added.
+
+	* posix.c (open_pipe l_open_input_pipe l_open_output_pipe
+	prinpipe):  moved from ioext.c.
+	(l_fork): added.
+
+Fri Feb 10 10:50:03 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* scl.c (num2long long2num): moved here from subr.c.
+	(num2ulong): fixed (< to >=) bug.
+
+	* unif.c (aset array2list array_ref cvref): uniform integers and
+	unsigned integer arrays now handle full size integers (and
+	inexacts) using num2long, num2ulong, long2num, and ulong2num when
+	INUMS_ONLY is not defined.
+
+	* scmfig.h (INUMS_ONLY): defined when INUMs are the only numbers.
+
+Sun Jan 29 23:22:40 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* scm.texi (Overview): scm.1 converted to texinfo format and
+	incorporated.
+
+Sun Jan 22 11:13:58 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* scm.texi (Internals): code.doc converted to texinfo format.
+	Much added and reorganized.  code.doc removed.
+
+Thu Jan 19 00:40:11 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* subr.c (logbitp logtest): added.
+
+Wed Jan 11 14:45:17 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* scl.c (num2ulong): checks for bignum sign and magnitude added.
+
+	* subr.c (logand logior logxor lognot): lognot restriction to
+	INUMs removed.  Logand, logior, and logxor now will work for up to
+	32 bit signed numbers.
+
+Tue Jan 10 13:19:52 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* repl.c (def_err_response): Circuitous call to quit() replaced
+	with exit(EXIT_FAILURE);
+	(everr): Now calls def_err_response() in interrupt frame if
+	errjmp_bad or there are dynwinds to do.  This prevents silent
+	failure in batch mode.
+
+Mon Jan  9 00:12:14 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* scm.texi (Trouble Shooting): Section converted from README.
+
+	* Init.scm (-d filename): option added which does:
+	(begin (require 'database-utilities) (open-database filename))
+
+	* repl.c (handle_it): Now discards possibly used top freelist cell
+	for GC safety.  Also now just punts if errjmp_bad.
+
+	* scm.texi: converted from MANUAL.  GUILE documentation merged in.
+
+Tue Jan  3 15:09:36 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* scl.c (SYSTNAME): msdos changed to ms-dos.  windows added.
+	archimedes changed to acorn.
+
+	From: jon_seymour@vnet.ibm.com (jon seymour)
+	* scmfig.h: defined LACK_TIMES and STDC_HEADERS if __IBMC__ is
+	defined.
+
+	* sys.c: #include <io.h> and #include <direct.h>. define ttyname()
+	macro.
+
+	* scm.c: #include <io.h> and compile out execvp() call.
+
+	* time.c: #include <sys/timeb.h>
+
+	* makefile.os2: makefile for use with OS/2 toolkit nmake.
+
+Sun Jan  1 21:17:36 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* dynl.c Link.scm: names unified.  Libraries for HP-UX fixed.
+	HP-UX dll suffix now ".sl".
+
+	From: Shigenobu Kimura <skimu@komachi.phys.s.u-tokyo.ac.jp> *
+	dynl.c (fcall): Fixed dynamic linking on hp9000s700 (or 720) HP-UX
+	9.01 or 9.03.
+
+Wed Dec  7 21:19:26 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* ioext.c (l_open_input_pipe, l_open_output_pipe): moved from
+	"Init.scm".
+
+Mon Dec  5 16:55:21 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* sys.c (i_setbuf0): added.
+	(open_file): `0' in mode string now controls the buffered-ness of
+	returned port.
+
+	* Init.scm (slib:load-compiled): no longer silently fails if other
+	than the first argument does not link correctly.
+
+	From: Robert Sanders <rsanders@hrothgar.mindspring.com>
+	* ioext.c (l_write_line): moved from "Init.scm".
+
+Sun Dec  4 21:47:08 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* sys.c (free_storage): lord@cygnus.com pointed out that candle
+	was being burnt from both ends.  Loop fixed.  Mallocs either
+	leaking or counted wrong.
+
+Sat Dec  3 22:32:59 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* code.doc: added description of compiled closures.
+
+Thu Nov 24 23:10:31 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* socket.c (l_socketpair): added.  Both make-stream-socketpair and
+	make-stream-socket now take optional prototype argument.
+
+Tue Nov 22 00:16:05 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* ramap.c (ramapc and friends): moved from unif.c to get source
+	file sizes below 64k.
+
+Mon Nov 21 00:44:32 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* posix.c (l_pwinfo grinfo): made to work like network inquiry
+	procedures (no args steps through entries).
+	(l_setgr l_setpw l_uname): added.
+
+	From: Radey Shouman <shouman@ccwf.cc.utexas.edu>
+	* gsubr.c (make_gsubr gubr_apply): allows arbitrary (< 11)
+	required, optional, and rest arguments to compiled functions.
+
+Sun Nov 20 11:59:18 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* socket.c MANUAL: most Scheme names for socket functions changed
+	for consistency.
+	* socket.c (socket:shutdown): added.  I can't imagine what use
+	shutdown provides.  SOCKETs can be closed like any other port.
+	Should socket:shutdown SOCKETs be closed?  Does having shutdown
+	sockets cause file descriptors to be reused?  Socket:shutdown will
+	be removed if no use is found for it.
+	(tc16_sknm): added to encapsulate information retrieved from
+	getpeername and getsockname.
+	(socket-name:family socket-name:port-number socket-name:address):
+	added to retrieve information from tc16_sknm.
+	(inet:string->address inet:address->string inet:network
+	inet:local-network-address inet:make-address): added.
+	(gethost sethostent getnet getnetent getproto setprotoent getserv
+	setservent): inquiry procedures added.
+
+	* sys.c (makfromstrs(argc, argv)): added.  converts C array of
+	strings to SCM list of strings.  If argc < 0, a null terminated
+	array is assumed.
+
+Sat Nov 19 00:20:58 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* eval.c (l_proc_doc): added procedure-documentation.
+
+Fri Nov 18 23:34:35 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* build.scm (scm:build): Added. Replaces system specific
+	makefiles.
+	* ccnfigdb.scm: Database of system specific compile, link, and
+	archive procedures and library information.
+
+Thu Oct 27 12:57:02 1994  Jerry D. Hedden  <hedden@esdsdf.dnet.ge.com>
+
+	* ioext.c: conditional code for vms and version (3.6) of Aztec C.
+	* pi.scm ((e digits)): Modified 'bigpi' for slight speed
+	improvement.  Added function to calculate digits of 'e'.
+
+Wed Oct 26 11:22:05 1994  Gary Houston  <ghouston@actrix.gen.nz>
+
+	* scl.c (round): Now rounds as described in R4RS.
+
+	* test.scm (test-inexact): test cases for round.
+
+Tue Oct 25 00:02:27 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* sys.c	(grow_throw lthrow dynthrow): now pass arrays, check
+	for adequate growth, and clear out register windows (on sparc).
+
+Mon Oct 24 01:05:34 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* ioext.c (ttyname fileno): added.
+
+Sat Oct 22 12:12:57 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* unix.c (symlink readlink lstat): added.
+
+	* scmfig.h repl.c sys.c (IO_EXTENSIONS): flag removed.
+
+	* ioext.c (read-line read-line! file-position, file-set-position
+	reopen-file open-pipe opendir readdir rewinddir closedir chdir
+	umask rename-file isatty? access chmod mkdir rmdir stat utime
+	raise): moved from "repl.c" and "sys.c".
+
+Fri Oct 21 21:19:13 1994  Radey Shouman  <shouman@ccwf.cc.utexas.edu>
+
+	* unif.c (ra2contig): now has a second parameter to indicate
+	whether copying is necessary or not.  Eliminates gratuitous copy
+	by UNIFORM-ARRAY-READ! when called with a noncontiguous array.
+
+	(array_map): more liberal check on when ARRAY-MAP! can use
+	array-ified asubrs.
+
+Thu Oct 20 18:00:35 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* sys.c (opendir readdir rewinddir closedir reopen-file): added
+	under IO_EXTENSIONS.
+
+Wed Oct 19 14:18:26 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* eval.c (badargsp): added under ifndef RECKLESS to check @apply
+	and apply() arg counts.
+
+Tue Oct 18 00:02:10 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* unix.c (mknod acct nice sync): added.
+
+	* socket.c (socket bind! gethost connect! listen! accept): added.
+
+	* time.c (utime): added under IO_EXTENSIONS.
+
+Mon Oct 17 23:49:06 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* sys.c (getcwd umask access chmod mkdir rmdir): added
+	under IO_EXTENSIONS.
+
+	* scm.c (l_pause): added if SIGALRM defined.
+	(l_sleep): added if SIGALRM not defined.
+
+	* scl.c (num2ulong): added.  Used in "time.c"
+
+Sun Oct 16 22:41:04 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* sys.c (access chmod): Posix access added under IO_EXTENSIONS.
+
+Fri Oct 14 09:45:32 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* posix.c (chown link pipe waitpid, kill, getpw, getgr, get*id,
+	set*id): added.
+
+	* time.c (l_raise l_getpid): added
+	* subr.c (ulong2big):
+	* scl.c (ulong2num): useful routines for system call data
+	conversion moved from "time.c".
+
+Thu Sep 22 14:48:16 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* subr.c (big2inum): (more accruately) renamed from big2long.
+
+Mon Aug 29 11:36:46 1994  Radey Shouman  <rshouman@hpcf.cc.utexas.edu>
+
+	* unif.c: This is a large patch, but also a bit larger than it
+	appears -- I moved a few function definitions around to eliminate
+	gratuitous forward references.
+
+	* unif.c repl.c (raprin1): Combined print routine for arrays with
+	that for uves.
+
+	* unif.c (UNIFORM-VECTOR-READ! and -WRITE): work with general
+	arrays, by copying when necessary, renamed them to
+	UNIFORM-ARRAY-READ! and -WRITE.
+
+	* unif.c (ARRAY-CONTENTS): Generalized so that it returns a 1-d
+	array even when the stride in the last dimension is greater than
+	one, gave it an optional second argument STRICT, which makes it
+	behave as it did before, returning an array/vector only if the
+	contents are contiguous in memory.
+
+	* unif.c (ARRAY-CONTIGUOUS?) Eliminated. Instead, use
+		(lambda (ra) (array? (array-contents ra #t)))
+
+	* unif.c code.doc (ramapc): unrolls arrays mapping into one loop
+	if possible, to make this quick, changed the format of the array
+	CAR, now uses one bit to indicate that an array is contiguous --
+	this still allows a ridiculous number of dimensions.
+
+	* scm.h (DSUBRF): dsubrs are mapped directly, to allow this I
+	moved the typedef for dsubr and #define for DSUBRF to scm.h
+
+	* unif.c (ARRAY-MAP!) taught something about subrs, now most subrs
+	may be mapped without going through apply(), saving time and
+	reducing consing.  +, -, *, /, =, <, <=, >, and >= are mapped
+	directly as special cases -- for uniform arrays this is nearly as
+	fast as the equivalent C, and doesnt' cons.  I've made sure that
+	+, -, *, and / vectorize on the CRAY, this may be wasted effort
+	but the effort is not great.
+
+	* unif.c (ARRAY-COPY!) now copies many arrays of differing types
+	to each other without going through the aref/aset, e.g. float ->
+	double, double -> complex, integer -> float ...  This should make
+	array type coercions for arithmetic faster.
+
+	* unif.c (TRANSPOSE-ARRAY) Added, which returns a shared array
+	that is the transpose of its first argument.  I think this does
+	what an APL:TRANSPOSE would.
+
+	* unif.c (ENCLOSE-ARRAY) Added, this returns an array that looks
+	like an array of shared arrays, the difference being that the
+	shared arrays are not actually allocated until referenced.
+	Internally, the contents of an enclosed array is another array.
+	The main reason for this is to allow a reasonably efficient
+	implementation of APL:COMPRESS, EXPAND, and INDEXING.  In order to
+	actually make an array of shared arrays, just use ARRAY-COPY!.
+
+	* unif.c (cvref): Created internal version of aref(), cvref() that
+	doesn't do error checking; Thus speeding things up.  Profiling of
+	SCM running array code revealed that aref() was taking a
+	surprising fraction of the CPU time
+
+	TO DO:
+
+	The mechanism for looking up the vectorized functions is a little
+	kludgy, I was tempted to steal some of the CAR of the subr type to
+	encode an offset into a table of vectorized functions, but this
+	would make it more likely that dynamically loaded subrs lose thier
+	names.
+
+	It is almost possible to write APL:+ and friends now, it is just
+	necessary to figure out the appropriate type of the returned array
+	and allocate it, and to promote scalar arguments to arrays (with
+	increments 0).
+
+	This doesn't include vectorized REAL-PART, IMAG-PART,
+	MAKE-RECTANGULAR ...
+
+	I think some C support for APL:REDUCE and maybe INNER-PRODUCT will
+	be needed for a reasonably fast APL.scm
+
+	unif.c is getting quite big, time to split it up?
+
+
+Mon Sep  5 22:44:50 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* Init.scm repl.c (quit): code was not using return values
+	correctly.
+
+Sun Aug 21 01:02:48 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* record.c (init_record): remaining record functions moved into C
+	code.
+	* eval.c sys.c: compiled closures now conditional under CCLO.
+
+Sat Aug 20 23:03:36 1994  rshouman@chpc.utexas.edu (Radey Shouman)
+
+	* eval.c (ceval apply):
+	* sys.c (makcclo): tc7_cclo, compiled closures, now supported.
+	* record.c (init_record): C implementation of slib "Record"s using
+	CCLO.
+	* scm.h subr.c (QUOTIENT MODULO REMAINDER): fixes a bug for
+	bignums with DIGSTOOBIG defined.  Also, changed the return type of
+	longdigs() to void, since that value is no longer used anywhere.
+
+Mon Aug  1 11:16:56 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* time.c (curtime): replaces get-universal-time.  Other time
+	functions removed (SLIB support more complete).
+
+	* subr.c (divbigbig): fixed (modulo -2177452800 86400) => 86400
+	bug.  Also added to test.scm.
+
+Sun Jul 24 16:09:48 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* dynl.c (init_dynl): *feature* dld:dyncm added for dynamically
+	(ldso) linked libc.sa and libm.sa (under Linux).
+
+Fri Jul 15 12:53:48 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* unif.c (array-fill!): bug with increment in default clause fixed.
+	Fast string support added.
+
+	From: rshouman@chpc.utexas.edu (Radey Shouman)
+	* unif.c (array-fill! array-for-each): bug fixes.
+
+Sun Jul 10 01:51:00 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* scm.c (run_scm init_scm): "-a" heap allocation argument supported.
+
+	* Makefile (proto.h): removed.
+
+	From: Drew Whitehouse, Drew.Whitehouse@anu.edu.au
+	* scm.h (P): Conditionalized ANSI'fied version of the scm.h.
+
+Sun Jun 26 12:41:59 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* Link.scm (usr:lib lib): Now checks for shared libraries
+	(lib*.sa) first.
+
+Thu Jun 23 19:45:53 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* scl.c scm.c: Support for compilation under Turbo C++ for Windows
+	 (system and exec disabled) added under C flag "_Windows".
+
+Sat Jun 18 11:47:17 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* test.scm ((test-delay)): added.
+	((test-bignum)): added and called automatically if bignums
+	suported.  test-inexact called automatically if inexacts
+	supported.
+
+Mon Jun  6 09:26:35 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* Init.scm (trace untrace): moved to SLIB/trace.scm.
+
+Thu May 12 00:01:20 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* Link.scm: Autoload for hobbit now does (provide 'hobbit).  This
+	allows hobbit to know if it is self compiling (although reloads of
+	hobbit will not be quite right).
+	((compile file . args)): removed.
+
+	* makefile.unix (proto.h): removed.
+
+	* Transcen.scm: compile-allnumbers HOBBIT declaration added.
+	Init.scm will now load compiled Transcen.o.
+
+	* scm.h: HOBBIT section removed.
+
+	* README (SLIB): Now strongly recommends getting SLIB and lists
+	ftp sites.
+
+	* eval.c (m_delay): fixed bug with multiple sets of (delay x).
+
+Thu Apr 28 22:41:41 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* unif.c (makflo): shortcut for single precision float arrays
+	added.
+
+Fri Apr 15 00:54:14 1994  rshouman@chpc.utexas.edu (Radey Shouman)
+
+	* unif.c: no longer uses pointer comparisons in loops.  Should
+	fix problems on 8086 processors.
+	* unif.c (make_sh_array): Fixes MAKE-SHARED-ARRAY so that shared
+	arrays with only 1 element in some direction may still be
+	ARRAY-CONTIGUOUS?
+	(uve_write uve_read): Fixes bug in UNIFORM-ARRAY-WRITE,
+	UNIFORM-ARRAY_READ!.  Now they do the right thing for shared
+	bit-arrays not starting at the beginning of their contents vector.
+	(array_contents ARRAY-SIMPLE?): ARRAY-CONTENTS may now return a
+	shared, contiguous, 1-d array, instead of a vector, if the array
+	cannot access all of the contents vector.  ARRAY-SIMPLE? removed.
+	(array-fill!): a replacement and generalization of
+	UNIFORM-VECTOR-FILL!.
+	(raequal): Combines with uve_equal(), providing also ARRAY-EQUAL?
+	ARRAY-EQUAL? is equivalent to EQUAL? if all its arguments are
+	uniform vectors or if all are arrays.  It differs from EQUAL? in
+	that a shared, 1-d array may be ARRAY-EQUAL? to a uniform vector.
+	  for example
+	  (define sh (make-shared-array '#(0 1 2 3) list '(0 1))) ==> #1(0 1)
+	  (equal? '#(0 1) sh)       ==> #F
+	  (array-equal? '#(0 1) sh) ==> #T
+	(list2ura): Combines list2uve() and list2ura().
+
+Thu Apr 14 23:26:54 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* time.c (LACK_FTIME LACK_TIMES): defined for vms.
+
+Mon Apr  4 10:39:47 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* eval.c (copytree): now copies vectors as well.
+
+	* repl.c (quit): now accepts #t and #f values.
+
+Sun Apr  3 23:30:14 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* repl.c (repl): call to my_time() moved to not include READ time.
+
+	* time.c (mytime): now prefers to use times() over clock().
+	Compilation constant CLOCKS_PER_SEC doesn't scale when a binary is
+	moved between machines.
+
+Thu Mar 31 16:22:53 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* Init.scm (*SCM-VERSION*): added.
+
+	* Makefile (intro): Added message for those who just make.
+	Cleaned up and reorganized Makefile.
+
+	* patchlvl.h (PATCHLEVEL): removed.  Whole version now just in
+	SCMVERSION.
+
+Wed Mar 23 00:09:51 1994  rshouman@chpc.utexas.edu (Radey Shouman)
+
+	* repl.c (iprin1): Characters higher than 127 print as
+	#\<octal-number>.
+
+	* Init.scm ((read:array digit port)): added.  Most # syntax
+	handled in read:sharp.
+
+	* unif.c (clist2uve clist2array): removed.
+
+Fri Mar 11 15:10:53 1994  Radey Shouman  (rshouman@chpc.utexas.edu)
+
+	* sys.c (sfgetc): can now return EOF.
+
+Mon Mar  7 17:07:26 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* patchlvl.h (SCMVERSION): 4e0
+
+	* scmfig.h: was config.h (too generic).
+
+	* scm.c (main run_scm) repl.c (repl_driver init_init): now take
+	initpath argument.  IMPLINIT now used in scm.c
+
+Sun Feb 27 00:27:45 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* eval.c (ceval m_cont IM_CONT): @call-with-current-continuation
+	special form for tail recursive call-with-current-continuation
+	added.  call_cc() routine removed.
+
+Fri Feb 25 01:55:06 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* eval.c (ceval m_apply IM_APPLY apply:nconc-to-last): @apply
+	special form for tail-recursive apply added.  ISYMs reactivated.
+
+Mon Feb 21 14:42:12 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* crs.c (nodelay): added.  In NODELAY mode WGETCH returns
+	eof-object when no input is ready.
+
+	* Init.scm ((read:sharp c port)): defined to handle #', #+, and
+	#-.
+
+	* repl.c (lreadr): Now calls out to Scheme function read:sharp
+	when encountering unknown #<char>.
+
+Tue Feb 15 01:08:10 1994  Shiro KAWAI <kawai@sail.t.u-tokyo.ac.jp>
+
+	* eval.c (ceval apply): under flag CAUTIOUS, checks for applying
+	to non-lists added.
+
+Sat Feb 12 21:23:01 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* sys.c (sym2vcell intern sysintern): now use internal strhash().
+
+	* scl.c sys.c (hash hashv hashq strhash()): added.
+
+Sat Feb  5 01:24:35 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* scm.h (ARRAY_NDIM): #define ARRAY_NDIM NUMDIGS changed to
+	#define ARRAY_NDIM(x) NUMDIGS(x) to correct problem on Next.
+
+Fri Feb  4 23:15:21 1994  rshouman@chpc.utexas.edu (Radey Shouman)
+
+	* unif.c: 0d arrays added.  Serial array mapping functions and
+	ARRAY-SIMPLE? added.
+
+Thu Feb  3 12:42:18 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* scm.h (LENGTH): now does unsigned shift.
+
+Wed Feb  2 23:40:25 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* Link.scm (*catalog*): catalog entries for db (wb),
+	turtle-graphics, curses, regex, rev2-procedures, and
+	rev3-procedures added.
+
+Sun Jan 30 19:25:24 1994  rshouman@chpc.utexas.edu (Radey Shouman)
+
+	* sys.c eval.c setjump.h setjump.s (longjump setjump): full
+	continuations now work on Cray YMP.
+
+Thu Jan 27 01:09:13 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* dynl.c MANUAL Init.scm (init_dynl): dynamic linking modified for
+	modern linux.
+
+Sat Jan 22 17:58:55 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	From: ucs3028@aberdeen.ac.uk (Al Slater)
+	* makefile.acorn repl.c (set_erase): Port to acorn archimedes.
+	This uses Huw Rogers free unix function call library for the
+	archimedes - this is very very widely available and should pose no
+	problem to anyone trying to find it - its on every archimedes ftp
+	site.
+
+	From: hugh@cosc.canterbury.ac.nz (Hugh Emberson)
+	* dynl.c Link.scm: Dynamic Linking with SunOS.
+
+Thu Jan  6 22:12:51 1994    (jaffer at jacal)
+
+	* sys.c (gc_mark mark_locations): now externally callable.
+
+Sun Jan  2 19:32:59 1994    fred@sce.carleton.ca (Fred J Kaudel)
+
+	* unif.c (ra_matchp ramapc): patch to unif.c avoids two problems
+	(K&R C does not allow initialization of "automatic" arrays or
+	structures).  This was not use in 4d2 or previously, and the
+	following patch ensures that such initialization only occurs for
+	ANSI C compilers (Note that K&R C compilers need to explicitly
+	assign the values).
+
+Sat Dec 18 23:55:30 1993    (jaffer at jacal)
+
+	* scm.1 scm.doc (FEATURES): improved and updated manual page.
+
+	* repl.c (BRACKETS_AS_PARENS): controls whether [ and ] are read
+	as ( and ) in forms.
+
+Wed Dec  8 23:13:09 1993    rshouman@chpc.utexas.edu (Radey Shouman)
+
+	* unif.c: More array fixes and functions.
+
+Tue Dec  7 00:44:23 1993    (jaffer at jacal)
+
+	* dynl.c (dld_stub): removed since dld is working better on Linux.
+
+Wed Dec  1 15:27:44 1993    (jaffer at jacal)
+
+	* scm.h (SNAME): explicit cast added to get rid of compiler
+	warnings.
+
+	From: bh@anarres.CS.Berkeley.EDU (Brian Harvey)
+	* repl.c (repl) output newlines when more than one form on a line
+	for Borland C.
+
+	From: rshouman@chpc.utexas.edu (Radey Shouman)
+	* unif.c: More array fixes and documentation.
+
+Mon Nov 29 01:06:21 1993  rshouman@chpc.utexas.edu (Radey Shouman)
+
+	* unif.c: More array functions (need documentation).
+
+Sun Nov 28 01:34:22 1993    (jaffer at jacal)
+
+	* scm.h (SNAME): returns a pointer to nullstr if offset is 0.
+
+	* subr.c eval.c (make_synt make_subr): now check that offset from
+	heap_org hack works for each subr.  If not, 0 is used.
+
+	* Link.scm (compile-file): compiles SCM file to object suitable
+	for LOAD.
+
+	* Link.scm: initialization file created with Scheme code for
+	compilation and	linking.  LOAD now automatically loads SCM object
+	files.
+
+	* dynl.c Init.scm: dynamic linking now works under DLD on Linux.
+	Wb, crs, and sc2 can by dynamically loaded.
+
+Thu Nov 25 22:58:36 1993    (jaffer at jacal)
+
+	* sys.c (ltmpnam): return value of mktemp call tested in accord
+	with HP-UX documentation (returns "" on error).
+
+	* config.h (SYSCALLDEF): removed.  Macro I/O calls (getc, putc)
+	replaced with function versions.  Control-C interrupts should work
+	while pending input on all systems again.
+
+Tue Nov 23 01:18:35 1993    dorai@cs.rice.edu (Dorai Sitaram)
+
+	* repl.c sys.c time.c config.h: MWC (Mark Williams C) support.
+
+Sun Nov  7 10:58:53 1993    "Greg Wilson" <Greg.Wilson@cs.anu.edu.au>
+
+	* scm.c config.h (TICKS ticks tick-interrupt): if TICKS is
+	#defined, ticks and tick-interrupt work like alarm and
+	alarm-interrupt, but with units of evaluation rather than units of
+	time.
+
+Mon Nov  1 18:47:04 1993    (jaffer at jacal)
+
+	* unif.c (uniform-vector-ref => array-ref): integrated arrays
+	with uniform-vectors.  Strings, vectors, and uniform-vectors
+	now just special case of arrays (to the user).
+
+Fri Oct 29 01:26:53 1993    (jaffer at jacal)
+
+	* unif.c (rasmob tc16_array): arrays are now a smob.
+
+Thu Oct 28 01:21:43 1993    (jaffer at jacal)
+
+	* sys.c repl.c (igc gc_start): GC message gives reason for GC.
+
+Wed Oct 27 10:03:00 1993    (jaffer at jacal)
+
+	* config.h (SICP): flag makes (eq? '() '#f) and changes other
+	things in order to make SCM more compatible with Abelson and
+	Sussman's book.
+
+	* sys.c (gc_mark gc_sweep mark_locations): GC bug fixed.  GC from
+	must_malloc would collect the tc_free_cell already allocated.
+
+	* sys.c setjump.h (must_malloc must_realloc INIT_MALLOC_LIMIT):
+	modified to call igc when malloc usage exceeds mtrigger (idea from
+	hugh@ear.MIT.EDU, Hugh Secker-Walker).
+
+	From: Jerry D. Hedden
+	* pi.scm (bigpi): bignum version of pi calculator.
+
+Tue Oct 26 18:41:33 1993    (jaffer at jacal)
+
+	* repl.c (room): added procedure for printing storage statistics.
+
+Sun Oct 24 22:40:15 1993    (jaffer at jacal)
+
+	* config.h eval.c scl.c (STACK_LIMIT CHECK_STACK): added.
+	* sys.c (stack_check): added.
+
+Sat Oct 23 00:08:30 1993    (jaffer at jacal)
+
+	* sys.c (mallocated): added to keep track of non-heap usage.
+
+	* sys.c (igc): fixed interrupt vulnerabilities around gc.
+
+Sun Oct 17 13:06:11 1993    (jaffer at jacal)
+
+	* repl.c (exit_report): added.  Prints cumulative times if
+	(verbose > 2).  Called from free_storage().
+
+	* repl.c (repl): fixed CRDYP(stdin) BUG!  Transcripts should work
+	again.  Other annoying CR behaviour fixed.
+
+	* time.c (init_time your_base my_base): now not reset when
+	restarting so timing numbers for restarting are correct.
+
+	* scm.h (sys_protects): rearranged.
+	* sys.c (tmp_errp): now a statically allocated global variable,
+	used by init_storage and free_storage.
+	* scm.h sys.c (tc16_fport, tc16_pupe, tc16_strport, tc16_sfport):
+	now #defines (which must correspond to order of newptob calls).
+
+Sun Oct  3 20:38:09 1993  Bryan O'Sullivan  (bos@scrg.cs.tcd.ie)
+
+	* README.unix configure configure.in scmconfig.h.in
+	mkinstalldirs Makefile.in acconfig-1.5.h: SCM can now be built
+	using GNU autoconf.  Put in scmconfig4c5.tar.gz
+
+Sun Oct  3 00:33:57 1993    (jaffer at jacal)
+
+	* MANUAL (bit-count bit-position bit-set*! bit-count*
+	bit-invert!): (from unif.c) are now documented.
+
+	* sys.c (fixconfig): added 3rd argument to distinguish between
+	setjump.h and config.h.
+	* setjump.h config.h: moved IN_SYS stuff from config.h to
+	setjump.h.
+	* config.h (HAVE_CONFIG_H): User config preferences now taken
+	from "scmconfig.h" if HAVE_CONFIG_H is defined.
+	* config.h (EXIT_SUCCESS EXIT_FAILURE): fixed for VMS.
+
+Sat Oct  2 00:34:38 1993  rshouman@hermes.chpc.utexas.edu (Radey Shouman)
+
+	* unif.c repl.c: added read and write syntax for uniform vectors.
+	* unif.c (uniform-vector->list list->uniform-vector): created.
+	* time.c (time_in_msec): conditionalized for wide range of CLKTCK
+	values.
+	* config.h (BITSPERDIG POINTERS_MUNGED)
+	* scm.h (PTR2SCM SCM2PTR)
+	* scl.c (DIGSTOOBIG)
+	    Ported SCM to Unicos, the Cray operating system.
+
+	From: schwab@ls5.informatik.uni-dortmund.de (Andreas Schwab)
+	* scl.c (dblprec): set from DBL_DIG, if available.
+
+Fri Oct  1 21:43:58 1993    (jaffer at jacal)
+
+	* unif.c (bit-position): now returns #f when item is not found.
+	Now returns #f when 3rd argument is length of 2nd argument
+	(instead of error).
+
+Fri Sep 24 14:30:47 1993    (jaffer at jacal)
+
+	* sys.c (free_storage): fixed bug where growth_mon was being
+	called after the port cell had been freed.  gc_end now also
+	called at end.
+
+Tue Sep 21 23:46:05 1993    (jaffer at jacal)
+
+	* Init.scm scm.c: Restored old command line behaviour (loading all
+	command line arguments) for case when first command line argument
+	does not have leading `-'.
+
+	* sys.c (mode_bits): abstracted from open_file and mksfpt.
+
+	* scm.h (*FPORTP): series of predicates added for operations which
+	only work on some fports.
+
+	* sys.c crs.c: ungetc removed from ptobfuns structure and
+	soft-ports.
+
+Mon Sep 20 23:53:25 1993    (jaffer at jacal)
+
+	* sys.c (make-soft-port): Soft-ports added, allowing Scheme
+	i/o extensions.
+
+Sun Sep 19 22:55:28 1993    (jaffer at jacal)
+
+	* 4c4: released.
+	* Init.scm scm.c scm.1: command line proccessing totally
+	rewritten.  Thanks to Scott Schwartz
+	<schwartz@groucho.cs.psu.edu> for help with this.
+
+Mon Sep 13 21:45:52 1993  pegelow@moorea.uni-muenster.de (Ulrich Pegelow)
+
+	* scl.c (add1): finally a way to fool optimizing gcc to not use
+	extra precision registers.
+
+Sun Sep 12 18:46:02 1993    (jaffer at jacal)
+
+	* sys.c (pwrite): added to stubbify fwrite to fix bug on VMS.
+	* config.h: moved flags to top per suggestions from Bryan
+	O'Sullivan (bos@scrg.cs.tcd.ie).
+
+Fri Sep 10 11:42:27 1993    (jaffer at jacal)
+
+	* repl.c config.h (EXIT_SUCCESS EXIT_ERROR): added.  Values
+	returned by SCM program.
+
+Thu Sep  9 13:09:28 1993  Vincent Manis <manis@cs.ubc.ca>
+
+	* sys.c (stwrite init_types add_final): fixed declarations.
+
+Mon Sep	 6 16:10:50 1993  Bryan O'Sullivan  (bos@scrg.cs.tcd.ie)
+
+	* README: changed the build and installation instructions to bring
+	them up to date with reality.
+
+Sun Sep	 5 23:08:54 1993  Bryan O'Sullivan  (bos@scrg.cs.tcd.ie)
+
+	* Wrote autoconf script to support GNU Autoconf configuration
+	to make scm easier to build.
+
+	* Created Makefile.in; a radical overhaul of Makefile to remove
+	some of the brokenness and allow cross-compilation and use of
+	autoconf.
+
+Sat Sep  4 23:00:49 1993    (jaffer at jacal)
+
+	* 4c3: released.
+	* sys.c (grow_throw): removed use of memset for SPARC machines.
+
+Sat Sep  4 18:09:59 1993  Bryan O'Sullivan  (bos@scrg.cs.tcd.ie)
+
+	* time.c: added SVR4 to the list of LACK_FTIME systems, because
+	most all SVR4 BSD-compatibility stuff is a total mess.
+
+	* config.h: changed definition of STDC_HEADERS so it does the
+	Right Thing on systems which run GCC but don't have header files
+	with prototypes.
+
+	* makefile.unix: added a note for SVR4 users.
+
+Tue Aug 31 18:30:53 1993    (jaffer at jacal)
+
+	* eval.c (m_define): if verbose >= 5 warnings are issued for all
+	top-level redefinitions.
+
+Mon Aug 30 16:24:26 1993    (jaffer at jacal)
+
+	* scm.c sys.c (finals num_finals add_final): Finalization calls
+	now dynamically, incrementally, defined.
+
+Thu Aug 26 12:38:27 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* 4c2: fixed declaration problems in PTOB with K&R C.
+
+Sun Aug 22 23:02:51 1993    (jaffer at jacal)
+
+	* split.scm: code which directs input, output, and diagnostic
+	output to separate windows (using curses functions defined in
+	crs.c).
+
+Sat Aug 21 16:46:33 1993    (jaffer at jacal)
+
+	* Init.scm (output-port-height): added if not already defined.
+	output-port-width also made conditional.
+
+	* sys.c (tc16_strport): string ports created.
+
+Thu Aug 19 11:37:07 1993    (jaffer at jacal)
+
+	* sys.c (init_types): freecell, floats, and bignums now have SMOB
+	entries.  gc_sweep and gc_mark still inline codes for bignums and
+	floats.
+
+	* sys.c repl.c code.doc: Ports now an extensible type.
+	Indirection suggested by Shen <sls@aero.org>.
+
+Mon Aug 16 01:20:26 1993    (jaffer at jacal)
+
+	* crs.c: curses support created.
+
+Sun Aug 15 16:56:36 1993    (jaffer at jacal)
+
+	* rgx.c sys.c (mark0 equal0): mark0 moved to sys.c.  equal0
+	created.
+
+Fri Jun 25 01:16:31 1993    (jaffer at jacal)
+
+	* QUICKREF: added.
+
+Tue Jun 22 00:40:58 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* repl.c (ungetted): replaced with CRDYP(stdin) to fix recently
+	introduced transcript bug.
+
+Sun Jun 20 22:29:32 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* config.h (NOSETBUF): setbuf() now conditionalized on NOSETBUF.
+
+	* Init.scm (defmacro): now copies the results of macro expansion
+	in order to avoid capture of memoized code by macros like:
+	(defmacro f (x) `(list '= ',x ,x)).
+
+Wed Jun  2 23:32:05 1993  Aubrey Jaffer  (jaffer at caddr)
+
+	* eval.c (map for-each): now check that arguments are lists.
+
+Mon May 31 23:05:19 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* Init.scm (trace untrace): now defmacros which handle (trace) and
+	(untrace) as in Common Lisp.
+
+Wed May  5 01:17:37 1993  Roland Orre  <orre@sans.kth.se>
+
+	* all: internal output functions now take SCM ports instead of
+	FILE* in preparation for string-ports.
+
+Tue May  4 17:49:49 1993  Aubrey Jaffer  (jaffer at wbtree)
+
+	* makefile.unix (escm.a): created scm "ar" file and used for
+	dbscm.
+
+Sun Apr 25 21:35:46 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* sys.c (free_storage): i++ moved out of CELL_* in response to:
+From: john kozak <jkozak@cix.compulink.co.uk>
+Minor bug report: around line 10 of routine "free_storage" you do calls
+to CELL_UP and CELL_DOWN with arguments having side-effects: with the
+PROT386switch defined in config.h these args are evaluated twice...
+
+Sun Apr 11 22:56:19 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* eval.c (IM_DEFINE): added.  Internal defines are no longer
+	turned into LETRECS.
+
+Wed Apr  7 13:32:53 1993  Jerry D. Hedden <HEDDEN@ESDSDF.dnet.ge.com>
+
+	* scl.c (idbl2str): fix for bug introduced by removing +'s.
+
+Tue Mar 23 15:37:12 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* scl.c (idbl2str): now prints positivie infinity as +#.# again
+	(instead of #.#).
+
+Mon Mar 22 01:38:02 1993  Aubrey Jaffer  (jaffer at montreux)
+
+	* subr.c (quotient): renamed to lquotient to avoid conflict with
+	HP-UX 9.01.
+
+Fri Mar 19 01:21:08 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* sys.c repl.c: #ifndef THINK_C #include <sys/ioctl.h>
+	* time.c (lstat): #ifndef THINK_C. ThinkC 5.0.1 lacked.
+
+Mon Mar 15 23:35:32 1993  jhowland@ariel.cs.trinity.edu (Dr. John E. Howland)
+
+	* scl.c (idbl2str iflo2str big2str): leading + eliminated on
+	output and number->string.
+
+Wed Mar 10 00:58:32 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* repl.c scm.h (CRDYP CLRDY CGETUN CUNGET): cleaned up ungetc hack.
+
+	* scm.c repl.c (exec): added.
+
+Sun Mar  7 22:44:23 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* repl.c (def_err_response): now will print errobjs if they are
+	immediates, symbols, ports, procedures, or numbers.
+
+Fri Mar  5 23:15:54 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* repl.c (repl): now gives repl_report() for initialization.
+
+	* Init.scm (defvar): added.
+
+	From: Roland Orre  <orre@sans.kth.se>
+	* repl.c (lungetc): no longer calls ungetc.  Fixed problem that
+	many systems had with ungetc on unbuffered ports (setbuf(0)).
+
+Thu Mar  4 13:51:12 1993  Stephen Schissler
+
+	* makefile.wcc: Watcom support added.
+
+Wed Mar  3 23:11:08 1993  Aubrey Jaffer  (jaffer at montreux)
+
+	* sys.c scm.h (dynwinds): made a sys_protect.
+
+Mon Feb 15 11:30:50 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* Init.scm (defmacro macroexpand macroexpand1 macro? gensym):
+	added.
+
+	* repl.c (stdin): setbuf not done for __TURBOC__==1.
+
+	* makefile.bor: now has method to build turtegr.exe.
+
+	* eval.c (ceval): Memoizing macros now can return any legal Scheme
+	expression.
+
+Sat Feb 13 18:01:13 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* subr.c (mkbig adjbig): now check for bignum size.
+
+	* Init.scm: reorganized so site-specific information is at the
+	head.
+
+	* repl.c (errno): changed from set-errno now returns value.
+
+	* subr.c (intexpt): now handles bignum exponents.
+
+	From: "David J. Fiander" <davidf@golem.waterloo.on.ca>
+	* time.c makefile.unix subr.c: SCO Unix and XENIX patches.
+
+Fri Feb 12 22:18:57 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* Init.scm (WITH-INPUT-FROM-PORT WITH-OUTPUT-TO-PORT
+	WITH-ERROR-TO-PORT): added.
+
+	* subr.c (ash): fixed for case (ash 2 40) where INUM arguments
+	make a bignum result.
+
+	* repl.c (lreadr): \ followed by a newline in a string is ignored.
+
+	From: Scott Schwartz <schwartz@groucho.cs.psu.edu>
+	* repl.c (lreadr): Can now read \0\f\n\r\t\a\v in strings.
+
+Thu Feb 11 01:25:50 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* Init.scm (with-input-from-file with-output-to-file
+	with-error-to-file): now use dynamic-wind.
+
+Sun Feb  7 22:51:08 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* eval.c (ceval): fixed bug with non-memoizing macro returning an
+	IMP.
+
+Sat Feb  6 01:22:27 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* (current-error-port with-error-to-file): add.
+
+Fri Feb  5 00:51:23 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* time.c (stat): added.
+
+	From: rnelson@wsuaix.csc.wsu.edu (roger nelson)
+	* dmakefile: support for DICE C on Amiga.
+
+Thu Feb  4 01:55:30 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* sys.c (open-file) makes unbuffered if isatty.
+
+	* repl.c (char-ready?) added.
+
+Mon Feb  1 15:24:18 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* subr.c (logor): changed to LOGIOR to be compatible with common
+	Lisp.
+
+	* eval.c (bodycheck): now checks for empty bodies.
+
+Sun Jan 31 01:01:11 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* time.c (get-universal-time decode-universal-time): now use
+	bignums.
+
+Tue Jan 26 00:17:06 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* sys.c (mark_locations): now length argument in terms of
+	STACKITEM.  Does both alignments in one pass.
+
+Mon Jan 25 12:13:40 1993  soravi@Athena.MIT.EDU
+
+	* makefile.emx: for OS/2
+
+Sun Jan 24 18:46:32 1993  stevev@miser.uoregon.edu (Steve VanDevender)
+
+	* scl.c (big2str): now faster because it divides by as many 10s as
+	fit in a BIGDIG.
+
+Sat Jan 23 00:23:53 1993  stevev@miser.uoregon.edu (Steve VanDevender):
+
+	* config.h (INUM MAKINUM): shift optimization for TURBOC.
+
+Fri Jan 22 00:46:58 1993  hanche@ams.sunysb.edu (Harald Hanche-Olsen)
+
+	* unif.c (uniform-vector?): added.
+
+Tue Jan 19 00:27:04 1993  stevev@miser.uoregon.edu (Steve VanDevender)
+
+	* subr.c scl.c config.h: bignum bug fixes for MSDOS.
+
+Mon Jan 18 01:15:24 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* subr.c (ash lognot intlength logcount bitextract): now handle
+	bignums.
+
+Sun Jan 17 10:42:44 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* sys.c (close_port): can now close pipes as well.
+
+	* subr.c (adjbig normbig divide quotient): fixed more divide bugs.
+
+	* subr.c (even? odd?): fixed problem with bignums.
+
+Sat Jan 16 00:02:05 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* subr.c (divbigbig): Fixed last divide bug?
+
+Fri Jan 15 00:07:27 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* rgx.c (regmatch?): added.  Debugged for both HP-UX and GNU
+	regex-0.11.  Documentation added to MANUAL.
+
+Thu Jan 14 11:54:52 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* patchlvl.h (SCMVERSION): moved from config.h.
+
+	* scl.c (product): fixed missing {} bug.
+
+	From: HEDDEN@esdsdf.dnet.ge.com
+	* scl.c (lmin lmax) bignum versions.
+
+Wed Jan 13 01:40:51 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* released scm4b0.
+
+	* subr.c: fixed bignum bugs found by jacal.
+
+	* code cleanup.
+
+	From: HEDDEN@esdsdf.dnet.ge.com
+	* subr.c (lgcd quotent modulo lremainder): Bignum versions.
+	* subr.c (divbigbig): new version.
+
+Sun Jan  3 00:29:35 1993  stevev@miser.uoregon.edu (Steve VanDevender)
+
+	* Re-port to BorlandC v2.0
+
+	* sys.c (must_realloc): added
+
+	* config.h subr.c (BIGRAD pseudolong): now insensitive to ratio of
+	sizeof(long)/sizeof(BIGDIG).
+
+Mon Dec 21 23:20:47 1992  Aubrey Jaffer  (jaffer at camelot)
+
+	From: Scott Schwartz <schwartz@groucho.cs.psu.edu>
+	* rgx.c: created SCM interface to regex and regexp routines.
+
+	From: HEDDEN@esdsdf.dnet.ge.com
+	* subr.c scl.c: Now just one mulbigbig and addbigbig routine.
+
+	from: soravi@Athena.MIT.EDU
+	* README: directions for compiling SCM under OS/2 2.0.
+
+Wed Dec  9 15:34:30 1992  Aubrey Jaffer  (jaffer at camelot)
+
+	* eval.c (tc7_subr_2x): eliminated.  All comparison subrs now
+	rpsubrs.
+
+	* scm.h: Changed SUBR numbers.  This improves HP-UX interpretation
+	speed (why?).
+
+	* eval.c (PURE_FUNCTIONAL): removed.  Can now be done in
+	initialization code.
+
+	* eval.c (tc7_rpsubr): added type for transitive comparison
+	operators.  Suprisingly, this slows down (pi 100 5).
+
+Mon Dec  7 16:15:47 1992  Aubrey Jaffer  (jaffer at camelot)
+
+	* subr.c (logand logor logxor lognot ash logcount integer-length
+	bit-extract): added.
+
+	From: HEDDEN@esdsdf.dnet.ge.com
+	* scl.c: lots more numeric improvements and code reductions.
+
+Mon Nov 30 12:25:54 1992  Aubrey Jaffer  (jaffer at camelot)
+
+	* scm.h (IDINC ICDR IDIST): enlarged depth count in ILOCs.
+
+Sun Nov 29 01:10:18 1992  Aubrey Jaffer  (jaffer at camelot)
+
+	* subr.c scl.c: most arithmetic operations will now return
+	bignums.
+
+	* config.h (FIXABLE POSFIXABLE NEGFIXABLE): added.
+
+	* sys.c (object-hash object-unhash): now use bignums.
+
+	* scl.c (big2str istr2int): bignum i/o implemented.
+
+	* unif.c: subr2s were incorrectly initialized as lsubr2s.
+
+Tue Nov 24 14:02:52 1992  Aubrey Jaffer  (jaffer at camelot)
+
+	* eval.c (ceval): added unmemocar calls to error handling when
+	possible.
+
+	* scl.c (idbl2str): added back NAN and infinity support.
+
+	* eval.c (syntax_mem): replaced with individual macros.
+	* eval.c (procedure->syntax procedure->macro
+	procedure->memoizing-macro): All syntactic keywords are now
+	tc7_symbol.  User definable macros added.
+	* sys.c: ISYMs no longer in symhash.  ISYMs cannot be read.
+	init_isyms merged into init_eval.
+
+Sat Nov 21 00:39:31 1992  Aubrey Jaffer  (jaffer at camelot)
+
+	* makefile.unix (check): now exits with error code.
+
+	* sys.c (init_isyms): eliminated.  ISYMS now inited in init_eval.
+
+Fri Nov 20 16:14:06 1992  Aubrey Jaffer  (jaffer at camelot)
+
+	* released scm4a13
+
+	* repl.c: longjmps now dowinds() first.
+
+	* setjump.h: now has all setjmp related definitions.
+
+	* Init.scm (trace untrace): use new macro system.
+
+	* eval.c (defined? procedure->macro procedure->memoizing-macro
+	make_synt): macro system added.  defined? uses it.
+
+	From: HEDDEN@esdsdf.dnet.ge.com
+	* scl.c: fixes for several transcendental functions.
+
+Thu Nov 19 01:14:38 1992  Aubrey Jaffer  (jaffer at camelot)
+
+	* repl.c sys.c: errjmp replaced with JMPBUF(rootcont).
+
+Sun Nov 15 01:49:00 1992  HEDDEN@esdsdf.dnet.ge.com
+
+	* scl.c (istr2int istr2flo istring2number string2number): new
+	versions.
+
+Thu Nov 12 23:00:04 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* Init.scm (load): now prints out actual filename found in mesasge
+	;done loading ...
+
+Wed Nov 11 01:01:59 1992  Aubrey Jaffer  (jaffer at camelot)
+
+	* repl.c (def_err_response): ARG1 error with errobj==UNDEFINED
+	becomes WNA error.
+
+	From: HEDDEN@esdsdf.dnet.ge.com (Jerry D. Hedden)
+	* scl.c (difference divide): Now are asubrs.
+
+	* Init.scm (*features*): fixed to correspond to SLIB conventions.
+
+Mon Nov  9 12:03:58 1992  Aubrey Jaffer  (jaffer at camelot)
+
+	* scl.h test.scm: (string->number "i") and "3I" and "3.3I" fixed
+	to return #f.  Tests added to test.scm.
+
+Fri Nov  6 16:39:38 1992  Aubrey Jaffer  (jaffer at camelot)
+
+	* scm.h (rootcont): sysprotect added.
+
+	From: Vincent Manis <manis@cs.ubc.ca>
+	* scm.h: __cplusplus prototype support.
+
+Thu Nov  5 00:39:50 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* eval.c (lookupcar): now checks for UNDEFINED in local bindings
+	becuase LETREC inits to UNDEFINED.
+
+	* sys.c (dynamic-wind): added.
+
+	* config.h eval.c (ceval): CAUTIOUS mode added.
+
+	From: hugh@ear.MIT.EDU (Hugh Secker-Walker)
+	* eval.c (ceval): internal defines now transformed to letrecs.
+
+Sun Oct 25 12:27:23 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* repl.c (read-line read-line!): created.
+
+Sat Oct 24 18:36:23 1992  Aubrey Jaffer  (jaffer at camelot)
+
+	* repl.c (lreadparen): now tail-recursive.
+
+	* eval.c (copy-tree eval): added.  dummy_cell replaced with a
+	cons(obj,UNDEFINED).
+
+Thu Oct 22 21:26:53 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* repl.c (set-errno!): changed to set-errno.
+
+Thu Oct 15 00:49:20 1992  Aubrey Jaffer  (jaffer at camelot)
+
+	* sys.c (must_free): must_free created.  Pointers are set to 0.
+	It detects objects being freed twice.
+
+Wed Oct 14 23:57:43 1992  Aubrey Jaffer  (jaffer at camelot)
+
+	* scm.c (run_scm): Now has INITS and FINALS.
+
+	* scm.c (init_signals ignore_signals unignore_signals
+	restore_signals): siginterrupt() for ultix.
+
+Fri Oct  9 14:25:06 1992  Aubrey Jaffer  (jaffer at camelot)
+
+	* all: put in explicit casts to (unsigned char *) and (long) to
+	satisfy lint.
+
+	* sys.c (gc): all to gc_end was during deferred interrupts,
+	causing problems with verbose=3 and interrupts during GC.
+
+	* config.h(SYSCALLDEF): fixed so that test on errno occurs before
+	ALLOW_INTS (and possible call to user code).
+
+Sun Oct  4 01:45:25 1992  Aubrey Jaffer  (jaffer at camelot)
+
+	* eval.c (syntax_mem): removed gratuitous cons.
+
+	* eval.c repl.c scm.h: Reduced static string use.  Added peephole
+	optimizations for AND and OR.
+
+	From: hugh@ear.MIT.EDU (Hugh Secker-Walker)
+	* eval.c repl.c scm.h (syntax_mem):  syntax forms are now memoized
+	so that syntax checks are done only once.  Interpreter is now
+	smaller and faster and uses less stack space.  Modifications to
+	code are now made under DEFER_INTS as they always should have
+	been.
+
+Wed Sep 30 22:06:24 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* scl.c subr.c scm.h config.h: Started adding bignum code.
+
+Sun Sep 27 22:59:59 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* repl.c (restart): added.
+
+	* sys.c (freeall): finished.
+
+	* scm.h (tc7_symbol): split into tc7_ssymbol and tc7_msymbol to
+	distinguish between non-GCable and GCable symbols.
+
+Wed Sep 23 00:36:23 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* repl.c (peek_char lungetc): added workaround for TURBOC 1.0
+	problem with ungetc inside SYSCALLDEF macro.
+
+	* repl.c (iprin1): uses ttyname for #<stream ..> if available.
+
+	* Init.scm: now sets verbose to 0 if stdin or stdout is not a tty.
+
+	* repl.c (isatty?): added.
+
+	* repl.c (verbose): levels bumped up by 1.  verbose == 0 means no
+	prompt.
+
+	* makefile.djg config.h (GNUDOS -> GO32): flags changed for djgpp108.
+
+Wed Aug 26 21:46:26 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* test.scm: put in (test #f < 1 3 2) and (test #f >= 1 3 2).
+
+	* scl.c (leqp greqp): put back in.  (not (< 1 3 2)) does not imply
+	(>= 1 3 2).
+
+	* makefile.unix: tar and shar files now created in subdirectory.
+
+	* config.h time.c: Linux support added.
+
+	* repl.c: Greatly improved VMS interrupt support.
+
+	* eval.c (ceval): I_LET now changes to I_LETSTAR for single clause
+	unnamed lets.y
+
+	* (tc7_lsubr_2n): removed.
+
+Fri Jul 31 00:24:50 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* unif.c (bit-position): fixed;  I am sure I had done these
+	changes before.  Also corrected some error messages.
+
+	From: campbell@redsox.bsw.com (Larry Campbell)
+	* scm.h subr.c sys.c (equalp): smobfuns now include equalp.
+
+Mon Jul 20 16:44:30 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	From: Stephen Adams <S.R.Adams@ecs.southampton.ac.uk>
+	* eval.c scm.h subr.c (BOOL_NOT) macro added to fix ^ bug in
+	BorlandC.  This was fixed previously as well.
+
+	From: campbell@redsox.bsw.com (Larry Campbell)
+	* unif.c (vector-set-length!): was always typing to tc7_vector.
+
+Sat Jul 18 01:07:33 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* subr.c sys.c (make_vector init_storage resizuve): mallocs and
+	reallocs are now always > 0.
+
+	* time.c (get_univ_time): bypassed mktime() for (__TURBOC__ == 1).
+
+Mon Jul 13 22:27:04 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* repl.c (lreadr): now ignores first line of port if begins with "#!"
+
+	* scl.c (lesseqp greqp): removed; changed to use tc7_lsubr_2n.
+
+	* scm.h eval.c (tc7_lsubr_2n): type added.  Other subr types
+	rearranged.
+
+Sat Jul 11 23:47:18 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* scm.h sys.c repl.c eval.c code.doc (newsmob smobs smobfuns): now
+	support	dynamically added smob types.  Promises moved to eval.c.
+	Promises and arbiters are now newsmobs.
+
+	* makefile.unix repl.c scl.c (floprint): moved from repl.c to
+	scl.c.  The only files which care about -DFLOATS are now scl.c,
+	eval.c, scm.c, and unif.c.
+
+	* sys.c scm.h (init_storage): now uses variable num_protects
+	instead of #define NUM_PROTECTS.
+
+Tue Jul  7 00:00:57 1992  Ulf_Moeller@hh2.maus.de (Ulf Moeller)
+
+	* Init.scm config.h makefile.prj: support for the ATARI-ST with
+	Turbo C added.
+
+Tue Jun 30 23:45:50 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* unif.c (make-uniform-vector uniform-vector-set!
+	uniform-vector-ref): added.
+
+Tue Jun 23 11:49:13 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* scm.h sys.c code.doc: rearranged tc7 codes and added bvect,
+	ivect, uvect, fvect, dvect, cvect, and cclo.
+
+	* scm.h sys.c eval.c repl.c code.doc: Changed symbols to be
+	tc7_symbol.
+
+Sat Jun  6 22:27:40 1992  campbell@redsox.bsw.com (Larry Campbell)
+
+	* scl.c (divide): divide by 0 and Exact-only divides of non
+	multiples now cause exception in RECKLESS mode.
+
+Wed May 27 16:02:58 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* config.h scl.c (NUMBUFLEN): split into INTBUFLEN and FLOBUFLEN
+	and made proportional to size of numeric types.
+
+	From: fred@sce.carleton.ca (Fred J Kaudel)
+	* makefile.ast scm.c Init.scm: minor chages for ATARI ST support.
+
+	* test.scm (test-inexact): created.
+
+Thu May 21 11:43:41 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* patchlvl.h (PATCHLEVEL): 5
+
+	From: hugh@ear.mit.edu (Hugh Secker-Walker)
+	* config.h: better wording for heap allocation strategy
+	explanation.
+
+Wed May 20 00:31:18 1992  S.R.Adams@ecs.southampton.ac.uk
+
+	* subr.c (stci_leqp st_leqp): reversed order of ^ clauses to avoid
+	Borland 3.0 bug.
+
+	* sys.c (gc_sweep): missing i-=2; added when splicing out segment.
+
+	* MANUAL time.c (get-universal-time decode-universal-time): half
+	hearted attempt to add these.  Needs bignums.
+
+Wed May 13 14:01:07 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* sys.c (gc_mark): improved tail recursivness for CONSes.
+
+	* repl.c (growth_mon): now prints out the hplims table if
+	verbose>3.
+
+	* sys.c (init_heap_seg): Serious bug in growing hplims fixed.
+	num_heap_segs eliminated; hplims are realloced whenever grown.
+
+Tue May 12 15:36:17 1992  Aubrey Jaffer  (jaffer at train)
+
+	* config.h sys.c (alloc_some_heap expmem):  expmem captures
+	whether the INIT_HEAP_SIZE allocation was successful.  If so,
+	alloc_some_heap uses exponential heap allocation instead of
+	HEAP_SEG_SIZE.
+
+Mon May 11 15:29:04 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* sys.c (gc_sweep init_heap_seg heap_org): Empty heap segments
+	are now freed.
+
+	* sc2.c (STR_EXTENSIONS): renamed REV2_PROCEDURES and R2RS and
+	R3RS functions put into sc2.c.
+
+Sun May 10 01:34:11 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* scm.c (ignore_interrupts unignore_interrupts): added for
+	system, edt$edit, and popen to use.
+
+	* repl.c (lwrite display newline write_char): Close pipe if EPIPE.
+
+	* repl.c (file_set_position): now errs on ESPIPE.
+
+	* scm.c (SIGPIPE): now ignored (errs come back as EPIPE).
+
+Sat May  9 17:52:36 1992  Stephen Adams <S.R.Adams@ecs.southampton.ac.uk>
+
+	* config.h (PROT386): PROT386 added.  PTR_LT and CELL_UP modified.
+
+Fri May  8 17:57:22 1992  hugh@ear.mit.edu (Hugh Secker-Walker)
+
+	* Init.scm (last-pair append!): last-pair is faster version.
+	Append! corrected for null first arg.  (getenv "HOME") now gets
+	a "/" added if not present.
+
+	* config.scm (MIN_GC_YIELD): now proportional to HEAP_SEG_SIZE.
+
+	* README: setting environment variables corrected.
+
+	* subr.c (length): error message now has arg if not a list.
+
+	* sys.c (open-pipe): now turns off interrupts before forking.
+
+	* scl.c (lsystem): now turns off interrupts before forking.
+
+	* scm.c (ignore_signals): created.
+
+Sat May  2 01:02:16 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* Init.c (WITH-INPUT-FROM-FILE WITH-OUTPUT-TO-FILE): defined in
+	terms of current-input-port and current-output-port.  Bug in
+	open-input-pipe and open-output-pipe fixed.
+
+	* sys.c repl.c (current-input-port current-output-port): moved
+	from sys.c to repl.c.  set-current-input-port and
+	set-current-output-port added to repl.c.
+
+Mon Apr 13 22:51:32 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* patchlvl.h: (PATCHLEVEL): released scm4a1.
+
+	* makefile.* VMSBUILD.COM VMSGCC.COM: compile time.h.
+
+	* scm.c (alrm_signal int_signal): now save and restore errno so
+	SYSCALL will work correctly across interrupts.
+
+Sun Apr 12 01:44:10 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* patchlvl.h: (PATCHLEVEL): released scm4a0.
+
+	* repl.c (lread): tok_buf now local to each invocation of read.
+	This makes READ interruptable and reentrant.
+
+	* sys.c MANUAL (STRING-SET-LENGTH! STRING-VECTOR-LENGTH!): created.
+
+	* sys.c repl.c (grow_tok_buf tok_buf tok_buf_len): moved to repl.c
+
+	* repl.c (lfwrite): now emulated for VMS.
+
+	* repl.c scl.c (num_buf): now local to all routines that use it.
+
+	* time.h: created by moving time functions from repl.c.  Read and
+	write functions were moved from sys.c to repl.c.
+
+	* sys.c repl.c (DEFER_INTS ALLOW_INTS CHECK_INTS): totally
+	rewritten.  SIGALRM and SIGINT now execute at interrupt level.
+	Interrupts deferred only for protected code sections, not for
+	reads and writes.
+
+	* sys.c repl.c (SYSCALL): created to reexecute system calls
+	interrupted (EINTR) by SIGALRM and SIGINT.
+
+	* sys.c scl.c (flo0): 0.0 is now always flo0.
+
+	* repl.c sys.c (TRANSCRIPT-ON TRANSCRIPT-OFF): added.  This
+	required shadowing putc, fputs, fwrite, and getc with lputc,
+	lputs, lfwrite, and lgetc.
+
+Sun Apr  5 00:27:33 1992  HEDDEN@esdsdf.dnet.ge.com (Jerry D. Hedden)
+
+	* scl.c (eqp lessp greaterp lesseqp greatereqp):
+	Comparisons with inexact numbers was not being performed
+	correctly.  For example, (< 1.0 2.0 1.5) would yield #t.  What was
+	missing was a line x=y; in the inexact comparison sections of
+	lessp(), greaterp(), lesseqp() and greatereqp().  In addition, I
+	modified these routines and eqp() to allow for mixed arithmetic
+	types.
+
+Sat Apr  4 00:17:29 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* scm.h code.doc: tc7_bignum => tc7_spare.  Added tc16_bigpos and
+	tc16_bigneg.  SMOBS reordered.  tc16_record added.
+
+	* scm.h repl.c sys.c (make-arbiter try-arbiter release-arbiter):
+	added.  tc16_arbiter added.
+
+Fri Apr  3 01:25:35 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* sys.c config.h (TEMPTEMPLATE): created in config.h.
+
+	* scm.h: removed long aliases for C versions of Scheme functions.
+
+	* sys.c eval.c scm.h: (delay force makprom): added.  Also added
+	tc16_promise data type.
+
+	* Init.scm (trace untrace): added autoloads and read macros.
+
+	From: T. Kurt Bond, tkb@mtnet2.wvnet.edu
+	* sys.c (template): correct template for VMS.
+
+Tue Mar 31 01:50:12 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* sys.c config.h Init.scm (open-file open-pipe): created and
+	expressed other open functions in terms of.  Bracketed all i/o
+	system calls with DEFER and ALLOW _SIGINTS.
+
+Sat Mar 28 00:24:01 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* sys.c MANUAL (#.): read macro syntax added.  Balanced comments
+	also documented.
+
+Fri Mar 27 22:53:26 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* sys.c (iprin1): changed printed representation for unreadable
+	objects from #[...] to #<...>.
+
+	From: brh@aquila.ahse.cdc.com (brian r hanson x6009):
+	* scm.h config.h (NCELLP PTR_LT): fixes for 64 bit pointers on
+	nosve.
+
+Fri Mar 20 01:36:08 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* Released scm3c13
+
+	* code.doc: corrected some minor inconsistencies and added a
+	section "To add a package of new procedures to scm".
+
+Sun Mar 15 19:44:45 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* Init.scm: now loads <program-name>_INIT_PATH when <program-name>
+	is not "SCM".
+
+	* config.h (PTR_LT): (x < y) => ((x) < (y))
+
+Wed Mar  4 01:53:15 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* Released scm3c12.
+
+	* scm.h code.doc eval.c sys.c (IXSYM): Eliminated Immediate IXSYM
+	type.
+
+Tue Mar  3 00:58:18 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* eval.c config.c (ceval DEFINED? SYNTAX_EXTENSIONS): added
+	DEFINED? to ceval conditional on SYNTAX_EXTENSIONS.
+
+	From: Andrew Wilcox <andrew@astro.psu.edu>
+	* makefile.unix scm.c (main init_scm display_banner init_signals
+	restore_signals run_scm): RTL support.
+
+Mon Mar  2 19:05:29 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* subr.c (make-string): now checks for ARG1 >= 0.
+
+Fri Feb 28 00:13:00 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* patchlvl.h (PATCHLEVEL): 12
+
+	* Init.scm: loads JCAL if scm is invoked with name JCAL, JACAL,
+	jcal or jacal.
+
+	* Init.scm (ABS): set to MAGNITUDE if FLOATS are supported.
+
+	* gc_mark gc: no longer assume sizeof(short) == 2.
+
+	* config.h (CELL_UP CELL_DN): no longer assume sizeof(CELL) == 8.
+
+	From: Brian Hanson, Control Data Corporation.  brh@ahse.cdc.com
+	* scl.c config.h repl.c: partial port to Control Data NOS/VE.
+
+	From: fred@sce.carleton.ca (Fred J Kaudel)
+	* repl.c Init.scm makefile.ast: Port to Atari-ST
+
+	* sys.c scm.h eval.c (throw): renamed to lthrow to avoid conflict
+	with Gnu CC.
+
+Mon Feb 10 14:31:24 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* sys.c (delete-file rename-file): added.
+
+	* sys.c (chdir): now returns #f instead of error.
+
+	* Init.scm: Calls to PROVIDED? inlined so no longer dependent on
+	SLIB being loaded.  (set! ABS MAGNITUDE) if inexacts supported.
+	Support for slib1b3 added.
+
+	* sys.c (alloc_some_heap): fixed bugs.  One fix from
+	bowles@is.s.u-tokyo.ac.jp.
+
+	* eval.c (ceval):  fixed bug with internal (define foo bar) where
+	bar is a global.  Put badfun2: back in for better error reporting.
+
+	* patchlvl.h (PATCHLEVEL): 11
+
+Mon Jan 20 16:19:04 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* config.c (INITS): comments added.
+
+	From: T. Kurt Bond, tkb@mtnet2.wvnet.edu
+	* VMSGCC.COM VMSMAKE.COM: now take arguments.
+
+	From: "Fred Bayer" <bayerf@lan.informatik.tu-muenchen.de>
+	* makefile.aztec repl.c: Aztec C (makefile) port.
+
+Fri Jan 17 16:36:07 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* sys.c (gc init_storage stack_size): stack_size now of type
+	sizet.  init_storage no longer uses it.  gc() now uses it instead
+	of pointer to local.  This fixes bug with gcc -O.
+
+	* sys.c (cons cons2 cons2r):  &w;&x;&y; removed because of above
+	fix.
+
+Thu Jan 16 22:33:00 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* scl.c (real-part): added.
+
+Wed Jan 15 13:06:39 1992  "Fred Bayer" <bayerf@lan.informatik.tu-muenchen.de>
+
+	* scl.c repl.c scm.c config.c: Port for AMIGA
+
+	* scm.h (REALP): fixed for SINGLES not defined.
+
+Sat Jan 11 20:20:40 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* patchlvl.h (PATCHLEVEL): 8 released.
+
+	* README: added hints for EDITING SCHEME CODE.
+
+	* repl.c (SIGRETTYPE): now int for __TURBOC__.
+
+	* makefile.tur makefile.djg: created.
+
+	* config.h: DJGPP (__GO32__) support added.
+
+	* scm.h (memv): definition added.
+
+Sun Jan  5 00:33:44 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* repl.c makefile.* (main): INITS added.
+
+	* scl.c: fixed ASSERT statements with mismatched ARGn and
+	arguments.
+
+Thu Dec 19 19:16:50 1991  Aubrey Jaffer  (jaffer at train)
+
+	* sys.c (cons cons2 cons2r): added fix for gcc -O bug.
+
+	* repl.c (LACK_FTIME LACK_TIMES): more messing with these.
+
+	* sys.c config.o (HAVE_PIPE): created.
+
+	* config.h (FLT_RADIX): now #ifdef FLT_RADIX rather than __STDC__.
+	Needed for DJGCC.
+
+	* sys.c (DBLMANT_DIG DBL_FLOAT_DIG): now tested for directly
+	rather than STDC_INCLUDES.
+
+	* makefile.unix (subr.o): explicit compilation line added.
+
+	* scl.c (truncate -> ltrunc):  Name conflict with DJGCC libraries.
+
+Sun Dec  8 23:31:04 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* eval.c (apply): added check for number of args to closures.
+
+Sat Dec  7 01:30:46 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* patchlvl.h (PATCHLEVEL): 7
+
+	* sys.c (chdir): THINK_C doesn't support;
+
+	* repl.c: SVR2 needs <time.h> instead of <sys/time.h>
+
+	* repl.c: SVR2 needs LACK_FTIME
+
+	* repl.c: #include <sys/timeb.h> now automatic ifndef LACK_FTIME.
+
+Mon Dec  2 15:42:11 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* patchlvl.h (PATCHLEVEL): 5
+
+	* sys.c (intern sysintern): made strings and hash unsigned.  Fixed
+	bug with characters > 128 in symbols.
+
+	From: boopsy!mike@maccs.dcss.mcmaster.ca (Michael A. Borza)
+	* scl.c (eqv? memv assv): created if FLOATS is #defined.
+
+Mon Dec  2 11:37:11 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* patchlvl.h (PATCHLEVEL): 4
+
+	* sys.c (gc_sweep): usaage of pclose() now conditional on unix.
+
+	* MANUAL (chdir): documented.
+
+	From: T. Kurt Bond, Adminisoft, Inc. <tkb@MTNET2.WVNET.EDU>:
+
+	* repl.c sys.c (errno): VMS GNU C uses a special hack in <errno.h>
+	to get the link-time attributes for the errno variable to match
+	those the VMS C run-time library expects (it makes errno a
+	preprocessor define so that the variable that the compiler sees
+	has a special form that the assember then interprets), so if it is
+	VMS and __GNUC__ is defined <errno.h> needs included.
+
+	* setjump.h (SETJUMP LONGJUMP): SETJUMP and LONGJUMP changed to
+	setjump and longjump. The VMS linker is case-indifferent.  VMS GNU
+	C mangles variable names that have upper case letters in them to
+	preserve their uniqueness.
+
+	* sys.c (iprint iprin1): Now inline putc loops instead of calls to
+	fwrite for VMS. The VMS `fwrite' has been enhanced to work with
+	VMS's Record Management Sevice, RMS.  Part of this enhancement is
+	to treat each call to `fwrite' as producing a seperate record.
+	This works fine if you are writing to a stream_LF file or an
+	actual terminal screen, but if you are writing to a file that has
+	implied carriage control (such as a batch log file, or a mailbox
+	used for subprocess communication), which is a more common file
+	organization for RMS, each call to `fwrite' has a newline appended
+	to it.  This causes much of the output to be incorrectly split
+	across lines.
+
+	* vmsgcc.com: created.
+
+Sun Dec  1 00:33:42 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* patchlvl.h (PATCHLEVEL): 3 released.
+
+	* Init.scm (rev2-procedures): all now supported.
+
+	* Init.scm sys.c MANUAL (flush): flush changed to force-output to
+	be compatible with Common Lisp.
+
+	* sys.c (chdir): added.
+
+Wed Nov 27 09:37:20 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* patchlvl.h (PATCHLEVEL): 2
+
+	* repl.c (set-errno! perror): added.
+
+	* sys.c (gc): FLUSH_REGISTER_WINDOWS call added.
+
+	* sys.c (open-input-pipe open-output-pipe close-pipe): added.
+
+Mon Nov 25 13:02:13 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* patchlvl.h (PATCHLEVEL): 1
+
+	* sys.c (flush): added.
+
+	* repl.c (mytime): macro was missing ().  CLKTCK now defaults to 60.
+
+	From: Yasuaki Honda, honda@csl.SONY.co.jp,
+	* README Init.scm subr.c scm.c repl.c scl.c: support for
+	Macintosh running Think C.
+
+Sun Nov 24 15:30:51 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* scl.c (str2flo): fixed parsing of -1-i.
+
+	* subr.c (equal): Now correct for inexacts.  Need to do eqv.
+
+	* scm.h (REALPART): fixed pixel C compiler bug with doubles inside
+	`?' conditionals.
+
+	* scl.c (zerop): now checks imaginary half of complex number.
+
+	From: jjc@jclark.com
+	* repl.c (repl_driver): now checks that	s_response is non-NULL
+	before INTERNing.
+
+Tue Nov 19 00:10:59 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* version scm3c0
+
+	* documentation: changed revised^3.99 to revised^4.
+
+	* example.scm: created from Scheme^4 spec.
+
+	* makefile.msc: -Ox changed to -Oxp to fix over-enthusiastic float
+	optimizations.
+
+	* Init.scm (ed): defined.
+
+	* repl.c (def_err_response): UNDEFINED objects don't print out.
+
+Sun Nov 17 23:11:03 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* scl.c (vms-debug): now returns UNSPECIFIED.
+
+	* repl.c MANUAL (restart_repl): RESTART-REPL changed to ABORT.
+
+	* repl.c (err_ctrl_c):now clears sig_pending.
+
+Wed Nov 13 23:51:36 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* config.h: removed #ifdef sparc #define STDC_HEADERS
+
+	* makefile.bor: added extra '\' to filepath.
+
+	* repl.c (everr): fixed bug with ARGx.
+
+	* repl.c (errmsgs def_err_response): cleaned up error messages.
+
+Sun Nov 10 23:10:24 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* released scm3b7
+
+Mon Nov  4 18:36:49 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* patchlvl.h (PATCHLEVEL): 6
+
+	* sys.c (idbl2str): tests for Not-a-Number and Infinity added.
+
+	* repl.c scm.h: response system rewritten and integrated with
+	error system.
+
+	* scl.c (/): now returns inexacts if integer arguments do not
+	divide evenly.
+
+Mon Oct 28 23:44:16 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* makefile.unix: can now make float (scm) and integer-only (escm)
+	versions in same directory.
+
+	* repl.c (*sigint-response* *arithmetic-response* restart-repl):
+	responses for signals added.
+
+	* scl.c (lmin lmax sum difference product divide expt exp log):
+	now take mixed types.  expt available in non-FLOATS compilation.
+
+	* repl.c (get-decoded-time): added.  Includes and time functions
+	reorganized.
+
+	* sys.c (object-hash object-unhash): added.
+
+Tue Oct 15 00:45:35 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* repl.c Init.scm (*features*): moved constant features into
+	Init.scm.  Moved tests for numeric features to slib/require.scm.
+
+	* release scm3b1.
+
+	* config.h (ANSI_INCLUDES): redid include files.
+
+	* subr.c scl.c: moved all FLOAT conditionals from subr.c to scl.c.
+
+Wed Oct  9 00:28:54 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* release scm3a13.
+
+	* patchlvl.h (PATCHLEVEL): 13
+
+	* Init.scm: "vicinity.scm" changed to "require.scm"
+
+Mon Oct  7 00:34:07 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* test.scm: test of redefining built-in symbol and extra ')'
+	removed.
+
+	* scm.doc makefile.unix: scm.doc created from scm.1 in
+	makefile.unix.
+
+	* VMSBUILD.COM setjump.asm setjump.h (setjmp longjmp jmp_buf): put
+	in from comp.sources.reviewed in order to let VMS have full
+	continuations.  VMSBUILD.COM is a compile script.
+
+Fri Oct  4 00:05:54 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* scl.c(sleep): removed; not supported by MSC (although could be
+	written).
+
+	* scm.h config.h (size_t): moved to config.h.
+
+	* sys.c (f_getc): -> lgetc for vax, getc otherwise.
+
+	* patchlvl.h (PATCHLEVEL): 12
+
+Mon Sep 30 01:14:48 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* scl.c(sleep): created.
+
+	* repl.c(internal-time-units-per-second get=internal-run-time):
+	created
+
+	* repl.c: created from scm.c (shuffled around lots of functions).
+
+Sat Sep 28 00:22:30 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* scm.c config.h (char-code-limit most-positive-fixnum
+	most-negative-fixnum): created.
+
+Tue Sep 24 01:21:43 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* scm.c (software-type); created.
+
+	* scm.c config.h (terms, list-file, library-vicinity,
+	program-vicinity, user-vicinity, make-vicinity, sub-vicinity):
+	moved to Init.scm and library.
+
+	* scm.c config.h Makefile (PROGPATH): changed to IMPLPATH.
+
+	* Init.scm: created
+
+Fri Sep 20 13:22:08 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* patchlvl.h (PATCHLEVEL): 5
+
+	* all: changed declarations to size_t where appropriate.  scm.h
+	test preprocessor flag _SIZE_T to determine if already declared.
+	size_t should greatly enhance portability to Macintosh and other
+	machines.
+
+Tue Sep 17 01:15:31 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* scm.c (tmpnam): support for mktemp added.
+
+Mon Sep 16 14:06:26 1991  Aubrey Jaffer  (jaffer at train)
+
+	* scm.c (implementation-vicinity): added.  (program-vicinity) now
+	returns undefined if called not within a load.
+
+	* sys.c (call-with-io-file): removed.
+
+	* scm.c (tmpnam): added.
+
+	* scm.c config.h (tmporary-vicinity): removed.
+
+Sun Sep 15 22:21:30 1991  bevan@cs.man.ac.uk
+
+	* subr.c scm.h (remainder): renamed to lremainder to avoid
+	conflict with math.h on SunOS4.1.
+
+Sat Sep  7 22:27:49 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* scm.c (program-arguments load): program-arguments created.
+
+	* scm.c (getenv): added getenv and used for program-vicinity and
+	library-vicinity.
+
+	* scm.c (program-vicinity): fixed if load_name is NULL.
+
+	* scl.c config.h (substring-move-left! substring-move-right!):
+	added under STR_EXTENSIONS flag.
+
+Wed Aug 28 22:59:20 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* Sending scm3a to comp.sources.reviewed
+
+	* scm.c (main): prints out feature list at startup.
+
+	* subr.c (eqp lessp greaterp lesseqp greatereqp): now work for
+	floats.
+
+	* scl.c (sum difference divide product): moved to scl.c and
+	now work for floats.
+
+	* all: all masks with low bits explicity cast to (int).
+
+Sat Aug 17 00:39:06 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* sys.c subr.c scl.c (iint2str istr2int istring2number istr2flo
+	iflo2str idbl2str): number I/O and conversion to strings rewritten.
+
+	* sys.c (gc_mark): continuations now marked SHORT_ALIGNed. (from
+	Craig Lawson).
+
+	* added QuickC support from Craig Lawson.
+
+Tue Jul 30 01:08:52 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* config.h: #ifdef pyr added.
+
+	* scm.c MANUAL: vicinity functions added.
+
+Tue Jul 16 00:51:23 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* scl.c sys.c: float functions added.
+
+	* Documentation reorganized according to comp.sources.reviewed
+	guidelines.
+
+	* sys.c config.h (open_input_file open_output_file open_rw_file):
+	file mode string moved to defines in config.h
+
+Thu Jul 11 23:30:03 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* sys.c config.h (EBCDIC ASCII) moved to config.h
+
+	* subr.c config.h (BADIVSGNS) moved to config.h
+
+	* scm.h config.h (SRS) moved to config.h
+
+Sun Jul  7 23:49:26 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* all: started adding comp.sources.reviewed corrections and
+	suggestions.
+
+	* scm.c patchlvl.h (main): PATCHLEVEL now printed in banner.
+
+	* subr.c sys.c: read_integer removed. istring2number created.
+	lread and string2number now both use istring2number.
+
+Fri Jun  7 13:43:40 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* VERSION scm2e sent to comp.sources.reviewed
+
+	* public.lic: renamed COPYING.
+
+	* scm.c (gc_status): gc_status renamed prolixity.  Now returns old
+	value of verbose.  Can take 0 arguments.
+
+	* sys.c (lreadr): added #| common lisp style |# balanced comments.
+
+	* scm.h scm.c sys.c (I/O functions): combined **PORTP and OPENP to
+	become OP**PORTP.
+
+	* scm.h sys.c (gc_sweep): moved OPENP to bit in upper half word of
+	port cells.
+
+Sat May 25 00:04:45 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* scm.c (stack_start_ptr, repl_driver, main, err functions):
+	exits removed from all err functions.  all escapes through
+	repl_driver.
+
+	* scm.c README (verbose): Now has graded verbosity.
+
+	* scm.c README (quit): Now takes optional argument which is return
+	value.
+
+Wed May 22 01:40:17 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* code.doc scm.h eval.c (ceval): Rearanged immediate type codes to
+	create IXSYMs (immediate extension syms) to allow more than 15
+	special forms.  ILOCs now work with up to 32767 in one environment
+	frame.  Dispatch is slightly faster for ILOCs in function position.
+	ICHRs can be up to 24 bits.
+
+Fri May 10 00:16:32 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* scm.h sys.c (gc_mark, gc_sweep): GCMARK moved to bit 8 of CAR
+	for some datatypes.
+
+Wed May  1 14:11:05 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* patch1 MESSAGE SENT.
+
+	From: jclark@bugs.specialix.co.uk.jjc
+	* sys.c (lreadr): removed
+	order evaluation bug when growing tok_buf.
+
+Fri Apr 26 10:39:41 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* scm2d RELEASED
+
+	* sys.c (closure) no longer calls ilength (ECONS problem).  Added
+	ASSERT before call to closure in eval.
+
+Thu Apr 25 09:53:40 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* scm.c (error): created.
+
+Wed Apr 24 16:58:06 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* utils.scm: created.
+
+	* makefile (name8s): code from dmason works in makefile.
+
+	* eval.c (evalcar): fixed errobj on (else 3 4) error.
+	Inlined function application in (cond ((foo => fun))).
+
+	* sys.c (lprin1): change looped putcs to fwrite.
+
+Wed Apr 24 01:54:09 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* sys.c (lreadr): fixed assert for "eof in string".
+
+	* subr.c (lgcd): changed to work with borland C.
+
+	* eval.c (eval): added checks to LAMBDA and LET.
+
+	* eval.c (apply): now checks for null arg1 in lsubr.
+
+Fri Apr 12 00:09:03 1991  Aubrey Jaffer  (jaffer at kleph)
+
+	* config.h scm.h (SCMPTR): created to correct address arithmetic
+	on stack bounds under Borland C++.  Borland C++ now runs scm2c.
+
+Wed Apr 10 21:38:09 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* sys.c (open_io_file, cw_io_file, file_position, file_set_pos,
+	read_to_str) created (IO_EXTENSIONS)
+
+	* config.h (IO_EXTENSIONS): defined
+
+	* sys.c scm.c: lprin1f changed to iprin1
+
+Wed Apr 10 12:58:59 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* sys.c (intern): line 850: for(i = alen;0 <= --i;)changed to
+				    for(i = alen;0 < --i;).
+	This fixed b_pos and v_pos mapping to the same symbol.
+
+Wed Apr  4 00:00:00 1991  Aubrey Jaffer  (jaffer at kleph.ai.mit.edu)
+
+	* released scm2b
+
+Wed Apr  3 22:51:39 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* all files: eliminated types tc7_subr_2n and tc7_subr_2xn.
+	Replaced with tc7_subr_2o and tc7_subr_1o so that all subr calls
+	can be checked for number of arguments.
+
+Tue Apr  2 23:11:15 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* code.doc: cleaned up.
+
+Mon Apr  1 14:27:22 1991  Aubrey Jaffer  (jaffer at Ivan)
+
+	* eval.c (ceval): fixed nasty tail recursion bug at carloop:.
+
+	* scm.c (everr): still fixing error reporting.
+
+	* eval.c subr.c: added flag PURE_FUNCTIONAL which removes side
+	effect special forms and functions.
+
+	* subr.c (substring): now allows first index to be equal to length
+	of string
+
+	* sys.c (lprin1f): dispatches on TYP16 of smobs.
+
+	* scm.h: fixed typo in unused function defs.
+
+Mon Mar 28 00:00:00 1991  Aubrey Jaffer  (jaffer at zohar.ai.mit.edu)
+
+	* scm2a released: too many changes to record.  See code.doc.
+
+Mon Feb 18 21:48:24 1991  Aubrey Jaffer  (jaffer at foxkid)
+
+	* scm.h: types reformatted (TYP6 -> TYP7).
+
+	* eval.c (ceval): Now dispatch directly on ISYMs in ceval.
+
+Fri Feb 15 23:39:48 1991  Aubrey Jaffer  (jaffer at foxkid)
+
+	* sys.c: #include <malloc.h> not done for VMS
+
+Wed Feb 13 17:49:33 1991  Aubrey Jaffer  (jaffer at foxkid)
+
+	* scm.c scl.c: added unsigned declarations to some char *
+	definitions in order to fix characters having negative codes.
+
+	* scm.h (MAKISYM, MAKFLAG, ICHR, MAKICHR, MAKINUM): Now cast to
+	long so that their calls don't have to.  Changing MAKICHR fixed
+	problem in scl.c (string2list) on IBMPC.
+
+	* subr.c (quotient): support for `/' reintroduced; required by
+	r3.99rs but not IEEE.
+
+	* subr.c (char functions): added isascii tests for
+	char-alphabetic, char-numeric?, char-whitespace?,
+	char-upper-case?, and char-lower-case?.  Added test against
+	char_code_limit to int2char.
+
+	* subr.c (s_char_alphap): is subr_1 not lsubr.
+
+	* test.scm: added tests for char-alphabetic, char-numeric?,
+	char-whitespace?, char-upper-case?, and char-lower-case?.
+
+	* sys.c: most `return;'s eliminated to reduce warning messages.
+	Substituted breaks and reordered switch and if clauses.
+
+Sun Feb  3 23:12:34 1991  Aubrey Jaffer  (jaffer at foxkid)
+
+	* scm1-2: released.
+
+	* sys.c (read-char peek-char) added code for EOF.
+
+	* test.scm (leaf-eq?) added and file "cont.scm" removed.  I/O
+	tests added.
+
+	* sys.c (I/O functions) now check for input and output ports
+	rather than just ports.
+
+	* sys.c (lprin1f): occurences of stdout changed to f.  Newlines
+	after printing port removed.
+
+Thu Jan 31 22:52:39 1991  Aubrey Jaffer  (jaffer at foxkid)
+
+	* subr.c (quotient): support for `/' removed; not required.
+
+	* scm.c (wta): message for OUTOFRANGE fixed.
+
+Mon Jan 28 12:45:55 1991  Aubrey Jaffer  (jaffer at foxkid)
+
+	* eval.c (apply): added checks for number of arguments.
+
+	* scm.h (CHECK_SIGINT): checks for blocked SIGINT.
+
+	* sys.c (lprin1): added blocking and testing for SIGINT so that
+	output won't hang on VMS.
+
+	* scm.c (repl): added fflush call.
+
+	* scm.c (err_head, wta): added fflush calls to error routines so
+	that error message come out in proper order.
+
diff --git a/Iedline.scm b/Iedline.scm
new file mode 100644
index 0000000..cbeb265
--- /dev/null
+++ b/Iedline.scm
@@ -0,0 +1,103 @@
+;; Copyright (C) 1994, 1995 Free Software Foundation, Inc.
+;; 
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; 
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; 
+;; You should have received a copy of the GNU General Public License
+;; along with this software; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;
+;; As a special exception, the Free Software Foundation gives permission
+;; for additional uses of the text contained in its release of GUILE.
+;;
+;; The exception is that, if you link the GUILE library with other files
+;; to produce an executable, this does not by itself cause the
+;; resulting executable to be covered by the GNU General Public License.
+;; Your use of that executable is in no way restricted on account of
+;; linking the GUILE library code into it.
+;;
+;; This exception does not however invalidate any other reasons why
+;; the executable file might be covered by the GNU General Public License.
+;;
+;; This exception applies only to the code released by the
+;; Free Software Foundation under the name GUILE.  If you copy
+;; code from other Free Software Foundation releases into a copy of
+;; GUILE, as the General Public License permits, the exception does
+;; not apply to the code that you add in this way.  To avoid misleading
+;; anyone as to the status of such modified files, you must delete
+;; this exception notice from them.
+;;
+;; If you write modifications of your own for GUILE, it is your choice
+;; whether to permit this exception to apply to your modifications.
+;; If you do not wish that, delete this exception notice.  
+
+;;  "Iedline.scm" Scheme interface to readline library
+;; Author: Radey Shouman
+
+;; Change both current-input-port and current-output-port to
+;; allow line editing of input.
+;; All output goes through a soft port in order to detect prompt 
+;; lines, i.e. lines unterminated by a newline.
+
+(define (make-edited-line-port)
+  (let ((prompt "")
+	(outp (default-output-port))
+	(inp (default-input-port))
+	(strp (call-with-input-string "" identity)))
+    (make-soft-port
+     (vector (lambda (c)
+	       (write-char c outp))
+	     (lambda (s)
+	       (display s outp)
+	       (or (zero? (string-length s))
+		   (eq? #\newline (string-ref s (- (string-length s) 1)))
+		   (begin
+		     (set! prompt (string-append "\r" s))
+		     (force-output outp))))
+	     (lambda ()
+	       (force-output outp))
+	     (lambda ()
+	       (let tail ((c (read-char strp)))
+		 (if (char? c) c
+		     (let ((str (read-edited-line prompt)))
+		       (if (string? str)
+			   (let ((n (string-length str)))
+			     (add-history str)
+			     (vector-set-length! str (+ 1 n))
+			     (string-set! str n #\newline)
+			     (set! strp (call-with-input-string
+					 str identity))
+			     (tail (read-char strp)))
+			   str)))))
+	     #f)
+     OPEN_BOTH)))
+
+(define line-editing
+  (let ((edit-port #f)
+	(oiport #f)
+	(ooport #f))
+    (lambda arg
+      (define past edit-port)
+      (cond ((null? arg))
+	    ((and (car arg) (not edit-port))
+	     (set! edit-port (make-edited-line-port))
+	     (set! oiport (set-current-input-port edit-port))
+	     (set! ooport (set-current-output-port edit-port)))
+	    (edit-port
+	     (set-current-input-port oiport)
+	     (set-current-output-port ooport)
+	     (set! edit-port #f)))
+      past)))
+
+(and 
+ (if (provided? 'unix) (isatty? (current-input-port)) #t)
+ (eq? (current-input-port) (default-input-port))
+ (not (getenv "EMACS"))
+ (line-editing #t))
diff --git a/Init.scm b/Init.scm
new file mode 100644
index 0000000..758c407
--- /dev/null
+++ b/Init.scm
@@ -0,0 +1,854 @@
+;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
+;; 
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; 
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; 
+;; You should have received a copy of the GNU General Public License
+;; along with this software; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;
+;; As a special exception, the Free Software Foundation gives permission
+;; for additional uses of the text contained in its release of GUILE.
+;;
+;; The exception is that, if you link the GUILE library with other files
+;; to produce an executable, this does not by itself cause the
+;; resulting executable to be covered by the GNU General Public License.
+;; Your use of that executable is in no way restricted on account of
+;; linking the GUILE library code into it.
+;;
+;; This exception does not however invalidate any other reasons why
+;; the executable file might be covered by the GNU General Public License.
+;;
+;; This exception applies only to the code released by the
+;; Free Software Foundation under the name GUILE.  If you copy
+;; code from other Free Software Foundation releases into a copy of
+;; GUILE, as the General Public License permits, the exception does
+;; not apply to the code that you add in this way.  To avoid misleading
+;; anyone as to the status of such modified files, you must delete
+;; this exception notice from them.
+;;
+;; If you write modifications of your own for GUILE, it is your choice
+;; whether to permit this exception to apply to your modifications.
+;; If you do not wish that, delete this exception notice.  
+
+;;;; "Init.scm", Scheme initialization code for SCM.
+;;; Author: Aubrey Jaffer.
+
+(define (scheme-implementation-type) 'SCM)
+(define (scheme-implementation-version) "4e6")
+
+;;; Temporary hack for compatability with older versions.
+(define software-type
+  (cond ((eq? 'msdos (software-type))
+	 (lambda () 'ms-dos))
+	(else software-type)))
+
+;;; This definition of PROGRAM-VICINITY is a copy of the definition in
+;;; SLIB/require.scm.  It is used here to bootstrap
+;;; IMPLEMENTATION-VICINITY and possibly LIBRARY-VICINITY.
+
+(define program-vicinity
+  (let ((*vicinity-suffix*
+	 (case (software-type)
+	   ((AMIGA)	'(#\: #\/))
+	   ((MS-DOS WINDOWS ATARIST OS/2)	'(#\\ #\/))
+	   ((MACOS THINKC)	'(#\:))
+	   ((NOSVE)	'(#\: #\.))
+	   ((UNIX COHERENT)	'(#\/))
+	   ((VMS)	'(#\: #\])))))
+    (lambda ()
+      (let loop ((i (- (string-length *load-pathname*) 1)))
+	(cond ((negative? i) "")
+	      ((memv (string-ref *load-pathname* i) *vicinity-suffix*)
+	       (substring *load-pathname* 0 (+ i 1)))
+	      (else (loop (- i 1))))))))
+
+(define in-vicinity string-append)
+
+;;; This is the vicinity where this file resides.
+(define implementation-vicinity
+  (let ((vic (program-vicinity)))
+    (lambda () vic)))
+
+;;; (library-vicinity) should be defined to be the pathname of the
+;;; directory where files of Scheme library functions reside.
+
+;;; If the environment variable SCHEME_LIBRARY_PATH is undefined, use
+;;; (implementation-vicinity) as (library-vicinity).  "require.scm",
+;;; the first file loaded from (library-vicinity), can redirect it.
+
+(define library-vicinity
+  (let ((library-path (getenv "SCHEME_LIBRARY_PATH")))
+    (if library-path (lambda () library-path)
+	implementation-vicinity)))
+
+;;; Here for backward compatability
+(define scheme-file-suffix
+  (case (software-type)
+    ((NOSVE) (lambda () "_scm"))
+    (else (lambda () ".scm"))))
+
+(set! *features*
+      (append '(getenv tmpnam abort transcript with-file
+		ieee-p1178 rev4-report rev4-optional-procedures
+		hash object-hash delay eval dynamic-wind
+		multiarg-apply multiarg/and- logical defmacro
+		string-port source current-time)
+	      *features*))
+
+(define slib:exit quit)
+(define (exec-self)
+  (require 'i/o-extensions)
+  (execv (execpath) (program-arguments)))
+
+(define (terms)
+  (list-file (in-vicinity (implementation-vicinity) "COPYING")))
+
+(define (list-file file)
+  (call-with-input-file file
+    (lambda (inport)
+      (do ((c (read-char inport) (read-char inport)))
+	  ((eof-object? c))
+	(write-char c)))))
+
+(define (read:eval-feature exp)
+  (cond ((symbol? exp)
+	 (or (memq exp *features*) (eq? exp (software-type))))
+	((and (pair? exp) (list? exp))
+	 (case (car exp)
+	   ((not) (not (read:eval-feature (cadr exp))))
+	   ((or) (if (null? (cdr exp)) #f
+		     (or (read:eval-feature (cadr exp))
+			 (read:eval-feature (cons 'or (cddr exp))))))
+	   ((and) (if (null? (cdr exp)) #t
+		      (and (read:eval-feature (cadr exp))
+			   (read:eval-feature (cons 'and (cddr exp))))))
+	   (else (error "read:sharp+ invalid expression " exp))))))
+
+(define (read:array digit port)
+  (define chr0 (char->integer #\0))
+  (let ((rank (let readnum ((val (- (char->integer digit) chr0)))
+		(if (char-numeric? (peek-char port))
+		    (readnum (+ (* 10 val)
+				(- (char->integer (read-char port)) chr0)))
+		    val)))
+	(prot (if (eq? #\( (peek-char port))
+		  '()
+		  (let ((c (read-char port)))
+		    (case c ((#\b) #t)
+			  ((#\a) #\a)
+			  ((#\u) 1)
+			  ((#\e) -1)
+			  ((#\s) 1.0)
+			  ((#\i) 1/3)
+			  ((#\c) 0+i)
+			  (else (error "read:array unknown option " c)))))))
+    (if (eq? (peek-char port) #\()
+	(list->uniform-array rank prot (read port))
+	(error "read:array list not found"))))
+
+(define (read:uniform-vector proto port)
+  (if (eq? #\( (peek-char port))
+      (list->uniform-array 1 proto (read port))
+      (error "read:uniform-vector list not found")))
+
+(define (read:sharp c port)
+  (define (barf)
+    (error "unknown # object" c))
+  (case c ((#\') (read port))
+	((#\+) (if (read:eval-feature (read port))
+		   (read port)
+		   (begin (read port) (if #f #f))))
+	((#\-) (if (not (read:eval-feature (read port)))
+		   (read port)
+		   (begin (read port) (if #f #f))))
+	((#\b) (read:uniform-vector #t port))
+	((#\a) (read:uniform-vector #\a port))
+	((#\u) (read:uniform-vector 1 port))
+	((#\e) (read:uniform-vector -1 port))
+	((#\s) (read:uniform-vector 1.0 port))
+	((#\i) (read:uniform-vector 1/3 port))
+	((#\c) (read:uniform-vector 0+i port))
+	((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
+	 (read:array c port))
+	((#\!) (if (= 1 (line-number))
+		   (let skip () (if (eq? #\newline (peek-char port))
+				    (if #f #f)
+				    (begin (read-char port) (skip))))
+		   (barf)))
+	(else (barf))))
+
+(define type 'type)			;for /bin/sh hack.
+
+;;;; Here are some Revised^2 Scheme functions:
+(define 1+
+  (let ((+ +))
+    (lambda (n) (+ n 1))))
+(define -1+
+  (let ((+ +))
+    (lambda (n) (+ n -1))))
+(define 1- -1+)
+(define <? <)
+(define <=? <=)
+(define =? =)
+(define >? >)
+(define >=? >=)
+(define t #t)
+(define nil #f)
+(define sequence begin)
+
+(set! apply
+      (let ((apply:nconc-to-last apply:nconc-to-last)
+	    (@apply @apply))
+	(lambda (fun . args) (@apply fun (apply:nconc-to-last args)))))
+(define call-with-current-continuation
+  (let ((@call-with-current-continuation @call-with-current-continuation))
+    (lambda (proc) (@call-with-current-continuation proc))))
+
+;;; VMS does something strange when output is sent to both
+;;; CURRENT-OUTPUT-PORT and CURRENT-ERROR-PORT.
+(case (software-type) ((VMS) (set-current-error-port (current-output-port))))
+
+;;; OPEN_READ, OPEN_WRITE, and OPEN_BOTH are used to request the proper
+;;; mode to open files in.  MS-DOS does carraige return - newline
+;;; translation if not opened in `b' mode.
+
+(define OPEN_READ (case (software-type)
+		    ((MS-DOS WINDOWS ATARIST) "rb")
+		    (else "r")))
+(define OPEN_WRITE (case (software-type)
+		     ((MS-DOS WINDOWS ATARIST) "wb")
+		     (else "w")))
+(define OPEN_BOTH (case (software-type)
+		    ((MS-DOS WINDOWS ATARIST) "r+b")
+		    (else "r+")))
+(define (_IONBF mode) (string-append mode "0"))
+
+(define could-not-open #f)
+
+(define (open-input-file str)
+  (or (open-file str OPEN_READ)
+      (and (procedure? could-not-open) (could-not-open) #f)
+      (error "OPEN-INPUT-FILE couldn't open file " str)))
+(define (open-output-file str)
+  (or (open-file str OPEN_WRITE)
+      (and (procedure? could-not-open) (could-not-open) #f)
+      (error "OPEN-OUTPUT-FILE couldn't open file " str)))
+(define (open-io-file str) (open-file str OPEN_BOTH))
+
+(define close-input-port close-port)
+(define close-output-port close-port)
+(define close-io-port close-port)
+
+(define (call-with-input-file str proc)
+  (let* ((file (open-input-file str))
+	 (ans (proc file)))
+    (close-input-port file)
+    ans))
+
+(define (call-with-output-file str proc)
+  (let* ((file (open-output-file str))
+	 (ans (proc file)))
+    (close-output-port file)
+    ans))
+
+(define (with-input-from-port port thunk)
+  (let* ((swaports (lambda () (set! port (set-current-input-port port)))))
+    (dynamic-wind swaports thunk swaports)))
+
+(define (with-output-to-port port thunk)
+  (let* ((swaports (lambda () (set! port (set-current-output-port port)))))
+    (dynamic-wind swaports thunk swaports)))
+
+(define (with-error-to-port port thunk)
+  (let* ((swaports (lambda () (set! port (set-current-error-port port)))))
+    (dynamic-wind swaports thunk swaports)))
+
+(define (with-input-from-file file thunk)
+  (let* ((nport (open-input-file file))
+	 (ans (with-input-from-port nport thunk)))
+    (close-port nport)
+    ans))
+
+(define (with-output-to-file file thunk)
+  (let* ((nport (open-output-file file))
+	 (ans (with-output-to-port nport thunk)))
+    (close-port nport)
+    ans))
+
+(define (with-error-to-file file thunk)
+  (let* ((nport (open-output-file file))
+	 (ans (with-error-to-port nport thunk)))
+    (close-port nport)
+    ans))
+
+(if (not (defined? force-output))
+    (define (force-output . a) #f))
+
+(define (error . args)
+  (define cep (current-error-port))
+  (perror "ERROR")
+  (errno 0)
+  (display "ERROR: " cep)
+  (if (not (null? args))
+      (begin (display (car args) cep)
+	     (for-each (lambda (x) (display #\  cep) (write x cep))
+		       (cdr args))))
+  (newline cep)
+  (force-output cep)
+  (abort))
+
+(define set-errno errno)
+(define exit quit)
+
+(define (file-exists? str)
+  (let ((port (open-file str OPEN_READ)))
+    (if port (begin (close-port port) #t)
+	#f)))
+
+(define difftime -)
+(define offset-time +)
+
+(if (not (memq 'ed *features*))
+    (begin
+      (define (ed . args)
+	(system (apply string-append
+		       (or (getenv "EDITOR") "ed")
+		       (map (lambda (s) (string-append " " s)) args))))
+      (set! *features* (cons 'ed *features*))))
+
+(if (not (defined? output-port-width))
+    (define (output-port-width . arg) 80))
+
+(if (not (defined? output-port-height))
+    (define (output-port-height . arg) 24))
+
+(if (not (defined? last-pair))
+    (define (last-pair l) (if (pair? (cdr l)) (last-pair (cdr l)) l)))
+
+(define (has-suffix? str suffix)
+  (let ((sufl (string-length suffix))
+	(sl (string-length str)))
+    (and (> sl sufl)
+	 (string=? (substring str (- sl sufl) sl) suffix))))
+
+(define (identity x) x)
+(define slib:error error)
+(define slib:tab #\tab)
+(define slib:form-feed #\page)
+(define slib:eval eval)
+
+;;; Load.
+(define load:indent 0)
+(define (load:pre file)
+  (define cep (current-error-port))
+  (cond ((> (verbose) 1)
+	 (display
+	  (string-append ";" (make-string load:indent #\ ) "loading " file)
+	  cep)
+	 (set! load:indent (modulo (+ 2 load:indent) 16))
+	 (newline cep)))
+  (force-output cep))
+
+(define (load:post filesuf)
+  (define cep (current-error-port))
+  (errno 0)
+  (cond ((> (verbose) 1)
+	 (set! load:indent (modulo (+ -2 load:indent) 16))
+	 (display (string-append ";" (make-string load:indent #\ )
+				 "done loading " filesuf)
+		  cep)
+	 (newline cep)
+	 (force-output cep))))
+
+(define (scm:load file . libs)
+  (define filesuf file)
+  (define hss (has-suffix? file (scheme-file-suffix)))
+  (load:pre file)
+  (or (and (defined? link:link) (not hss)
+	   (or (apply link:link file libs)
+	       (and link:able-suffix
+		    (let ((fs (string-append file link:able-suffix)))
+		      (cond ((not (file-exists? fs)) #f)
+			    ((apply link:link fs libs) (set! filesuf fs) #t)
+			    (else #f))))))
+      (and (null? libs) (try-load file))
+      ;;HERE is where the suffix gets specified
+      (and (not hss)
+	   (begin (errno 0)		; clean up error from TRY-LOAD above
+                  (set! filesuf (string-append file (scheme-file-suffix)))
+		  (try-load filesuf)))
+      (and (procedure? could-not-open) (could-not-open) #f)
+      (let () (set! load:indent 0)
+	   (error "LOAD couldn't find file " file)))
+  (load:post filesuf))
+(define load scm:load)
+(define slib:load load)
+
+(define (scm:load-source file)
+  (define sfs (scheme-file-suffix))
+  (define filesuf file)
+  (load:pre file)
+  (or (and (or (try-load file)
+	       ;;HERE is where the suffix gets specified
+	       (and (not (has-suffix? file sfs))
+		    (begin (set! filesuf (string-append file sfs))
+			   (try-load filesuf)))))
+      (and (procedure? could-not-open) (could-not-open) #f)
+      (error "LOAD couldn't find file " file))
+  (load:post filesuf))
+(define slib:load-source scm:load-source)
+
+(load (in-vicinity (library-vicinity) "require"))
+
+;;; DO NOT MOVE!  This has to be done after "require.scm" is loaded.
+(define slib:load-source scm:load-source)
+(define slib:load scm:load)
+
+(cond ((or (defined? dyn:link)
+	   (defined? vms:dynamic-link-call)
+	   (file-exists? (in-vicinity (implementation-vicinity) "hobbit.tms")))
+       (load (in-vicinity (implementation-vicinity) "Link"))))
+
+(cond ((defined? link:link)
+       (define (slib:load-compiled . args)
+	 (or (apply link:link args)
+	     (error "Couldn't link files " args)))
+       (provide 'compiled)))
+
+(define (string-upcase str) (string-upcase! (string-copy str)))
+(define (string-downcase str) (string-downcase! (string-copy str)))
+(define (string-capitalize str) (string-capitalize! (string-copy str)))
+
+(define logical:logand logand)
+(define logical:logior logior)
+(define logical:logxor logxor)
+(define logical:lognot lognot)
+(define logical:ash ash)
+(define logical:logcount logcount)
+(define logical:integer-length integer-length)
+(define logical:bit-extract bit-extract)
+(define logical:integer-expt integer-expt)
+
+(define (logical:ipow-by-squaring x k acc proc)
+  (cond ((zero? k) acc)
+	((= 1 k) (proc acc x))
+	(else (logical:ipow-by-squaring (proc x x)
+					(quotient k 2)
+					(if (even? k) acc (proc acc x))
+					proc))))
+
+;defmacro from dorai@cs.rice.edu (heavily hacked by jaffer):
+(define *defmacros* '())
+(define (defmacro? m) (and (assq m *defmacros*) #t))
+
+(define defmacro:transformer
+  (lambda (f)
+    (procedure->memoizing-macro
+      (lambda (exp env)
+	(copy-tree (apply f (cdr exp)))))))
+
+(define defmacro
+  (let ((defmacro-transformer
+	  (lambda (name parms . body)
+	    `(define ,name
+	       (let ((transformer (lambda ,parms ,@body)))
+		 (set! *defmacros* (acons ',name transformer *defmacros*))
+		 (defmacro:transformer transformer))))))
+    (set! *defmacros* (acons 'defmacro defmacro-transformer *defmacros*))
+    (defmacro:transformer defmacro-transformer)))
+
+(define (macroexpand-1 e)
+  (if (pair? e) (let ((a (car e)))
+		  (cond ((symbol? a) (set! a (assq a *defmacros*))
+				     (if a (apply (cdr a) (cdr e)) e))
+			(else e)))
+      e))
+
+(define (macroexpand e)
+  (if (pair? e) (let ((a (car e)))
+		  (cond ((symbol? a)
+			 (set! a (assq a *defmacros*))
+			 (if a (macroexpand (apply (cdr a) (cdr e))) e))
+			(else e)))
+      e))
+
+(define gentemp
+  (let ((*gensym-counter* -1))
+    (lambda ()
+      (set! *gensym-counter* (+ *gensym-counter* 1))
+      (string->symbol
+       (string-append "scm:G" (number->string *gensym-counter*))))))
+
+(define defmacro:eval slib:eval)
+(define defmacro:load load)
+
+(define (slib:eval-load <filename> evl)
+  (if (not (file-exists? <filename>))
+      (set! <filename> (string-append <filename> (scheme-file-suffix))))
+  (call-with-input-file <filename>
+    (lambda (port)
+      (let ((old-load-pathname *load-pathname*))
+	(set! *load-pathname* <filename>)
+	(do ((o (read port) (read port)))
+	    ((eof-object? o))
+	  (evl o))
+	(set! *load-pathname* old-load-pathname)))))
+
+(define (print . args)
+  (define result #f)
+  (for-each (lambda (x) (set! result x) (write x) (display #\ )) args)
+  (newline)
+  result)
+
+;;; Autoloads for SLIB procedures.
+
+(define (tracef . args) (require 'trace) (apply tracef args))
+(define (trace:tracef . args) (require 'trace) (apply trace:tracef args))
+(define (trace-all . args) (require 'debug) (apply trace-all args))
+(define (pretty-print . args) (require 'pretty-print)
+  (apply pretty-print args))
+
+;;; Macros.
+
+;;; Trace gets redefmacroed when tracef autoloads.
+(defmacro trace x
+  (if (null? x) '()
+      `(begin ,@(map (lambda (x) `(set! ,x (trace:tracef ,x ',x))) x))))
+(defmacro break x
+  (if (null? x) '()
+      `(begin ,@(map (lambda (x) `(set! ,x (break:breakf ,x ',x))) x))))
+
+(defmacro defvar (var val)
+  `(if (not (defined? ,var)) (define ,var ,val)))
+
+(cond
+ ((defined? stack-trace)
+
+  #+breakpoint-error;; remove this line to enable breakpointing on errors
+  (define (error . args)
+    (define cep (current-error-port))
+    (perror "ERROR")
+    (errno 0)
+    (display "ERROR: " cep)
+    (if (not (null? args))
+	(begin (display (car args) cep)
+	       (for-each (lambda (x) (display #\  cep) (write x cep))
+			 (cdr args))))
+    (newline cep)
+    (cond ((stack-trace) (newline cep)))
+    (display " * Breakpoint established: (continue <val>) to return." cep)
+    (newline cep) (force-output cep)
+    (require 'debug) (apply breakpoint args))
+
+  (define (user-interrupt . args)
+    (define cep (current-error-port))
+    (newline cep) (display "ERROR: user interrupt" cep)
+    (newline cep)
+    (cond ((stack-trace) (newline cep)))
+    (display " * Breakpoint established: (continue <val>) to return." cep)
+    (newline cep) (force-output cep)
+    (require 'debug) (apply breakpoint args))
+  ))
+
+;;; ABS and MAGNITUDE can be the same.
+(cond ((and (inexact? (string->number "0.0")) (not (defined? exp)))
+       (if (defined? usr:lib)
+	   (if (usr:lib "m")
+	       (load (in-vicinity (implementation-vicinity) "Transcen")
+		     (usr:lib "m"))
+	       (load (in-vicinity (implementation-vicinity) "Transcen")))
+	   (load (in-vicinity (implementation-vicinity) "Transcen"
+			      (scheme-file-suffix))))
+       (set! abs magnitude)))
+
+(if (defined? array?)
+    (begin
+      (define uniform-vector? array?)
+      (define make-uniform-vector dimensions->uniform-array)
+;      (define uniform-vector-ref array-ref)
+      (define (uniform-vector-set! u i o)
+	(uniform-vector-set1! u o i))
+;      (define uniform-vector-fill! array-fill!)
+;      (define uniform-vector-read! uniform-array-read!)
+;      (define uniform-vector-write uniform-array-write)
+
+      (define (make-array fill . args)
+	(dimensions->uniform-array args () fill))
+      (define (make-uniform-array prot . args)
+	(dimensions->uniform-array args prot))
+      (define (list->array ndim lst)
+	(list->uniform-array ndim '() lst))
+      (define (list->uniform-vector prot lst)
+	(list->uniform-array 1 prot lst))
+      (define (array-shape a)
+	(map (lambda (ind) (if (number? ind) (list 0 (+ -1 ind)) ind))
+	     (array-dimensions a)))))
+
+;;;; Initialize statically linked add-ons
+(cond ((defined? scm_init_extensions)
+       (scm_init_extensions)
+       (set! scm_init_extensions #f)))
+
+;;; Use *argv* instead of (program-arguments), to allow option
+;;; processing to be done on it.  "ScmInit.scm" must
+;;;	(set! *argv* (program-arguments))
+;;; if it wants to alter the arguments which BOOT-TAIL processes.
+(define *argv* #f)
+
+;;; This loads the user's initialization file, or files named in
+;;; program arguments.
+
+(or
+ (eq? (software-type) 'THINKC)
+ (member "-no-init-file" (program-arguments))
+ (member "--no-init-file" (program-arguments))
+ (try-load
+  (in-vicinity
+   (let ((home (getenv "HOME")))
+     (if home
+	 (case (software-type)
+	   ((UNIX COHERENT)
+	    (if (char=? #\/ (string-ref home (+ -1 (string-length home))))
+		home			;V7 unix has a / on HOME
+		(string-append home "/")))
+	   (else home))
+	 (user-vicinity)))
+   "ScmInit.scm"))
+ (errno 0))
+
+(if (not (defined? *R4RS-macro*))
+    (define *R4RS-macro* #f))
+(if (not (defined? *interactive*))
+    (define *interactive* #f))
+
+(define (boot-tail)
+  (cond ((not *argv*) (set! *argv* (program-arguments))
+		      (cond ((provided? 'getopt) (set! *optind* 1)
+						 (set! *optarg* #f)))))
+  (cond
+   ((and (> (length *argv*) 1) (char=? #\- (string-ref (cadr *argv*) 0)))
+    (require 'getopt)
+;;; (else
+;;;  (define *optind* 1)
+;;;  (define getopt:opt #f)
+;;;  (define (getopt argc argv optstring) #f))
+
+    (let* ((simple-opts "muqvbis")
+	   (arg-opts '("a kbytes" "no-init-file" "-no-init-file"
+				  "-version" "-help" "p number"
+				  "r feature" "f filename" "l filename"
+				  "d filename" "c string" "e string"
+				  "o filename"))
+	   (opts (apply string-append ":" simple-opts
+			(map (lambda (o)
+			       (string-append (string (string-ref o 0)) ":"))
+			     arg-opts)))
+	   (argc (length *argv*))
+	   (didsomething #f)
+	   (moreopts #t)
+	   (exe-name (symbol->string (scheme-implementation-type)))
+	   (up-name (apply string (map char-upcase (string->list exe-name)))))
+
+      (define (do-thunk thunk)
+	(if *interactive*
+	    (thunk)
+	    (let ((complete #f))
+	      (dynamic-wind
+	       (lambda () #f)
+	       (lambda ()
+		 (thunk)
+		 (set! complete #t))
+	       (lambda () (if (not complete) (quit #f)))))))
+
+      (define (do-string-arg)
+	(require 'string-port)
+	(do-thunk
+	 (lambda ()
+	   ((if *R4RS-macro* macro:eval eval)
+	    (call-with-input-string
+	     (string-append "(begin " *optarg* ")")
+	     read))))
+	(set! didsomething #t))
+
+      (define (do-load file)
+	(do-thunk
+	 (lambda ()
+	   (cond (*R4RS-macro* (require 'macro) (macro:load file))
+		 (else (load file)))))
+	(set! didsomething #t))
+
+      (define (usage preopt opt postopt success?)
+	(define cep (if success? (current-output-port) (current-error-port)))
+	(define indent (make-string 6 #\ ))
+	(define i 3)
+	(cond ((char? opt) (set! opt (string opt)))
+	      ;;((symbol? opt) (set! opt (symbol->string opt)))
+	      )
+	(display (string-append preopt opt postopt) cep)
+	(newline cep)
+	(display (string-append "Usage: "
+				exe-name
+				" [-a kbytes] [-" simple-opts "]") cep)
+	(for-each
+	 (lambda (o)
+	   (display (string-append " [-" o "]") cep)
+	   (set! i (+ 1 i))
+	   (cond ((zero? (modulo i 4)) (newline cep) (display indent cep))))
+	 (cdr arg-opts))
+	(display " [-- | -s | -] [file] [args...]" cep) (newline cep)
+	(if success? (display success? cep) (exit #f)))
+
+      ;; -a int => ignore (handled by run_scm)
+      ;; -c str => (eval str)
+      ;; -e str => (eval str)
+      ;; -d str => (require 'database-utilities) (open-database str)
+      ;; -f str => (load str)
+      ;; -l str => (load str)
+      ;; -r str => (require str)
+      ;; -o str => (dump str)
+      ;; -p int => (verbose int)
+      ;; -m     => (set! *R4RS-macro* #t)
+      ;; -u     => (set! *R4RS-macro* #f)
+      ;; -v     => (verbose 3)
+      ;; -q     => (verbose 0)
+      ;; -i     => (set! *interactive* #t)
+      ;; -b     => (set! *interactive* #f)
+      ;; -s     => set argv, don't execute first one
+      ;; -no-init-file => don't load init file
+      ;; --no-init-file => don't load init file
+      ;; --help => print and exit
+      ;; --version => print and exit
+      ;; --     => last option
+
+      (let loop ((option (getopt-- argc *argv* opts)))
+	(case option
+	  ((#\a)
+	   (cond ((> *optind* 3)
+		  (usage "scm: option `-" getopt:opt "' must be first" #f))
+		 ((or (not (exact? (string->number *optarg*)))
+		      (not (<= 1 (string->number *optarg*) 10000)))
+		  ;;	This size limit should match scm.c ^^
+		  (usage "scm: option `-" getopt:opt
+			 (string-append *optarg* "' unreasonable") #f))))
+	  ((#\e #\c) (do-string-arg))	;sh-like
+	  ((#\f #\l) (do-load *optarg*)) ;(set-car! *argv* *optarg*)
+	  ((#\d) (require 'database-utilities)
+		 (open-database *optarg*))
+	  ((#\o) (require 'dump)
+		 (if (< *optind* (length *argv*))
+		     (dump *optarg* #t)
+		     (dump *optarg*)))
+	  ((#\r) (do-thunk (lambda ()
+			     (if (and (= 1 (string-length *optarg*))
+				      (char-numeric? (string-ref *optarg* 0)))
+				 (case (string-ref *optarg* 0)
+				   ((#\2) (require 'rev3-procedures)
+					  (require 'rev2-procedures))
+				   ((#\3) (require 'rev3-procedures))
+				   ((#\4) (require 'rev4-optional-procedures))
+				   ((#\5) (require 'dynamic-wind)
+					  (require 'values)
+					  (require 'macro)
+					  (set! *R4RS-macro* #t))
+				   (else (require (string->symbol *optarg*))))
+				 (require (string->symbol *optarg*))))))
+	  ((#\p) (verbose (string->number *optarg*)))
+	  ((#\q) (verbose 0))
+	  ((#\v) (verbose 3))
+	  ((#\i) (set! *interactive* #t) ;sh-like
+		 (verbose (max 2 (verbose))))
+	  ((#\b) (set! didsomething #t)
+		 (set! *interactive* #f))
+	  ((#\s) (set! moreopts #f)	;sh-like
+		 (set! didsomething #t)
+		 (set! *interactive* #t))
+	  ((#\m) (set! *R4RS-macro* #t))
+	  ((#\u) (set! *R4RS-macro* #f))
+	  ((#\n) (if (not (string=? "o-init-file" *optarg*))
+		     (usage "scm: unrecognized option `-n" *optarg* "'" #f)))
+	  ((#\:) (usage "scm: option `-" getopt:opt "' requires an argument" #f))
+	  ((#\?) (usage "scm: unrecognized option `-" getopt:opt "'" #f))
+	  ((#f) (set! moreopts #f)	;sh-like
+		(cond ((and (< *optind* (length *argv*))
+			    (string=? "-" (list-ref *argv* *optind*)))
+		       (set! *optind* (+ 1 *optind*)))))
+	  (else
+	   (or (cond ((not (string? option)) #f)
+		     ((string-ci=? "no-init-file" option))
+		     ((string-ci=? "version" option)
+		      (display
+		       (string-append exe-name " "
+				      (scheme-implementation-version)
+				      "
+Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
+"
+				      up-name
+				      " may be distributed under the terms of"
+				      " the GNU General Public Licence;
+certain other uses are permitted as well."
+				      " For details, see the file `COPYING',
+which is included in the "
+				      up-name " distribution.
+There is no warranty, to the extent permitted by law.
+"
+				      ))
+		      (cond ((execpath)
+			     (display " This executable was loaded from ")
+			     (display (execpath))
+			     (newline)))
+		      (quit #t))
+		     ((string-ci=? "help" option)
+		      (usage "This is "
+			     up-name
+			     ", a Scheme interpreter."
+			     (string-append
+			      "Latest info: "
+			      "http://www-swiss.ai.mit.edu/~jaffer/"
+			      up-name ".html
+"
+			      ))
+		      (quit #t))
+		     (else #f))
+	       (usage "scm: unknown option `--" option "'" #f))))
+
+	(cond ((and moreopts (< *optind* (length *argv*)))
+	       (loop (getopt-- argc *argv* opts)))
+	      ((< *optind* (length *argv*)) ;No more opts
+	       (set! *argv* (list-tail *argv* *optind*))
+	       (set! *optind* 1)
+	       (cond ((not didsomething) (do-load (car *argv*))
+					 (set! *optind* (+ 1 *optind*))))
+	       (cond ((and (> (verbose) 2)
+			   (not (= (+ -1 *optind*) (length *argv*))))
+		      (display "scm: extra command arguments unused:"
+			       (current-error-port))
+		      (for-each (lambda (x) (display (string-append " " x)
+						     (current-error-port)))
+				(list-tail *argv* (+ -1 *optind*)))
+		      (newline (current-error-port)))))
+	      ((and (not didsomething) (= *optind* (length *argv*)))
+	       (set! *interactive* #t)))))
+
+    (cond ((not *interactive*) (quit))
+	  (*R4RS-macro*
+	   (require 'repl)
+	   (require 'macro)
+	   (let* ((oquit quit))
+	     (set! quit (lambda () (repl:quit)))
+	     (set! exit quit)
+	     (repl:top-level macro:eval)
+	     (oquit))))
+    ;;otherwise, fall into non-macro SCM repl.
+    )
+   (else
+    (begin (errno 0)
+	   (set! *interactive* #t)
+	   (for-each load (cdr (program-arguments)))))))
diff --git a/Link.scm b/Link.scm
new file mode 100644
index 0000000..ad88e47
--- /dev/null
+++ b/Link.scm
@@ -0,0 +1,284 @@
+;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
+;; 
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; 
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; 
+;; You should have received a copy of the GNU General Public License
+;; along with this software; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;
+;; As a special exception, the Free Software Foundation gives permission
+;; for additional uses of the text contained in its release of GUILE.
+;;
+;; The exception is that, if you link the GUILE library with other files
+;; to produce an executable, this does not by itself cause the
+;; resulting executable to be covered by the GNU General Public License.
+;; Your use of that executable is in no way restricted on account of
+;; linking the GUILE library code into it.
+;;
+;; This exception does not however invalidate any other reasons why
+;; the executable file might be covered by the GNU General Public License.
+;;
+;; This exception applies only to the code released by the
+;; Free Software Foundation under the name GUILE.  If you copy
+;; code from other Free Software Foundation releases into a copy of
+;; GUILE, as the General Public License permits, the exception does
+;; not apply to the code that you add in this way.  To avoid misleading
+;; anyone as to the status of such modified files, you must delete
+;; this exception notice from them.
+;;
+;; If you write modifications of your own for GUILE, it is your choice
+;; whether to permit this exception to apply to your modifications.
+;; If you do not wish that, delete this exception notice.  
+
+;;;; "Link.scm", Compiling and dynamic linking code for SCM.
+;;; Author: Aubrey Jaffer.
+
+(define cc:command
+  (let ((default "cc -c"))	;-O removed for HP-UX self-compile
+    (case (software-type)
+      ((unix) (if (memq 'sun-dl *features*)
+		  "gcc -g -O -fpic -c" ; If you have problems change -fpic to
+		                       ; -fPIC (see GCC info pages).
+		  default))
+      (else default))))
+
+(define link:command
+  (case (software-type)
+    (else "cc")))
+
+(define scm:object-suffix
+  (case (software-type)
+    ((MSDOS VMS) ".OBJ")
+    (else (if (provided? 'sun-dl) ".so" ".o"))))
+
+;;; This is an unusual autoload because it should load either the
+;;; source or compiled version if present.
+(if (not (defined? hobbit))		;Autoload for hobbit
+    (define (hobbit . args)
+      (require (in-vicinity (implementation-vicinity) "hobbit"))
+      (provide 'hobbit)
+      (apply hobbit args)))
+
+(define (compile-file file . args)
+  (apply hobbit file args)
+  (require (in-vicinity (implementation-vicinity) "build"))
+  (build-from-whole-argv
+   (list "build" "-tdll"
+	 (string-append "--compiler-options=-I" (implementation-vicinity))
+	 "-c"
+	 (string-append (descmify file) ".c")
+	 ;; or (replace-suffix file (scheme-file-suffix) ".c")
+	 "-hsystem"
+	 )))
+
+(define (link-named-scm name . modules)
+  (require (in-vicinity (implementation-vicinity) "build"))
+  (let* ((iv (implementation-vicinity))
+	 (oss (string-append scm:object-suffix " "))
+	 (command
+	  (list "build" "--type=exe" "-cscm.c" "-hsystem"
+		(string-append "--linker-options=-L" (implementation-vicinity))
+		(apply string-append
+		       "-i"
+		       (map (lambda (n)
+			      (string-append "init_" n))
+			    modules))
+		(apply string-append
+		       "-j"
+		       (map (lambda (n)
+			      (string-append n oss)) modules))
+		"-o" name)))
+    (cond ((>= (verbose) 3)
+	   (write command) (newline)))
+    (build-from-whole-argv command)))
+
+;;;; Dynamic linking/loading
+
+(cond
+ ((defined? dyn:link)
+  (define link:modules '())
+  (define link:able-suffix 
+    (cond ((provided? 'shl) ".sl")
+	  ((provided? 'sun-dl) ".so")
+	  (else ".o")))
+  (define link:link
+    (lambda (file . libs)
+      (define oloadpath *load-pathname*)
+      (let* ((sl (string-length file))
+	     (lasl (string-length link:able-suffix))
+	     (*vicinity-suffix*
+	      (case (software-type)
+		((NOSVE)	'(#\: #\.))
+		((AMIGA)	'(#\: #\/))
+		((UNIX)	'(#\/))
+		((VMS)	'(#\: #\]))
+		((MSDOS ATARIST OS/2)	'(#\\))
+		((MACOS THINKC)	'(#\:))))
+	     (fname (let loop ((i (- sl 1)))
+		      (cond ((negative? i) file)
+			    ((memv (string-ref file i) *vicinity-suffix*)
+			     (substring file (+ i 1) sl))
+			    (else (loop (- i 1))))))
+	     (nsl (string-length fname))
+	     (name (cond ((< nsl lasl) fname)
+			 ((string-ci=? (substring fname (- nsl lasl) nsl)
+				       link:able-suffix)
+			  (substring fname 0 (- nsl lasl)))
+			 (else fname)))
+	     (linkobj #f))
+	(set! *load-pathname* file)
+	(set! linkobj (assoc name link:modules))
+	(cond (linkobj (dyn:unlink (cdr linkobj))))
+	(set! linkobj (dyn:link file))
+	(for-each (lambda (lib)
+		    (cond ((dyn:link lib))
+			  (else (slib:error "couldn't link: " lib))))
+		  libs)
+	(cond ((not linkobj)
+	       (set! *load-pathname* oloadpath) #f)
+	      ((dyn:call
+		(string-append
+		 "init_" (list->string (map char-downcase (string->list name))))
+		linkobj)
+	       (set! link:modules (acons name linkobj link:modules))
+	       (set! *load-pathname* oloadpath) #t)
+	      (else
+	       (dyn:unlink linkobj)
+	       (set! *load-pathname* oloadpath) #f)))))))
+
+(cond
+ ((defined? vms:dynamic-link-call)
+  (define link:able-suffix #f)
+  (define (link:link file)
+    (define dir "")
+    (define fil "")
+    (let loop ((i (- (string-length file) 1)))
+      (cond ((negative? i) (set! dir file))
+	    ((memv (string-ref file i) '(#\: #\]))
+	     (set! dir (substring file 0 (+ i 1)))
+	     (set! fil (substring file (+ i 1) (string-length file))))
+	    (else (loop (- i 1)))))
+    (vms:dynamic-link-call dir fil (string-append "init_" fil)))))
+
+(set! *catalog*
+      (acons 'scmhob (in-vicinity (implementation-vicinity) "scmhob")
+	     *catalog*))
+(and (defined? *catalog*) (defined? link:link)
+     (cond ((provided? 'dld:dyncm)
+	    (define (usr:lib lib)
+	      (or (and (member lib '("c" "m"))
+		       (let ((sa (string-append "/usr/lib/lib" lib ".sa")))
+			 (and (file-exists? sa) sa)))
+		  (string-append "/usr/lib/lib" lib ".a")))
+	    (define (x:lib lib) (string-append "/usr/X11/lib/lib" lib ".sa")))
+	   ((provided? 'sun-dl)
+	    ;; These libraries are (deferred) linked in conversion to ".so"
+	    (define (usr:lib lib) #f)
+	    (define (x:lib lib) #f))
+	   ((provided? 'shl)
+	    (define (usr:lib lib)
+	      (if (member lib '("c" "m"))
+		  (string-append "/lib/lib" lib link:able-suffix)
+		  (string-append "/usr/lib/lib" lib link:able-suffix)))
+	    (define (x:lib lib) (string-append "/usr/X11R5/lib/lib"
+					       lib link:able-suffix)))
+	   (else
+	    (define (usr:lib lib) (string-append "/usr/lib/lib" lib ".a"))
+	    (define (x:lib lib) (string-append "/usr/X11/lib/lib" lib ".sa"))))
+     (begin
+       (define wb:vicinity (string-append (implementation-vicinity) "../wb/"))
+       (define (catalog:add-link feature ofile . libs)
+	 (define fe (file-exists? ofile))
+	 (cond ((or (not (require:feature->path feature)) fe)
+		;; remove #f from libs list
+		(set! libs (let rem ((l libs))
+			     (cond ((null? l) l)
+				   ((car l) (cons (car l) (rem (cdr l))))
+				   (else (rem (cdr l))))))
+		(set! *catalog*
+		      (acons feature (cons 'compiled (cons ofile libs))
+			     *catalog*))
+		fe)
+	       (else #f)))
+       (set! *catalog*
+	     (acons 'wb-table (in-vicinity wb:vicinity "wbtab") *catalog*))
+       (catalog:add-link 'db
+			 (in-vicinity wb:vicinity "db" link:able-suffix)
+			 (in-vicinity wb:vicinity "handle" link:able-suffix)
+			 (in-vicinity wb:vicinity "blink" link:able-suffix)
+			 (in-vicinity wb:vicinity "prev" link:able-suffix)
+			 (in-vicinity wb:vicinity "ent" link:able-suffix)
+			 (in-vicinity wb:vicinity "sys" link:able-suffix)
+			 (in-vicinity wb:vicinity "del" link:able-suffix)
+			 (in-vicinity wb:vicinity "stats" link:able-suffix)
+			 (in-vicinity wb:vicinity "blkio" link:able-suffix)
+			 (in-vicinity wb:vicinity "scan" link:able-suffix)
+			 (usr:lib "c"))
+       (set! *catalog* (cons '(wb . db) *catalog*))
+       (catalog:add-link 'turtle-graphics
+			 (in-vicinity (implementation-vicinity) "turtlegr"
+				      link:able-suffix)
+			 (x:lib "X11")
+			 (usr:lib "m")
+			 (usr:lib "c"))
+       (catalog:add-link 'curses
+			 (in-vicinity (implementation-vicinity) "crs"
+				      link:able-suffix)
+			 (usr:lib "ncurses")
+			 ;;(usr:lib "curses")
+			 ;;(usr:lib "termcap")
+			 (usr:lib "c"))
+       (catalog:add-link 'edit-line
+			 (in-vicinity (implementation-vicinity) "edline"
+				      link:able-suffix)
+			 (usr:lib "edit")
+			 (usr:lib "termcap")
+			 (usr:lib "c"))
+       (catalog:add-link 'regex
+			 (in-vicinity (implementation-vicinity) "rgx"
+				      link:able-suffix)
+			 (usr:lib "c"))
+       (catalog:add-link 'unix
+			 (in-vicinity (implementation-vicinity) "unix"
+				      link:able-suffix)
+			 (in-vicinity (implementation-vicinity) "ioext"
+				      link:able-suffix)
+			 (usr:lib "c"))
+       (catalog:add-link 'posix
+			 (in-vicinity (implementation-vicinity) "posix"
+				      link:able-suffix)
+			 (usr:lib "c"))
+       (catalog:add-link 'socket
+			 (in-vicinity (implementation-vicinity) "socket"
+				      link:able-suffix)
+			 (usr:lib "c"))
+       (cond ((catalog:add-link 'i/o-extensions
+				(in-vicinity (implementation-vicinity) "ioext"
+					     link:able-suffix)
+				(usr:lib "c"))
+	      (set! *catalog* (append '((line-i/o . i/o-extensions)
+					(pipe . i/o-extensions))
+				      *catalog*))))
+       (cond ((catalog:add-link 'rev2-procedures
+				(in-vicinity (implementation-vicinity) "sc2"
+					     link:able-suffix))
+	      (set! *catalog* (cons '(rev3-procedures . rev2-procedures)
+				    *catalog*))))
+       (catalog:add-link 'record
+			 (in-vicinity (implementation-vicinity) "record"
+				      link:able-suffix))
+       (catalog:add-link 'generalized-c-arguments
+			 (in-vicinity (implementation-vicinity) "gsubr"
+				      link:able-suffix))
+       (catalog:add-link 'array-for-each
+			 (in-vicinity (implementation-vicinity) "ramap"
+				      link:able-suffix))
+       ))
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..2bb47f6
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,384 @@
+# Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
+# 
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+# 
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with this software; see the file COPYING.  If not, write to
+# the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+#
+# As a special exception, the Free Software Foundation gives permission
+# for additional uses of the text contained in its release of GUILE.
+#
+# The exception is that, if you link the GUILE library with other files
+# to produce an executable, this does not by itself cause the
+# resulting executable to be covered by the GNU General Public License.
+# Your use of that executable is in no way restricted on account of
+# linking the GUILE library code into it.
+#
+# This exception does not however invalidate any other reasons why
+# the executable file might be covered by the GNU General Public License.
+#
+# This exception applies only to the code released by the
+# Free Software Foundation under the name GUILE.  If you copy
+# code from other Free Software Foundation releases into a copy of
+# GUILE, as the General Public License permits, the exception does
+# not apply to the code that you add in this way.  To avoid misleading
+# anyone as to the status of such modified files, you must delete
+# this exception notice from them.
+#
+# If you write modifications of your own for GUILE, it is your choice
+# whether to permit this exception to apply to your modifications.
+# If you do not wish that, delete this exception notice.  
+
+# "Makefile" for scm4e6 Scheme Interpreter
+# Author: Aubrey Jaffer
+
+SHELL = /bin/sh
+#CC =
+CFLAGS = #-g
+#LIBS =
+LD = $(CC) #-g
+
+# directory where COPYING and Init.scm reside.
+#IMPLPATH = /usr/local/src/scm/
+#this one is good for bootstrapping
+IMPLPATH = `pwd`/
+# Pathname where Init.scm resides.
+IMPLINIT = $(IMPLPATH)Init.scm
+DFLAG = -DIMPLINIT=\"$(IMPLINIT)\"
+
+# If pathname where Init.scm resides is not known in advance then
+# SCM_INIT_PATH is the environment variable whose value is the
+# pathname where Init.scm resides.
+
+intro:
+	@echo
+	@echo "This is scm$(VERSION).  Read \"scm.info\" (from \"scm.texi\")"
+	@echo "to learn how to build and install SCM."
+	@echo "Here is a quick guide:"
+	@echo
+	@echo "  From: bos@scrg.cs.tcd.ie"
+	@echo "  Build and install scripts using GNU autoconf are"
+	@echo "  available as scmconfig.tar.gz in the SCM distribution"
+	@echo "  directories.  See README.unix in scmconfig.tar.gz for"
+	@echo "  further instructions."
+	@echo
+	@echo "  Alternatively:"
+	@echo "      make scmlit"
+	@echo
+	@echo "  If you are on a non-unix system, create an empty file"
+	@echo "  \"scmflags.h\".  Then compile time.c, repl.c, scl.c,"
+	@echo "  sys.c, eval.c, subr.c, unif.c, and rope.c.  Then link"
+	@echo "  them to create a \"scmlit\" executable."
+	@echo
+	@echo "  Once you have built scmlit successfully, test it:"
+	@echo "      make checklit"
+	@echo "  If this reports no errors, use scmlit to build.scm"
+	@echo "  fancier versions of scm, with optional features."
+
+ofiles = time.o repl.o scl.o sys.o eval.o subr.o unif.o rope.o \
+	continue.o findexec.o
+# ramap.o
+
+all:	scmlit
+scmlit:	$(ofiles) scm.o
+	$(LD) -o scmlit $(ofiles) scm.o $(LIBS)
+scm.o:	scm.c scm.h scmfig.h patchlvl.h scmflags.h
+	$(CC) $(CFLAGS) -c $(DFLAG) scm.c
+scmflags.h:	scmflags
+scmflags:
+	echo "#ifndef IMPLINIT" > scmflags.h
+	echo "#define IMPLINIT \"$(IMPLINIT)\"" >> scmflags.h
+	echo "#endif" >> scmflags.h
+
+.c.o:
+	$(CC) -c $(CFLAGS) $< -o $@
+scl.o:	scl.c scm.h scmfig.h scmflags.h
+eval.o:	eval.c scm.h scmfig.h scmflags.h setjump.h
+unif.o:	unif.c scm.h scmfig.h scmflags.h
+#ramap.o:	ramap.c scm.h scmfig.h scmflags.h
+repl.o:	repl.c scm.h scmfig.h scmflags.h setjump.h
+sys.o:	sys.c scm.h scmfig.h scmflags.h setjump.h
+time.o:	time.c scm.h scmfig.h scmflags.h
+subr.o:	subr.c scm.h scmfig.h scmflags.h
+rope.o:	rope.c scm.h scmfig.h scmflags.h
+continue.o:	continue.c continue.h setjump.h
+	$(CC) $(CFLAGS) -c continue.c
+
+srcdir=$(HOME)/scm/
+
+udscm:
+	$(srcdir)build.scm -hsystem -Fcautious bignums arrays inexact \
+	engineering-notation dump dynamic-linking -o udscm
+
+myscm:	udscm $(ifiles)
+	./udscm -o scm
+mylib:
+	$(srcdir)build.scm -hsystem -Fcautious bignums arrays inexact \
+	engineering-notation dump dynamic-linking -tlib
+pgscm:
+	$(srcdir)build.scm -hsystem -Fcautious bignums arrays inexact \
+	engineering-notation dump dynamic-linking -o udscm \
+	 --compiler-options=-pg --linker-options=-pg
+	./udscm -o pgscm
+mydebug:
+	$(srcdir)build.scm -hsystem -Fcautious bignums arrays inexact \
+	engineering-notation dump dynamic-linking debug -ogdbscm \
+	 --compiler-options=-Wall --linker-options=-Wall
+mydlls:
+	$(srcdir)build.scm -h system -t dll -c sc2.c rgx.c crs.c edline.c \
+		record.c gsubr.c ioext.c posix.c unix.c socket.c \
+		ramap.c
+myturtle:
+	$(srcdir)build.scm -h system -F turtlegr -t dll
+
+checklit:	r4rstest.scm
+	./scmlit -fr4rstest.scm -e'(test-sc4)(test-cont)(test-delay)(gc)'
+check:	r4rstest.scm
+	./scm -fr4rstest.scm -e'(test-sc4)(test-cont)(test-delay)(gc)'
+bench:
+	echo `whoami`@`hostname` testing scm >> BenchLog
+	echo  on `date` >> BenchLog
+	ls -l scm >> BenchLog
+	size scm >> BenchLog
+	uname -a >> BenchLog
+	./scm -lbench.scm
+	cat bench.log >> BenchLog
+	echo >> BenchLog
+	echo
+	tail -20 BenchLog
+benchlit:
+	echo `whoami`@`hostname` testing scmlit >> BenchLog
+	echo  on `date` >> BenchLog
+	ls -l scmlit >> BenchLog
+	size scmlit >> BenchLog
+	uname -a >> BenchLog
+	./scmlit -lbench.scm
+	cat bench.log >> BenchLog
+	echo >> BenchLog
+	echo
+	tail -20 BenchLog
+
+dvidir=../dvi/
+dvi:	$(dvidir)scm.dvi
+$(dvidir)scm.dvi:	$(srcdir)scm.texi $(dvidir)scm.fn Makefile
+#	cd $(dvidir);texi2dvi $(srcdir)scm.texi
+	-(cd $(dvidir);export set TEXINPUTS=$(srcdir):$$TEXINPUTS;texindex scm.??)
+	cd $(dvidir);export set TEXINPUTS=$(srcdir):$$TEXINPUTS;tex $(srcdir)scm.texi
+$(dvidir)scm.fn:
+	cd $(dvidir);tex $(srcdir)scm.texi
+xdvi:	$(dvidir)scm.dvi
+	xdvi -s 3 $(dvidir)scm.dvi
+htmldir=../public_html/
+html:	$(htmldir)scm_toc.html
+$(htmldir)scm_toc.html:	$(srcdir)scm.texi
+	cd $(htmldir);make scm_toc.html
+
+################ INSTALL DEFINITIONS ################
+
+prefix = /usr/local/
+exec_prefix = $(prefix)/
+# directory where `make install' will put executable.
+bindir = $(exec_prefix)bin/
+libdir = $(exec_prefix)lib/
+# directory where `make install' will put manual page.
+man1dir = $(prefix)man/man1/
+infodir = $(prefix)info/
+includedir = $(prefix)include/
+
+info:	$(infodir)/scm.info
+$(infodir)/scm.info:	scm.texi
+	makeinfo scm.texi -o $(infodir)/scm.info
+
+infoz:	$(infodir)/scm.info.gz
+$(infodir)/scm.info.gz:	$(infodir)/scm.info
+	-rm $(infodir)/scm.info*.gz
+	gzip $(infodir)/scm.info*
+
+install:	scm.1
+	test -d $(bindir) || mkdir $(bindir)
+	test -d $(man1dir) || mkdir $(man1dir)
+	-cp scm $(bindir)
+	-strip $(bindir)scm
+	-cp scm.1 $(man1dir)
+	test -d $(IMPLPATH) || mkdir $(IMPLPATH)
+	-cp Init.scm $(IMPLPATH)
+	-cp Link.scm $(IMPLPATH)
+	-cp Transcen.scm $(IMPLPATH)
+	-cp COPYING $(IMPLPATH)
+
+installlib:
+	test -d $(includedir) || mkdir $(includedir)
+	cp scm.h $(includedir)scm.h
+	cp scmfig.h $(includedir)scmfig.h
+	test -d $(libdir) || mkdir $(libdir)
+	cp libscm.a $(libdir)libscm.a
+
+uninstall:
+	-rm $(bindir)scm
+	-rm $(man1dir)scm.1
+	-rm $(includedir)scm.h
+	-rm $(includedir)scmfig.h
+	-rm $(libdir)libscm.a
+#	-rm $(IMPLPATH)Init.scm
+#	-cp $(IMPLPATH)Link.scm
+#	-rm $(IMPLPATH)Transcen.scm
+#	-rm $(IMPLPATH)COPYING
+
+scm.doc:	scm.1
+	nroff -man $< | ul -tunknown >$@
+
+#### Stuff for maintaining SCM below ####
+
+VERSION = 4e6
+ver = $(VERSION)
+RM_R = rm -rf
+cfiles = scm.c time.c repl.c ioext.c scl.c sys.c eval.c subr.c sc2.c \
+	unif.c rgx.c crs.c dynl.c record.c posix.c socket.c unix.c \
+	rope.c ramap.c gsubr.c edline.c Iedline.scm continue.c \
+	findexec.c
+ufiles = pre-crt0.c ecrt0.c gmalloc.c unexec.c unexelf.c
+confiles = scmconfig.h.in mkinstalldirs acconfig-1.5.h install-sh \
+	configure configure.in Makefile.in COPYING README.unix
+
+hfiles = scm.h scmfig.h setjump.h patchlvl.h continue.h
+ifiles = Init.scm Transcen.scm Link.scm
+tfiles = r4rstest.scm example.scm pi.scm pi.c split.scm bench.scm
+dfiles = ANNOUNCE README COPYING scm.1 scm.doc QUICKREF \
+	scm.texi ChangeLog 
+mfiles = Makefile build.scm build.bat
+vfiles = setjump.mar setjump.s
+afiles = $(dfiles) $(cfiles) $(hfiles) $(ifiles) $(tfiles) $(mfiles) \
+	$(vfiles) $(ufiles)
+
+makedev = make -f $(HOME)/makefile.dev
+CHPAT=$(HOME)/bin/chpat
+dest = $(HOME)/dist/
+temp/scm:	$(afiles)
+	-$(RM_R) temp
+	mkdir temp
+	mkdir temp/scm
+	ln $(afiles) temp/scm
+
+dist:	$(dest)scm$(VERSION).tar.gz
+$(dest)scm$(VERSION).tar.gz:	temp/scm
+	$(makedev) DEST=$(dest) PROD=scm ver=$(VERSION) tar.gz
+shar:	scm.shar
+scm.shar:	temp/scm
+	$(makedev) PROD=scm shar
+dclshar:	scm.com
+com:	scm.com
+scm.com:	temp/scm
+	$(makedev) PROD=scm com
+zip:	scm.zip
+scm.zip:	temp/scm
+	$(makedev) PROD=scm zip
+distzip:	scm$(VERSION).zip
+scm$(VERSION).zip:	temp/scm turtle turtlegr.c grtest.scm require.scm
+	$(makedev) DEST=$(dest) PROD=scm ver=$(VERSION) zip
+	cd ..; zip -9ur $(dest)scm$(VERSION).zip \
+		scm/turtle scm/turtlegr.c scm/grtest.scm scm/require.scm
+	mv $(dest)scm$(VERSION).zip /c/scm/dist/
+pubzip:	temp/scm
+	$(makedev) DEST=$(HOME)/pub/ PROD=scm zip
+
+diffs:	pubdiffs
+pubdiffs:	temp/scm
+	$(makedev) DEST=$(HOME)/pub/ PROD=scm pubdiffs
+distdiffs:	temp/scm
+	$(makedev) DEST=$(dest) PROD=scm ver=$(ver) distdiffs
+
+
+HOBBITVERSION = 4d
+hobfiles = README.hob hobbit.doc hobbit.tms hobbit.scm scmhob.h
+
+hobtemp/scm:	$(hobfiles)
+	-$(RM_R) hobtemp
+	mkdir hobtemp
+	mkdir hobtemp/scm
+	ln $(hobfiles) hobtemp/scm
+
+hobdist:	$(dest)hobbit$(HOBBITVERSION).tar.gz
+$(dest)hobbit$(HOBBITVERSION).tar.gz:	hobtemp/scm
+	$(makedev) DEST=$(dest) PROD=scm ver=-hob$(HOBBITVERSION) \
+		tar.gz TEMP=hobtemp/
+	mv $(dest)scm-hob$(HOBBITVERSION).tar.gz \
+		$(dest)hobbit$(HOBBITVERSION).tar.gz
+hobbit$(HOBBITVERSION).zip:	hobtemp/scm
+	$(makedev) TEMP=hobtemp/ name=hobbit$(HOBBITVERSION) PROD=scm zip
+
+new:
+	$(CHPAT) scm$(VERSION) scm$(ver) ANNOUNCE ../jacal/ANNOUNCE \
+		../wb/README ../wb/ANNOUNCE \
+		../public_html/README.html ../dist/README \
+		../public_html/SLIB.html ../public_html/JACAL.html \
+		../public_html/SCM.html ../public_html/Hobbit.html \
+		/c/scm/dist/install.bat /c/scm/dist/makefile \
+		/c/scm/dist/mkdisk.bat
+	$(CHPAT) $(VERSION) $(ver) README scm.texi patchlvl.h \
+		Init.scm ../public_html/SCM.html Makefile
+
+configtemp/scm:	$(confiles)
+	-$(RM_R) configtemp/scm
+	-mkdir configtemp
+	mkdir configtemp/scm
+	ln $(confiles) configtemp/scm
+confdist:	scmconfig.tar.gz
+scmconfig.tar.gz:	configtemp/scm
+	cd configtemp; tar cohf ../scmconfig.tar scm
+	chmod 664 scmconfig.tar
+	-rm -f scmconfig.tar.*z
+	gzip scmconfig.tar
+	chmod 664 scmconfig.tar.*z
+
+lint:	lints
+lints:	$(cfiles) $(hfiles)
+	lint $(CPPFLAGS) $(ALL_CFLAGS) $(cfiles) | tee lints
+#	lint $(CPPFLAGS) $(ALL_CFLAGS) $(cfiles) | tee lintes
+
+#seds to help find names not unique in first 8 characters (name8s)
+# for BSD nm format
+SED_TO_STRIP_NM=sed -e '/.*\.o$$/d' -e 's/.* _//' -e 's/.* T //'
+#old, bad for T [^_] on suns: SED_TO_STRIP_NM=sed -e '/.*\.o$$/d' -e 's/.* _//'
+# For a System V nm where plain C identifiers have _ prepended:
+#SED_TO_STRIP_NM=sed -e '/^_[A-Za-z][A-za-z0-9_]*[ 	|].*|extern|!d' -e 's/|/ /g' -e 's/^_//'
+# For a System V nm where plain C identifiers have nothing prepended:
+#SED_TO_STRIP_NM=sed -e '/^[A-Za-z][A-za-z0-9_]*[ 	|].*|extern|!d' -e 's/|/ /g'
+
+name8:	name8s
+name8s:	scm
+	nm scm |\
+	$(SED_TO_STRIP_NM) |\
+	sort -u|\
+	awk '{	if (substr(l,1,8)==substr($$1,1,8)) {\
+			if (p) print l;\
+			print $$1;p=0;stat=1\
+		}else p=1;\
+		l=$$1\
+	     }END{exit stat}' -
+ctags:	$(hfiles) $(cfiles)
+	etags $(hfiles) $(cfiles)
+TAGS:
+tags:	$(hfiles) $(cfiles) $(ifiles) $(vfiles) $(ufiles)\
+	hobbit.scm scm.texi README build.scm # $(mfiles) ChangeLog
+	etags $(hfiles) $(cfiles) $(ifiles) $(vfiles) $(ufiles)\
+	hobbit.scm scm.texi README build.scm # $(mfiles) ChangeLog
+mostlyclean:
+clean:
+	-rm -f *~ *.bak *.orig *.rej core a.out ramap.o $(ofiles) scm.o \
+	lints tmp* \#* *\#
+	-$(RM_R) *temp
+distclean:	clean
+	-rm -f $(EXECFILES) *.o a.out TAGS
+realclean:	distclean
+	-rm -f scm.doc
+realempty:	temp/scm
+	-rm -f $(afiles)
diff --git a/Makefile.in b/Makefile.in
new file mode 100644
index 0000000..c2f69c5
--- /dev/null
+++ b/Makefile.in
@@ -0,0 +1,462 @@
+# Copyright (C) 1990, 1991, 1992, 1993 Aubrey Jaffer.	-*- Makefile -*-
+# This file is part of SCM.
+# 
+# SCM 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.
+#
+# SCM is distributed in the hope that 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 SCM; see the file COPYING.  If not, write to the Free
+# Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+#
+# Makefile for SCM
+#
+
+# Ultrix 2.2 make doesn't expand the value of VPATH.
+srcdir = @srcdir@
+
+CC = @CC@
+
+CFLAGS = @CFLAGS@ -I. -I$(srcdir)
+LDFLAGS = @LDFLAGS@
+
+# Define these for your system as follows:
+#	-DRTL		To create a run-time library only (no
+#			interactive front end).
+#	-DRECKLESS	To turn most SCM error schecking off.
+#	-DCAUTIOUS	To always check the number of arguments to
+#			interpreted closures.
+#	-DIO_EXTENSIONS	To get primitives such as chdir, delete-file,
+#			file-opisition, and pipes.
+#	-DPROMPT=\"..\"	To change the default prompt.
+#	-DFLOATS	To turn on support for inexact numbers.
+#	-DSINGLES	To use single-precision floats (if a float is
+#			the same size as a long).
+#	-DSINGLESONLY	To make all inexact real numbers to be single
+#			precision.  Only useful if SINGLES is also
+#			defined.
+#	-DGC_FREE_SEGMENTS
+#			To have all segments of unused heap be freed
+#			up after garbage collection.  Do not define if
+#			you never want the heap to shrink.
+#	-DTICKS		If you want the ticks and ticks-interrupt
+#			functions defined.
+#	-DBRACKETS_AS_PARENS
+#			To have square brackets read as parentheses
+#			in forms.
+#	-DMEMOIZE_LOCALS To speed up most local variable references.
+#			You will need to remove this and recompile
+#			eval.c if you use very large or deep
+#			environments (more than 4095 bound variables
+#			in one procedure).
+#	-DENGNOT	To use engineering notation instead of
+#			scientific notation.
+#	-DSICP		To make SCM more compatible with the Scheme used
+#			in Abelson & Sussman's book.
+#	-DSTACK_LIMIT	To limit the maximum growth of the stack (you
+#			almost certainly don't want this).
+# See also `scmconfig.h' and `scmfig.h'.
+defines = @DEFS@ \
+	-DCAUTIOUS -DARRAYS -DBIGNUMS -DCCLO \
+	-DFLOATS -DIO_EXTENSIONS -DMEMOIZE_LOCALS -DGC_FREE_SEGMENTS
+
+# If you are using user extension files, change INITS and FINALS
+# below.  INITS makes up the initialization calls for user extension
+# files.  FINALS defines the finalization calls for user extension
+# files.
+
+# File	INITS		FINALS		functions defined
+#
+# sc2.c	init_sc2\(\)			substring-move-left!,
+#					substring-move-right!,
+#					substring-fill!, append!, last-pair
+# rgx.c	init_rgx\(\)			regcomp, regexec (POSIX)
+# crs.c	init_curses\(\) lendwin\(\)	... lots ...
+
+INITS = -DINITS=init_sc2\(\)\;
+FINALS = -DFINALS=\;
+
+# If you are using rgx.c, set the next line to point to the include
+# directory where your POSIX regexp include files live (if you are using
+# GNU regex).
+# RGXFLAGS = -I/archive/regex-0.11/
+
+# If your system needs extra libraries loaded in, define them here.
+#	-lm		For floating point math (needed).
+#	-lcurses	For crs.c extensions.
+#	-lncurses	For curses on Linux (curses has bugs).
+#	-lterm{cap,lib}	May be required for curses support.
+#	-lregex		For POSIX regexp support (rgx.c).
+LOADLIBES = @LIBS@ -lm
+
+# Any extra object files your system needs.
+extras = @LIBOBJS@
+
+# Common prefix for machine-independent installed files.
+prefix = /usr/local
+# Common prefix for machine-dependent installed files.
+exec_prefix = $(prefix)
+
+# Name under which to install SCM.
+instname = scm
+# Directory to install `scm' in.
+bindir = $(exec_prefix)/bin
+# Directory in which to install Init.scm, COPYING, and Transcen.scm.
+libdir = $(exec_prefix)/lib/scm
+# Directory to search by default for included makefiles.
+includedir = $(prefix)/include
+# Directory to install the Info files in.
+infodir = $(prefix)/info
+# Directory to install the man page in.
+mandir = $(prefix)/man/man$(manext)
+# Number to put on the man page filename.
+manext = 1
+# Directory to perform pre-install tests in.
+testdir = $(srcdir)
+
+# Program to install `scm'.
+INSTALL_PROGRAM = @INSTALL_PROGRAM@
+# Program to install the man page.
+INSTALL_DATA = @INSTALL_DATA@
+# Generic install program.
+INSTALL = @INSTALL@
+
+# Program to format Texinfo source into Info files.
+MAKEINFO = makeinfo
+# Program to format Texinfo source into DVI files.
+TEXI2DVI = texi2dvi
+
+# Programs to make tags files.
+ETAGS = etags
+CTAGS = ctags -tw
+
+# You should not need to change below this line.
+
+SHELL = /bin/sh
+DFLAG = -DIMPLINIT=\"$(libdir)/Init.scm\"
+TDFLAG = -DIMPLINIT=\"$(testdir)/Init.scm\"
+# nunix = nonunix
+nunix = $(srcdir)
+# examples = examples
+examples = $(srcdir)
+ffiles = continue.o time.o repl.o fscl.o sys.o feval.o subr.o sc2.o \
+funif.o rope.o ramap.o findexec.o #rgx.o
+fifiles = continue.o time.o repl.o iscm.o fscl.o sys.o feval.o subr.o \
+sc2.o funif.o rope.o ramap.o findexec.o #rgx.o
+efiles = time.o repl.o escl.o sys.o eeval.o subr.o sc2.o eunif.o #rgx.o
+cfiles = $(srcdir)/scm.c $(srcdir)/time.c $(srcdir)/repl.c \
+	$(srcdir)/scl.c $(srcdir)/sys.c $(srcdir)/eval.c \
+	$(srcdir)/subr.c $(srcdir)/sc2.c $(srcdir)/unif.c \
+	$(srcdir)/rgx.c $(srcdir)/crs.c $(srcdir)/dynl.c $(srcdir)/findexec.c
+hfiles = $(srcdir)/scm.h $(srcdir)/scmfig.h scmconfig.h \
+	$(srcdir)/setjump.h $(srcdir)/patchlvl.h
+ifiles = Init.scm Transcen.scm
+tfiles = $(examples)/test.scm $(examples)/example.scm \
+	$(examples)/pi.scm $(examples)/pi.c $(examples)/split.scm
+dfiles = $(srcdir)/README $(srcdir)/COPYING $(srcdir)/scm.1 \
+	$(srcdir)/QUICKREF $(srcdir)/MANUAL $(srcdir)/ChangeLog \
+	$(srcdir)/code.doc $(srcdir)/ANNOUNCE
+mfiles = Makefile $(nunix)/makefile.msc $(nunix)/makefile.bor \
+	$(nunix)/makefile.tur $(nunix)/makefile.djg \
+	$(nunix)/makefile.emx $(nunix)/makefile.qc \
+	$(nunix)/compile.amiga $(nunix)/link.amiga \
+	$(nunix)/makefile.aztec $(nunix)/makefile.ast \
+	$(nunix)/makefile.prj $(nunix)/dmakefile \
+	$(nunix)/makefile.wcc
+vfiles = $(nunix)/setjump.mar $(nunix)/VMSBUILD.COM $(nunix)/VMSGCC.COM
+afiles = $(dfiles) $(cfiles) $(hfiles) $(ifiles) $(tfiles) $(mfiles) $(vfiles)
+
+.SUFFIXES:
+.SUFFIXES: .o .c .h .ps .dvi .info .texinfo .scm
+
+.PHONY: all
+all: scm
+
+# -DINITS= the initialization calls for user extension files.
+# -DFINALS= the finalialization calls for user extension files.
+dbscm: escm.a sc2.o $(srcdir)/../wb/db.a $(srcdir)/scm.c $(srcdir)/scm.h \
+		$(srcdir)/scmfig.h $(srcdir)/patchlvl.h Makefile
+	$(CC) -o dbscm $(CFLAGS) $(INITS)init_db\(\)\;init_rgx\(\) \
+		$(FINALS)final_db\(\) $(defines) $(srcdir)/scm.c \
+		escm.a $(srcdir)/../wb/db.a $(LOADLIBES) $(extras)
+	rm escm.a
+curscm: escm.a crs.o
+	$(CC) -o curscm $(CFLAGS) $(INITS)init_curses\(\)\;init_rgx\(\) \
+		$(FINALS)lendwin\(\) $(srcdir)/scm.c crs.o escm.a -lcurses \
+		$(LOADLIBES) $(extras)
+	rm escm.a
+dscm: dscm.a main.o
+	$(CC) -o dscm $(CFLAGS) main.o -ldld
+dscm.a: $(efiles) Makefile dynl.o $(srcdir)/scm.c
+	$(CC) $(CFLAGS) -DRTL $(INITS)init_dynl\(\) -c $(srcdir)/scm.c
+	ar crvs dscm.a scm.o dynl.o $(efiles) $(LOADLIBES)
+dynl.o: $(srcdir)/dynl.c $(srcdir)/scm.h $(srcdir)/scmfig.h \
+		Makefile
+	$(CC) $(CFLAGS) -DDLD -DRTL -c $(srcdir)/dynl.c
+
+instscm: $(fifiles)
+	$(CC) -o instscm $(fifiles) $(LOADLIBES) $(extras)
+
+scm: $(ffiles) fscm.o
+	$(CC) -o scm $(ffiles) fscm.o $(LOADLIBES) $(extras)
+fscm.o: $(srcdir)/scm.c $(srcdir)/scm.h $(srcdir)/scmfig.h \
+		scmconfig.h $(srcdir)/patchlvl.h
+	$(CC) $(CFLAGS) $(TDFLAG) $(defines) -c $(FFLAGS) $(INITS) \
+		$(FINALS) $(srcdir)/scm.c
+	mv scm.o fscm.o
+
+iscm.o: $(srcdir)/scm.c $(srcdir)/scm.h $(srcdir)/scmfig.h \
+		scmconfig.h $(srcdir)/patchlvl.h
+	$(CC) $(CFLAGS) $(DFLAG) $(defines) -c $(FFLAGS) $(INITS) \
+		$(FINALS) $(srcdir)/scm.c
+	mv scm.o iscm.o
+
+fscl.o: $(srcdir)/scl.c $(srcdir)/scm.h $(srcdir)/scmfig.h \
+		scmconfig.h
+	$(CC) $(CFLAGS) $(defines) -c $(FFLAGS) $(srcdir)/scl.c
+	mv scl.o fscl.o
+feval.o: $(srcdir)/eval.c $(srcdir)/scm.h $(srcdir)/scmfig.h \
+		scmconfig.h
+	$(CC) $(CFLAGS) $(defines) -c $(FFLAGS) $(srcdir)/eval.c
+	mv eval.o feval.o
+funif.o: $(srcdir)/unif.c $(srcdir)/scm.h $(srcdir)/scmfig.h \
+		scmconfig.h
+	$(CC) $(CFLAGS) $(defines) -c $(FFLAGS) $(srcdir)/unif.c
+	mv unif.o funif.o
+
+escm: $(efiles) escm.o
+	$(CC) -o escm $(efiles) escm.o $(LOADLIBES) $(extras)
+escm.o: $(srcdir)/scm.c $(srcdir)/scm.h $(srcdir)/scmfig.h \
+		scmconfig.h $(srcdir)/patchlvl.h
+	$(CC) $(CFLAGS) $(defines) -c $(INITS) $(FINALS) $(srcdir)/scm.c
+	mv scm.o escm.o
+escl.o: $(srcdir)/scl.c $(srcdir)/scm.h $(srcdir)/scmfig.h \
+		scmconfig.h
+	$(CC) $(CFLAGS) $(defines) -c $(srcdir)/scl.c
+	mv scl.o escl.o
+eeval.o: $(srcdir)/eval.c $(srcdir)/scm.h $(srcdir)/scmfig.h \
+		scmconfig.h
+	$(CC) $(CFLAGS) $(defines) -c $(srcdir)/eval.c
+	mv eval.o eeval.o
+eunif.o: $(srcdir)/unif.c $(srcdir)/scm.h scmconfig.h
+	$(CC) $(CFLAGS) $(defines) -c unif.c
+	mv unif.o eunif.o
+
+repl.o: $(srcdir)/repl.c $(srcdir)/scm.h $(srcdir)/scmfig.h \
+		$(srcdir)/setjump.h scmconfig.h
+	$(CC) $(CFLAGS) $(defines) -c $(TDFLAG) $(srcdir)/repl.c
+sys.o: $(srcdir)/sys.c $(srcdir)/scm.h $(srcdir)/scmfig.h \
+		$(srcdir)/setjump.h scmconfig.h
+	$(CC) $(CFLAGS) $(defines) -c $(srcdir)/sys.c
+continue.o: $(srcdir)/continue.c $(srcdir)/scm.h $(srcdir)/scmfig.h \
+		$(srcdir)/setjump.h scmconfig.h
+	$(CC) $(CFLAGS) $(defines) -c $(srcdir)/continue.c
+rope.o: $(srcdir)/rope.c $(srcdir)/scm.h $(srcdir)/scmfig.h \
+		$(srcdir)/setjump.h scmconfig.h
+	$(CC) $(CFLAGS) $(defines) -c $(srcdir)/rope.c
+ramap.o: $(srcdir)/ramap.c $(srcdir)/scm.h $(srcdir)/scmfig.h \
+		$(srcdir)/setjump.h scmconfig.h
+		$(CC) $(CFLAGS) $(defines) -c $(srcdir)/ramap.c
+time.o: $(srcdir)/time.c $(srcdir)/scm.h $(srcdir)/scmfig.h \
+		scmconfig.h
+	$(CC) $(CFLAGS) $(defines) -c $(srcdir)/time.c
+subr.o: $(srcdir)/subr.c $(srcdir)/scm.h $(srcdir)/scmfig.h \
+		scmconfig.h
+	$(CC) $(CFLAGS) $(defines) -c $(srcdir)/subr.c
+sc2.o: $(srcdir)/sc2.c $(srcdir)/scm.h scmconfig.h
+	$(CC) $(CFLAGS) $(defines) -c $(srcdir)/sc2.c
+rgx.o: $(srcdir)/rgx.c $(srcdir)/scm.h Makefile scmconfig.h
+	$(CC) $(CFLAGS) $(defines) $(RGXFLAGS) -c rgx.c
+crs.o: $(srcdir)/crs.c $(srcdir)/scm.h scmconfig.h
+	$(CC) $(CFLAGS) $(defines) -c crs.c
+findexec.o: $(srcdir)/findexec.c
+	$(CC) $(CFLAGS) $(defines) -c $(srcdir)/findexec.c
+
+both: scm escm
+
+$(srcdir)/proto.h: $(cfiles)
+	rm -f $(srcdir)/proto.h
+	mkproto $(cfiles) > $(srcdir)/proto.h
+
+libscm.a: rtlscm.o $(ffiles)
+	rm -f libscm.a
+	ar rc libscm.a rtlscm.o $(ffiles)
+	$(RANLIB) libscm.a
+
+rtlscm.o: $(srcdir)/scm.c $(srcdir)/scm.h $(srcdir)/scmfig.h \
+		$(srcdir)/patchlvl.h scmconfig.h
+	$(CC) $(CFLAGS) $(defines) -c $(FFLAGS) -DRTL $(INITS)init_user_scm\(\) \
+	$(FINALS) $(srcdir)/scm.c
+	mv scm.o rtlscm.o
+
+.PHONY: install installdirs
+install: installdirs \
+	$(bindir)/$(instname) $(mandir)/$(instname).$(manext) \
+	$(libdir)/Init.scm $(libdir)/Transcen.scm $(libdir)/COPYING
+
+installdirs:
+	$(SHELL) ${srcdir}/mkinstalldirs $(bindir) $(infodir) \
+		$(mandir) $(libdir)
+
+$(bindir)/$(instname): instscm
+	$(INSTALL_PROGRAM) instscm $@.new
+# Some systems can't deal with renaming onto a running binary.
+	-rm -f $@.old
+	-mv $@ $@.old
+	mv $@.new $@
+
+$(mandir)/$(instname).$(manext): $(srcdir)/scm.1
+	$(INSTALL_DATA) $(srcdir)/scm.1 $@
+
+$(libdir)/Init.scm: $(srcdir)/Init.scm
+	$(INSTALL_DATA) $(srcdir)/Init.scm $@
+
+$(libdir)/Transcen.scm: $(srcdir)/Transcen.scm
+	$(INSTALL_DATA) $(srcdir)/Transcen.scm $@
+
+$(libdir)/COPYING: $(srcdir)/COPYING
+	$(INSTALL_DATA) $(srcdir)/COPYING $@
+
+.PHONY: tar shar dclshar com zip pubzip
+tar: scm.tar
+shar: scm.shar
+dclshar: scm.com
+com: scm.com
+zip: scm.zip
+scm.tar: temp/scm
+	cd temp; tar chf ../scm.tar scm
+	chmod 664 scm.tar
+scm.shar: temp/scm
+	cd temp; shar scm >../scm.shar
+	chmod 664 scm.shar
+scm.com: temp/scm
+	cd temp; dclshar scm >../scm.com
+	chmod 664 scm.com
+scm.zip: temp/scm
+	cd temp; zip -r ../scm.zip scm
+	chmod 664 scm.zip
+pubzip: temp/scm
+	cd temp; zip -ru ../../pub/scm.zip scm
+	chmod 664 ../pub/scm.zip
+
+temp/scm: $(afiles)
+	-rm -rf temp
+	mkdir temp
+	mkdir temp/scm
+	ln $(afiles) temp/scm
+
+.PHONY: dist tar.Z tar.gz shar.Z
+dist: tar.gz
+tar.Z: scm.tar.Z
+tar.gz: scm.tar.gz
+shar.Z: scm.shar.Z
+scm.tar.Z: scm.tar
+	-rm -f scm.tar.Z
+	compress scm.tar
+	chmod 664 scm.tar.Z
+scm.tar.gz: scm.tar
+	-rm -f scm.tar.gz
+	gzip scm.tar
+	chmod 664 scm.tar.gz
+scm.shar.Z: scm.shar
+	-rm -f scm.shar.Z
+	compress scm.shar
+	chmod 664 scm.shar.Z
+
+.PHONY: pubdiffs distdiffs
+pubdiffs: temp/scm
+	mv temp/scm temp/nscm
+	cd temp;unzip ../../pub/scm.zip
+	-rm -f scm.diffs
+	-diff -c temp/scm temp/nscm > scm.diffs
+	-rm -rf temp
+	ls -l scm.diffs
+distdiffs: temp/scm
+	mv temp/scm temp/nscm
+	cd temp;zcat ../../dist/scm*.tar.gz | tar xvf -
+	-rm -f scm.pat
+	-diff -c temp/scm temp/nscm > scm.pat
+	-rm -rf temp
+	ls -l scm.pat
+
+.PHONY: checks check echeck
+checks: check echeck
+check: ./scm test.scm
+	echo '(test-sc4)(test-cont)(test-inexact)(gc)(exit (length errs))' \
+	| ./scm test.scm
+echeck: ./escm test.scm
+	echo '(test-sc4)(test-cont)(gc)(exit (length errs))' \
+	| ./escm test.scm
+
+.PHONY: lint
+lint: lints
+lints: $(cfiles) $(hfiles)
+	lint $(CFLAGS) $(cfiles) | tee lints
+#	lint $(CFLAGS) $(cfiles) | tee lintes
+
+# Seds to help find names not unique in first 8 characters (name8s).
+# for BSD nm format
+# SED_TO_STRIP_NM = sed -e '/.*\.o$$/d' -e 's/.* _//' -e 's/.* T //'
+#old, bad for T [^_] on suns: SED_TO_STRIP_NM=sed -e '/.*\.o$$/d' -e 's/.* _//'
+# For a System V nm where plain C identifiers have _ prepended:
+#SED_TO_STRIP_NM = sed -e '/^_[A-Za-z][A-za-z0-9_]*[ 	|].*|extern|!d' -e 's/|/ /g' -e 's/^_//'
+# For a System V nm where plain C identifiers have nothing prepended:
+#SED_TO_STRIP_NM = sed -e '/^[A-Za-z][A-za-z0-9_]*[ 	|].*|extern|!d' -e 's/|/ /g'
+SED_TO_STRIP_NM = :
+
+.PHONY: name8
+name8: name8s
+name8s: scm
+	nm scm |\
+	$(SED_TO_STRIP_NM) |\
+	sort -u|\
+	awk '{	if (substr(l,1,8)==substr($$1,1,8)) {\
+			if (p) print l;\
+			print $$1;p=0;stat=1\
+		}else p=1;\
+		l=$$1\
+	     }END{exit stat}' - |\
+	tee name8s
+
+tagsrcs = $(hfiles) $(cfiles) $(ifiles) $(mfiles) $(vfiles) \
+	MANUAL code.doc README
+TAGS: $(tagsrcs)
+	$(ETAGS) $(tagsrcs)
+tags: $(tagsrcs)
+	$(CTAGS) $(tagsrcs)
+
+.PHONY: clean cleanish realclean
+clean:
+	-rm -f *~ \#* *.o *\# *.orig *.rej a.out core lints tmp*
+	-rm -rf temp hobtemp
+cleanish:
+	-rm -f *~ \#* *\# *.orig *.rej a.out core lints tmp*
+	-rm -rf temp hobtemp
+distclean:
+	-rm -f *~ \#* *.o *\# *.orig *.rej a.out core TAGS lints tmp* \
+		scmconfig.h config.status
+	-rm -rf temp hobtemp
+
+Makefile: config.status $(srcdir)/Makefile.in
+	$(SHELL) config.status
+scmconfig.h: stamp-config ;
+stamp-config: config.status $(srcdir)/scmconfig.h.in
+	$(SHELL) config.status
+	touch stamp-config
+
+configure: configure.in
+	autoconf $(ACFLAGS)
+scmconfig.h.in: configure.in
+	autoheader $(ACFLAGS)
+
+# This tells versions [3.59,3.63) of GNU make not to export all variables.
+.NOEXPORT:
+
+# Automatically generated dependencies will be put at the end of the file.
diff --git a/QUICKREF b/QUICKREF
new file mode 100644
index 0000000..93ca5d4
--- /dev/null
+++ b/QUICKREF
@@ -0,0 +1,201 @@
+;; FILE             "Scheme Sigs"
+;; IMPLEMENTS   R^4RS Function Signature Synopsis
+;; AUTHOR           Kenneth A Dickey
+;; DATE             1992 October 2
+;; LAST UPDATED 1992 October 3
+;; NOTES:  Extracted from Amiga Gambit QuickTour file
+
+=== FUNCTION SYNOPSIS ===
+
+Notation:
+  <object>      any Scheme data object.
+  <object>*     zero or more objects
+  <object>+     one or more objects
+  [<object>]    optional object
+  ( <whatever> )...   Zero or more occurances of ( <whatever> )
+
+; SYNTAX
+
+  (LAMBDA <name> <exp>+ )
+  (LAMBDA (<name>* ) <exp>+ )
+  (AND <exp>*)
+  (OR  <exp>*)
+  (IF <test-exp> <if-true> [<if-false>] )
+  (COND (<test> <exp>* )... [(ELSE <exp>+)] )
+  (CASE <key-exp> ((<datum>+ ) <exp>* )... [(ELSE <exp>+)] )
+  (DEFINE ( <name> <name>* ) <exp>+ )
+  (DEFINE <name> <exp> )
+  (LET [<name>] ( (<vname> <value-exp>)... ) <exp>+ )
+  (LET*   ( (<vname> <value-exp>)... ) <exp>+ )
+  (LETREC ( (<vname> <value-exp>)... ) <exp>+ )
+  (BEGIN <expression>+ )
+  (DO ( (<var> <init> <step>)... ) ( <test> <exp>* ) <exp>* )
+  ;; Note also R^4RS syntax, below
+
+
+; IEEE Scheme
+
+  (NOT <object>)
+  (BOOLEAN? <object>)
+
+  (EQ?    <obj1> <obj2>)
+  (EQV?   <obj1> <obj2>)
+  (EQUAL? <obj1> <obj2>)
+
+  (PAIR? <object>)
+  (CONS <obj1> <obj2>)
+  (CAR <pair>)
+  (CDR <pair>)
+  (SET-CAR! <pair> <object>)
+  (SET-CDR! <pair> <object>)
+  (CAAR  <list>)   (CADR  <list>)   (CDAR  <list>)   (CDDR <list>)
+  (CAAAR <list>)   (CAADR <list>)   (CADAR <list>)   (CADDR <list>)
+  (CDAAR <list>)   (CDADR <list>)   (CDDAR <list>)   (CDDDR <list>)
+  (CAAAAR <list>)  (CAAADR <list>)  (CAADAR <list>)  (CAADDR <list>)
+  (CADAAR <list>)  (CADADR <list>)  (CADDAR <list>)  (CADDDR <list>)
+  (CDAAAR <list>)  (CDAADR <list>)  (CDADAR <list>)  (CDADDR <list>)
+  (CDDAAR <list>)  (CDDADR <list>)  (CDDDAR <list>)  (CDDDDR <list>)
+  (NULL? <object>)
+  (LIST? <object>)
+  (LIST <object>* )
+  (LENGTH <list>)
+  (APPEND <list>+ )
+  (REVERSE <list>)
+  (LIST-REF <list> <index>)
+
+  (MEMQ  <object> <list>)
+  (MEMV  <object> <list>)
+  (MEMBER <object> <list>)
+
+  (ASSQ  <object> <alist>)
+  (ASSV  <object> <alist>)
+  (ASSOC <object> <alist>)
+
+  (SYMBOL? <object>)  (SYMBOL->STRING <symbol>)  (STRING->SYMBOL <string>)
+
+  (NUMBER? <object>)
+  (COMPLEX? <object>)
+  (REAL? <object>)
+  (RATIONAL? <object>)
+  (INTEGER? <object>)
+  (EXACT? <number>)     (INEXACT? <number>)
+  (=  <number>+ )
+  (<  <number>+ )  (>  <number>+ )
+  (<= <number>+ )  (>= <number>+ )
+  (ZERO? <number>)
+  (POSITIVE? <number>)  (NEGATIVE? <number>)
+  (ODD? <number>)       (EVEN? <number>)
+  (MAX <number>+ )      (MIN <number>+ )
+  (+ <number>+ )
+  (* <number>+ )
+  (- <number>+ )
+  (/ <number>+ )
+  (ABS <number>)
+  (QUOTIENT <num1> <num2>)  (REMAINDER <num1> <num2>)
+  (MODULO <num1> <num2>)
+  (GCD <number>* )          (LCM <number>* )
+  (NUMERATOR <rational>)    (DENOMINATOR <rational>)
+  (FLOOR <number>)          (CEILING <number>)
+  (TRUNCATE <number>)       (ROUND <number>)
+  (RATIONALIZE <num1> <num2>)
+  (EXP <number>)            (LOG <number>)
+  (SIN <number>)   (COS <number>)   (TAN <number>)
+  (ASIN <number>)  (ACOS <number>)  (ATAN <number> [<number>])
+  (SQRT <number>)
+  (EXPT <num1> <num2>)
+  (MAKE-RECTANGULAR <num1> <num2>)  (MAKE-POLAR <num1> <num2>)
+  (REAL-PART <number>)       (IMAG-PART <number>)
+  (MAGNITUDE <number>)       (ANGLE <number>)
+  (EXACT->INEXACT <number>)  (INEXACT->EXACT <number>)
+  (NUMBER->STRING <number>)  (STRING->NUMBER <string>)
+
+  (CHAR? <object>)
+  (CHAR=?  <char1> <char2>)  (CHAR-CI=?  <char1> <char2>)
+  (CHAR<?  <char1> <char2>)  (CHAR-CI<?  <char1> <char2>)
+  (CHAR>?  <char1> <char2>)  (CHAR-CI>?  <char1> <char2>)
+  (CHAR<=? <char1> <char2>)  (CHAR-CI<=? <char1> <char2>)
+  (CHAR>=? <char1> <char2>)  (CHAR-CI>=? <char1> <char2>)
+  (CHAR-ALPHABETIC? <character>)
+  (CHAR-NUMERIC?    <character>)
+  (CHAR-WHITESPACE? <character>)
+  (CHAR-UPPER-CASE? <character>)  (CHAR-LOWER-CASE? <character>)
+  (CHAR->INTEGER <character>)     (INTEGER->CHAR    <integer>)
+  (CHAR-UPCASE   <character>)     (CHAR-DOWNCASE    <character>)
+
+  (STRING? <object>)
+  (MAKE-STRING <length> [<character>] )
+  (STRING <character>+ )
+  (STRING-LENGTH <string>)
+  (STRING-REF <string> <index>)
+  (STRING-SET! <string> <index> <character>)
+  (STRING=?  <string1> <string2>)  (STRING-CI=?  <string1> <string2>)
+  (STRING<?  <string1> <string2>)  (STRING-CI<?  <string1> <string2>)
+  (STRING>?  <string1> <string2>)  (STRING-CI>?  <string1> <string2>)
+  (STRING<=? <string1> <string2>)  (STRING-CI<=? <string1> <string2>)
+  (STRING>=? <string1> <string2>)  (STRING-CI>=? <string1> <string2>)
+  (SUBSTRING <string> <start-index> <end-index>)
+  (STRING-APPEND <string>+ )
+
+  (VECTOR? <object>)
+  (MAKE-VECTOR <length> [<object>] )
+  (VECTOR <object>* )
+  (VECTOR-LENGTH <vector>)
+  (VECTOR-REF  <vector> <index>)
+  (VECTOR-SET! <vector> <index> <object>)
+
+  (PROCEDURE? <object>)
+  (APPLY <procedure> <arg>* <arg-list>)
+  (MAP   <procedure> <list>+ )
+  (FOR-EACH <procedure> <list>+ )
+  (CALL-WITH-CURRENT-CONTINUATION <one-argument-procedure>)
+
+  (CALL-WITH-INPUT-FILE  <string> <procedure>)
+  (CALL-WITH-OUTPUT-FILE <string> <procedure>)
+  (INPUT-PORT? <object>)  (OUTPUT-PORT? <object>)
+  (CURRENT-INPUT-PORT)    (CURRENT-OUTPUT-PORT)
+  (OPEN-INPUT-FILE  <string>)       (OPEN-OUTPUT-FILE <string>)
+  (CLOSE-INPUT-PORT  <input-port>)  (CLOSE-OUTPUT-PORT <output-port>)
+  (EOF-OBJECT? <object>)
+  (READ [<input-port>] )
+  (READ-CHAR [<input-port>] )
+  (PEEK-CHAR [<input-port>] )
+  (WRITE   <object> [<output-port>] )
+  (DISPLAY <object> [<output-port>] )
+  (NEWLINE [<output-port>] )
+  (WRITE-CHAR <character> [<output-port>] )
+
+
+; R4RS Scheme
+
+  (LIST-TAIL <list> <index>)
+  (STRING->LIST <string>)
+  (LIST->STRING <list-of-characters>)
+  (STRING-COPY  <string>)
+  (STRING-FILL! <string> <character>)
+  (VECTOR->LIST <vector>)
+  (LIST->VECTOR <list>)
+  (VECTOR-FILL! <vector> <object>)
+  (DELAY <expression>)
+  (FORCE <promise>)
+  (WITH-INPUT-FROM-FILE <string> <thunk>)
+  (WITH-OUTPUT-TO-FILE  <string> <thunk>)
+  (CHAR-READY? [<input-port>] )
+  (LOAD <string>)
+  (TRANSCRIPT-ON <string>)
+  (TRANSCRIPT-OFF)
+
+  (DEFINE-SYNTAX <name> <transformer-spec>)     -- High-Level macros (only)
+  (LET-SYNTAX    ( <syntax-spec>* ) <exp>+ )
+  (LETREC-SYNTAX ( <syntax-spec>* ) <exp>+ )
+
+
+
+=== STANDARDS REFERENCES ===
+
+
+IEEE Standard 1178-1990. "IEEE Standard for the Scheme Programming
+Language", IEEE, New York, 1991, ISBN 1-55937-125-0 [1-800-678-IEEE:
+order # SH14209].  -- now also an ANSI standard.
+
+W. Clinger and J. Rees, eds., "Revised^4 Report on the Algorithmic
+Language Scheme", ACM LISP Pointers IV, 3 (July-September 1991).
diff --git a/README b/README
new file mode 100644
index 0000000..7dbcf52
--- /dev/null
+++ b/README
@@ -0,0 +1,384 @@
+This directory contains the distribution of scm4e6.  Scm conforms to
+Revised^4 Report on the Algorithmic Language Scheme and the IEEE P1178
+specification.  Scm runs under VMS, MS-DOS, OS2, MacOS, Amiga,
+Atari-ST, NOS/VE, Unix and similar systems.
+
+This file consists mainly of excerpts from "scm.info", the result of
+compiling (with makeinfo) "scm.texi" to `info' form.  In case of
+conflicts with "scm.info", consult "scm.info".
+
+The author can be reached at <jaffer@ai.mit.edu>
+
+			       MANIFEST
+
+  `README' is this file.  It contains a MANIFEST, INSTALLATION
+	INSTRUCTIONS, hints for EDITING SCHEME CODE, and a TROUBLE
+	SHOOTING GUIDE.
+  `COPYING' details the LACK OF WARRANTY for scm and the conditions
+	for distributing scm.
+  `scm.1' is the unix style man page in nroff format.
+  `scm.doc' is the text man page generated from scm.1.
+  `QUICKREF' is a Quick Reference card for IEEE and R4RS.
+  `scm.texi' details feature support and enhancements to Scheme and
+	contains a SCHEME BIBLIOGRAPHY.
+  `ChangeLog' documents changes to the scm.
+
+  `r4rstest.scm' is Scheme code which tests conformance with Scheme
+	specifications.
+  `example.scm' is Scheme code from Revised^4 Report on the
+	Algorithmic Language Scheme which uses inexact numbers.
+  `pi.scm' is Scheme code for computing digits of pi [type (pi 100 5)]
+	which can be used to test the performance of scm against
+	compiled C code [cc -o pi pi.c;time pi 100 5].
+  `pi.c' is C code for computing digits of pi.
+  `bench.scm' is Scheme code for computing and recording speed of
+	"pi.scm".
+
+  `Makefile' is for building scmlit using the `make' program.
+  `build.scm' creates a database and program for compiling and linking
+	new SCM executables, libraries, and dlls.
+  `build.bat' invokes build.scm on MS-DOS platforms.
+  `setjump.mar' provides setjmp and longjmp which do not use $unwind
+	utility on VMS.
+  `setjump.s' provides setjmp and longjmp for the Cray YMP.
+
+  `Init.scm' is Scheme initialization code.
+  `Transcen.scm' has Scheme code for inexact builtin procedures.
+  `Link.scm' has Scheme code for compiling and dynamic linking.
+  `scmfig.h' is a C include file containing system dependent definitions.
+  `patchlvl.h is the patchlevel of this release.
+  `continue.c' code for continuations.
+  `continue.h' data types and external functions for continuations.
+  `setjump.h' is an include file dealing with continuations, stacks,
+	and memory allocation.
+  `scm.h' has the data type and external definitions of scm.
+
+  `scm.c' has the top level and interrupt code.
+  `findexec.c' has code to find the executable file.
+  `time.c' has functions dealing with time.
+  `repl.c' has error, read-eval-print loop, read, write and load code.
+  `scl.c' has the code for utility functions which are not part of the
+	IEEE Scheme spec or which are required for non-integer
+	arithmetic.
+  `eval.c' has the evaluator, apply, map, and foreach.
+  `sys.c' has the code for opening and closing files, storage
+	allocation and garbage collection.
+  `rope.c' has C interface functions.
+  `subr.c' has all the rest of functions.
+  `sc2.c' has code for procedures from R2RS and R3RS not in R4RS.
+  `dynl.c' has c code for dynamically loading object files.
+  `unif.c' has code for uniform vectors.
+  `rgx.c' has code for string regular expression match.
+  `crs.c' has code for interactive terminal control.
+  `split.scm' sets up CURSCM (SCM with crs.c) so that input, output,
+	and diagnostic output are each directed to separate windows.
+  `edline.c' Gnu readline input editing
+	(get ftp.sys.toronto.edu:/pub/rc/editline.shar).
+  `Iedline.scm' Gnu readline input editing.
+  `record.c' has code for proposed "Record" user definable datatypes.
+  `gsubr.c' has make_gsubr for arbitrary (< 11) arguments to C functions.
+
+  `ioext.c' has code for system calls in common between PC compilers and unix.
+  `posix.c' has code for posix library interface.
+  `unix.c' has code for non-posix system calls on unix systems.
+  `socket.c' has code for socket interface.
+
+				 SLIB
+
+[SLIB] is a portable Scheme library meant to provide compatibility and
+utility functions for all standard Scheme implementations.  Although
+SLIB is not *neccessary* to run SCM, I strongly suggest you obtain and
+install it.  Bug reports about running SCM without SLIB have very low
+priority.  SLIB is available from the same sites as SCM:
+
+   * ftp-swiss.ai.mit.edu:pub/scm/slib2a6.tar.gz
+   * prep.ai.mit.edu:pub/gnu/jacal/slib2a6.tar.gz
+   * ftp.maths.tcd.ie:pub/bosullvn/jacal/slib2a6.tar.gz
+   * ftp.cs.indiana.edu:/pub/scheme-repository/imp/slib2a6.tar.gz
+
+Unpack SLIB (`tar xzf slib2a6.tar.gz' or `unzip -ao slib2a6.zip') in an
+appropriate directory for your system; both `tar' and `unzip' will
+create the directory `slib'.
+
+Then create a file `require.scm' in the SCM "implementation-vicinity"
+(this is the same directory as where the file `Init.scm' is installed).
+`require.scm' should have the contents:
+
+     (define (library-vicinity) "/usr/local/lib/slib/")
+     (load (in-vicinity (library-vicinity) "require"))
+
+where the pathname string `/usr/local/lib/slib/' is to be replaced by
+the pathname into which you installed SLIB.  Absolute pathnames are
+recommended here; if you use a relative pathname, SLIB can get confused
+when the working directory is changed (*note chmod: I/O-Extensions.).
+The way to specify a relative pathname is to append it to the
+implementation-vicinity, which is absolute:
+
+     (define library-vicinity
+       (let ((lv (string-append (implementation-vicinity) "../slib/")))
+         (lambda () lv)))
+     (load (in-vicinity (library-vicinity) "require"))
+
+Alternatively, you can set the (shell) environment variable
+`SCHEME_LIBRARY_PATH' to the pathname of the SLIB directory (*note
+SCHEME_LIBRARY_PATH: SCM Variables.).  If set, the environment variable
+overrides `require.scm'.  Again, absolute pathnames are recommended.
+
+			      MAKING SCM
+
+  The SCM distribution has "Makefile" which contains rules for making
+"scmlit", a "bare-bones" version of SCM sufficient for running
+`build.scm'.  `build.scm' is used to compile (or create scripts to
+compile) full featured versions.
+
+  Makefiles are not portable to the majority of platforms.  If
+`Makefile' works for you, good; If not, I don't want to hear about it.
+If you need to compile SCM without build.scm, there are several ways to
+proceed:
+
+   * Use SCM on a different platform to run `build.scm' to create a
+     script to build SCM;
+
+   * Use another implementation of Scheme to run `build.scm' to create a
+     script to build SCM;
+
+   * Create your own script or `Makefile'.
+
+   * Buy a SCM executable from jaffer@ai.mit.edu.  See the end of
+     `ANNOUNCE' in the distribution for details.
+
+   * Use scmconfig (From: bos@scrg.cs.tcd.ie):
+
+     Build and install scripts using GNU "autoconf" are available from
+     `scmconfig4e6.tar.gz' in the distribution directories.  See
+     `README.unix' in `scmconfig4e6.tar.gz' for further instructions.
+
+		  Making SCM with Think C 4.0 or 4.1
+
+Note: These instructions need to be uptdated for scm4e6.  If Think C
+can be called using system(), then SCM can be built using build.scm.
+
+  Edit Scmfig.H to set desired options and IMPLINIT.
+  from Yasuaki Honda // honda@csl.SONY.co.jp:
+  Make a project and add source files repl.c, time.c, scm.c, subr.c,
+  sys.c, eval.c, scl.c, sc2.c, and unif.c to it.
+  Add libraries MacTraps, unix, ANSI to the project.
+  The project should be segmented in the following way:
+    ----------
+    repl.c
+    scm.c
+    subr.c
+    sys.c
+    sc2.c
+    unif.c
+    time.c
+    ----------
+    MacTraps
+    unix
+    ----------
+    ANSI
+    ----------
+    eval.c
+    ----------
+    scl.c
+    ----------
+  Choose 'Set Project Type' from 'Project' menu.
+    Choose Application from radio buttons.
+    Set Partition size to 600K. (The default 384K is not enough).
+
+			 EDITING SCHEME CODE
+
+Gnu Emacs:
+     Editing of Scheme code is supported by emacs.  Buffers holding
+     files ending in .scm are automatically put into scheme-mode.
+
+     If your Emacs can run a process in a buffer you can use the Emacs
+     command `M-x run-scheme' with SCM.  However, the run-scheme
+     (`xscheme.el') which comes included with Gnu Emacs 18 will work
+     only with MIT Cscheme.  If you are using Emacs 18, get the emacs
+     packages:
+
+        * ftp-swiss.ai.mit.edu:/pub/scheme-editor-packages/cmuscheme.el
+
+        * ftp-swiss.ai.mit.edu:/pub/scheme-editor-packages/comint.el
+
+     These files are already standard in Emacs 19.
+
+     If your Emacs can not run a process in a buffer, see "under other
+     systems" below.
+
+Epsilon (MS-DOS):
+     There is lisp (and scheme) mode available by use of the package
+     `LISP.E'.  It offers several different indentation formats.  With
+     this package, buffers holding files ending in `.L', `.LSP', `.S',
+     and `.SCM' (my modification) are automatically put into lisp-mode.
+
+     It is possible to run a process in a buffer under Epsilon.  With
+     Epsilon 5.0 the command line options `-e512 -m0' are neccessary to
+     manage RAM properly.  It has been reported that when compiling SCM
+     with Turbo C, you need to `#define NOSETBUF' for proper operation
+     in a process buffer with Epsilon 5.0.
+
+     One can also call out to an editor from SCM if RAM is at a
+     premium; See "under other systems" below.
+
+other systems:
+     Define the environment variable `EDITOR' to be the name of the
+     editing program you use.  The SCM procedure `(ed arg1 ...)' will
+     invoke your editor and return to SCM when you exit the editor.  The
+     following definition is convenient:
+
+          (define (e) (ed "work.scm") (load "work.scm"))
+
+     Typing `(e)' will invoke the editor with the file of interest.
+     After editing, the modified file will be loaded.
+
+			   TROUBLE SHOOTING
+
+Reported problems and solutions are grouped under "Compiling",
+"Linking", "Running", and "Testing".  If you don't find your problem
+listed here, you can send a bug report to <jaffer@ai.mit.edu>.  The
+bug report should include:
+
+ * The version of SCM (printed when SCM is invoked with no arguments).
+
+ * The type of computer you are using.
+
+ * The name and version of your computer's operating system.
+
+ * The values of the environment variables SCM_INIT_PATH and
+   SCHEME_LIBRARY_PATH.
+
+ * The name and version of your C compiler.
+
+ * If you are using an executable from a distribution, the name,
+   vendor, and date of that distribution.  In this case,
+   corresponding with the vendor is recommended.
+
+
+		Compiling:
+
+FILE	ERROR or WARNING			HOW TO FIX
+
+*.c	include file not found			Correct status of
+						STDC_HEADERS
+
+						fix #include statement
+						or add #define for
+						system type to scmfig.h
+
+scm.c	assignment between incompatible types	change SIGRETTYPE in scm.c
+
+time.c	CLK_TCK redefined			incompatablility
+						between <stdlib.h> and
+						<sys/types.h>.  remove
+						STDC_HEADERS in scmfig.h
+
+						edit <sys/types.h> to
+						remove incompatability.
+
+sys.c	statement not reached			ignore
+	constant in conditional expression	ignore
+
+sys.c: `???' undeclared, outside of functions	#undef STDC_HEADERS
+						in scmfig.h
+
+scl.c	syntax error				define system type in
+						scmfig.h and scl.c (softtype)
+
+		Linking:
+
+ERROR or WARNING			HOW TO FIX
+
+_sin etc. missing.			uncomment LIBS in makefile
+
+		Running:
+
+PROBLEM					HOW TO FIX
+
+Opening message and then machine	Change memory model option
+crashes.				to C compiler (or makefile).
+
+					Make sure sizet definition is
+					correct in scmfig.h
+
+					Reduce size of HEAP_SEG_SIZE
+					in setjump.h
+
+Input hangs				#define NOSETBUF
+
+ERROR: heap: need larger initial	Need to increase the initial
+					heap allocation using
+					-a<kbytes> or INIT_HEAP_SIZE.
+
+ERROR: Could not allocate ...		Check sizet definition.
+
+					Get more memory.
+
+					Don't try to run as subproccess
+
+... in scmfig.h and recompile scm	Do it and recompile files.
+
+ERROR: Init.scm not found		Assign correct IMPLINIT in
+					makefile or scmfig.h or
+					define environment variable
+					SCM_INIT_PATH to be the full
+					pathname of Init.scm (see
+					INSTALLATION instructions).
+
+WARNING: require.scm not found		define environment variable
+					SCHEME_LIBRARY_PATH to be the
+					full pathname of the scheme
+					library SLIB or change
+					library-vicinity in Init.scm
+					to point to library or remove.
+					See section SLIB above.
+
+					Make sure library-vicinity has
+					a trailing file separator
+					(like / or \).
+
+		Testing: (load "r4rstest.scm") or (load "pi.scm") (pi 100 5)
+
+Runs some and then machine crashes.	See above under machine
+					crashes.
+
+Runs some and then ERROR: ...		Remove optimization option
+(after a GC has happened)		to C compiler and recompile.
+
+					#define SHORT_ALIGN in scmfig.h
+
+Some symbol names print incorrectly.	Change memory model option
+					to C compiler (or makefile).
+
+					Check that HEAP_SEG_SIZE fits
+					within sizet.
+
+					Increase size of HEAP_SEG_SIZE
+					(or INIT_HEAP_SIZE if it is
+					smaller than HEAP_SEG_SIZE).
+
+ERROR: Rogue pointer in Heap.		See above under machine
+					crashes.
+
+Newlines don't appear correctly in	Check file mode (define OPEN_...
+output files.				in Init.scm
+
+Spaces or control characters appear	Check character defines in
+in symbol names				scmfig.h
+
+Negative numbers turn positive.		Check SRS in scmfig.h
+
+VMS: Couldn't unwind stack		#define CHEAP_CONTIUATIONS
+VAX: botched longjmp			in scmfig.h
+
+Sparc(SUN-4) heap is growing out of control:
+
+	You are experiencing a GC problem peculiar to the Sparc.  The
+	problem is that SCM doesn't know how to clear register
+	windows.  Every location which is not reused still gets marked
+	at GC time.  This causes lots of stuff which should be
+	collected to not be.  This will be a problem with any
+	"conservative" GC until we find what instruction will clear
+	the register windows.  This problem is exacerbated by using
+	lots of call-with-current-continuations.
diff --git a/README.unix b/README.unix
new file mode 100644
index 0000000..0f9094d
--- /dev/null
+++ b/README.unix
@@ -0,0 +1,182 @@
+This file contains the instructions for building scm4e under Unix
+systems.  Scm conforms to Revised^4 Report on the Algorithmic Language
+Scheme and the IEEE P1178 specification.  Scm runs under VMS, MS-DOS,
+OS2, MacOS, Amiga, Atari-ST, NOS/VE, Unix and similar systems.
+ 
+The author of scm can be reached at <jaffer@ai.mit.edu> or
+Aubrey Jaffer, 84 Pleasant St., Wakefield MA 01880.
+
+The Unix installation support included in this scmconfig distribution
+has been written by myself, Bryan O'Sullivan <bosullvn@maths.tcd.ie>,
+and is maintained by me.  Please direct any problems you have with
+either scm itself or this configuration software to <bug-scm@scrg.cs.tcd.ie>.
+
+NOTE: Before you get started, make sure that you have unpacked this
+      scmconfig distribution into the whatever directory you have
+      unpacked the same version of scm.
+
+Several chunks of this file have been lifted more or less verbatim
+from the standard INSTALL file which comes with most GNU utilities
+these days.
+
+			       MANIFEST
+
+  `README.unix' is this file.  It contains a MANIFEST, INSTALLATION
+	INSTRUCTIONS, TROUBLESHOOTING, and various other information.
+  `COPYING' details the LACK OF WARRANTY for scmconfig and scm and the
+	conditions for distributing scm and scmconfig.
+  `acconfig-1.5.h' is a temporary fix for a bug in version 1.5 of GNU
+	autoconf.  This file should not concern you unless you are
+	familiar with autoconf (you don't need to be).
+  `configure' is an executable shell script which generates
+	`scmconfig.h' and `Makefile'.
+  `configure.in' is a template file used by with autoconf (autoconf is
+	not needed to build scm), which produces the `configure'
+	script.
+  `scmconfig.h.in' is an automatically-generated template file used by
+	configure, which produces `scmconfig.h'.
+  `Makefile.in' is a template file used by configure, which produces
+	`Makefile'.
+
+		      INSTALLATION INSTRUCTIONS
+
+To compile this package:
+
+1.  In the directory that this file is in, type `./configure'.  If
+    you're using `csh' on an old version of System V, you might need
+    to type `sh configure' instead to prevent `csh' from trying to
+    execute `configure' itself.
+
+    You may wish to edit the generated `Makefile' file in order to
+    customise scm to your own preferences.  The comments in there
+    should be adequate to let you decide what you want to do.
+    `Makefile' has a reasonable set of defaults for most Unix systems,
+    so you may not have to edit it at all.
+
+[You can skip the rest of this section (down to point 2 below) the
+ first time around.]
+
+    The `configure' shell script attempts to guess correct values for
+    various system-dependent variables used during compilation, and
+    creates the Makefile.
+
+    Running `configure' takes a minute or two.  While it is running,
+    it prints some messages that tell what it is doing.  If you don't
+    want to see the messages, run `configure' with its standard output
+    redirected to `/dev/null'; for example, `./configure >/dev/null'.
+
+    To compile the package in a different directory from the one
+    containing the source code, you must use a version of `make' that
+    supports the VPATH variable, such as GNU `make'.  `cd' to the
+    directory where you want the object files and executables to go
+    and run `configure'.  `configure' automatically checks for the
+    source code in the directory that `configure' is in and in `..'.
+    If for some reason `configure' is not in the source code directory
+    that you are configuring, then it will report that it can't find
+    the source code.  In that case, run `configure' with the option
+    `--srcdir=DIR', where DIR is the directory that contains the
+    source code.
+
+    See the section titled `INSTALL' below on building scm with
+    different default search paths.  By default, when you run `make',
+    scm looks in the source directory for `Init.scm'.  The binary
+    which is built when you run `make install' looks in the correct
+    places for files.
+
+    Another `configure' option is useful mainly in `Makefile' rules
+    for updating `config.status' and `Makefile'.  The `--no-create'
+    option figures out the configuration for your system and records
+    it in `config.status', without actually configuring the package
+    (creating `Makefile's and perhaps a configuration header file).
+    Later, you can run `./config.status' to actually configure the
+    package.  You can also give `config.status' the `--recheck'
+    option, which makes it re-run `configure' with the same arguments
+    you used before.  This option is useful if you change `configure'.
+
+    `configure' ignores any other arguments that you give it.
+
+    If your system requires unusual options for compilation or linking
+    that `configure' doesn't know about, you can give `configure'
+    initial values for some variables by setting them in the
+    environment.  In Bourne-compatible shells, you can do that on the
+    command line like this:
+	CC='gcc -traditional' DEFS=-D_POSIX_SOURCE ./configure
+
+2.  Type `make' to compile the package.  If you want, you can override
+    the `make' variables CFLAGS and LDFLAGS like this:
+	make CFLAGS=-O2 LDFLAGS=-s
+
+3.  Test scm.  This is done in the following way (user input comes
+    after the `bash$' and `>' prompts):
+	bash$ scm
+	SCM version xxx, Copyright (C) 1990, 1991, 1992, 1993 Aubrey Jaffer.
+	SCM comes with ABSOLUTELY NO WARRANTY; for details type `(terms)'.
+	This is free software, and you are welcome to redistribute it
+	under certain conditions; type `(terms)' for details.
+	;loading ".../Transcen.scm"
+	;done loading ".../Transcen.scm"
+	;Evaluation took 230 mSec (0 in gc) 8661 cons work
+	> (load "test.scm")
+	...
+	> (test-sc4)
+	...
+	> (test-cont)
+	...
+	> (test-inexact)
+
+4.  You can remove the program binaries and object files from the
+    source directory by typing `make clean'.  To also remove the
+    Makefile(s), the header file containing system-dependent definitions
+    (if the package uses one), and `config.status' (all the files that
+    `configure' created), type `make distclean'.
+
+[You can skip this next bit unless you are editing the `configure.in'
+ file, which you should not do unless you are familiar with autoconf.]
+
+    If you are using versions of autoconf before or including 1.5, you
+    should rename `acconfig-1.5.h' to `acconfig.h' before running
+    autoheader, since these distributions do not handle
+    `TIME_WITH_SYS_TIME' correctly.
+
+			       INSTALL
+
+Type `make install' to install programs, data files, and
+documentation.
+
+By default, `make install' will install the package's files in
+/usr/local/bin, /usr/local/lib, /usr/local/man, etc.  You can specify
+an installation prefix other than /usr/local by giving `configure' the
+option `--prefix=PATH'.  Alternately, you can do so by consistently
+giving a value for the `prefix' variable when you run `make', e.g.,
+	make prefix=/usr/gnu
+	make prefix=/usr/gnu install
+
+You can specify separate installation prefixes for
+architecture-specific files and architecture-independent files.  If
+you give `configure' the option `--exec-prefix=PATH' or set the `make'
+variable `exec_prefix' to PATH, the package will use PATH as the
+prefix for installing programs and libraries.  Data files and
+documentation will still use the regular prefix.  Normally, all files
+are installed using the regular prefix.
+
+			   TROUBLESHOOTING
+
+If you encounter any problems while building scm, please send
+electronic mail to <bug-scm@scrg.cs.tcd.ie> with a description of the
+problem, and any solution to it you may have found.  Some mention of
+the version of Unix you are trying to build scm on, and the versions
+of scm and scmconfig you are using, would be helpful in diagnosing the
+problem.
+
+If you encounter any problems with system include files not being
+found, or attempts being made to read the wrong files, please contact
+<bug-scm@scrg.cs.tcd.ie> with a description of the include files that
+are not being handled correctly; the problem probably lies in the
+autoconf support, and can usually be quickly fixed by manually editing
+`scmconfig.h'.
+
+If you find that scm does not link because it cannot find a
+time-related function, please mail a description of the problem to
+<bug-scm@scrg.cs.tcd.ie>, stating which function(s) can't be found.
+In the mean time, editing the top of `time.c' should provide a fix for
+the problem.
diff --git a/Transcen.scm b/Transcen.scm
new file mode 100644
index 0000000..896f77f
--- /dev/null
+++ b/Transcen.scm
@@ -0,0 +1,133 @@
+;; Copyright (C) 1992, 1993, 1995 Free Software Foundation, Inc.
+;; 
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; 
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; 
+;; You should have received a copy of the GNU General Public License
+;; along with this software; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;
+;; As a special exception, the Free Software Foundation gives permission
+;; for additional uses of the text contained in its release of GUILE.
+;;
+;; The exception is that, if you link the GUILE library with other files
+;; to produce an executable, this does not by itself cause the
+;; resulting executable to be covered by the GNU General Public License.
+;; Your use of that executable is in no way restricted on account of
+;; linking the GUILE library code into it.
+;;
+;; This exception does not however invalidate any other reasons why
+;; the executable file might be covered by the GNU General Public License.
+;;
+;; This exception applies only to the code released by the
+;; Free Software Foundation under the name GUILE.  If you copy
+;; code from other Free Software Foundation releases into a copy of
+;; GUILE, as the General Public License permits, the exception does
+;; not apply to the code that you add in this way.  To avoid misleading
+;; anyone as to the status of such modified files, you must delete
+;; this exception notice from them.
+;;
+;; If you write modifications of your own for GUILE, it is your choice
+;; whether to permit this exception to apply to your modifications.
+;; If you do not wish that, delete this exception notice.  
+
+;;;; "Transcen.scm", Complex trancendental functions for SCM.
+;;; Author: Jerry D. Hedden.
+
+(define compile-allnumbers #t)		;for HOBBIT compiler
+
+(define (exp z)
+  (if (real? z) ($exp z)
+      (make-polar ($exp (real-part z)) (imag-part z))))
+
+(define (log z)
+  (if (and (real? z) (>= z 0))
+      ($log z)
+      (make-rectangular ($log (magnitude z)) (angle z))))
+
+(define (sqrt z)
+  (if (real? z)
+      (if (negative? z) (make-rectangular 0 ($sqrt (- z)))
+	  ($sqrt z))
+      (make-polar ($sqrt (magnitude z)) (/ (angle z) 2))))
+
+(define expt
+  (let ((integer-expt integer-expt))
+    (lambda (z1 z2)
+      (cond ((exact? z2)
+	     (integer-expt z1 z2))
+	    ((and (real? z2) (real? z1) (>= z1 0))
+	     ($expt z1 z2))
+	    (else
+	     (exp (* z2 (log z1))))))))
+
+(define (sinh z)
+  (if (real? z) ($sinh z)
+      (let ((x (real-part z)) (y (imag-part z)))
+	(make-rectangular (* ($sinh x) ($cos y))
+			  (* ($cosh x) ($sin y))))))
+(define (cosh z)
+  (if (real? z) ($cosh z)
+      (let ((x (real-part z)) (y (imag-part z)))
+	(make-rectangular (* ($cosh x) ($cos y))
+			  (* ($sinh x) ($sin y))))))
+(define (tanh z)
+  (if (real? z) ($tanh z)
+      (let* ((x (* 2 (real-part z)))
+	     (y (* 2 (imag-part z)))
+	     (w (+ ($cosh x) ($cos y))))
+	(make-rectangular (/ ($sinh x) w) (/ ($sin y) w)))))
+
+(define (asinh z)
+  (if (real? z) ($asinh z)
+      (log (+ z (sqrt (+ (* z z) 1))))))
+
+(define (acosh z)
+  (if (and (real? z) (>= z 1))
+      ($acosh z)
+      (log (+ z (sqrt (- (* z z) 1))))))
+
+(define (atanh z)
+  (if (and (real? z) (> z -1) (< z 1))
+      ($atanh z)
+      (/ (log (/ (+ 1 z) (- 1 z))) 2)))
+
+(define (sin z)
+  (if (real? z) ($sin z)
+      (let ((x (real-part z)) (y (imag-part z)))
+	(make-rectangular (* ($sin x) ($cosh y))
+			  (* ($cos x) ($sinh y))))))
+(define (cos z)
+  (if (real? z) ($cos z)
+      (let ((x (real-part z)) (y (imag-part z)))
+	(make-rectangular (* ($cos x) ($cosh y))
+			  (- (* ($sin x) ($sinh y)))))))
+(define (tan z)
+  (if (real? z) ($tan z)
+      (let* ((x (* 2 (real-part z)))
+	     (y (* 2 (imag-part z)))
+	     (w (+ ($cos x) ($cosh y))))
+	(make-rectangular (/ ($sin x) w) (/ ($sinh y) w)))))
+
+(define (asin z)
+  (if (and (real? z) (>= z -1) (<= z 1))
+      ($asin z)
+      (* -i (asinh (* +i z)))))
+
+(define (acos z)
+  (if (and (real? z) (>= z -1) (<= z 1))
+      ($acos z)
+      (+ (/ (angle -1) 2) (* +i (asinh (* +i z))))))
+
+(define (atan z . y)
+  (if (null? y)
+      (if (real? z) ($atan z)
+	  (/ (log (/ (- +i z) (+ +i z))) +2i))
+      ($atan2 z (car y))))
diff --git a/acconfig-1.5.h b/acconfig-1.5.h
new file mode 100644
index 0000000..4f33b04
--- /dev/null
+++ b/acconfig-1.5.h
@@ -0,0 +1,22 @@
+/* acconfig.h
+   This file is in the public domain.
+
+   Descriptive text for the C preprocessor macros that
+   the distributed Autoconf macros can define.
+   No software package will use all of them; autoheader copies the ones
+   your configure.in uses into your configuration header file templates.
+
+   The entries are in sort -df order: alphabetical, case insensitive,
+   ignoring punctuation (such as underscores).
+
+   Leave the following blank line there!!  Autoheader needs it.  */
+
+
+/* Define if <sys/time.h> and <time.h> do not clash with each other.  */
+#undef TIME_WITH_SYS_TIME
+
+
+/* Leave that blank line there!!  Autoheader needs it.
+   If you're adding to this file, keep in mind:
+   The entries are in sort -df order: alphabetical, case insensitive,
+   ignoring punctuation (such as underscores).  */
diff --git a/bench.scm b/bench.scm
new file mode 100644
index 0000000..acb4a2c
--- /dev/null
+++ b/bench.scm
@@ -0,0 +1,55 @@
+
+(require (in-vicinity (implementation-vicinity) "pi.scm"))
+(require 'transcript)
+(define isqrt
+  (cond ((provided? 'inexact) sqrt)
+	(else (require 'root) integer-sqrt)))
+(define i/
+  (cond ((provided? 'inexact) /)
+	(else quotient)))
+(define around
+  (cond ((provided? 'inexact)
+	 (lambda (x)
+	   (cond ((>= 3000 (abs x) 3) (inexact->exact (round x)))
+		 (else x))))
+	(else identity)))
+
+(define (time-pi digits)
+  (let ((start-time (get-internal-run-time)))
+    (pi digits 4)
+    (i/ (* 1000 (- (get-internal-run-time) start-time))
+       internal-time-units-per-second)))
+
+(define (benchmark . arg)
+  (define file
+    (cond ((null? arg) "bench.log")
+	  (else (car arg))))
+  (do ((digits 50 (+ digits digits))
+       (t 0 (time-pi (+ digits digits))))
+      ((> t 3000)
+       (do ((tl '() (cons (time-pi digits) tl))
+	    (j 12 (+ -1 j)))
+	   ((zero? j)
+	    (let* ((avg (i/ (apply + tl) (length tl)))
+		   (dev (isqrt (i/ (apply
+				    + (map (lambda (x) (* (- x avg) (- x avg)))
+						 tl))
+				   (length tl)))))
+	      (and file (transcript-on file))
+	      (for-each display
+			(list digits " digits took " (around avg) " mSec +/- "
+			      (around dev) " mSec."))
+	      (newline)
+	      (let ((scaled-avg (i/ (* (i/ (* avg 1000) digits) 1000) digits)))
+		(for-each display
+			  (list " That is about " scaled-avg
+				" mSec/k-digit^2 +/- "
+				(around
+				 (i/ (* 100 (i/ (* (i/ (* dev 1000) digits)
+						   1000) digits))
+				     scaled-avg))
+				"%."))
+		(newline)
+		(and file (transcript-off)))
+	      ))))))
+(benchmark)
diff --git a/build.bat b/build.bat
new file mode 100755
index 0000000..723e25e
--- /dev/null
+++ b/build.bat
@@ -0,0 +1 @@
+scm -f %0 -e(bi) build %1 %2 %3 %4 %5 %6 %7 %8 %9
diff --git a/build.scm b/build.scm
new file mode 100755
index 0000000..557a5ab
--- /dev/null
+++ b/build.scm
@@ -0,0 +1,1393 @@
+#!/bin/sh
+type;exec scmlit -f $0 -e"(bi)" build $*
+;;; "build.scm" Build database and program	-*-scheme-*-
+;;; Copyright (C) 1994, 1995, 1996 Aubrey Jaffer.
+;;; See the file `COPYING' for terms applying to this program.
+
+(require 'getopt)
+(require 'parameters)
+(require 'database-utilities)
+
+;;;(define build (create-database "buildscm.scm" 'alist-table))
+(define build (create-database #f 'alist-table))
+
+(require 'batch)
+(batch:initialize! build)
+
+(define-tables build
+
+  '(file-formats
+    ((format symbol))
+    ()
+    ((plaintext)
+     (c-source)
+     (c-header)
+     (scheme)
+     (vax-asm)
+     (cray-asm)
+     (makefile)
+     (MS-DOS-batch)
+     (nroff)
+     (texinfo)))
+
+  '(file-categories
+    ((category symbol))
+    ((documentation string))
+    ((documentation "Documentation file (or source for)")
+     (required "File required for building executable SCM")
+     (optional "File required for some feature")
+     (linkable "File whose object can be dynamically linked")
+     (test "File to test SCM")
+     (none "No files")))
+
+  '(build-whats
+    ((name symbol))
+    ((class file-categories)
+     (c-proc symbol)
+     (o-proc symbol)
+     (spec expression)
+     (documentation string))
+    ((exe required compile-c-files link-c-program #f
+	  "executable program")
+     (lib required compile-c-files make-archive ((define "RTL"))
+	  "library module")
+     (dlls linkable compile-dll-c-files make-dll-archive ((define "RTL"))
+	   "archived dynamically linked library object files")
+     (dll none compile-dll-c-files make-nothing #f
+	  "dynamically linked library object file")))
+
+  '(manifest
+    ((file string))
+    ((format file-formats)
+     (category file-categories)
+     (documentation string))
+    (("README"	plaintext	documentation	"contains a MANIFEST, INSTALLATION INSTRUCTIONS, hints for EDITING SCHEME CODE, and a TROUBLE SHOOTING GUIDE.")
+     ("COPYING"	plaintext	documentation	"details the LACK OF WARRANTY for SCM and the conditions for distributing SCM.")
+     ("scm.1"	nroff	documentation	"unix style man page.")
+     ("scm.doc"	plaintext	documentation	"man page generated from scm.1.")
+     ("QUICKREF"	plaintext	documentation	"Quick Reference card for R4RS and IEEE Scheme.")
+     ("scm.texi"	Texinfo	documentation	"SCM installation and use.")
+     ("ChangeLog"	plaintext	documentation	"changes to SCM.")
+     ("r4rstest.scm"	Scheme	test	"tests conformance with Scheme specifications.")
+     ("example.scm"	Scheme	test	"example from R4RS which uses inexact numbers.")
+     ("pi.scm"	Scheme	test	"computes digits of pi [type (pi 100 5)].  Test performance against pi.c.")
+     ("pi.c"	c-source	test	"computes digits of pi [cc -o pi pi.c;time pi 100 5].")
+     ("bench.scm"	Scheme	test	"computes and records performance statistics of pi.scm.")
+     ("Makefile"	Makefile	required	"builds SCMLIT using the `make' program.")
+     ("build.scm"	Scheme	required	"database for compiling and linking new SCM programs.")
+     ("build.bat"	MS-DOS-batch	optional	"invokes build.scm for MS-DOS")
+     ("setjump.mar"	Vax-asm	optional	"provides setjmp and longjmp which do not use $unwind utility on VMS.")
+     ("setjump.s"	Cray-asm	optional	"provides setjmp and longjmp for the Cray YMP.")
+     ("Init.scm"	Scheme	required	"Scheme initialization.")
+     ("Transcen.scm"	Scheme	required	"inexact builtin procedures.")
+     ("Link.scm"	Scheme	required	"compiles and dynamically links.")
+     ("scmfig.h"	c-header	required	"contains system dependent definitions.")
+     ("patchlvl.h"	c-header	required	"patchlevel of this release.")
+     ("setjump.h"	c-header	required	"continuations, stacks, and memory allocation.")
+     ("continue.h"	c-header	required	"continuations.")
+     ("continue.c"	c-source	required	"continuations.")
+     ("scm.h"	c-header	required	"data type and external definitions of SCM.")
+     ("scm.c"	c-source	required	"top level, interrupts, and non-IEEE utility functions.")
+     ("findexec.c"	c-source	required	"find the executable file function.")
+     ("time.c"	c-source	required	"functions dealing with time.")
+     ("repl.c"	c-source	required	"error, read-eval-print loop, read, write and load.")
+     ("scl.c"	c-source	required	"inexact arithmetic")
+     ("eval.c"	c-source	required	"evaluator, apply, map, and foreach.")
+     ("sys.c"	c-source	required	"call-with-current-continuation, opening and closing files, storage allocation and garbage collection.")
+     ("subr.c"	c-source	required	"the rest of IEEE functions.")
+     ("unif.c"	c-source	required	"uniform vectors.")
+     ("rope.c"	c-source	required	"C interface functions.")
+     ("ramap.c"	c-source	optional	"array mapping")
+     ("dynl.c"	c-source	optional	"dynamically load object files.")
+     ("sc2.c"	c-source	linkable	"procedures from R2RS and R3RS not in R4RS.")
+     ("rgx.c"	c-source	linkable	"string regular expression match.")
+     ("crs.c"	c-source	linkable	"interactive terminal control.")
+     ("split.scm"	Scheme	test	"example use of crs.c.  Input, output, and diagnostic output directed to separate windows.")
+     ("edline.c"	c-source	linkable	"Gnu readline input editing (get ftp.sys.toronto.edu:/pub/rc/editline.shar).")
+     ("Iedline.scm"	Scheme	optional	"Gnu readline input editing.")
+     ("record.c"	c-source	linkable	"proposed `Record' user definable datatypes.")
+     ("gsubr.c"	c-source	linkable	"make_gsubr for arbitrary (< 11) arguments to C functions.")
+     ("ioext.c"	c-source	linkable	"system calls in common between PC compilers and unix.")
+     ("posix.c"	c-source	linkable	"posix library interface.")
+     ("unix.c"	c-source	linkable	"non-posix system calls on unix systems.")
+     ("socket.c"	c-source	linkable	"BSD socket interface.")
+     ("pre-crt0.c"	c-source	optional	"loaded before crt0.o on machines which do not remap part of the data space into text space in unexec.")
+     ("ecrt0.c"	c-source	optional	"standard Vax 4.2 Unix crt0.c cannot be used because it makes `envron' an initialized variable.")
+     ("gmalloc.c"	c-source	optional	"Gnu malloc().")
+     ("unexec.c"	c-source	optional	"Convert a running program into an a.out file.")
+     ("unexelf.c"	c-source	optional	"Convert a running ELF program into an a.out file.")
+     )))
+
+(for-each (build 'add-domain)
+	  '((optstring #f (lambda (x) (or (not x) (string? x))) string #f)
+	    (filename #f #f string #f)
+	    (build-whats #f #f symbol #f)))
+
+(define-tables build
+
+  '(processor-family
+    ((family atom))
+    ((also-runs processor-family))
+    ((*unknown* #f)
+     (8086 #f)
+     (acorn #f)
+     (cray #f)
+     (hp-risc #f)
+     (i386 8086)
+     (m68000 #f)
+     (m68030 m68000)
+     (mips #f)
+     (nos/ve #f)
+     (pdp-10 #f)
+     (pdp-11 #f)
+     (pdp-8 #f)
+     (powerpc #f)
+     (pyramid #f)
+     (sequent #f)
+     (sparc #f)
+     (tahoe #f)
+     (vax pdp-11)
+     ))
+
+  '(platform
+    ((name symbol))
+    ((processor processor-family)
+     (operating-system operating-system)
+     (compiler symbol))
+    ((*unknown* *unknown* unix *unknown*)
+     (acorn-unixlib acorn *unknown* *unknown*)
+     (aix powerpc aix *unknown*)
+     (amiga-aztec m68000 amiga aztec)
+     (amiga-dice-c m68000 amiga dice-c)
+     (amiga-sas/c-5.10 m68000 amiga sas/c)
+     (atari-st-gcc m68000 atari.st gcc)
+     (atari-st-turbo-c m68000 atari.st turbo-c)
+     (borland-c-3.1 8086 ms-dos borland-c)
+     (djgpp i386 ms-dos gcc)
+     (gcc *unknown* unix gcc)
+     (highc.31 i386 ms-dos highc)
+     (hp-ux hp-risc hp-ux *unknown*)
+     (linux-aout i386 linux gcc)
+     (linux i386 linux gcc)
+     (microsoft-c 8086 ms-dos microsoft-c)
+     (microsoft-c-nt i386 ms-dos microsoft-c)
+     (microsoft-quick-c 8086 ms-dos microsoft-quick-c)
+     (ms-dos 8086 ms-dos *unknown*)
+     (os/2-cset i386 os/2 C-Set++)
+     (os/2-emx i386 os/2 gcc)
+     (sun sparc sun-os *unknown*)
+     (svr4 *unknown* unix *unknown*)
+     (turbo-c-2 8086 ms-dos turbo-c)
+     (unicos cray unicos *unknown*)
+     (unix *unknown* unix *unknown*)
+     (vms vax vms *unknown*)
+     (vms-gcc vax vms gcc)
+     (watcom-9.0 i386 ms-dos watcom)
+     ))
+
+  '(C-libraries
+    ((library symbol)
+     (platform platform))
+    ((compiler-flags string)
+     (link-lib-flag string)
+     (lib-path optstring)
+     (supress-files expression))
+
+    ((m *unknown* "" "-lm" "/usr/lib/libm.a" ())
+     (c *unknown* "" "-lc" "/usr/lib/libc.a" ())
+     (regex *unknown* "" "-lrgx" "/usr/lib/librgx.a" ())
+     (curses *unknown* "" "-lcurses" "/usr/lib/libcurses.a" ())
+     (graphics *unknown* "-I/usr/X11/include -DX11" "-lX11"
+	       "/usr/X11/lib/libX11.sa" ())
+     (editline *unknown* "" "-ledit" "/usr/lib/libedit.a" ())
+     (termcap *unknown* "" "-ltermcap" "/usr/lib/libtermcap.a" ())
+     (debug *unknown* "-g" "-g" #f ())
+
+     (m linux-aout "" "-lm" "/usr/lib/libm.sa" ())
+     (c linux-aout "" "-lc" "/usr/lib/libc.sa" ())
+     (dlll linux-aout "-DDLD -DDLD_DYNCM" "-ldld" #f ("findexec.c"))
+     (regex linux-aout "" "" "" ())
+     (curses linux-aout "-I/usr/include/ncurses" "-lncurses"
+	     "/usr/lib/libncurses.a" ())
+     (nostart linux-aout "" "-nostartfiles" #f ("ecrt0.c"))
+     (dump linux-aout "" "/usr/lib/crt0.o" #f ("unexelf.c"))
+
+     (m linux "" "-lm" "/lib/libm.so" ())
+     (c linux "" "-lc" "/lib/libc.so" ())
+     (dlll linux "-DSUN_DL" "-ldl" #f ())
+     (graphics linux "-I/usr/include/X11 -DX11" "-L/usr/X11R6/lib -lX11"
+	       "/usr/X11R6/lib/libX11.so" ())
+     (curses linux "" "-lcurses" "/lib/libncurses.so" ())
+     (nostart linux "" "" #f ("pre-crt0.c" "ecrt0.c"))
+     (dump linux "" "" #f ("unexec.c"))
+
+     (m acorn-unixlib "" "" #f ())
+
+     (m amiga-dice-c "" "-lm" #f ())
+     (m amiga-SAS/C-5.10 "" "lcmieee.lib" #f ())
+     (c amiga-SAS/C-5.10 "" "lc.lib" #f ())
+
+     (m vms-gcc "" "" #f ())
+     (m vms "" "" #f ())
+
+     (m atari-st-gcc "" "-lpml" #f ())
+     (m atari-st-turbo-c "" "" #f ())
+
+     (m sun "" "-lm" #f ())
+     (dlll sun "-DSUN_DL" "-ldl" #f ())
+     (nostart sun "" "-e __start -nostartfiles -static" #f ("pre-crt0.c"))
+     (dump sun "" "" #f ("unexec.c"))
+
+     (m hp-ux "" "-lm" #f ())
+     (dlll hp-ux "-DHAVE_DYNL" "-Wl,-E -ldld" #f ())
+     (graphics hp-ux "-DX11" "-lX" "/usr/lib/X11R5/libX11.sl" ())
+
+     (c djgpp "" "-lc" #f ("findexec.c"))
+     (curses djgpp "-I/djgpp/contrib/pdcurses/include/"
+	     "-L/djgpp/contrib/pdcurses/lib/ -lcurses"
+	     "\\djgpp\\contrib\\pdcurses\\lib\\libcurse.a" ())
+     (nostart djgpp "" "-nostartfiles" #f ("ecrt0.c"))
+     (dump djgpp "" "c:/djgpp/lib/crt0.o" #f ("unexelf.c"))
+
+     (c Microsoft-C "" "" #f ("findexec.c"))
+     (m Microsoft-C "" "" #f ())
+     (c Microsoft-C-nt "" "" #f ("findexec.c"))
+     (m Microsoft-C-nt "" "" #f ())
+     (c Microsoft-Quick-C "" "" #f ("findexec.c"))
+     (m Microsoft-Quick-C "" "" #f ())
+
+     (c Turbo-C-2 "" "" #f ("findexec.c"))
+     (m Turbo-C-2 "" "" #f ())
+     (graphics Turbo-C-2 "" "graphics.lib" #f ())
+
+     (c Borland-C-3.1 "" "" #f ("findexec.c"))
+     (m Borland-C-3.1 "" "" #f ())
+     (graphics Borland-C-3.1 "" "graphics.lib" #f ())
+     (windows Borland-C-3.1 "-N -W" "-W" #f ())
+
+     (c highc.31 "" "" #f ("findexec.c"))
+     (m highc.31 "" "" #f ())
+     (windows highc.31 "-Hwin" "-Hwin" #f ())
+     ))
+
+  '(compile-commands
+    ((name symbol)
+     (platform platform))
+    ((procedure expression))
+
+    ((compile-c-files Borland-C-3.1
+		      (lambda (files parms)
+			(define rsp-name "temp.rsp")
+			(apply batch:lines->file parms rsp-name files)
+			(batch:system parms
+				      "bcc" "-d" "-O" "-Z" "-G" "-w-pro" "-ml" "-c"
+				      (if (member '(define "FLOATS" #t)
+						  (c-defines parms))
+					  "" "-f-")
+				      (c-includes parms)
+				      (c-flags parms)
+				      (string-append "@" rsp-name))
+			(replace-suffix files ".c" ".obj")))
+     (link-c-program Borland-C-3.1
+		     (lambda (oname objects libs parms)
+		       (define lnk-name (string-append oname ".lnk"))
+		       (apply batch:lines->file parms
+			      lnk-name
+			      (append libs objects))
+		       (batch:system parms "bcc"
+				     (string-append "-e" oname)
+				     "-ml"
+				     (string-append "@" lnk-name))
+		       (string-append oname ".exe")))
+
+     (compile-c-files Turbo-C-2
+		      (lambda (files parms)
+			(batch:system parms
+				      "tcc" "-c" "-d" "-O" "-Z" "-G" "-ml" "-c"
+				      "-Ic:\\turboc\\include"
+				      (c-includes parms)
+				      (c-flags parms)
+				      files)
+			(replace-suffix files ".c" ".obj")))
+     (link-c-program Turbo-C-2
+		     (lambda (oname objects libs parms)
+		       (let ((exe (replace-suffix (car objects) ".obj" ".exe"))
+			     (oexe (string-append oname ".exe")))
+			 (if (not (string-ci=? exe oexe))
+			     (batch:delete-file parms oexe))
+			 (batch:system parms
+				       "tcc" "-Lc:\\turboc\\lib" libs objects)
+			 (if (not (string-ci=? exe oexe))
+			     (batch:rename-file parms exe oexe))
+			 oexe)))
+
+     (compile-c-files Microsoft-C
+		      (lambda (files parms)
+			(batch:system parms
+				      "cl" "-c" "Oxp" "-AH"
+				      (c-includes parms)
+				      (c-flags parms)
+				      files)
+			(replace-suffix files ".c" ".obj")))
+     (link-c-program Microsoft-C
+		     (lambda (oname objects libs parms)
+		       (let ((exe (replace-suffix (car objects) ".obj" ".exe"))
+			     (oexe (string-append oname ".exe")))
+			 (if (not (string-ci=? exe oexe))
+			     (batch:delete-file parms oexe))
+			 (batch:system parms
+				       "link" "/noe" "/ST:40000"
+				       (apply string-join "+"
+					      (map (lambda (o)
+						     (replace-suffix o ".obj" ""))
+						   objects))
+				       libs)
+			 (if (not (string-ci=? exe oexe))
+			     (batch:rename-file parms exe oexe))
+			 oexe)))
+     (compile-c-files Microsoft-C-nt
+		      (lambda (files parms)
+			(batch:system parms
+				      "cl" "-c"
+				      (c-includes parms)
+				      (c-flags parms)
+				      files)
+			(replace-suffix files ".c" ".obj")))
+     (link-c-program Microsoft-C-nt
+		     (lambda (oname objects libs parms)
+		       (let ((exe (replace-suffix (car objects) ".obj" ".exe"))
+			     (oexe (string-append oname ".exe")))
+			 (if (not (string-ci=? exe oexe))
+			     (batch:delete-file parms oexe))
+			 (batch:system parms
+				       "link"
+				       (apply string-join " "
+					      (map (lambda (o)
+						     (replace-suffix o ".obj" ""))
+						   objects))
+				       libs)
+			 (if (not (string-ci=? exe oexe))
+			     (batch:rename-file parms exe oexe))
+			 oexe)))
+
+     (compile-c-files Microsoft-Quick-C
+		      (lambda (files parms)
+			(batch:system parms
+				      "qcl" "/AH" "/W1" "/Ze" "/O" "/Ot" "/DNDEBUG"
+				      (c-includes parms)
+				      (c-flags parms)
+				      files)
+			(replace-suffix files ".c" ".obj")))
+     (link-c-program Microsoft-Quick-C
+		     (lambda (oname objects libs parms)
+		       (define crf-name (string-append oname ".crf"))
+		       (apply batch:lines->file parms
+			      crf-name
+			      `(,@(map (lambda (f) (string-append f " +"))
+				       objects)
+				""
+				,(string-append oname ".exe")
+				,(apply string-join " " libs)
+				";"))
+		       (batch:system parms
+				     "qlink"
+				     "/CP:0xffff" "/NOI" "/SE:0x80" "/ST:0x9c40"
+				     crf-name)
+		       (string-append oname ".exe")))
+
+     (compile-c-files Watcom-9.0
+		      (lambda (files parms)
+			(batch:system parms
+				      "wcc386p" "/mf" "/d2" "/ze" "/oxt" "/3s"
+				      "/zq" "/w3"
+				      (c-includes parms)
+				      (c-flags parms)
+				      files)
+			(replace-suffix files ".c" ".obj")))
+     (link-c-program Watcom-9.0
+		     (lambda (oname objects libs parms)
+		       (let ((exe (replace-suffix (car objects)
+						  ".obj" ".exe"))
+			     (oexe (string-append oname ".exe")))
+			 (if (not (string-ci=? exe oexe))
+			     (batch:delete-file parms oexe))
+			 (batch:system parms
+				       "wlinkp" "option" "quiet" "option"
+				       "stack=40000" "FILE"
+				       (apply string-join ","
+					      (map (lambda (o)
+						     (replace-suffix o ".obj" ""))
+						   objects))
+				       libs)
+			 (if (not (string-ci=? exe oexe))
+			     (batch:rename-file parms exe oexe))
+			 oexe)))
+     (compile-c-files highc.31
+		      (lambda (files parms)
+			(define hcc-name "temp.hcc")
+			(apply batch:lines->file parms hcc-name files)
+			(batch:system parms
+				      "\\hi_c\\hc386.31\\bin\\hc386"
+				      (c-includes parms)
+				      (c-flags parms)
+				      "-c" (string-append "@" hcc-name))
+			(replace-suffix files ".c" ".obj")))
+     (link-c-program highc.31
+		     (lambda (oname objects libs parms)
+		       (let ((oexe (string-append oname ".exe")))
+			 (define lnk-name (string-append oname ".lnk"))
+			 (apply batch:lines->file parms
+				lnk-name (append libs objects))
+			 (batch:system parms
+				       "\\hi_c\\hc386.31\\bin\\hc386" "-o" oname
+				       (string-append "@" lnk-name))
+			 (batch:system parms
+				       "bind386" "/hi_c/pharlap.51/run386b.exe" oname
+				       "-exe" oexe)
+			 oexe)))
+
+     (compile-c-files djgpp
+		      (lambda (files parms)
+			(batch:apply-chop-to-fit
+			 batch:try-system parms
+			 "gcc" "-Wall" "-O2" "-c"
+			 (c-includes parms) (c-flags parms)
+			 files)
+			(replace-suffix files ".c" ".o")))
+     (link-c-program djgpp
+		     (lambda (oname objects libs parms)
+		       (let ((exe (string-append oname ".exe")))
+			 (or
+			  (batch:try-system parms
+					    "gcc" "-o" oname
+					    (must-be-first
+					     '("-nostartfiles"
+					       "pre-crt0.o" "ecrt0.o"
+					       "c:/djgpp/lib/crt0.o")
+					     (append objects libs)))
+			  (let ((arname (string-append oname ".a")))
+			    (batch:delete-file parms arname)
+			    (batch:apply-chop-to-fit
+			     batch:try-system parms
+			     "ar" "r" arname objects)
+			    (batch:system
+			     parms "gcc" "-o" oname
+			     (must-be-first
+			      '("-nostartfiles"
+				"pre-crt0.o" "ecrt0.o"
+				"c:/djgpp/lib/crt0.o")
+			      (cons arname libs))))
+			  (slib:error 'build "couldn't build archive"))
+			 (batch:system parms "strip" oname)
+			 (batch:delete-file parms exe)
+			 (batch:system parms
+				       "coff2exe" "-s"
+				       "c:\\djgpp\\bin\\go32.exe"
+				       oname)
+			 exe)))
+
+     (compile-c-files os/2-emx
+		      (lambda (files parms)
+			(batch:system parms
+				      "gcc" "-O" "-m386" "-c"
+				      (c-includes parms)
+				      (c-flags parms)
+				      files)
+			(replace-suffix files ".c" ".o")))
+     (link-c-program os/2-emx
+		     (lambda (oname objects libs parms)
+		       (batch:system parms
+				     "gcc" "-o" (string-append oname ".exe")
+				     objects libs)
+		       (string-append oname ".exe")))
+
+     (compile-c-files os/2-cset
+		      (lambda (files parms)
+			(batch:system parms
+				      "icc.exe" "/Gd-" "/Ge+" "/Gm+" "/Q" "-c"
+				      (c-includes parms)
+				      (c-flags parms)
+				      files)
+			(replace-suffix files ".c" ".obj")))
+     (link-c-program os/2-cset
+		     (lambda (oname objects libs parms)
+		       (batch:system parms
+				     "link386.exe" objects libs
+				     (string-append "," oname ".exe,,,;"))
+		       (string-append oname ".exe")))
+
+     (compile-c-files HP-UX
+		      (lambda (files parms)
+			(batch:system parms
+				      "cc" "+O1" "-c"
+				      (c-includes parms)
+				      (c-flags parms)
+				      files)
+			(replace-suffix files ".c" ".o")))
+     (compile-dll-c-files HP-UX
+			  (lambda (files parms)
+			    (batch:system parms
+					  "cc" "+O1" "-Wl,-E" "+z" "-c"
+					  (c-includes parms)
+					  (c-flags parms)
+					  files)
+			    (for-each
+			     (lambda (fname)
+			       (batch:rename-file parms
+						  (string-append fname ".sl")
+						  (string-append fname ".sl~"))
+			       (batch:system parms
+					     "ld" "-b" "-o"
+					     (string-append fname ".sl")
+					     (string-append fname ".o")))
+			     (replace-suffix files ".c" ""))
+			    (replace-suffix files ".c" ".sl")))
+;     (make-dll-archive HP-UX
+;		       (lambda (oname objects libs parms)
+;			 (batch:system parms
+;				       "ld" "-b" "-o" (string-append oname ".sl")
+;				       objects)
+;			 (string-append oname ".sl")))
+
+     (make-dll-archive sun
+		       (lambda (oname objects libs parms)
+			 (batch:system parms
+				       "ld" "-assert" "pure-text" "-o"
+				       (string-append oname ".so.1.0")
+				       objects)
+			 (string-append oname ".so.1.0")))
+
+     (compile-c-files linux-aout
+		      (lambda (files parms)
+			(batch:system parms
+				      "gcc" "-Wall" "-O2" "-c"
+				      (c-includes parms)
+				      (c-flags parms)
+				      files)
+			(replace-suffix files ".c" ".o")))
+     (compile-dll-c-files linux-aout
+			  (lambda (files parms)
+			    (batch:system parms
+					  "gcc" "-Wall" "-O2" "-c"
+					  (c-includes parms)
+					  (c-flags parms)
+					  files)
+			    (replace-suffix files ".c" ".o")))
+;;;     (make-dll-archive linux-aout
+;;;		       (lambda (oname objects libs parms) #t
+;;;			       oname))
+
+     (compile-c-files linux
+		      (lambda (files parms)
+			(batch:system parms
+				      "gcc" "-O2" "-c" (c-includes parms)
+				      (c-flags parms)
+				      files)
+			(replace-suffix files ".c" ".o")))
+     (compile-dll-c-files linux
+			  (lambda (files parms)
+			    (batch:system parms
+					  "gcc" "-O2" "-fpic" "-c" (c-includes parms)
+					  (c-flags parms)
+					  files)
+			    (let* ((platform (car (parameter-list-ref
+						   parms 'platform)))
+				   (ld-opts
+				    (map (lambda (l)
+					   (build:lib-ld-flag l platform))
+					 (parameter-list-ref parms 'c-lib))))
+			      (for-each
+			       (lambda (fname)
+				 (batch:system parms
+					       "gcc" "-shared" "-o"
+					       (string-append fname ".so")
+					       (string-append fname ".o")
+					       ld-opts))
+			       (replace-suffix files ".c" "")))
+			    (replace-suffix files ".c" ".so")))
+     (make-dll-archive linux
+		       (lambda (oname objects libs parms)
+			 (let ((platform (car (parameter-list-ref
+					       parms 'platform))))
+			   (batch:system
+			    parms
+			    "gcc" "-shared" "-o"
+			    (string-append oname ".so")
+			    objects
+			    (map (lambda (l) (build:lib-ld-flag l platform))
+				 (parameter-list-ref parms 'c-lib))))
+			 (string-append oname ".so")))
+     (link-c-program linux
+		     (lambda (oname objects libs parms)
+		       (batch:system parms
+				     "gcc" "-rdynamic" "-o" oname
+				     (must-be-first
+				      '("pre-crt0.o" "ecrt0.o" "/usr/lib/crt0.o")
+				      (append objects libs)))
+		       oname))
+
+     (compile-c-files Unicos
+		      (lambda (files parms)
+			(batch:system parms
+				      "cc" "-hvector2" "-hscalar2" "-c"
+				      (c-includes parms)
+				      (c-flags parms)
+				      files)
+			(replace-suffix files ".c" ".o")))
+     (link-c-program Unicos
+		     (lambda (oname objects libs parms)
+		       (batch:system parms
+				     "cc" "setjump.o" "-o" oname objects libs)
+		       oname))
+
+     (compile-c-files gcc
+		      (lambda (files parms)
+			(batch:system parms
+				      "gcc" "-Wall" "-O2" "-c"
+				      (c-includes parms)
+				      (c-flags parms)
+				      files)
+			(replace-suffix files ".c" ".o")))
+
+     (link-c-program gcc
+		     (lambda (oname objects libs parms)
+		       (batch:rename-file parms
+					  oname (string-append oname "~"))
+		       (batch:system parms
+				     "gcc" "-o" oname
+				     (must-be-first
+				      '("-nostartfiles"
+					"pre-crt0.o" "ecrt0.o"
+					"/usr/lib/crt0.o")
+				      (append objects libs)))
+		       oname))
+
+     (compile-c-files svr4
+		      (lambda (files parms)
+			(batch:system parms
+				      "cc" "-O" "-DSVR4" "-c"
+				      (c-includes parms)
+				      (c-flags parms)
+				      files)
+			(replace-suffix files ".c" ".o")))
+
+     (compile-c-files aix
+		      (lambda (files parms)
+			(batch:system parms
+				      "cc" "-O" "-Dunix" "-c"
+				      (c-includes parms)
+				      (c-flags parms)
+				      files)
+			(replace-suffix files ".c" ".o")))
+     (link-c-program aix
+		     (lambda (oname objects libs parms)
+		       (batch:system parms
+				     "cc" "-lansi" "-o" oname objects libs)
+		       oname))
+
+     (compile-c-files amiga-aztec
+		      (lambda (files parms)
+			(batch:system parms
+				      "cc" "-dAMIGA"
+				      (c-includes parms)
+				      (c-flags parms)
+				      files)
+			(replace-suffix files ".c" ".o")))
+     (link-c-program amiga-aztec
+		     (lambda (oname objects libs parms)
+		       (batch:system parms
+				     "cc" "-o" oname objects libs "-lma")
+		       oname))
+
+     (compile-c-files amiga-SAS/C-5.10
+		      (lambda (files parms)
+			(batch:system parms
+				      "lc" "-d3" "-M" "-fi" "-O"
+				      (c-includes parms)
+				      (c-flags parms)
+				      files)
+			(batch:system parms "blink with link.amiga NODEBUG")
+			(replace-suffix files ".c" ".o")))
+     (link-c-program amiga-SAS/C-5.10
+		     (lambda (oname objects libs parms)
+		       (define lnk-name "link.amiga")
+		       (apply batch:lines->file parms
+			      lnk-name
+			      (apply string-join "+" ">FROM LIB:c.o"
+				     (map object->string objects))
+			      (string-append
+			       "TO " (object->string (string-append "/" oname)))
+			      (append
+			       (cond
+				((pair? libs)
+				 (cons (string-append "LIB LIB:" (car libs))
+				       (map (lambda (s)
+					      (string-append "    LIB:" s))
+					    (cdr libs))))
+				(else '()))
+			       '("VERBOSE" "SC" "SD")))
+		       oname))
+
+     (compile-c-files amiga-dice-c
+		      (lambda (files parms)
+			(batch:system parms
+				      "dcc" "-r" "-gs" "-c"
+				      (c-includes parms)
+				      (c-flags parms)
+				      files "-o" (replace-suffix files ".c" ".o"))
+			(replace-suffix files ".c" ".o")))
+     (link-c-program amiga-dice-c
+		     (lambda (oname objects libs parms)
+		       (batch:system parms
+				     "dcc" "-r" "-gs" "-o" oname objects libs)
+		       oname))
+
+     (compile-c-files atari-st-gcc
+		      (lambda (files parms)
+			(batch:system parms
+				      "gcc" "-v" "-O" "-c"
+				      (c-includes parms)
+				      (c-flags parms)
+				      files)
+			(replace-suffix files ".c" ".o")))
+     (link-c-program atari-st-gcc
+		     (lambda (oname objects libs parms)
+		       (batch:system parms
+				     "gcc" "-v" "-o" (string-append oname ".ttp")
+				     objects libs)
+		       (string-append oname ".ttp")))
+
+     (compile-c-files atari-st-turbo-c
+		      (lambda (files parms)
+			(batch:system parms
+				      "tcc" "-P" "-W-" "-Datarist"
+				      (c-includes parms)
+				      (c-flags parms)
+				      files)
+			(replace-suffix files ".c" ".o")))
+     (link-c-program atari-st-turbo-c
+		     (lambda (oname objects libs parms)
+		       (batch:system parms
+				     "tlink" "-o" (string-append oname ".ttp")
+				     objects libs "mintlib.lib" "osbind.lib"
+				     "pcstdlib.lib" "pcfltlib.lib")
+		       (string-append oname ".ttp")))
+
+     (compile-c-files acorn-unixlib
+		      (lambda (files parms)
+			(batch:system parms
+				      "cc" "-c" "-depend" "!Depend" "-IUnixLib:"
+				      "-pcc" "-Dunix" "-DSVR3" "-DARM_ULIB"
+				      (c-includes parms)
+				      (c-flags parms)
+				      files)
+			(replace-suffix files ".c" ".o")))
+     (link-c-program acorn-unixlib
+		     (lambda (oname objects libs parms)
+		       (batch:system parms
+				     "link" "-o" oname objects libs
+				     ":5.$.dev.gcc.unixlib36d.clib.o.unixlib")
+		       (batch:system parms
+				     "squeeze" oname)
+		       oname))
+
+     (compile-c-files vms
+		      (lambda (files parms)
+			(batch:system parms
+				      "cc"
+				      (c-includes parms)
+				      (c-flags parms)
+				      (replace-suffix files ".c" ""))
+			(replace-suffix files ".c" ".obj")))
+     (link-c-program vms
+		     (lambda (oname objects libs parms)
+		       (let ((exe (replace-suffix (car objects)
+						  ".obj" ".exe"))
+			     (oexe (string-append oname ".exe")))
+			 (batch:system parms
+				       "macro" "setjump")
+			 (batch:system parms
+				       "link"
+				       (apply string-join ","
+					      (append (map (lambda (f)
+							     (replace-suffix f ".obj" ""))
+							   objects)
+						      '("setjump" "sys$input/opt\n   ")))
+				       (apply string-join
+					      "," (append (remove "" libs)
+							  '("sys$share:vaxcrtl/share"))))
+			 (if (not (string-ci=? exe oexe))
+			     (batch:rename-file parms exe oexe))
+			 oexe)))
+
+     (compile-c-files vms-gcc
+		      (lambda (files parms)
+			(batch:system parms
+				      "gcc"
+				      (c-includes parms)
+				      (c-flags parms)
+				      (replace-suffix files ".c" ""))
+			(replace-suffix files ".c" ".obj")))
+     (link-c-program vms-gcc
+		     (lambda (oname objects libs parms)
+		       (let ((exe (replace-suffix (car objects)
+						  ".obj" ".exe"))
+			     (oexe (string-append oname ".exe")))
+			 (batch:system parms
+				       "macro" "setjump")
+			 (batch:system parms
+				       "link"
+				       (apply string-join ","
+					      (append objects
+						      '("setjump.obj"
+							"sys$input/opt\n   ")))
+				       (apply string-join
+					      "," (append (remove "" libs)
+							  '("gnu_cc:[000000]gcclib/lib"
+							    "sys$share:vaxcrtl/share"))))
+			 (if (not (string-ci=? exe oexe))
+			     (batch:rename-file parms exe oexe))
+			 oexe)))
+
+     (compile-c-files *unknown*
+		      (lambda (files parms)
+			(batch:system parms
+				      "cc" "-O" "-c"
+				      (c-includes parms)
+				      (c-flags parms)
+				      files)
+			(replace-suffix files ".c" ".o")))
+     (link-c-program *unknown*
+		     (lambda (oname objects libs parms)
+		       (batch:rename-file parms
+					  oname (string-append oname "~"))
+		       (batch:system parms
+				     "cc" "-o" oname
+				     (must-be-first
+				      '("-nostartfiles"
+					"pre-crt0.o" "ecrt0.o"
+					"/usr/lib/crt0.o")
+				      (append objects libs)))
+		       oname))
+     (make-archive *unknown*
+		   (lambda (oname objects libs parms)
+		     (let ((aname (string-append oname ".a")))
+		       (batch:system parms
+				     "ar rc" aname objects)
+		       (batch:system parms
+				     "ranlib" aname)
+		       aname)))
+     (compile-dll-c-files *unknown*
+			  (lambda (files parms)
+			    (batch:system parms
+					  "cc" "-O" "-c"
+					  (c-includes parms)
+					  (c-flags parms)
+					  files)
+			    (replace-suffix files ".c" ".o")))
+     (make-dll-archive *unknown*
+		       (lambda (oname objects libs parms)
+			 (let ((aname (string-append oname ".a")))
+			   (batch:system parms
+					 "ar rc" aname objects)
+			   (batch:system parms
+					 "ranlib" aname)
+			   aname)))
+     (make-nothing *unknown*
+		   (lambda (oname objects libs parms)
+		     (if (= 1 (length objects)) (car objects)
+			 objects)))
+     ))
+
+  '(features
+    ((name symbol))
+    ((spec expression)
+     (documentation string))
+    ((lit () "Light - no features")
+     (none () "No features")
+
+     (cautious ((define "CAUTIOUS"))
+	       "\
+Normally, the number of arguments arguments to interpreted closures
+ (from LAMBDA) are checked if the function part of a form is not a
+symbol or only the first time the form is executed if the function
+part is a symbol.  defining RECKLESS disables any checking.  If you
+want to have SCM always check the number of arguments to interpreted
+closures #define CAUTIOUS.")
+
+     (careful-interrupt-masking ((define "CAREFUL_INTS"))
+				"\
+Define CAREFUL_INTS for extra checking of interrupt masking.  This is
+for debugging C code in sys.c and repl.c.")
+
+     (debug ((c-lib debug)
+	     (features cautious careful-interrupt-masking stack-limit))
+	    "Debugging")
+
+     (reckless ((define "RECKLESS"))
+	       "\
+If your scheme code runs without any errors you can disable almost all
+error checking by compiling all files with RECKLESS.")
+
+     (stack-limit ((define ("STACK_LIMIT" "(HEAP_SEG_SIZE/2)")))
+		  "\
+Define STACK_LIMIT to enable checking for stack overflow.  Define
+value of STACK_LIMIT to be the size to which SCM should allow the
+stack to grow.  STACK_LIMIT should be less than the maximum size the
+hardware can support, as not every routine checks the stack.")
+
+     (bignums ((define "BIGNUMS"))
+	      "\
+Large precision integers.")
+
+     (arrays ((define "ARRAYS"))
+	     "\
+Define ARRAYS if you want arrays, uniform-arrays and uniform-vectors.")
+
+     (array-for-each ((c-file "ramap.c") (init "init_ramap"))
+	     "\
+array-map! and array-for-each (ARRAYS must also be defined).")
+
+     (inexact ((define "FLOATS") (c-lib m))
+	      "\
+Define FLOATS if you want floating point numbers.")
+
+     (engineering-notation ((define "ENGNOT"))
+			   "\
+Define ENGNOT if you want floats to display in engineering notation
+ (exponents always multiples of 3) instead of scientific notation.")
+
+     (single-precision-only ((define "SINGLESONLY"))
+			    "\
+Define SINGLESONLY if you want all inexact real numbers to be single
+precision.  This only has an effect if SINGLES is also defined (which
+is the default).  This does not affect complex numbers.")
+
+     (sicp ((define "SICP"))
+	   "\
+Define SICP if you want to run code from:
+
+    H. Abelson, G. J. Sussman, and J. Sussman,
+    Structure and Interpretation of Computer Programs,
+    The MIT Press, Cambridge, Massachusetts, USA
+
+ (eq? '() '#f) is the major difference.")
+
+     (rev2-procedures ((c-file "sc2.c") (init "init_sc2"))
+		      "\
+These procedures were specified in the `Revised^2 Report on Scheme'
+but not in `R4RS'.")
+
+     (record ((c-file "record.c") (init "init_record"))
+	     "\
+The Record package provides a facility for user to define their own
+record data types.  See SLIB for documentation.")
+
+     (compiled-closure ((define "CCLO"))
+		       "\
+Define CCLO if you want to use compiled closures.")
+
+     (generalized-c-arguments ((c-file "gsubr.c") (init "init_gsubr"))
+			      "\
+make_gsubr for arbitrary (< 11) arguments to C functions.")
+
+     (tick-interrupts ((define "TICKS"))
+		      "\
+Define TICKS if you want the ticks and ticks-interrupt functions.")
+
+     (i/o-extensions ((c-file "ioext.c") (init "init_ioext"))
+		     "\
+Commonly available I/O extensions: `Exec', line I/O, file positioning,
+file delete and rename, and directory functions.")
+
+     (turtlegr
+      ((c-file "turtlegr.c") (c-lib graphics) (features inexact)
+			     (init "init_turtlegr"))
+      "\
+`Turtle' graphics calls for both Borland-C and X11.")
+
+     (curses ((c-file "crs.c") (c-lib curses) (init "init_crs"))
+	     "\
+`Curses' screen management package.")
+
+     (edit-line
+      ((c-file "edline.c") (c-lib termcap editline) (compiled-init "init_edline"))
+      "\
+interface to the editline or GNU readline library")
+
+     (regex ((c-file "rgx.c") (c-lib regex) (init "init_rgx"))
+	    "\
+String regular expression matching.")
+
+     (socket ((c-file "socket.c") (init "init_socket"))
+	     "\
+BSD socket interface.")
+
+     (posix ((c-file "posix.c") (init "init_posix"))
+	    "\
+Posix functions available on all `Unix-like' systems.  fork and
+process functions, user and group IDs, file permissions, and `link'.")
+
+     (unix ((c-file "unix.c") (init "init_unix"))
+	   "\
+Those unix features which have not made it into the Posix specs: nice,
+acct, lstat, readlink, symlink, mknod and sync.")
+
+     (windows ((c-lib windows))		; (define "NON_PREEMPTIVE")
+	      "\
+Microsoft Windows executable.")
+
+     (dynamic-linking ((c-file "dynl.c") (c-lib dlll))
+		      "\
+Load compiled files while running.")
+
+     (dump ((define "CAN_DUMP")
+	    (c-lib dump)
+	    (c-lib nostart)
+	    (c-file "unexec.c")
+	    (c-file "unexelf.c")
+	    (c-file "gmalloc.c")
+	    (c-file "ecrt0.c")
+	    (c-file "pre-crt0.c"))
+	   "\
+Convert a running scheme program into an executable file.")
+
+;;;; Descriptions of these parameters is in "setjump.h".
+;;;	(initial-heap-size ((define "INIT_HEAP_SIZE" (* 25000 sizeof-cell))))
+;;;	(heap-segment-size ((define "HEAP_SEG_SIZE" (* 8100 sizeof-cell))))
+;;;	(short-aligned-stack ((define "SHORT_ALIGN")))
+;;;	(initial-malloc-limit ((define "INIT_MALLOC_LIMIT" 100000)))
+;;;	(number-of-hash-buckets ((define "NUM_HASH_BUCKETS" 137)))
+;;;	(minimum-gc-yield ((define "MIN_GC_YIELD" "(heap_size/4)")))
+
+     (heap-can-shrink ((define "DONT_GC_FREE_SEGMENTS"))
+		      "\
+Define DONT_GC_FREE_SEGMENTS if you want segments of unused heap to
+not be freed up after garbage collection.  This may reduce time in GC
+for *very* large working sets.")
+
+     (cheap-continuations ((define "CHEAP_CONTINUATIONS"))
+			  "\
+If you only need straight stack continuations CHEAP_CONTINUATIONS will
+run faster and use less storage than not having it.  Machines with
+unusual stacks need this.  Also, if you incorporate new C code into
+scm which uses VMS system services or library routines (which need to
+unwind the stack in an ordrly manner) you may need to define
+CHEAP_CONTINUATIONS.")
+
+     (memoize-local-bindings ((define "MEMOIZE_LOCALS"))
+			     "\
+Saves the interpeter from having to look up local bindings for every
+identifier reference")
+     ))
+  '(build-params
+    *parameter-columns*
+    *parameter-columns*
+    ((1 platform single platform
+	(lambda (pl) (list batch:platform))
+	#f
+	"what to build it for")
+     (2 target-name single string (lambda (pl) '("scm")) #f
+	"base name of target")
+     (3 c-lib nary symbol (lambda (pl) '(c)) #f
+	"C library (and include files)")
+     (4 define nary string #f #f "#define FLAG")
+     (5 implinit single string
+	(lambda (pl) (list (object->string
+			    (in-vicinity (implementation-vicinity) "Init.scm"))))
+	#f "implementation vicinity")
+     (6 c-file nary filename #f #f "C source files")
+     (7 o-file nary filename #f #f "other object files")
+     (8 init nary string #f #f "initialization calls")
+     (9 compiled-init nary string #f #f "later initialization calls")
+     (10 features nary symbol
+	 (lambda (pl) '(arrays inexact bignums))
+	 (lambda (rdb) (((rdb 'open-table) 'features #f) 'get 'spec))
+	 "features to include")
+     (11 what single build-whats
+	 (lambda (pl) '(exe))
+	 (lambda (rdb)
+	   (define tab (((rdb 'open-table) 'build-whats #f) 'get 'class))
+	   (define manifest ((((rdb 'open-table) 'manifest #f)
+			      'row:retrieve*)))
+	   (lambda (what)
+	     (define catgry (tab what))
+	     `((c-file
+		,@(map car
+		       (remove-if-not
+			(lambda (row) (and (eq? 'c-source (cadr row))
+					   (eq? catgry (caddr row))))
+			manifest)))
+	       ,@(or ((((rdb 'open-table) 'build-whats #f) 'get 'spec) what)
+		     '()))))
+	 "what to build")
+     (12 batch-dialect single batch-dialect
+	 guess-how
+	 #f
+	 "How to build")
+     (13 who single expression (lambda (pl) (list (current-output-port))) #f
+	 "name of buildfile or port")
+     (14 compiler-options nary string #f #f "command-line compiler options")
+     (15 linker-options nary string #f #f "command-line linker options")
+
+     (17 batch-port nary expression #f #f
+	 "port batch file will be written to.")
+     (18 c-defines nary expression #f #f "#defines for C")
+     (19 c-includes nary expression #f #f "library induced defines for C")
+     ))
+  '(build-pnames
+    ((name string))
+    ((parameter-index uint))
+    (
+     ("p" 1) ("platform" 1)
+     ("o" 2) ("outname" 2)
+     ("l" 3) ("libraries" 3)
+     ("D" 4) ("defines" 4)
+     ("s" 5) ("scheme initialization file" 5)
+     ("c" 6) ("c source files" 6)
+     ("j" 7) ("object files" 7)
+     ("i" 9) ("initialization calls" 9)
+     ("F" 10) ("features" 10)
+     ("t" 11) ("type" 11)
+     ("h" 12) ("batch dialect" 12)
+     ("w" 13) ("script name" 13)
+     ("compiler options" 14)
+     ("linker options" 15)
+     ))
+
+  '(*commands*
+    ((name symbol))			;or just desc:*commands*
+    ((parameters parameter-list)
+     (parameter-names parameter-name-translation)
+     (procedure expression)
+     (documentation string))
+    ((build
+      build-params
+      build-pnames
+      build:build
+      "build program.")
+     (*initialize*
+      no-parameters
+      no-parameters
+      build:init
+      "SCM Build Database"))))
+
+;;;((build 'close-database))
+;;;(define build (open-database! "buildscm.scm" 'alist-table))
+
+(define build:error slib:error)
+(define build:c-libraries #f)
+(define build:lib-cc-flag #f)
+(define build:lib-ld-flag #f)
+(define build:c-supress #f)
+(define plan-command #f)
+
+;;; Look up command on a platform, but default to '*unknown* if not
+;;; initially found.
+
+(define (make-defaulting-platform-lookup getter)
+  (lambda (thing plat)
+    (define (look platform)
+      (let ((ans (getter thing platform)))
+	(cond (ans ans)
+	      ((eq? '*unknown* platform)
+	       (build:error "Couldn't find: " thing))
+	      (else (look '*unknown*)))))
+    (look plat)))
+
+(define system:success? zero?)
+
+(require 'alist)
+(require 'common-list-functions)
+(require 'object->string)
+
+(define build:build
+  (lambda (rdb)
+    (lambda (parms)
+      (let ((expanders
+	     (map (lambda (e) (and e (lambda (s) (e s))))
+		  (map (lambda (f) (if f ((slib:eval f) rdb) f))
+		       ((((rdb 'open-table) 'build-params #f)
+			 'get* 'expander))))))
+	(parameter-list-expand expanders parms)
+	(set! parms
+	      (fill-empty-parameters
+	       (map slib:eval
+		    ((((rdb 'open-table) 'build-params #f)
+		      'get* 'default)))
+	       parms))
+	(parameter-list-expand expanders parms))
+      (let* ((platform (car (parameter-list-ref parms 'platform)))
+	     (init= (apply string-append
+			   (map (lambda (c)
+				  (string-append c "();"))
+				(parameter-list-ref parms 'init))))
+	     (compiled-init=
+	      (apply string-append
+		     (map (lambda (c)
+			    (string-append c "();"))
+			  (parameter-list-ref parms 'compiled-init))))
+	     (c-defines
+	      `((define "IMPLINIT"
+		  ,(car (parameter-list-ref parms 'implinit)))
+		,@(if (string=? "" init=) '()
+		      `((define "INITS" ,init=)))
+		,@(if (string=? "" compiled-init=) '()
+		      `((define "COMPILED_INITS" ,compiled-init=)))
+		,@(map (lambda (d) (if (pair? d)
+				       `(define ,@d)
+				       `(define ,d #t)))
+		       (parameter-list-ref parms 'define))))
+	     (c-includes
+	      (map (lambda (l) (build:lib-cc-flag l platform))
+		   (parameter-list-ref parms 'c-lib)))
+	     (batch-dialect (car (parameter-list-ref parms 'batch-dialect)))
+	     (what (car (parameter-list-ref parms 'what)))
+	     (c-proc (plan-command ((((rdb 'open-table) 'build-whats #f)
+				     'get 'c-proc)
+				    what)
+				   platform)))
+	(adjoin-parameters!
+	 parms
+	 (cons 'c-defines c-defines)
+	 (cons 'c-includes c-includes)
+	 )
+
+	(let ((name (car (parameter-list-ref parms 'who))))
+	  (batch:call-with-output-script
+	   parms
+	   name
+	   (lambda (batch-port)
+	     (define o-files '())
+	     (adjoin-parameters!
+	      parms
+	      (list 'batch-port batch-port))
+
+	     ;; ================ Write file with C defines
+	     (apply batch:lines->file parms
+		    "scmflags.h"
+		    (defines->c-defines c-defines))
+
+	     ;; ================ Compile C source files
+	     (set! o-files
+		   (let ((supressors
+			  (apply append
+				 (map (lambda (l) (build:c-supress l platform))
+				      (parameter-list-ref parms 'c-lib)))))
+		     (c-proc (remove-if (lambda (file) (member file supressors))
+					(parameter-list-ref parms 'c-file))
+			     parms)))
+
+	     ;; ================ Link C object files
+	     ((plan-command
+	       ((((rdb 'open-table) 'build-whats #f) 'get 'o-proc) what)
+	       platform)
+	      (car (parameter-list-ref parms 'target-name))
+	      (append o-files (parameter-list-ref parms 'o-file))
+	      (append
+	       (parameter-list-ref parms 'linker-options)
+	       (map (lambda (l) (build:lib-ld-flag l platform))
+		    (parameter-list-ref parms 'c-lib)))
+	      parms))))))))
+
+(define (c-defines parms)
+  (parameter-list-ref parms 'c-defines))
+(define (c-includes parms)
+  (parameter-list-ref parms 'c-includes))
+(define (c-flags parms)
+  (parameter-list-ref parms 'compiler-options))
+
+(define (defines->c-defines defines)
+  (map
+   (lambda (d)
+     (case (caddr d)
+       ((#t) (string-join " " "#define" (cadr d)))
+       ((#f) (string-join " " "#undef" (cadr d)))
+       (else (apply string-join " " "#define" (cdr d)))))
+   defines))
+
+(define (defines->flags defines)
+  (map
+   (lambda (d)
+     (case (caddr d)
+       ((#t) (string-append "-D" (cadr d)))
+       ((#f) (string-append "-U" (cadr d)))
+       (else (string-append "-D" (cadr d) "=" (object->string (caddr d))))))
+   defines))
+
+(define (guess-how pl)
+  (let* ((plat (parameter-list-ref pl 'platform))
+	 (platform (if (pair? plat) (car plat) batch:platform)))
+    (let ((os (or ((((build 'open-table) 'platform #f)
+		    'get 'operating-system) platform) batch:platform)))
+      (cond ((not os) (slib:error "OS corresponding to " platform " unknown"))
+	    (else (list (os->batch-dialect os)))))))
+
+(define build:initializer
+  (lambda (rdb)
+    (set! build:c-libraries ((rdb 'open-table) 'c-libraries #f))
+    (set! build:lib-cc-flag
+	  (make-defaulting-platform-lookup
+	   (build:c-libraries 'get 'compiler-flags)))
+    (set! build:lib-ld-flag
+	  (make-defaulting-platform-lookup
+	   (build:c-libraries 'get 'link-lib-flag)))
+    (set! build:c-supress
+	  (make-defaulting-platform-lookup
+	   (build:c-libraries 'get 'supress-files)))
+    (set! plan-command
+	  (let ((lookup (make-defaulting-platform-lookup
+			 (((rdb 'open-table) 'compile-commands #f)
+			  'get 'procedure))))
+	    (lambda (thing plat)
+	      (slib:eval (lookup thing plat)))))))
+(build:initializer build)
+
+(define (build-from-argv argv)
+  (cond ((string? argv)
+	 (require 'read-command)
+	 (set! argv (call-with-input-string argv read-command))))
+  (let ()
+    (define command (string->symbol (list-ref argv *optind*)))
+    (define argc (length argv))
+    (cond
+     ((pair? argv)
+      (set! *optind* (+ 1 *optind*))
+      ((make-command-server build '*commands*)
+       command
+       (lambda (comname comval options positions arities types
+			defaults checks aliases)
+	 (let* ((params (getopt->parameter-list
+			 argc argv options arities types aliases))
+		(fparams (fill-empty-parameters defaults params)))
+	   (cond ((not (list? params)) #f)
+		 ((not (check-parameters checks fparams)) #f)
+		 ((not (check-arities (map arity->arity-spec arities) fparams))
+		  (slib:error 'build-from-argv "arity error" fparams) #f)
+		 (else (comval fparams))))))))))
+
+(define (build-from-whole-argv argv)
+  (set! *optind* 0)
+  (set! *optarg* #f)
+  (build-from-argv argv))
+
+(define b build-from-whole-argv)
+
+(define (b*)
+  (require 'read-command)
+  (do ((e (read-command) (read-command)))
+      ((eof-object? e))
+    (cond ((null? e))
+	  (else
+	   (cond ((not (string-ci=? (car e) "build"))
+		  (set! e (cons "build" e))))
+	   (write (build-from-whole-argv e))
+	   (newline)))
+    (display "build> ")
+    (force-output)))
+
+(define (bi) (build-from-argv *argv*))
+
+(cond (*interactive*
+       (display "type (b \"build <command-line>\") to build") (newline)
+       (display "type (b*) to enter build command loop") (newline)))
diff --git a/configure b/configure
new file mode 100755
index 0000000..53d869e
--- /dev/null
+++ b/configure
@@ -0,0 +1,849 @@
+#!/bin/sh
+# Guess values for system-dependent variables and create Makefiles.
+# Generated automatically using autoconf.
+# Copyright (C) 1991, 1992, 1993 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.
+
+# Usage: configure [--srcdir=DIR] [--host=HOST] [--gas] [--nfp]
+#        [--prefix=PREFIX] [--exec-prefix=PREFIX] [--with-PACKAGE[=VALUE]]
+# Ignores all args except --srcdir, --prefix, --exec-prefix, and
+# --with-PACKAGE[=VALUE] unless this script has special code to handle it.
+
+for arg
+do
+  # Handle --exec-prefix with a space before the argument.
+  if test x$next_exec_prefix = xyes; then exec_prefix=$arg; next_exec_prefix=
+  # Handle --host with a space before the argument.
+  elif test x$next_host = xyes; then next_host=
+  # Handle --prefix with a space before the argument.
+  elif test x$next_prefix = xyes; then prefix=$arg; next_prefix=
+  # Handle --srcdir with a space before the argument.
+  elif test x$next_srcdir = xyes; then srcdir=$arg; next_srcdir=
+  else
+    case $arg in
+     # For backward compatibility, recognize -exec-prefix and --exec_prefix.
+     -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* | --exec=* | --exe=* | --ex=* | --e=*)
+	exec_prefix=`echo $arg | sed 's/[-a-z_]*=//'` ;;
+     -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- | --exec | --exe | --ex | --e)
+	next_exec_prefix=yes ;;
+
+     -gas | --gas | --ga | --g) ;;
+
+     -host=* | --host=* | --hos=* | --ho=* | --h=*) ;;
+     -host | --host | --hos | --ho | --h)
+	next_host=yes ;;
+
+     -nfp | --nfp | --nf) ;;
+
+     -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+	prefix=`echo $arg | sed 's/[-a-z_]*=//'` ;;
+     -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+	next_prefix=yes ;;
+
+     -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=* | --s=*)
+	srcdir=`echo $arg | sed 's/[-a-z_]*=//'` ;;
+     -srcdir | --srcdir | --srcdi | --srcd | --src | --sr | --s)
+	next_srcdir=yes ;;
+
+     -with-* | --with-*)
+       package=`echo $arg|sed -e 's/-*with-//' -e 's/=.*//'`
+       # Reject names that aren't valid shell variable names.
+       if test -n "`echo $package| sed 's/[-a-zA-Z0-9_]//g'`"; then
+         echo "configure: $package: invalid package name" >&2; exit 1
+       fi
+       package=`echo $package| sed 's/-/_/g'`
+       case "$arg" in
+         *=*) val="`echo $arg|sed 's/[^=]*=//'`" ;;
+         *) val=1 ;;
+       esac
+       eval "with_$package='$val'" ;;
+
+     -v | -verbose | --verbose | --verbos | --verbo | --verb | --ver | --ve | --v)
+       verbose=yes ;;
+
+     *) ;;
+    esac
+  fi
+done
+
+trap 'rm -fr conftest* confdefs* core; exit 1' 1 3 15
+trap 'rm -f confdefs*' 0
+
+# NLS nuisances.
+# These must not be set unconditionally because not all systems understand
+# e.g. LANG=C (notably SCO).
+if test "${LC_ALL+set}" = 'set' ; then LC_ALL=C; export LC_ALL; fi
+if test "${LANG+set}"   = 'set' ; then LANG=C;   export LANG;   fi
+
+rm -f conftest* confdefs.h
+# AIX cpp loses on an empty file, so make sure it contains at least a newline.
+echo > confdefs.h
+compile='${CC-cc} $CFLAGS conftest.c -o conftest $LIBS >/dev/null 2>&1'
+
+# 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.
+unique_file=scl.c
+
+# Find the source files, if location was not specified.
+if test -z "$srcdir"; then
+  srcdirdefaulted=yes
+  # Try the directory containing this script, then `..'.
+  prog=$0
+  confdir=`echo $prog|sed 's%/[^/][^/]*$%%'`
+  test "X$confdir" = "X$prog" && confdir=.
+  srcdir=$confdir
+  if test ! -r $srcdir/$unique_file; then
+    srcdir=..
+  fi
+fi
+if test ! -r $srcdir/$unique_file; then
+  if test x$srcdirdefaulted = xyes; then
+    echo "configure: Can not find sources in \`${confdir}' or \`..'." 1>&2
+  else
+    echo "configure: Can not find sources in \`${srcdir}'." 1>&2
+  fi
+  exit 1
+fi
+# Preserve a srcdir of `.' to avoid automounter screwups with pwd.
+# But we can't avoid them for `..', to make subdirectories work.
+case $srcdir in
+  .|/*|~*) ;;
+  *) srcdir=`cd $srcdir; pwd` ;; # Make relative path absolute.
+esac
+
+
+# Save the original args to write them into config.status later.
+configure_args="$*"
+
+
+
+test -z "$CFLAGS" && CFLAGS=-g 
+test -z "$LDFLAGS" && LDFLAGS=-g 
+
+if test -z "$CC"; then
+  # Extract the first word of `gcc', so it can be a program name with args.
+  set dummy gcc; word=$2
+  echo checking for $word
+  IFS="${IFS= 	}"; saveifs="$IFS"; IFS="${IFS}:"
+  for dir in $PATH; do
+    test -z "$dir" && dir=.
+    if test -f $dir/$word; then
+      CC="gcc"
+      break
+    fi
+  done
+  IFS="$saveifs"
+fi
+test -z "$CC" && CC="cc"
+test -n "$CC" && test -n "$verbose" && echo "	setting CC to $CC"
+
+# Find out if we are using GNU C, under whatever name.
+cat > conftest.c <<EOF
+#ifdef __GNUC__
+  yes
+#endif
+EOF
+${CC-cc} -E conftest.c > conftest.out 2>&1
+if egrep yes conftest.out >/dev/null 2>&1; then
+  GCC=1 # For later tests.
+fi
+rm -f conftest*
+
+# Make sure to not get the incompatible SysV /etc/install and
+# /usr/sbin/install, which might be in PATH before a BSD-like install,
+# or the SunOS /usr/etc/install directory, or the AIX /bin/install,
+# or the AFS install, which mishandles nonexistent args, or
+# /usr/ucb/install on SVR4, which tries to use the nonexistent group
+# `staff'.  On most BSDish systems install is in /usr/bin, not /usr/ucb
+# anyway.  Sigh.
+if test "z${INSTALL}" = "z" ; then
+  echo checking for install
+  IFS="${IFS= 	}"; saveifs="$IFS"; IFS="${IFS}:"
+  for dir in $PATH; do
+    test -z "$dir" && dir=.
+    case $dir in
+    /etc|/usr/sbin|/usr/etc|/usr/afsws/bin|/usr/ucb) ;;
+    *)
+      if test -f $dir/installbsd; then
+	INSTALL="$dir/installbsd -c" # OSF1
+	INSTALL_PROGRAM='$(INSTALL)'
+	INSTALL_DATA='$(INSTALL) -m 644'
+	break
+      fi
+      if test -f $dir/install; then
+	if grep dspmsg $dir/install >/dev/null 2>&1; then
+	  : # AIX
+	else
+	  INSTALL="$dir/install -c"
+	  INSTALL_PROGRAM='$(INSTALL)'
+	  INSTALL_DATA='$(INSTALL) -m 644'
+	  break
+	fi
+      fi
+      ;;
+    esac
+  done
+  IFS="$saveifs"
+fi
+INSTALL=${INSTALL-cp}
+test -n "$verbose" && echo "	setting INSTALL to $INSTALL"
+INSTALL_PROGRAM=${INSTALL_PROGRAM-'$(INSTALL)'}
+test -n "$verbose" && echo "	setting INSTALL_PROGRAM to $INSTALL_PROGRAM"
+INSTALL_DATA=${INSTALL_DATA-'$(INSTALL)'}
+test -n "$verbose" && echo "	setting INSTALL_DATA to $INSTALL_DATA"
+
+echo checking how to run the C preprocessor
+if test -z "$CPP"; then
+  # This must be in double quotes, not single quotes, because CPP may get
+  # substituted into the Makefile and ``${CC-cc}'' will simply confuse
+  # make.  It must be expanded now.
+  CPP="${CC-cc} -E"
+  cat > conftest.c <<EOF
+#include "confdefs.h"
+#include <stdio.h>
+Syntax Error
+EOF
+err=`eval "($CPP conftest.c >/dev/null) 2>&1"`
+if test -z "$err"; then
+  :
+else
+  rm -rf conftest*
+  CPP=/lib/cpp
+fi
+rm -f conftest*
+fi
+test ".${verbose}" != "." && echo "	setting CPP to $CPP"
+
+if test -z "$RANLIB"; then
+  # Extract the first word of `ranlib', so it can be a program name with args.
+  set dummy ranlib; word=$2
+  echo checking for $word
+  IFS="${IFS= 	}"; saveifs="$IFS"; IFS="${IFS}:"
+  for dir in $PATH; do
+    test -z "$dir" && dir=.
+    if test -f $dir/$word; then
+      RANLIB="ranlib"
+      break
+    fi
+  done
+  IFS="$saveifs"
+fi
+test -z "$RANLIB" && RANLIB=":"
+test -n "$RANLIB" && test -n "$verbose" && echo "	setting RANLIB to $RANLIB"
+
+echo checking for AIX
+cat > conftest.c <<EOF
+#include "confdefs.h"
+#ifdef _AIX
+  yes
+#endif
+
+EOF
+eval "$CPP conftest.c > conftest.out 2>&1"
+if egrep "yes" conftest.out >/dev/null 2>&1; then
+  rm -rf conftest*
+  
+{
+test -n "$verbose" && \
+echo "	defining _ALL_SOURCE"
+echo "#define" _ALL_SOURCE 1 >> confdefs.h
+DEFS="$DEFS -D_ALL_SOURCE=1"
+SEDDEFS="${SEDDEFS}\${SEDdA}_ALL_SOURCE\${SEDdB}_ALL_SOURCE\${SEDdC}1\${SEDdD}
+\${SEDuA}_ALL_SOURCE\${SEDuB}_ALL_SOURCE\${SEDuC}1\${SEDuD}
+\${SEDeA}_ALL_SOURCE\${SEDeB}_ALL_SOURCE\${SEDeC}1\${SEDeD}
+"
+}
+
+
+fi
+rm -f conftest*
+
+
+echo checking for POSIXized ISC
+if test -d /etc/conf/kconfig.d &&
+  grep _POSIX_VERSION /usr/include/sys/unistd.h >/dev/null 2>&1
+then
+  ISC=1 # If later tests want to check for ISC.
+  
+{
+test -n "$verbose" && \
+echo "	defining _POSIX_SOURCE"
+echo "#define" _POSIX_SOURCE 1 >> confdefs.h
+DEFS="$DEFS -D_POSIX_SOURCE=1"
+SEDDEFS="${SEDDEFS}\${SEDdA}_POSIX_SOURCE\${SEDdB}_POSIX_SOURCE\${SEDdC}1\${SEDdD}
+\${SEDuA}_POSIX_SOURCE\${SEDuB}_POSIX_SOURCE\${SEDuC}1\${SEDuD}
+\${SEDeA}_POSIX_SOURCE\${SEDeB}_POSIX_SOURCE\${SEDeC}1\${SEDeD}
+"
+}
+
+  if test -n "$GCC"; then
+    CC="$CC -posix"
+  else
+    CC="$CC -Xp"
+  fi
+fi
+
+echo checking for minix/config.h
+cat > conftest.c <<EOF
+#include "confdefs.h"
+#include <minix/config.h>
+EOF
+err=`eval "($CPP conftest.c >/dev/null) 2>&1"`
+if test -z "$err"; then
+  rm -rf conftest*
+  MINIX=1
+
+fi
+rm -f conftest*
+
+# The Minix shell can't assign to the same variable on the same line!
+if test -n "$MINIX"; then
+  
+{
+test -n "$verbose" && \
+echo "	defining _POSIX_SOURCE"
+echo "#define" _POSIX_SOURCE 1 >> confdefs.h
+DEFS="$DEFS -D_POSIX_SOURCE=1"
+SEDDEFS="${SEDDEFS}\${SEDdA}_POSIX_SOURCE\${SEDdB}_POSIX_SOURCE\${SEDdC}1\${SEDdD}
+\${SEDuA}_POSIX_SOURCE\${SEDuB}_POSIX_SOURCE\${SEDuC}1\${SEDuD}
+\${SEDeA}_POSIX_SOURCE\${SEDeB}_POSIX_SOURCE\${SEDeC}1\${SEDeD}
+"
+}
+
+  
+{
+test -n "$verbose" && \
+echo "	defining" _POSIX_1_SOURCE to be 2
+echo "#define" _POSIX_1_SOURCE 2 >> confdefs.h
+DEFS="$DEFS -D_POSIX_1_SOURCE=2"
+SEDDEFS="${SEDDEFS}\${SEDdA}_POSIX_1_SOURCE\${SEDdB}_POSIX_1_SOURCE\${SEDdC}2\${SEDdD}
+\${SEDuA}_POSIX_1_SOURCE\${SEDuB}_POSIX_1_SOURCE\${SEDuC}2\${SEDuD}
+\${SEDeA}_POSIX_1_SOURCE\${SEDeB}_POSIX_1_SOURCE\${SEDeC}2\${SEDeD}
+"
+}
+
+  
+{
+test -n "$verbose" && \
+echo "	defining _MINIX"
+echo "#define" _MINIX 1 >> confdefs.h
+DEFS="$DEFS -D_MINIX=1"
+SEDDEFS="${SEDDEFS}\${SEDdA}_MINIX\${SEDdB}_MINIX\${SEDdC}1\${SEDdD}
+\${SEDuA}_MINIX\${SEDuB}_MINIX\${SEDuC}1\${SEDuD}
+\${SEDeA}_MINIX\${SEDeB}_MINIX\${SEDeC}1\${SEDeD}
+"
+}
+
+fi
+
+echo checking for ANSI C header files
+cat > conftest.c <<EOF
+#include "confdefs.h"
+#include <stdlib.h>
+#include <stdarg.h>
+#include <string.h>
+#include <float.h>
+EOF
+err=`eval "($CPP conftest.c >/dev/null) 2>&1"`
+if test -z "$err"; then
+  rm -rf conftest*
+  # SunOS 4.x string.h does not declare mem*, contrary to ANSI.
+echo '#include "confdefs.h"
+#include <string.h>' > conftest.c
+eval "$CPP conftest.c > conftest.out 2>&1"
+if egrep "memchr" conftest.out >/dev/null 2>&1; then
+  rm -rf conftest*
+  # SGI's /bin/cc from Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.
+cat > conftest.c <<EOF
+#include "confdefs.h"
+#include <ctype.h>
+#define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
+#define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
+#define XOR(e,f) (((e) && !(f)) || (!(e) && (f)))
+int main () { int i; for (i = 0; i < 256; i++)
+if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) exit(2);
+exit (0); }
+
+EOF
+eval $compile
+if test -s conftest && (./conftest; exit) 2>/dev/null; then
+  
+{
+test -n "$verbose" && \
+echo "	defining STDC_HEADERS"
+echo "#define" STDC_HEADERS 1 >> confdefs.h
+DEFS="$DEFS -DSTDC_HEADERS=1"
+SEDDEFS="${SEDDEFS}\${SEDdA}STDC_HEADERS\${SEDdB}STDC_HEADERS\${SEDdC}1\${SEDdD}
+\${SEDuA}STDC_HEADERS\${SEDuB}STDC_HEADERS\${SEDuC}1\${SEDuD}
+\${SEDeA}STDC_HEADERS\${SEDeB}STDC_HEADERS\${SEDeC}1\${SEDeD}
+"
+}
+
+
+fi
+rm -fr conftest*
+
+fi
+rm -f conftest*
+
+
+fi
+rm -f conftest*
+
+for hdr in unistd.h string.h memory.h limits.h time.h sys/types.h sys/time.h sys/timeb.h sys/times.h
+do
+trhdr=HAVE_`echo $hdr | tr '[a-z]./' '[A-Z]__'`
+echo checking for ${hdr}
+cat > conftest.c <<EOF
+#include "confdefs.h"
+#include <${hdr}>
+EOF
+err=`eval "($CPP conftest.c >/dev/null) 2>&1"`
+if test -z "$err"; then
+  rm -rf conftest*
+  
+{
+test -n "$verbose" && \
+echo "	defining ${trhdr}"
+echo "#define" ${trhdr} 1 >> confdefs.h
+DEFS="$DEFS -D${trhdr}=1"
+SEDDEFS="${SEDDEFS}\${SEDdA}${trhdr}\${SEDdB}${trhdr}\${SEDdC}1\${SEDdD}
+\${SEDuA}${trhdr}\${SEDuB}${trhdr}\${SEDuC}1\${SEDuD}
+\${SEDeA}${trhdr}\${SEDeB}${trhdr}\${SEDeC}1\${SEDeD}
+"
+}
+
+
+fi
+rm -f conftest*
+done
+
+echo checking for whether time.h and sys/time.h may both be included
+cat > conftest.c <<EOF
+#include "confdefs.h"
+#include <sys/types.h>
+#include <sys/time.h>
+#include <time.h>
+int main() { exit(0); }
+int t() { struct tm *tp; }
+EOF
+if eval $compile; then
+  rm -rf conftest*
+  
+{
+test -n "$verbose" && \
+echo "	defining TIME_WITH_SYS_TIME"
+echo "#define" TIME_WITH_SYS_TIME 1 >> confdefs.h
+DEFS="$DEFS -DTIME_WITH_SYS_TIME=1"
+SEDDEFS="${SEDDEFS}\${SEDdA}TIME_WITH_SYS_TIME\${SEDdB}TIME_WITH_SYS_TIME\${SEDdC}1\${SEDdD}
+\${SEDuA}TIME_WITH_SYS_TIME\${SEDuB}TIME_WITH_SYS_TIME\${SEDuC}1\${SEDuD}
+\${SEDeA}TIME_WITH_SYS_TIME\${SEDeB}TIME_WITH_SYS_TIME\${SEDeC}1\${SEDeD}
+"
+}
+
+
+fi
+rm -f conftest*
+
+for func in ftime times
+do
+trfunc=HAVE_`echo $func | tr '[a-z]' '[A-Z]'`
+echo checking for ${func}
+cat > conftest.c <<EOF
+#include "confdefs.h"
+#include <ctype.h>
+int main() { exit(0); }
+int t() { 
+/* 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_${func}) || defined (__stub___${func})
+choke me
+#else
+/* Override any gcc2 internal prototype to avoid an error.  */
+extern char ${func}(); ${func}();
+#endif
+ }
+EOF
+if eval $compile; then
+  rm -rf conftest*
+  {
+test -n "$verbose" && \
+echo "	defining ${trfunc}"
+echo "#define" ${trfunc} 1 >> confdefs.h
+DEFS="$DEFS -D${trfunc}=1"
+SEDDEFS="${SEDDEFS}\${SEDdA}${trfunc}\${SEDdB}${trfunc}\${SEDdC}1\${SEDdD}
+\${SEDuA}${trfunc}\${SEDuB}${trfunc}\${SEDuC}1\${SEDuD}
+\${SEDeA}${trfunc}\${SEDeB}${trfunc}\${SEDeC}1\${SEDeD}
+"
+}
+
+
+fi
+rm -f conftest*
+done
+
+echo checking for return type of signal handlers
+cat > conftest.c <<EOF
+#include "confdefs.h"
+#include <sys/types.h>
+#include <signal.h>
+#ifdef signal
+#undef signal
+#endif
+extern void (*signal ()) ();
+int main() { exit(0); }
+int t() { int i; }
+EOF
+if eval $compile; then
+  rm -rf conftest*
+  
+{
+test -n "$verbose" && \
+echo "	defining" RETSIGTYPE to be void
+echo "#define" RETSIGTYPE void >> confdefs.h
+DEFS="$DEFS -DRETSIGTYPE=void"
+SEDDEFS="${SEDDEFS}\${SEDdA}RETSIGTYPE\${SEDdB}RETSIGTYPE\${SEDdC}void\${SEDdD}
+\${SEDuA}RETSIGTYPE\${SEDuB}RETSIGTYPE\${SEDuC}void\${SEDuD}
+\${SEDeA}RETSIGTYPE\${SEDeB}RETSIGTYPE\${SEDeC}void\${SEDeD}
+"
+}
+
+
+else
+  rm -rf conftest*
+  
+{
+test -n "$verbose" && \
+echo "	defining" RETSIGTYPE to be int
+echo "#define" RETSIGTYPE int >> confdefs.h
+DEFS="$DEFS -DRETSIGTYPE=int"
+SEDDEFS="${SEDDEFS}\${SEDdA}RETSIGTYPE\${SEDdB}RETSIGTYPE\${SEDdC}int\${SEDdD}
+\${SEDuA}RETSIGTYPE\${SEDuB}RETSIGTYPE\${SEDuC}int\${SEDuD}
+\${SEDeA}RETSIGTYPE\${SEDeB}RETSIGTYPE\${SEDeC}int\${SEDeD}
+"
+}
+
+fi
+rm -f conftest*
+
+
+prog='/* Ultrix mips cc rejects this.  */
+typedef int charset[2]; const charset x;
+/* SunOS 4.1.1 cc rejects this.  */
+char const *const *ccp;
+char **p;
+/* AIX XL C 1.02.0.0 rejects this.
+   It does not let you subtract one const X* pointer from another in an arm
+   of an if-expression whose if-part is not a constant expression */
+const char *g = "string";
+ccp = &g + (g ? g-g : 0);
+/* HPUX 7.0 cc rejects these. */
+++ccp;
+p = (char**) ccp;
+ccp = (char const *const *) p;
+{ /* SCO 3.2v4 cc rejects this.  */
+  char *t;
+  char const *s = 0 ? (char *) 0 : (char const *) 0;
+
+  *t++ = 0;
+}
+{ /* Someone thinks the Sun supposedly-ANSI compiler will reject this.  */
+  int x[] = {25,17};
+  const int *foo = &x[0];
+  ++foo;
+}
+{ /* Sun SC1.0 ANSI compiler rejects this -- but not the above. */
+  typedef const int *iptr;
+  iptr p = 0;
+  ++p;
+}
+{ /* AIX XL C 1.02.0.0 rejects this saying
+     "k.c", line 2.27: 1506-025 (S) Operand must be a modifiable lvalue. */
+  struct s { int j; const int *ap[3]; };
+  struct s *b; b->j = 5;
+}
+{ /* ULTRIX-32 V3.1 (Rev 9) vcc rejects this */
+  const int foo = 10;
+}'
+echo checking for lack of working const
+cat > conftest.c <<EOF
+#include "confdefs.h"
+
+int main() { exit(0); }
+int t() { $prog }
+EOF
+if eval $compile; then
+  :
+else
+  rm -rf conftest*
+  
+{
+test -n "$verbose" && \
+echo "	defining" const to be empty
+echo "#define" const  >> confdefs.h
+DEFS="$DEFS -Dconst="
+SEDDEFS="${SEDDEFS}\${SEDdA}const\${SEDdB}const\${SEDdC}\${SEDdD}
+\${SEDuA}const\${SEDuB}const\${SEDuC}\${SEDuD}
+\${SEDeA}const\${SEDeB}const\${SEDeC}\${SEDeD}
+"
+}
+
+fi
+rm -f conftest*
+
+echo checking whether $CC and cc understand -c and -o together
+echo 'foo(){}' > conftest.c
+# Make sure it works both with $CC and with simple cc.
+# We do the test twice because some compilers refuse to overwrite an
+# existing .o file with -o, though they will create one.
+if ${CC-cc} -c conftest.c -o conftest.o >/dev/null 2>&1 \
+ && test -f conftest.o && ${CC-cc} -c conftest.c -o conftest.o >/dev/null 2>&1
+then
+  # Test first that cc exists at all.
+  if cc -c conftest.c >/dev/null 2>&1
+  then
+    if cc -c conftest.c -o conftest2.o >/dev/null 2>&1 && \
+       test -f conftest2.o && cc -c conftest.c -o conftest2.o >/dev/null 2>&1
+    then
+      :
+    else
+      
+{
+test -n "$verbose" && \
+echo "	defining NO_MINUS_C_MINUS_O"
+echo "#define" NO_MINUS_C_MINUS_O 1 >> confdefs.h
+DEFS="$DEFS -DNO_MINUS_C_MINUS_O=1"
+SEDDEFS="${SEDDEFS}\${SEDdA}NO_MINUS_C_MINUS_O\${SEDdB}NO_MINUS_C_MINUS_O\${SEDdC}1\${SEDdD}
+\${SEDuA}NO_MINUS_C_MINUS_O\${SEDuB}NO_MINUS_C_MINUS_O\${SEDuC}1\${SEDuD}
+\${SEDeA}NO_MINUS_C_MINUS_O\${SEDeB}NO_MINUS_C_MINUS_O\${SEDeC}1\${SEDeD}
+"
+}
+
+    fi
+  fi
+else
+  
+{
+test -n "$verbose" && \
+echo "	defining NO_MINUS_C_MINUS_O"
+echo "#define" NO_MINUS_C_MINUS_O 1 >> confdefs.h
+DEFS="$DEFS -DNO_MINUS_C_MINUS_O=1"
+SEDDEFS="${SEDDEFS}\${SEDdA}NO_MINUS_C_MINUS_O\${SEDdB}NO_MINUS_C_MINUS_O\${SEDdC}1\${SEDdD}
+\${SEDuA}NO_MINUS_C_MINUS_O\${SEDuB}NO_MINUS_C_MINUS_O\${SEDuC}1\${SEDuD}
+\${SEDeA}NO_MINUS_C_MINUS_O\${SEDeB}NO_MINUS_C_MINUS_O\${SEDeC}1\${SEDeD}
+"
+}
+
+fi
+rm -f conftest*
+
+
+
+
+# Set default prefixes.
+if test -n "$prefix"; then
+  test -z "$exec_prefix" && exec_prefix='${prefix}'
+  prsub="s%^prefix\\([ 	]*\\)=\\([ 	]*\\).*$%prefix\\1=\\2$prefix%"
+fi
+if test -n "$exec_prefix"; then
+  prsub="$prsub
+s%^exec_prefix\\([ 	]*\\)=\\([ 	]*\\).*$%exec_prefix\\1=\\2$exec_prefix%"
+fi
+# Quote sed substitution magic chars in DEFS.
+cat >conftest.def <<EOF
+$DEFS
+EOF
+escape_ampersand_and_backslash='s%[&\\]%\\&%g'
+DEFS=`sed "$escape_ampersand_and_backslash" <conftest.def`
+rm -f conftest.def
+# Substitute for predefined variables.
+
+trap 'rm -f config.status; exit 1' 1 3 15
+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 $configure_args
+
+for arg
+do
+  case "\$arg" in
+    -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+    echo running \${CONFIG_SHELL-/bin/sh} $0 $configure_args
+    exec \${CONFIG_SHELL-/bin/sh} $0 $configure_args ;;
+    *) echo "Usage: config.status --recheck" 2>&1; exit 1 ;;
+  esac
+done
+
+trap 'rm -fr Makefile scmconfig.h conftest*; exit 1' 1 3 15
+CFLAGS='$CFLAGS'
+LDFLAGS='$LDFLAGS'
+CC='$CC'
+INSTALL='$INSTALL'
+INSTALL_PROGRAM='$INSTALL_PROGRAM'
+INSTALL_DATA='$INSTALL_DATA'
+CPP='$CPP'
+RANLIB='$RANLIB'
+LIBOBJS='$LIBOBJS'
+LIBS='$LIBS'
+srcdir='$srcdir'
+prefix='$prefix'
+exec_prefix='$exec_prefix'
+prsub='$prsub'
+extrasub='$extrasub'
+EOF
+cat >> config.status <<\EOF
+
+top_srcdir=$srcdir
+
+CONFIG_FILES=${CONFIG_FILES-"Makefile"}
+for file in .. ${CONFIG_FILES}; do if test "x$file" != x..; then
+  srcdir=$top_srcdir
+  # Remove last slash and all that follows it.  Not all systems have dirname.
+  dir=`echo $file|sed 's%/[^/][^/]*$%%'`
+  if test "$dir" != "$file"; then
+    test "$top_srcdir" != . && srcdir=$top_srcdir/$dir
+    test ! -d $dir && mkdir $dir
+  fi
+  echo creating $file
+  rm -f $file
+  echo "# Generated automatically from `echo $file|sed 's|.*/||'`.in by configure." > $file
+  sed -e "
+$prsub
+$extrasub
+s%@CFLAGS@%$CFLAGS%g
+s%@LDFLAGS@%$LDFLAGS%g
+s%@CC@%$CC%g
+s%@INSTALL@%$INSTALL%g
+s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g
+s%@INSTALL_DATA@%$INSTALL_DATA%g
+s%@CPP@%$CPP%g
+s%@RANLIB@%$RANLIB%g
+s%@LIBOBJS@%$LIBOBJS%g
+s%@LIBS@%$LIBS%g
+s%@srcdir@%$srcdir%g
+s%@DEFS@%-DHAVE_CONFIG_H%" $top_srcdir/${file}.in >> $file
+fi; done
+
+CONFIG_HEADERS=${CONFIG_HEADERS-"scmconfig.h"}
+for file in .. ${CONFIG_HEADERS}; do if test "x$file" != x..; then
+echo creating $file
+
+# These sed commands are put into SEDDEFS when defining a macro.
+# They are broken into pieces to make the sed script easier to manage.
+# They 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.
+# Each defining turns into a single global substitution command.
+#
+# SEDd sets the value in "#define NAME VALUE" lines.
+SEDdA='s@^\([ 	]*\)#\([ 	]*define[ 	][ 	]*\)'
+SEDdB='\([ 	][ 	]*\)[^ 	]*@\1#\2'
+SEDdC='\3'
+SEDdD='@g'
+# SEDu turns "#undef NAME" with trailing blanks into "#define NAME VALUE".
+SEDuA='s@^\([ 	]*\)#\([ 	]*\)undef\([ 	][ 	]*\)'
+SEDuB='\([ 	]\)@\1#\2define\3'
+SEDuC=' '
+SEDuD='\4@g'
+# SEDe turns "#undef NAME" without trailing blanks into "#define NAME VALUE".
+SEDeA='s@^\([ 	]*\)#\([ 	]*\)undef\([ 	][ 	]*\)'
+SEDeB='$@\1#\2define\3'
+SEDeC=' '
+SEDeD='@g'
+rm -f conftest.sed
+EOF
+# Turn off quoting long enough to insert the sed commands.
+rm -f conftest.sh
+cat > conftest.sh <<EOF
+$SEDDEFS
+EOF
+
+# Break up $SEDDEFS (now in conftest.sh) because some shells have a limit
+# on the size of here documents.
+
+# Maximum number of lines to put in a single here document.
+maxshlines=9
+
+while :
+do
+  # wc gives bogus results for an empty file on some systems.
+  lines=`grep -c . conftest.sh`
+  if test -z "$lines" || test "$lines" -eq 0; then break; fi
+  rm -f conftest.s1 conftest.s2
+  sed ${maxshlines}q conftest.sh > conftest.s1 # Like head -20.
+  sed 1,${maxshlines}d conftest.sh > conftest.s2 # Like tail +21.
+  # Write a limited-size here document to append to conftest.sed.
+  echo 'cat >> conftest.sed <<CONFEOF' >> config.status
+  cat conftest.s1 >> config.status
+  echo 'CONFEOF' >> config.status
+  rm -f conftest.s1 conftest.sh
+  mv conftest.s2 conftest.sh
+done
+rm -f conftest.sh
+
+# Now back to your regularly scheduled config.status.
+cat >> config.status <<\EOF
+# This sed command replaces #undef's 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 in
+# scmconfig.h.
+cat >> conftest.sed <<\CONFEOF
+s,^[ 	]*#[ 	]*undef[ 	][ 	]*[a-zA-Z_][a-zA-Z_0-9]*,/* & */,
+CONFEOF
+rm -f conftest.h
+# Break up the sed commands because old seds have small limits.
+maxsedlines=20
+cp $top_srcdir/$file.in conftest.h1
+while :
+do
+  lines=`grep -c . conftest.sed`
+  if test -z "$lines" || test "$lines" -eq 0; then break; fi
+  rm -f conftest.s1 conftest.s2 conftest.h2
+  sed ${maxsedlines}q conftest.sed > conftest.s1 # Like head -20.
+  sed 1,${maxsedlines}d conftest.sed > conftest.s2 # Like tail +21.
+  sed -f conftest.s1 < conftest.h1 > conftest.h2
+  rm -f conftest.s1 conftest.h1 conftest.sed
+  mv conftest.h2 conftest.h1
+  mv conftest.s2 conftest.sed
+done
+rm -f conftest.sed conftest.h
+echo "/* $file.  Generated automatically by configure.  */" > conftest.h
+cat conftest.h1 >> conftest.h
+rm -f conftest.h1
+if cmp -s $file conftest.h 2>/dev/null; then
+  # The file exists and we would not be changing it.
+  echo "$file is unchanged"
+  rm -f conftest.h
+else
+  rm -f $file
+  mv conftest.h $file
+fi
+fi; done
+
+
+
+exit 0
+EOF
+chmod +x config.status
+${CONFIG_SHELL-/bin/sh} config.status
+
+
diff --git a/configure.in b/configure.in
new file mode 100644
index 0000000..76c60ad
--- /dev/null
+++ b/configure.in
@@ -0,0 +1,33 @@
+dnl Process this file with autoconf to produce a configure script.
+AC_INIT(scl.c)
+AC_CONFIG_HEADER(scmconfig.h)
+
+test -z "$CFLAGS" && CFLAGS=-g AC_SUBST(CFLAGS)
+test -z "$LDFLAGS" && LDFLAGS=-g AC_SUBST(LDFLAGS)
+
+AC_PROG_CC
+AC_PROG_INSTALL
+AC_PROG_CPP
+AC_PROG_RANLIB
+AC_AIX
+AC_ISC_POSIX
+AC_MINIX
+AC_STDC_HEADERS
+AC_HAVE_HEADERS(unistd.h string.h memory.h limits.h time.h sys/types.h sys/time.h sys/timeb.h sys/times.h)
+AC_TIME_WITH_SYS_TIME
+AC_HAVE_FUNCS(ftime times getcwd)
+AC_RETSIGTYPE
+AC_CONST
+AC_MINUS_C_MINUS_O
+dnl AC_PREFIX(scm)
+
+AC_SUBST(LIBOBJS)
+
+AC_OUTPUT(Makefile)
+
+dnl Local Variables:
+dnl comment-start: "dnl "
+dnl comment-end: ""
+dnl comment-start-skip: "\\bdnl\\b\\s *"
+dnl compile-command: "make configure scmconfig.h.in"
+dnl End:
diff --git a/continue.c b/continue.c
new file mode 100644
index 0000000..b28fe6e
--- /dev/null
+++ b/continue.c
@@ -0,0 +1,255 @@
+/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  
+ */
+
+/* "continue.c" Scheme Continuations for C.
+   Author: Aubrey Jaffer */
+
+/* "setjump.h" contains definitions for the `other' field (type
+   CONTINUATION_OTHER) the struct Continuation.  "setjump.h" must
+   #include "continue.h".  CONTINUATION_OTHER defaults to `long' */
+
+#define IN_CONTINUE_C
+#ifdef USE_CONTINUE_H
+# include "continue.h"
+#else
+# include "setjump.h"
+#endif
+
+/* For platforms with short integers, we use thrown_value instead of
+   the value returned from setjmp so that any (long) value can be
+   returned.  */
+
+#ifdef SHORT_INT
+long thrown_value;
+#endif
+
+/* stack_size() returns the number of units of size STACKITEM which
+   fit between @var{start} and the current top of stack.  No check is
+   done in this routine to ensure that @var{start} is actually in the
+   current stack segment.  */
+
+long stack_size(start)
+     STACKITEM *start;
+{
+  STACKITEM stack;
+#ifdef STACK_GROWS_UP
+  return &stack - start;
+#else
+  return start - &stack;
+#endif /* def STACK_GROWS_UP */
+}
+
+/* make_root_continuation() allocates (malloc) storage for a
+   CONTINUATION near the current extent of stack.  This newly
+   allocated CONTINUATION is returned if successful, 0 if not.  After
+   make_root_continuation() returns, the calling routine still needs
+   to `setjmp(new_continuation->jmpbuf)' in order to complete the
+   capture of this continuation.  */
+
+CONTINUATION *make_root_continuation(stack_base)
+     STACKITEM *stack_base;
+{
+  CONTINUATION *cont;
+  cont = (CONTINUATION *)malloc(sizeof(CONTINUATION));
+  if (!cont) return 0;
+  cont->length = 0;
+  cont->stkbse = stack_base;
+  cont->parent = cont;
+  return cont;
+}
+
+/* make_continuation() allocates storage for the current continuation,
+   copying (or encapsulating) the stack state from parent_cont->stkbse
+   to the current top of stack.  The newly allocated CONTINUATION is
+   returned if successful, 0 if not.  After make_continuation()
+   returns, the calling routine still needs to
+   `setjmp(new_continuation->jmpbuf)' in order to complete the capture
+   of this continuation.  */
+
+/* Note: allocating local (stack) storage for the CONTINUATION would
+	 not work; Think about it.  */
+
+CONTINUATION *make_continuation(parent_cont)
+     CONTINUATION *parent_cont;
+{
+  CONTINUATION *cont;
+#ifdef CHEAP_CONTINUATIONS
+  cont = (CONTINUATION *)malloc(sizeof(CONTINUATION));
+  if (!cont) return 0;
+  cont->length = 0;
+  cont->stkbse = parent_cont->stkbse;
+#else
+  long j;
+  register STACKITEM *src, *dst;
+  FLUSH_REGISTER_WINDOWS;
+  j = stack_size(parent_cont->stkbse);
+  cont = (CONTINUATION *)malloc((sizeof(CONTINUATION) + j*sizeof(STACKITEM)));
+  if (!cont) return 0;
+  cont->length = j;
+  cont->stkbse = parent_cont->stkbse;
+  src = cont->stkbse;
+# ifdef STACK_GROWS_UP
+  src += parent_cont->length;
+# else
+  src -= parent_cont->length + cont->length;
+# endif/* ndef STACK_GROWS_UP */
+  dst = (STACKITEM *)(cont + 1);
+  for (j = cont->length; 0 <= --j; ) *dst++ = *src++;
+#endif /* ndef CHEAP_CONTINUATIONS */
+  cont->parent = parent_cont;
+  return cont;
+}
+
+/* free_continuation() is trivial, but who knows what the future
+   holds.  */
+
+void free_continuation(cont)
+     CONTINUATION *cont;
+{
+  free(cont);
+}
+
+/* Final routine involved in throw()ing to a continuation.  After
+   ensuring that there is sufficient room on the stack for the saved
+   continuation, dynthrow() copies the continuation onto the stack and
+   longjmp()s into it.  The routine does not return.  */
+
+/* If you use conservative GC and your Sparc(SUN-4) heap is growing
+   out of control:
+
+   You are experiencing a GC problem peculiar to the Sparc.  The
+   problem is that contin doesn't know how to clear register windows.
+   Every location which is not reused still gets marked at GC time.
+   This causes lots of stuff which should be collected to not be.
+   This will be a problem with any *conservative* GC until we find
+   what instruction will clear the register windows.  This problem is
+   exacerbated by using lots of make-CONTINUATION.
+
+   Possibly adding the following before the thrown_value = val; line
+   might help to clear out unused stack above the continuation (a
+   small part of the problem).
+
+#ifdef sparc
+  bzero((void *)&a, sizeof(STACKITEM) *
+	(((STACKITEM *)&a) - (dst - cont->length)))
+#endif
+
+   Let me know if you try it.  */
+
+void dynthrow(a)
+     long *a;
+{
+  register CONTINUATION *cont = (CONTINUATION *)(a[0]);
+  long val = a[1];
+#ifndef CHEAP_CONTINUATIONS
+  register long j;
+  register STACKITEM *src, *dst = cont->stkbse;
+# ifdef STACK_GROWS_UP
+  if (a[2] && (a - ((long *)a[3]) < 100))
+    puts("grow_throw: check if long growth[100]; being optimized out");
+  /* if (a[2]) fprintf(stderr, " ct = %ld, dist = %ld\n", a[2], (((long *)a[3]) - a)); */
+  if PTR_GE(dst + (cont->length), (STACKITEM *)&a) grow_throw(a);
+# else
+  if (a[2] && (((long *)a[3]) - a < 100))
+    puts("grow_throw: check if long growth[100]; being optimized out");
+  /* if (a[2]) fprintf(stderr, " ct = %ld, dist = %ld\n", a[2], (((long *)a[3]) - a)); */
+  dst -= cont->length;
+  if PTR_LE(dst, (STACKITEM *)&a) grow_throw(a);
+# endif/* def STACK_GROWS_UP */
+  FLUSH_REGISTER_WINDOWS;
+  src = (STACKITEM *)(cont + 1);
+  for (j = cont->length;0 <= --j;) *dst++ = *src++;
+#endif /* ndef CHEAP_CONTINUATIONS */
+#ifdef SHORT_INT
+  thrown_value = val;
+  longjmp(cont->jmpbuf, 1);
+#else
+  longjmp(cont->jmpbuf, val);
+#endif
+}
+
+/* grow_throw() grows the stack by 100 long words.  If the "sizeof
+   growth" assignment is not sufficient to restrain your overly
+   optimistic compiler, the stack will grow by much less and
+   grow_throw() and dynthrow() will waste time calling each other.  To
+   fix this you will have to compile grow_throw() in a separate file
+   so the compiler won't be able to guess that the growth array isn't
+   all used.  */
+
+#ifndef CHEAP_CONTINUATIONS
+void grow_throw(a)		/* Grow the stack so that there is room */
+     long *a;			/* to copy in the continuation.  Then */
+{				/* retry the throw.  */
+  long growth[100];
+  growth[0] = a[0];
+  growth[1] = a[1];
+  growth[2] = a[2] + 1;
+  growth[3] = (long) a;
+  growth[99] = sizeof growth;
+  dynthrow(growth);
+}
+#endif /* ndef CHEAP_CONTINUATIONS */
+
+/* throw_to_continuation() restores the stack in effect when
+   @var{cont} was made and resumes @var{cont}'s processor state.  If
+   the stack cannot be resotred because @var{cont} and @var{root_cont}
+   do not have the same stkbase, @code{throw_to_continuation()
+   returns.  */
+
+/* Note: If 2 or more @var{cont}s share a parent continuation and if
+   the values of stack allocated variables in that parent continuation
+   are changed, the results are unspecified.  This is because the
+   parent continuation may or may not be reloaded, depending on what
+   other throws have intervened.  */
+
+void throw_to_continuation(cont, val, root_cont)
+     CONTINUATION *cont;
+     long val;
+     CONTINUATION *root_cont;
+{
+  long a[3];
+  a[0] = (long)cont;
+  a[1] = val;
+  a[2] = 0;
+  if (cont->stkbse != root_cont->stkbse)
+    return;			/* Stale continuation */
+  dynthrow(a);
+}
diff --git a/continue.h b/continue.h
new file mode 100644
index 0000000..3309172
--- /dev/null
+++ b/continue.h
@@ -0,0 +1,178 @@
+/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  
+ */
+
+/* "continue.h" Scheme Continuations for C.
+   Author: Aubrey Jaffer. */
+
+#ifdef vms
+# ifndef CHEAP_CONTINUATIONS
+
+   typedef int jmp_buf[17];
+   extern int setjump(jmp_buf env);
+   extern int longjump(jmp_buf env, int ret);
+
+#  define setjmp setjump
+#  define longjmp longjump
+# else
+#  include <setjmp.h>
+# endif
+#else				/* ndef vms */
+# ifdef _CRAY1
+    typedef int jmp_buf[112];
+    extern int setjump(jmp_buf env);
+    extern int longjump(jmp_buf env, int ret);
+
+#  define setjmp setjump
+#  define longjmp longjump
+# else				/* ndef _CRAY1 */
+#  include <setjmp.h>
+# endif				/* ndef _CRAY1 */
+#endif				/* ndef vms */
+
+/* `other' is a CONTINUATION slot for miscellaneous data of type
+   CONTINUATION_OTHER.  */
+
+#ifndef CONTINUATION_OTHER
+# define CONTINUATION_OTHER int
+#endif
+
+/* If stack is not longword aligned then */
+
+/* #define SHORT_ALIGN */
+#ifdef THINK_C
+# define SHORT_ALIGN
+#endif
+#ifdef MSDOS
+# define SHORT_ALIGN
+#endif
+#ifdef atarist
+# define SHORT_ALIGN
+#endif
+
+#ifdef SHORT_ALIGN
+typedef short STACKITEM;
+#else
+typedef long STACKITEM;
+#endif
+
+struct Continuation {jmp_buf jmpbuf;
+		     long thrwval;
+		     long length;
+		     STACKITEM *stkbse;
+		     CONTINUATION_OTHER other;
+		     struct Continuation *parent;
+		   };
+typedef struct Continuation CONTINUATION;
+
+#ifndef P
+# ifdef USE_ANSI_PROTOTYPES
+#  define P(s) s
+# else
+#  define P(s) ()
+# endif
+#endif
+
+extern long thrown_value;
+long stack_size P((STACKITEM *start));
+CONTINUATION *make_root_continuation P((STACKITEM *stack_base));
+CONTINUATION *make_continuation P((CONTINUATION *parent_cont));
+void free_continuation P((CONTINUATION *cont));
+void dynthrow P((long *a));
+void grow_throw P((long *a));
+void throw_to_continuation P((CONTINUATION *cont, long val,
+			      CONTINUATION *root_cont));
+
+/* how to get the local definition for malloc */
+
+#ifndef STDC_HEADERS
+# ifndef malloc
+	char *malloc P((sizet size));
+# endif
+	char *realloc P((char *ptr, sizet size));
+#endif
+
+/* PTR_LT defines how to compare two addresses (which may not be in
+   the same array).  */
+
+#if defined(__TURBOC__) && !defined(__TOS__)
+# ifdef PROT386
+#  define PTR_LT(x, y) (((long)(x)) < ((long)(y)))
+# else
+#  define PTR_LT(x, y) ((x) < (y))
+# endif
+#else /* not __TURBOC__ */
+# ifdef nosve
+#  define PTR_MASK 0xffffffffffff
+#  define PTR_LT(x, y) (((int)(x)&PTR_MASK) < ((int)(y)&PTR_MASK))
+# else
+#  define PTR_LT(x, y) ((x) < (y))
+# endif
+#endif
+
+#define PTR_GT(x, y) PTR_LT(y, x)
+#define PTR_LE(x, y) (!PTR_GT(x, y))
+#define PTR_GE(x, y) (!PTR_LT(x, y))
+
+/* James Clark came up with this neat one instruction fix for
+   continuations on the SPARC.  It flushes the register windows so
+   that all the state of the process is contained in the stack. */
+
+#ifdef sparc
+# define FLUSH_REGISTER_WINDOWS asm("ta 3")
+#else
+# define FLUSH_REGISTER_WINDOWS /* empty */
+#endif
+
+/* If stacks grow up then */
+
+/* #define STACK_GROWS_UP */
+#ifdef hp9000s800
+# define STACK_GROWS_UP
+#endif
+#ifdef pyr
+# define STACK_GROWS_UP
+#endif
+#ifdef nosve
+# define STACK_GROWS_UP
+#endif
+#ifdef _UNICOS
+# define STACK_GROWS_UP
+#endif
diff --git a/crs.c b/crs.c
new file mode 100644
index 0000000..5a4a5f1
--- /dev/null
+++ b/crs.c
@@ -0,0 +1,412 @@
+/* Copyright (C) 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  
+ */
+
+/* "crs.c" interface to `curses' interactive terminal control library.
+   Author: Aubrey Jaffer */
+
+#include "scm.h"
+#include <curses.h>
+
+#ifdef MWC
+# include <unctrl.h>
+#endif
+
+#ifndef STDC_HEADERS
+	int wrefresh P((WINDOW *));
+	int wgetch P((WINDOW *));
+#endif
+
+/* define WIN port type */
+#define WIN(obj) ((WINDOW*)CDR(obj))
+#define WINP(obj) (tc16_window==TYP16(obj))
+int freewindow(win)
+     WINDOW *win;
+{
+  if (win==stdscr) return 0;
+  delwin(win);
+  return 0;
+}
+int prinwindow(exp, port, writing)
+     SCM exp; SCM port; int writing;
+{
+  prinport(exp, port, "window");
+  return !0;
+}
+int bwaddch(c, win) int c; WINDOW *win; {waddch(win, c);return c;}
+int bwaddstr(str, win) char *str; WINDOW *win; {waddstr(win, str);return 0;}
+sizet bwwrite(str, siz, num, win)
+     sizet siz, num;
+     char *str; WINDOW *win;
+{
+  sizet i = 0, prod = siz*num;
+  for (;i < prod;i++) waddch(win, str[i]);
+  return num;
+}
+int tc16_window;
+static ptobfuns winptob = {
+  mark0,
+  freewindow,
+  prinwindow,
+  equal0,
+  bwaddch,
+  bwaddstr,
+  bwwrite,
+  wrefresh,
+  wgetch,
+  freewindow};
+
+SCM mkwindow(win)
+     WINDOW *win;
+{
+  SCM z;
+  if (NULL==win) return BOOL_F;
+  NEWCELL(z);
+  DEFER_INTS;
+  SETCHARS(z, win);
+  CAR(z) = tc16_window | OPN | RDNG | WRTNG;
+  ALLOW_INTS;
+  return z;
+}
+
+SCM *loc_stdscr = 0;
+SCM linitscr()
+{
+  WINDOW *win;
+  if NIMP(*loc_stdscr) {
+    refresh();
+    return *loc_stdscr;
+  }
+  win = initscr();
+  return *loc_stdscr = mkwindow(win);
+}
+SCM lendwin()
+{
+  if IMP(*loc_stdscr) return BOOL_F;
+  return ERR==endwin() ? BOOL_F : BOOL_T;
+}
+
+static char s_newwin[] = "newwin", s_subwin[] = "subwin", s_mvwin[] = "mvwin",
+	    s_overlay[] = "overlay", s_overwrite[] = "overwrite";
+SCM lnewwin(lines, cols, args)
+     SCM lines, cols, args;
+{
+  SCM begin_y, begin_x;
+  WINDOW *win;
+  ASSERT(INUMP(lines), lines, ARG1, s_newwin);
+  ASSERT(INUMP(cols), cols, ARG2, s_newwin);
+  ASSERT(2==ilength(args), args, WNA, s_newwin);
+  begin_y = CAR(args);
+  begin_x = CAR(CDR(args));
+  ASSERT(INUMP(begin_y), begin_y, ARG3, s_newwin);
+  ASSERT(INUMP(begin_x), begin_y, ARG4, s_newwin);
+  win = newwin(INUM(lines), INUM(cols),
+	       INUM(begin_y), INUM(begin_x));
+  return mkwindow(win);
+}
+
+SCM lmvwin(win, y, x)
+     SCM win, y, x;
+{
+  ASSERT(NIMP(win) && WINP(win), win, ARG1, s_mvwin);
+  ASSERT(INUMP(x), x, ARG2, s_mvwin);
+  ASSERT(INUMP(y), y, ARG3, s_mvwin);
+  return ERR==mvwin(WIN(win), INUM(y), INUM(x)) ? BOOL_F : BOOL_T;
+}
+
+SCM lsubwin(win, lines, args)
+     SCM win, lines, args;
+{
+  SCM cols, begin_y, begin_x;
+  WINDOW *nwin;
+  ASSERT(NIMP(win) && WINP(win), win, ARG1, s_subwin);
+  ASSERT(INUMP(lines), lines, ARG2, s_subwin);
+  ASSERT(3==ilength(args), args, WNA, s_subwin);
+  cols = CAR(args);
+  args = CDR(args);
+  begin_y = CAR(args);
+  begin_x = CAR(CDR(args));
+  ASSERT(INUMP(cols), cols, ARG3, s_subwin);
+  ASSERT(INUMP(begin_y), begin_y, ARG3, s_subwin);
+  ASSERT(INUMP(begin_x), begin_y, ARG4, s_subwin);
+  nwin = subwin(WIN(win), INUM(lines), INUM(cols),
+		INUM(begin_y), INUM(begin_x));
+  return mkwindow(nwin);
+}
+
+SCM loverlay(srcwin, dstwin)
+     SCM srcwin, dstwin;
+{
+  ASSERT(NIMP(srcwin) && WINP(srcwin), srcwin, ARG1, s_overlay);
+  ASSERT(NIMP(dstwin) && WINP(dstwin), dstwin, ARG2, s_overlay);
+  return ERR==overlay(WIN(srcwin), WIN(dstwin)) ? BOOL_F : BOOL_T;
+}
+
+SCM loverwrite(srcwin, dstwin)
+     SCM srcwin, dstwin;
+{
+  ASSERT(NIMP(srcwin) && WINP(srcwin), srcwin, ARG1, s_overwrite);
+  ASSERT(NIMP(dstwin) && WINP(dstwin), dstwin, ARG2, s_overwrite);
+  return ERR==overwrite(WIN(srcwin), WIN(dstwin)) ? BOOL_F : BOOL_T;
+}
+
+static char s_wmove[] = "wmove", s_wadd[] = "wadd", s_winsert[] = "winsert",
+	s_box[] = "box";
+SCM lwmove(win, y, x)
+     SCM win, y, x;
+{
+  ASSERT(NIMP(win) && WINP(win), win, ARG1, s_wmove);
+  ASSERT(INUMP(x), x, ARG2, s_wmove);
+  ASSERT(INUMP(y), y, ARG3, s_wmove);
+  return ERR==wmove(WIN(win), INUM(y), INUM(x)) ? BOOL_F : BOOL_T;
+}
+
+SCM lwadd(win, obj)
+     SCM win, obj;
+{
+  ASSERT(NIMP(win) && WINP(win), win, ARG1, s_wadd);
+  if ICHRP(obj)
+    return ERR==waddch(WIN(win), ICHR(obj)) ? BOOL_F : BOOL_T;
+  if INUMP(obj)
+    return ERR==waddch(WIN(win), INUM(obj)) ? BOOL_F : BOOL_T;
+  ASSERT(NIMP(obj) && STRINGP(obj), obj, ARG2, s_wadd);
+  return ERR==waddstr(WIN(win), CHARS(obj)) ? BOOL_F : BOOL_T;
+}
+
+SCM lwinsert(win, obj)
+     SCM win, obj;
+{
+  ASSERT(NIMP(win) && WINP(win), win, ARG1, s_winsert);
+  if INUMP(obj)
+    return ERR==winsch(WIN(win), INUM(obj)) ? BOOL_F : BOOL_T;
+  ASSERT(ICHRP(obj), obj, ARG2, s_winsert);
+  return ERR==winsch(WIN(win), ICHR(obj)) ? BOOL_F : BOOL_T;
+}
+
+SCM lbox(win, vertch, horch)
+     SCM win, vertch, horch;
+{
+  int v, h;
+  ASSERT(NIMP(win) && WINP(win), win, ARG1, s_box);
+  if INUMP(vertch) v = INUM(vertch);
+  else {
+    ASSERT(ICHRP(vertch), vertch, ARG2, s_box);
+    v = ICHR(vertch);
+  }
+  if INUMP(horch) h = INUM(horch);
+  else {
+    ASSERT(ICHRP(horch), horch, ARG3, s_box);
+    h = ICHR(horch);
+  }
+  return ERR==box(WIN(win), v, h) ? BOOL_F : BOOL_T;
+}
+
+static char s_getyx[] = "getyx", s_winch[] = "winch", s_unctrl[] = "unctrl";
+SCM lgetyx(win)
+     SCM win;
+{
+  int y, x;
+  ASSERT(NIMP(win) && WINP(win), win, ARG1, s_getyx);
+  getyx(WIN(win), y, x);
+  return cons2(MAKINUM(y), MAKINUM(x), EOL);
+}
+
+SCM lwinch(win)
+     SCM win;
+{
+  ASSERT(NIMP(win) && WINP(win), win, ARG1, s_winch);
+  return MAKICHR(winch(WIN(win)));
+}
+
+SCM lunctrl(c)
+     SCM c;
+{
+  ASSERT(ICHRP(c), c, ARG1, s_unctrl);
+  {
+    char *str = unctrl(ICHR(c));
+    return makfrom0str(str);
+  }
+}
+static char s_owidth[] = "output-port-width";
+static char s_oheight[] = "output-port-height";
+SCM owidth(arg)
+     SCM arg;
+{
+  if UNBNDP(arg) arg = cur_outp;
+  ASSERT(NIMP(arg) && OPOUTPORTP(arg), arg, ARG1, s_owidth);
+  if NIMP(*loc_stdscr)
+    if WINP(arg) return MAKINUM(WIN(arg)->_maxx+1);
+    else return MAKINUM(COLS);
+  return MAKINUM(80);
+}
+SCM oheight(arg)
+     SCM arg;
+{
+  if UNBNDP(arg) arg = cur_outp;
+  ASSERT(NIMP(arg) && OPOUTPORTP(arg), arg, ARG1, s_owidth);
+  if NIMP(*loc_stdscr)
+    if WINP(arg) return MAKINUM(WIN(arg)->_maxy+1);
+    else return MAKINUM(LINES);
+  return MAKINUM(24);
+}
+SCM lrefresh()
+{
+  return MAKINUM(wrefresh(curscr));
+}
+
+#define SUBR0(lname, name) SCM lname(){name();return UNSPECIFIED;}
+SUBR0(lnl, nl)
+SUBR0(lnonl, nonl)
+SUBR0(lcbreak, cbreak)
+SUBR0(lnocbreak, nocbreak)
+SUBR0(lecho, echo)
+SUBR0(lnoecho, noecho)
+SUBR0(lraw, raw)
+SUBR0(lnoraw, noraw)
+SUBR0(lsavetty, savetty)
+SUBR0(lresetty, resetty)
+
+static char s_nonl[] = "nonl", s_nocbreak[] = "nocbreak",
+	    s_noecho[] = "noecho", s_noraw[] = "noraw";
+
+static iproc subr0s[] = {
+	{"initscr", linitscr},
+	{"endwin", lendwin},
+	{&s_nonl[2], lnl},
+	{s_nonl, lnonl},
+	{&s_nocbreak[2], lcbreak},
+	{s_nocbreak, lnocbreak},
+	{&s_noecho[2], lecho},
+	{s_noecho, lnoecho},
+	{&s_noraw[2], lraw},
+	{s_noraw, lnoraw},
+	{"resetty", lresetty},
+	{"savetty", lsavetty},
+	{"refresh", lrefresh},
+	{0, 0}};
+
+#define SUBRW(ln, n, s_n, sn) static char s_n[]=sn;\
+	SCM ln(w)SCM w;\
+	{ASSERT(NIMP(w) && WINP(w), w, ARG1, sn);\
+	return ERR==n(WIN(w))?BOOL_F:BOOL_T;}
+
+SUBRW(lwerase, werase, s_werase, "werase")
+SUBRW(lwclear, wclear, s_wclear, "wclear")
+SUBRW(lwclrtobot, wclrtobot, s_wclrtobot, "wclrtobot")
+SUBRW(lwclrtoeol, wclrtoeol, s_wclrtoeol, "wclrtoeol")
+SUBRW(lwdelch, wdelch, s_wdelch, "wdelch")
+SUBRW(lwdeleteln, wdeleteln, s_wdeleteln, "wdeleteln")
+SUBRW(lwinsertln, winsertln, s_winsertln, "winsertln")
+SUBRW(lscroll, scroll, s_scroll, "scroll")
+SUBRW(ltouchwin, touchwin, s_touchwin, "touchwin")
+SUBRW(lwstandout, wstandout, s_wstandout, "wstandout")
+SUBRW(lwstandend, wstandend, s_wstandend, "wstandend")
+
+static iproc subr1s[] = {
+	{s_werase, lwerase},
+	{s_wclear, lwclear},
+	{s_wclrtobot, lwclrtobot},
+	{s_wclrtoeol, lwclrtoeol},
+	{s_wdelch, lwdelch},
+	{s_wdeleteln, lwdeleteln},
+	{s_winsertln, lwinsertln},
+	{s_scroll, lscroll},
+	{s_touchwin, ltouchwin},
+	{s_wstandout, lwstandout},
+	{s_wstandend, lwstandend},
+	{s_getyx, lgetyx},
+	{s_winch, lwinch},
+	{s_unctrl, lunctrl},
+	{0, 0}};
+
+#define SUBROPT(ln, n, s_n, sn) static char s_n[]=sn;\
+	SCM ln(w, b)SCM w, b;\
+	{ASSERT(NIMP(w) && WINP(w), w, ARG1, sn);\
+	return ERR==n(WIN(w), BOOL_F != b)?BOOL_F:BOOL_T;}
+
+/* SUBROPT(lclearok, clearok, s_clearok, "clearok") */
+/* SUBROPT(lidlok, idlok, s_idlok, "idlok") */
+SUBROPT(lleaveok, leaveok, s_leaveok, "leaveok")
+SUBROPT(lscrollok, scrollok, s_scrollok, "scrollok")
+/* SUBROPT(lnodelay, nodelay, s_nodelay, "nodelay") */
+
+static char s_clearok[] = "clearok";
+SCM lclearok(w, b) SCM w, b;
+{
+  if (BOOL_T==w) return ERR==clearok(curscr, BOOL_F != b)?BOOL_F:BOOL_T;
+  ASSERT(NIMP(w) && WINP(w), w, ARG1, s_clearok);
+  return ERR==clearok(WIN(w), BOOL_F != b)?BOOL_F:BOOL_T;
+}
+
+static iproc subr2s[] = {
+	{s_overlay, loverlay},
+	{s_overwrite, loverwrite},
+	{s_wadd, lwadd},
+	{s_winsert, lwinsert},
+	{s_clearok, lclearok},
+	/* {s_idlok, lidlok}, */
+	{s_leaveok, lleaveok},
+	{s_scrollok, lscrollok},
+/*	{s_nodelay, lnodelay}, */
+	{0, 0}};
+
+void init_crs()
+{
+  /*  savetty(); */
+  /* "Stdscr" is a nearly inaccessible symbol used as a GC protect. */
+  loc_stdscr = &CDR(sysintern("Stdscr", UNDEFINED));
+  tc16_window = newptob(&winptob);
+
+  init_iprocs(subr0s, tc7_subr_0);
+  init_iprocs(subr1s, tc7_subr_1);
+  init_iprocs(subr2s, tc7_subr_2);
+
+  make_subr(s_owidth, tc7_subr_1o, owidth);
+  make_subr(s_oheight, tc7_subr_1o, oheight);
+
+  make_subr(s_newwin, tc7_lsubr_2, lnewwin);
+  make_subr(s_subwin, tc7_lsubr_2, lsubwin);
+
+  make_subr(s_wmove, tc7_subr_3, lwmove);
+  make_subr(s_mvwin, tc7_subr_3, lmvwin);
+  make_subr(s_box, tc7_subr_3, lbox);
+  add_feature("curses");
+  add_final(lendwin);
+}
diff --git a/dynl.c b/dynl.c
new file mode 100644
index 0000000..6cd3b58
--- /dev/null
+++ b/dynl.c
@@ -0,0 +1,448 @@
+/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  
+ */
+
+/* "dynl.c" dynamically link&load object files.
+   Author: Aubrey Jaffer */
+
+#include "scm.h"
+#ifndef STDC_HEADERS
+	int free ();		/* P((char *ptr)) */
+#endif
+
+/* linkpath holds the filename which just got linked.  Scheme
+   *loadpath* will get set to linkpath and then restored around the
+   initialization call */
+/* static SCM linkpath; */
+
+#ifdef DLD
+# include "dld.h"
+
+void listundefs()
+{
+  int i;
+  char **undefs = dld_list_undefined_sym();
+  puts("   undefs:");
+  for(i = dld_undefined_sym_count;i--;) {
+    putc('"', stdout);
+    fputs(undefs[i], stdout);
+    puts("\"");
+  }
+  free(undefs);
+}
+
+static char s_link[] = "dyn:link", s_call[] = "dyn:call";
+SCM l_dyn_link(fname)
+     SCM fname;
+{
+  int status;
+  ASSERT(NIMP(fname) && STRINGP(fname), fname, ARG1, s_link);
+  DEFER_INTS;
+  status = dld_link(CHARS(fname));
+  ALLOW_INTS;
+  if (!status) {/* linkpath = fname; */ return fname;}
+  if (DLD_ENOFILE==status) return BOOL_F;
+  if (DLD_EBADOBJECT==status) return BOOL_F;
+  dld_perror("DLD");
+  return BOOL_F;
+}
+SCM l_dyn_call(symb, shl)
+     SCM symb, shl;
+{
+  int i;
+  void (*func)() = 0;
+/*  SCM oloadpath = *loc_loadpath; */
+  ASSERT(NIMP(symb) && STRINGP(symb), symb, ARG1, s_call);
+  DEFER_INTS;
+  if ((i = dld_function_executable_p(CHARS(symb))))
+    func = (void (*) ()) dld_get_func(CHARS(symb));
+  else dld_perror("DLDP");
+  ALLOW_INTS;
+  if (!i) listundefs();
+  if (!func) {
+    dld_perror("DLD");
+    return BOOL_F;
+  }
+/*  *loc_loadpath = linkpath; */
+  (*func) ();
+/*  *loc_loadpath = oloadpath; */
+  return BOOL_T;
+}
+static char s_main_call[] = "dyn:main-call";
+SCM l_dyn_main_call(symb, shl, args)
+     SCM symb, shl, args;
+{
+  int i;
+  int (*func)(int argc, char **argv) = 0;
+  char **argv;
+/*  SCM oloadpath = *loc_loadpath; */
+  ASSERT(NIMP(symb) && STRINGP(symb), symb, ARG1, s_main_call);
+  DEFER_INTS;
+  argv = makargvfrmstrs(args, s_main_call);
+  if ((i = dld_function_executable_p(CHARS(symb))))
+    func = (int (*) (int argc, char **argv)) dld_get_func(CHARS(symb));
+  else dld_perror("DLDP");
+  if (!i) listundefs();
+  if (!func) {
+    must_free_argv(argv);
+    ALLOW_INTS;
+    dld_perror("DLD");
+    return BOOL_F;
+  }
+  ALLOW_INTS;
+/*  *loc_loadpath = linkpath; */
+  i = (*func) ((int)ilength(args), argv);
+/*  *loc_loadpath = oloadpath; */
+  DEFER_INTS;
+  must_free_argv(argv);
+  ALLOW_INTS;
+  return MAKINUM(0L+i);
+}
+
+static char s_unlink[] = "dyn:unlink";
+SCM l_dyn_unlink(fname)
+     SCM fname;
+{
+  int status;
+  ASSERT(NIMP(fname) && STRINGP(fname), fname, ARG1, s_unlink);
+  DEFER_INTS;
+  status = dld_unlink_by_file(CHARS(fname), 1);
+  ALLOW_INTS;
+  if (!status) return BOOL_T;
+  dld_perror("DLD");
+  return BOOL_F;
+}
+static iproc subr1s[] = {
+	{s_link, l_dyn_link},
+	{s_unlink, l_dyn_unlink},
+	{0, 0}};
+void init_dynl()
+{
+# ifndef RTL
+  if (!execpath) execpath = dld_find_executable(CHARS(CAR(progargs)));
+  if (dld_init(execpath)) {
+    dld_perror("DLD:");
+/*    wta(CAR(progargs), "couldn't init", "dld"); */
+    return;
+  }
+# endif
+  init_iprocs(subr1s, tc7_subr_1);
+  make_subr(s_call, tc7_subr_2, l_dyn_call);
+  make_subr(s_main_call, tc7_lsubr_2, l_dyn_main_call);
+  add_feature("dld");
+# ifdef DLD_DYNCM
+  add_feature("dld:dyncm");
+# endif
+}
+#else
+
+# ifdef hpux
+#  include "dl.h"
+
+#  define SHL(obj) ((shl_t*)CDR(obj))
+int prinshl(exp, port, writing)
+     SCM exp; SCM port; int writing;
+{
+  lputs("#<shl ", port);
+  intprint(CDR(exp), 16, port);
+  lputc('>', port);
+  return 1;
+}
+int tc16_shl;
+static smobfuns shlsmob = {mark0, free0, prinshl};
+
+static char s_link[] = "dyn:link", s_call[] = "dyn:call";
+SCM l_dyn_link(fname)
+     SCM fname;
+{
+  SCM z;
+  shl_t shl;
+  ASSERT(NIMP(fname) && STRINGP(fname), fname, ARG1, s_link);
+  DEFER_INTS;
+  shl = shl_load(CHARS(fname), BIND_DEFERRED , 0L);
+  if (NULL==shl) {
+    ALLOW_INTS;
+    return BOOL_F;
+  }
+  NEWCELL(z);
+  SETCHARS(z, shl);
+  CAR(z) = tc16_shl;
+  ALLOW_INTS;
+/*  linkpath = fname; */
+  return z;
+}
+SCM l_dyn_call(symb, shl)
+     SCM symb, shl;
+{
+  void (*func)() = 0;
+  int i;
+/*  SCM oloadpath = *loc_loadpath; */
+  ASSERT(NIMP(symb) && STRINGP(symb), symb, ARG1, s_call);
+  ASSERT(NIMP(shl) && CAR(shl)==tc16_shl, shl, ARG2, s_call);
+  DEFER_INTS;
+  if ((i = shl_findsym(&SHL(shl),
+		       CHARS(symb),
+		       TYPE_PROCEDURE, &func)) != 0) {
+    puts("    undef:"); puts(CHARS(symb));
+  }
+  ALLOW_INTS;
+  if (i != 0) return BOOL_F;
+/*  *loc_loadpath = linkpath; */
+  (*func) ();
+/*  *loc_loadpath = oloadpath; */
+  return BOOL_T;
+}
+
+static char s_main_call[] = "dyn:main-call";
+SCM l_dyn_main_call(symb, shl, args)
+     SCM symb, shl, args;
+{
+  int i;
+  int (*func)P((int argc, char **argv)) = 0; 
+  char **argv;
+/*  SCM oloadpath = *loc_loadpath; */
+  ASSERT(NIMP(symb) && STRINGP(symb), symb, ARG1, s_main_call);
+  ASSERT(NIMP(shl) && CAR(shl)==tc16_shl, shl, ARG2, s_main_call);
+  DEFER_INTS;
+  if ((i = shl_findsym(&SHL(shl),
+		       CHARS(symb),
+		       TYPE_PROCEDURE, &func)) != 0) {
+    puts("    undef:"); puts(CHARS(symb));
+  }
+  argv = makargvfrmstrs(args, s_main_call);
+  ALLOW_INTS;
+  if (i != 0) return BOOL_F;
+/*  *loc_loadpath = linkpath; */
+  i = (*func) ((int)ilength(args), argv);
+/*  *loc_loadpath = oloadpath; */
+  DEFER_INTS;
+  must_free_argv(argv);
+  ALLOW_INTS;
+  return MAKINUM(0L+i);
+}
+
+static char s_unlink[] = "dyn:unlink";
+SCM l_dyn_unlink(shl)
+     SCM shl;
+{
+  int status;
+  ASSERT(NIMP(shl) && CAR(shl)==tc16_shl, shl, ARG1, s_unlink);
+  DEFER_INTS;
+  status = shl_unload(SHL(shl));
+  ALLOW_INTS;
+  if (!status) return BOOL_T;
+  return BOOL_F;
+}
+static iproc subr1s[] = {
+	{s_link, l_dyn_link},
+	{s_unlink, l_dyn_unlink},
+	{0, 0}};
+void init_dynl()
+{
+  tc16_shl = newsmob(&shlsmob);
+  init_iprocs(subr1s, tc7_subr_1);
+  make_subr(s_call, tc7_subr_2, l_dyn_call);
+  make_subr(s_main_call, tc7_lsubr_2, l_dyn_main_call);
+  add_feature("shl");
+}
+# endif
+#endif
+
+#ifdef vms
+/* This permits dynamic linking. For example, the procedure of 0 arguments
+   from a file could be the initialization procedure.
+   (vms:dynamic-link-call "MYDISK:[MYDIR].EXE" "foo" "INIT_FOO")
+   The first argument specifies the directory where the file specified
+   by the second argument resides.  The current directory would be
+   "SYS$DISK:[].EXE".
+   The second argument cannot contain any punctuation.
+   The third argument probably needs to be uppercased to mimic the VMS linker.
+   */
+
+# include <descrip.h>
+# include <ssdef.h>
+# include <rmsdef.h>
+
+struct dsc$descriptor *descriptorize(x, buff)
+     struct dsc$descriptor *x;
+     SCM buff;
+{(*x).dsc$w_length = LENGTH(buff);
+ (*x).dsc$a_pointer = CHARS(buff);
+ (*x).dsc$b_class = DSC$K_CLASS_S;
+ (*x).dsc$b_dtype = DSC$K_DTYPE_T;
+ return(x);}
+
+static char s_dynl[] = "vms:dynamic-link-call";
+SCM dynl(dir, symbol, fname)
+     SCM dir, symbol, fname;
+{
+  struct dsc$descriptor fnamed, symbold, dird;
+  void (*fcn)();
+  long retval;
+  ASSERT(IMP(dir) || STRINGP(dir), dir, ARG1, s_dynl);
+  ASSERT(NIMP(fname) && STRINGP(fname), fname, ARG2, s_dynl);
+  ASSERT(NIMP(symbol) && STRINGP(symbol), symbol, ARG3, s_dynl);
+  descriptorize(&fnamed, fname);
+  descriptorize(&symbold, symbol);
+  DEFER_INTS;
+  retval = lib$find_image_symbol(&fnamed, &symbold, &fcn,
+				 IMP(dir) ? 0 : descriptorize(&dird, dir));
+  if (SS$_NORMAL != retval) {
+    /* wta(MAKINUM(retval), "vms error", s_dynl); */
+    ALLOW_INTS;
+    return BOOL_F;
+  }
+  ALLOW_INTS;
+/*  *loc_loadpath = dir; */
+  (*fcn)();
+/*  *loc_loadpath = oloadpath; */
+  return BOOL_T;
+}
+
+void init_dynl()
+{
+  make_subr(s_dynl, tc7_subr_3, dynl);
+}
+#endif
+
+
+#ifdef SUN_DL
+# include <dlfcn.h>
+
+# define SHL(obj) ((void*)CDR(obj))
+
+# ifdef SVR4		/* Solaris 2. */
+#  define DLOPEN_MODE	RTLD_LAZY
+# else
+#  define DLOPEN_MODE	1	/* Thats what it says in the man page. */
+# endif
+
+sizet frshl(ptr)
+	CELLPTR ptr;
+{
+# if 0
+  /* Should freeing a shl close and possibly unmap the object file it */
+  /* refers to? */
+  if(SHL(ptr))
+    dlclose(SHL(ptr));
+# endif
+  return 0;
+}
+
+int prinshl(exp, port, writing)
+	SCM exp; SCM port; int writing;
+{
+  lputs("#<shl ", port);
+  intprint(CDR(exp), 16, port);
+  lputc('>', port);
+  return 1;
+}
+int tc16_shl;
+static smobfuns shlsmob = {mark0, frshl, prinshl};
+
+static char s_link[] = "dyn:link", s_call[] = "dyn:call";
+SCM l_dyn_link(fname)
+	SCM fname;
+{
+  SCM z;
+  void *handle;
+  if FALSEP(fname) return fname;
+  ASSERT(NIMP(fname) && STRINGP(fname), fname, ARG1, s_link);
+  DEFER_INTS;
+  handle = dlopen(CHARS(fname), DLOPEN_MODE);
+  if (NULL==handle) {
+    ALLOW_INTS;
+    return BOOL_F;
+  }
+  NEWCELL(z);
+  SETCHARS(z, handle);
+  CAR(z) = tc16_shl;
+  ALLOW_INTS;
+/*  linkpath = fname; */
+  return z;
+}
+
+SCM l_dyn_call(symb, shl)
+	SCM symb, shl;
+{
+  void (*func)() = 0;
+/*  SCM oloadpath = *loc_loadpath; */
+  ASSERT(NIMP(symb) && STRINGP(symb), symb, ARG1, s_call);
+  ASSERT(NIMP(shl) && CAR(shl)==tc16_shl, shl, ARG2, s_call);
+  DEFER_INTS;
+  func = dlsym(SHL(shl), CHARS(symb));
+  if (!func) {
+    const char *dlr = dlerror();
+    ALLOW_INTS;
+    if (dlr) puts(dlr);
+    return BOOL_F;
+  }
+  ALLOW_INTS;
+/*  *loc_loadpath = linkpath; */
+  (*func) ();
+/*  *loc_loadpath = oloadpath; */
+  return BOOL_T;
+}
+static char s_unlink[] = "dyn:unlink";
+SCM l_dyn_unlink(shl)
+	SCM shl;
+{
+  int status;
+  ASSERT(NIMP(shl) && CAR(shl)==tc16_shl, shl, ARG1, s_unlink);
+  DEFER_INTS;
+  status = dlclose(SHL(shl));
+  SETCHARS(shl, NULL);
+  ALLOW_INTS;
+  if (!status) return BOOL_T;
+  return BOOL_F;
+}
+static iproc subr1s[] = {
+{s_link, l_dyn_link},
+{s_unlink, l_dyn_unlink},
+{0, 0}};
+
+void init_dynl()
+{
+  tc16_shl = newsmob(&shlsmob);
+  init_iprocs(subr1s, tc7_subr_1);
+  make_subr(s_call, tc7_subr_2, l_dyn_call);
+  add_feature("sun-dl");
+}
+#endif	/* SUN_DL */
diff --git a/ecrt0.c b/ecrt0.c
new file mode 100644
index 0000000..a9c7f28
--- /dev/null
+++ b/ecrt0.c
@@ -0,0 +1,614 @@
+/* C code startup routine.
+   Copyright (C) 1985, 1986, 1992 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, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+
+/* The standard Vax 4.2 Unix crt0.c cannot be used for Emacs
+   because it makes `environ' an initialized variable.
+   It is easiest to have a special crt0.c on all machines
+   though I don't know whether other machines actually need it.  */
+
+/* On the vax and 68000, in BSD4.2 and USG5.2,
+   this is the data format on startup:
+  (vax) ap and fp are unpredictable as far as I know; don't use them.
+  sp ->  word containing argc
+         word pointing to first arg string
+	 [word pointing to next arg string]... 0 or more times
+	 0
+Optionally:
+	 [word pointing to environment variable]... 1 or more times
+	 ...
+	 0
+And always:
+	 first arg string
+	 [next arg string]... 0 or more times
+*/
+
+/* On the 16000, at least in the one 4.2 system I know about,
+  the initial data format is
+  sp ->  word containing argc
+         word containing argp
+         word pointing to first arg string, and so on as above
+*/
+
+#ifdef emacs
+#include <config.h>
+#endif
+
+/*		********  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.
+    Similarly, note that the address of _start() should be the start
+    of text space.   Fred Fish, UniSoft Systems Inc.  */
+
+int data_start = 0;
+
+#ifdef NEED_ERRNO
+int errno;
+#endif
+
+#ifndef DONT_NEED_ENVIRON
+char **environ;
+#endif
+
+#ifndef static
+/* On systems where the static storage class is usable, this function
+   should be declared as static.  Otherwise, the static keyword has
+   been defined to be something else, and code for those systems must
+   take care of this declaration appropriately.  */
+static start1 ();
+#endif
+
+#ifdef APOLLO
+extern	char   *malloc(), *realloc(), *(*_libc_malloc) (), *(*_libc_realloc)();
+extern	void	free(),	(*_libc_free) (); extern int main();
+std_$call void  unix_$main();
+
+_start()
+{
+	_libc_malloc = malloc;
+	_libc_realloc = realloc;
+	_libc_free = free;
+	unix_$main(main);	/* no return */
+}
+#endif /* APOLLO */
+
+#if defined(orion) || defined(pyramid) || defined(celerity) || defined(ALLIANT) || defined(clipper) || defined(sps7)
+
+#if defined(sps7) && defined(V3x)
+        asm("	section	10");
+        asm("	ds.b	0xb0");
+#endif
+
+#ifdef ALLIANT
+/* _start must initialize _curbrk and _minbrk on the first startup;
+   when starting up after dumping, it must initialize them to what they were
+   before the dumping, since they are in the shared library and
+   are not dumped.  See ADJUST_EXEC_HEADER in m-alliant.h.  */
+extern unsigned char *_curbrk, *_minbrk;
+extern unsigned char end;
+unsigned char *_setbrk = &end;
+#ifdef ALLIANT_2800
+unsigned char *_end = &end;
+#endif
+#endif
+
+#ifndef DUMMIES
+#define DUMMIES
+#endif
+
+_start (DUMMIES argc, argv, envp)
+     int argc;
+     char **argv, **envp;
+{
+#ifdef ALLIANT
+#ifdef ALLIANT_2800
+  _curbrk = _end;
+  _minbrk = _end;
+#else
+  _curbrk = _setbrk;
+  _minbrk = _setbrk;
+#endif
+#endif
+
+  environ = envp;
+
+  exit (main (argc, argv, envp));
+}
+
+#endif /* orion or pyramid or celerity or alliant or clipper */
+
+#if defined (ns16000) && !defined (sequent) && !defined (UMAX) && !defined (CRT0_DUMMIES)
+
+_start ()
+{
+/* On 16000, _start pushes fp onto stack */
+  start1 ();
+}
+
+/* ignore takes care of skipping the fp value pushed in start.  */
+static
+start1 (ignore, argc, argv)
+     int ignore;
+     int argc;
+     register char **argv;
+{
+  environ = argv + argc + 1;
+
+  if (environ == *argv)
+    environ--;
+  exit (main (argc, argv, environ));
+}
+#endif /* ns16000, not sequent and not UMAX, and not the CRT0_DUMMIES method */
+
+#ifdef UMAX
+_start()
+{
+	asm("	exit []			# undo enter");
+	asm("	.set	exitsc,1");
+	asm("	.set	sigcatchall,0x400");
+
+	asm("	.globl	_exit");
+	asm("	.globl	start");
+	asm("	.globl	__start");
+	asm("	.globl	_main");
+	asm("	.globl	_environ");
+	asm("	.globl	_sigvec");
+	asm("	.globl	sigentry");
+
+	asm("start:");
+	asm("	br	.xstart");
+	asm("	.org	0x20");
+	asm("	.double	p_glbl,0,0xf00000,0");
+	asm("	.org	0x30");
+	asm(".xstart:");
+	asm("	adjspb	$8");
+	asm("	movd	8(sp),0(sp)	# argc");
+	asm("	addr	12(sp),r0");
+	asm("	movd	r0,4(sp)	# argv");
+	asm("L1:");
+	asm("	movd	r0,r1");
+	asm("	addqd	$4,r0");
+	asm("	cmpqd	$0,0(r1)	# null args term ?");
+	asm("	bne	L1");
+	asm("	cmpd	r0,0(4(sp))	# end of 'env' or 'argv' ?");
+	asm("	blt	L2");
+	asm("	addqd	$-4,r0		# envp's are in list");
+	asm("L2:");
+	asm("	movd	r0,8(sp)	# env");
+	asm("	movd	r0,@_environ	# indir is 0 if no env ; not 0 if env");
+	asm("	movqd	$0,tos		# setup intermediate signal handler");
+	asm("	addr	@sv,tos");
+	asm("	movzwd	$sigcatchall,tos");
+	asm("	jsr	@_sigvec");
+	asm("	adjspb	$-12");
+	asm("	jsr	@_main");
+	asm("	adjspb	$-12");
+	asm("	movd	r0,tos");
+	asm("	jsr	@_exit");
+	asm("	adjspb	$-4");
+	asm("	addr	@exitsc,r0");
+	asm("	svc");
+	asm("	.align	4		# sigvec arg");
+	asm("sv:");
+	asm("	.double	sigentry");
+	asm("	.double	0");
+	asm("	.double	0");
+
+	asm("	.comm	p_glbl,1");
+}
+#endif /* UMAX */
+
+#ifdef CRT0_DUMMIES
+
+/* Define symbol "start": here; some systems want that symbol.  */
+#ifdef DOT_GLOBAL_START
+asm("	.text		");
+asm("	.globl start	");
+asm("	start:		");
+#endif /* DOT_GLOBAL_START */
+
+#ifdef NODOT_GLOBAL_START
+asm("	text		");
+asm("	global start	");
+asm("	start:		");
+#endif /* NODOT_GLOBAL_START */
+
+#ifdef m68000
+
+/* GCC 2.1, when optimization is turned off, seems to want to push a
+   word of garbage on the stack, which screws up the CRT0_DUMMIES
+   hack.  So we hand-code _start in assembly language.  */
+asm(".text			");
+asm("	.even			");
+asm(".globl __start		");
+asm("__start:			");
+asm("	link a6,#0		");
+asm("	jbsr _start1		");
+asm("	unlk a6			");
+asm("	rts			");
+
+#else /* not m68000 */
+
+_start ()
+{
+/* On vax, nothing is pushed here  */
+/* On sequent, bogus fp is pushed here  */
+  start1 ();
+}
+
+#endif /* possibly m68000 */
+
+static
+start1 (CRT0_DUMMIES argc, xargv)
+     int argc;
+     char *xargv;
+{
+  register char **argv = &xargv;
+  environ = argv + argc + 1;
+
+  if ((char *)environ == xargv)
+    environ--;
+  exit (main (argc, argv, environ));
+
+  /* Refer to `start1' so GCC will not think it is never called
+     and optimize it out.  */
+  (void) &start1;
+}
+#else /* not CRT0_DUMMIES */
+
+/* "m68k" and "m68000" both stand for m68000 processors,
+   but with different program-entry conventions.
+   This is a kludge.  Now that the CRT0_DUMMIES mechanism above exists,
+   most of these machines could use the vax code above
+   with some suitable definition of CRT0_DUMMIES.
+   Then the symbol m68k could be flushed.
+   But I don't want to risk breaking these machines
+   in a version 17 patch release, so that change is being put off.  */
+
+#ifdef m68k			/* Can't do it all from C */
+	asm ("	global	_start");
+	asm ("	text");
+	asm ("_start:");
+#ifndef NU
+#ifdef STRIDE
+	asm ("	comm	havefpu%,2");
+#else /* m68k, not STRIDE */
+	asm ("  comm	splimit%,4");
+#endif /* STRIDE */
+	asm ("	global	exit");
+	asm ("	text");
+#ifdef STRIDE
+	asm ("	trap	&3");
+	asm ("	mov.w	%d0,havefpu%");
+#else /* m68k, not STRIDE */
+  	asm ("	mov.l	%d0,splimit%");
+#endif /* STRIDE */
+#endif /* not NU */
+	asm ("	jsr	start1");
+	asm ("	mov.l	%d0,(%sp)");
+	asm ("	jsr	exit");
+	asm ("	mov.l	&1,%d0");	/* d0 = 1 => exit */
+	asm ("	trap	&0");
+#else /* m68000, not m68k */
+
+#ifdef m68000
+
+#ifdef ISI68K
+/* Added by ESM Sun May 24 12:44:02 1987 to get new ISI library to work */
+/* Edited by Ray Mon May 15 15:59:56 EST 1989 so we can compile with gcc */
+#if defined(BSD4_3) && !defined(__GNUC__)
+static foo () {
+#endif
+	asm ("	.globl  is68020");
+	asm ("is68020:");
+#ifndef BSD4_3
+	asm ("	.long   0x00000000");
+	asm ("	.long   0xffffffff");
+/* End of stuff added by ESM */
+#endif
+	asm ("	.text");
+	asm ("	.globl	__start");
+	asm ("__start:");
+	asm ("	.word 0");
+	asm ("	link	a6,#0");
+	asm ("	jbsr	_start1");
+	asm ("	unlk	a6");
+	asm ("	rts");
+#if defined(BSD4_3) && !defined(__GNUC__)
+      }
+#endif
+#else /* not ISI68K */
+
+_start ()
+{
+#ifdef sun
+#ifdef LISP_FLOAT_TYPE
+  finitfp_();
+#endif
+#endif     
+/* On 68000, _start pushes a6 onto stack  */
+  start1 ();
+}
+#endif /* not ISI68k */
+#endif /* m68000 */
+#endif /* m68k */
+
+#if defined(m68k) || defined(m68000)
+/* ignore takes care of skipping the a6 value pushed in start.  */
+static
+#if defined(m68k)
+start1 (argc, xargv)
+#else
+start1 (ignore, argc, xargv)
+#endif
+     int argc;
+     char *xargv;
+{
+  register char **argv = &xargv;
+  environ = argv + argc + 1;
+
+  if ((char *)environ == xargv)
+    environ--;
+#ifdef sun_68881
+  asm("    jsr     f68881_used");
+#endif
+#ifdef sun_fpa
+  asm("    jsr     ffpa_used");
+#endif
+#ifdef sun_soft
+  asm("    jsr     start_float");
+#endif
+  exit (main (argc, argv, environ));
+}
+
+#endif /* m68k or m68000 */
+
+#endif /* not CRT0_DUMMIES */
+
+#ifdef hp9000s300
+int argc_value;
+char **argv_value;
+#ifdef OLD_HP_ASSEMBLER
+	asm("   text");
+	asm("	globl __start");
+	asm("	globl _exit");
+	asm("	globl _main");
+	asm("__start");
+	asm("	dc.l	0");
+	asm("	subq.w	#0x1,d0");
+	asm("	move.w	d0,float_soft");
+	asm("	move.l	0x4(a7),d0");
+	asm("	beq.s	skip_1");
+	asm("	move.l	d0,a0");
+	asm("	clr.l	-0x4(a0)");
+	asm("skip_1");
+	asm("	move.l	a7,a0");
+	asm("	subq.l	#0x8,a7");
+	asm("	move.l	(a0),(a7)");
+	asm("	move.l	(a0),_argc_value");
+	asm("	addq.l	#0x4,a0");
+	asm("	move.l	a0,0x4(a7)");
+	asm("	move.l	a0,_argv_value");
+	asm("incr_loop");
+	asm("	tst.l	(a0)+");
+	asm("	bne.s	incr_loop");
+	asm("	move.l	0x4(a7),a1");
+	asm("	cmp.l	(a1),a0");
+	asm("	blt.s	skip_2");
+	asm("	subq.l	#0x4,a0");
+	asm("skip_2");
+	asm("	move.l	a0,0x8(a7)");
+	asm("	move.l	a0,_environ");
+	asm("	jsr	_main");
+	asm("	addq.l	#0x8,a7");
+	asm("	move.l	d0,-(a7)");
+	asm("	jsr	_exit");
+	asm("	move.w	#0x1,d0");
+	asm("	trap	#0x0");
+	asm("	comm	float_soft,4");
+/* float_soft is allocated in this way because C would
+   put an underscore character in its name otherwise. */
+
+#else /* new hp assembler */
+
+	asm("	text");
+        asm("   global  float_loc");
+        asm("   set     float_loc,0xFFFFB000");
+ 	asm("	global	fpa_loc");
+	asm("	set	fpa_loc,0xfff08000");
+	asm("	global	__start");
+	asm("	global	_exit");
+	asm("	global	_main");
+	asm("__start:");
+	asm("	byte	0,0,0,0");
+	asm("	subq.w	&1,%d0");
+	asm("	mov.w	%d0,float_soft");
+	asm("	mov.w	%d1,flag_68881");
+#ifndef HPUX_68010
+	asm("	beq.b	skip_float");
+	asm("	fmov.l	&0x7400,%fpcr");
+/*	asm("	fmov.l	&0x7480,%fpcr"); */
+#endif /* HPUX_68010 */
+	asm("skip_float:");
+	asm("	mov.l	%a0,%d0");
+	asm("	add.l	%d0,%d0");
+	asm("	subx.w	%d1,%d1");
+	asm("	mov.w	%d1,flag_68010");
+	asm("	add.l	%d0,%d0");
+	asm("	subx.w	%d1,%d1");
+	asm("	mov.w	%d1,flag_fpa");
+	asm("	tst.l	%d2");
+	asm("	ble.b	skip_3");
+	asm("	lsl	flag_68881");
+	asm("	lsl	flag_fpa");
+	asm("skip_3:");
+	asm("	mov.l	4(%a7),%d0");
+	asm("	beq.b	skip_1");
+	asm("	mov.l	%d0,%a0");
+	asm("	clr.l	-4(%a0)");
+	asm("skip_1:");
+	asm("	mov.l	%a7,%a0");
+	asm("	subq.l	&8,%a7");
+	asm("	mov.l	(%a0),(%a7)");
+	asm("	mov.l	(%a0),_argc_value");
+	asm("	addq.l	&4,%a0");
+	asm("	mov.l	%a0,4(%a7)");
+	asm("	mov.l	%a0,_argv_value");
+	asm("incr_loop:");
+	asm("	tst.l	(%a0)+");
+	asm("	bne.b	incr_loop");
+	asm("	mov.l	4(%a7),%a1");
+	asm("	cmp.l	%a0,(%a1)");
+	asm("	blt.b	skip_2");
+	asm("	subq.l	&4,%a0");
+	asm("skip_2:");
+	asm("	mov.l	%a0,8(%a7)");
+	asm("	mov.l	%a0,_environ");
+	asm("	jsr	_main");
+	asm("	addq.l	&8,%a7");
+	asm("	mov.l	%d0,-(%a7)");
+	asm("	jsr	_exit");
+	asm("	mov.w	&1,%d0");
+	asm("	trap	&0");
+	asm("	comm	float_soft, 4");
+	asm("	comm	flag_68881, 4");
+	asm("	comm	flag_68010, 4");
+	asm("	comm	flag_68040, 4");
+	asm("	comm	flag_fpa, 4");
+
+#endif /* new hp assembler */
+#endif /* hp9000s300 */
+
+#ifdef GOULD
+
+/* startup code has to be in near text rather
+   than fartext as allocated by the C compiler. */
+	asm("	.text");
+	asm("	.align	2");
+	asm("	.globl	__start");
+	asm("	.text");
+	asm("__start:");
+/* setup base register b1 (function base). */
+	asm("	.using	b1,.");
+	asm("	tpcbr	b1");
+/* setup base registers b3 through b7 (data references). */
+	asm("	file	basevals,b3");
+/* setup base register b2 (stack pointer); it should be
+   aligned on a 8-word boundary; but because it is pointing
+   to argc, its value should be remembered (in r5). */
+	asm("	movw	b2,r4");
+	asm("	movw	b2,r5");
+	asm("	andw	#~0x1f,r4");
+	asm("	movw	r4,b2");
+/* allocate stack frame to do some work. */
+	asm("	subea	16w,b2");
+/* initialize signal catching for UTX/32 1.2; this is
+   necessary to make restart from saved image work. */
+	asm("	movea	sigcatch,r1");
+	asm("	movw	r1,8w[b2]");
+	asm("	svc	#1,#150");
+/* setup address of argc for start1. */
+	asm("	movw	r5,8w[b2]");
+	asm("   func	#1,_start1");
+	asm("	halt");
+/* space for ld to store base register initial values. */
+	asm("	.align	5");
+	asm("basevals:");
+	asm("	.word	__base3,__base4,__base5,__base6,__base7");
+
+static
+start1 (xargc)
+     int *xargc;
+{
+  register int	argc;
+  register char **argv;
+
+  argc = *xargc;
+  argv = (char **)(xargc) + 1;
+  environ = argv + argc + 1;
+
+  if (environ == argv)
+    environ--;
+  exit (main (argc, argv, environ));
+
+}
+
+#endif /* GOULD */
+
+#ifdef elxsi
+#include <elxsi/argvcache.h>
+
+extern char **environ;
+extern int	errno;
+extern void	_init_doscan(), _init_iob();
+extern char	end[];
+char		*_init_brk = end;
+
+_start()
+{
+  environ = exec_cache.ac_envp;
+  brk (_init_brk);
+  errno = 0;
+  _init_doscan ();
+  _init_iob ();
+  _exit (exit (main (exec_cache.ac_argc,
+		     exec_cache.ac_argv,
+		     exec_cache.ac_envp)));
+}
+#endif /* elxsi */
+
+
+#ifdef sparc
+asm (".global __start");
+asm (".text");
+asm ("__start:");
+asm ("	mov	0, %fp");
+asm ("	ld	[%sp + 64], %o0");
+asm ("	add	%sp, 68, %o1");
+asm ("	sll	%o0, 2,	%o2");
+asm ("	add	%o2, 4,	%o2");
+asm ("	add	%o1, %o2, %o2");
+asm ("	sethi	%hi(_environ), %o3");
+asm ("	st	%o2, [%o3+%lo(_environ)]");
+asm ("	andn	%sp, 7,	%sp");
+asm ("	call	_main");
+asm ("	sub	%sp, 24, %sp");
+asm ("	call	__exit");
+asm ("	nop");
+
+#endif /* sparc */
+
+#if __FreeBSD__ == 2
+char *__progname;
+#endif
+#ifdef __bsdi__
+#include <sys/param.h> /* for version number */
+#if defined(_BSDI_VERSION) && (_BSDI_VERSION >= 199501)
+char *__progname;
+#endif
+#endif /* __bsdi__ */
diff --git a/edline.c b/edline.c
new file mode 100644
index 0000000..ab15578
--- /dev/null
+++ b/edline.c
@@ -0,0 +1,94 @@
+/* Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.
+ */
+
+/* "readline.c" Scheme interface to readline library
+   Author: Radey Shouman */
+
+#include "scm.h"
+
+char *readline   P((const char *prompt));
+void add_history P((char *p));
+
+             /* Reads on stdin/stdout only */
+static char s_readline[] = "read-edited-line";
+SCM lreadline(prompt)
+     SCM prompt;
+{
+  SCM res;
+  char *s;
+  ASSERT(NIMP(prompt) && STRINGP(prompt), prompt, ARG1, s_readline);
+  s = readline(CHARS(prompt));
+  if (NULL == s) return EOF_VAL;
+  NEWCELL(res);
+  DEFER_INTS;
+  SETCHARS(res,s);
+  SETLENGTH(res,(sizet)strlen(s),tc7_string);
+  ALLOW_INTS;
+  return res;
+}
+static char s_add_history[] = "add-history";
+SCM ladd_history(line)
+     SCM line;
+{
+  ASSERT(NIMP(line) && STRINGP(line), line, ARG1, s_add_history);
+  add_history(CHARS(line));
+  return UNSPECIFIED;
+}
+static char s_def_inport[] = "default-input-port";
+SCM def_inport()
+{
+  return def_inp;
+}
+static char s_def_outport[] = "default-output-port";
+SCM def_outport()
+{
+  return def_outp;
+}
+static char s_Iedline[] = "Iedline.scm";
+void init_edline()
+{
+  make_subr(s_def_inport, tc7_subr_0, def_inport);
+  make_subr(s_def_outport, tc7_subr_0, def_outport);
+  make_subr(s_readline, tc7_subr_1, lreadline);
+  make_subr(s_add_history, tc7_subr_1, ladd_history);
+  if (scm_ldprog(s_Iedline))
+    wta(*loc_errobj, "couldn't init", s_Iedline);
+}
diff --git a/eval.c b/eval.c
new file mode 100644
index 0000000..2cf04fe
--- /dev/null
+++ b/eval.c
@@ -0,0 +1,1494 @@
+/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  
+ */
+
+/* "eval.c" eval and apply.
+   Authors: Aubrey Jaffer & Hugh E. Secker-Walker. */
+
+#include "scm.h"
+#include "setjump.h"
+
+#define I_SYM(x) (CAR((x)-1L))
+#define I_VAL(x) (CDR((x)-1L))
+#define EVALCELLCAR(x, env) SYMBOLP(CAR(x))?*lookupcar(x, env):ceval(CAR(x), env)
+#ifdef MEMOIZE_LOCALS
+# define EVALIMP(x, env) (ILOCP(x)?*ilookup((x), env):x)
+#else
+# define EVALIMP(x, env) x
+#endif
+#define EVALCAR(x, env) (NCELLP(CAR(x))?(IMP(CAR(x))?EVALIMP(CAR(x), env):\
+					I_VAL(CAR(x))):EVALCELLCAR(x, env))
+#define EXTEND_ENV acons
+
+#ifdef MEMOIZE_LOCALS
+SCM *ilookup(iloc, env)
+     SCM iloc, env;
+{
+  register int ir = IFRAME(iloc);
+  register SCM er = env;
+  for(;0 != ir;--ir) er = CDR(er);
+  er = CAR(er);
+  for(ir = IDIST(iloc);0 != ir;--ir) er = CDR(er);
+  if ICDRP(iloc) return &CDR(er);
+  return &CAR(CDR(er));
+}
+#endif
+SCM *lookupcar(vloc, genv)
+     SCM vloc, genv;
+{
+  SCM env = genv;
+  register SCM *al, fl, var = CAR(vloc);
+#ifdef MEMOIZE_LOCALS
+  register SCM iloc = ILOC00;
+#endif
+  for(;NIMP(env);env = CDR(env)) {
+    al = &CAR(env);
+    for(fl = CAR(*al);NIMP(fl);fl = CDR(fl)) {
+      if NCONSP(fl)
+	if (fl==var) {
+#ifdef MEMOIZE_LOCALS
+	  CAR(vloc) = iloc + ICDR;
+#endif
+	  return &CDR(*al);
+	}
+	else break;
+      al = &CDR(*al);
+      if (CAR(fl)==var) {
+#ifdef MEMOIZE_LOCALS
+# ifndef RECKLESS		/* letrec inits to UNDEFINED */
+	if UNBNDP(CAR(*al)) {env = EOL; goto errout;}
+# endif
+	CAR(vloc) = iloc;
+#endif
+	return &CAR(*al);
+      }
+#ifdef MEMOIZE_LOCALS
+      iloc += IDINC;
+#endif
+    }
+#ifdef MEMOIZE_LOCALS
+    iloc = (~IDSTMSK) & (iloc + IFRINC);
+#endif
+  }
+  var = sym2vcell(var);
+#ifndef RECKLESS
+  if (NNULLP(env) || UNBNDP(CDR(var))) {
+    var = CAR(var);
+  errout:
+    everr(vloc, genv, var,
+	  NULLP(env)?"unbound variable: ":"damaged environment", "");
+  }
+#endif
+  CAR(vloc) = var + 1;
+  return &CDR(var);
+}
+static SCM unmemocar(form, env)
+     SCM form, env;
+{
+  register int ir;
+  if IMP(form) return form;
+  if (1==TYP3(form))
+    CAR(form) = I_SYM(CAR(form));
+#ifdef MEMOIZE_LOCALS
+  else if ILOCP(CAR(form)) {
+    for(ir = IFRAME(CAR(form)); ir != 0; --ir) env = CDR(env);
+    env = CAR(CAR(env));
+    for(ir = IDIST(CAR(form));ir != 0;--ir) env = CDR(env);
+    CAR(form) = ICDRP(CAR(form)) ? env : CAR(env);
+  }
+#endif
+  return form;
+}
+
+SCM eval_args(l, env)
+     SCM l, env;
+{
+	SCM res = EOL, *lloc = &res;
+	while NIMP(l) {
+		*lloc = cons(EVALCAR(l, env), EOL);
+		lloc = &CDR(*lloc);
+		l = CDR(l);
+	}
+	return res;
+}
+
+    /* the following rewrite expressions and
+     * some memoized forms have different syntax */
+
+static char s_expression[] = "missing or extra expression";
+static char s_test[] = "bad test";
+static char s_body[] = "bad body";
+static char s_bindings[] = "bad bindings";
+static char s_variable[] = "bad variable";
+static char s_clauses[] = "bad or missing clauses";
+static char s_formals[] = "bad formals";
+#define ASSYNT(_cond, _arg, _pos, _subr) if(!(_cond))wta(_arg, (char *)_pos, _subr);
+
+SCM i_dot, i_quote, i_quasiquote, i_lambda,
+  i_let, i_arrow, i_else, i_unquote, i_uq_splicing, i_apply;
+static char s_quasiquote[] = "quasiquote";
+static char s_delay[] = "delay";
+
+#define ASRTSYNTAX(cond_, msg_) if(!(cond_))wta(xorig, (msg_), what);
+
+static void bodycheck(xorig, bodyloc, what)
+     SCM xorig, *bodyloc;
+     char *what;
+{
+  ASRTSYNTAX(ilength(*bodyloc) >= 1, s_expression);
+}
+
+SCM m_quote(xorig, env)
+     SCM xorig, env;
+{
+  ASSYNT(ilength(CDR(xorig))==1, xorig, s_expression, s_quote);
+  return cons(IM_QUOTE, CDR(xorig));
+}
+
+SCM m_begin(xorig, env)
+     SCM xorig, env;
+{
+  ASSYNT(ilength(CDR(xorig)) >= 1, xorig, s_expression, s_begin);
+  return cons(IM_BEGIN, CDR(xorig));
+}
+
+SCM m_if(xorig, env)
+     SCM xorig, env;
+{
+  int len = ilength(CDR(xorig));
+  ASSYNT(len >= 2 && len <= 3, xorig, s_expression, s_if);
+  return cons(IM_IF, CDR(xorig));
+}
+
+SCM m_set(xorig, env)
+     SCM xorig, env;
+{
+  SCM x = CDR(xorig);
+  ASSYNT(2==ilength(x), xorig, s_expression, s_set);
+  ASSYNT(NIMP(CAR(x)) && SYMBOLP(CAR(x)),
+	 xorig, s_variable, s_set);
+  return cons(IM_SET, x);
+}
+
+SCM m_and(xorig, env)
+     SCM xorig, env;
+{
+  int len = ilength(CDR(xorig));
+  ASSYNT(len >= 0, xorig, s_test, s_and);
+  if (len >= 1) return cons(IM_AND, CDR(xorig));
+  else return BOOL_T;
+}
+
+SCM m_or(xorig, env)
+     SCM xorig, env;
+{
+  int len = ilength(CDR(xorig));
+  ASSYNT(len >= 0, xorig, s_test, s_or);
+  if (len >= 1) return cons(IM_OR, CDR(xorig));
+  else return BOOL_F;
+}
+
+SCM m_case(xorig, env)
+     SCM xorig, env;
+{
+  SCM proc, x = CDR(xorig);
+  ASSYNT(ilength(x) >= 2, xorig, s_clauses, s_case);
+  while(NIMP(x = CDR(x))) {
+    proc = CAR(x);
+    ASSYNT(ilength(proc) >= 2, xorig, s_clauses, s_case);
+    ASSYNT(ilength(CAR(proc)) >= 0 || i_else==CAR(proc),
+	   xorig, s_clauses, s_case);
+  }
+  return cons(IM_CASE, CDR(xorig));
+}
+
+SCM m_cond(xorig, env)
+     SCM xorig, env;
+{
+  SCM arg1, x = CDR(xorig);
+  int len = ilength(x);
+  ASSYNT(len >= 1, xorig, s_clauses, s_cond);
+  while(NIMP(x)) {
+    arg1 = CAR(x);
+    len = ilength(arg1);
+    ASSYNT(len >= 1, xorig, s_clauses, s_cond);
+    if (i_else==CAR(arg1)) {
+      ASSYNT(NULLP(CDR(x)) && len >= 2, xorig, "bad ELSE clause", s_cond);
+      CAR(arg1) = BOOL_T;
+    }
+    if (len >= 2 && i_arrow==CAR(CDR(arg1)))
+      ASSYNT(3==len && NIMP(CAR(CDR(CDR(arg1)))),
+	     xorig, "bad recipient", s_cond);
+    x = CDR(x);
+  }
+  return cons(IM_COND, CDR(xorig));
+}
+
+SCM m_lambda(xorig, env)
+     SCM xorig, env;
+{
+  SCM proc, x = CDR(xorig);
+  if (ilength(x) < 2) goto badforms;
+  proc = CAR(x);
+  if NULLP(proc) goto memlambda;
+  if IMP(proc) goto badforms;
+  if SYMBOLP(proc) goto memlambda;
+  if NCONSP(proc) goto badforms;
+  while NIMP(proc) {
+    if NCONSP(proc)
+      if (!SYMBOLP(proc)) goto badforms;
+      else goto memlambda;
+    if (!(NIMP(CAR(proc)) && SYMBOLP(CAR(proc)))) goto badforms;
+    proc = CDR(proc);
+  }
+  if NNULLP(proc)
+  badforms: wta(xorig, s_formals, s_lambda);
+ memlambda:
+  bodycheck(xorig, &CDR(x), s_lambda);
+  return cons(IM_LAMBDA, CDR(xorig));
+}
+SCM m_letstar(xorig, env)
+     SCM xorig, env;
+{
+  SCM x = CDR(xorig), arg1, proc, vars = EOL, *varloc = &vars;
+  int len = ilength(x);
+  ASSYNT(len >= 2, xorig, s_body, s_letstar);
+  proc = CAR(x);
+  ASSYNT(ilength(proc) >= 0, xorig, s_bindings, s_letstar);
+  while NIMP(proc) {
+    arg1 = CAR(proc);
+    ASSYNT(2==ilength(arg1), xorig, s_bindings, s_letstar);
+    ASSYNT(NIMP(CAR(arg1)) && SYMBOLP(CAR(arg1)), xorig, s_variable, s_letstar);
+    *varloc = cons2(CAR(arg1), CAR(CDR(arg1)), EOL);
+    varloc = &CDR(CDR(*varloc));
+    proc = CDR(proc);
+  }
+  x = cons(vars, CDR(x));
+  bodycheck(xorig, &CDR(x), s_letstar);
+  return cons(IM_LETSTAR, x);
+}
+
+/* DO gets the most radically altered syntax
+   (do ((<var1> <init1> <step1>)
+   (<var2> <init2>)
+   ... )
+   (<test> <return>)
+   <body>)
+   ;; becomes
+   (do_mem (varn ... var2 var1)
+   (<init1> <init2> ... <initn>)
+   (<test> <return>)
+   (<body>)
+   <step1> <step2> ... <stepn>) ;; missing steps replaced by var
+   */
+SCM m_do(xorig, env)
+     SCM xorig, env;
+{
+  SCM x = CDR(xorig), arg1, proc;
+  SCM vars = EOL, inits = EOL, steps = EOL;
+  SCM *initloc = &inits, *steploc = &steps;
+  int len = ilength(x);
+  ASSYNT(len >= 2, xorig, s_test, s_do);
+  proc = CAR(x);
+  ASSYNT(ilength(proc) >= 0, xorig, s_bindings, s_do);
+  while NIMP(proc) {
+    arg1 = CAR(proc);
+    len = ilength(arg1);
+    ASSYNT(2==len || 3==len, xorig, s_bindings, s_do);
+    ASSYNT(NIMP(CAR(arg1)) && SYMBOLP(CAR(arg1)), xorig, s_variable, s_do);
+    /* vars reversed here, inits and steps reversed at evaluation */
+    vars = cons(CAR(arg1), vars); /* variable */
+    arg1 = CDR(arg1);
+    *initloc = cons(CAR(arg1), EOL); /* init */
+    initloc = &CDR(*initloc);
+    arg1 = CDR(arg1);
+    *steploc = cons(IMP(arg1)?CAR(vars):CAR(arg1), EOL); /* step */
+    steploc = &CDR(*steploc);
+    proc = CDR(proc);
+  }
+  x = CDR(x);
+  ASSYNT(ilength(CAR(x)) >= 1, xorig, s_test, s_do);
+  x = cons2(CAR(x), CDR(x), steps);
+  x = cons2(vars, inits, x);
+  bodycheck(xorig, &CAR(CDR(CDR(x))), s_do);
+  return cons(IM_DO, x);
+}
+
+/* evalcar is small version of inline EVALCAR when we don't care about speed */
+static SCM evalcar(x, env)
+     SCM x, env;
+{
+  return EVALCAR(x, env);
+}
+
+static SCM iqq(form, env, depth)
+     SCM form, env;
+     int depth;
+{
+  SCM tmp;
+  int edepth = depth;
+  if IMP(form) return form;
+  if VECTORP(form) {
+    long i = LENGTH(form);
+    SCM *data = VELTS(form);
+    tmp = EOL;
+    for(;--i >= 0;) tmp = cons(data[i], tmp);
+    return vector(iqq(tmp, env, depth));
+  }
+  if NCONSP(form) return form;
+  tmp = CAR(form);
+  if (i_quasiquote==tmp) {
+    depth++;
+    goto label;
+  }
+  if (i_unquote==tmp) {
+    --depth;
+  label:
+    form = CDR(form);
+    ASSERT(NIMP(form) && ECONSP(form) && NULLP(CDR(form)),
+	   form, ARG1, s_quasiquote);
+    if (0==depth) return evalcar(form, env);
+    return cons2(tmp, iqq(CAR(form), env, depth), EOL);
+  }
+  if (NIMP(tmp) && (i_uq_splicing==CAR(tmp))) {
+    tmp = CDR(tmp);
+    if (0==--edepth)
+      return append(cons2(evalcar(tmp, env), iqq(CDR(form), env, depth), EOL));
+  }
+  return cons(iqq(CAR(form), env, edepth), iqq(CDR(form), env, depth));
+}
+
+/* Here are acros which return values rather than code. */
+
+SCM m_quasiquote(xorig, env)
+     SCM xorig, env;
+{
+  SCM x = CDR(xorig);
+  ASSYNT(ilength(x)==1, xorig, s_expression, s_quasiquote);
+  return iqq(CAR(x), env, 1);
+}
+
+SCM m_delay(xorig, env)
+     SCM xorig, env;
+{
+  ASSYNT(ilength(xorig)==2, xorig, s_expression, s_delay);
+  xorig = CDR(xorig);
+  return makprom(closure(cons2(EOL, CAR(xorig), CDR(xorig)), env));
+}
+
+extern int verbose;
+SCM m_define(x, env)
+     SCM x, env;
+{
+  SCM proc, arg1 = x; x = CDR(x);
+  /*  ASSYNT(NULLP(env), x, "bad placement", s_define);*/
+  ASSYNT(ilength(x) >= 2, arg1, s_expression, s_define);
+  proc = CAR(x); x = CDR(x);
+  while (NIMP(proc) && CONSP(proc)) { /* nested define syntax */
+    x = cons(cons2(i_lambda, CDR(proc), x), EOL);
+    proc = CAR(proc);
+  }
+  ASSYNT(NIMP(proc) && SYMBOLP(proc), arg1, s_variable, s_define);
+  ASSYNT(1==ilength(x), arg1, s_expression, s_define);
+  if NULLP(env) {
+    x = evalcar(x, env);
+    arg1 = sym2vcell(proc);
+#ifndef RECKLESS
+    if (NIMP(CDR(arg1)) && ((SCM) SNAME(CDR(arg1))==proc)
+	&& (CDR(arg1) != x))
+      warn("redefining built-in ", CHARS(proc));
+    else
+#endif
+    if (5 <= verbose && UNDEFINED != CDR(arg1))
+      warn("redefining ", CHARS(proc));
+    CDR(arg1) = x;
+#ifdef SICP
+    return cons2(i_quote, CAR(arg1), EOL);
+#else
+    return UNSPECIFIED;
+#endif
+  }
+  return cons2(IM_DEFINE, proc, x);
+}
+/* end of acros */
+
+SCM m_letrec(xorig, env)
+     SCM xorig, env;
+{
+  SCM cdrx = CDR(xorig);	/* locally mutable version of form */
+  char *what = CHARS(CAR(xorig));
+  SCM x = cdrx, proc, arg1;	/* structure traversers */
+  SCM vars = EOL, inits = EOL, *initloc = &inits;
+
+  ASRTSYNTAX(ilength(x) >= 2, s_body);
+  proc = CAR(x);
+  if NULLP(proc) return m_letstar(xorig, env); /* null binding, let* faster */
+  ASRTSYNTAX(ilength(proc) >= 1, s_bindings);
+  do {
+    /* vars list reversed here, inits reversed at evaluation */
+    arg1 = CAR(proc);
+    ASRTSYNTAX(2==ilength(arg1), s_bindings);
+    ASRTSYNTAX(NIMP(CAR(arg1)) && SYMBOLP(CAR(arg1)), s_variable);
+    vars = cons(CAR(arg1), vars);
+    *initloc = cons(CAR(CDR(arg1)), EOL);
+    initloc = &CDR(*initloc);
+  } while NIMP(proc = CDR(proc));
+  cdrx = cons2(vars, inits, CDR(x));
+  bodycheck(xorig, &CDR(CDR(cdrx)), what);
+  return cons(IM_LETREC, cdrx);
+}
+
+SCM m_let(xorig, env)
+     SCM xorig, env;
+{
+  SCM cdrx = CDR(xorig);	/* locally mutable version of form */
+  SCM x = cdrx, proc, arg1, name; /* structure traversers */
+  SCM vars = EOL, inits = EOL, *varloc = &vars, *initloc = &inits;
+
+  ASSYNT(ilength(x) >= 2, xorig, s_body, s_let);
+  proc = CAR(x);
+  if (NULLP(proc)
+      || (NIMP(proc) && CONSP(proc)
+	  && NIMP(CAR(proc)) && CONSP(CAR(proc)) && NULLP(CDR(proc))))
+    return m_letstar(xorig, env); /* null or single binding, let* is faster */
+  ASSYNT(NIMP(proc), xorig, s_bindings, s_let);
+  if CONSP(proc)		/* plain let, proc is <bindings> */
+    return cons(IM_LET, CDR(m_letrec(xorig, env)));
+  if (!SYMBOLP(proc)) wta(xorig, s_bindings, s_let); /* bad let */
+  name = proc;			/* named let, build equiv letrec */
+  x = CDR(x);
+  ASSYNT(ilength(x) >= 2, xorig, s_body, s_let);
+  proc = CAR(x);		/* bindings list */
+  ASSYNT(ilength(proc) >= 0, xorig, s_bindings, s_let);
+  while NIMP(proc) {		/* vars and inits both in order */
+    arg1 = CAR(proc);
+    ASSYNT(2==ilength(arg1), xorig, s_bindings, s_let);
+    ASSYNT(NIMP(CAR(arg1)) && SYMBOLP(CAR(arg1)), xorig, s_variable, s_let);
+    *varloc = cons(CAR(arg1), EOL);
+    varloc = &CDR(*varloc);
+    *initloc = cons(CAR(CDR(arg1)), EOL);
+    initloc = &CDR(*initloc);
+    proc = CDR(proc);
+  }
+  return
+    m_letrec(cons2(i_let,
+		   cons(cons2(name, cons2(i_lambda, vars, CDR(x)), EOL), EOL),
+		   acons(name, inits, EOL)), /* body */
+	     env);
+}
+
+#define s_atapply (ISYMCHARS(IM_APPLY)+1)
+
+SCM m_apply(xorig, env)
+     SCM xorig, env;
+{
+  ASSYNT(ilength(CDR(xorig))==2, xorig, s_expression, s_atapply);
+  return cons(IM_APPLY, CDR(xorig));
+}
+
+#define s_atcall_cc (ISYMCHARS(IM_CONT)+1)
+
+SCM m_cont(xorig, env)
+     SCM xorig, env;
+{
+  ASSYNT(ilength(CDR(xorig))==1, xorig, s_expression, s_atcall_cc);
+  return cons(IM_CONT, CDR(xorig));
+}
+
+#ifndef RECKLESS
+int badargsp(formals, args)
+     SCM formals, args;
+{
+  while NIMP(formals) {
+    if NCONSP(formals) return 0;
+    if IMP(args) return 1;
+    formals = CDR(formals);
+    args = CDR(args);
+  }
+  return NNULLP(args) ? 1 : 0;
+}
+#endif
+
+char s_map[] = "map", s_for_each[] = "for-each", s_eval[] = "eval";
+SCM eqv P((SCM x, SCM y));
+long tc16_macro;		/* Type code for macros */
+#ifdef CAUTIOUS
+static char s_bottom[] = "stacktrace bottommed out";
+#endif
+
+SCM ceval(x, env)
+     SCM x, env;
+{
+  union {SCM *lloc; SCM arg1;} t;
+  SCM proc, arg2;
+  CHECK_STACK;
+ loop: POLL;
+  switch TYP7(x) {
+  case tcs_symbols:
+    /* only happens when called at top level */
+    x = cons(x, UNDEFINED);
+    goto retval;
+  case (127 & IM_AND):
+    x = CDR(x);
+    t.arg1 = x;
+    while(NNULLP(t.arg1 = CDR(t.arg1)))
+      if FALSEP(EVALCAR(x, env)) return BOOL_F;
+      else x = t.arg1;
+    goto carloop;
+ cdrtcdrxbegin:
+#ifdef CAUTIOUS
+    ASSERT(NIMP(stacktrace), EOL, s_bottom, s_eval);
+    stacktrace = CDR(stacktrace);
+#endif
+ cdrxbegin:
+  case (127 & IM_BEGIN):
+    x = CDR(x);
+ begin:
+    t.arg1 = x;
+    while(NNULLP(t.arg1 = CDR(t.arg1))) {
+      SIDEVAL(CAR(x), env);
+      x = t.arg1;
+    }
+ carloop:			/* eval car of last form in list */
+    if NCELLP(CAR(x)) {
+      x = CAR(x);
+      return IMP(x)?EVALIMP(x, env):I_VAL(x);
+    }
+    if SYMBOLP(CAR(x)) {
+ retval:
+      return *lookupcar(x, env);
+    }
+    x = CAR(x);
+    goto loop;			/* tail recurse */
+
+  case (127 & IM_CASE):
+    x = CDR(x);
+    t.arg1 = EVALCAR(x, env);
+    while(NIMP(x = CDR(x))) {
+      proc = CAR(x);
+      if (i_else==CAR(proc)) {
+	x = CDR(proc);
+	goto begin;
+      }
+      proc = CAR(proc);
+      while NIMP(proc) {
+	if (CAR(proc)==t.arg1
+#ifdef FLOATS
+	    || NFALSEP(eqv(CAR(proc), t.arg1))
+#endif
+	    ) {
+	  x = CDR(CAR(x));
+	  goto begin;
+	}
+	proc = CDR(proc);
+      }
+    }
+    return UNSPECIFIED;
+  case (127 & IM_COND):
+    while(NIMP(x = CDR(x))) {
+      proc = CAR(x);
+      t.arg1 = EVALCAR(proc, env);
+      if NFALSEP(t.arg1) {
+	x = CDR(proc);
+	if NULLP(x) return t.arg1;
+	if (i_arrow != CAR(x)) goto begin;
+	proc = CDR(x);
+	proc = EVALCAR(proc, env);
+	ASRTGO(NIMP(proc), badfun);
+#ifdef CAUTIOUS
+	if CLOSUREP(proc) goto checkargs1;
+#endif
+	goto evap1;
+      }
+    }
+    return UNSPECIFIED;
+  case (127 & IM_DO):
+    x = CDR(x);
+    proc = CAR(CDR(x)); /* inits */
+    t.arg1 = EOL; /* values */
+    while NIMP(proc) {
+      t.arg1 = cons(EVALCAR(proc, env), t.arg1);
+      proc = CDR(proc);
+    }
+    env = EXTEND_ENV(CAR(x), t.arg1, env);
+    x = CDR(CDR(x));
+    while (proc = CAR(x), FALSEP(EVALCAR(proc, env))) {
+      for(proc = CAR(CDR(x));NIMP(proc);proc = CDR(proc)) {
+	t.arg1 = CAR(proc);	/* body */
+	SIDEVAL(t.arg1, env);
+      }
+      for(t.arg1 = EOL, proc = CDR(CDR(x)); NIMP(proc); proc = CDR(proc))
+	t.arg1 = cons(EVALCAR(proc, env), t.arg1); /* steps */
+      env = EXTEND_ENV(CAR(CAR(env)), t.arg1, CDR(env));
+    }
+    x = CDR(proc);
+    if NULLP(x) return UNSPECIFIED;
+    goto begin;
+  case (127 & IM_IF):
+    x = CDR(x);
+    if NFALSEP(EVALCAR(x, env)) x = CDR(x);
+    else if IMP(x = CDR(CDR(x))) return UNSPECIFIED;
+    goto carloop;
+  case (127 & IM_LET):
+    x = CDR(x);
+    proc = CAR(CDR(x));
+    t.arg1 = EOL;
+    do {
+      t.arg1 = cons(EVALCAR(proc, env), t.arg1);
+    } while NIMP(proc = CDR(proc));
+    env = EXTEND_ENV(CAR(x), t.arg1, env);
+    x = CDR(x);
+    goto cdrxbegin;
+  case (127 & IM_LETREC):
+    x = CDR(x);
+    env = EXTEND_ENV(CAR(x), undefineds, env);
+    x = CDR(x);
+    proc = CAR(x);
+    t.arg1 = EOL;
+    do {
+	t.arg1 = cons(EVALCAR(proc, env), t.arg1);
+    } while NIMP(proc = CDR(proc));
+    CDR(CAR(env)) = t.arg1;
+    goto cdrxbegin;
+  case (127 & IM_LETSTAR):
+    x = CDR(x);
+    proc = CAR(x);
+    if IMP(proc) {
+      env = EXTEND_ENV(EOL, EOL, env);
+      goto cdrxbegin;
+    }
+    do {
+      t.arg1 = CAR(proc);
+      proc = CDR(proc);
+      env = EXTEND_ENV(t.arg1, EVALCAR(proc, env), env);
+    } while NIMP(proc = CDR(proc));
+    goto cdrxbegin;
+  case (127 & IM_OR):
+    x = CDR(x);
+    t.arg1 = x;
+    while(NNULLP(t.arg1 = CDR(t.arg1))) {
+      x = EVALCAR(x, env);
+      if NFALSEP(x) return x;
+      x = t.arg1;
+    }
+    goto carloop;
+  case (127 & IM_LAMBDA):
+    return closure(CDR(x), env);
+  case (127 & IM_QUOTE):
+    return CAR(CDR(x));
+  case (127 & IM_SET):
+    x = CDR(x);
+    proc = CAR(x);
+    switch (7 & (int)proc) {
+    case 0:
+      t.lloc = lookupcar(x, env);
+      break;
+    case 1:
+      t.lloc = &I_VAL(proc);
+      break;
+#ifdef MEMOIZE_LOCALS
+    case 4:
+      t.lloc = ilookup(proc, env);
+      break;
+#endif
+    }
+    x = CDR(x);
+    *t.lloc = EVALCAR(x, env);
+#ifdef SICP
+    return *t.lloc;
+#else
+    return UNSPECIFIED;
+#endif
+  case (127 & IM_DEFINE):	/* only for internal defines */
+    x = CDR(x);
+    proc = CAR(x);
+    x = CDR(x);
+    x = evalcar(x, env);
+    env = CAR(env);
+    DEFER_INTS;
+    CAR(env) = cons(proc, CAR(env));
+    CDR(env) = cons(x, CDR(env));
+    ALLOW_INTS;
+    return UNSPECIFIED;
+	/* new syntactic forms go here. */
+  case (127 & MAKISYM(0)):
+    proc = CAR(x);
+    ASRTGO(ISYMP(proc), badfun);
+    switch ISYMNUM(proc) {
+    case (ISYMNUM(IM_APPLY)):
+      proc = CDR(x);
+      proc = EVALCAR(proc, env);
+      ASRTGO(NIMP(proc), badfun);
+      if (CLOSUREP(proc)) {
+	t.arg1 = CDR(CDR(x));
+	t.arg1 = EVALCAR(t.arg1, env);
+#ifndef RECKLESS
+	if (badargsp(CAR(CODE(proc)), t.arg1)) goto wrongnumargs;
+#endif
+	env = EXTEND_ENV(CAR(CODE(proc)), t.arg1, ENV(proc));
+	x = CODE(proc);
+	goto cdrxbegin;
+      }
+      proc = i_apply;
+      goto evapply;
+    case (ISYMNUM(IM_CONT)):
+      t.arg1 = scm_make_cont();
+      if (proc = setjmp(CONT(t.arg1)->jmpbuf))
+#ifdef SHORT_INT
+	return (SCM)thrown_value;
+#else
+	return (SCM)proc;
+#endif
+      proc = CDR(x);
+      proc = evalcar(proc, env);
+      ASRTGO(NIMP(proc), badfun);
+#ifdef CAUTIOUS
+      if CLOSUREP(proc) {
+      checkargs1:
+	stacktrace = cons(x, stacktrace);
+	/* Check that argument list of proc can match 1 arg. */
+	arg2 = CAR(CODE(proc));
+	ASRTGO(NIMP(arg2), wrongnumargs);
+	if NCONSP(arg2) goto evap1;
+	arg2 = CDR(arg2);
+	ASRTGO(NULLP(arg2) || NCONSP(arg2), wrongnumargs);
+      }
+#endif
+      goto evap1;
+    default:
+      goto badfun;
+    }
+  default:
+    proc = x;
+  badfun:
+    everr(x, env, proc, "Wrong type to apply: ", "");
+  case tc7_vector:
+  case tc7_bvect: case tc7_ivect: case tc7_uvect:
+  case tc7_fvect: case tc7_dvect: case tc7_cvect:
+  case tc7_string:
+  case tc7_smob:
+    return x;
+#ifdef MEMOIZE_LOCALS
+  case (127 & ILOC00):
+    proc = *ilookup(CAR(x), env);
+    ASRTGO(NIMP(proc), badfun);
+# ifndef RECKLESS
+#  ifdef CAUTIOUS
+    goto checkargs;
+#  endif
+# endif
+    break;
+#endif /* ifdef MEMOIZE_LOCALS */
+  case tcs_cons_gloc:
+    proc = I_VAL(CAR(x));
+    ASRTGO(NIMP(proc), badfun);
+#ifndef RECKLESS
+# ifdef CAUTIOUS
+    goto checkargs;
+# endif
+#endif
+    break;
+  case tcs_cons_nimcar:
+    if SYMBOLP(CAR(x)) {
+      proc = *lookupcar(x, env);
+      if IMP(proc) {unmemocar(x, env); goto badfun;}
+      if (tc16_macro==TYP16(proc)) {
+	unmemocar(x, env);
+	t.arg1 = apply(CDR(proc), x, cons(env, listofnull));
+	switch ((int)(CAR(proc)>>16)) {
+	case 2:
+	  if (ilength(t.arg1) <= 0)
+	    t.arg1 = cons2(IM_BEGIN, t.arg1, EOL);
+	  DEFER_INTS;
+	  CAR(x) = CAR(t.arg1);
+	  CDR(x) = CDR(t.arg1);
+	  ALLOW_INTS;
+	  goto loop;
+	case 1:
+	  if NIMP(x = t.arg1) goto loop;
+	case 0:
+	  return t.arg1;
+	}
+      }
+    }
+    else proc = ceval(CAR(x), env);
+    ASRTGO(NIMP(proc), badfun);
+#ifndef RECKLESS
+# ifdef CAUTIOUS
+  checkargs:
+# endif
+    /* At this point proc is the evaluated procedure from the function
+       position and x has the form which is being evaluated. */
+    if CLOSUREP(proc) {
+# ifdef CAUTIOUS
+      stacktrace = cons(x, stacktrace);
+# endif
+      arg2 = CAR(CODE(proc));
+      t.arg1 = CDR(x);
+      while NIMP(arg2) {
+	if NCONSP(arg2) {
+	  goto evapply;
+	}
+	if IMP(t.arg1) goto umwrongnumargs;
+	arg2 = CDR(arg2);
+	t.arg1 = CDR(t.arg1);
+      }
+      if NNULLP(t.arg1) goto umwrongnumargs;
+    }
+#endif
+  }
+ evapply:
+  if NULLP(CDR(x)) switch TYP7(proc) { /* no arguments given */
+  case tc7_subr_0:
+    return SUBRF(proc)();
+  case tc7_subr_1o:
+    return SUBRF(proc) (UNDEFINED);
+  case tc7_lsubr:
+    return SUBRF(proc)(EOL);
+  case tc7_rpsubr:
+    return BOOL_T;
+  case tc7_asubr:
+    return SUBRF(proc)(UNDEFINED, UNDEFINED);
+#ifdef CCLO
+  case tc7_cclo:
+    t.arg1 = proc;
+    proc = CCLO_SUBR(proc);
+    goto evap1;
+#endif
+  case tcs_closures:
+    x = CODE(proc);
+    env = EXTEND_ENV(CAR(x), EOL, ENV(proc));
+    goto cdrtcdrxbegin;
+  case tc7_contin:
+  case tc7_subr_1:
+  case tc7_subr_2:
+  case tc7_subr_2o:
+  case tc7_cxr:
+  case tc7_subr_3:
+  case tc7_lsubr_2:
+  umwrongnumargs:
+    unmemocar(x, env);
+  wrongnumargs:
+    everr(x, env, proc, (char *)WNA, "");
+  default:
+    goto badfun;
+  }
+  x = CDR(x);
+#ifdef CAUTIOUS
+  if (IMP(x)) goto wrongnumargs;
+#endif
+  t.arg1 = EVALCAR(x, env);
+  x = CDR(x);
+  if NULLP(x)
+evap1: switch TYP7(proc) { /* have one argument in t.arg1 */
+  case tc7_subr_2o:
+    return SUBRF(proc)(t.arg1, UNDEFINED);
+  case tc7_subr_1:
+  case tc7_subr_1o:
+    return SUBRF(proc)(t.arg1);
+  case tc7_cxr:
+#ifdef FLOATS
+    if SUBRF(proc) {
+      if INUMP(t.arg1)
+	return makdbl(DSUBRF(proc)((double) INUM(t.arg1)), 0.0);
+      ASRTGO(NIMP(t.arg1), floerr);
+      if REALP(t.arg1)
+	return makdbl(DSUBRF(proc)(REALPART(t.arg1)), 0.0);
+# ifdef BIGDIG
+      if BIGP(t.arg1)
+	return makdbl(DSUBRF(proc)(big2dbl(t.arg1)), 0.0);
+# endif
+    floerr:
+      wta(t.arg1, (char *)ARG1, CHARS(SNAME(proc)));
+    }
+#endif
+    proc = (SCM)SNAME(proc);
+    {
+      char *chrs = CHARS(proc)+LENGTH(proc)-1;
+      while('c' != *--chrs) {
+	ASSERT(NIMP(t.arg1) && CONSP(t.arg1),
+	       t.arg1, ARG1, CHARS(proc));
+	t.arg1 = ('a'==*chrs)?CAR(t.arg1):CDR(t.arg1);
+      }
+      return t.arg1;
+    }
+  case tc7_rpsubr:
+    return BOOL_T;
+  case tc7_asubr:
+    return SUBRF(proc)(t.arg1, UNDEFINED);
+  case tc7_lsubr:
+    return SUBRF(proc)(cons(t.arg1, EOL));
+#ifdef CCLO
+  case tc7_cclo:
+    arg2 = t.arg1;
+    t.arg1 = proc;
+    proc = CCLO_SUBR(proc);
+    goto evap2;
+#endif
+  case tcs_closures:
+    x = CODE(proc);
+    env = EXTEND_ENV(CAR(x), cons(t.arg1, EOL), ENV(proc));
+    goto cdrtcdrxbegin;
+  case tc7_contin:
+    scm_dynthrow(CONT(proc), t.arg1);
+  case tc7_subr_2:
+  case tc7_subr_0:
+  case tc7_subr_3:
+  case tc7_lsubr_2:
+    goto wrongnumargs;
+  default:
+    goto badfun;
+  }
+#ifdef CAUTIOUS
+  if (IMP(x)) goto wrongnumargs;
+#endif
+  {				/* have two or more arguments */
+    arg2 = EVALCAR(x, env);
+    x = CDR(x);
+    if NULLP(x)
+#ifdef CCLO
+  evap2:
+#endif
+      switch TYP7(proc) { /* have two arguments */
+    case tc7_subr_2:
+    case tc7_subr_2o:
+      return SUBRF(proc)(t.arg1, arg2);
+    case tc7_lsubr:
+      return SUBRF(proc)(cons2(t.arg1, arg2, EOL));
+    case tc7_lsubr_2:
+      return SUBRF(proc)(t.arg1, arg2, EOL);
+    case tc7_rpsubr:
+    case tc7_asubr:
+      return SUBRF(proc)(t.arg1, arg2);
+#ifdef CCLO
+    cclon: case tc7_cclo:
+      return apply(CCLO_SUBR(proc), proc,
+		   cons2(t.arg1, arg2, cons(eval_args(x, env), EOL)));
+/*    case tc7_cclo:
+      x = cons(arg2, eval_args(x, env));
+      arg2 = t.arg1;
+      t.arg1 = proc;
+      proc = CCLO_SUBR(proc);
+      goto evap3; */
+#endif
+    case tc7_subr_0:
+    case tc7_cxr:
+    case tc7_subr_1o:
+    case tc7_subr_1:
+    case tc7_subr_3:
+    case tc7_contin:
+      goto wrongnumargs;
+    default:
+      goto badfun;
+    case tcs_closures:
+      env = EXTEND_ENV(CAR(CODE(proc)), cons2(t.arg1, arg2, EOL), ENV(proc));
+      x = CODE(proc);
+      goto cdrtcdrxbegin;
+    }
+    switch TYP7(proc) {		/* have 3 or more arguments */
+    case tc7_subr_3:
+      ASRTGO(NULLP(CDR(x)), wrongnumargs);
+      return SUBRF(proc)(t.arg1, arg2, EVALCAR(x, env));
+    case tc7_asubr:
+/*      t.arg1 = SUBRF(proc)(t.arg1, arg2);
+      while NIMP(x) {
+	t.arg1 = SUBRF(proc)(t.arg1, EVALCAR(x, env));
+	x = CDR(x);
+      }
+      return t.arg1; */
+    case tc7_rpsubr:
+      return apply(proc, t.arg1, acons(arg2, eval_args(x, env), EOL));
+    case tc7_lsubr_2:
+      return SUBRF(proc)(t.arg1, arg2, eval_args(x, env));
+    case tc7_lsubr:
+      return SUBRF(proc)(cons2(t.arg1, arg2, eval_args(x, env)));
+#ifdef CCLO
+    case tc7_cclo: goto cclon;
+#endif
+    case tcs_closures:
+      env = EXTEND_ENV(CAR(CODE(proc)),
+		       cons2(t.arg1, arg2, eval_args(x, env)),
+		       ENV(proc));
+      x = CODE(proc);
+      goto cdrtcdrxbegin;
+    case tc7_subr_2:
+    case tc7_subr_1o:
+    case tc7_subr_2o:
+    case tc7_subr_0:
+    case tc7_cxr:
+    case tc7_subr_1:
+    case tc7_contin:
+      goto wrongnumargs;
+    default:
+      goto badfun;
+    }
+  }
+}
+
+SCM procedurep(obj)
+     SCM obj;
+{
+	if NIMP(obj) switch TYP7(obj) {
+	case tcs_closures:
+	case tc7_contin:
+	case tcs_subrs:
+#ifdef CCLO
+	case tc7_cclo:
+#endif
+	  return BOOL_T;
+	}
+	return BOOL_F;
+}
+
+static char s_proc_doc[] = "procedure-documentation";
+SCM l_proc_doc(proc)
+     SCM proc;
+{
+  SCM code;
+  ASSERT(BOOL_T==procedurep(proc) && NIMP(proc) && TYP7(proc) != tc7_contin,
+	 proc, ARG1, s_proc_doc);
+  switch TYP7(proc) {
+  case tcs_closures:
+    code = CDR(CODE(proc));
+    if IMP(CDR(code)) return BOOL_F;
+    code = CAR(code);
+    if IMP(code) return BOOL_F;
+    if STRINGP(code) return code;
+  default:
+    return BOOL_F;
+/*
+  case tcs_subrs:
+#ifdef CCLO
+  case tc7_cclo:
+#endif
+*/
+  }
+}
+
+/* This code is for apply. it is destructive on multiple args.
+   This will only screw you if you do (apply apply '( ... )) */
+SCM nconc2last(lst)
+     SCM lst;
+{
+  SCM *lloc = &lst;
+#ifdef CAUTIOUS
+  ASSERT(ilength(lst) >= 1, lst, WNA, s_apply);
+#endif
+  while NNULLP(CDR(*lloc)) lloc = &CDR(*lloc);
+#ifdef CAUTIOUS
+  ASSERT(ilength(CAR(*lloc)) >= 0, lst, ARGn, s_apply);
+#endif
+  *lloc = CAR(*lloc);
+  return lst;
+}
+
+
+SCM apply(proc, arg1, args)
+     SCM proc, arg1, args;
+{
+  ASRTGO(NIMP(proc), badproc);
+  if NULLP(args)
+    if NULLP(arg1) arg1 = UNDEFINED;
+    else {
+      args = CDR(arg1);
+      arg1 = CAR(arg1);
+    }
+  else {
+    /*		ASRTGO(NIMP(args) && CONSP(args), wrongnumargs); */
+    args = nconc2last(args);
+  }
+#ifdef CCLO
+ tail:
+#endif
+  switch TYP7(proc) {
+  case tc7_subr_2o:
+    args = NULLP(args)?UNDEFINED:CAR(args);
+    return SUBRF(proc)(arg1, args);
+  case tc7_subr_2:
+    ASRTGO(NULLP(CDR(args)), wrongnumargs);
+    args = CAR(args);
+    return SUBRF(proc)(arg1, args);
+  case tc7_subr_0:
+    ASRTGO(UNBNDP(arg1), wrongnumargs);
+    return SUBRF(proc)();
+  case tc7_subr_1:
+  case tc7_subr_1o:
+    ASRTGO(NULLP(args), wrongnumargs);
+    return SUBRF(proc)(arg1);
+  case tc7_cxr:
+    ASRTGO(NULLP(args), wrongnumargs);
+#ifdef FLOATS
+    if SUBRF(proc) {
+      if INUMP(arg1)
+	return makdbl(DSUBRF(proc)((double) INUM(arg1)), 0.0);
+      ASRTGO(NIMP(arg1), floerr);
+      if REALP(arg1)
+	return makdbl(DSUBRF(proc)(REALPART(arg1)), 0.0);
+# ifdef BIGDIG
+      if BIGP(arg1)
+	return makdbl(DSUBRF(proc)(big2dbl(arg1)), 0.0);
+# endif
+    floerr:
+      wta(arg1, (char *)ARG1, CHARS(SNAME(proc)));
+    }
+#endif
+    proc = (SCM)SNAME(proc);
+    {
+      char *chrs = CHARS(proc)+LENGTH(proc)-1;
+      while('c' != *--chrs) {
+	ASSERT(NIMP(arg1) && CONSP(arg1),
+	       arg1, ARG1, CHARS(proc));
+	arg1 = ('a'==*chrs)?CAR(arg1):CDR(arg1);
+      }
+      return arg1;
+    }
+  case tc7_subr_3:
+    return SUBRF(proc)(arg1, CAR(args), CAR(CDR(args)));
+  case tc7_lsubr:
+    return SUBRF(proc)(UNBNDP(arg1) ? EOL : cons(arg1, args));
+  case tc7_lsubr_2:
+    ASRTGO(NIMP(args) && CONSP(args), wrongnumargs);
+    return SUBRF(proc)(arg1, CAR(args), CDR(args));
+  case tc7_asubr:
+    if NULLP(args) return SUBRF(proc)(arg1, UNDEFINED);
+    while NIMP(args) {
+      ASSERT(CONSP(args), args, ARG2, s_apply);
+      arg1 = SUBRF(proc)(arg1, CAR(args));
+      args = CDR(args);
+    }
+    return arg1;
+  case tc7_rpsubr:
+    if NULLP(args) return BOOL_T;
+    while NIMP(args) {
+      ASSERT(CONSP(args), args, ARG2, s_apply);
+      if FALSEP(SUBRF(proc)(arg1, CAR(args))) return BOOL_F;
+      arg1 = CAR(args);
+      args = CDR(args);
+    }
+    return BOOL_T;
+  case tcs_closures:
+    arg1 = (UNBNDP(arg1) ? EOL : cons(arg1, args));
+#ifndef RECKLESS
+    if (badargsp(CAR(CODE(proc)), arg1)) goto wrongnumargs;
+#endif
+    args = EXTEND_ENV(CAR(CODE(proc)), arg1, ENV(proc));
+    proc = CODE(proc);
+    while NNULLP(proc = CDR(proc)) arg1 = EVALCAR(proc, args);
+    return arg1;
+  case tc7_contin:
+    ASRTGO(NULLP(args), wrongnumargs);
+    scm_dynthrow(CONT(proc), arg1);
+#ifdef CCLO
+  case tc7_cclo:
+    args = (UNBNDP(arg1) ? EOL : cons(arg1, args));
+    arg1 = proc;
+    proc = CCLO_SUBR(proc);
+    goto tail;
+#endif
+  wrongnumargs:
+    wta(proc, (char *)WNA, s_apply);
+  default:
+  badproc:
+    wta(proc, (char *)ARG1, s_apply);
+    return arg1;
+  }
+}
+
+SCM map(proc, arg1, args)
+     SCM proc, arg1, args;
+{
+	long i;
+	SCM res = EOL, *pres = &res;
+	SCM *ve = &args;	/* Keep args from being optimized away. */
+	if NULLP(arg1) return res;
+	ASSERT(NIMP(arg1), arg1, ARG2, s_map);
+	if NULLP(args) {
+		while NIMP(arg1) {
+			ASSERT(CONSP(arg1), arg1, ARG2, s_map);
+			*pres = cons(apply(proc, CAR(arg1), listofnull), EOL);
+			pres = &CDR(*pres);
+			arg1 = CDR(arg1);
+		}
+		return res;
+	}
+	args = vector(cons(arg1, args));
+	ve = VELTS(args);
+#ifndef RECKLESS
+	for(i = LENGTH(args)-1; i >= 0; i--)
+	  ASSERT(NIMP(ve[i]) && CONSP(ve[i]), args, ARG2, s_map);
+#endif
+	while (1) {
+		arg1 = EOL;
+		for (i = LENGTH(args)-1;i >= 0;i--) {
+			if IMP(ve[i]) return res;
+			arg1 = cons(CAR(ve[i]), arg1);
+			ve[i] = CDR(ve[i]);
+		}
+		*pres = cons(apply(proc, arg1, EOL), EOL);
+		pres = &CDR(*pres);
+	}
+}
+SCM for_each(proc, arg1, args)
+     SCM proc, arg1, args;
+{
+	SCM *ve = &args;	/* Keep args from being optimized away. */
+	long i;
+	if NULLP(arg1) return UNSPECIFIED;
+	ASSERT(NIMP(arg1), arg1, ARG2, s_for_each);
+	if NULLP(args) {
+		while NIMP(arg1) {
+			ASSERT(CONSP(arg1), arg1, ARG2, s_for_each);
+			apply(proc, CAR(arg1), listofnull);
+			arg1 = CDR(arg1);
+		}
+		return UNSPECIFIED;
+	}
+	args = vector(cons(arg1, args));
+	ve = VELTS(args);
+	while (1) {
+		arg1 = EOL;
+		for (i = LENGTH(args)-1;i >= 0;i--) {
+			if IMP(ve[i]) return UNSPECIFIED;
+			arg1 = cons(CAR(ve[i]), arg1);
+			ve[i] = CDR(ve[i]);
+		}
+		apply(proc, arg1, EOL);
+	}
+}
+
+SCM closure(code, env)
+     SCM code, env;
+{
+	register SCM z;
+	NEWCELL(z);
+	SETCODE(z, code);
+	ENV(z) = env;
+	return z;
+}
+
+long tc16_promise;
+SCM makprom(code)
+     SCM code;
+{
+	register SCM z;
+	NEWCELL(z);
+	CDR(z) = code;
+	CAR(z) = tc16_promise;
+	return z;
+}
+static int prinprom(exp, port, writing)
+     SCM exp;
+     SCM port;
+     int writing;
+{
+  lputs("#<promise ", port);
+  iprin1(CDR(exp), port, writing);
+  lputc('>', port);
+  return !0;
+}
+
+SCM makacro(code)
+     SCM code;
+{
+	register SCM z;
+	NEWCELL(z);
+	CDR(z) = code;
+	CAR(z) = tc16_macro;
+	return z;
+}
+SCM makmacro(code)
+     SCM code;
+{
+	register SCM z;
+	NEWCELL(z);
+	CDR(z) = code;
+	CAR(z) = tc16_macro | (1L<<16);
+	return z;
+}
+SCM makmmacro(code)
+     SCM code;
+{
+	register SCM z;
+	NEWCELL(z);
+	CDR(z) = code;
+	CAR(z) = tc16_macro | (2L<<16);
+	return z;
+}
+static int prinmacro(exp, port, writing)
+     SCM exp;
+     SCM port;
+     int writing;
+{
+  if (CAR(exp) & (3L<<16)) lputs("#<macro", port);
+  else lputs("#<syntax", port);
+  if (CAR(exp) & (2L<<16)) lputc('!', port);
+  lputc(' ', port);
+  iprin1(CDR(exp), port, writing);
+  lputc('>', port);
+  return !0;
+}
+
+char s_force[] = "force";
+SCM force(x)
+     SCM x;
+{
+  ASSERT((TYP16(x)==tc16_promise), x, ARG1, s_force);
+  if (!((1L<<16) & CAR(x))) {
+    SCM ans = apply(CDR(x), EOL, EOL);
+    if (!((1L<<16) & CAR(x))) {
+      DEFER_INTS;
+      CDR(x) = ans;
+      CAR(x) |= (1L<<16);
+      ALLOW_INTS;
+    }
+  }
+  return CDR(x);
+}
+
+SCM copytree(obj)
+     SCM obj;
+{
+  SCM ans, tl;
+  if IMP(obj) return obj;
+  if VECTORP(obj) {
+    sizet i = LENGTH(obj);
+    ans = make_vector(MAKINUM(i), UNSPECIFIED);
+    while(i--) VELTS(ans)[i] = copytree(VELTS(obj)[i]);
+    return ans;
+  }
+  if NCONSP(obj) return obj;
+/*  return cons(copytree(CAR(obj)), copytree(CDR(obj))); */
+  ans = tl = cons(copytree(CAR(obj)), UNSPECIFIED);
+  while(NIMP(obj = CDR(obj)) && CONSP(obj))
+    tl = (CDR(tl) = cons(copytree(CAR(obj)), UNSPECIFIED));
+  CDR(tl) = obj;
+  return ans;
+}
+SCM eval(obj)
+     SCM obj;
+{
+  obj = copytree(obj);
+  return EVAL(obj, (SCM)EOL);
+}
+
+SCM definedp(x, env)
+     SCM x, env;
+{
+  SCM proc = CAR(x = CDR(x));
+  return (ISYMP(proc)
+	  || (NIMP(proc) && SYMBOLP(proc)
+	      && !UNBNDP(CDR(sym2vcell(proc)))))?
+		(SCM)BOOL_T : (SCM)BOOL_F;
+}
+
+static iproc subr1s[] = {
+	{"copy-tree", copytree},
+	{s_eval, eval},
+	{s_force, force},
+	{s_proc_doc, l_proc_doc},
+	{"procedure->syntax", makacro},
+	{"procedure->macro", makmacro},
+	{"procedure->memoizing-macro", makmmacro},
+	{"apply:nconc-to-last", nconc2last},
+	{0, 0}};
+
+static iproc lsubr2s[] = {
+/*	{s_apply, apply}, now explicity initted */
+	{s_map, map},
+	{s_for_each, for_each},
+	{0, 0}};
+
+static smobfuns promsmob = {markcdr, free0, prinprom};
+static smobfuns macrosmob = {markcdr, free0, prinmacro};
+
+SCM make_synt(name, macroizer, fcn)
+     char *name;
+     SCM (*macroizer)();
+     SCM (*fcn)();
+{
+  SCM symcell = sysintern(name, UNDEFINED);
+  long tmp = ((((CELLPTR)(CAR(symcell)))-heap_org)<<8);
+  register SCM z;
+  if ((tmp>>8) != ((CELLPTR)(CAR(symcell))-heap_org))
+    tmp = 0;
+  NEWCELL(z);
+  SUBRF(z) = fcn;
+  CAR(z) = tmp + tc7_subr_2;
+  CDR(symcell) = macroizer(z);
+  return CAR(symcell);
+}
+
+void init_eval()
+{
+  tc16_promise = newsmob(&promsmob);
+  tc16_macro = newsmob(&macrosmob);
+  init_iprocs(subr1s, tc7_subr_1);
+  init_iprocs(lsubr2s, tc7_lsubr_2);
+  i_apply = make_subr(s_apply, tc7_lsubr_2, apply);
+  i_dot = CAR(sysintern(".", UNDEFINED));
+  i_arrow = CAR(sysintern("=>", UNDEFINED));
+  i_else = CAR(sysintern("else", UNDEFINED));
+  i_unquote = CAR(sysintern("unquote", UNDEFINED));
+  i_uq_splicing = CAR(sysintern("unquote-splicing", UNDEFINED));
+
+  /* acros */
+  i_quasiquote = make_synt(s_quasiquote, makacro, m_quasiquote);
+  make_synt(s_define, makmmacro, m_define);
+  make_synt(s_delay, makacro, m_delay);
+  /* end of acros */
+
+  make_synt(s_and, makmmacro, m_and);
+  make_synt(s_begin, makmmacro, m_begin);
+  make_synt(s_case, makmmacro, m_case);
+  make_synt(s_cond, makmmacro, m_cond);
+  make_synt(s_do, makmmacro, m_do);
+  make_synt(s_if, makmmacro, m_if);
+  i_lambda = make_synt(s_lambda, makmmacro, m_lambda);
+  i_let = make_synt(s_let, makmmacro, m_let);
+  make_synt(s_letrec, makmmacro, m_letrec);
+  make_synt(s_letstar, makmmacro, m_letstar);
+  make_synt(s_or, makmmacro, m_or);
+  i_quote = make_synt(s_quote, makmmacro, m_quote);
+  make_synt(s_set, makmmacro, m_set);
+  make_synt(s_atapply, makmmacro, m_apply);
+  make_synt(s_atcall_cc, makmmacro, m_cont);
+
+  make_synt("defined?", makacro, definedp);
+}
diff --git a/example.scm b/example.scm
new file mode 100644
index 0000000..4a7b4a0
--- /dev/null
+++ b/example.scm
@@ -0,0 +1,137 @@
+;From Revised^4 Report on the Algorithmic Language Scheme
+;William Clinger and Jonathon Rees (Editors)
+
+;			       EXAMPLE
+
+;INTEGRATE-SYSTEM integrates the system 
+;	y_k' = f_k(y_1, y_2, ..., y_n), k = 1, ..., n
+;of differential equations with the method of Runge-Kutta.
+
+;The parameter SYSTEM-DERIVATIVE is a function that takes a system
+;state (a vector of values for the state variables y_1, ..., y_n) and
+;produces a system derivative (the values y_1', ..., y_n').  The
+;parameter INITIAL-STATE provides an initial system state, and H is an
+;initial guess for the length of the integration step.
+
+;The value returned by INTEGRATE-SYSTEM is an infinite stream of
+;system states.
+
+(define integrate-system
+  (lambda (system-derivative initial-state h)
+    (let ((next (runge-kutta-4 system-derivative h)))
+      (letrec ((states
+		(cons initial-state
+		      (delay (map-streams next states)))))
+	states))))
+
+;RUNGE-KUTTA-4 takes a function, F, that produces a
+;system derivative from a system state.  RUNGE-KUTTA-4
+;produces a function that takes a system state and
+;produces a new system state.
+
+(define runge-kutta-4
+  (lambda (f h)
+    (let ((*h (scale-vector h))
+	  (*2 (scale-vector 2))
+	  (*1/2 (scale-vector (/ 1 2)))
+	  (*1/6 (scale-vector (/ 1 6))))
+      (lambda (y)
+	;; Y is a system state
+	(let* ((k0 (*h (f y)))
+	       (k1 (*h (f (add-vectors y (*1/2 k0)))))
+	       (k2 (*h (f (add-vectors y (*1/2 k1)))))
+	       (k3 (*h (f (add-vectors y k2)))))
+	  (add-vectors y
+		       (*1/6 (add-vectors k0
+					  (*2 k1)
+					  (*2 k2)
+					  k3))))))))
+
+(define elementwise
+  (lambda (f)
+    (lambda vectors
+      (generate-vector
+       (vector-length (car vectors))
+       (lambda (i)
+	 (apply f
+		(map (lambda (v) (vector-ref  v i))
+		     vectors)))))))
+
+(define generate-vector
+  (lambda (size proc)
+    (let ((ans (make-vector size)))
+      (letrec ((loop
+		(lambda (i)
+		  (cond ((= i size) ans)
+			(else
+			 (vector-set! ans i (proc i))
+			 (loop (+ i 1)))))))
+	(loop 0)))))
+
+(define add-vectors (elementwise +))
+
+(define scale-vector
+  (lambda (s)
+    (elementwise (lambda (x) (* x s)))))
+
+;MAP-STREAMS is analogous to MAP: it applies its first
+;argument (a procedure) to all the elements of its second argument (a
+;stream).
+
+(define map-streams
+  (lambda (f s)
+    (cons (f (head s))
+	  (delay (map-streams f (tail s))))))
+
+;Infinite streams are implemented as pairs whose car holds the first
+;element of the stream and whose cdr holds a promise to deliver the rest
+;of the stream.
+
+(define head car)
+(define tail
+  (lambda (stream) (force (cdr stream))))
+
+
+;The following illustrates the use of INTEGRATE-SYSTEM in
+;integrating the system
+;
+;			     dvC	vC
+;			   C --- = -i - --
+;			     dt	     L	 R
+;
+;				diL
+;			      L --- = v
+;				dt     C
+;
+;which models a damped oscillator.
+
+(define damped-oscillator
+  (lambda (R L C)
+    (lambda (state)
+      (let ((Vc (vector-ref state 0))
+	    (Il (vector-ref state 1)))
+	(vector (- 0 (+ (/ Vc (* R C)) (/ Il C)))
+		(/ Vc L))))))
+
+(define the-states
+  (integrate-system
+   (damped-oscillator 10000 1000 .001)
+   '#(1 0)
+   .01))
+
+(do ((i 10 (- i 1))
+     (s the-states (tail s)))
+    ((zero? i) (newline))
+  (newline)
+  (write (head s)))
+
+; #(1 0)
+; #(0.99895054 9.994835e-6)
+; #(0.99780226 1.9978681e-5)
+; #(0.9965554 2.9950552e-5)
+; #(0.9952102 3.990946e-5)
+; #(0.99376684 4.985443e-5)
+; #(0.99222565 5.9784474e-5)
+; #(0.9905868 6.969862e-5)
+; #(0.9888506 7.9595884e-5)
+; #(0.9870173 8.94753e-5)
diff --git a/findexec.c b/findexec.c
new file mode 100644
index 0000000..bbeac76
--- /dev/null
+++ b/findexec.c
@@ -0,0 +1,145 @@
+/* This file was part of DLD, a dynamic link/unlink editor for C.
+
+   Copyright (C) 1990 by W. Wilson Ho.
+
+   The author can be reached electronically by how@cs.ucdavis.edu or
+   through physical mail at:
+
+   W. Wilson Ho
+   Division of Computer Science
+   University of California at Davis
+   Davis, CA 95616
+
+Fri Sep 14 22:16:14 1990  Edgar Roeder  (edgar at megamaster)
+
+	* added a separate DLDPATH environment variable in
+	dld_find_executable so that users may specify a special path
+	for object modules.
+
+Thu Feb  3 01:46:16 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* find_exec.c (dld_find_executable): added stat check for
+	linux so that it doesn't think directories with the same name
+	as the program are executable.
+
+Wed Feb 21 23:06:35 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* find_exec.c: extracted for general use.  Generalized to
+	MS-DOS.  */
+
+/* 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. */
+
+/* Given a filename, dld_find_executable searches the directories
+   listed in the environment variable PATH for a file with that
+   filename.  A new copy of the complete path name of that file is
+   returned.  This new string may be disposed by free() later on.  */
+
+#include <sys/file.h>
+#include <sys/param.h>
+#ifdef linux
+# include <stdlib.h>
+# include <sys/stat.h>
+# include <unistd.h>     /* for X_OK define */
+#endif
+#ifdef __svr4__
+# include <string.h>
+# include <stdlib.h>
+# include <sys/stat.h>
+# include <unistd.h>     /* for X_OK define */
+#else
+# ifdef __sgi__
+#  include <string.h>
+#  include <stdlib.h>
+#  include <sys/stat.h>
+#  include <unistd.h>     /* for X_OK define */
+# else
+#  include <strings.h>
+# endif
+#endif
+#ifndef __STDC__
+# define const /**/
+#endif
+
+#ifndef DEFAULT_PATH
+# define DEFAULT_PATH ".:~/bin::/usr/local/bin:/usr/new:/usr/ucb:/usr/bin:/bin:/usr/hosts"
+#endif
+
+static char *copy_of(s)
+     register const char *s;
+{
+  register char *p = (char *) malloc(strlen(s)+1);
+  if (!p) return 0;
+  *p = 0;
+  strcpy(p, s);
+  return p;
+}
+
+/* ABSOLUTE_FILENAME_P(fname): True if fname is an absolute filename */
+#ifdef atarist
+# define ABSOLUTE_FILENAME_P(fname)	((fname[0] == '/') || \
+	(fname[0] && (fname[1] == ':')))
+#else
+# define ABSOLUTE_FILENAME_P(fname)	(fname[0] == '/')
+#endif /* atarist */
+
+char *dld_find_executable(name)
+     const char *name;
+{
+  char *search;
+  register char *p;
+  char tbuf[MAXPATHLEN];
+
+  if (ABSOLUTE_FILENAME_P(name))
+    return copy_of(name);
+
+  if ((name[0] == '.') && (name[1] == '/')) {
+    getcwd(tbuf, MAXPATHLEN);
+    strcat(tbuf, name + 1);
+    return copy_of(tbuf);
+  }
+
+  if (((search = (char *) getenv("DLDPATH")) == 0) &&
+      ((search = (char *) getenv("PATH")) == 0))
+    search = DEFAULT_PATH;
+
+  p = search;
+
+  while (*p) {
+    register char *next = tbuf;
+
+    if (p[0]=='~' && p[1]=='/' && getenv("HOME")) {
+      strcpy(tbuf, (char *)getenv("HOME"));
+      next = tbuf + strlen(tbuf);
+      p++;
+    }
+
+    /* Copy directory name into [tbuf] */
+    while (*p && *p != ':') *next++ = *p++;
+    *next = 0;
+    if (*p) p++;
+
+    if (tbuf[0] == '.' && tbuf[1] == 0)
+      getcwd(tbuf, MAXPATHLEN);	/* was getwd(tbuf); */
+    else if (tbuf[0]=='~' && tbuf[1]==0 && getenv("HOME"))
+      strcpy(tbuf, (char *)getenv("HOME"));
+
+    strcat(tbuf, "/");
+    strcat(tbuf, name);
+
+    if (access(tbuf, X_OK) == 0) {
+#ifndef hpux
+# ifndef ultrix
+      struct stat stat_temp;
+      if (stat(tbuf,&stat_temp)) continue;
+      if (S_IFREG != (S_IFMT & stat_temp.st_mode)) continue;
+# endif/* ultrix */
+#endif /* hpux */
+      return copy_of(tbuf);
+    }
+  }
+
+  return 0;
+}
diff --git a/gmalloc.c b/gmalloc.c
new file mode 100644
index 0000000..59874ee
--- /dev/null
+++ b/gmalloc.c
@@ -0,0 +1,1638 @@
+/* DO NOT EDIT THIS FILE -- it is automagically generated.  -*- C -*- */
+
+#define _MALLOC_INTERNAL
+
+/* The malloc headers and source files from the C library follow here.  */
+
+/* Declarations for `malloc' and friends.
+   Copyright 1990, 91, 92, 93, 95, 96 Free Software Foundation, Inc.
+		  Written May 1989 by Mike Haertel.
+
+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; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 675 Mass Ave,
+Cambridge, MA 02139, USA.
+
+   The author may be reached (Email) at the address mike@ai.mit.edu,
+   or (US mail) as Mike Haertel c/o Free Software Foundation.  */
+
+#ifndef _MALLOC_H
+
+#define _MALLOC_H	1
+
+#ifdef _MALLOC_INTERNAL
+
+#ifdef	HAVE_CONFIG_H
+#include <config.h>
+#endif
+
+#if defined (__cplusplus) || (defined (__STDC__) && __STDC__)
+#undef	__P
+#define	__P(args)	args
+#undef	__ptr_t
+#define	__ptr_t		void *
+#else /* Not C++ or ANSI C.  */
+#undef	__P
+#define	__P(args)	()
+#undef	const
+#define	const
+#undef	__ptr_t
+#define	__ptr_t		char *
+#endif /* C++ or ANSI C.  */
+
+#if	defined(_LIBC) || defined(STDC_HEADERS) || defined(USG)
+#include <string.h>
+#else
+#ifndef memset
+#define	memset(s, zero, n)	bzero ((s), (n))
+#endif
+#ifndef memcpy
+#define	memcpy(d, s, n)		bcopy ((s), (d), (n))
+#endif
+#endif
+
+#if	defined (__GNU_LIBRARY__) || (defined (__STDC__) && __STDC__)
+#include <limits.h>
+#else
+#ifndef CHAR_BIT
+#define	CHAR_BIT	8
+#endif
+#endif
+
+#ifdef	HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+
+#endif	/* _MALLOC_INTERNAL.  */
+
+
+#ifdef	__cplusplus
+extern "C"
+{
+#endif
+
+#if defined (__STDC__) && __STDC__
+#include <stddef.h>
+#define	__malloc_size_t		size_t
+#define	__malloc_ptrdiff_t	ptrdiff_t
+#else
+#define	__malloc_size_t		unsigned int
+#define	__malloc_ptrdiff_t	int
+#endif
+
+#ifndef	NULL
+#define	NULL	0
+#endif
+
+
+/* Allocate SIZE bytes of memory.  */
+extern __ptr_t malloc __P ((__malloc_size_t __size));
+/* Re-allocate the previously allocated block
+   in __ptr_t, making the new block SIZE bytes long.  */
+extern __ptr_t realloc __P ((__ptr_t __ptr, __malloc_size_t __size));
+/* Allocate NMEMB elements of SIZE bytes each, all initialized to 0.  */
+extern __ptr_t calloc __P ((__malloc_size_t __nmemb, __malloc_size_t __size));
+/* Free a block allocated by `malloc', `realloc' or `calloc'.  */
+extern void free __P ((__ptr_t __ptr));
+
+/* Allocate SIZE bytes allocated to ALIGNMENT bytes.  */
+#if ! (defined (_MALLOC_INTERNAL) && __DJGPP__ - 0 == 1) /* Avoid conflict.  */
+extern __ptr_t memalign __P ((__malloc_size_t __alignment,
+			      __malloc_size_t __size));
+#endif
+
+/* Allocate SIZE bytes on a page boundary.  */
+#if ! (defined (_MALLOC_INTERNAL) && defined (GMALLOC_INHIBIT_VALLOC))
+extern __ptr_t valloc __P ((__malloc_size_t __size));
+#endif
+
+
+#ifdef _MALLOC_INTERNAL
+
+/* The allocator divides the heap into blocks of fixed size; large
+   requests receive one or more whole blocks, and small requests
+   receive a fragment of a block.  Fragment sizes are powers of two,
+   and all fragments of a block are the same size.  When all the
+   fragments in a block have been freed, the block itself is freed.  */
+#define INT_BIT		(CHAR_BIT * sizeof(int))
+#define BLOCKLOG	(INT_BIT > 16 ? 12 : 9)
+#define BLOCKSIZE	(1 << BLOCKLOG)
+#define BLOCKIFY(SIZE)	(((SIZE) + BLOCKSIZE - 1) / BLOCKSIZE)
+
+/* Determine the amount of memory spanned by the initial heap table
+   (not an absolute limit).  */
+#define HEAP		(INT_BIT > 16 ? 4194304 : 65536)
+
+/* Number of contiguous free blocks allowed to build up at the end of
+   memory before they will be returned to the system.  */
+#define FINAL_FREE_BLOCKS	8
+
+/* Data structure giving per-block information.  */
+typedef union
+  {
+    /* Heap information for a busy block.  */
+    struct
+      {
+	/* Zero for a large (multiblock) object, or positive giving the
+	   logarithm to the base two of the fragment size.  */
+	int type;
+	union
+	  {
+	    struct
+	      {
+		__malloc_size_t nfree; /* Free frags in a fragmented block.  */
+		__malloc_size_t first; /* First free fragment of the block.  */
+	      } frag;
+	    /* For a large object, in its first block, this has the number
+	       of blocks in the object.  In the other blocks, this has a
+	       negative number which says how far back the first block is.  */
+	    __malloc_ptrdiff_t size;
+	  } info;
+      } busy;
+    /* Heap information for a free block
+       (that may be the first of a free cluster).  */
+    struct
+      {
+	__malloc_size_t size;	/* Size (in blocks) of a free cluster.  */
+	__malloc_size_t next;	/* Index of next free cluster.  */
+	__malloc_size_t prev;	/* Index of previous free cluster.  */
+      } free;
+  } malloc_info;
+
+/* Pointer to first block of the heap.  */
+extern char *_heapbase;
+
+/* Table indexed by block number giving per-block information.  */
+extern malloc_info *_heapinfo;
+
+/* Address to block number and vice versa.  */
+#define BLOCK(A)	(((char *) (A) - _heapbase) / BLOCKSIZE + 1)
+#define ADDRESS(B)	((__ptr_t) (((B) - 1) * BLOCKSIZE + _heapbase))
+
+/* Current search index for the heap table.  */
+extern __malloc_size_t _heapindex;
+
+/* Limit of valid info table indices.  */
+extern __malloc_size_t _heaplimit;
+
+/* Doubly linked lists of free fragments.  */
+struct list
+  {
+    struct list *next;
+    struct list *prev;
+  };
+
+/* Free list headers for each fragment size.  */
+extern struct list _fraghead[];
+
+/* List of blocks allocated with `memalign' (or `valloc').  */
+struct alignlist
+  {
+    struct alignlist *next;
+    __ptr_t aligned;		/* The address that memaligned returned.  */
+    __ptr_t exact;		/* The address that malloc returned.  */
+  };
+extern struct alignlist *_aligned_blocks;
+
+/* Instrumentation.  */
+extern __malloc_size_t _chunks_used;
+extern __malloc_size_t _bytes_used;
+extern __malloc_size_t _chunks_free;
+extern __malloc_size_t _bytes_free;
+
+/* Internal versions of `malloc', `realloc', and `free'
+   used when these functions need to call each other.
+   They are the same but don't call the hooks.  */
+extern __ptr_t _malloc_internal __P ((__malloc_size_t __size));
+extern __ptr_t _realloc_internal __P ((__ptr_t __ptr, __malloc_size_t __size));
+extern void _free_internal __P ((__ptr_t __ptr));
+
+#endif /* _MALLOC_INTERNAL.  */
+
+/* Given an address in the middle of a malloc'd object,
+   return the address of the beginning of the object.  */
+extern __ptr_t malloc_find_object_address __P ((__ptr_t __ptr));
+
+/* Underlying allocation function; successive calls should
+   return contiguous pieces of memory.  */
+extern __ptr_t (*__morecore) __P ((__malloc_ptrdiff_t __size));
+
+/* Default value of `__morecore'.  */
+extern __ptr_t __default_morecore __P ((__malloc_ptrdiff_t __size));
+
+/* If not NULL, this function is called after each time
+   `__morecore' is called to increase the data size.  */
+extern void (*__after_morecore_hook) __P ((void));
+
+/* Number of extra blocks to get each time we ask for more core.
+   This reduces the frequency of calling `(*__morecore)'.  */
+extern __malloc_size_t __malloc_extra_blocks;
+
+/* Nonzero if `malloc' has been called and done its initialization.  */
+extern int __malloc_initialized;
+/* Function called to initialize malloc data structures.  */
+extern int __malloc_initialize __P ((void));
+
+/* Hooks for debugging versions.  */
+extern void (*__malloc_initialize_hook) __P ((void));
+extern void (*__free_hook) __P ((__ptr_t __ptr));
+extern __ptr_t (*__malloc_hook) __P ((__malloc_size_t __size));
+extern __ptr_t (*__realloc_hook) __P ((__ptr_t __ptr, __malloc_size_t __size));
+extern __ptr_t (*__memalign_hook) __P ((__malloc_size_t __size,
+					__malloc_size_t __alignment));
+
+/* Return values for `mprobe': these are the kinds of inconsistencies that
+   `mcheck' enables detection of.  */
+enum mcheck_status
+  {
+    MCHECK_DISABLED = -1,	/* Consistency checking is not turned on.  */
+    MCHECK_OK,			/* Block is fine.  */
+    MCHECK_FREE,		/* Block freed twice.  */
+    MCHECK_HEAD,		/* Memory before the block was clobbered.  */
+    MCHECK_TAIL			/* Memory after the block was clobbered.  */
+  };
+
+/* Activate a standard collection of debugging hooks.  This must be called
+   before `malloc' is ever called.  ABORTFUNC is called with an error code
+   (see enum above) when an inconsistency is detected.  If ABORTFUNC is
+   null, the standard function prints on stderr and then calls `abort'.  */
+extern int mcheck __P ((void (*__abortfunc) __P ((enum mcheck_status))));
+
+/* Check for aberrations in a particular malloc'd block.  You must have
+   called `mcheck' already.  These are the same checks that `mcheck' does
+   when you free or reallocate a block.  */
+extern enum mcheck_status mprobe __P ((__ptr_t __ptr));
+
+/* Activate a standard collection of tracing hooks.  */
+extern void mtrace __P ((void));
+extern void muntrace __P ((void));
+
+/* Statistics available to the user.  */
+struct mstats
+  {
+    __malloc_size_t bytes_total; /* Total size of the heap. */
+    __malloc_size_t chunks_used; /* Chunks allocated by the user. */
+    __malloc_size_t bytes_used;	/* Byte total of user-allocated chunks. */
+    __malloc_size_t chunks_free; /* Chunks in the free list. */
+    __malloc_size_t bytes_free;	/* Byte total of chunks in the free list. */
+  };
+
+/* Pick up the current statistics. */
+extern struct mstats mstats __P ((void));
+
+/* Call WARNFUN with a warning message when memory usage is high.  */
+extern void memory_warnings __P ((__ptr_t __start,
+				  void (*__warnfun) __P ((const char *))));
+
+
+/* Relocating allocator.  */
+
+/* Allocate SIZE bytes, and store the address in *HANDLEPTR.  */
+extern __ptr_t r_alloc __P ((__ptr_t *__handleptr, __malloc_size_t __size));
+
+/* Free the storage allocated in HANDLEPTR.  */
+extern void r_alloc_free __P ((__ptr_t *__handleptr));
+
+/* Adjust the block at HANDLEPTR to be SIZE bytes long.  */
+extern __ptr_t r_re_alloc __P ((__ptr_t *__handleptr, __malloc_size_t __size));
+
+
+#ifdef	__cplusplus
+}
+#endif
+
+#endif /* malloc.h  */
+/* Memory allocator `malloc'.
+   Copyright 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
+		  Written May 1989 by Mike Haertel.
+
+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; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 675 Mass Ave,
+Cambridge, MA 02139, USA.
+
+   The author may be reached (Email) at the address mike@ai.mit.edu,
+   or (US mail) as Mike Haertel c/o Free Software Foundation.  */
+
+#ifndef	_MALLOC_INTERNAL
+#define _MALLOC_INTERNAL
+#include <malloc.h>
+#endif
+#include <errno.h>
+
+/* How to really get more memory.  */
+__ptr_t (*__morecore) __P ((ptrdiff_t __size)) = __default_morecore;
+
+/* Debugging hook for `malloc'.  */
+__ptr_t (*__malloc_hook) __P ((__malloc_size_t __size));
+
+/* Pointer to the base of the first block.  */
+char *_heapbase;
+
+/* Block information table.  Allocated with align/__free (not malloc/free).  */
+malloc_info *_heapinfo;
+
+/* Number of info entries.  */
+static __malloc_size_t heapsize;
+
+/* Search index in the info table.  */
+__malloc_size_t _heapindex;
+
+/* Limit of valid info table indices.  */
+__malloc_size_t _heaplimit;
+
+/* Free lists for each fragment size.  */
+struct list _fraghead[BLOCKLOG];
+
+/* Instrumentation.  */
+__malloc_size_t _chunks_used;
+__malloc_size_t _bytes_used;
+__malloc_size_t _chunks_free;
+__malloc_size_t _bytes_free;
+
+/* Are you experienced?  */
+int __malloc_initialized;
+
+__malloc_size_t __malloc_extra_blocks;
+
+void (*__malloc_initialize_hook) __P ((void));
+void (*__after_morecore_hook) __P ((void));
+
+
+/* Aligned allocation.  */
+static __ptr_t align __P ((__malloc_size_t));
+static __ptr_t
+align (size)
+     __malloc_size_t size;
+{
+  __ptr_t result;
+  unsigned long int adj;
+
+  result = (*__morecore) (size);
+  adj = (unsigned long int) ((unsigned long int) ((char *) result -
+						  (char *) NULL)) % BLOCKSIZE;
+  if (adj != 0)
+    {
+      __ptr_t new;
+      adj = BLOCKSIZE - adj;
+      new = (*__morecore) (adj);
+      result = (char *) result + adj;
+    }
+
+  if (__after_morecore_hook)
+    (*__after_morecore_hook) ();
+
+  return result;
+}
+
+/* Get SIZE bytes, if we can get them starting at END.
+   Return the address of the space we got.
+   If we cannot get space at END, fail and return 0.  */
+static __ptr_t get_contiguous_space __P ((__malloc_ptrdiff_t, __ptr_t));
+static __ptr_t
+get_contiguous_space (size, position)
+     __malloc_ptrdiff_t size;
+     __ptr_t position;
+{
+  __ptr_t before;
+  __ptr_t after;
+
+  before = (*__morecore) (0);
+  /* If we can tell in advance that the break is at the wrong place,
+     fail now.  */
+  if (before != position)
+    return 0;
+
+  /* Allocate SIZE bytes and get the address of them.  */
+  after = (*__morecore) (size);
+  if (!after)
+    return 0;
+
+  /* It was not contiguous--reject it.  */
+  if (after != position)
+    {
+      (*__morecore) (- size);
+      return 0;
+    }
+
+  return after;
+}
+
+
+/* This is called when `_heapinfo' and `heapsize' have just
+   been set to describe a new info table.  Set up the table
+   to describe itself and account for it in the statistics.  */
+static void register_heapinfo __P ((void));
+#ifdef __GNUC__
+__inline__
+#endif
+static void
+register_heapinfo ()
+{
+  __malloc_size_t block, blocks;
+
+  block = BLOCK (_heapinfo);
+  blocks = BLOCKIFY (heapsize * sizeof (malloc_info));
+
+  /* Account for the _heapinfo block itself in the statistics.  */
+  _bytes_used += blocks * BLOCKSIZE;
+  ++_chunks_used;
+
+  /* Describe the heapinfo block itself in the heapinfo.  */
+  _heapinfo[block].busy.type = 0;
+  _heapinfo[block].busy.info.size = blocks;
+  /* Leave back-pointers for malloc_find_address.  */
+  while (--blocks > 0)
+    _heapinfo[block + blocks].busy.info.size = -blocks;
+}
+
+/* Set everything up and remember that we have.  */
+int
+__malloc_initialize ()
+{
+  if (__malloc_initialized)
+    return 0;
+
+  if (__malloc_initialize_hook)
+    (*__malloc_initialize_hook) ();
+
+  heapsize = HEAP / BLOCKSIZE;
+  _heapinfo = (malloc_info *) align (heapsize * sizeof (malloc_info));
+  if (_heapinfo == NULL)
+    return 0;
+  memset (_heapinfo, 0, heapsize * sizeof (malloc_info));
+  _heapinfo[0].free.size = 0;
+  _heapinfo[0].free.next = _heapinfo[0].free.prev = 0;
+  _heapindex = 0;
+  _heapbase = (char *) _heapinfo;
+  _heaplimit = BLOCK (_heapbase + heapsize * sizeof (malloc_info));
+
+  register_heapinfo ();
+
+  __malloc_initialized = 1;
+  return 1;
+}
+
+static int morecore_recursing;
+
+/* Get neatly aligned memory, initializing or
+   growing the heap info table as necessary. */
+static __ptr_t morecore __P ((__malloc_size_t));
+static __ptr_t
+morecore (size)
+     __malloc_size_t size;
+{
+  __ptr_t result;
+  malloc_info *newinfo, *oldinfo;
+  __malloc_size_t newsize;
+
+  if (morecore_recursing)
+    /* Avoid recursion.  The caller will know how to handle a null return.  */
+    return NULL;
+
+  result = align (size);
+  if (result == NULL)
+    return NULL;
+
+  /* Check if we need to grow the info table.  */
+  if ((__malloc_size_t) BLOCK ((char *) result + size) > heapsize)
+    {
+      /* Calculate the new _heapinfo table size.  We do not account for the
+	 added blocks in the table itself, as we hope to place them in
+	 existing free space, which is already covered by part of the
+	 existing table.  */
+      newsize = heapsize;
+      do
+	newsize *= 2;
+      while ((__malloc_size_t) BLOCK ((char *) result + size) > newsize);
+
+      /* We must not reuse existing core for the new info table when called
+	 from realloc in the case of growing a large block, because the
+	 block being grown is momentarily marked as free.  In this case
+	 _heaplimit is zero so we know not to reuse space for internal
+	 allocation.  */
+      if (_heaplimit != 0)
+	{
+	  /* First try to allocate the new info table in core we already
+	     have, in the usual way using realloc.  If realloc cannot
+	     extend it in place or relocate it to existing sufficient core,
+	     we will get called again, and the code above will notice the
+	     `morecore_recursing' flag and return null.  */
+	  int save = errno;	/* Don't want to clobber errno with ENOMEM.  */
+	  morecore_recursing = 1;
+	  newinfo = (malloc_info *) _realloc_internal
+	    (_heapinfo, newsize * sizeof (malloc_info));
+	  morecore_recursing = 0;
+	  if (newinfo == NULL)
+	    errno = save;
+	  else
+	    {
+	      /* We found some space in core, and realloc has put the old
+		 table's blocks on the free list.  Now zero the new part
+		 of the table and install the new table location.  */
+	      memset (&newinfo[heapsize], 0,
+		      (newsize - heapsize) * sizeof (malloc_info));
+	      _heapinfo = newinfo;
+	      heapsize = newsize;
+	      goto got_heap;
+	    }
+	}
+
+      /* Allocate new space for the malloc info table.  */
+      while (1)
+  	{
+ 	  newinfo = (malloc_info *) align (newsize * sizeof (malloc_info));
+
+ 	  /* Did it fail?  */
+ 	  if (newinfo == NULL)
+ 	    {
+ 	      (*__morecore) (-size);
+ 	      return NULL;
+ 	    }
+
+ 	  /* Is it big enough to record status for its own space?
+ 	     If so, we win.  */
+ 	  if ((__malloc_size_t) BLOCK ((char *) newinfo
+ 				       + newsize * sizeof (malloc_info))
+ 	      < newsize)
+ 	    break;
+
+ 	  /* Must try again.  First give back most of what we just got.  */
+ 	  (*__morecore) (- newsize * sizeof (malloc_info));
+ 	  newsize *= 2;
+  	}
+
+      /* Copy the old table to the beginning of the new,
+	 and zero the rest of the new table.  */
+      memcpy (newinfo, _heapinfo, heapsize * sizeof (malloc_info));
+      memset (&newinfo[heapsize], 0,
+	      (newsize - heapsize) * sizeof (malloc_info));
+      oldinfo = _heapinfo;
+      _heapinfo = newinfo;
+      heapsize = newsize;
+
+      register_heapinfo ();
+
+      /* Reset _heaplimit so _free_internal never decides
+	 it can relocate or resize the info table.  */
+      _heaplimit = 0;
+      _free_internal (oldinfo);
+
+      /* The new heap limit includes the new table just allocated.  */
+      _heaplimit = BLOCK ((char *) newinfo + heapsize * sizeof (malloc_info));
+      return result;
+    }
+
+ got_heap:
+  _heaplimit = BLOCK ((char *) result + size);
+  return result;
+}
+
+/* Allocate memory from the heap.  */
+__ptr_t
+_malloc_internal (size)
+     __malloc_size_t size;
+{
+  __ptr_t result;
+  __malloc_size_t block, blocks, lastblocks, start;
+  register __malloc_size_t i;
+  struct list *next;
+
+  /* ANSI C allows `malloc (0)' to either return NULL, or to return a
+     valid address you can realloc and free (though not dereference).
+
+     It turns out that some extant code (sunrpc, at least Ultrix's version)
+     expects `malloc (0)' to return non-NULL and breaks otherwise.
+     Be compatible.  */
+
+#if	0
+  if (size == 0)
+    return NULL;
+#endif
+
+  if (size < sizeof (struct list))
+    size = sizeof (struct list);
+
+#ifdef SUNOS_LOCALTIME_BUG
+  if (size < 16)
+    size = 16;
+#endif
+
+  /* Determine the allocation policy based on the request size.  */
+  if (size <= BLOCKSIZE / 2)
+    {
+      /* Small allocation to receive a fragment of a block.
+	 Determine the logarithm to base two of the fragment size. */
+      register __malloc_size_t log = 1;
+      --size;
+      while ((size /= 2) != 0)
+	++log;
+
+      /* Look in the fragment lists for a
+	 free fragment of the desired size. */
+      next = _fraghead[log].next;
+      if (next != NULL)
+	{
+	  /* There are free fragments of this size.
+	     Pop a fragment out of the fragment list and return it.
+	     Update the block's nfree and first counters. */
+	  result = (__ptr_t) next;
+	  next->prev->next = next->next;
+	  if (next->next != NULL)
+	    next->next->prev = next->prev;
+	  block = BLOCK (result);
+	  if (--_heapinfo[block].busy.info.frag.nfree != 0)
+	    _heapinfo[block].busy.info.frag.first = (unsigned long int)
+	      ((unsigned long int) ((char *) next->next - (char *) NULL)
+	       % BLOCKSIZE) >> log;
+
+	  /* Update the statistics.  */
+	  ++_chunks_used;
+	  _bytes_used += 1 << log;
+	  --_chunks_free;
+	  _bytes_free -= 1 << log;
+	}
+      else
+	{
+	  /* No free fragments of the desired size, so get a new block
+	     and break it into fragments, returning the first.  */
+	  result = malloc (BLOCKSIZE);
+	  if (result == NULL)
+	    return NULL;
+
+	  /* Link all fragments but the first into the free list.  */
+	  next = (struct list *) ((char *) result + (1 << log));
+	  next->next = NULL;
+	  next->prev = &_fraghead[log];
+	  _fraghead[log].next = next;
+
+	  for (i = 2; i < (__malloc_size_t) (BLOCKSIZE >> log); ++i)
+	    {
+	      next = (struct list *) ((char *) result + (i << log));
+	      next->next = _fraghead[log].next;
+	      next->prev = &_fraghead[log];
+	      next->prev->next = next;
+	      next->next->prev = next;
+	    }
+
+	  /* Initialize the nfree and first counters for this block.  */
+	  block = BLOCK (result);
+	  _heapinfo[block].busy.type = log;
+	  _heapinfo[block].busy.info.frag.nfree = i - 1;
+	  _heapinfo[block].busy.info.frag.first = i - 1;
+
+	  _chunks_free += (BLOCKSIZE >> log) - 1;
+	  _bytes_free += BLOCKSIZE - (1 << log);
+	  _bytes_used -= BLOCKSIZE - (1 << log);
+	}
+    }
+  else
+    {
+      /* Large allocation to receive one or more blocks.
+	 Search the free list in a circle starting at the last place visited.
+	 If we loop completely around without finding a large enough
+	 space we will have to get more memory from the system.  */
+      blocks = BLOCKIFY (size);
+      start = block = _heapindex;
+      while (_heapinfo[block].free.size < blocks)
+	{
+	  block = _heapinfo[block].free.next;
+	  if (block == start)
+	    {
+	      /* Need to get more from the system.  Get a little extra.  */
+	      __malloc_size_t wantblocks = blocks + __malloc_extra_blocks;
+	      block = _heapinfo[0].free.prev;
+	      lastblocks = _heapinfo[block].free.size;
+	      /* Check to see if the new core will be contiguous with the
+		 final free block; if so we don't need to get as much.  */
+	      if (_heaplimit != 0 && block + lastblocks == _heaplimit &&
+		  /* We can't do this if we will have to make the heap info
+                     table bigger to accomodate the new space.  */
+		  block + wantblocks <= heapsize &&
+		  get_contiguous_space ((wantblocks - lastblocks) * BLOCKSIZE,
+					ADDRESS (block + lastblocks)))
+		{
+ 		  /* We got it contiguously.  Which block we are extending
+		     (the `final free block' referred to above) might have
+		     changed, if it got combined with a freed info table.  */
+ 		  block = _heapinfo[0].free.prev;
+  		  _heapinfo[block].free.size += (wantblocks - lastblocks);
+		  _bytes_free += (wantblocks - lastblocks) * BLOCKSIZE;
+ 		  _heaplimit += wantblocks - lastblocks;
+		  continue;
+		}
+	      result = morecore (wantblocks * BLOCKSIZE);
+	      if (result == NULL)
+		return NULL;
+	      block = BLOCK (result);
+	      /* Put the new block at the end of the free list.  */
+	      _heapinfo[block].free.size = wantblocks;
+	      _heapinfo[block].free.prev = _heapinfo[0].free.prev;
+	      _heapinfo[block].free.next = 0;
+	      _heapinfo[0].free.prev = block;
+	      _heapinfo[_heapinfo[block].free.prev].free.next = block;
+	      ++_chunks_free;
+	      /* Now loop to use some of that block for this allocation.  */
+	    }
+	}
+
+      /* At this point we have found a suitable free list entry.
+	 Figure out how to remove what we need from the list. */
+      result = ADDRESS (block);
+      if (_heapinfo[block].free.size > blocks)
+	{
+	  /* The block we found has a bit left over,
+	     so relink the tail end back into the free list. */
+	  _heapinfo[block + blocks].free.size
+	    = _heapinfo[block].free.size - blocks;
+	  _heapinfo[block + blocks].free.next
+	    = _heapinfo[block].free.next;
+	  _heapinfo[block + blocks].free.prev
+	    = _heapinfo[block].free.prev;
+	  _heapinfo[_heapinfo[block].free.prev].free.next
+	    = _heapinfo[_heapinfo[block].free.next].free.prev
+	    = _heapindex = block + blocks;
+	}
+      else
+	{
+	  /* The block exactly matches our requirements,
+	     so just remove it from the list. */
+	  _heapinfo[_heapinfo[block].free.next].free.prev
+	    = _heapinfo[block].free.prev;
+	  _heapinfo[_heapinfo[block].free.prev].free.next
+	    = _heapindex = _heapinfo[block].free.next;
+	  --_chunks_free;
+	}
+
+      _heapinfo[block].busy.type = 0;
+      _heapinfo[block].busy.info.size = blocks;
+      ++_chunks_used;
+      _bytes_used += blocks * BLOCKSIZE;
+      _bytes_free -= blocks * BLOCKSIZE;
+
+      /* Mark all the blocks of the object just allocated except for the
+	 first with a negative number so you can find the first block by
+	 adding that adjustment.  */
+      while (--blocks > 0)
+	_heapinfo[block + blocks].busy.info.size = -blocks;
+    }
+
+  return result;
+}
+
+__ptr_t
+malloc (size)
+     __malloc_size_t size;
+{
+  if (!__malloc_initialized && !__malloc_initialize ())
+    return NULL;
+
+  return (__malloc_hook != NULL ? *__malloc_hook : _malloc_internal) (size);
+}
+
+#ifndef _LIBC
+
+/* On some ANSI C systems, some libc functions call _malloc, _free
+   and _realloc.  Make them use the GNU functions.  */
+
+__ptr_t
+_malloc (size)
+     __malloc_size_t size;
+{
+  return malloc (size);
+}
+
+void
+_free (ptr)
+     __ptr_t ptr;
+{
+  free (ptr);
+}
+
+__ptr_t
+_realloc (ptr, size)
+     __ptr_t ptr;
+     __malloc_size_t size;
+{
+  return realloc (ptr, size);
+}
+
+#endif
+/* Free a block of memory allocated by `malloc'.
+   Copyright 1990, 1991, 1992, 1994, 1995 Free Software Foundation, Inc.
+		  Written May 1989 by Mike Haertel.
+
+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; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 675 Mass Ave,
+Cambridge, MA 02139, USA.
+
+   The author may be reached (Email) at the address mike@ai.mit.edu,
+   or (US mail) as Mike Haertel c/o Free Software Foundation.  */
+
+#ifndef	_MALLOC_INTERNAL
+#define _MALLOC_INTERNAL
+#include <malloc.h>
+#endif
+
+
+/* Cope with systems lacking `memmove'.    */
+#ifndef memmove
+#if  (defined (MEMMOVE_MISSING) || \
+      !defined(_LIBC) && !defined(STDC_HEADERS) && !defined(USG))
+#ifdef emacs
+#undef	__malloc_safe_bcopy
+#define __malloc_safe_bcopy safe_bcopy
+#endif
+/* This function is defined in realloc.c.  */
+extern void __malloc_safe_bcopy __P ((__ptr_t, __ptr_t, __malloc_size_t));
+#define memmove(to, from, size)	__malloc_safe_bcopy ((from), (to), (size))
+#endif
+#endif
+
+
+/* Debugging hook for free.  */
+void (*__free_hook) __P ((__ptr_t __ptr));
+
+/* List of blocks allocated by memalign.  */
+struct alignlist *_aligned_blocks = NULL;
+
+/* Return memory to the heap.
+   Like `free' but don't call a __free_hook if there is one.  */
+void
+_free_internal (ptr)
+     __ptr_t ptr;
+{
+  int type;
+  __malloc_size_t block, blocks;
+  register __malloc_size_t i;
+  struct list *prev, *next;
+  __ptr_t curbrk;
+  const __malloc_size_t lesscore_threshold
+    /* Threshold of free space at which we will return some to the system.  */
+    = FINAL_FREE_BLOCKS + 2 * __malloc_extra_blocks;
+
+  register struct alignlist *l;
+
+  if (ptr == NULL)
+    return;
+
+  for (l = _aligned_blocks; l != NULL; l = l->next)
+    if (l->aligned == ptr)
+      {
+	l->aligned = NULL;	/* Mark the slot in the list as free.  */
+	ptr = l->exact;
+	break;
+      }
+
+  block = BLOCK (ptr);
+
+  type = _heapinfo[block].busy.type;
+  switch (type)
+    {
+    case 0:
+      /* Get as many statistics as early as we can.  */
+      --_chunks_used;
+      _bytes_used -= _heapinfo[block].busy.info.size * BLOCKSIZE;
+      _bytes_free += _heapinfo[block].busy.info.size * BLOCKSIZE;
+
+      /* Find the free cluster previous to this one in the free list.
+	 Start searching at the last block referenced; this may benefit
+	 programs with locality of allocation.  */
+      i = _heapindex;
+      if (i > block)
+	while (i > block)
+	  i = _heapinfo[i].free.prev;
+      else
+	{
+	  do
+	    i = _heapinfo[i].free.next;
+	  while (i > 0 && i < block);
+	  i = _heapinfo[i].free.prev;
+	}
+
+      /* Determine how to link this block into the free list.  */
+      if (block == i + _heapinfo[i].free.size)
+	{
+	  /* Coalesce this block with its predecessor.  */
+	  _heapinfo[i].free.size += _heapinfo[block].busy.info.size;
+	  block = i;
+	}
+      else
+	{
+	  /* Really link this block back into the free list.  */
+	  _heapinfo[block].free.size = _heapinfo[block].busy.info.size;
+	  _heapinfo[block].free.next = _heapinfo[i].free.next;
+	  _heapinfo[block].free.prev = i;
+	  _heapinfo[i].free.next = block;
+	  _heapinfo[_heapinfo[block].free.next].free.prev = block;
+	  ++_chunks_free;
+	}
+
+      /* Now that the block is linked in, see if we can coalesce it
+	 with its successor (by deleting its successor from the list
+	 and adding in its size).  */
+      if (block + _heapinfo[block].free.size == _heapinfo[block].free.next)
+	{
+	  _heapinfo[block].free.size
+	    += _heapinfo[_heapinfo[block].free.next].free.size;
+	  _heapinfo[block].free.next
+	    = _heapinfo[_heapinfo[block].free.next].free.next;
+	  _heapinfo[_heapinfo[block].free.next].free.prev = block;
+	  --_chunks_free;
+	}
+
+      /* How many trailing free blocks are there now?  */
+      blocks = _heapinfo[block].free.size;
+
+      /* Where is the current end of accessible core?  */
+      curbrk = (*__morecore) (0);
+
+      if (_heaplimit != 0 && curbrk == ADDRESS (_heaplimit))
+	{
+	  /* The end of the malloc heap is at the end of accessible core.
+	     It's possible that moving _heapinfo will allow us to
+	     return some space to the system.  */
+
+ 	  __malloc_size_t info_block = BLOCK (_heapinfo);
+ 	  __malloc_size_t info_blocks = _heapinfo[info_block].busy.info.size;
+ 	  __malloc_size_t prev_block = _heapinfo[block].free.prev;
+ 	  __malloc_size_t prev_blocks = _heapinfo[prev_block].free.size;
+ 	  __malloc_size_t next_block = _heapinfo[block].free.next;
+ 	  __malloc_size_t next_blocks = _heapinfo[next_block].free.size;
+
+	  if (/* Win if this block being freed is last in core, the info table
+		 is just before it, the previous free block is just before the
+		 info table, and the two free blocks together form a useful
+		 amount to return to the system.  */
+	      (block + blocks == _heaplimit &&
+	       info_block + info_blocks == block &&
+	       prev_block != 0 && prev_block + prev_blocks == info_block &&
+	       blocks + prev_blocks >= lesscore_threshold) ||
+	      /* Nope, not the case.  We can also win if this block being
+		 freed is just before the info table, and the table extends
+		 to the end of core or is followed only by a free block,
+		 and the total free space is worth returning to the system.  */
+	      (block + blocks == info_block &&
+	       ((info_block + info_blocks == _heaplimit &&
+		 blocks >= lesscore_threshold) ||
+		(info_block + info_blocks == next_block &&
+		 next_block + next_blocks == _heaplimit &&
+		 blocks + next_blocks >= lesscore_threshold)))
+	      )
+	    {
+	      malloc_info *newinfo;
+	      __malloc_size_t oldlimit = _heaplimit;
+
+	      /* Free the old info table, clearing _heaplimit to avoid
+		 recursion into this code.  We don't want to return the
+		 table's blocks to the system before we have copied them to
+		 the new location.  */
+	      _heaplimit = 0;
+	      _free_internal (_heapinfo);
+	      _heaplimit = oldlimit;
+
+	      /* Tell malloc to search from the beginning of the heap for
+		 free blocks, so it doesn't reuse the ones just freed.  */
+	      _heapindex = 0;
+
+	      /* Allocate new space for the info table and move its data.  */
+	      newinfo = (malloc_info *) _malloc_internal (info_blocks
+							  * BLOCKSIZE);
+	      memmove (newinfo, _heapinfo, info_blocks * BLOCKSIZE);
+	      _heapinfo = newinfo;
+
+	      /* We should now have coalesced the free block with the
+		 blocks freed from the old info table.  Examine the entire
+		 trailing free block to decide below whether to return some
+		 to the system.  */
+	      block = _heapinfo[0].free.prev;
+	      blocks = _heapinfo[block].free.size;
+ 	    }
+
+	  /* Now see if we can return stuff to the system.  */
+	  if (block + blocks == _heaplimit && blocks >= lesscore_threshold)
+	    {
+	      register __malloc_size_t bytes = blocks * BLOCKSIZE;
+	      _heaplimit -= blocks;
+	      (*__morecore) (-bytes);
+	      _heapinfo[_heapinfo[block].free.prev].free.next
+		= _heapinfo[block].free.next;
+	      _heapinfo[_heapinfo[block].free.next].free.prev
+		= _heapinfo[block].free.prev;
+	      block = _heapinfo[block].free.prev;
+	      --_chunks_free;
+	      _bytes_free -= bytes;
+	    }
+	}
+
+      /* Set the next search to begin at this block.  */
+      _heapindex = block;
+      break;
+
+    default:
+      /* Do some of the statistics.  */
+      --_chunks_used;
+      _bytes_used -= 1 << type;
+      ++_chunks_free;
+      _bytes_free += 1 << type;
+
+      /* Get the address of the first free fragment in this block.  */
+      prev = (struct list *) ((char *) ADDRESS (block) +
+			      (_heapinfo[block].busy.info.frag.first << type));
+
+      if (_heapinfo[block].busy.info.frag.nfree == (BLOCKSIZE >> type) - 1)
+	{
+	  /* If all fragments of this block are free, remove them
+	     from the fragment list and free the whole block.  */
+	  next = prev;
+	  for (i = 1; i < (__malloc_size_t) (BLOCKSIZE >> type); ++i)
+	    next = next->next;
+	  prev->prev->next = next;
+	  if (next != NULL)
+	    next->prev = prev->prev;
+	  _heapinfo[block].busy.type = 0;
+	  _heapinfo[block].busy.info.size = 1;
+
+	  /* Keep the statistics accurate.  */
+	  ++_chunks_used;
+	  _bytes_used += BLOCKSIZE;
+	  _chunks_free -= BLOCKSIZE >> type;
+	  _bytes_free -= BLOCKSIZE;
+
+	  free (ADDRESS (block));
+	}
+      else if (_heapinfo[block].busy.info.frag.nfree != 0)
+	{
+	  /* If some fragments of this block are free, link this
+	     fragment into the fragment list after the first free
+	     fragment of this block. */
+	  next = (struct list *) ptr;
+	  next->next = prev->next;
+	  next->prev = prev;
+	  prev->next = next;
+	  if (next->next != NULL)
+	    next->next->prev = next;
+	  ++_heapinfo[block].busy.info.frag.nfree;
+	}
+      else
+	{
+	  /* No fragments of this block are free, so link this
+	     fragment into the fragment list and announce that
+	     it is the first free fragment of this block. */
+	  prev = (struct list *) ptr;
+	  _heapinfo[block].busy.info.frag.nfree = 1;
+	  _heapinfo[block].busy.info.frag.first = (unsigned long int)
+	    ((unsigned long int) ((char *) ptr - (char *) NULL)
+	     % BLOCKSIZE >> type);
+	  prev->next = _fraghead[type].next;
+	  prev->prev = &_fraghead[type];
+	  prev->prev->next = prev;
+	  if (prev->next != NULL)
+	    prev->next->prev = prev;
+	}
+      break;
+    }
+}
+
+/* Return memory to the heap.  */
+void
+free (ptr)
+     __ptr_t ptr;
+{
+  if (__free_hook != NULL)
+    (*__free_hook) (ptr);
+  else
+    _free_internal (ptr);
+}
+
+/* Define the `cfree' alias for `free'.  */
+#ifdef weak_alias
+weak_alias (free, cfree)
+#else
+void
+cfree (ptr)
+     __ptr_t ptr;
+{
+  free (ptr);
+}
+#endif
+/* Change the size of a block allocated by `malloc'.
+   Copyright 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
+		     Written May 1989 by Mike Haertel.
+
+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; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 675 Mass Ave,
+Cambridge, MA 02139, USA.
+
+   The author may be reached (Email) at the address mike@ai.mit.edu,
+   or (US mail) as Mike Haertel c/o Free Software Foundation.  */
+
+#ifndef	_MALLOC_INTERNAL
+#define _MALLOC_INTERNAL
+#include <malloc.h>
+#endif
+
+
+
+/* Cope with systems lacking `memmove'.    */
+#if  (defined (MEMMOVE_MISSING) || \
+      !defined(_LIBC) && !defined(STDC_HEADERS) && !defined(USG))
+
+#ifdef emacs
+#undef	__malloc_safe_bcopy
+#define __malloc_safe_bcopy safe_bcopy
+#else
+
+/* Snarfed directly from Emacs src/dispnew.c:
+   XXX Should use system bcopy if it handles overlap.  */
+
+/* Like bcopy except never gets confused by overlap.  */
+
+void
+__malloc_safe_bcopy (afrom, ato, size)
+     __ptr_t afrom;
+     __ptr_t ato;
+     __malloc_size_t size;
+{
+  char *from = afrom, *to = ato;
+
+  if (size <= 0 || from == to)
+    return;
+
+  /* If the source and destination don't overlap, then bcopy can
+     handle it.  If they do overlap, but the destination is lower in
+     memory than the source, we'll assume bcopy can handle that.  */
+  if (to < from || from + size <= to)
+    bcopy (from, to, size);
+
+  /* Otherwise, we'll copy from the end.  */
+  else
+    {
+      register char *endf = from + size;
+      register char *endt = to + size;
+
+      /* If TO - FROM is large, then we should break the copy into
+	 nonoverlapping chunks of TO - FROM bytes each.  However, if
+	 TO - FROM is small, then the bcopy function call overhead
+	 makes this not worth it.  The crossover point could be about
+	 anywhere.  Since I don't think the obvious copy loop is too
+	 bad, I'm trying to err in its favor.  */
+      if (to - from < 64)
+	{
+	  do
+	    *--endt = *--endf;
+	  while (endf != from);
+	}
+      else
+	{
+	  for (;;)
+	    {
+	      endt -= (to - from);
+	      endf -= (to - from);
+
+	      if (endt < to)
+		break;
+
+	      bcopy (endf, endt, to - from);
+	    }
+
+	  /* If SIZE wasn't a multiple of TO - FROM, there will be a
+	     little left over.  The amount left over is
+	     (endt + (to - from)) - to, which is endt - from.  */
+	  bcopy (from, to, endt - from);
+	}
+    }
+}
+#endif /* emacs */
+
+#ifndef memmove
+extern void __malloc_safe_bcopy __P ((__ptr_t, __ptr_t, __malloc_size_t));
+#define memmove(to, from, size) __malloc_safe_bcopy ((from), (to), (size))
+#endif
+
+#endif
+
+
+#define min(A, B) ((A) < (B) ? (A) : (B))
+
+/* Debugging hook for realloc.  */
+__ptr_t (*__realloc_hook) __P ((__ptr_t __ptr, __malloc_size_t __size));
+
+/* Resize the given region to the new size, returning a pointer
+   to the (possibly moved) region.  This is optimized for speed;
+   some benchmarks seem to indicate that greater compactness is
+   achieved by unconditionally allocating and copying to a
+   new region.  This module has incestuous knowledge of the
+   internals of both free and malloc. */
+__ptr_t
+_realloc_internal (ptr, size)
+     __ptr_t ptr;
+     __malloc_size_t size;
+{
+  __ptr_t result;
+  int type;
+  __malloc_size_t block, blocks, oldlimit;
+
+  if (size == 0)
+    {
+      _free_internal (ptr);
+      return _malloc_internal (0);
+    }
+  else if (ptr == NULL)
+    return _malloc_internal (size);
+
+  block = BLOCK (ptr);
+
+  type = _heapinfo[block].busy.type;
+  switch (type)
+    {
+    case 0:
+      /* Maybe reallocate a large block to a small fragment.  */
+      if (size <= BLOCKSIZE / 2)
+	{
+	  result = _malloc_internal (size);
+	  if (result != NULL)
+	    {
+	      memcpy (result, ptr, size);
+	      _free_internal (ptr);
+	      return result;
+	    }
+	}
+
+      /* The new size is a large allocation as well;
+	 see if we can hold it in place. */
+      blocks = BLOCKIFY (size);
+      if (blocks < _heapinfo[block].busy.info.size)
+	{
+	  /* The new size is smaller; return
+	     excess memory to the free list. */
+	  _heapinfo[block + blocks].busy.type = 0;
+	  _heapinfo[block + blocks].busy.info.size
+	    = _heapinfo[block].busy.info.size - blocks;
+	  _heapinfo[block].busy.info.size = blocks;
+	  /* We have just created a new chunk by splitting a chunk in two.
+	     Now we will free this chunk; increment the statistics counter
+	     so it doesn't become wrong when _free_internal decrements it.  */
+	  ++_chunks_used;
+	  _free_internal (ADDRESS (block + blocks));
+	  result = ptr;
+	}
+      else if (blocks == _heapinfo[block].busy.info.size)
+	/* No size change necessary.  */
+	result = ptr;
+      else
+	{
+	  /* Won't fit, so allocate a new region that will.
+	     Free the old region first in case there is sufficient
+	     adjacent free space to grow without moving. */
+	  blocks = _heapinfo[block].busy.info.size;
+	  /* Prevent free from actually returning memory to the system.  */
+	  oldlimit = _heaplimit;
+	  _heaplimit = 0;
+	  _free_internal (ptr);
+	  result = _malloc_internal (size);
+	  if (_heaplimit == 0)
+	    _heaplimit = oldlimit;
+	  if (result == NULL)
+	    {
+	      /* Now we're really in trouble.  We have to unfree
+		 the thing we just freed.  Unfortunately it might
+		 have been coalesced with its neighbors.  */
+	      if (_heapindex == block)
+	        (void) _malloc_internal (blocks * BLOCKSIZE);
+	      else
+		{
+		  __ptr_t previous
+		    = _malloc_internal ((block - _heapindex) * BLOCKSIZE);
+		  (void) _malloc_internal (blocks * BLOCKSIZE);
+		  _free_internal (previous);
+		}
+	      return NULL;
+	    }
+	  if (ptr != result)
+	    memmove (result, ptr, blocks * BLOCKSIZE);
+	}
+      break;
+
+    default:
+      /* Old size is a fragment; type is logarithm
+	 to base two of the fragment size.  */
+      if (size > (__malloc_size_t) (1 << (type - 1)) &&
+	  size <= (__malloc_size_t) (1 << type))
+	/* The new size is the same kind of fragment.  */
+	result = ptr;
+      else
+	{
+	  /* The new size is different; allocate a new space,
+	     and copy the lesser of the new size and the old. */
+	  result = _malloc_internal (size);
+	  if (result == NULL)
+	    return NULL;
+	  memcpy (result, ptr, min (size, (__malloc_size_t) 1 << type));
+	  _free_internal (ptr);
+	}
+      break;
+    }
+
+  return result;
+}
+
+__ptr_t
+realloc (ptr, size)
+     __ptr_t ptr;
+     __malloc_size_t size;
+{
+  if (!__malloc_initialized && !__malloc_initialize ())
+    return NULL;
+
+  return (__realloc_hook != NULL ? *__realloc_hook : _realloc_internal)
+    (ptr, size);
+}
+/* Copyright (C) 1991, 1992, 1994 Free Software Foundation, Inc.
+
+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; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 675 Mass Ave,
+Cambridge, MA 02139, USA.
+
+   The author may be reached (Email) at the address mike@ai.mit.edu,
+   or (US mail) as Mike Haertel c/o Free Software Foundation.  */
+
+#ifndef	_MALLOC_INTERNAL
+#define	_MALLOC_INTERNAL
+#include <malloc.h>
+#endif
+
+/* Allocate an array of NMEMB elements each SIZE bytes long.
+   The entire array is initialized to zeros.  */
+__ptr_t
+calloc (nmemb, size)
+     register __malloc_size_t nmemb;
+     register __malloc_size_t size;
+{
+  register __ptr_t result = malloc (nmemb * size);
+
+  if (result != NULL)
+    (void) memset (result, 0, nmemb * size);
+
+  return result;
+}
+/* Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
+This file is part of the GNU C Library.
+
+The GNU C Library 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.
+
+The GNU C Library is distributed in the hope that 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 the GNU C Library; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+#ifndef	_MALLOC_INTERNAL
+#define	_MALLOC_INTERNAL
+#include <malloc.h>
+#endif
+
+#ifndef	__GNU_LIBRARY__
+#define	__sbrk	sbrk
+#endif
+
+#ifdef __GNU_LIBRARY__
+/* It is best not to declare this and cast its result on foreign operating
+   systems with potentially hostile include files.  */
+
+#include <stddef.h>
+extern __ptr_t __sbrk __P ((ptrdiff_t increment));
+#endif
+
+#ifndef NULL
+#define NULL 0
+#endif
+
+/* Allocate INCREMENT more bytes of data space,
+   and return the start of data space, or NULL on errors.
+   If INCREMENT is negative, shrink data space.  */
+__ptr_t
+__default_morecore (increment)
+     __malloc_ptrdiff_t increment;
+{
+  __ptr_t result = (__ptr_t) __sbrk (increment);
+  if (result == (__ptr_t) -1)
+    return NULL;
+  return result;
+}
+/* Copyright (C) 1991, 92, 93, 94, 95, 96 Free Software Foundation, Inc.
+
+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; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 675 Mass Ave,
+Cambridge, MA 02139, USA.  */
+
+#ifndef	_MALLOC_INTERNAL
+#define _MALLOC_INTERNAL
+#include <malloc.h>
+#endif
+
+#if __DJGPP__ - 0 == 1
+
+/* There is some problem with memalign in DJGPP v1 and we are supposed
+   to omit it.  Noone told me why, they just told me to do it.  */
+
+#else
+
+__ptr_t (*__memalign_hook) __P ((size_t __size, size_t __alignment));
+
+__ptr_t
+memalign (alignment, size)
+     __malloc_size_t alignment;
+     __malloc_size_t size;
+{
+  __ptr_t result;
+  unsigned long int adj, lastadj;
+
+  if (__memalign_hook)
+    return (*__memalign_hook) (alignment, size);
+
+  /* Allocate a block with enough extra space to pad the block with up to
+     (ALIGNMENT - 1) bytes if necessary.  */
+  result = malloc (size + alignment - 1);
+  if (result == NULL)
+    return NULL;
+
+  /* Figure out how much we will need to pad this particular block
+     to achieve the required alignment.  */
+  adj = (unsigned long int) ((char *) result - (char *) NULL) % alignment;
+
+  do
+    {
+      /* Reallocate the block with only as much excess as it needs.  */
+      free (result);
+      result = malloc (adj + size);
+      if (result == NULL)	/* Impossible unless interrupted.  */
+	return NULL;
+
+      lastadj = adj;
+      adj = (unsigned long int) ((char *) result - (char *) NULL) % alignment;
+      /* It's conceivable we might have been so unlucky as to get a
+	 different block with weaker alignment.  If so, this block is too
+	 short to contain SIZE after alignment correction.  So we must
+	 try again and get another block, slightly larger.  */
+    } while (adj > lastadj);
+
+  if (adj != 0)
+    {
+      /* Record this block in the list of aligned blocks, so that `free'
+	 can identify the pointer it is passed, which will be in the middle
+	 of an allocated block.  */
+
+      struct alignlist *l;
+      for (l = _aligned_blocks; l != NULL; l = l->next)
+	if (l->aligned == NULL)
+	  /* This slot is free.  Use it.  */
+	  break;
+      if (l == NULL)
+	{
+	  l = (struct alignlist *) malloc (sizeof (struct alignlist));
+	  if (l == NULL)
+	    {
+	      free (result);
+	      return NULL;
+	    }
+	  l->next = _aligned_blocks;
+	  _aligned_blocks = l;
+	}
+      l->exact = result;
+      result = l->aligned = (char *) result + alignment - adj;
+    }
+
+  return result;
+}
+
+#endif /* Not DJGPP v1 */
+/* Allocate memory on a page boundary.
+   Copyright (C) 1991, 92, 93, 94, 96 Free Software Foundation, Inc.
+
+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; see the file COPYING.LIB.  If
+not, write to the Free Software Foundation, Inc., 675 Mass Ave,
+Cambridge, MA 02139, USA.
+
+   The author may be reached (Email) at the address mike@ai.mit.edu,
+   or (US mail) as Mike Haertel c/o Free Software Foundation.  */
+
+#if defined (_MALLOC_INTERNAL) && defined (GMALLOC_INHIBIT_VALLOC)
+
+/* Emacs defines GMALLOC_INHIBIT_VALLOC to avoid this definition
+   on MSDOS, where it conflicts with a system header file.  */
+
+#define ELIDE_VALLOC
+
+#endif
+
+#ifndef	ELIDE_VALLOC
+
+#if defined (__GNU_LIBRARY__) || defined (_LIBC)
+#include <stddef.h>
+#include <sys/cdefs.h>
+extern size_t __getpagesize __P ((void));
+#else
+#include "getpagesize.h"
+#define	 __getpagesize()	getpagesize()
+#endif
+
+#ifndef	_MALLOC_INTERNAL
+#define	_MALLOC_INTERNAL
+#include <malloc.h>
+#endif
+
+static __malloc_size_t pagesize;
+
+__ptr_t
+valloc (size)
+     __malloc_size_t size;
+{
+  if (pagesize == 0)
+    pagesize = __getpagesize ();
+
+  return memalign (pagesize, size);
+}
+
+#endif	/* Not ELIDE_VALLOC.  */
diff --git a/gsubr.c b/gsubr.c
new file mode 100644
index 0000000..96b0f78
--- /dev/null
+++ b/gsubr.c
@@ -0,0 +1,138 @@
+/* Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  
+ */
+
+/* "gsubr.c" CCLOs taking general number of required, optional, and rest args.
+   Author: Radey Shouman */
+
+#include "scm.h"
+
+#define GSUBR_MAKTYPE(req, opt, rst) ((req)|((opt)<<4)|((rst)<<8))
+#define GSUBR_REQ(x) ((int)(x)&0xf)
+#define GSUBR_OPT(x) (((int)(x)&0xf0)>>4)
+#define GSUBR_REST(x) ((int)(x)>>8)
+
+#define GSUBR_MAX 10
+#define GSUBR_TYPE(cclo) (VELTS(cclo)[1])
+#define GSUBR_PROC(cclo) (VELTS(cclo)[2])
+
+static SCM f_gsubr_apply;
+SCM make_gsubr(name, req, opt, rst, fcn)
+     char *name;
+     int req, opt, rst;
+     SCM (*fcn)();
+{
+  switch GSUBR_MAKTYPE(req, opt, rst) {
+  case GSUBR_MAKTYPE(0, 0, 0): return make_subr(name, tc7_subr_0, fcn);
+  case GSUBR_MAKTYPE(1, 0, 0): return make_subr(name, tc7_subr_1, fcn);
+  case GSUBR_MAKTYPE(0, 1, 0): return make_subr(name, tc7_subr_1o, fcn);
+  case GSUBR_MAKTYPE(1, 1, 0): return make_subr(name, tc7_subr_2o, fcn);
+  case GSUBR_MAKTYPE(2, 0, 0): return make_subr(name, tc7_subr_2, fcn);
+  case GSUBR_MAKTYPE(3, 0, 0): return make_subr(name, tc7_subr_3, fcn);
+  case GSUBR_MAKTYPE(0, 0, 1): return make_subr(name, tc7_lsubr, fcn);
+  case GSUBR_MAKTYPE(2, 0, 1): return make_subr(name, tc7_lsubr_2, fcn);
+  default:
+    {
+      SCM symcell = sysintern(name, UNDEFINED);
+      SCM z, cclo = makcclo(f_gsubr_apply, 3L);
+      long tmp = ((((CELLPTR)(CAR(symcell)))-heap_org)<<8);
+      ASSERT(GSUBR_MAX >= req + opt + rst, MAKINUM(req + opt + rst),
+	     OUTOFRANGE, "make_gsubr");
+      if ((tmp>>8) != ((CELLPTR)(CAR(symcell))-heap_org))
+	tmp = 0;
+      NEWCELL(z);
+      SUBRF(z) = fcn;
+      CAR(z) = tmp + tc7_subr_0;
+      GSUBR_PROC(cclo) = z;
+      GSUBR_TYPE(cclo) = MAKINUM(GSUBR_MAKTYPE(req, opt, rst));
+      CDR(symcell) = cclo;
+      return cclo;
+    }
+  }
+}
+
+char s_gsubr_apply[] = " gsubr-apply";
+SCM gsubr_apply(args)
+     SCM args;
+{
+  SCM self = CAR(args);
+  SCM (*fcn)() = SUBRF(GSUBR_PROC(self));
+  int typ = INUM(GSUBR_TYPE(self));
+  int i, n = GSUBR_REQ(typ) + GSUBR_OPT(typ) + GSUBR_REST(typ);
+  SCM v[10];
+  if (n > 10) wta(self, "internal programming error", s_gsubr_apply);
+  args = CDR(args);
+  for (i = 0; i < GSUBR_REQ(typ); i++) {
+#ifndef RECKLESS
+    if IMP(args)
+      wnargs: wta(UNDEFINED, (char *)WNA, CHARS(SNAME(GSUBR_PROC(self))));
+#endif
+    v[i] = CAR(args);
+    args = CDR(args);
+  }
+  for (; i < GSUBR_REQ(typ) + GSUBR_OPT(typ); i++) {
+    if NIMP(args) {
+      v[i] = CAR(args);
+      args = CDR(args);
+    }
+    else
+      v[i] = UNDEFINED;
+  }
+  if GSUBR_REST(typ)
+    v[i] = args;
+  else
+    ASRTGO(NULLP(args), wnargs);
+  switch (n) {
+  case 2: return (*fcn)(v[0], v[1]);
+  case 3: return (*fcn)(v[0], v[1], v[2]);
+  case 4: return (*fcn)(v[0], v[1], v[2], v[3]);
+  case 5: return (*fcn)(v[0], v[1], v[2], v[3], v[4]);
+  case 6: return (*fcn)(v[0], v[1], v[2], v[3], v[4], v[5]);
+  case 7: return (*fcn)(v[0], v[1], v[2], v[3], v[4], v[5], v[6]);
+  case 8: return (*fcn)(v[0], v[1], v[2], v[3], v[4], v[5], v[6], v[7]);
+  case 9: return (*fcn)(v[0], v[1], v[2], v[3], v[4], v[5], v[6], v[7], v[8]);
+  case 10: return (*fcn)(v[0], v[1], v[2], v[3], v[4], v[5], v[6], v[7], v[8], v[9]);
+  }
+}
+
+void init_gsubr()
+{
+  f_gsubr_apply = make_subr(s_gsubr_apply, tc7_lsubr, gsubr_apply);
+}
diff --git a/install-sh b/install-sh
new file mode 100644
index 0000000..89fc9b0
--- /dev/null
+++ b/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/ioext.c b/ioext.c
new file mode 100644
index 0000000..3e77a29
--- /dev/null
+++ b/ioext.c
@@ -0,0 +1,703 @@
+/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  
+ */
+
+/* "ioext.c" code for system calls in common between PC compilers and unix.
+   Author: Aubrey Jaffer */
+
+#include "scm.h"
+
+#ifdef __EMX__
+# include <sys/types.h>
+#endif
+
+#ifndef THINK_C
+# ifdef vms
+#  include <stat.h>
+# else
+#  include <sys/stat.h>
+# endif
+# ifdef __TURBOC__
+#  include <io.h>
+# endif
+SCM	stat2scm P((struct stat *stat_temp));
+/* int	mkdir P((const char *path, mode_t mode)); */
+#endif
+#ifdef hpux
+# include <unistd.h>
+#endif
+#ifdef __sgi__
+# include <unistd.h>
+#endif
+
+#ifndef STDC_HEADERS
+	int chdir P((const char *path));
+	int unlink P((const char *name));
+	int link P((const char *from, const char *to));
+	char *getcwd P((char *buf, sizet size));
+	int access P((const char *name, int type));
+	int dup P((int fd));
+	int dup2 P((int fd, int fd2));
+	int close P((int fd));
+	int rmdir P((const char *path));
+	int execv P((const char *, char *const *));
+	int execvp P((const char *, char *const *));
+	int putenv P((const char *));
+#else
+# ifdef _WIN32
+#  include <direct.h>
+#  include <io.h>
+#  include <process.h>
+# endif
+# ifdef __HIGHC__
+#  include <direct.h>
+#  include <dirent.h>
+#  include <process.h>
+#  define mkdir(foo,bar) mkdir(foo)
+# endif
+#endif /* STDC_HEADERS */
+
+#ifdef __EMX__
+	int execv P((const char *, char *const *));
+	int execvp P((const char *, char *const *));
+	int putenv P((const char *));
+#endif
+
+static char s_read_line[] = "read-line";
+SCM read_line(port)
+     SCM port;
+{
+  register int c;
+  register int j = 0;
+  sizet len = 30;
+  SCM tok_buf = makstr((long) len);
+  register char *p = CHARS(tok_buf);
+  if UNBNDP(port) port = cur_inp;
+  else ASSERT(NIMP(port) && OPINPORTP(port), port, ARG1, s_read_line);
+  if (EOF==(c = lgetc(port))) return EOF_VAL;
+  while(1) {
+    switch (c) {
+    case LINE_INCREMENTORS:
+    case EOF:
+      if (len==j) return tok_buf;
+      return resizuve(tok_buf, (SCM)MAKINUM(j));
+    default:
+      if (j >= len) {
+	p = grow_tok_buf(tok_buf);
+	len = LENGTH(tok_buf);
+      }
+      p[j++] = c;
+      c = lgetc(port);
+    }
+  }
+}
+static char s_read_line1[] = "read-line!";
+SCM read_line1(str, port)
+     SCM str, port;
+{
+  register int c;
+  register int j = 0;
+  register char *p;
+  sizet len;
+  ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_read_line1);
+  p = CHARS(str);
+  len = LENGTH(str);
+  if UNBNDP(port) port = cur_inp;
+  else ASSERT(NIMP(port) && OPINPORTP(port), port, ARG2, s_read_line1);
+  c = lgetc(port);
+  if (EOF==c) return EOF_VAL;
+  while(1) {
+    switch (c) {
+    case LINE_INCREMENTORS:
+    case EOF:
+      return MAKINUM(j);
+    default:
+      if (j >= len) {
+	lungetc(c, port);
+	return BOOL_F;
+      }
+      p[j++] = c;
+      c = lgetc(port);
+    }
+  }
+}
+static char s_write_line[] = "write-line";
+SCM l_write_line(obj, port)
+     SCM obj, port;
+{
+  display(obj, port);
+  return newline(port);
+}
+
+static char	s_file_position[] = "file-position",
+		s_file_set_pos[] = "file-set-position";
+SCM file_position(port)
+     SCM port;
+{
+	long ans;
+	ASSERT(NIMP(port) && OPFPORTP(port), port, ARG1, s_file_position);
+	SYSCALL(ans = ftell(STREAM(port)););
+	if CRDYP(port) ans--;
+	return MAKINUM(ans);
+      }
+SCM file_set_position(port, pos)
+     SCM port, pos;
+{
+	SCM ans;
+	ASSERT(NIMP(port) && OPFPORTP(port), port, ARG1, s_file_set_pos);
+	CLRDY(port);		/* Clear ungetted char */
+	SYSCALL(ans = (fseek(STREAM(port), INUM(pos), 0)) ? BOOL_F : BOOL_T;);
+#ifdef HAVE_PIPE
+# ifdef ESPIPE
+	if (!OPIOPORTP(port))
+	  ASSERT(ESPIPE != errno, port, ARG1, s_file_set_pos);
+# endif
+#endif
+	return ans;
+}
+
+static char s_reopen_file[] = "reopen-file";
+SCM reopen_file(filename, modes, port)
+     SCM filename, modes, port;
+{
+  FILE *f;
+  ASSERT(NIMP(filename) && STRINGP(filename), filename, ARG1, s_reopen_file);
+  ASSERT(NIMP(modes) && STRINGP(modes), modes, ARG2, s_reopen_file);
+  DEFER_INTS;
+  ASSERT(NIMP(port) && FPORTP(port) && OPENP(port), port, ARG3, s_reopen_file);
+  SYSCALL(f = freopen(CHARS(filename), CHARS(modes), STREAM(port)););
+  if (!f) port = BOOL_F;
+  else {
+    SETSTREAM(port, f);
+    if (BUF0 & (CAR(port) = tc16_fport | mode_bits(CHARS(modes))))
+      i_setbuf0(port);
+  }
+  ALLOW_INTS;
+  return port;
+}
+
+#ifndef MCH_AMIGA
+
+static char s_dup[]="duplicate-port";
+SCM l_dup(oldpt, modes)
+     SCM oldpt, modes;
+{
+  int tfd;
+  FILE *f;
+  SCM newpt;
+  ASSERT(NIMP(oldpt) && OPPORTP(oldpt), oldpt, ARG1, s_dup);
+  ASSERT(NIMP(modes) && STRINGP(modes), modes, ARG2, s_dup);
+  NEWCELL(newpt);
+  DEFER_INTS;
+  SYSCALL(tfd = dup(fileno(STREAM(oldpt))););
+  if (-1==tfd) {ALLOW_INTS;return BOOL_F;};
+  SYSCALL(f = fdopen(tfd, CHARS(modes)););
+  if (!f) {
+    close(tfd);
+    wta(MAKINUM(tfd), (char *)NALLOC, s_port_type);
+  }
+  SETSTREAM(newpt, f);
+  if (BUF0 & (CAR(newpt) = tc16_fport | mode_bits(CHARS(modes))))
+    i_setbuf0(newpt);
+  ALLOW_INTS;
+  return newpt;
+}
+static char s_dup2[]="redirect-port!";
+SCM l_dup2(into_pt, from_pt)
+     SCM into_pt, from_pt;
+{
+  int ans, oldfd, newfd;
+  DEFER_INTS;
+  ASSERT(NIMP(into_pt) && OPPORTP(into_pt), into_pt, ARG1, s_dup2);
+  ASSERT(NIMP(from_pt) && OPPORTP(from_pt), from_pt, ARG1, s_dup2);
+  oldfd = fileno(STREAM(into_pt));
+  newfd = fileno(STREAM(from_pt));
+  SYSCALL(ans = dup2(oldfd, newfd););
+  if (-1==ans) {ALLOW_INTS;return BOOL_F;};
+  ALLOW_INTS;
+  return into_pt;
+}
+
+# ifndef vms
+#  ifndef _WIN32
+#   include <dirent.h>
+static char s_opendir[]="opendir";
+SCM l_opendir(dirname)
+     SCM dirname;
+{
+  DIR *ds;
+  SCM dir;
+  ASSERT(NIMP(dirname) && STRINGP(dirname), dirname, ARG1, s_opendir);
+  NEWCELL(dir);
+  DEFER_INTS;
+  SYSCALL(ds = opendir(CHARS(dirname)););
+  if (!ds) {ALLOW_INTS; return BOOL_F;}
+  CAR(dir) = tc16_dir | OPN;
+  SETCDR(dir, ds);
+  ALLOW_INTS;
+  return dir;
+}
+static char s_readdir[]="readdir";
+SCM l_readdir(port)
+     SCM port;
+{
+  struct dirent *rdent;
+  DEFER_INTS;
+  ASSERT(OPDIRP(port), port, ARG1, s_readdir);
+  SYSCALL(rdent = readdir((DIR *)CDR(port)););
+  if (!rdent) {ALLOW_INTS; return BOOL_F;}
+  ALLOW_INTS;
+  /* rdent could be overwritten by another readdir to the same handle */
+  return makfrom0str(rdent->d_name);
+}
+static char s_rewinddir[]="rewinddir";
+SCM l_rewinddir(port)
+     SCM port;
+{
+  ASSERT(OPDIRP(port), port, ARG1, s_rewinddir);
+  rewinddir((DIR *)CDR(port));
+  return UNSPECIFIED;
+}
+static char s_closedir[]="closedir";
+SCM l_closedir(port)
+     SCM port;
+{
+  int sts;
+  ASSERT(DIRP(port), port, ARG1, s_closedir);
+  DEFER_INTS;
+  if CLOSEDP(port) {ALLOW_INTS;return BOOL_F;}
+  SYSCALL(sts = closedir((DIR *)CDR(port)););
+  if (sts) {ALLOW_INTS; return BOOL_F;}
+  CAR(port) = tc16_dir;
+  ALLOW_INTS;
+  return BOOL_T;
+}
+
+int dir_print(sexp, port, writing)
+     SCM sexp; SCM port; int writing;
+{
+  prinport(sexp, port, "directory");
+  return !0;
+}
+sizet dir_free(p)
+     CELLPTR p;
+{
+  if OPENP((SCM)p) closedir((DIR *)CDR((SCM)p));
+  return 0;
+}
+
+long tc16_dir;
+static smobfuns dir_smob = {mark0, dir_free, dir_print, 0};
+#  endif /* _WIN32 */
+# endif /* vms */
+
+static char s_mkdir[] = "mkdir";
+SCM l_mkdir(path, mode)
+     SCM path, mode;
+{
+  int val;
+  ASSERT(NIMP(path) && STRINGP(path), path, ARG1, s_mkdir);
+  ASSERT(INUMP(mode), mode, ARG2, s_mkdir);
+# ifdef _WIN32
+  SYSCALL(val = mkdir(CHARS(path)););
+# else
+  SYSCALL(val = mkdir(CHARS(path), INUM(mode)););
+				/* (mode_t)INUM(mode) might be needed */
+# endif
+  return val ? BOOL_F : BOOL_T;
+}
+# ifdef vms
+static char s_dot_dir[] = ".DIR";
+# endif
+static char s_rmdir[] = "rmdir";
+SCM l_rmdir(path)
+     SCM path;
+{
+  int val;
+  ASSERT(NIMP(path) && STRINGP(path), path, ARG1, s_rmdir);
+# ifdef vms
+  return del_fil(st_append(cons2(path, s_dot_dir, EOL)));
+# else
+  SYSCALL(val = rmdir(CHARS(path)););
+  return val ? BOOL_F : BOOL_T;
+# endif
+}
+#endif /* MCH_AMIGA */
+
+#ifndef THINK_C
+static char s_chdir[] = "chdir";
+SCM lchdir(str)
+     SCM str;
+{
+  int ans;
+  ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_chdir);
+  SYSCALL(ans = chdir(CHARS(str)););
+  return ans ? BOOL_F : BOOL_T;
+}
+# ifndef MCH_AMIGA
+#  ifdef __TURBOC__
+#   include <dir.h>
+#  endif
+SCM l_getcwd()
+{
+  char *ans;
+#  ifndef vms
+  char wd[256];
+  SYSCALL(ans = getcwd(wd, 256););
+  return ans ? makfrom0str(wd) : BOOL_F;
+#  else
+  SYSCALL(ans = getenv("PATH"););
+  return ans ? makfrom0str(ans) : BOOL_F;
+#  endif
+}
+
+static char s_chmod[] = "chmod";
+SCM l_chmod(pathname, mode)
+     SCM pathname, mode;
+{
+  int val;
+  ASSERT(NIMP(pathname) && STRINGP(pathname), pathname, ARG1, s_chmod);
+  ASSERT(INUMP(mode), mode, ARG2, s_chmod);
+  SYSCALL(val = chmod(CHARS(pathname), INUM(mode)););
+  return val ? BOOL_F : BOOL_T;
+}
+
+#  ifndef vms
+#   ifdef __EMX__
+#    include <sys/utime.h>
+#   else
+#    ifdef _WIN32
+#     include <sys/utime.h>
+#    else
+#     include <utime.h>
+#    endif
+#   endif
+static char s_utime[] = "utime";
+SCM l_utime(pathname, acctime, modtime)
+     SCM pathname, acctime, modtime;
+{
+  int val;
+  struct utimbuf utm_tmp;
+  utm_tmp.actime = num2ulong(acctime, (char *)ARG2, s_utime);
+  utm_tmp.modtime = num2ulong(modtime, (char *)ARG3, s_utime);
+  ASSERT(NIMP(pathname) && STRINGP(pathname), pathname, ARG1, s_utime);
+  SYSCALL(val = utime(CHARS(pathname), &utm_tmp););
+  return val ? BOOL_F : BOOL_T;
+}
+#  endif /* vms */
+
+static char s_umask[] = "umask";
+SCM l_umask(mode)
+     SCM mode;
+{
+  ASSERT(INUMP(mode), mode, ARG1, s_umask);
+  return MAKINUM(umask(INUM(mode)));
+}
+# endif /* MCH_AMIGA */
+#endif /* THINK_C */
+
+static char s_ren_fil[] = "rename-file";
+SCM ren_fil(oldname, newname)
+     SCM oldname, newname;
+{
+  SCM ans;
+  ASSERT(NIMP(oldname) && STRINGP(oldname), oldname, ARG1, s_ren_fil);
+  ASSERT(NIMP(newname) && STRINGP(newname), newname, ARG2, s_ren_fil);
+#ifdef STDC_HEADERS
+  SYSCALL(ans = (rename(CHARS(oldname), CHARS(newname))) ? BOOL_F: BOOL_T;);
+  return ans;
+#else
+  DEFER_INTS;
+  SYSCALL(ans = link(CHARS(oldname), CHARS(newname)) ? BOOL_F : BOOL_T;);
+  if (!FALSEP(ans)) {
+    SYSCALL(ans = unlink(CHARS(oldname)) ? BOOL_F : BOOL_T;);
+    if FALSEP(ans)
+      SYSCALL(unlink(CHARS(newname));); /* unlink failed.  remove new name */
+  }
+  ALLOW_INTS;
+  return ans;
+#endif
+}
+static char s_fileno[] = "fileno";
+SCM l_fileno(port)
+     SCM port;
+{
+  ASSERT(NIMP(port) && OPPORTP(port), port, ARG1, s_fileno);
+  if (tc16_fport != TYP16(port)) return BOOL_F;
+  return MAKINUM(fileno(STREAM(port)));
+}
+static char s_isatty[] = "isatty?";
+SCM l_isatty(port)
+     SCM port;
+{
+  ASSERT(NIMP(port) && OPPORTP(port), port, ARG1, s_isatty);
+  if (tc16_fport != TYP16(port)) return BOOL_F;
+  return isatty(fileno(STREAM(port)))?BOOL_T:BOOL_F;
+}
+#ifndef F_OK
+# define F_OK 00
+# define X_OK 01
+# define W_OK 02
+# define R_OK 04
+#endif
+static char s_access[] = "access";
+SCM l_access(pathname, mode)
+     SCM pathname, mode;
+{
+  int val;
+  int imodes;
+  ASSERT(NIMP(pathname) && STRINGP(pathname), pathname, ARG1, s_access);
+  if INUMP(mode) imodes = INUM(mode);
+  else {
+    ASSERT(NIMP(mode) && STRINGP(mode), mode, ARG2, s_access);
+    imodes = F_OK | (strchr(CHARS(mode), 'r') ? R_OK : 0)
+      | (strchr(CHARS(mode), 'w') ? W_OK : 0)
+	| (strchr(CHARS(mode), 'x') ? X_OK : 0);
+  }
+  SYSCALL(val = access(CHARS(pathname), imodes););
+  return val ? BOOL_F : BOOL_T;
+}
+
+#ifndef THINK_C
+
+char s_stat[] = "stat";
+SCM l_stat(str)
+  SCM str;
+{
+  int i;
+  struct stat stat_temp;
+  if IMP(str)
+  badarg1: wta(str, (char *)ARG1, s_stat);
+  if STRINGP(str) {SYSCALL(i = stat(CHARS(str), &stat_temp););}
+  else {
+# ifndef MCH_AMIGA
+    if (!OPFPORTP(str)) goto badarg1;
+    SYSCALL(i = fstat(fileno(STREAM(str)), &stat_temp););
+# else
+    goto badarg1;
+# endif
+  }
+  if (i) return BOOL_F;
+  return stat2scm(&stat_temp);
+}
+# ifdef MCH_AMIGA
+SCM stat2scm(stat_temp)
+     struct stat *stat_temp;
+{
+  SCM ans = make_vector(MAKINUM(3), UNSPECIFIED);
+  SCM *ve = VELTS(ans);
+  ve[ 0] = ulong2num((unsigned long)stat_temp->st_attr);
+  ve[ 1] = ulong2num((unsigned long)stat_temp->st_mtime);
+  ve[ 2] = ulong2num((unsigned long)stat_temp->st_size);
+  return ans;
+}
+# else
+SCM stat2scm(stat_temp)
+     struct stat *stat_temp;
+{
+  SCM ans = make_vector(MAKINUM(11), UNSPECIFIED);
+  SCM *ve = VELTS(ans);
+  ve[ 0] = ulong2num((unsigned long)stat_temp->st_dev);
+  ve[ 1] = ulong2num((unsigned long)stat_temp->st_ino);
+  ve[ 2] = ulong2num((unsigned long)stat_temp->st_mode);
+  ve[ 3] = ulong2num((unsigned long)stat_temp->st_nlink);
+  ve[ 4] = ulong2num((unsigned long)stat_temp->st_uid);
+  ve[ 5] = ulong2num((unsigned long)stat_temp->st_gid);
+  ve[ 6] = ulong2num((unsigned long)stat_temp->st_rdev);
+  ve[ 7] = ulong2num((unsigned long)stat_temp->st_size);
+  ve[ 8] = ulong2num((unsigned long)stat_temp->st_atime);
+  ve[ 9] = ulong2num((unsigned long)stat_temp->st_mtime);
+  ve[10] = ulong2num((unsigned long)stat_temp->st_ctime);
+  return ans;
+}
+#  ifdef __TURBOC__
+#   include <process.h>
+#  endif
+SCM l_getpid()
+{
+  return MAKINUM((unsigned long)getpid());
+}
+# endif /* MCH_AMIGA */
+#endif				/* THINK_C */
+
+#ifndef __IBMC__
+# ifndef THINK_C
+#  ifndef __WATCOMC__
+#   ifndef GO32
+#    ifndef _Windows
+#     ifdef __TURBOC__
+#      include <process.h>
+#     endif
+char s_execv[] = "execv";
+char s_execvp[] = "execvp";
+SCM i_execv(modes, path, args)
+     char * modes;
+     SCM path, args;
+{
+  char **execargv;
+  int i = ilength(args);
+  ASSERT(i>0, args, WNA, s_execv);
+  ASSERT(NIMP(path) && STRINGP(path), path, ARG1, s_execv);
+  /*  dowinds(EOL, ilength(dynwinds)); */
+  args = cons(path, args);
+  DEFER_INTS;
+  execargv = makargvfrmstrs(args, s_execv);
+  ALLOW_INTS;
+  (strchr(modes, 'p') ? execvp : execv)(execargv[0], &execargv[1]);
+  perror(execargv[0]);
+  return MAKINUM(errno);
+}
+SCM lexec(path, arg0, args)
+     SCM path, arg0, args;
+{
+  return i_execv("", path, cons(arg0, args));
+}
+SCM lexecp(path, arg0, args)
+     SCM path, arg0, args;
+{
+  return i_execv("p", path, cons(arg0, args));
+}
+SCM lexecv(path, args)
+     SCM path, args;
+{
+  return i_execv("", path, args);
+}
+SCM lexecvp(path, args)
+     SCM path, args;
+{
+  return i_execv("p", path, args);
+}
+static char s_putenv[] = "putenv";
+SCM l_putenv(str)
+     SCM str;
+{
+  ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_putenv);
+  return putenv(CHARS(str)) ? BOOL_F : BOOL_T;
+}
+#    endif
+#   endif
+#  endif
+# endif
+#endif
+
+static iproc subr1s[] = {
+	{s_file_position, file_position},
+	{s_fileno, l_fileno},
+	{s_isatty, l_isatty},
+#ifndef MCH_AMIGA
+# ifndef vms
+#  ifndef _WIN32
+	{s_opendir, l_opendir},
+	{s_readdir, l_readdir},
+	{s_rewinddir, l_rewinddir},
+	{s_closedir, l_closedir},
+#  endif
+# endif
+	{s_rmdir, l_rmdir},
+#endif
+#ifndef THINK_C
+# ifndef MCH_AMIGA
+	{s_umask, l_umask},
+# endif
+	{s_chdir, lchdir},
+	{s_stat, l_stat},
+#endif
+	{0, 0}};
+
+static iproc subr1os[] = {
+	{s_read_line, read_line},
+	{0, 0}};
+
+static iproc subr2s[] = {
+	{s_ren_fil, ren_fil},
+	{s_access, l_access},
+#ifndef MCH_AMIGA
+	{s_dup, l_dup},
+	{s_dup2, l_dup2},
+	{s_mkdir, l_mkdir},
+# ifndef THINK_C
+	{s_chmod, l_chmod},
+# endif
+#endif
+	{0, 0}};
+
+static iproc subr2os[] = {
+	{s_file_set_pos, file_set_position},
+	{s_read_line1, read_line1},
+	{s_write_line, l_write_line},
+	{0, 0}};
+
+void init_ioext()
+{
+	init_iprocs(subr1os, tc7_subr_1o);
+	init_iprocs(subr1s, tc7_subr_1);
+	init_iprocs(subr2os, tc7_subr_2o);
+	init_iprocs(subr2s, tc7_subr_2);
+	make_subr(s_reopen_file, tc7_subr_3, reopen_file);
+#ifndef THINK_C
+# ifndef MCH_AMIGA
+	make_subr("getpid", tc7_subr_0, l_getpid);
+	make_subr("getcwd", tc7_subr_0, l_getcwd);
+#  ifndef vms
+#   ifndef _WIN32
+	make_subr(s_utime, tc7_subr_3, l_utime);
+	tc16_dir = newsmob(&dir_smob);
+#   endif
+#  endif
+# endif
+#endif
+#ifndef __IBMC__
+# ifndef THINK_C
+#  ifndef __WATCOMC__
+#   ifndef GO32
+#    ifndef _Windows
+	make_subr(s_execv, tc7_subr_2, lexecv);
+	make_subr(s_execvp, tc7_subr_2, lexecvp);
+	make_subr("execl", tc7_lsubr_2, lexec);
+	make_subr("execlp", tc7_lsubr_2, lexecp);
+	make_subr(s_putenv, tc7_subr_1, l_putenv);
+#    endif
+#   endif
+#  endif
+# endif
+#endif
+	add_feature("i/o-extensions");
+	add_feature("line-i/o");
+}
diff --git a/mkinstalldirs b/mkinstalldirs
new file mode 100755
index 0000000..0e29377
--- /dev/null
+++ b/mkinstalldirs
@@ -0,0 +1,35 @@
+#!/bin/sh
+# Make directory hierarchy. 
+# Written by Noah Friedman <friedman@prep.ai.mit.edu>
+# Public domain.
+
+defaultIFS=' 	
+'
+IFS="${IFS-${defaultIFS}}"
+
+errstatus=0
+
+for file in ${1+"$@"} ; do 
+   oIFS="${IFS}"
+   # Some sh's can't handle IFS=/ for some reason.
+   IFS='%'
+   set - `echo ${file} | sed -e 's@/@%@g' -e 's@^%@/@'`
+   IFS="${oIFS}"
+
+   pathcomp=''
+
+   for d in ${1+"$@"} ; do
+     pathcomp="${pathcomp}${d}"
+
+     if test ! -d "${pathcomp}"; then
+        echo "mkdir $pathcomp" 1>&2
+        mkdir "${pathcomp}" || errstatus=$?
+     fi
+
+     pathcomp="${pathcomp}/"
+   done
+done
+
+exit $errstatus
+
+# eof
diff --git a/patchlvl.h b/patchlvl.h
new file mode 100644
index 0000000..97543ec
--- /dev/null
+++ b/patchlvl.h
@@ -0,0 +1,8 @@
+/* SCMVERSION is a string for the version specifier.  The leading
+   number is the major version number, the letter is the revision ("a"
+   for alpha release, "b" for beta release, "c", and so on), and the
+   trailing number is the patchlevel. */
+
+#ifndef SCMVERSION
+# define SCMVERSION "4e6"
+#endif
diff --git a/pi.c b/pi.c
new file mode 100644
index 0000000..2047d2b
--- /dev/null
+++ b/pi.c
@@ -0,0 +1,78 @@
+/* Copyright (C) 1991 1995 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  
+ */
+
+/* "pi.c", program for computing digits of numerical value of PI.
+   Author: Aubrey Jaffer
+
+pi <n> <d> prints out <n> digits of pi in groups of <d> digits.
+
+'Spigot' algorithm origionally due to Stanly Rabinowitz.
+This algorithm takes time proportional to the square of <n>/<d>.
+This fact can make comparisons of computational speed between systems
+of vastly differring performances quicker and more accurate.
+
+Try: pi 100 5
+The digit size <d> will have to be reduced for larger <n> or an
+error due to overflow will occur. */
+
+short *calloc();
+main(c,v)
+int c;char **v;{
+  int n=200,j=0,m,b=2,k=0,t,r=1,d=5;
+  long q;
+  short *a;
+  if(c>1)n=atoi(v[1]);
+  if(c>2)d=atoi(v[2]);
+  while(k++<d)r=r*10;
+  n=n/d+1;
+  k=m=3.322*n*d;
+  a=calloc(1+m,2);
+  while(k)a[--k]=2;
+  for(a[m]=4;j<n;b=q%r){
+    q=0;
+    for(k=m;k;){
+      q+=a[k]*r;
+      t=(2*k+1);
+      a[k]=q%t;
+      q=q/t;
+      q*=k--;}
+    printf("%0*d%s",d,b+q/r,++j%10?"  ":"\n");}
+  puts("");}
diff --git a/pi.scm b/pi.scm
new file mode 100644
index 0000000..bb533bc
--- /dev/null
+++ b/pi.scm
@@ -0,0 +1,165 @@
+;; Copyright (C) 1991, 1993, 1994, 1995 Free Software Foundation, Inc.
+;; 
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; 
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; 
+;; You should have received a copy of the GNU General Public License
+;; along with this software; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;
+;; As a special exception, the Free Software Foundation gives permission
+;; for additional uses of the text contained in its release of GUILE.
+;;
+;; The exception is that, if you link the GUILE library with other files
+;; to produce an executable, this does not by itself cause the
+;; resulting executable to be covered by the GNU General Public License.
+;; Your use of that executable is in no way restricted on account of
+;; linking the GUILE library code into it.
+;;
+;; This exception does not however invalidate any other reasons why
+;; the executable file might be covered by the GNU General Public License.
+;;
+;; This exception applies only to the code released by the
+;; Free Software Foundation under the name GUILE.  If you copy
+;; code from other Free Software Foundation releases into a copy of
+;; GUILE, as the General Public License permits, the exception does
+;; not apply to the code that you add in this way.  To avoid misleading
+;; anyone as to the status of such modified files, you must delete
+;; this exception notice from them.
+;;
+;; If you write modifications of your own for GUILE, it is your choice
+;; whether to permit this exception to apply to your modifications.
+;; If you do not wish that, delete this exception notice.  
+
+;;;; "pi.scm", program for computing digits of numerical value of PI.
+;;;; "bigpi.scm", program for computing digits of numerical value of PI.
+;;;; "e.scm", program for computing digits of numerical value of 'e'.
+;;; Authors: Aubrey Jaffer & Jerry D. Hedden
+
+;;; (pi <n> <d>) prints out <n> digits of pi in groups of <d> digits.
+
+;;; 'Spigot' algorithm origionally due to Stanly Rabinowitz.
+;;; This algorithm takes time proportional to the square of <n>/<d>.
+;;; This fact can make comparisons of computational speed between systems
+;;; of vastly differring performances quicker and more accurate.
+
+;;; Try (pi 100 5)
+;;; The digit size <d> will have to be reduced for larger <n> or an
+;;; overflow error will occur (on systems lacking bignums).
+
+;;; It your Scheme has bignums try (pi 1000).
+
+(define (pi n . args)
+  (if (null? args) (bigpi n)
+      (let* ((d (car args))
+	     (r (do ((s 1 (* 10 s))
+		     (i d (- i 1)))
+		    ((zero? i) s)))
+	     (n (+ (quotient n d) 1))
+	     (m (quotient (* n d 3322) 1000))
+	     (a (make-vector (+ 1 m) 2)))
+	(vector-set! a m 4)
+	(do ((j 1 (+ 1 j))
+	     (q 0 0)
+	     (b 2 (remainder q r)))
+	    ((> j n))
+	  (do ((k m (- k 1)))
+	      ((zero? k))
+	    (set! q (+ q (* (vector-ref a k) r)))
+	    (let ((t (+ 1 (* 2 k))))
+	      (vector-set! a k (remainder q t))
+	      (set! q (* k (quotient q t)))))
+	  (let ((s (number->string (+ b (quotient q r)))))
+	    (do ((l (string-length s) (+ 1 l)))
+		((>= l d) (display s))
+	      (display #\0)))
+	  (if (zero? (modulo j 10)) (newline) (display #\ )))
+	(newline))))
+
+;;; (pi <n>) prints out <n> digits of pi.
+
+;;; 'Spigot' algorithm originally due to Stanly Rabinowitz:
+;;;
+;;; PI = 2+(1/3)*(2+(2/5)*(2+(3/7)*(2+ ... *(2+(k/(2k+1))*(4)) ... )))
+;;;
+;;; where 'k' is approximately equal to the desired precision of 'n'
+;;; places times 'log2(10)'.
+;;;
+;;; This version takes advantage of "bignums" in SCM to compute all
+;;; of the requested digits in one pass!  Basically, it calculates
+;;; the truncated portion of (PI * 10^n), and then displays it in a
+;;; nice format.
+
+(define (bigpi digits)
+  (let* ((n (* 10 (quotient (+ digits 9) 10)))	; digits in multiples of 10
+	 (z (inexact->exact (truncate		; z = number of terms
+			     (/ (* n (log 10)) (log 2)))))
+	 (q (do ((x 2 (* 10000000000 x))	; q = 2 * 10^n
+		 (i (/ n 10) (- i 1)))
+		((zero? i)  x)))
+	 (_pi (number->string			; _pi = PI * 10^n
+	       ;; do the calculations in one pass!!!
+	       (let pi_calc ((j z) (k (+ z z 1)) (p (+ q q)))
+		 (if (zero? j)
+		     p
+		     (pi_calc (- j 1) (- k 2) (+ q (quotient (* p j) k))))))))
+    ;; print out the result ("3." followed by 5 groups of 10 digits per line)
+    (display (substring _pi 0 1)) (display #\.) (newline)
+    (do ((i 0 (+ i 10)))
+	((>= i n))
+      (display (substring _pi (+ i 1) (+ i 11)))
+      (display (if (zero? (modulo (+ i 10) 50)) #\newline #\ )))
+    (if (not (zero? (modulo n 50))) (newline))))
+
+;;; (e <n>) prints out <n> digits of 'e'.
+
+;;; Uses the formula:
+;;;
+;;;           1    1    1    1          1
+;;;   e = 1 + -- + -- + -- + -- + ... + --
+;;;           1!   2!   3!   4!         k!
+;;;
+;;; where 'k' is determined using the desired precision 'n' in:
+;;;
+;;;    n  <  ((k * (ln(k) - 1)) / ln(10))
+;;;
+;;; which uses Stirling's formula for approximating ln(k!)
+;;;
+;;; This program takes advantage of "bignums" in SCM to compute all
+;;; the requested digits at once!  Basically, it calculates the
+;;; fractional part of 'e' (i.e., e-2) as a fraction of two bignums
+;;; 'e_n' and 'e_d', determines the integer part of (e_n * 10^n)/e_d,
+;;; and then displays it in a nice format.
+
+(define (e digits)
+  (let* ((n (* 10 (quotient (+ digits 9) 10)))	; digits in multiples of 10
+	 (k (do ((i 15 (+ i 1)))		; k = number of terms
+		((< n (/ (* i (- (log i) 1)) (log 10)))  i)))
+	 (q (do ((x 1 (* 10000000000 x))	; q = 10^n
+		 (i (/ n 10) (- i 1)))
+		((zero? i)  x)))
+	 (_e (let ((ee
+		    ; do calculations
+		    (let e_calc ((i k) (e_d 1) (e_n 0))
+		      (if (= i 1)
+			  (cons (* q e_n) e_d)
+			  (e_calc (- i 1) (* e_d i) (+ e_n e_d))))))
+	       (number->string (+ (quotient (car ee) (cdr ee))
+				  ; rounding
+				  (if (< (remainder (car ee) (cdr ee))
+					 (quotient (cdr ee) 2))
+				      0 1))))))
+    ;; print out the result ("2." followed by 5 groups of 10 digits per line)
+    (display "2.") (newline)
+    (do ((i 0 (+ i 10)))
+	((>= i n))
+      (display (substring _e i (+ i 10)))
+      (display (if (zero? (modulo (+ i 10) 50)) #\newline #\ )))
+    (if (not (zero? (modulo n 50))) (newline))))
diff --git a/posix.c b/posix.c
new file mode 100644
index 0000000..422d61d
--- /dev/null
+++ b/posix.c
@@ -0,0 +1,408 @@
+/* Copyright (C) 1994, 1995 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  
+ */
+
+/* "posix.c" functions only in Posix (unix).
+   Author: Aubrey Jaffer */
+
+#include "scm.h"
+
+#include <pwd.h>
+#include <sys/types.h>
+#include <sys/wait.h>
+
+#ifndef STDC_HEADERS
+	char *ttyname P((int fd));
+	FILE *popen P((const char* command, const char* type));
+	int pclose P((FILE* stream));
+#endif
+
+     /* Only the superuser can successfully execute this call */
+static char s_chown[] = "chown";
+SCM l_chown(path, owner, group)
+     SCM path, owner, group;
+{
+  int val;
+  ASSERT(NIMP(path) && STRINGP(path), path, ARG1, s_chown);
+  ASSERT(INUMP(owner), owner, ARG2, s_chown);
+  ASSERT(INUMP(group), group, ARG3, s_chown);
+  SYSCALL(val = chown(CHARS(path), INUM(owner), INUM(group)););
+  return val ? BOOL_F : BOOL_T;
+}
+
+static char s_link[] = "link";
+SCM l_link(oldpath, newpath)
+     SCM oldpath, newpath;
+{
+  int val;
+  ASSERT(NIMP(oldpath) && STRINGP(oldpath), oldpath, ARG1, s_link);
+  ASSERT(NIMP(newpath) && STRINGP(newpath), newpath, ARG2, s_link);
+  SYSCALL(val = link(CHARS(oldpath), CHARS(newpath)););
+  return val ? BOOL_F : BOOL_T;
+}
+
+SCM l_pipe()
+{
+  int fd[2], ret;
+  FILE *f_rd, *f_wt;
+  SCM p_rd, p_wt;
+  NEWCELL(p_rd); NEWCELL(p_wt);
+  SYSCALL(ret = pipe(fd););
+  if (ret) {ALLOW_INTS; return BOOL_F;}
+  SYSCALL(f_rd = fdopen(fd[0], "r"););
+  if (!f_rd) {
+    close(fd[0]);
+    goto errout;
+  }
+  SYSCALL(f_wt = fdopen(fd[1], "w"););
+  if (!f_wt) {
+    fclose(f_rd);
+  errout:
+    close(fd[1]);
+    wta(UNDEFINED, (char *)NALLOC, s_port_type);
+  }
+  CAR(p_rd) = tc16_fport | mode_bits("r");
+  CAR(p_wt) = tc16_fport | mode_bits("w");
+  SETSTREAM(p_rd, f_rd);
+  SETSTREAM(p_wt, f_wt);
+  ALLOW_INTS;
+  return cons(p_rd, p_wt);
+}
+
+char	s_op_pipe[] = "open-pipe";
+SCM open_pipe(pipestr, modes)
+     SCM pipestr, modes;
+{
+	FILE *f;
+	register SCM z;
+	ASSERT(NIMP(pipestr) && STRINGP(pipestr), pipestr, ARG1, s_op_pipe);
+	ASSERT(NIMP(modes) && STRINGP(modes), modes, ARG2, s_op_pipe);
+	NEWCELL(z);
+	/* DEFER_INTS, SYSCALL, and ALLOW_INTS are probably paranoid here*/
+	DEFER_INTS;
+	ignore_signals();
+	SYSCALL(f = popen(CHARS(pipestr), CHARS(modes)););
+	unignore_signals();
+	if (!f) z = BOOL_F;
+	else {
+	  CAR(z) = tc16_pipe | OPN | (strchr(CHARS(modes), 'r') ? RDNG : WRTNG);
+	  SETSTREAM(z, f);
+	}
+	ALLOW_INTS;
+	return z;
+}
+SCM l_open_input_pipe(pipestr)
+     SCM pipestr;
+{
+  return open_pipe(pipestr, makfromstr("r", (sizeof "r")-1));
+}
+SCM l_open_output_pipe(pipestr)
+     SCM pipestr;
+{
+  return open_pipe(pipestr, makfromstr("w", (sizeof "w")-1));
+}
+static int prinpipe(exp, port, writing)
+     SCM exp; SCM port; int writing;
+{
+  prinport(exp, port, s_pipe);
+  return !0;
+}
+
+static char scm_s_getgroups[] = "getgroups";
+SCM scm_getgroups()
+{
+  SCM grps, ans;
+  int ngroups = getgroups(NULL, 0);
+  if (!ngroups) return BOOL_F;
+  NEWCELL(grps);
+  DEFER_INTS;
+  {
+    gid_t *groups = (gid_t *)must_malloc(ngroups * sizeof(gid_t),
+					 scm_s_getgroups);
+    int val = getgroups(ngroups, groups);
+    if (val < 0) {
+      must_free(groups);
+      ALLOW_INTS;
+      return BOOL_F;
+    }
+    SETCHARS(grps, groups);	/* set up grps as a GC protect */
+    SETLENGTH(grps, 0L + ngroups * sizeof(gid_t), tc7_string);
+    ALLOW_INTS;
+    ans = make_vector(MAKINUM(ngroups), UNDEFINED);
+    while (--ngroups >= 0) VELTS(ans)[ngroups] = MAKINUM(groups[ngroups]);
+    SETCHARS(grps, groups);	/* to make sure grps stays around. */
+    return ans;
+  }
+}  
+
+/* These 2 routines are not protected against `entry' being reused
+   before access to that structure is completed */
+
+static char s_pwinfo[] = "getpw";
+SCM l_pwinfo(user)
+     SCM user;
+{
+  SCM ans = make_vector(MAKINUM(7), UNSPECIFIED);
+  struct passwd *entry;
+  SCM *ve = VELTS(ans);
+  DEFER_INTS;
+  if UNBNDP(user) SYSCALL(entry = getpwent(););
+  else if INUMP(user) SYSCALL(entry = getpwuid(INUM(user)););
+  else {
+    ASSERT(NIMP(user) && STRINGP(user), user, ARG1, s_pwinfo);
+    SYSCALL(entry = getpwnam(CHARS(user)););
+  }
+  ALLOW_INTS;
+  if (!entry) return BOOL_F;
+  ve[ 0] = makfrom0str(entry->pw_name);
+  ve[ 1] = makfrom0str(entry->pw_passwd);
+  ve[ 2] = ulong2num((unsigned long)entry->pw_uid);
+  ve[ 3] = ulong2num((unsigned long)entry->pw_gid);
+  ve[ 4] = makfrom0str(entry->pw_gecos);
+  ve[ 5] = makfrom0str(entry->pw_dir);
+  ve[ 6] = makfrom0str(entry->pw_shell);
+  return ans;
+}
+#include <grp.h>
+static char s_grinfo[] = "getgr";
+SCM l_grinfo(name)
+     SCM name;
+{
+  SCM ans = make_vector(MAKINUM(4), UNSPECIFIED);
+  struct group *entry;
+  SCM *ve = VELTS(ans);
+  DEFER_INTS;
+  if UNBNDP(name) SYSCALL(entry = getgrent(););
+  else if INUMP(name) SYSCALL(entry = getgrgid(INUM(name)););
+  else {
+    ASSERT(NIMP(name) && STRINGP(name), name, ARG1, s_grinfo);
+    SYSCALL(entry = getgrnam(CHARS(name)););
+  }
+  ALLOW_INTS;
+  if (!entry) return BOOL_F;
+  ve[ 0] = makfrom0str(entry->gr_name);
+  ve[ 1] = makfrom0str(entry->gr_passwd);
+  ve[ 2] = ulong2num((unsigned long)entry->gr_gid);
+  ve[ 3] = makfromstrs(-1, entry->gr_mem);
+  return ans;
+}
+SCM l_setgr(arg)
+     SCM arg;
+{
+  if (UNBNDP(arg) || FALSEP(arg)) endgrent();
+  else setgrent();
+  return UNSPECIFIED;
+}
+SCM l_setpw(arg)
+     SCM arg;
+{
+  if (UNBNDP(arg) || FALSEP(arg)) endpwent();
+  else setpwent();
+  return UNSPECIFIED;
+}
+
+static char s_kill[] = "kill";
+SCM l_kill(pid, sig)
+     SCM pid, sig;
+{
+  int i;
+  ASSERT(INUMP(pid), pid, ARG1, s_kill);
+  ASSERT(INUMP(sig), sig, ARG2, s_kill);
+  SYSCALL(i = kill((int)INUM(pid), (int)INUM(sig)););
+  return MAKINUM(0L+i);
+}
+static char s_waitpid[] = "waitpid";
+SCM l_waitpid(pid, options)
+     SCM pid, options;
+{
+  int i, status;
+  ASSERT(INUMP(pid), pid, ARG1, s_waitpid);
+  ASSERT(INUMP(options), options, ARG2, s_waitpid);
+  SYSCALL(i = waitpid(INUM(pid), &status, INUM(options)););
+  return i < 0 ? BOOL_F : MAKINUM(0L+status);
+}
+
+SCM l_getppid()
+{
+  return MAKINUM(0L+getppid());
+}
+
+SCM l_getuid()
+{
+  return MAKINUM(0L+getuid());
+}
+SCM l_getgid()
+{
+  return MAKINUM(0L+getgid());
+}
+#ifndef LACK_E_IDs
+SCM l_geteuid()
+{
+  return MAKINUM(0L+geteuid());
+}
+SCM l_getegid()
+{
+  return MAKINUM(0L+getegid());
+}
+#endif
+
+static char s_setuid[] = "setuid";
+SCM l_setuid(id)
+     SCM id;
+{
+  ASSERT(INUMP(id), id, ARG1, s_setuid);
+  return setuid(INUM(id)) ? BOOL_F : BOOL_T;
+}
+static char s_setgid[] = "setgid";
+SCM l_setgid(id)
+     SCM id;
+{
+  ASSERT(INUMP(id), id, ARG1, s_setgid);
+  return setgid(INUM(id)) ? BOOL_F : BOOL_T;
+}
+
+#ifndef LACK_E_IDs
+static char s_seteuid[] = "seteuid";
+SCM l_seteuid(id)
+     SCM id;
+{
+  ASSERT(INUMP(id), id, ARG1, s_seteuid);
+  return seteuid(INUM(id)) ? BOOL_F : BOOL_T;
+}
+static char s_setegid[] = "setegid";
+SCM l_setegid(id)
+     SCM id;
+{
+  ASSERT(INUMP(id), id, ARG1, s_setegid);
+  return setegid(INUM(id)) ? BOOL_F : BOOL_T;
+}
+#endif
+
+static char s_ttyname[] = "ttyname";
+SCM l_ttyname(port)
+     SCM port;
+{
+  char *ans;
+  ASSERT(NIMP(port) && OPPORTP(port), port, ARG1, s_ttyname);
+  if (tc16_fport != TYP16(port)) return BOOL_F;
+  SYSCALL(ans = ttyname(fileno(STREAM(port))););
+  /* ans could be overwritten by another call to ttyname */
+  return ans ? makfrom0str(ans) : BOOL_F;
+}
+
+SCM l_fork()
+{
+  long pid = 0L + fork();
+  return -1L==pid ? BOOL_F : MAKINUM(pid);
+}
+
+#include <sys/utsname.h>
+SCM l_uname()
+{
+  struct utsname buf;
+  SCM ans = make_vector(MAKINUM(5), UNSPECIFIED);
+  SCM *ve = VELTS(ans);
+  if (uname(&buf)) return BOOL_F;
+  ve[ 0] = makfrom0str(buf.sysname);
+  ve[ 1] = makfrom0str(buf.nodename);
+  ve[ 2] = makfrom0str(buf.release);
+  ve[ 3] = makfrom0str(buf.version);
+  ve[ 4] = makfrom0str(buf.machine);
+  /* ve[ 5] = makfrom0str(buf.domainname); */
+  return ans;
+}
+
+static iproc subr0s[] = {
+	{"pipe", l_pipe},
+	{scm_s_getgroups, scm_getgroups},
+	{"getppid", l_getppid},
+	{"getuid", l_getuid},
+	{"getgid", l_getgid},
+#ifndef LACK_E_IDs
+	{"getegid", l_getegid},
+	{"geteuid", l_geteuid},
+#endif
+	{"uname", l_uname},
+	{"fork", l_fork},
+	{0, 0}};
+
+static iproc subr1os[] = {
+	{s_pwinfo, l_pwinfo},
+	{s_grinfo, l_grinfo},
+	{"setpwent", l_setpw},
+	{"setgrent", l_setgr},
+	{0, 0}};
+
+static iproc subr1s[] = {
+	{"setuid", l_setuid},
+	{"setgid", l_setgid},
+#ifndef LACK_E_IDs
+	{"setegid", l_setegid},
+	{"seteuid", l_seteuid},
+#endif
+	{"open-input-pipe", l_open_input_pipe},
+	{"open-output-pipe", l_open_output_pipe},
+	{s_ttyname, l_ttyname},
+	{0, 0}};
+
+static iproc subr2s[] = {
+	{s_link, l_link},
+	{s_kill, l_kill},
+	{s_waitpid, l_waitpid},
+	{s_op_pipe, open_pipe},
+	{0, 0}};
+
+static iproc subr3s[] = {
+	{s_chown, l_chown},
+	{0, 0}};
+
+void init_posix()
+{
+	init_iprocs(subr0s, tc7_subr_0);
+	init_iprocs(subr1s, tc7_subr_1);
+	init_iprocs(subr1os, tc7_subr_1o);
+	init_iprocs(subr2s, tc7_subr_2);
+	init_iprocs(subr3s, tc7_subr_3);
+	add_feature("posix");
+	ptobs[0x0ff & (tc16_pipe>>8)].fclose = pclose;
+	ptobs[0x0ff & (tc16_pipe>>8)].free = pclose;
+	ptobs[0x0ff & (tc16_pipe>>8)].print = prinpipe;
+	add_feature(s_pipe);
+}
diff --git a/pre-crt0.c b/pre-crt0.c
new file mode 100644
index 0000000..67fd31c
--- /dev/null
+++ b/pre-crt0.c
@@ -0,0 +1,9 @@
+/* This file is loaded before crt0.o on machines where we do not
+   remap part of the data space into text space in unexec.
+   On these machines, there is no problem with standard crt0.o's
+   that make environ an initialized variable.  However, we do
+   need to make sure the label data_start exists anyway.  */
+
+/* Create a label to appear at the beginning of data space.  */
+
+int data_start = 0;
diff --git a/r4rstest.scm b/r4rstest.scm
new file mode 100644
index 0000000..6573e20
--- /dev/null
+++ b/r4rstest.scm
@@ -0,0 +1,1038 @@
+;; Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
+;;
+;; This program is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by the
+;; Free Software Foundation; either version 2, or (at your option) any
+;; later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; To receive a copy of the GNU General Public License, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA; or view
+;; http://www-swiss.ai.mit.edu/~jaffer/GPL.html
+
+;;;; "r4rstest.scm" Test correctness of scheme implementations.
+;;; Author: Aubrey Jaffer
+
+;;; This includes examples from
+;;; William Clinger and Jonathan Rees, editors.
+;;; Revised^4 Report on the Algorithmic Language Scheme
+;;; and the IEEE specification.
+
+;;; The input tests read this file expecting it to be named "r4rstest.scm".
+;;; Files `tmp1', `tmp2' and `tmp3' will be created in the course of running
+;;; these tests.  You may need to delete them in order to run
+;;; "r4rstest.scm" more than once.
+
+;;;   There are three optional tests:
+;;; (TEST-CONT) tests multiple returns from call-with-current-continuation
+;;; 
+;;; (TEST-SC4) tests procedures required by R4RS but not by IEEE
+;;; 
+;;; (TEST-DELAY) tests DELAY and FORCE, which are not required by
+;;;   either standard.
+
+;;; If you are testing a R3RS version which does not have `list?' do:
+;;; (define list? #f)
+
+;;; send corrections or additions to jaffer@ai.mit.edu
+
+(define cur-section '())(define errs '())
+(define SECTION (lambda args
+		  (display "SECTION") (write args) (newline)
+		  (set! cur-section args) #t))
+(define record-error (lambda (e) (set! errs (cons (list cur-section e) errs))))
+
+(define test
+  (lambda (expect fun . args)
+    (write (cons fun args))
+    (display "  ==> ")
+    ((lambda (res)
+      (write res)
+      (newline)
+      (cond ((not (equal? expect res))
+	     (record-error (list res expect (cons fun args)))
+	     (display " BUT EXPECTED ")
+	     (write expect)
+	     (newline)
+	     #f)
+	    (else #t)))
+     (if (procedure? fun) (apply fun args) (car args)))))
+(define (report-errs)
+  (newline)
+  (if (null? errs) (display "Passed all tests")
+      (begin
+	(display "errors were:")
+	(newline)
+	(display "(SECTION (got expected (call)))")
+	(newline)
+	(for-each (lambda (l) (write l) (newline))
+		  errs)))
+  (newline))
+
+(SECTION 2 1);; test that all symbol characters are supported.
+'(+ - ... !.. $.+ %.- &.! *.: /:. :+. <-. =. >. ?. ~. _. ^.)
+
+(SECTION 3 4)
+(define disjoint-type-functions
+  (list boolean? char? null? number? pair? procedure? string? symbol? vector?))
+(define type-examples
+  (list
+   #t #f #\a '() 9739 '(test) record-error "test" "" 'test '#() '#(a b c) ))
+(define i 1)
+(for-each (lambda (x) (display (make-string i #\ ))
+		  (set! i (+ 3 i))
+		  (write x)
+		  (newline))
+	  disjoint-type-functions)
+(define type-matrix
+  (map (lambda (x)
+	 (let ((t (map (lambda (f) (f x)) disjoint-type-functions)))
+	   (write t)
+	   (write x)
+	   (newline)
+	   t))
+       type-examples))
+(set! i 0)
+(define j 0)
+(for-each (lambda (x y)
+	    (set! j (+ 1 j))
+	    (set! i 0)
+	    (for-each (lambda (f)
+			(set! i (+ 1 i))
+			(cond ((and (= i j))
+			       (cond ((not (f x))) (test #t f x)))
+			      ((f x) (test #f f x)))
+			(cond ((and (= i j))
+			       (cond ((not (f y))) (test #t f y)))
+			      ((f y) (test #f f y))))
+		      disjoint-type-functions))
+	  (list #t #\a '() 9739 '(test) record-error "test" 'car '#(a b c))
+	  (list #f #\newline '() -3252 '(t . t) car "" 'nil '#()))
+(SECTION 4 1 2)
+(test '(quote a) 'quote (quote 'a))
+(test '(quote a) 'quote ''a)
+(SECTION 4 1 3)
+(test 12 (if #f + *) 3 4)
+(SECTION 4 1 4)
+(test 8 (lambda (x) (+ x x)) 4)
+(define reverse-subtract
+  (lambda (x y) (- y x)))
+(test 3 reverse-subtract 7 10)
+(define add4
+  (let ((x 4))
+    (lambda (y) (+ x y))))
+(test 10 add4 6)
+(test '(3 4 5 6) (lambda x x) 3 4 5 6)
+(test '(5 6) (lambda (x y . z) z) 3 4 5 6)
+(SECTION 4 1 5)
+(test 'yes 'if (if (> 3 2) 'yes 'no))
+(test 'no 'if (if (> 2 3) 'yes 'no))
+(test '1 'if (if (> 3 2) (- 3 2) (+ 3 2)))
+(SECTION 4 1 6)
+(define x 2)
+(test 3 'define (+ x 1))
+(set! x 4)
+(test 5 'set! (+ x 1))
+(SECTION 4 2 1)
+(test 'greater 'cond (cond ((> 3 2) 'greater)
+			   ((< 3 2) 'less)))
+(test 'equal 'cond (cond ((> 3 3) 'greater)
+			 ((< 3 3) 'less)
+			 (else 'equal)))
+(test 2 'cond (cond ((assv 'b '((a 1) (b 2))) => cadr)
+		     (else #f)))
+(test 'composite 'case (case (* 2 3)
+			 ((2 3 5 7) 'prime)
+			 ((1 4 6 8 9) 'composite)))
+(test 'consonant 'case (case (car '(c d))
+			 ((a e i o u) 'vowel)
+			 ((w y) 'semivowel)
+			 (else 'consonant)))
+(test #t 'and (and (= 2 2) (> 2 1)))
+(test #f 'and (and (= 2 2) (< 2 1)))
+(test '(f g) 'and (and 1 2 'c '(f g)))
+(test #t 'and (and))
+(test #t 'or (or (= 2 2) (> 2 1)))
+(test #t 'or (or (= 2 2) (< 2 1)))
+(test #f 'or (or #f #f #f))
+(test #f 'or (or))
+(test '(b c) 'or (or (memq 'b '(a b c)) (+ 3 0)))
+(SECTION 4 2 2)
+(test 6 'let (let ((x 2) (y 3)) (* x y)))
+(test 35 'let (let ((x 2) (y 3)) (let ((x 7) (z (+ x y))) (* z x))))
+(test 70 'let* (let ((x 2) (y 3)) (let* ((x 7) (z (+ x y))) (* z x))))
+(test #t 'letrec (letrec ((even?
+			   (lambda (n) (if (zero? n) #t (odd? (- n 1)))))
+			  (odd?
+			   (lambda (n) (if (zero? n) #f (even? (- n 1))))))
+		   (even? 88)))
+(define x 34)
+(test 5 'let (let ((x 3)) (define x 5) x))
+(test 34 'let x)
+(test 6 'let (let () (define x 6) x))
+(test 34 'let x)
+(test 7 'let* (let* ((x 3)) (define x 7) x))
+(test 34 'let* x)
+(test 8 'let* (let* () (define x 8) x))
+(test 34 'let* x)
+(test 9 'letrec (letrec () (define x 9) x))
+(test 34 'letrec x)
+(test 10 'letrec (letrec ((x 3)) (define x 10) x))
+(test 34 'letrec x)
+(SECTION 4 2 3)
+(define x 0)
+(test 6 'begin (begin (set! x 5) (+ x 1)))
+(SECTION 4 2 4)
+(test '#(0 1 2 3 4) 'do (do ((vec (make-vector 5))
+			    (i 0 (+ i 1)))
+			   ((= i 5) vec)
+			 (vector-set! vec i i)))
+(test 25 'do (let ((x '(1 3 5 7 9)))
+	       (do ((x x (cdr x))
+		    (sum 0 (+ sum (car x))))
+		   ((null? x) sum))))
+(test 1 'let (let foo () 1))
+(test '((6 1 3) (-5 -2)) 'let
+      (let loop ((numbers '(3 -2 1 6 -5))
+		 (nonneg '())
+		 (neg '()))
+	(cond ((null? numbers) (list nonneg neg))
+	      ((negative? (car numbers))
+	       (loop (cdr numbers)
+		     nonneg
+		     (cons (car numbers) neg)))
+	      (else
+	       (loop (cdr numbers)
+		     (cons (car numbers) nonneg)
+		     neg)))))
+(SECTION 4 2 6)
+(test '(list 3 4) 'quasiquote `(list ,(+ 1 2) 4))
+(test '(list a (quote a)) 'quasiquote (let ((name 'a)) `(list ,name ',name)))
+(test '(a 3 4 5 6 b) 'quasiquote `(a ,(+ 1 2) ,@(map abs '(4 -5 6)) b))
+(test '((foo 7) . cons)
+	'quasiquote
+	`((foo ,(- 10 3)) ,@(cdr '(c)) . ,(car '(cons))))
+
+;;; sqt is defined here because not all implementations are required to
+;;; support it. 
+(define (sqt x)
+	(do ((i 0 (+ i 1)))
+	    ((> (* i i) x) (- i 1))))
+
+(test '#(10 5 2 4 3 8) 'quasiquote `#(10 5 ,(sqt 4) ,@(map sqt '(16 9)) 8))
+(test 5 'quasiquote `,(+ 2 3))
+(test '(a `(b ,(+ 1 2) ,(foo 4 d) e) f)
+      'quasiquote `(a `(b ,(+ 1 2) ,(foo ,(+ 1 3) d) e) f))
+(test '(a `(b ,x ,'y d) e) 'quasiquote
+	(let ((name1 'x) (name2 'y)) `(a `(b ,,name1 ,',name2 d) e)))
+(test '(list 3 4) 'quasiquote (quasiquote (list (unquote (+ 1 2)) 4)))
+(test '`(list ,(+ 1 2) 4) 'quasiquote '(quasiquote (list (unquote (+ 1 2)) 4)))
+(SECTION 5 2 1)
+(define add3 (lambda (x) (+ x 3)))
+(test 6 'define (add3 3))
+(define first car)
+(test 1 'define (first '(1 2)))
+(define old-+ +)
+(define + (lambda (x y) (list y x)))
+(test '(3 6) add3 6)
+(set! + old-+)
+(test 9 add3 6)
+(SECTION 5 2 2)
+(test 45 'define
+	(let ((x 5))
+		(define foo (lambda (y) (bar x y)))
+		(define bar (lambda (a b) (+ (* a b) a)))
+		(foo (+ x 3))))
+(define x 34)
+(define (foo) (define x 5) x)
+(test 5 foo)
+(test 34 'define x)
+(define foo (lambda () (define x 5) x))
+(test 5 foo)
+(test 34 'define x)
+(define (foo x) ((lambda () (define x 5) x)) x)
+(test 88 foo 88)
+(test 4 foo 4)
+(test 34 'define x)
+(SECTION 6 1)
+(test #f not #t)
+(test #f not 3)
+(test #f not (list 3))
+(test #t not #f)
+(test #f not '())
+(test #f not (list))
+(test #f not 'nil)
+
+;(test #t boolean? #f)
+;(test #f boolean? 0)
+;(test #f boolean? '())
+(SECTION 6 2)
+(test #t eqv? 'a 'a)
+(test #f eqv? 'a 'b)
+(test #t eqv? 2 2)
+(test #t eqv? '() '())
+(test #t eqv? '10000 '10000)
+(test #f eqv? (cons 1 2)(cons 1 2))
+(test #f eqv? (lambda () 1) (lambda () 2))
+(test #f eqv? #f 'nil)
+(let ((p (lambda (x) x)))
+  (test #t eqv? p p))
+(define gen-counter
+ (lambda ()
+   (let ((n 0))
+      (lambda () (set! n (+ n 1)) n))))
+(let ((g (gen-counter))) (test #t eqv? g g))
+(test #f eqv? (gen-counter) (gen-counter))
+(letrec ((f (lambda () (if (eqv? f g) 'f 'both)))
+	 (g (lambda () (if (eqv? f g) 'g 'both))))
+  (test #f eqv? f g))
+
+(test #t eq? 'a 'a)
+(test #f eq? (list 'a) (list 'a))
+(test #t eq? '() '())
+(test #t eq? car car)
+(let ((x '(a))) (test #t eq? x x))
+(let ((x '#())) (test #t eq? x x))
+(let ((x (lambda (x) x))) (test #t eq? x x))
+
+(test #t equal? 'a 'a)
+(test #t equal? '(a) '(a))
+(test #t equal? '(a (b) c) '(a (b) c))
+(test #t equal? "abc" "abc")
+(test #t equal? 2 2)
+(test #t equal? (make-vector 5 'a) (make-vector 5 'a))
+(SECTION 6 3)
+(test '(a b c d e) 'dot '(a . (b . (c . (d . (e . ()))))))
+(define x (list 'a 'b 'c))
+(define y x)
+(and list? (test #t list? y))
+(set-cdr! x 4)
+(test '(a . 4) 'set-cdr! x)
+(test #t eqv? x y)
+(test '(a b c . d) 'dot '(a . (b . (c . d))))
+(and list? (test #f list? y))
+(and list? (let ((x (list 'a))) (set-cdr! x x) (test #f 'list? (list? x))))
+
+;(test #t pair? '(a . b))
+;(test #t pair? '(a . 1))
+;(test #t pair? '(a b c))
+;(test #f pair? '())
+;(test #f pair? '#(a b))
+
+(test '(a) cons 'a '())
+(test '((a) b c d) cons '(a) '(b c d))
+(test '("a" b c) cons "a" '(b c))
+(test '(a . 3) cons 'a 3)
+(test '((a b) . c) cons '(a b) 'c)
+
+(test 'a car '(a b c))
+(test '(a) car '((a) b c d))
+(test 1 car '(1 . 2))
+
+(test '(b c d) cdr '((a) b c d))
+(test 2 cdr '(1 . 2))
+
+(test '(a 7 c) list 'a (+ 3 4) 'c)
+(test '() list)
+
+(test 3 length '(a b c))
+(test 3 length '(a (b) (c d e)))
+(test 0 length '())
+
+(test '(x y) append '(x) '(y))
+(test '(a b c d) append '(a) '(b c d))
+(test '(a (b) (c)) append '(a (b)) '((c)))
+(test '() append)
+(test '(a b c . d) append '(a b) '(c . d))
+(test 'a append '() 'a)
+
+(test '(c b a) reverse '(a b c))
+(test '((e (f)) d (b c) a) reverse '(a (b c) d (e (f))))
+
+(test 'c list-ref '(a b c d) 2)
+
+(test '(a b c) memq 'a '(a b c))
+(test '(b c) memq 'b '(a b c))
+(test '#f memq 'a '(b c d))
+(test '#f memq (list 'a) '(b (a) c))
+(test '((a) c) member (list 'a) '(b (a) c))
+(test '(101 102) memv 101 '(100 101 102))
+
+(define e '((a 1) (b 2) (c 3)))
+(test '(a 1) assq 'a e)
+(test '(b 2) assq 'b e)
+(test #f assq 'd e)
+(test #f assq (list 'a) '(((a)) ((b)) ((c))))
+(test '((a)) assoc (list 'a) '(((a)) ((b)) ((c))))
+(test '(5 7) assv 5 '((2 3) (5 7) (11 13)))
+(SECTION 6 4)
+;(test #t symbol? 'foo)
+(test #t symbol? (car '(a b)))
+;(test #f symbol? "bar")
+;(test #t symbol? 'nil)
+;(test #f symbol? '())
+;(test #f symbol? #f)
+;;; But first, what case are symbols in?  Determine the standard case:
+(define char-standard-case char-upcase)
+(if (string=? (symbol->string 'A) "a")
+    (set! char-standard-case char-downcase))
+(test #t 'standard-case
+      (string=? (symbol->string 'a) (symbol->string 'A)))
+(test #t 'standard-case
+      (or (string=? (symbol->string 'a) "A")
+	  (string=? (symbol->string 'A) "a")))
+(define (str-copy s)
+  (let ((v (make-string (string-length s))))
+    (do ((i (- (string-length v) 1) (- i 1)))
+	((< i 0) v)
+      (string-set! v i (string-ref s i)))))
+(define (string-standard-case s)
+  (set! s (str-copy s))
+  (do ((i 0 (+ 1 i))
+       (sl (string-length s)))
+      ((>= i sl) s)
+      (string-set! s i (char-standard-case (string-ref s i)))))
+(test (string-standard-case "flying-fish") symbol->string 'flying-fish)
+(test (string-standard-case "martin") symbol->string 'Martin)
+(test "Malvina" symbol->string (string->symbol "Malvina"))
+(test #t 'standard-case (eq? 'a 'A))
+
+(define x (string #\a #\b))
+(define y (string->symbol x))
+(string-set! x 0 #\c)
+(test "cb" 'string-set! x)
+(test "ab" symbol->string y)
+(test y string->symbol "ab")
+
+(test #t eq? 'mISSISSIppi 'mississippi)
+(test #f 'string->symbol (eq? 'bitBlt (string->symbol "bitBlt")))
+(test 'JollyWog string->symbol (symbol->string 'JollyWog))
+
+(SECTION 6 5 5)
+(test #t number? 3)
+(test #t complex? 3)
+(test #t real? 3)
+(test #t rational? 3)
+(test #t integer? 3)
+
+(test #t exact? 3)
+(test #f inexact? 3)
+
+(test #t = 22 22 22)
+(test #t = 22 22)
+(test #f = 34 34 35)
+(test #f = 34 35)
+(test #t > 3 -6246)
+(test #f > 9 9 -2424)
+(test #t >= 3 -4 -6246)
+(test #t >= 9 9)
+(test #f >= 8 9)
+(test #t < -1 2 3 4 5 6 7 8)
+(test #f < -1 2 3 4 4 5 6 7)
+(test #t <= -1 2 3 4 5 6 7 8)
+(test #t <= -1 2 3 4 4 5 6 7)
+(test #f < 1 3 2)
+(test #f >= 1 3 2)
+
+(test #t zero? 0)
+(test #f zero? 1)
+(test #f zero? -1)
+(test #f zero? -100)
+(test #t positive? 4)
+(test #f positive? -4)
+(test #f positive? 0)
+(test #f negative? 4)
+(test #t negative? -4)
+(test #f negative? 0)
+(test #t odd? 3)
+(test #f odd? 2)
+(test #f odd? -4)
+(test #t odd? -1)
+(test #f even? 3)
+(test #t even? 2)
+(test #t even? -4)
+(test #f even? -1)
+
+(test 38 max 34 5 7 38 6)
+(test -24 min 3  5 5 330 4 -24)
+
+(test 7 + 3 4)
+(test '3 + 3)
+(test 0 +)
+(test 4 * 4)
+(test 1 *)
+
+(test -1 - 3 4)
+(test -3 - 3)
+(test 7 abs -7)
+(test 7 abs 7)
+(test 0 abs 0)
+
+(test 5 quotient 35 7)
+(test -5 quotient -35 7)
+(test -5 quotient 35 -7)
+(test 5 quotient -35 -7)
+(test 1 modulo 13 4)
+(test 1 remainder 13 4)
+(test 3 modulo -13 4)
+(test -1 remainder -13 4)
+(test -3 modulo 13 -4)
+(test 1 remainder 13 -4)
+(test -1 modulo -13 -4)
+(test -1 remainder -13 -4)
+(define (divtest n1 n2)
+	(= n1 (+ (* n2 (quotient n1 n2))
+		 (remainder n1 n2))))
+(test #t divtest 238 9)
+(test #t divtest -238 9)
+(test #t divtest 238 -9)
+(test #t divtest -238 -9)
+
+(test 4 gcd 0 4)
+(test 4 gcd -4 0)
+(test 4 gcd 32 -36)
+(test 0 gcd)
+(test 288 lcm 32 -36)
+(test 1 lcm)
+
+;;;;From: fred@sce.carleton.ca (Fred J Kaudel)
+;;; Modified by jaffer.
+(define (test-inexact)
+  (define f3.9 (string->number "3.9"))
+  (define f4.0 (string->number "4.0"))
+  (define f-3.25 (string->number "-3.25"))
+  (define f.25 (string->number ".25"))
+  (define f4.5 (string->number "4.5"))
+  (define f3.5 (string->number "3.5"))
+  (define f0.0 (string->number "0.0"))
+  (define f0.8 (string->number "0.8"))
+  (define f1.0 (string->number "1.0"))
+  (define wto write-test-obj)
+  (define dto display-test-obj)
+  (define lto load-test-obj)
+  (newline)
+  (display ";testing inexact numbers; ")
+  (newline)
+  (SECTION 6 5 5)
+  (test #t inexact? f3.9)
+  (test #t 'inexact? (inexact? (max f3.9 4)))
+  (test f4.0 'max (max f3.9 4))
+  (test f4.0 'exact->inexact (exact->inexact 4))
+  (test (- f4.0) round (- f4.5))
+  (test (- f4.0) round (- f3.5))
+  (test (- f4.0) round (- f3.9))
+  (test f0.0 round f0.0)
+  (test f0.0 round f.25)
+  (test f1.0 round f0.8)
+  (test f4.0 round f3.5)
+  (test f4.0 round f4.5)
+  (set! write-test-obj (list f.25 f-3.25));.25 inexact errors less likely.
+  (set! display-test-obj (list f.25 f-3.25));.3 often has such errors (~10^-13)
+  (set! load-test-obj (list 'define 'foo (list 'quote write-test-obj)))
+  (test #t call-with-output-file
+      "tmp3"
+      (lambda (test-file)
+	(write-char #\; test-file)
+	(display write-test-obj test-file)
+	(newline test-file)
+	(write load-test-obj test-file)
+	(output-port? test-file)))
+  (check-test-file "tmp3")
+  (set! write-test-obj wto)
+  (set! display-test-obj dto)
+  (set! load-test-obj lto)
+  (let ((x (string->number "4195835.0"))
+	(y (string->number "3145727.0")))
+    (test #t 'pentium-fdiv-bug (> f1.0 (- x (* (/ x y) y)))))
+  (report-errs))
+
+(define (test-bignum)
+  (define tb
+    (lambda (n1 n2)
+      (= n1 (+ (* n2 (quotient n1 n2))
+	       (remainder n1 n2)))))
+  (newline)
+  (display ";testing bignums; ")
+  (newline)
+  (SECTION 6 5 5)
+  (test 0 modulo 3333333333 3)
+  (test 0 modulo 3333333333 -3)
+  (test 0 remainder 3333333333 3)
+  (test 0 remainder 3333333333 -3)
+  (test 2 modulo 3333333332 3)
+  (test -1 modulo 3333333332 -3)
+  (test 2 remainder 3333333332 3)
+  (test 2 remainder 3333333332 -3)
+  (test 1 modulo -3333333332 3)
+  (test -2 modulo -3333333332 -3)
+  (test -2 remainder -3333333332 3)
+  (test -2 remainder -3333333332 -3)
+
+  (test 3 modulo 3 3333333333)
+  (test 3333333330 modulo -3 3333333333)
+  (test 3 remainder 3 3333333333)
+  (test -3 remainder -3 3333333333)
+  (test -3333333330 modulo 3 -3333333333)
+  (test -3 modulo -3 -3333333333)
+  (test 3 remainder 3 -3333333333)
+  (test -3 remainder -3 -3333333333)
+
+  (test 0 modulo -2177452800 86400)
+  (test 0 modulo 2177452800 -86400)
+  (test 0 modulo 2177452800 86400)
+  (test 0 modulo -2177452800 -86400)
+  (test #t 'remainder (tb 281474976710655 65535))
+  (test #t 'remainder (tb 281474976710654 65535))
+  (SECTION 6 5 6)
+  (test 281474976710655 string->number "281474976710655")
+  (test "281474976710655" number->string 281474976710655)
+  (report-errs))
+
+(SECTION 6 5 6)
+(test "0" number->string 0)
+(test "100" number->string 100)
+(test "100" number->string 256 16)
+(test 100 string->number "100")
+(test 256 string->number "100" 16)
+(test #f string->number "")
+(test #f string->number ".")
+(test #f string->number "d")
+(test #f string->number "D")
+(test #f string->number "i")
+(test #f string->number "I")
+(test #f string->number "3i")
+(test #f string->number "3I")
+(test #f string->number "33i")
+(test #f string->number "33I")
+(test #f string->number "3.3i")
+(test #f string->number "3.3I")
+(test #f string->number "-")
+(test #f string->number "+")
+
+(SECTION 6 6)
+(test #t eqv? '#\  #\Space)
+(test #t eqv? #\space '#\Space)
+(test #t char? #\a)
+(test #t char? #\()
+(test #t char? #\ )
+(test #t char? '#\newline)
+
+(test #f char=? #\A #\B)
+(test #f char=? #\a #\b)
+(test #f char=? #\9 #\0)
+(test #t char=? #\A #\A)
+
+(test #t char<? #\A #\B)
+(test #t char<? #\a #\b)
+(test #f char<? #\9 #\0)
+(test #f char<? #\A #\A)
+
+(test #f char>? #\A #\B)
+(test #f char>? #\a #\b)
+(test #t char>? #\9 #\0)
+(test #f char>? #\A #\A)
+
+(test #t char<=? #\A #\B)
+(test #t char<=? #\a #\b)
+(test #f char<=? #\9 #\0)
+(test #t char<=? #\A #\A)
+
+(test #f char>=? #\A #\B)
+(test #f char>=? #\a #\b)
+(test #t char>=? #\9 #\0)
+(test #t char>=? #\A #\A)
+
+(test #f char-ci=? #\A #\B)
+(test #f char-ci=? #\a #\B)
+(test #f char-ci=? #\A #\b)
+(test #f char-ci=? #\a #\b)
+(test #f char-ci=? #\9 #\0)
+(test #t char-ci=? #\A #\A)
+(test #t char-ci=? #\A #\a)
+
+(test #t char-ci<? #\A #\B)
+(test #t char-ci<? #\a #\B)
+(test #t char-ci<? #\A #\b)
+(test #t char-ci<? #\a #\b)
+(test #f char-ci<? #\9 #\0)
+(test #f char-ci<? #\A #\A)
+(test #f char-ci<? #\A #\a)
+
+(test #f char-ci>? #\A #\B)
+(test #f char-ci>? #\a #\B)
+(test #f char-ci>? #\A #\b)
+(test #f char-ci>? #\a #\b)
+(test #t char-ci>? #\9 #\0)
+(test #f char-ci>? #\A #\A)
+(test #f char-ci>? #\A #\a)
+
+(test #t char-ci<=? #\A #\B)
+(test #t char-ci<=? #\a #\B)
+(test #t char-ci<=? #\A #\b)
+(test #t char-ci<=? #\a #\b)
+(test #f char-ci<=? #\9 #\0)
+(test #t char-ci<=? #\A #\A)
+(test #t char-ci<=? #\A #\a)
+
+(test #f char-ci>=? #\A #\B)
+(test #f char-ci>=? #\a #\B)
+(test #f char-ci>=? #\A #\b)
+(test #f char-ci>=? #\a #\b)
+(test #t char-ci>=? #\9 #\0)
+(test #t char-ci>=? #\A #\A)
+(test #t char-ci>=? #\A #\a)
+
+(test #t char-alphabetic? #\a)
+(test #t char-alphabetic? #\A)
+(test #t char-alphabetic? #\z)
+(test #t char-alphabetic? #\Z)
+(test #f char-alphabetic? #\0)
+(test #f char-alphabetic? #\9)
+(test #f char-alphabetic? #\space)
+(test #f char-alphabetic? #\;)
+
+(test #f char-numeric? #\a)
+(test #f char-numeric? #\A)
+(test #f char-numeric? #\z)
+(test #f char-numeric? #\Z)
+(test #t char-numeric? #\0)
+(test #t char-numeric? #\9)
+(test #f char-numeric? #\space)
+(test #f char-numeric? #\;)
+
+(test #f char-whitespace? #\a)
+(test #f char-whitespace? #\A)
+(test #f char-whitespace? #\z)
+(test #f char-whitespace? #\Z)
+(test #f char-whitespace? #\0)
+(test #f char-whitespace? #\9)
+(test #t char-whitespace? #\space)
+(test #f char-whitespace? #\;)
+
+(test #f char-upper-case? #\0)
+(test #f char-upper-case? #\9)
+(test #f char-upper-case? #\space)
+(test #f char-upper-case? #\;)
+
+(test #f char-lower-case? #\0)
+(test #f char-lower-case? #\9)
+(test #f char-lower-case? #\space)
+(test #f char-lower-case? #\;)
+
+(test #\. integer->char (char->integer #\.))
+(test #\A integer->char (char->integer #\A))
+(test #\a integer->char (char->integer #\a))
+(test #\A char-upcase #\A)
+(test #\A char-upcase #\a)
+(test #\a char-downcase #\A)
+(test #\a char-downcase #\a)
+(SECTION 6 7)
+(test #t string? "The word \"recursion\\\" has many meanings.")
+;(test #t string? "")
+(define f (make-string 3 #\*))
+(test "?**" 'string-set! (begin (string-set! f 0 #\?) f))
+(test "abc" string #\a #\b #\c)
+(test "" string)
+(test 3 string-length "abc")
+(test #\a string-ref "abc" 0)
+(test #\c string-ref "abc" 2)
+(test 0 string-length "")
+(test "" substring "ab" 0 0)
+(test "" substring "ab" 1 1)
+(test "" substring "ab" 2 2)
+(test "a" substring "ab" 0 1)
+(test "b" substring "ab" 1 2)
+(test "ab" substring "ab" 0 2)
+(test "foobar" string-append "foo" "bar")
+(test "foo" string-append "foo")
+(test "foo" string-append "foo" "")
+(test "foo" string-append "" "foo")
+(test "" string-append)
+(test "" make-string 0)
+(test #t string=? "" "")
+(test #f string<? "" "")
+(test #f string>? "" "")
+(test #t string<=? "" "")
+(test #t string>=? "" "")
+(test #t string-ci=? "" "")
+(test #f string-ci<? "" "")
+(test #f string-ci>? "" "")
+(test #t string-ci<=? "" "")
+(test #t string-ci>=? "" "")
+
+(test #f string=? "A" "B")
+(test #f string=? "a" "b")
+(test #f string=? "9" "0")
+(test #t string=? "A" "A")
+
+(test #t string<? "A" "B")
+(test #t string<? "a" "b")
+(test #f string<? "9" "0")
+(test #f string<? "A" "A")
+
+(test #f string>? "A" "B")
+(test #f string>? "a" "b")
+(test #t string>? "9" "0")
+(test #f string>? "A" "A")
+
+(test #t string<=? "A" "B")
+(test #t string<=? "a" "b")
+(test #f string<=? "9" "0")
+(test #t string<=? "A" "A")
+
+(test #f string>=? "A" "B")
+(test #f string>=? "a" "b")
+(test #t string>=? "9" "0")
+(test #t string>=? "A" "A")
+
+(test #f string-ci=? "A" "B")
+(test #f string-ci=? "a" "B")
+(test #f string-ci=? "A" "b")
+(test #f string-ci=? "a" "b")
+(test #f string-ci=? "9" "0")
+(test #t string-ci=? "A" "A")
+(test #t string-ci=? "A" "a")
+
+(test #t string-ci<? "A" "B")
+(test #t string-ci<? "a" "B")
+(test #t string-ci<? "A" "b")
+(test #t string-ci<? "a" "b")
+(test #f string-ci<? "9" "0")
+(test #f string-ci<? "A" "A")
+(test #f string-ci<? "A" "a")
+
+(test #f string-ci>? "A" "B")
+(test #f string-ci>? "a" "B")
+(test #f string-ci>? "A" "b")
+(test #f string-ci>? "a" "b")
+(test #t string-ci>? "9" "0")
+(test #f string-ci>? "A" "A")
+(test #f string-ci>? "A" "a")
+
+(test #t string-ci<=? "A" "B")
+(test #t string-ci<=? "a" "B")
+(test #t string-ci<=? "A" "b")
+(test #t string-ci<=? "a" "b")
+(test #f string-ci<=? "9" "0")
+(test #t string-ci<=? "A" "A")
+(test #t string-ci<=? "A" "a")
+
+(test #f string-ci>=? "A" "B")
+(test #f string-ci>=? "a" "B")
+(test #f string-ci>=? "A" "b")
+(test #f string-ci>=? "a" "b")
+(test #t string-ci>=? "9" "0")
+(test #t string-ci>=? "A" "A")
+(test #t string-ci>=? "A" "a")
+(SECTION 6 8)
+(test #t vector? '#(0 (2 2 2 2) "Anna"))
+;(test #t vector? '#())
+(test '#(a b c) vector 'a 'b 'c)
+(test '#() vector)
+(test 3 vector-length '#(0 (2 2 2 2) "Anna"))
+(test 0 vector-length '#())
+(test 8 vector-ref '#(1 1 2 3 5 8 13 21) 5)
+(test '#(0 ("Sue" "Sue") "Anna") 'vector-set
+	(let ((vec (vector 0 '(2 2 2 2) "Anna")))
+	  (vector-set! vec 1 '("Sue" "Sue"))
+	  vec))
+(test '#(hi hi) make-vector 2 'hi)
+(test '#() make-vector 0)
+(test '#() make-vector 0 'a)
+(SECTION 6 9)
+(test #t procedure? car)
+;(test #f procedure? 'car)
+(test #t procedure? (lambda (x) (* x x)))
+(test #f procedure? '(lambda (x) (* x x)))
+(test #t call-with-current-continuation procedure?)
+(test 7 apply + (list 3 4))
+(test 7 apply (lambda (a b) (+ a b)) (list 3 4))
+(test 17 apply + 10 (list 3 4))
+(test '() apply list '())
+(define compose (lambda (f g) (lambda args (f (apply g args)))))
+(test 30 (compose sqt *) 12 75)
+
+(test '(b e h) map cadr '((a b) (d e) (g h)))
+(test '(5 7 9) map + '(1 2 3) '(4 5 6))
+(test '#(0 1 4 9 16) 'for-each
+	(let ((v (make-vector 5)))
+		(for-each (lambda (i) (vector-set! v i (* i i)))
+			'(0 1 2 3 4))
+		v))
+(test -3 call-with-current-continuation
+		(lambda (exit)
+		 (for-each (lambda (x) (if (negative? x) (exit x)))
+		 	'(54 0 37 -3 245 19))
+		#t))
+(define list-length
+ (lambda (obj)
+  (call-with-current-continuation
+   (lambda (return)
+    (letrec ((r (lambda (obj) (cond ((null? obj) 0)
+				((pair? obj) (+ (r (cdr obj)) 1))
+				(else (return #f))))))
+	(r obj))))))
+(test 4 list-length '(1 2 3 4))
+(test #f list-length '(a b . c))
+(test '() map cadr '())
+
+;;; This tests full conformance of call-with-current-continuation.  It
+;;; is a separate test because some schemes do not support call/cc
+;;; other than escape procedures.  I am indebted to
+;;; raja@copper.ucs.indiana.edu (Raja Sooriamurthi) for fixing this
+;;; code.  The function leaf-eq? compares the leaves of 2 arbitrary
+;;; trees constructed of conses.  
+(define (next-leaf-generator obj eot)
+  (letrec ((return #f)
+	   (cont (lambda (x)
+		   (recur obj)
+		   (set! cont (lambda (x) (return eot)))
+		   (cont #f)))
+	   (recur (lambda (obj)
+		      (if (pair? obj)
+			  (for-each recur obj)
+			  (call-with-current-continuation
+			   (lambda (c)
+			     (set! cont c)
+			     (return obj)))))))
+    (lambda () (call-with-current-continuation
+		(lambda (ret) (set! return ret) (cont #f))))))
+(define (leaf-eq? x y)
+  (let* ((eot (list 'eot))
+	 (xf (next-leaf-generator x eot))
+	 (yf (next-leaf-generator y eot)))
+    (letrec ((loop (lambda (x y)
+		     (cond ((not (eq? x y)) #f)
+			   ((eq? eot x) #t)
+			   (else (loop (xf) (yf)))))))
+      (loop (xf) (yf)))))
+(define (test-cont)
+  (newline)
+  (display ";testing continuations; ")
+  (newline)
+  (SECTION 6 9)
+  (test #t leaf-eq? '(a (b (c))) '((a) b c))
+  (test #f leaf-eq? '(a (b (c))) '((a) b c d))
+  (report-errs))
+
+;;; Test Optional R4RS DELAY syntax and FORCE procedure
+(define (test-delay)
+  (newline)
+  (display ";testing DELAY and FORCE; ")
+  (newline)
+  (SECTION 6 9)
+  (test 3 'delay (force (delay (+ 1 2))))
+  (test '(3 3) 'delay (let ((p (delay (+ 1 2))))
+			(list (force p) (force p))))
+  (test 2 'delay (letrec ((a-stream
+			   (letrec ((next (lambda (n)
+					    (cons n (delay (next (+ n 1)))))))
+			     (next 0)))
+			  (head car)
+			  (tail (lambda (stream) (force (cdr stream)))))
+		   (head (tail (tail a-stream)))))
+  (letrec ((count 0)
+	   (p (delay (begin (set! count (+ count 1))
+			    (if (> count x)
+				count
+				(force p)))))
+	   (x 5))
+    (test 6 force p)
+    (set! x 10)
+    (test 6 force p))
+  (test 3 'force
+	(letrec ((p (delay (if c 3 (begin (set! c #t) (+ (force p) 1)))))
+		 (c #f))
+	  (force p)))
+  (report-errs))
+
+(SECTION 6 10 1)
+(test #t input-port? (current-input-port))
+(test #t output-port? (current-output-port))
+(test #t call-with-input-file "r4rstest.scm" input-port?)
+(define this-file (open-input-file "r4rstest.scm"))
+(test #t input-port? this-file)
+(SECTION 6 10 2)
+(test #\; peek-char this-file)
+(test #\; read-char this-file)
+(test '(define cur-section '()) read this-file)
+(test #\( peek-char this-file)
+(test '(define errs '()) read this-file)
+(close-input-port this-file)
+(close-input-port this-file)
+(define (check-test-file name)
+  (define test-file (open-input-file name))
+  (test #t 'input-port?
+	(call-with-input-file
+	    name
+	  (lambda (test-file)
+	    (test load-test-obj read test-file)
+	    (test #t eof-object? (peek-char test-file))
+	    (test #t eof-object? (read-char test-file))
+	    (input-port? test-file))))
+  (test #\; read-char test-file)
+  (test display-test-obj read test-file)
+  (test load-test-obj read test-file)
+  (close-input-port test-file))
+(SECTION 6 10 3)
+(define write-test-obj
+  '(#t #f #\a () 9739 -3 . #((test) "te \" \" st" "" test #() b c)))
+(define display-test-obj
+  '(#t #f a () 9739 -3 . #((test) te " " st test #() b c)))
+(define load-test-obj
+  (list 'define 'foo (list 'quote write-test-obj)))
+(test #t call-with-output-file
+      "tmp1"
+      (lambda (test-file)
+	(write-char #\; test-file)
+	(display write-test-obj test-file)
+	(newline test-file)
+	(write load-test-obj test-file)
+	(output-port? test-file)))
+(check-test-file "tmp1")
+
+(define test-file (open-output-file "tmp2"))
+(write-char #\; test-file)
+(display write-test-obj test-file)
+(newline test-file)
+(write load-test-obj test-file)
+(test #t output-port? test-file)
+(close-output-port test-file)
+(check-test-file "tmp2")
+(define (test-sc4)
+  (newline)
+  (display ";testing scheme 4 functions; ")
+  (newline)
+  (SECTION 6 7)
+  (test '(#\P #\space #\l) string->list "P l")
+  (test '() string->list "")
+  (test "1\\\"" list->string '(#\1 #\\ #\"))
+  (test "" list->string '())
+  (SECTION 6 8)
+  (test '(dah dah didah) vector->list '#(dah dah didah))
+  (test '() vector->list '#())
+  (test '#(dididit dah) list->vector '(dididit dah))
+  (test '#() list->vector '())
+  (SECTION 6 10 4)
+  (load "tmp1")
+  (test write-test-obj 'load foo)
+  (report-errs))
+
+(report-errs)
+(if (and (string->number "0.0") (inexact? (string->number "0.0")))
+    (test-inexact))
+
+(let ((n (string->number "281474976710655")))
+  (if (and n (exact? n))
+      (test-bignum)))
+(newline)
+(display "To fully test continuations, Scheme 4, and DELAY/FORCE do:")
+(newline)
+(display "(test-cont) (test-sc4) (test-delay)")
+(newline)
+"last item in file"
diff --git a/ramap.c b/ramap.c
new file mode 100644
index 0000000..b869ff6
--- /dev/null
+++ b/ramap.c
@@ -0,0 +1,1677 @@
+/* Copyright (C) 1994, 1995 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  
+ */
+
+/* "ramap.c" Array mapping functions for APL-Scheme.
+   Author: Radey Shouman */
+
+#include "scm.h"
+
+typedef struct {
+  char *name;
+  SCM sproc;
+  int (* vproc)();
+} ra_iproc;
+
+# define BVE_REF(a, i) ((VELTS(a)[(i)/LONG_BIT] & (1L<<((i)%LONG_BIT))) ? 1 : 0)
+# define BVE_SET(a, i) (VELTS(a)[(i)/LONG_BIT] |= (1L<<((i)%LONG_BIT)))
+# define BVE_CLR(a, i) (VELTS(a)[(i)/LONG_BIT] &= ~(1L<<((i)%LONG_BIT)))
+/* Fast, recycling vector ref */
+# define RVREF(ra, i, e) (e = cvref(ra, i, e))
+/* #define RVREF(ra, i, e) (cvref(ra, i, UNDEFINED)) to turn off */
+
+/* IVDEP means "ignore vector dependencies", meaning we guarantee that
+   elements of vector operands are not aliased */
+# ifdef _UNICOS
+#  define IVDEP(test, line) if (test) {_Pragma("ivdep"); line} else {line}
+# else
+#  define IVDEP(test, line) line
+# endif
+
+				/* inds must be a uvect or ivect, no check. */
+static sizet cind(ra, inds)
+     SCM ra, inds;
+{
+  sizet i;
+  int k;
+  long *ve = VELTS(inds);
+  if (!ARRAYP(ra))
+    return *ve;
+  i = ARRAY_BASE(ra);
+  for (k = 0; k < ARRAY_NDIM(ra); k++)
+    i += (ve[k] - ARRAY_DIMS(ra)[k].lbnd)*ARRAY_DIMS(ra)[k].inc;
+  return i;
+}
+
+  /* Checker for array mapping functions:
+     return values: 4 --> shapes, increments, and bases are the same;
+		    3 --> shapes and increments are the same;
+		    2 --> shapes are the same;
+		    1 --> ras are at least as big as ra0;
+		    0 --> no match.
+   */
+int ra_matchp(ra0, ras)
+     SCM ra0, ras;
+{
+  SCM ra1;
+  array_dim dims;
+  array_dim *s0 = &dims;
+  array_dim *s1;
+  sizet bas0 = 0;
+  int i, ndim = 1;
+  int exact = 2    /* 4 */;	/* Don't care about values >2 (yet?) */
+  if IMP(ra0) return 0;
+  switch TYP7(ra0) {
+  default: return 0;
+  case tc7_vector: case tc7_string: case tc7_bvect: case tc7_uvect:
+  case tc7_ivect: case tc7_fvect: case tc7_dvect: case tc7_cvect:
+    s0->lbnd = 0;
+    s0->inc = 1;
+    s0->ubnd = (long)LENGTH(ra0) - 1;
+    break;
+  case tc7_smob:
+    if (!ARRAYP(ra0)) return 0;
+    ndim = ARRAY_NDIM(ra0);
+    s0 = ARRAY_DIMS(ra0);
+    bas0 = ARRAY_BASE(ra0);
+    break;
+  }
+  while NIMP(ras) {
+    ra1 = CAR(ras);
+    switch (IMP(ra1) ? 0 : TYP7(ra1)) {
+    default: scalar:
+      CAR(ras) = sc2array(ra1,ra0,EOL); break;
+    case tc7_vector: case tc7_string: case tc7_bvect: case tc7_uvect:
+    case tc7_ivect: case tc7_fvect: case tc7_dvect: case tc7_cvect:
+      if (1 != ndim) return 0;
+      switch (exact) {
+      case 4: if (0 != bas0) exact = 3;
+      case 3: if (1 != s0->inc) exact = 2;
+      case 2: if ((0==s0->lbnd) && (s0->ubnd==LENGTH(ra1) - 1)) break;
+	exact = 1;
+      case 1: if (s0->lbnd < 0 || s0->ubnd >= LENGTH(ra1))
+	if (s0->lbnd <= s0->ubnd) return 0;
+      }
+      break;
+    case tc7_smob:
+      if (!ARRAYP(ra1)) goto scalar;
+      if (ndim != ARRAY_NDIM(ra1)) 
+	if (0==ARRAY_NDIM(ra1)) 
+	  goto scalar;
+	else
+	  return 0;
+      s1 = ARRAY_DIMS(ra1);
+      if (bas0 != ARRAY_BASE(ra1)) exact = 3;
+      for (i = 0; i < ndim; i++)
+	switch (exact) {
+	case 4: case 3:
+	  if (s0[i].inc != s1[i].inc)
+	    exact = 2;
+	case 2:
+	  if (s0[i].lbnd==s1[i].lbnd && s0[i].ubnd==s1[i].ubnd)
+	    break;
+	  exact = 1;
+	default:
+	  if (s0[i].lbnd < s1[i].lbnd || s0[i].ubnd > s1[i].ubnd)
+	    if (s0[i].lbnd <= s0[i].ubnd) return 0;
+	}
+      break;
+    }
+    ras = CDR(ras);
+  }
+  return exact;
+}
+
+static char s_ra_mismatch[] = "array shape mismatch";
+int ramapc(cproc, data, ra0, lra, what)
+     int (*cproc)();
+     SCM data, ra0, lra;
+     char *what;
+{
+  SCM inds, z;
+  SCM vra0, ra1, vra1;
+  SCM lvra, *plvra;
+  long *vinds;
+  int k, kmax = (ARRAYP(ra0) ? ARRAY_NDIM(ra0) - 1 : 0);
+  switch (ra_matchp(ra0, lra)) {
+  default:
+  case 0: wta(ra0, s_ra_mismatch, what);
+  case 2: case 3: case 4:	/* Try unrolling arrays */
+    if (kmax < 0) goto gencase;
+    vra0 = (0==kmax ? ra0 : array_contents(ra0, UNDEFINED));
+    if IMP(vra0) goto gencase;
+    if (!ARRAYP(vra0)) {
+      vra1 = make_ra(1);
+      ARRAY_BASE(vra1) = 0;
+      ARRAY_DIMS(vra1)->lbnd = 0;
+      ARRAY_DIMS(vra1)->ubnd = LENGTH(vra0) - 1;
+      ARRAY_DIMS(vra1)->inc = 1;
+      ARRAY_V(vra1) = vra0;
+      vra0 = vra1;
+    }
+    lvra = EOL;
+    plvra = &lvra;
+    for (z = lra; NIMP(z); z = CDR(z)) {
+      vra1 = ra1 = (0==kmax ? CAR(z) : array_contents(CAR(z), UNDEFINED));
+      if FALSEP(ra1) goto gencase;
+      if (!ARRAYP(ra1)) {
+	vra1 = make_ra(1);
+	ARRAY_DIMS(vra1)->lbnd = ARRAY_DIMS(vra0)->lbnd;
+	ARRAY_DIMS(vra1)->ubnd = ARRAY_DIMS(vra0)->ubnd;
+	ARRAY_BASE(vra1) = 0;
+	ARRAY_DIMS(vra1)->inc = 1;
+	ARRAY_V(vra1) = ra1;
+      }
+      *plvra = cons(vra1, EOL);
+      plvra = &CDR(*plvra);
+    }
+    return (UNBNDP(data) ? cproc(vra0, lvra) : cproc(vra0, data, lvra));
+  case 1: gencase:		/* Have to loop over all dimensions. */
+    vra0 = make_ra(1);
+    if ARRAYP(ra0) {
+      if (kmax < 0) {
+	ARRAY_DIMS(vra0)->lbnd = 0;
+	ARRAY_DIMS(vra0)->ubnd = 0;
+	ARRAY_DIMS(vra0)->inc = 1;
+      }
+      else {
+	ARRAY_DIMS(vra0)->lbnd = ARRAY_DIMS(ra0)[kmax].lbnd;
+	ARRAY_DIMS(vra0)->ubnd = ARRAY_DIMS(ra0)[kmax].ubnd;
+	ARRAY_DIMS(vra0)->inc = ARRAY_DIMS(ra0)[kmax].inc;
+      }
+      ARRAY_BASE(vra0) = ARRAY_BASE(ra0);
+      ARRAY_V(vra0) = ARRAY_V(ra0);
+    }
+    else {
+      ARRAY_DIMS(vra0)->lbnd = 0;
+      ARRAY_DIMS(vra0)->ubnd = LENGTH(ra0) - 1;
+      ARRAY_DIMS(vra0)->inc = 1;
+      ARRAY_BASE(vra0) = 0;
+      ARRAY_V(vra0) = ra0;
+      ra0 = vra0;
+    }
+    lvra = EOL;
+    plvra = &lvra;
+    for (z = lra; NIMP(z); z = CDR(z)) {
+      ra1 = CAR(z);
+      vra1 = make_ra(1);
+      ARRAY_DIMS(vra1)->lbnd = ARRAY_DIMS(vra0)->lbnd;
+      ARRAY_DIMS(vra1)->ubnd = ARRAY_DIMS(vra0)->ubnd;
+      if ARRAYP(ra1) {
+	if (kmax >= 0)
+	  ARRAY_DIMS(vra1)->inc = ARRAY_DIMS(ra1)[kmax].inc;
+	ARRAY_V(vra1) = ARRAY_V(ra1);
+      }
+      else {
+	ARRAY_DIMS(vra1)->inc = 1;
+	ARRAY_V(vra1) = ra1;
+      }
+      *plvra = cons(vra1, EOL);
+      plvra = &CDR(*plvra);
+    }
+    inds = make_uve(ARRAY_NDIM(ra0)+0L, MAKINUM(-1L));
+    vinds = (long *)VELTS(inds);
+    for (k = 0; k <= kmax; k++)
+      vinds[k] = ARRAY_DIMS(ra0)[k].lbnd;
+    k = kmax;
+    do {
+      if (k==kmax) {
+	SCM y = lra;
+	ARRAY_BASE(vra0) = cind(ra0, inds);
+	for (z = lvra; NIMP(z); z = CDR(z), y = CDR(y))
+	  ARRAY_BASE(CAR(z)) = cind(CAR(y), inds);
+	if (0==(UNBNDP(data) ? cproc(vra0, lvra) : cproc(vra0, data, lvra)))
+	  return 0;
+	k--;
+	continue;
+      }
+      if (vinds[k] < ARRAY_DIMS(ra0)[k].ubnd) {
+	vinds[k]++;
+	k++;
+	continue;
+      }
+      vinds[k] = ARRAY_DIMS(ra0)[k].lbnd - 1;
+      k--;
+    } while (k >= 0);
+    return 1;
+  }
+}
+
+static char s_array_fill[] = "array-fill!";
+SCM array_fill(ra, fill)
+     SCM ra, fill;
+{
+  ramapc(rafill, fill, ra, EOL, s_array_fill);
+  return UNSPECIFIED;
+}
+
+static char s_sarray_copy[] = "serial-array-copy!";
+# define s_array_copy  (s_sarray_copy + 7)
+static int racp(src, dst)
+     SCM dst, src;
+{
+  long n = (ARRAY_DIMS(src)->ubnd - ARRAY_DIMS(src)->lbnd + 1);
+  long inc_d, inc_s = ARRAY_DIMS(src)->inc;
+  sizet i_d, i_s = ARRAY_BASE(src);
+  dst = CAR(dst);
+  inc_d = ARRAY_DIMS(dst)->inc;
+  i_d = ARRAY_BASE(dst);
+  src = ARRAY_V(src);
+  dst = ARRAY_V(dst);
+  switch TYP7(dst) {
+  default: gencase: case tc7_vector:
+    for (; n-- > 0; i_s += inc_s, i_d += inc_d)
+      aset(dst, cvref(src, i_s, UNDEFINED), MAKINUM(i_d));
+    break;
+  case tc7_string: if (tc7_string != TYP7(dst)) goto gencase;
+    for (; n-- > 0; i_s += inc_s, i_d += inc_d)
+      CHARS(dst)[i_d] = CHARS(src)[i_s];
+    break;
+  case tc7_bvect: if (tc7_bvect != TYP7(dst)) goto gencase;
+    if (1==inc_d && 1==inc_s && i_s%LONG_BIT==i_d%LONG_BIT && n>=LONG_BIT) {
+      long *sv = (long *)VELTS(src);
+      long *dv = (long *)VELTS(dst);
+      sv += i_s/LONG_BIT;
+      dv += i_d/LONG_BIT;
+      if (i_s % LONG_BIT) {	/* leading partial word */
+	*dv = (*dv & ~(~0L<<(i_s%LONG_BIT))) | (*sv & (~0L<<(i_s%LONG_BIT)));
+	dv++;
+	sv++;
+	n -= LONG_BIT - (i_s % LONG_BIT);
+      }
+      IVDEP(src != dst,
+	    for (; n >= LONG_BIT; n -= LONG_BIT, sv++, dv++)
+	      *dv = *sv;)
+      if (n)			/* trailing partial word */
+	*dv = (*dv & (~0L<<n)) | (*sv & ~(~0L<<n));
+    }
+    else {
+      for (; n-- > 0; i_s += inc_s, i_d += inc_d)
+	if (VELTS(src)[i_s/LONG_BIT] & (1L << (i_s%LONG_BIT)))
+	  VELTS(dst)[i_d/LONG_BIT] |= (1L << (i_d%LONG_BIT));
+	else
+	  VELTS(dst)[i_d/LONG_BIT] &= ~(1L << (i_d%LONG_BIT));
+    }
+    break;
+  case tc7_uvect:
+  case tc7_ivect: {
+    long *d = (long *)VELTS(dst), *s = (long *)VELTS(src);
+    if (TYP7(src)==TYP7(dst)) {
+      IVDEP(src != dst,
+	    for (; n-- > 0; i_s += inc_s, i_d += inc_d)
+	      d[i_d] = s[i_s];)
+    }
+    else if (tc7_ivect==TYP7(dst))
+      for (; n-- > 0; i_s += inc_s, i_d += inc_d)
+	d[i_d] = num2long(cvref(src, i_s, UNDEFINED),
+			  (char *)ARG2, s_array_copy);
+    else
+      for (; n-- > 0; i_s += inc_s, i_d += inc_d)
+	d[i_d] = num2ulong(cvref(src, i_s, UNDEFINED),
+			   (char *)ARG2, s_array_copy);
+    break;
+  }
+# ifdef FLOATS
+#  ifdef SINGLES
+  case tc7_fvect: {
+    float *d = (float *)VELTS(dst);
+    float *s = (float *)VELTS(src);
+    switch TYP7(src) {
+    default: goto gencase;
+    case tc7_ivect: case tc7_uvect:
+      IVDEP(src != dst,
+	    for (; n-- > 0; i_s += inc_s, i_d += inc_d)
+	      d[i_d] = ((long *)s)[i_s]; )
+      break;
+    case tc7_fvect:
+      IVDEP(src != dst,
+	    for (; n-- > 0; i_s += inc_s, i_d += inc_d)
+	      d[i_d] = s[i_s]; )
+      break;
+    case tc7_dvect:
+      IVDEP(src != dst,
+	    for (; n-- > 0; i_s += inc_s, i_d += inc_d)
+	      d[i_d] = ((double *)s)[i_s]; )
+      break;
+    }
+    break;
+  }
+#  endif /* SINGLES */
+  case tc7_dvect: {
+    double *d = (double *)VELTS(dst);
+    double *s = (double *)VELTS(src);
+    switch TYP7(src) {
+    default: goto gencase;
+    case tc7_ivect: case tc7_uvect:
+      IVDEP(src != dst,
+	    for (; n-- > 0; i_s += inc_s, i_d += inc_d)
+	      d[i_d] = ((long *)s)[i_s]; )
+      break;
+    case tc7_fvect:
+      IVDEP(src != dst,
+	    for (; n-- > 0; i_s += inc_s, i_d += inc_d)
+	      d[i_d] = ((float *)s)[i_s];)
+      break;
+    case tc7_dvect:
+      IVDEP(src != dst,
+	    for (; n-- > 0; i_s += inc_s, i_d += inc_d)
+	      d[i_d] = s[i_s];)
+      break;
+    }
+    break;
+  }
+  case tc7_cvect: {
+    double (*d)[2] = (double (*)[2])VELTS(dst);
+    double (*s)[2] = (double (*)[2])VELTS(src);
+    switch TYP7(src) {
+    default: goto gencase;
+    case tc7_ivect: case tc7_uvect:
+      IVDEP(src != dst,
+	    for (; n-- > 0; i_s += inc_s, i_d += inc_d) {
+	      d[i_d][0] = ((long *)s)[i_s];
+	      d[i_d][1] = 0.0;
+	    })
+      break;
+    case tc7_fvect:
+      IVDEP(src != dst,
+	    for (; n-- > 0; i_s += inc_s, i_d += inc_d) {
+	      d[i_d][0] = ((float *)s)[i_s];
+	      d[i_d][1] = 0.0;
+	    })
+      break;
+    case tc7_dvect:
+      IVDEP(src != dst,
+	    for (; n-- > 0; i_s += inc_s, i_d += inc_d) {
+	      d[i_d][0] = ((double *)s)[i_s];
+	      d[i_d][1] = 0.0;
+	    })
+      break;
+    case tc7_cvect:
+      IVDEP(src != dst,
+	    for (; n-- > 0; i_s += inc_s, i_d += inc_d) {
+	      d[i_d][0] = s[i_s][0];
+	      d[i_d][1] = s[i_s][1];
+	    })
+    }
+    break;
+  }
+# endif /* FLOATS */
+  }
+  return 1;
+}
+SCM array_copy(src, dst)
+     SCM src;
+     SCM dst;
+{
+#ifndef RECKLESS
+  if (INUM0==array_rank(dst))
+    ASSERT(NIMP(dst) && ARRAYP(dst) && INUM0==array_rank(src),
+	   dst, ARG2, s_array_copy);
+#endif
+  ramapc(racp, UNDEFINED, src, cons(dst, EOL), s_array_copy);
+  return UNSPECIFIED;
+}
+
+SCM ra2contig(ra, copy)
+     SCM ra;
+     int copy;
+{
+  SCM ret;
+  long inc = 1;
+  sizet k, len = 1;
+  for (k = ARRAY_NDIM(ra); k--;)
+    len *= ARRAY_DIMS(ra)[k].ubnd - ARRAY_DIMS(ra)[k].lbnd + 1;
+  k = ARRAY_NDIM(ra);
+  if (ARRAY_CONTP(ra) && ((0==k) || (1==ARRAY_DIMS(ra)[k-1].inc))) {
+    if (tc7_bvect != TYP7(ARRAY_V(ra)))
+      return ra;
+    if ((len==LENGTH(ARRAY_V(ra)) &&
+	 0==ARRAY_BASE(ra) % LONG_BIT &&
+	 0==len % LONG_BIT))
+      return ra;
+  }
+  ret = make_ra(k);
+  ARRAY_BASE(ret) = 0;
+  while (k--) {
+    ARRAY_DIMS(ret)[k].lbnd = ARRAY_DIMS(ra)[k].lbnd;
+    ARRAY_DIMS(ret)[k].ubnd = ARRAY_DIMS(ra)[k].ubnd;
+    ARRAY_DIMS(ret)[k].inc = inc;
+    inc *= ARRAY_DIMS(ra)[k].ubnd - ARRAY_DIMS(ra)[k].lbnd + 1;
+  }
+  CAR(ret) |= ARRAY_CONTIGUOUS;
+  ARRAY_V(ret) = make_uve(inc+0L, array_prot(ra));
+  if (copy) array_copy(ra, ret);
+  return ret;
+}
+
+static char s_ura_rd[] = "uniform-array-read!";
+SCM ura_read(ra, port)
+     SCM ra, port;
+{
+  SCM ret, cra;
+  if (NIMP(ra) && ARRAYP(ra)) {
+    cra = ra2contig(ra, 0);
+    ret = uve_read(cra, port);
+    if (cra != ra) array_copy(cra, ra);
+    return ret;
+  }
+  else return uve_read(ra, port);
+}
+
+static char s_ura_wr[] = "uniform-array-write";
+SCM ura_write(ra, port)
+     SCM ra, port;
+{
+  if (NIMP(ra) && ARRAYP(ra))
+    return uve_write(ra2contig(ra,1), port);
+  else
+    return uve_write(ra, port);
+}
+
+static char s_sc2array[] = "scalar->array";
+SCM sc2array(s, ra, prot)
+     SCM s, ra, prot;
+{
+  SCM res;
+  ASSERT(NIMP(ra), ra, ARG2, s_sc2array);
+  if ARRAYP(ra) {
+    int k = ARRAY_NDIM(ra);
+    res = make_ra(k);
+    while (k--) {
+      ARRAY_DIMS(res)[k].ubnd = ARRAY_DIMS(ra)[k].ubnd;
+      ARRAY_DIMS(res)[k].lbnd = ARRAY_DIMS(ra)[k].lbnd;
+      ARRAY_DIMS(res)[k].inc = 0;
+    }
+    ra = ARRAY_V(ra);
+  }
+  else {
+    ASSERT(BOOL_T==arrayp(ra, UNDEFINED), ra, ARG2, s_sc2array);
+    res = make_ra(1);
+    ARRAY_DIMS(res)->ubnd = LENGTH(ra) - 1;
+    ARRAY_DIMS(res)->lbnd = 0;
+    ARRAY_DIMS(res)->inc = 0;
+  }
+  if (NIMP(s) && ARRAYP(s) && 0==ARRAY_NDIM(s)) {
+    ARRAY_BASE(res) = ARRAY_BASE(s);
+    ARRAY_V(res) = ARRAY_V(s);
+    return res;
+  }
+  ARRAY_BASE(res) = 0;
+  ARRAY_V(res) = make_uve(1L, NULLP(prot) ? array_prot(ra) : CAR(prot));
+  switch TYP7(ARRAY_V(res)) {
+  case tc7_vector:
+    break;
+  case tc7_string:
+    if ICHRP(s) break;
+    goto mismatch;
+  case tc7_uvect: 
+    if (INUMP(s) && INUM(s)>=0) break;
+#ifdef BIGDIG
+    if (NIMP(s) && tc16_bigpos==TYP16(s) && NUMDIGS(s)<=DIGSPERLONG) break;
+#endif
+    goto mismatch;
+  case tc7_ivect:
+    if INUMP(s) break;
+#ifdef BIGDIG
+    if (NIMP(s) && BIGP(s) && NUMDIGS(s)<=DIGSPERLONG) break;
+#endif
+    goto mismatch;
+#ifdef FLOATS
+#ifdef SINGLES
+  case tc7_fvect:
+#endif
+  case tc7_dvect:
+    if (NUMBERP(s) && !(NIMP(s) && CPLXP(s))) break;
+    goto mismatch;
+  case tc7_cvect:
+    if NUMBERP(s) break;
+    goto mismatch;
+#endif
+  mismatch: ARRAY_V(res) = make_vector(MAKINUM(1), s);
+    return res;
+  }
+  aset(ARRAY_V(res), s, INUM0);
+  return res;
+}
+
+/* Functions callable by ARRAY-MAP! */
+int ra_eqp(ra0, ras)
+     SCM ra0, ras;
+{
+  SCM ra1 = CAR(ras), ra2 = CAR(CDR(ras));
+  long n = ARRAY_DIMS(ra0)->ubnd - ARRAY_DIMS(ra0)->lbnd + 1;
+  sizet i0 = ARRAY_BASE(ra0), i1 = ARRAY_BASE(ra1), i2 = ARRAY_BASE(ra2);
+  long inc0 = ARRAY_DIMS(ra0)->inc;
+  long inc1 = ARRAY_DIMS(ra1)->inc;
+  long inc2 = ARRAY_DIMS(ra2)->inc;
+  ra0 = ARRAY_V(ra0);
+  ra1 = ARRAY_V(ra1);
+  ra2 = ARRAY_V(ra2);
+  switch (TYP7(ra1)==TYP7(ra2) ? TYP7(ra1) : 0) {
+  default: {
+    SCM e1 = UNDEFINED, e2 = UNDEFINED;
+    for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
+      if BVE_REF(ra0, i0)
+	if FALSEP(eqp(RVREF(ra1, i1, e1), RVREF(ra2, i2, e2)))
+	  BVE_CLR(ra0, i0);
+    break;
+  }
+  case tc7_uvect:
+  case tc7_ivect:
+    for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
+      if BVE_REF(ra0, i0)
+	if (VELTS(ra1)[i1] != VELTS(ra2)[i2]) BVE_CLR(ra0, i0);
+    break;
+# ifdef FLOATS
+#  ifdef SINGLES
+  case tc7_fvect:
+    for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
+      if BVE_REF(ra0, i0)
+	if (((float *)VELTS(ra1))[i1] != ((float *)VELTS(ra2))[i2])
+	  BVE_CLR(ra0, i0);
+    break;
+#  endif /*SINGLES*/
+  case tc7_dvect:
+    for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
+      if BVE_REF(ra0, i0)
+	if (((double *)VELTS(ra1))[i1] != ((double *)VELTS(ra2))[i2])
+	  BVE_CLR(ra0, i0);
+    break;
+  case tc7_cvect:
+    for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
+      if BVE_REF(ra0, i0)
+	if (((double *)VELTS(ra1))[2*i1] != ((double *)VELTS(ra2))[2*i2] ||
+	    ((double *)VELTS(ra1))[2*i1+1] != ((double *)VELTS(ra2))[2*i2+1])
+	  BVE_CLR(ra0, i0);
+    break;
+# endif /*FLOATS*/
+  }
+  return 1;
+}
+/* opt 0 means <, nonzero means >= */
+static int ra_compare(ra0, ra1, ra2, opt)
+     SCM ra0, ra1, ra2;
+     int opt;
+{
+  long n = ARRAY_DIMS(ra0)->ubnd - ARRAY_DIMS(ra0)->lbnd + 1;
+  sizet i0 = ARRAY_BASE(ra0), i1 = ARRAY_BASE(ra1), i2 = ARRAY_BASE(ra2);
+  long inc0 = ARRAY_DIMS(ra0)->inc;
+  long inc1 = ARRAY_DIMS(ra1)->inc;
+  long inc2 = ARRAY_DIMS(ra2)->inc;
+  ra0 = ARRAY_V(ra0);
+  ra1 = ARRAY_V(ra1);
+  ra2 = ARRAY_V(ra2);
+  switch (TYP7(ra1)==TYP7(ra2) ? TYP7(ra1) : 0) {
+  default: {
+    SCM e1 = UNDEFINED, e2 = UNDEFINED;
+    for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
+      if BVE_REF(ra0, i0)
+	if (opt ?
+	    NFALSEP(lessp(RVREF(ra1, i1, e1), RVREF(ra2, i2, e2))) :
+	    FALSEP(lessp(RVREF(ra1, i1, e1), RVREF(ra2, i2, e2))) )
+	  BVE_CLR(ra0, i0);
+    break;
+  }
+  case tc7_uvect:
+    for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) {
+      if BVE_REF(ra0, i0)
+	if (opt ?
+	    ((unsigned long*)VELTS(ra1))[i1] < ((unsigned long*)VELTS(ra2))[i2] :
+	    ((unsigned long*)VELTS(ra1))[i1] >= ((unsigned long*)VELTS(ra2))[i2])
+	  BVE_CLR(ra0, i0);
+    }
+    break;
+  case tc7_ivect:
+    for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) {
+      if BVE_REF(ra0, i0)
+	if (opt ?
+	    VELTS(ra1)[i1] < VELTS(ra2)[i2] :
+	    VELTS(ra1)[i1] >= VELTS(ra2)[i2])
+	  BVE_CLR(ra0, i0);
+    }
+    break;
+# ifdef FLOATS
+#  ifdef SINGLES
+  case tc7_fvect:
+    for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
+      if BVE_REF(ra0, i0)
+	if (opt ?
+	    ((float *)VELTS(ra1))[i1] < ((float *)VELTS(ra2))[i2] :
+	    ((float *)VELTS(ra1))[i1] >= ((float *)VELTS(ra2))[i2])
+	  BVE_CLR(ra0, i0);
+    break;
+#  endif /*SINGLES*/
+  case tc7_dvect:
+    for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
+      if BVE_REF(ra0, i0)
+	if (opt ?
+	    ((double *)VELTS(ra1))[i1] < ((double *)VELTS(ra2))[i2] :
+	    ((double *)VELTS(ra1))[i1] >= ((double *)VELTS(ra2))[i2])
+	  BVE_CLR(ra0, i0);
+    break;
+# endif /*FLOATS*/
+  }
+  return 1;
+}
+int ra_lessp(ra0, ras)
+     SCM ra0, ras;
+{
+ return ra_compare(ra0, CAR(ras), CAR(CDR(ras)), 0);
+}
+int ra_leqp(ra0, ras)
+     SCM ra0, ras;
+{
+  return ra_compare(ra0, CAR(CDR(ras)), CAR(ras), 1);
+}
+int ra_grp(ra0, ras)
+     SCM ra0, ras;
+{
+  return ra_compare(ra0, CAR(CDR(ras)), CAR(ras), 0);
+}
+int ra_greqp(ra0, ras)
+     SCM ra0, ras;
+{
+  return ra_compare(ra0, CAR(ras), CAR(CDR(ras)), 1);
+}
+
+int ra_sum(ra0, ras)
+     SCM ra0, ras;
+{
+  long n = ARRAY_DIMS(ra0)->ubnd - ARRAY_DIMS(ra0)->lbnd + 1;
+  sizet i0 = ARRAY_BASE(ra0);
+  long inc0 = ARRAY_DIMS(ra0)->inc;
+  ra0 = ARRAY_V(ra0);
+  if NNULLP(ras) {
+    SCM ra1 = CAR(ras);
+    sizet i1 = ARRAY_BASE(ra1);
+    long inc1 = ARRAY_DIMS(ra1)->inc;
+    ra1 = ARRAY_V(ra1);
+    switch (TYP7(ra0)==TYP7(ra1) ? TYP7(ra0) : 0) {
+    ovflow: wta(ra0, (char *)OVFLOW, "+");
+    default: {
+      SCM e0 = UNDEFINED, e1 = UNDEFINED;
+      for (; n-- > 0; i0 += inc0, i1 += inc1)
+	aset(ra0, sum(RVREF(ra0, i0, e0), RVREF(ra1, i1, e1)),
+	     MAKINUM(i0));
+      break;
+    }
+    case tc7_uvect: {
+      unsigned long r;
+      unsigned long *v0 = (unsigned long *)VELTS(ra0);
+      unsigned long *v1 = (unsigned long *)VELTS(ra1);
+      IVDEP(ra0 != ra1,
+	    for (; n-- > 0; i0 += inc0, i1 += inc1) {
+	      r = v0[i0] + v1[i1];
+	      ASRTGO(r >= v0[i0], ovflow); /* Will prevent vectorization */
+	      v0[i0] = r;
+	    } );
+      break;
+    }
+    case tc7_ivect: {
+      long r, *v0 = (long *)VELTS(ra0), *v1 = (long *)VELTS(ra1);
+      IVDEP(ra0 != ra1,
+	    for (; n-- > 0; i0 += inc0, i1 += inc1) {
+	      r = v0[i0] + v1[i1];
+	      ASRTGO((v0[i0]>0 ? r>=0 || v1[i1]<0 : r<=0 || v1[i1]>0), ovflow);
+	      v0[i0] = r;
+	    } );
+      break;
+    }
+# ifdef FLOATS
+#  ifdef SINGLES
+    case tc7_fvect: {
+      float *v0 = (float *)VELTS(ra0);
+      float *v1 = (float *)VELTS(ra1);
+      IVDEP(ra0 != ra1,
+	    for (; n-- > 0; i0 += inc0, i1 += inc1)
+	      v0[i0] += v1[i1]);
+      break;
+    }
+#  endif /* SINGLES */
+    case tc7_dvect: {
+      double *v0 = (double *)VELTS(ra0);
+      double *v1 = (double *)VELTS(ra1);
+      IVDEP(ra0 != ra1,
+	    for (; n-- > 0; i0 += inc0, i1 += inc1)
+	      v0[i0] += v1[i1]);
+      break;
+    }
+    case tc7_cvect: {
+      double (*v0)[2] = (double (*)[2])VELTS(ra0);
+      double (*v1)[2] = (double (*)[2])VELTS(ra1);
+      IVDEP(ra0 != ra1,
+	    for (; n-- > 0; i0 += inc0, i1 += inc1) {
+	      v0[i0][0] += v1[i1][0];
+	      v0[i0][1] += v1[i1][1];
+	    });
+      break;
+    }
+# endif /* FLOATS */
+    }
+  }
+  return 1;
+}
+
+int ra_difference(ra0, ras)
+     SCM ra0, ras;
+{
+  long n = ARRAY_DIMS(ra0)->ubnd - ARRAY_DIMS(ra0)->lbnd + 1;
+  sizet i0 = ARRAY_BASE(ra0);
+  long inc0 = ARRAY_DIMS(ra0)->inc;
+  ra0 = ARRAY_V(ra0);
+  if NULLP(ras) {
+    switch TYP7(ra0) {
+    default: {
+      SCM e0 = UNDEFINED;
+      for (; n-- > 0; i0 += inc0)
+	aset(ra0, difference(RVREF(ra0, i0, e0), UNDEFINED), MAKINUM(i0));
+      break;
+    }
+    case tc7_ivect: {
+      long *v0 = VELTS(ra0);
+      for (; n-- > 0; i0 += inc0)
+	v0[i0] = -v0[i0];
+      break;
+    }
+# ifdef FLOATS
+#  ifdef SINGLES
+    case tc7_fvect: {
+      float *v0 = (float *)VELTS(ra0);
+      for (; n-- > 0; i0 += inc0)
+	v0[i0] = -v0[i0];
+      break;
+    }
+#  endif /* SINGLES */
+    case tc7_dvect: {
+      double *v0 = (double *)VELTS(ra0);
+      for (; n-- > 0; i0 += inc0)
+	v0[i0] = -v0[i0];
+      break;
+    }
+    case tc7_cvect: {
+      double (*v0)[2] = (double (*)[2])VELTS(ra0);
+      for (; n-- > 0; i0 += inc0) {
+	v0[i0][0] = -v0[i0][0];
+	v0[i0][1] = -v0[i0][1];
+      }
+      break;
+    }
+# endif /* FLOATS */
+    }
+  }
+  else {
+    SCM ra1 = CAR(ras);
+    sizet i1 = ARRAY_BASE(ra1);
+    long inc1 = ARRAY_DIMS(ra1)->inc;
+    ra1 = ARRAY_V(ra1);
+    switch (TYP7(ra0)==TYP7(ra1) ? TYP7(ra0) : 0) {
+    ovflow: wta(ra0, (char *)OVFLOW, "-");
+    default: {
+      SCM e0 = UNDEFINED, e1 = UNDEFINED;
+      for (; n-- > 0; i0 += inc0, i1 += inc1)
+	aset(ra0, difference(RVREF(ra0, i0, e0), RVREF(ra1, i1, e1)), MAKINUM(i0));
+      break;
+    }
+    case tc7_uvect: {
+      unsigned long r;
+      unsigned long *v0 = (unsigned long *)VELTS(ra0);
+      unsigned long *v1 = (unsigned long*)VELTS(ra1);
+      IVDEP(ra0 != ra1,
+	    for (; n-- > 0; i0 += inc0, i1 += inc1) {
+	      r = v0[i0] - v1[i1];
+	      ASRTGO(r <= v0[i0], ovflow);
+	      v0[i0] = r;
+	    } );
+      break;
+    }
+    case tc7_ivect: {
+      long r, *v0 = VELTS(ra0), *v1 = VELTS(ra1);
+      IVDEP(ra0 != ra1,
+	    for (; n-- > 0; i0 += inc0, i1 += inc1) {
+	      r = v0[i0] - v1[i1];
+	      ASRTGO((v0[i0]>0 ? r>=0 || v1[i1]>0 : r<=0 || v1[i1]<0), ovflow);
+	      v0[i0] = r;
+	    } );
+      break;
+    }
+# ifdef FLOATS
+#  ifdef SINGLES
+    case tc7_fvect: {
+      float *v0 = (float *)VELTS(ra0);
+      float *v1 = (float *)VELTS(ra1);
+      IVDEP(ra0 != ra1,
+	    for (; n-- > 0; i0 += inc0, i1 += inc1)
+	      v0[i0] -= v1[i1]);
+      break;
+    }
+#  endif /* SINGLES */
+    case tc7_dvect: {
+      double *v0 = (double *)VELTS(ra0);
+      double *v1 = (double *)VELTS(ra1);
+      IVDEP(ra0 != ra1,
+	    for (; n-- > 0; i0 += inc0, i1 += inc1)
+	      v0[i0] -= v1[i1]);
+      break;
+    }
+    case tc7_cvect: {
+      double (*v0)[2] = (double (*)[2])VELTS(ra0);
+      double (*v1)[2] = (double (*)[2])VELTS(ra1);
+      IVDEP(ra0 != ra1,
+	    for (; n-- > 0; i0 += inc0, i1 += inc1) {
+	      v0[i0][0] -= v1[i1][0];
+	      v0[i0][1] -= v1[i1][1];
+	    })
+      break;
+    }
+# endif /* FLOATS */
+    }
+  }
+  return 1;
+}
+
+int ra_product(ra0, ras)
+     SCM ra0, ras;
+{
+  long n = ARRAY_DIMS(ra0)->ubnd - ARRAY_DIMS(ra0)->lbnd + 1;
+  sizet i0 = ARRAY_BASE(ra0);
+  long inc0 = ARRAY_DIMS(ra0)->inc;
+  ra0 = ARRAY_V(ra0);
+  if NNULLP(ras) {
+    SCM ra1 = CAR(ras);
+    sizet i1 = ARRAY_BASE(ra1);
+    long inc1 = ARRAY_DIMS(ra1)->inc;
+    ra1 = ARRAY_V(ra1);
+    switch (TYP7(ra0)==TYP7(ra1) ? TYP7(ra0) : 0) {
+    ovflow: wta(ra0, (char *)OVFLOW, "*");
+    default: {
+      SCM e0 = UNDEFINED, e1 = UNDEFINED;
+      for (; n-- > 0; i0 += inc0, i1 += inc1)
+	aset(ra0, product(RVREF(ra0, i0, e0), RVREF(ra1, i1, e1)),
+	     MAKINUM(i0));
+      break;
+    }
+    case tc7_uvect: {
+      unsigned long r;
+      unsigned long *v0 = (unsigned long *)VELTS(ra0);
+      unsigned long *v1 = (unsigned long *)VELTS(ra1);
+      IVDEP(ra0 != ra1,
+	    for (; n-- > 0; i0 += inc0, i1 += inc1) {
+	      r = v0[i0] * v1[i1];
+	      ASRTGO(0==v0[i0] || v1[i1]==r/v0[i0], ovflow);
+	      v0[i0] = r;
+	    } );
+      break;
+    }
+    case tc7_ivect: {
+      long r, *v0 = VELTS(ra0), *v1 =VELTS(ra1);
+      IVDEP(ra0 != ra1,
+	    for (; n-- > 0; i0 += inc0, i1 += inc1) {
+	      r = v0[i0] * v1[i1];
+	      ASRTGO(0==v0[i0] || v1[i1]==r/v0[i0], ovflow);
+	      v0[i0] = r;
+	    } );
+      break;
+    }
+# ifdef FLOATS
+#  ifdef SINGLES
+    case tc7_fvect: {
+      float *v0 = (float *)VELTS(ra0);
+      float *v1 = (float *)VELTS(ra1);
+      IVDEP(ra0 != ra1,
+	    for (; n-- > 0; i0 += inc0, i1 += inc1)
+	      v0[i0] *= v1[i1]);
+      break;
+    }
+#  endif /* SINGLES */
+    case tc7_dvect: {
+      double *v0 = (double *)VELTS(ra0);
+      double *v1 = (double *)VELTS(ra1);
+      IVDEP(ra0 != ra1,
+	    for (; n-- > 0; i0 += inc0, i1 += inc1)
+	      v0[i0] *= v1[i1]);
+      break;
+    }
+    case tc7_cvect: {
+      double (*v0)[2] = (double (*)[2])VELTS(ra0);
+      register double r;
+      double (*v1)[2] = (double (*)[2])VELTS(ra1);
+      IVDEP(ra0 != ra1,
+	    for (; n-- > 0; i0 += inc0, i1 += inc1) {
+	      r = v0[i0][0]*v1[i1][0] - v0[i0][1]*v1[i1][1];
+	      v0[i0][1] = v0[i0][0]*v1[i1][1] + v0[i0][1]*v1[i1][0];
+	      v0[i0][0] = r;
+	    });
+      break;
+    }
+# endif /* FLOATS */
+    }
+  }
+  return 1;
+}
+int ra_divide(ra0, ras)
+     SCM ra0, ras;
+{
+  long n = ARRAY_DIMS(ra0)->ubnd - ARRAY_DIMS(ra0)->lbnd + 1;
+  sizet i0 = ARRAY_BASE(ra0);
+  long inc0 = ARRAY_DIMS(ra0)->inc;
+  ra0 = ARRAY_V(ra0);
+  if NULLP(ras) {
+    switch TYP7(ra0) {
+    default: {
+      SCM e0 = UNDEFINED;
+      for (; n-- > 0; i0 += inc0)
+	aset(ra0, divide(RVREF(ra0, i0, e0), UNDEFINED), MAKINUM(i0));
+      break;
+    }
+# ifdef FLOATS
+#  ifdef SINGLES
+    case tc7_fvect: {
+      float *v0 = (float *)VELTS(ra0);
+      for (; n-- > 0; i0 += inc0)
+	v0[i0] = 1.0/v0[i0];
+      break;
+    }
+#  endif /* SINGLES */
+    case tc7_dvect: {
+      double *v0 = (double *)VELTS(ra0);
+      for (; n-- > 0; i0 += inc0)
+	v0[i0] = 1.0/v0[i0];
+      break;
+    }
+    case tc7_cvect: {
+      register double d;
+      double (*v0)[2] = (double (*)[2])VELTS(ra0);
+      for (; n-- > 0; i0 += inc0) {
+	d = v0[i0][0]*v0[i0][0] + v0[i0][1]*v0[i0][1];
+	v0[i0][0] /= d;
+	v0[i0][1] /= -d;
+      }
+      break;
+    }
+# endif /* FLOATS */
+    }
+  }
+  else {
+    SCM ra1 = CAR(ras);
+    sizet i1 = ARRAY_BASE(ra1);
+    long inc1 = ARRAY_DIMS(ra1)->inc;
+    ra1 = ARRAY_V(ra1);
+    switch (TYP7(ra0)==TYP7(ra1) ? TYP7(ra0) : 0) {
+    default: {
+      SCM e0 = UNDEFINED, e1 = UNDEFINED;
+      for (; n-- > 0; i0 += inc0, i1 += inc1)
+	aset(ra0, divide(RVREF(ra0, i0, e0), RVREF(ra1, i1, e1)), MAKINUM(i0));
+      break;
+    }
+# ifdef FLOATS
+#  ifdef SINGLES
+    case tc7_fvect: {
+      float *v0 = (float *)VELTS(ra0);
+      float *v1 = (float *)VELTS(ra1);
+      IVDEP(ra0 != ra1,
+	    for (; n-- > 0; i0 += inc0, i1 += inc1)
+	      v0[i0] /= v1[i1]);
+      break;
+    }
+#  endif /* SINGLES */
+    case tc7_dvect: {
+      double *v0 = (double *)VELTS(ra0);
+      double *v1 = (double *)VELTS(ra1);
+      IVDEP(ra0 != ra1,
+	    for (; n-- > 0; i0 += inc0, i1 += inc1)
+	      v0[i0] /= v1[i1]);
+      break;
+    }
+    case tc7_cvect: {
+      register double d, r;
+      double (*v0)[2] = (double (*)[2])VELTS(ra0);
+      double (*v1)[2] = (double (*)[2])VELTS(ra1);
+      IVDEP(ra0 != ra1,
+	    for (; n-- > 0; i0 += inc0, i1 += inc1) {
+	      d = v1[i1][0]*v1[i1][0] + v1[i1][1]*v1[i1][1];
+	      r = (v0[i0][0]*v1[i1][0] + v0[i0][1]*v1[i1][1])/d;
+	      v0[i0][1] = (v0[i0][1]*v1[i1][0] - v0[i0][0]*v1[i1][1])/d;
+	      v0[i0][0] = r;
+	    })
+      break;
+    }
+# endif /* FLOATS */
+    }
+  }
+  return 1;
+}
+static int ra_identity(dst, src)
+     SCM src, dst;
+{
+  return racp(CAR(src), cons(dst, EOL));
+}
+
+static int ramap(ra0, proc, ras)
+     SCM ra0, proc, ras;
+{
+  long i = ARRAY_DIMS(ra0)->lbnd;
+  long inc = ARRAY_DIMS(ra0)->inc;
+  long n = ARRAY_DIMS(ra0)->ubnd;
+  long base = ARRAY_BASE(ra0) - i*inc;
+  ra0 = ARRAY_V(ra0);
+  if NULLP(ras)
+    for (; i <= n; i++)
+      aset(ra0, apply(proc, EOL, EOL), MAKINUM(i*inc + base));
+  else {
+    SCM ra1 = CAR(ras);
+    SCM args, *ve = &ras;
+    sizet k, i1 = ARRAY_BASE(ra1);
+    long inc1 = ARRAY_DIMS(ra1)->inc;
+    ra1 = ARRAY_V(ra1);
+    ras = CDR(ras);
+    if NULLP(ras)
+      ras = nullvect;
+    else {
+      ras = vector(ras);
+      ve = VELTS(ras);
+    }
+    for (; i <= n; i++, i1 += inc1) {
+      args = EOL;
+      for (k = LENGTH(ras); k--;)
+	args = cons(aref(ve[k], MAKINUM(i)), args);
+      args = cons(cvref(ra1, i1, UNDEFINED), args);
+      aset(ra0, apply(proc, args, EOL), MAKINUM(i*inc + base));
+    }
+  }
+  return 1;
+}
+static int ramap_cxr(ra0, proc, ras)
+     SCM ra0, proc, ras;
+{
+  SCM ra1 = CAR(ras);
+  SCM e1 = UNDEFINED;
+  sizet i0 = ARRAY_BASE(ra0), i1 = ARRAY_BASE(ra1);
+  long inc0 = ARRAY_DIMS(ra0)->inc, inc1 = ARRAY_DIMS(ra1)->inc;
+  long n = ARRAY_DIMS(ra0)->ubnd - ARRAY_DIMS(ra1)->lbnd + 1;
+  ra0 = ARRAY_V(ra0);
+  ra1 = ARRAY_V(ra1);
+  switch TYP7(ra0) {
+  default: gencase:
+    for (; n-- > 0; i0 += inc0, i1 += inc1)
+      aset(ra0, apply(proc, RVREF(ra1, i1, e1), listofnull), MAKINUM(i0));
+    break;
+# ifdef FLOATS
+#  ifdef SINGLES
+  case tc7_fvect: {
+    float *dst = (float *)VELTS(ra0);
+    switch TYP7(ra1) {
+    default: goto gencase;
+    case tc7_fvect:
+      for (; n-- > 0; i0 += inc0, i1 += inc1)
+	dst[i0] = DSUBRF(proc)((double)((float *)VELTS(ra1))[i1]);
+      break;
+    case tc7_uvect:
+    case tc7_ivect:
+      for (; n-- > 0; i0 += inc0, i1 += inc1)
+	dst[i0] = DSUBRF(proc)((double)VELTS(ra1)[i1]);
+      break;
+    }
+    break;
+  }
+#  endif /* SINGLES */
+  case tc7_dvect: {
+    double *dst = (double *)VELTS(ra0);
+    switch TYP7(ra1) {
+    default: goto gencase;
+    case tc7_dvect:
+      for (; n-- > 0; i0 += inc0, i1 += inc1)
+	dst[i0] = DSUBRF(proc)(((double *)VELTS(ra1))[i1]);
+      break;
+    case tc7_uvect:
+    case tc7_ivect:
+      for (; n-- > 0; i0 += inc0, i1 += inc1)
+	dst[i0] = DSUBRF(proc)((double)VELTS(ra1)[i1]);
+      break;
+    }
+    break;
+  }
+# endif /* FLOATS */
+  }
+  return 1;
+}
+static int ramap_rp(ra0, proc, ras)
+     SCM ra0, proc, ras;
+{
+  SCM ra1 = CAR(ras), ra2 = CAR(CDR(ras));
+  SCM e1 = UNDEFINED, e2 = UNDEFINED;
+  long n = ARRAY_DIMS(ra0)->ubnd - ARRAY_DIMS(ra0)->lbnd + 1;
+  sizet i0 = ARRAY_BASE(ra0), i1 = ARRAY_BASE(ra1), i2 = ARRAY_BASE(ra2);
+  long inc0 = ARRAY_DIMS(ra0)->inc;
+  long inc1 = ARRAY_DIMS(ra1)->inc;
+  long inc2 = ARRAY_DIMS(ra2)->inc;
+  ra0 = ARRAY_V(ra0);
+  ra1 = ARRAY_V(ra1);
+  ra2 = ARRAY_V(ra2);
+  for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
+    if BVE_REF(ra0, i0)
+      if FALSEP(SUBRF(proc)(RVREF(ra1, i1, e1), RVREF(ra2, i2, e2)))
+	BVE_CLR(ra0, i0);
+  return 1;
+}
+static int ramap_1(ra0, proc, ras)
+     SCM ra0, proc, ras;
+{
+  SCM ra1 = CAR(ras);
+  SCM e1 = UNDEFINED;
+  long n = ARRAY_DIMS(ra0)->ubnd - ARRAY_DIMS(ra0)->lbnd + 1;
+  sizet i0 = ARRAY_BASE(ra0), i1 = ARRAY_BASE(ra1);
+  long inc0 = ARRAY_DIMS(ra0)->inc, inc1 = ARRAY_DIMS(ra1)->inc;
+  ra0 = ARRAY_V(ra0);
+  ra1 = ARRAY_V(ra1);
+  if (tc7_vector==TYP7(ra0))
+    for (; n-- > 0; i0 += inc0, i1 += inc1)
+      VELTS(ra0)[i0] = SUBRF(proc)(cvref(ra1, i1, UNDEFINED));
+  else
+    for (; n-- > 0; i0 += inc0, i1 += inc1)
+      aset(ra0, SUBRF(proc)(RVREF(ra1, i1, e1)), MAKINUM(i0));
+  return 1;
+}
+static int ramap_2o(ra0, proc, ras)
+     SCM ra0, proc, ras;
+{
+  SCM ra1 = CAR(ras);
+  SCM e1 = UNDEFINED;
+  long n = ARRAY_DIMS(ra0)->ubnd - ARRAY_DIMS(ra0)->lbnd + 1;
+  sizet i0 = ARRAY_BASE(ra0), i1 = ARRAY_BASE(ra1);
+  long inc0 = ARRAY_DIMS(ra0)->inc, inc1 = ARRAY_DIMS(ra1)->inc;
+  ra0 = ARRAY_V(ra0);
+  ra1 = ARRAY_V(ra1);
+  ras = CDR(ras);
+  if NULLP(ras) {
+    if (tc7_vector==TYP7(ra0))
+      for (; n-- > 0; i0 += inc0, i1 += inc1)
+	VELTS(ra0)[i0] = SUBRF(proc)(cvref(ra1, i1, UNDEFINED), UNDEFINED);
+    else
+      for (; n-- > 0; i0 += inc0, i1 += inc1)
+	aset(ra0, SUBRF(proc)(RVREF(ra1, i1, e1), UNDEFINED),
+	     MAKINUM(i0));
+  }
+  else {
+    SCM ra2 = CAR(ras);
+    SCM e2 = UNDEFINED;
+    sizet i2 = ARRAY_BASE(ra2);
+    long inc2 = ARRAY_DIMS(ra2)->inc;
+    ra2 = ARRAY_V(ra2);
+    if (tc7_vector==TYP7(ra0))
+      for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
+	VELTS(ra0)[i0] =
+	  SUBRF(proc)(cvref(ra1, i1, UNDEFINED), cvref(ra2, i2, UNDEFINED));
+    else
+      for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
+	aset(ra0,
+	     SUBRF(proc)(RVREF(ra1, i1, e1), RVREF(ra2, i2, e2)),
+	     MAKINUM(i0));
+  }
+  return 1;
+}
+static int ramap_a(ra0, proc, ras)
+     SCM ra0, proc, ras;
+{
+  SCM e0 = UNDEFINED, e1 = UNDEFINED;
+  long n = ARRAY_DIMS(ra0)->ubnd - ARRAY_DIMS(ra0)->lbnd + 1;
+  sizet i0 = ARRAY_BASE(ra0);
+  long inc0 = ARRAY_DIMS(ra0)->inc;
+  ra0 = ARRAY_V(ra0);
+  if NULLP(ras)
+    for (; n-- > 0; i0 += inc0)
+      aset(ra0, SUBRF(proc)(RVREF(ra0, i0, e0), UNDEFINED), MAKINUM(i0));
+  else {
+    SCM ra1 = CAR(ras);
+    sizet i1 = ARRAY_BASE(ra1);
+    long inc1 = ARRAY_DIMS(ra1)->inc;
+    ra1 = ARRAY_V(ra1);
+    for (; n-- > 0; i0 += inc0, i1 += inc1)
+      aset(ra0, SUBRF(proc)(RVREF(ra0, i0, e0), RVREF(ra1, i1, e1)),
+	   MAKINUM(i0));
+  }
+  return 1;
+}
+
+/* These tables are a kluge that will not scale well when more
+ vectorized subrs are added.  It is tempting to steal some bits from
+ the CAR of all subrs (like those selected by SMOBNUM) to hold an
+ offset into a table of vectorized subrs.  */
+
+static ra_iproc ra_rpsubrs[] = {
+  {"=", UNDEFINED, ra_eqp},
+  {"<", UNDEFINED, ra_lessp},
+  {"<=", UNDEFINED, ra_leqp},
+  {">", UNDEFINED, ra_grp},
+  {">=", UNDEFINED, ra_greqp},
+  {0, 0, 0}};
+static ra_iproc ra_asubrs[] = {
+  {"+", UNDEFINED, ra_sum},
+  {"-", UNDEFINED, ra_difference},
+  {"*", UNDEFINED, ra_product},
+  {"/", UNDEFINED, ra_divide},
+  {0, 0, 0}};
+
+static char s_sarray_map[] = "serial-array-map!";
+# define s_array_map  (s_sarray_map + 7)
+SCM array_map(ra0, proc, lra)
+     SCM ra0, proc, lra;
+{
+  int narg = ilength(lra);
+  ASSERT(BOOL_T==procedurep(proc), proc, ARG2, s_array_map);
+ tail:
+  switch TYP7(proc) {
+  wna: wta(UNDEFINED, (char *)WNA, s_array_map);
+  default: gencase:
+    ramapc(ramap, proc, ra0, lra, s_array_map);
+    return UNSPECIFIED;
+  case tc7_subr_1: ASRTGO(1==narg, wna);
+    ramapc(ramap_1, proc, ra0, lra, s_array_map);
+    return UNSPECIFIED;
+  case tc7_subr_2: ASRTGO(2==narg, wna);
+  case tc7_subr_2o: ASRTGO(2>=narg, wna);
+    ramapc(ramap_2o, proc, ra0, lra, s_array_map);
+    return UNSPECIFIED;
+  case tc7_cxr: if (! SUBRF(proc)) goto gencase;
+    ASRTGO(1==narg, wna);
+    ramapc(ramap_cxr, proc, ra0, lra, s_array_map);
+    return UNSPECIFIED;
+  case tc7_rpsubr: {
+    ra_iproc *p;
+    if (FALSEP(arrayp(ra0, BOOL_T))) goto gencase;
+    array_fill(ra0, BOOL_T);
+    for (p = ra_rpsubrs; p->name; p++)
+      if (proc==p->sproc) {
+	while (NNULLP(lra) && NNULLP(CDR(lra))) {
+	  ramapc(p->vproc, UNDEFINED, ra0, lra, s_array_map);
+	  lra = CDR(lra);
+	}
+	return UNSPECIFIED;
+      }
+    while (NNULLP(lra) && NNULLP(CDR(lra))) {
+      ramapc(ramap_rp, proc, ra0, lra, s_array_map);
+      lra = CDR(lra);
+    }
+    return UNSPECIFIED;
+  }
+  case tc7_asubr:
+    if NULLP(lra) {
+      SCM prot, fill = SUBRF(proc)(UNDEFINED, UNDEFINED);
+      if INUMP(fill) {
+	prot = array_prot(ra0);
+# ifdef FLOATS
+	if (NIMP(prot) && INEXP(prot))
+	  fill = makdbl((double)INUM(fill), 0.0);
+# endif
+      }
+      array_fill(ra0, fill);
+    }
+    else {
+      SCM tail, ra1 = CAR(lra);
+      SCM v0 = (NIMP(ra0) && ARRAYP(ra0) ? ARRAY_V(ra0) : ra0);
+      ra_iproc *p;
+      /* Check to see if order might matter.
+	 This might be an argument for a separate
+	 SERIAL-ARRAY-MAP! */
+      if (v0==ra1 || (NIMP(ra1) && ARRAYP(ra1) && v0==ARRAY_V(ra1)))
+	if (ra0 != ra1 || (ARRAYP(ra0) && !ARRAY_CONTP(ra0)))
+	  goto gencase;
+      for (tail = CDR(lra); NNULLP(tail); tail = CDR(tail)) {
+	ra1 = CAR(tail);
+	if (v0==ra1 || (NIMP(ra1) && ARRAYP(ra1) && v0==ARRAY_V(ra1)))
+	  goto gencase;
+      }
+      for (p = ra_asubrs; p->name; p++)
+	if (proc==p->sproc) {
+	  if (ra0 != CAR(lra))
+	    ramapc(ra_identity, UNDEFINED, ra0, cons(CAR(lra), EOL), s_array_map);
+	  lra = CDR(lra);
+	  while (1) {
+	    ramapc(p->vproc, UNDEFINED, ra0, lra, s_array_map);
+	    if (IMP(lra) || IMP(CDR(lra))) return UNSPECIFIED;
+	    lra = CDR(lra);
+	  }
+	}
+      ramapc(ramap_2o, proc, ra0, lra, s_array_map);
+      lra = CDR(lra);
+      if NIMP(lra)
+	for (lra = CDR(lra); NIMP(lra); lra = CDR(lra))
+	  ramapc(ramap_a, proc, ra0, lra, s_array_map);
+    }
+    return UNSPECIFIED;
+#ifdef CCLO
+  case tc7_cclo:
+    lra = cons(sc2array(proc,ra0,EOL), lra);
+    proc = CCLO_SUBR(proc);
+    goto tail;
+#endif
+  }
+}
+
+static int rafe(ra0, proc, ras)
+     SCM ra0, proc, ras;
+{
+  long i = ARRAY_DIMS(ra0)->lbnd;
+  sizet i0 = ARRAY_BASE(ra0);
+  long inc0 = ARRAY_DIMS(ra0)->inc;
+  long n = ARRAY_DIMS(ra0)->ubnd;
+  ra0 = ARRAY_V(ra0);
+  if NULLP(ras)
+    for (; i <= n; i++, i0 += inc0)
+      apply(proc, cvref(ra0, i0, UNDEFINED), listofnull);
+  else {
+    SCM ra1 = CAR(ras);
+    SCM args, *ve = &ras;
+    sizet k, i1 = ARRAY_BASE(ra1);
+    long inc1 = ARRAY_DIMS(ra1)->inc;
+    ra1 = ARRAY_V(ra1);
+    ras = CDR(ras);
+    if NULLP(ras)
+      ras = nullvect;
+    else {
+      ras = vector(ras);
+      ve = VELTS(ras);
+    }
+    for (; i <= n; i++, i0 += inc0, i1 += inc1) {
+      args = EOL;
+      for (k = LENGTH(ras); k--;)
+	args = cons(aref(ve[k], MAKINUM(i)), args);
+      args = cons2(cvref(ra0, i0, UNDEFINED), cvref(ra1, i1, UNDEFINED), args);
+      apply(proc, args, EOL);
+    }
+  }
+  return 1;
+}
+static char s_array_for_each[] = "array-for-each";
+SCM array_for_each(proc, ra0, lra)
+     SCM proc, ra0, lra;
+{
+  ASSERT(BOOL_T==procedurep(proc), proc, ARG1, s_array_for_each);
+ tail:
+  switch TYP7(proc) {
+  default:
+    ramapc(rafe, proc, ra0, lra, s_array_for_each);
+    return UNSPECIFIED;
+#ifdef CCLO
+  case tc7_cclo:
+    lra = cons(ra0, lra);
+    ra0 = sc2array(proc, ra0, EOL);
+    proc = CCLO_SUBR(proc);
+    goto tail;
+#endif
+  }
+}
+
+static char s_array_imap[] = "array-index-map!";
+SCM array_imap(ra, proc)
+     SCM ra, proc;
+{
+  sizet i;
+  ASSERT(NIMP(ra), ra, ARG1, s_array_imap);
+  ASSERT(BOOL_T==procedurep(proc), proc, ARG2, s_array_imap);
+  switch TYP7(ra) {
+  default: badarg: wta(ra, (char *)ARG1, s_array_imap);
+  case tc7_vector:
+    {
+      SCM *ve = VELTS(ra);
+      for (i = 0; i < LENGTH(ra); i++)
+	ve[i] = apply(proc, MAKINUM(i), listofnull);
+      return UNSPECIFIED;
+    }
+  case tc7_string: case tc7_bvect: case tc7_uvect: case tc7_ivect:
+  case tc7_fvect: case tc7_dvect: case tc7_cvect:
+    for (i = 0; i < LENGTH(ra); i++)
+      aset(ra, apply(proc, MAKINUM(i), listofnull), MAKINUM(i));
+    return UNSPECIFIED;
+  case tc7_smob: ASRTGO(ARRAYP(ra), badarg);
+    {
+      SCM args = EOL;
+      SCM inds = make_uve(ARRAY_NDIM(ra)+0L, MAKINUM(-1L));
+      long *vinds = VELTS(inds);
+      int j, k, kmax = ARRAY_NDIM(ra) - 1;
+      for (k = 0; k <= kmax; k++)
+	vinds[k] = ARRAY_DIMS(ra)[k].lbnd;
+      k = kmax;
+      do {
+	if (k==kmax) {
+	  vinds[k] = ARRAY_DIMS(ra)[k].lbnd;
+	  i = cind(ra, inds);
+	  for (; vinds[k] <= ARRAY_DIMS(ra)[k].ubnd; vinds[k]++) {
+	    for (j = kmax+1, args = EOL; j--;)
+	      args = cons(MAKINUM(vinds[j]), args);
+	    aset(ARRAY_V(ra), apply(proc, args, EOL), MAKINUM(i));
+	    i += ARRAY_DIMS(ra)[k].inc;
+	  }
+	  k--;
+	  continue;
+	}
+	if (vinds[k] < ARRAY_DIMS(ra)[k].ubnd) {
+	  vinds[k]++;
+	  k++;
+	  continue;
+	}
+	vinds[k] = ARRAY_DIMS(ra)[k].lbnd - 1;
+	k--;
+      } while (k >= 0);
+      return UNSPECIFIED;
+    }
+  }
+}
+
+SCM array_equal P((SCM ra0, SCM ra1));
+static int raeql_1(ra0, as_equal, ra1)
+     SCM ra0, as_equal, ra1;
+{
+  SCM e0 = UNDEFINED, e1 = UNDEFINED;
+  sizet i0 = 0, i1 = 0;
+  long inc0 = 1, inc1 = 1;
+  sizet n = LENGTH(ra0);
+  ra1 = CAR(ra1);
+  if ARRAYP(ra0) {
+    n = ARRAY_DIMS(ra0)->ubnd - ARRAY_DIMS(ra0)->lbnd + 1;
+    i0 = ARRAY_BASE(ra0);
+    inc0 = ARRAY_DIMS(ra0)->inc;
+    ra0 = ARRAY_V(ra0);
+  }
+  if ARRAYP(ra1) {
+    i1 = ARRAY_BASE(ra1);
+    inc1 = ARRAY_DIMS(ra1)->inc;
+    ra1 = ARRAY_V(ra1);
+  }
+  switch TYP7(ra0) {
+  case tc7_vector: default:
+    for (; n--; i0+=inc0, i1+=inc1) {
+      if FALSEP(as_equal) {
+	if FALSEP(array_equal(RVREF(ra0, i0, e0), RVREF(ra1, i1, e1)))
+	  return 0;
+      }
+      else
+	if FALSEP(equal(RVREF(ra0, i0, e0), RVREF(ra1, i1, e1)))
+	  return 0;
+    }
+    return 1;
+  case tc7_string: {
+    char *v0 = CHARS(ra0) + i0;
+    char *v1 = CHARS(ra1) + i1;
+    for (; n--; v0 += inc0, v1 += inc1)
+      if (*v0 != *v1) return 0;
+    return 1;
+  }
+  case tc7_bvect:
+    for (; n--; i0 += inc0, i1 += inc1)
+      if (BVE_REF(ra0, i0) != BVE_REF(ra1, i1)) return 0;
+    return 1;
+  case tc7_uvect: case tc7_ivect: {
+    long *v0 = (long *)VELTS(ra0) + i0;
+    long *v1 = (long *)VELTS(ra1) + i1;
+    for (; n--; v0 += inc0, v1 += inc1)
+      if (*v0 != *v1) return 0;
+    return 1;
+  }
+# ifdef FLOATS
+#  ifdef SINGLES
+  case tc7_fvect: {
+    float *v0 = (float *)VELTS(ra0) + i0;
+    float *v1 = (float *)VELTS(ra1) + i1;
+    for (; n--; v0 += inc0, v1 += inc1)
+      if (*v0 != *v1) return 0;
+    return 1;
+  }
+#  endif /* SINGLES */
+  case tc7_dvect: {
+    double *v0 = (double *)VELTS(ra0) + i0;
+    double *v1 = (double *)VELTS(ra1) + i1;
+    for (; n--; v0 += inc0, v1 += inc1)
+      if (*v0 != *v1) return 0;
+    return 1;
+  }
+  case tc7_cvect: {
+    double (*v0)[2]= (double (*)[2])VELTS(ra0) + i0;
+    double (*v1)[2] = (double (*)[2])VELTS(ra1) + i1;
+    for (; n--; v0 += inc0, v1 += inc1) {
+      if ((*v0)[0] != (*v1)[0]) return 0;
+      if ((*v0)[1] != (*v1)[1]) return 0;
+    }
+    return 1;
+  }
+# endif /* FLOATS */
+  }
+}
+static int raeql(ra0, as_equal, ra1)
+     SCM ra0, as_equal, ra1;
+{
+  SCM v0 = ra0, v1 = ra1;
+  array_dim dim0, dim1;
+  array_dim *s0 = &dim0, *s1 = &dim1;
+  sizet bas0 = 0, bas1 = 0;
+  int k, unroll = 1, ndim = 1;
+  if ARRAYP(ra0) {
+    ndim = ARRAY_NDIM(ra0);
+    s0 = ARRAY_DIMS(ra0);
+    bas0 = ARRAY_BASE(ra0);
+    v0 = ARRAY_V(ra0);
+  }
+  else {
+    s0->inc = 1; s0->lbnd = 0; s0->ubnd = LENGTH(v0) - 1;
+  }
+  if ARRAYP(ra1) {
+    if (ndim != ARRAY_NDIM(ra1)) return 0;
+    s1 = ARRAY_DIMS(ra1);
+    bas1 = ARRAY_BASE(ra1);
+    v1 = ARRAY_V(ra1);
+  }
+  else {
+    if (1 != ndim) return BOOL_F;
+    s1->inc = 1; s1->lbnd = 0; s1->ubnd = LENGTH(v1) - 1;
+  }
+  if (TYP7(v0) != TYP7(v1)) return 0;
+  unroll = (bas0==bas1);
+  for (k = ndim; k--;) {
+    if (s0[k].lbnd != s1[k].lbnd || s0[k].ubnd != s1[k].ubnd) return 0;
+    if (unroll) unroll = (s0[k].inc==s1[k].inc);
+  }
+  if (unroll && v0==v1) return BOOL_T;
+  return ramapc(raeql_1, as_equal, ra0, cons(ra1, EOL), "");
+}
+
+SCM raequal(ra0, ra1)
+     SCM ra0, ra1;
+{
+  return (raeql(ra0, BOOL_T, ra1) ? BOOL_T : BOOL_F);
+}
+static char s_array_equalp[] = "array-equal?";
+SCM array_equal(ra0, ra1)
+     SCM ra0, ra1;
+{
+  if (IMP(ra0) || IMP(ra1))
+  callequal: return equal(ra0, ra1);
+  switch TYP7(ra0) {
+  default: goto callequal;
+  case tc7_bvect: case tc7_string: case tc7_uvect: case tc7_ivect:
+  case tc7_fvect: case tc7_dvect: case tc7_cvect: case tc7_vector:
+    break;
+  case tc7_smob: if (!ARRAYP(ra0)) goto callequal;
+  }
+  switch TYP7(ra1) {
+  default: goto callequal;
+  case tc7_bvect: case tc7_string: case tc7_uvect: case tc7_ivect:
+  case tc7_fvect: case tc7_dvect: case tc7_cvect: case tc7_vector:
+    break;
+  case tc7_smob: if (!ARRAYP(ra1)) goto callequal;
+  }
+  return (raeql(ra0, BOOL_F, ra1) ? BOOL_T : BOOL_F);
+}
+
+static iproc subr2os[] = {
+  {s_ura_rd, ura_read},
+  {s_ura_wr, ura_write},
+  {0, 0}};
+
+static iproc subr2s[] = {
+	{s_array_fill, array_fill},
+	{s_array_copy, array_copy},
+	{s_sarray_copy, array_copy},
+	{0, 0}};
+
+static iproc lsubr2s[] = {
+  {s_sc2array, sc2array},
+  {s_array_map, array_map},
+  {s_sarray_map, array_map},
+  {s_array_for_each, array_for_each},
+  {s_array_imap, array_imap},
+  {0, 0}};
+
+static void init_raprocs(subra)
+     ra_iproc *subra;
+{
+  for(; subra->name; subra++)
+    subra->sproc = CDR(intern(subra->name, strlen(subra->name)));
+}
+
+void init_ramap()
+{
+  init_raprocs(ra_rpsubrs);
+  init_raprocs(ra_asubrs);
+  init_iprocs(subr2os, tc7_subr_2o);
+  init_iprocs(subr2s, tc7_subr_2);
+  init_iprocs(lsubr2s, tc7_lsubr_2);
+  make_subr(s_array_equalp, tc7_rpsubr, array_equal);
+  smobs[0x0ff & (tc16_array>>8)].equalp = raequal;
+  add_feature(s_array_for_each);
+}
diff --git a/record.c b/record.c
new file mode 100644
index 0000000..40b224c
--- /dev/null
+++ b/record.c
@@ -0,0 +1,349 @@
+/* Copyright (C) 1994, 1995 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  
+ */
+
+/* "record.c" code for (R5RS) proposed "Record" user definable datatypes.
+   Author: Radey Shouman */
+
+#include "scm.h"
+
+typedef struct {
+  SCM rtd;
+  SCM name;
+  SCM fields;
+} rtd_type;
+
+typedef union {
+  struct {
+    SCM proc;
+    SCM rtd;
+  } pred;
+  struct {
+    SCM proc;
+    SCM rtd;
+    SCM index;
+  } acc;
+  struct {
+    SCM proc;
+    SCM rtd;
+    SCM recsize;
+    SCM indices;
+  } constr;
+} rec_cclo;
+
+long tc16_record;
+
+/* Record-type-descriptor for record-type-descriptors */
+static SCM the_rtd_rtd;
+
+/* Record <= [rtd, ... elts ... ] */
+#define REC_RTD(x) (VELTS(x)[0])
+#define RECP(x) (tc16_record==TYP16(x))
+#define RTDP(x) (RECP(x) && the_rtd_rtd==REC_RTD(x))
+#define RTD_NAME(x) (((rtd_type *)CDR(x))->name)
+#define RTD_FIELDS(x) (((rtd_type *)CDR(x))->fields)
+#define RCLO_RTD(x) (((rec_cclo *)CDR(x))->pred.rtd)
+
+#ifdef ARRAYS
+# define MAKE_REC_INDS(n) make_uve((long)n, MAKINUM(1))
+# define REC_IND_REF(x, i) VELTS(x)[(i)]
+# define REC_IND_SET(x, i, val) VELTS(x)[(i)] = (val)
+#else
+# define MAKE_REC_INDS(n) make_vector(MAKINUM(n), INUM0)
+# define REC_IND_REF(x, i) INUM(VELTS(x)[(i)])
+# define REC_IND_SET(x, i, val) VELTS(x)[(i)] = MAKINUM(val)
+#endif
+
+static char s_record[] = "record";
+static char s_recordp[] = "record?";
+SCM recordp(obj)
+     SCM obj;
+{
+  return (NIMP(obj) && RECP(obj) ? BOOL_T : BOOL_F);
+}
+static char s_rec_pred1[] = " record-predicate-procedure";
+SCM rec_pred1(cclo, obj)
+     SCM cclo, obj;
+{
+  if (NIMP(obj) && RECP(obj) && (REC_RTD(obj)==RCLO_RTD(cclo)))
+    return BOOL_T;
+  return BOOL_F;
+}
+static SCM f_rec_pred1;
+static char s_rec_pred[] = "record-predicate";
+SCM rec_pred(rtd)
+     SCM rtd;
+{
+  SCM cclo = makcclo(f_rec_pred1, 2L);
+  ASSERT(NIMP(rtd) && RTDP(rtd), rtd, ARG1, s_rec_pred);
+  RCLO_RTD(cclo) = rtd;
+  return cclo;
+}
+
+static char s_rec_rtd[] = "record-type-descriptor";
+SCM rec_rtd(rec)
+     SCM rec;
+{
+  if (IMP(rec) || !RECP(rec)) return BOOL_F;
+  return REC_RTD(rec);
+}
+
+static SCM f_rec_constr1;
+static char s_rec_constr[] = "record-constructor";
+SCM rec_constr(rtd, flds)
+     SCM rtd, flds;
+{
+  SCM flst, fld;
+  SCM cclo = makcclo(f_rec_constr1, (long)sizeof(rec_cclo)/sizeof(SCM));
+  rec_cclo *ptr = (rec_cclo *)CDR(cclo);
+  sizet i, j;
+  ASSERT(NIMP(rtd) && RTDP(rtd), rtd, ARG1, s_rec_constr);
+  ptr->constr.rtd = rtd;
+  i = ilength(RTD_FIELDS(rtd));
+  ptr->constr.recsize = MAKINUM(i);
+  if UNBNDP(flds) {
+    ptr->constr.indices = MAKE_REC_INDS(i);
+    while (i--)
+      REC_IND_SET(ptr->constr.indices, i, i+1);
+  }
+  else {
+    ASSERT(NIMP(flds) && CONSP(flds), flds, ARG2, s_rec_constr);
+    ptr->constr.indices = MAKE_REC_INDS(ilength(flds));
+    for(i = 0; NIMP(flds); i++, flds = CDR(flds)) {
+      fld = CAR(flds);
+      ASSERT(NIMP(fld) && SYMBOLP(fld), fld, ARG2, s_rec_constr);
+      flst = RTD_FIELDS(rtd);
+      for (j = 0; ; j++, flst = CDR(flst)) {
+	if (fld==CAR(flst)) {
+	  REC_IND_SET(ptr->constr.indices, i, j+1);
+	  break;
+	}
+	ASSERT(NNULLP(flst), fld, ARG2, s_rec_constr);
+      }
+    }
+  }
+  return cclo;
+}
+static char s_rec_constr1[] = " record-constructor-procedure";
+SCM rec_constr1(args)
+     SCM args;
+{
+  SCM cclo = CAR(args);
+  SCM rec, inds = (((rec_cclo *)CDR(cclo))->constr.indices);
+  sizet i = INUM(((rec_cclo *)CDR(cclo))->constr.recsize);
+  args = CDR(args);
+  NEWCELL(rec);
+  DEFER_INTS;
+  SETCHARS(rec, must_malloc((i+1L)*sizeof(SCM), s_record));
+  SETNUMDIGS(rec, i+1L, tc16_record);
+  ALLOW_INTS;
+  while (i--)
+    VELTS(rec)[i+1] = UNSPECIFIED;
+  REC_RTD(rec) = RCLO_RTD(cclo);
+  for (i = 0; i < LENGTH(inds); i++, args = CDR(args)) {
+    ASSERT(NNULLP(args), UNDEFINED, WNA, s_rec_constr1);
+    VELTS(rec)[ REC_IND_REF(inds, i) ] = CAR(args);
+  }
+  ASSERT(NULLP(args), UNDEFINED, WNA, s_rec_constr1);
+  return rec;
+
+}
+
+/* Makes an accessor or modifier.
+   A cclo with 2 env elts -- rtd and field-number. */
+static SCM makrecclo(proc, rtd, field, what)
+     SCM proc, rtd, field;
+     char *what;
+{
+  SCM flst;
+  SCM cclo = makcclo(proc, 3L);
+  int i;
+  ASSERT(RTDP(rtd), rtd, ARG1, what);
+  ASSERT(NIMP(field) && SYMBOLP(field), field, ARG2, what);
+  RCLO_RTD(cclo) = rtd;
+  flst = RTD_FIELDS(rtd);
+  for (i = 1; ; i++) {
+    ASSERT(NNULLP(flst), field, ARG2, what);
+    if (CAR(flst)==field) break;
+    flst = CDR(flst);
+  }
+  (((rec_cclo *)CDR(cclo))->acc.index) = MAKINUM(i);
+  return cclo;
+}
+static char s_rec_accessor1[] = " record-accessor-procedure";
+SCM rec_accessor1(cclo, rec)
+     SCM cclo, rec;
+{
+  ASSERT(NIMP(rec) && RECP(rec), rec, ARG1, s_rec_accessor1);
+  ASSERT(RCLO_RTD(cclo)==REC_RTD(rec), rec, ARG1, s_rec_accessor1);
+  return VELTS(rec)[ INUM(((rec_cclo *)CDR(cclo))->acc.index) ];
+}
+static char s_rec_modifier1[] = " record-modifier-procedure";
+SCM rec_modifier1(cclo, rec, val)
+     SCM cclo, rec, val;
+{
+  ASSERT(NIMP(rec) && RECP(rec), rec, ARG1, s_rec_modifier1);
+  ASSERT(RCLO_RTD(cclo)==REC_RTD(rec), rec, ARG1, s_rec_modifier1);
+  VELTS(rec)[ INUM(((rec_cclo *)CDR(cclo))->acc.index) ] = val;
+  return UNSPECIFIED;
+}
+static SCM f_rec_accessor1;
+static char s_rec_accessor[] = "record-accessor";
+SCM rec_accessor(rtd, field)
+     SCM rtd, field;
+{
+ return makrecclo(f_rec_accessor1, rtd, field, s_rec_accessor);
+}
+static SCM f_rec_modifier1;
+static char s_rec_modifier[] = "record-modifier";
+SCM rec_modifier(rtd, field)
+     SCM rtd, field;
+{
+ return makrecclo(f_rec_modifier1, rtd, field, s_rec_accessor);
+}
+
+static char s_makrectyp[] = "make-record-type";
+SCM *loc_makrtd;
+SCM makrectyp(name, fields)
+     SCM name, fields;
+{
+  SCM n;
+#ifndef RECKLESS
+  if(ilength(fields) < 0)
+  errout: wta(fields, (char *)ARG2, s_makrectyp);
+  for (n=fields; NIMP(n); n = CDR(n))
+    if (!SYMBOLP(CAR(n))) goto errout;
+#endif
+  return apply(*loc_makrtd, name, cons(fields, listofnull));
+}
+
+static SCM markrec(ptr)
+     SCM ptr;
+{
+  sizet i;
+  if GC8MARKP(ptr) return BOOL_F;
+  SETGC8MARK(ptr);
+  for (i = NUMDIGS(ptr); --i;)
+    if NIMP(VELTS(ptr)[i]) gc_mark(VELTS(ptr)[i]);
+  return REC_RTD(ptr);
+}
+static sizet freerec(ptr)
+     CELLPTR ptr;
+{
+  must_free(CHARS(ptr));
+  return sizeof(SCM)*NUMDIGS(ptr);
+}
+static int recprin1(exp, port, writing)
+     SCM exp, port;
+     int writing;
+{
+  SCM names = RTD_FIELDS(REC_RTD(exp));
+  sizet i;
+  lputs("#s(", port);
+  iprin1(RTD_NAME(REC_RTD(exp)), port, 0);
+  for (i = 1; i < NUMDIGS(exp); i++) {
+    lputc(' ', port);
+    iprin1(CAR(names), port, 0);
+    names = CDR(names);
+    lputc(' ', port);
+    iprin1(VELTS(exp)[i], port, writing);
+  }
+  lputc(')', port);
+/*
+  lputs("#<record <", port);
+  iprin1(RTD_NAME(REC_RTD(exp)), port, 0);
+  lputc('>', port);
+  for(i = 1; i < NUMDIGS(exp); i++) {
+      lputc(' ', port);
+      iprin1(VELTS(exp)[i], port, writing);
+    }
+  lputc('>', port);
+*/
+  return 1;
+}
+SCM recequal(rec0, rec1)
+     SCM rec0, rec1;
+{
+  sizet i = NUMDIGS(rec0);
+  if (i != NUMDIGS(rec1)) return BOOL_F;
+  if (REC_RTD(rec0) != REC_RTD(rec1)) return BOOL_F;
+  while(--i)
+    if FALSEP(equal(VELTS(rec0)[i], VELTS(rec1)[i]))
+      return BOOL_F;
+  return BOOL_T;
+}
+static smobfuns recsmob = {markrec, freerec, recprin1, recequal};
+static iproc subr1s[] = {
+  {s_recordp, recordp},
+  {s_rec_pred, rec_pred},
+  {s_rec_rtd, rec_rtd},
+  {0, 0}};
+static iproc subr2s[] = {
+  {s_rec_accessor, rec_accessor},
+  {s_rec_modifier, rec_modifier},
+  {s_makrectyp, makrectyp},
+  {0, 0}};
+static char s_name[] = "name";
+static char s_fields[] = "fields";
+void init_record()
+{
+  SCM i_name = CAR(intern(s_name, (sizeof s_name)-1));
+  SCM i_fields = CAR(intern(s_fields, (sizeof s_fields)-1));
+  tc16_record = newsmob(&recsmob);
+  NEWCELL(the_rtd_rtd);
+  SETCHARS(the_rtd_rtd, must_malloc((long)sizeof(rtd_type), s_record));
+  SETNUMDIGS(the_rtd_rtd, (long)sizeof(rtd_type)/sizeof(SCM), tc16_record);
+  REC_RTD(the_rtd_rtd) = the_rtd_rtd;
+  RTD_NAME(the_rtd_rtd) = makfromstr(s_record, (sizeof s_record)-1);
+  RTD_FIELDS(the_rtd_rtd) = cons2(i_name, i_fields, EOL);
+  sysintern("record:rtd", the_rtd_rtd);
+  f_rec_pred1 = make_subr(s_rec_pred1, tc7_subr_2, rec_pred1);
+  f_rec_constr1 = make_subr(s_rec_constr1, tc7_lsubr, rec_constr1);
+  f_rec_accessor1 = make_subr(s_rec_accessor1, tc7_subr_2, rec_accessor1);
+  f_rec_modifier1 = make_subr(s_rec_modifier1, tc7_subr_3, rec_modifier1);
+  make_subr(s_rec_constr, tc7_subr_2o, rec_constr);
+  init_iprocs(subr1s, tc7_subr_1);
+  init_iprocs(subr2s, tc7_subr_2);
+  sysintern("record-type-descriptor?", rec_pred(the_rtd_rtd));
+  sysintern("record-type-name", rec_accessor(the_rtd_rtd, i_name));
+  sysintern("record-type-field-names", rec_accessor(the_rtd_rtd, i_fields));
+  loc_makrtd = &CDR(sysintern("RTD:make", rec_constr(the_rtd_rtd, UNDEFINED)));
+  add_feature(s_record);
+}
diff --git a/repl.c b/repl.c
new file mode 100644
index 0000000..48ac94a
--- /dev/null
+++ b/repl.c
@@ -0,0 +1,1649 @@
+/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  
+ */
+
+/* "repl.c" error, read-eval-print loop, read, write and load code.
+   Author: Aubrey Jaffer */
+
+#include "scm.h"
+#include "setjump.h"
+void	igc P((char *what, STACKITEM *stackbase));
+
+#ifdef ARM_ULIB
+# include <termio.h>
+int set_erase()
+{
+   struct termio tin;
+
+   ioctl(0, TCGETA, &tin);
+   tin.c_cc[VERASE] = '\010';
+
+   ioctl(0, TCSETA,&tin);
+   return(0);
+}
+#endif
+
+unsigned char upcase[CHAR_CODE_LIMIT];
+unsigned char downcase[CHAR_CODE_LIMIT];
+unsigned char lowers[] = "abcdefghijklmnopqrstuvwxyz";
+unsigned char uppers[] = "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
+extern int verbose;
+void init_tables()
+{
+  int i;
+  for(i = 0;i<CHAR_CODE_LIMIT;i++) upcase[i] = downcase[i] = i;
+  for(i = 0;i<sizeof lowers/sizeof(char);i++) {
+    upcase[lowers[i]] = uppers[i];
+    downcase[uppers[i]] = lowers[i];
+  }
+  verbose = 1;			/* Here so that monitor info won't be */
+				/* printed while in init_storage. (BOOM) */
+}
+
+#ifdef EBCDIC
+char *charnames[] = {
+  "nul","soh","stx","etx", "pf", "ht", "lc","del",
+   0   , 0   ,"smm", "vt", "ff", "cr", "so", "si",
+  "dle","dc1","dc2","dc3","res", "nl", "bs", "il",
+  "can", "em", "cc", 0   ,"ifs","igs","irs","ius",
+   "ds","sos", "fs", 0   ,"byp", "lf","eob","pre",
+   0   , 0   , "sm", 0   , 0   ,"enq","ack","bel",
+   0   , 0   ,"syn", 0   , "pn", "rs", "uc","eot",
+   0   , 0   , 0   , 0   ,"dc4","nak", 0   ,"sub",
+  "space", s_newline, "tab", "backspace", "return", "page", "null"};
+char charnums[] =
+"\000\001\002\003\004\005\006\007\
+\010\011\012\013\014\015\016\017\
+\020\021\022\023\024\025\026\027\
+\030\031\032\033\034\035\036\037\
+\040\041\042\043\044\045\046\047\
+\050\051\052\053\054\055\056\057\
+\060\061\062\063\064\065\066\067\
+\070\071\072\073\074\075\076\077\
+ \n\t\b\r\f\0";
+#endif /* def EBCDIC */
+#ifdef ASCII
+char *charnames[] = {
+  "nul","soh","stx","etx","eot","enq","ack","bel",
+   "bs", "ht", "nl", "vt", "np", "cr", "so", "si",
+  "dle","dc1","dc2","dc3","dc4","nak","syn","etb",
+  "can", "em","sub","esc", "fs", "gs", "rs", "us",
+  "space", s_newline, "tab", "backspace", "return", "page", "null", "del"};
+char charnums[] =
+"\000\001\002\003\004\005\006\007\
+\010\011\012\013\014\015\016\017\
+\020\021\022\023\024\025\026\027\
+\030\031\032\033\034\035\036\037\
+ \n\t\b\r\f\0\177";
+#endif /* def ASCII */
+char *isymnames[] = {
+				/* Special Forms */
+				/*  NUM_ISPCSYMS ISPCSYMS here */
+  "#@and", "#@begin", "#@case", "#@cond", "#@do", "#@if", "#@lambda",
+  "#@let", "#@let*", "#@letrec", "#@or", "#@quote", "#@set!",
+  "#@define", "#@apply", "#@call-with-current-continuation",
+				/* user visible ISYMS */
+				/* other keywords */
+				/* Flags */
+  "#f", "#t", "#<undefined>", "#<eof>", "()", "#<unspecified>"
+  };
+
+static char	s_read_char[] = "read-char", s_peek_char[] = "peek-char";
+char	s_read[] = "read", s_write[] = "write", s_newline[] = "newline";
+static char	s_display[] = "display", s_write_char[] = "write-char";
+
+static char	s_eofin[] = "end of file in ";
+static char	s_unknown_sharp[] = "unknown # object";
+
+static SCM lreadr P((SCM tok_buf, SCM port));
+static SCM lreadparen P((SCM tok_buf, SCM port, char *name));
+static sizet read_token P((int ic, SCM tok_buf, SCM port));
+
+void intprint(n, radix, port)
+     long n;
+     int radix;
+     SCM port;
+{
+  char num_buf[INTBUFLEN];
+  lfwrite(num_buf, (sizet)sizeof(char), iint2str(n, radix, num_buf), port);
+}
+
+void ipruk(hdr, ptr, port)
+     char *hdr;
+     SCM ptr;
+     SCM port;
+{
+  lputs("#<unknown-", port);
+  lputs(hdr, port);
+  if CELLP(ptr) {
+    lputs(" (0x", port);
+    intprint(CAR(ptr), 16, port);
+    lputs(" . 0x", port);
+    intprint(CDR(ptr), 16, port);
+    lputs(") @", port);
+  }
+  lputs(" 0x", port);
+  intprint(ptr, 16, port);
+  lputc('>', port);
+}
+
+void iprlist(hdr, exp, tlr, port, writing)
+     char *hdr, tlr;
+     SCM exp;
+     SCM port;
+     int writing;
+{
+  lputs(hdr, port);
+  /* CHECK_INTS; */
+  iprin1(CAR(exp), port, writing);
+  exp = CDR(exp);
+  for(;NIMP(exp);exp = CDR(exp)) {
+    if NECONSP(exp) break;
+    lputc(' ', port);
+    /* CHECK_INTS; */
+    iprin1(CAR(exp), port, writing);
+  }
+  if NNULLP(exp) {
+    lputs(" . ", port);
+    iprin1(exp, port, writing);
+  }
+  lputc(tlr, port);
+}
+void iprin1(exp, port, writing)
+     SCM exp;
+     SCM port;
+int writing;
+{
+  register long i;
+taloop:
+  switch (7 & (int)exp) {
+  case 2:
+  case 6:
+    intprint(INUM(exp), 10, port);
+    break;
+  case 4:
+    if ICHRP(exp) {
+      i = ICHR(exp);
+      if (writing) lputs("#\\", port);
+      if (!writing) lputc((int)i, port);
+      else if ((i <= ' ') && charnames[i]) lputs(charnames[i], port);
+#ifndef EBCDIC
+      else if (i=='\177')
+	lputs(charnames[(sizeof charnames/sizeof(char *))-1], port);
+#endif /* ndef EBCDIC */
+      else if (i > '\177')
+	intprint(i, 8, port);
+      else lputc((int)i, port);
+    }
+    else if (IFLAGP(exp) && (ISYMNUM(exp)<(sizeof isymnames/sizeof(char *))))
+      lputs(ISYMCHARS(exp), port);
+    else if ILOCP(exp) {
+      lputs("#@", port);
+      intprint((long)IFRAME(exp), 10, port);
+      lputc(ICDRP(exp)?'-':'+', port);
+      intprint((long)IDIST(exp), 10, port);
+    }
+    else goto idef;
+    break;
+  case 1:			/* gloc */
+    lputs("#@", port);
+    exp = CAR(exp-1);
+    goto taloop;
+  default:
+  idef:
+    ipruk("immediate", exp, port);
+    break;
+  case 0:
+    switch TYP7(exp) {
+    case tcs_cons_gloc:
+    case tcs_cons_imcar:
+    case tcs_cons_nimcar:
+      iprlist("(", exp, ')', port, writing);
+      break;
+    case tcs_closures:
+      exp = CODE(exp);
+      iprlist("#<CLOSURE ", exp, '>', port, writing);
+      break;
+    case tc7_string:
+      if (writing) {
+	lputc('\"', port);
+	for(i = 0;i<LENGTH(exp);++i) switch (CHARS(exp)[i]) {
+	case '"':
+	case '\\':
+	  lputc('\\', port);
+	default:
+	  lputc(CHARS(exp)[i], port);
+	}
+	lputc('\"', port);
+	break;
+      }
+    case tcs_symbols:
+      lfwrite(CHARS(exp), (sizet)sizeof(char), (sizet)LENGTH(exp), port);
+      break;
+    case tc7_vector:
+      lputs("#(", port);
+      for(i = 0;i+1<LENGTH(exp);++i) {
+	/* CHECK_INTS; */
+	iprin1(VELTS(exp)[i], port, writing);
+	lputc(' ', port);
+      }
+      if (i<LENGTH(exp)) {
+	/* CHECK_INTS; */
+	iprin1(VELTS(exp)[i], port, writing);
+      }
+      lputc(')', port);
+      break;
+    case tc7_bvect:
+    case tc7_ivect:
+    case tc7_uvect:
+    case tc7_fvect:
+    case tc7_dvect:
+    case tc7_cvect:
+      raprin1(exp, port, writing);
+      break;
+    case tcs_subrs:
+      lputs("#<primitive-procedure ", port);
+      lputs(CHARS(SNAME(exp)), port);
+      lputc('>', port);
+      break;
+#ifdef CCLO
+    case tc7_cclo:
+      lputs("#<compiled-closure ", port);
+      iprin1(CCLO_SUBR(exp), port, writing);
+      lputc('>', port);
+      break;
+#endif
+    case tc7_contin:
+      lputs("#<continuation ", port);
+      intprint(LENGTH(exp), 10, port);
+      lputs(" @ ", port);
+      intprint((long)CHARS(exp), 16, port);
+      lputc('>', port);
+      break;
+    case tc7_port:
+      i = PTOBNUM(exp);
+      if (i<numptob && ptobs[i].print && (ptobs[i].print)(exp, port, writing))
+	break;
+      goto punk;
+    case tc7_smob:
+      i = SMOBNUM(exp);
+      if (i<numsmob && smobs[i].print && (smobs[i].print)(exp, port, writing))
+	break;
+      goto punk;
+    default: punk: ipruk("type", exp, port);
+    }
+  }
+}
+
+#ifdef __IBMC__
+# define MSDOS
+#endif
+#ifdef MSDOS
+# ifndef GO32
+#  include <io.h>
+#  include <conio.h>
+static int input_waiting(f)
+     FILE *f;
+{
+  if (feof(f)) return 1;
+  if (fileno(f)==fileno(stdin) && (isatty(fileno(stdin)))) return kbhit();
+  return -1;
+}
+# endif
+#else
+# ifdef _DCC
+#  include <ioctl.h>
+# else
+#  ifndef AMIGA
+#   ifndef vms
+#    ifdef MWC
+#     include <sys/io.h>
+#    else
+#     ifndef THINK_C
+#      ifndef ARM_ULIB
+#       include <sys/ioctl.h>
+#      endif
+#     endif
+#    endif
+#   endif
+#  endif
+# endif
+
+# ifdef HAVE_SELECT
+#  ifdef HAVE_SYS_TIME_H
+#   include <sys/time.h>
+#  endif
+# endif
+
+static int input_waiting(f)
+     FILE *f;
+{
+# ifdef HAVE_SELECT
+  fd_set ifds;
+  struct timeval tv;
+
+  FD_ZERO(&ifds);
+  FD_SET(fileno(f), &ifds);
+  tv.tv_sec = 0;
+  tv.tv_usec = 0;
+  select((fileno(f) + 1), &ifds, (fd_set *) NULL, (fd_set *) NULL, &tv);
+  return FD_ISSET(fileno(f), &ifds);
+# else
+#  ifdef FIONREAD
+  long remir;
+  if (feof(f)) return 1;
+  ioctl(fileno(f), FIONREAD, &remir);
+  return remir;
+#  else
+  return -1;
+#  endif
+# endif
+}
+#endif
+/* perhaps should undefine MSDOS from __IBMC__ here */
+#ifndef GO32
+static char s_char_readyp[]="char-ready?";
+SCM char_readyp(port)
+     SCM port;
+{
+  if UNBNDP(port) port = cur_inp;
+  else ASSERT(NIMP(port) && OPINPORTP(port), port, ARG1, s_char_readyp);
+  if (CRDYP(port) || !(BUF0 & CAR(port))) return BOOL_T;
+  return input_waiting(STREAM(port)) ? BOOL_T : BOOL_F;
+}
+#endif
+
+SCM eof_objectp(x)
+     SCM x;
+{
+	return (EOF_VAL==x) ? BOOL_T : BOOL_F;
+}
+
+void lfflush(port)		/* internal SCM call */
+     SCM port;
+{
+  sizet i = PTOBNUM(port);
+  (ptobs[i].fflush)(STREAM(port));
+}
+static char	s_flush[] = "force-output";
+SCM lflush(port)		/* user accessible as force-output */
+     SCM port;
+{
+	if UNBNDP(port) port = cur_outp;
+	else ASSERT(NIMP(port) && OPOUTPORTP(port), port, ARG1, s_flush);
+	{
+	  sizet i = PTOBNUM(port);
+	  SYSCALL((ptobs[i].fflush)(STREAM(port)););
+	  return UNSPECIFIED;
+	}
+}
+
+SCM lwrite(obj, port)
+     SCM obj, port;
+{
+	if UNBNDP(port) port = cur_outp;
+	else ASSERT(NIMP(port) && OPOUTPORTP(port), port, ARG2, s_write);
+	iprin1(obj, port, 1);
+#ifdef HAVE_PIPE
+# ifdef EPIPE
+	if (EPIPE==errno) close_port(port);
+# endif
+#endif
+	return UNSPECIFIED;
+}
+SCM display(obj, port)
+     SCM obj, port;
+{
+	if UNBNDP(port) port = cur_outp;
+	else ASSERT(NIMP(port) && OPOUTPORTP(port), port, ARG2, s_display);
+	iprin1(obj, port, 0);
+#ifdef HAVE_PIPE
+# ifdef EPIPE
+	if (EPIPE==errno) close_port(port);
+# endif
+#endif
+	return UNSPECIFIED;
+}
+SCM newline(port)
+     SCM port;
+{
+	if UNBNDP(port) port = cur_outp;
+	else ASSERT(NIMP(port) && OPOUTPORTP(port), port, ARG1, s_newline);
+	lputc('\n', port);
+#ifdef HAVE_PIPE
+# ifdef EPIPE
+	if (EPIPE==errno) close_port(port);
+	else
+# endif
+#endif
+	  if (port==cur_outp) lfflush(port);
+	return UNSPECIFIED;
+}
+SCM write_char(chr, port)
+     SCM chr, port;
+{
+	if UNBNDP(port) port = cur_outp;
+	else ASSERT(NIMP(port) && OPOUTPORTP(port), port, ARG2, s_write_char);
+	ASSERT(ICHRP(chr), chr, ARG1, s_write_char);
+	lputc((int)ICHR(chr), port);
+#ifdef HAVE_PIPE
+# ifdef EPIPE
+	if (EPIPE==errno) close_port(port);
+# endif
+#endif
+	return UNSPECIFIED;
+}
+
+FILE *trans = 0;
+SCM trans_on(fil)
+     SCM fil;
+{
+  transcript = open_file(fil, makfromstr("w", (sizet)sizeof(char)));
+  if FALSEP(transcript) trans = 0;
+  else trans = STREAM(transcript);
+  return UNSPECIFIED;
+}
+SCM trans_off()
+{
+  if (!FALSEP(transcript)) close_port(transcript);
+  transcript = BOOL_F;
+  trans = 0;
+  return UNSPECIFIED;
+}
+
+void lputc(c, port)
+     int c;
+     SCM port;
+{
+  sizet i = PTOBNUM(port);
+  SYSCALL((ptobs[i].fputc)(c, STREAM(port)););
+  if (trans && (port==def_outp || port==cur_errp))
+    SYSCALL(fputc(c, trans););
+}
+void lputs(s, port)
+     char *s;
+     SCM port;
+{
+  sizet i = PTOBNUM(port);
+  SYSCALL((ptobs[i].fputs)(s, STREAM(port)););
+  if (trans && (port==def_outp || port==cur_errp))
+    SYSCALL(fputs(s, trans););
+}
+int lfwrite(ptr, size, nitems, port)
+     char *ptr;
+     sizet size;
+     sizet nitems;
+     SCM port;
+{
+  int ret;
+  sizet i = PTOBNUM(port);
+  SYSCALL(ret = (ptobs[i].fwrite)
+	  (ptr, size, nitems, STREAM(port)););
+  if (trans && (port==def_outp || port==cur_errp))
+    SYSCALL(fwrite(ptr, size, nitems, trans););
+  return ret;
+}
+
+int lgetc(port)
+  SCM port;
+{
+  FILE *f;
+  int c;
+  sizet i;
+  /* One char may be stored in the high bits of (car port) orre@nada.kth.se. */
+  if CRDYP(port)
+    {
+      c = CGETUN(port);
+      CLRDY(port);		/* Clear ungetted char */
+      return c;
+    }
+  f=STREAM(port);
+  i = PTOBNUM(port);
+#ifdef linux
+  c = (ptobs[i].fgetc)(f);
+#else
+  SYSCALL(c = (ptobs[i].fgetc)(f););
+#endif
+  if (trans && (f==stdin)) SYSCALL(fputc(c, trans););
+  return c;
+}
+void lungetc(c, port)
+  int c;
+  SCM port;
+{
+/*	ASSERT(!CRDYP(port), port, ARG2, "too many lungetc");*/
+	CUNGET(c, port);
+}
+
+SCM scm_read_char(port)
+     SCM port;
+{
+  int c;
+  if UNBNDP(port) port = cur_inp;
+  else ASSERT(NIMP(port) && OPINPORTP(port), port, ARG1, s_read_char);
+  c = lgetc(port);
+  if (EOF==c) return EOF_VAL;
+  return MAKICHR(c);
+}
+SCM peek_char(port)
+  SCM port;
+{
+	int c;
+	if UNBNDP(port) port = cur_inp;
+	else ASSERT(NIMP(port) && OPINPORTP(port), port, ARG1, s_peek_char);
+	c = lgetc(port);
+	if (EOF==c) return EOF_VAL;
+	lungetc(c, port);
+	return MAKICHR(c);
+}
+
+char *grow_tok_buf(tok_buf)
+     SCM tok_buf;
+{
+  sizet len = LENGTH(tok_buf);
+  len += len / 2;
+  resizuve(tok_buf, (SCM)MAKINUM(len));
+  return CHARS(tok_buf);
+}
+
+static int flush_ws(port, eoferr)
+     SCM port;
+char *eoferr;
+{
+	register int c;
+	while(1) switch (c = lgetc(port)) {
+	case EOF:
+goteof:
+		if (eoferr) wta(UNDEFINED, s_eofin, eoferr);
+		return c;
+	case ';':
+lp:
+		switch (c = lgetc(port)) {
+		case EOF:
+			goto goteof;
+		default:
+			goto lp;
+		case LINE_INCREMENTORS:
+			break;
+		}
+	case LINE_INCREMENTORS:
+		if (port==loadport) linum++;
+	case WHITE_SPACES:
+		break;
+	default:
+		return c;
+	}
+}
+SCM lread(port)
+     SCM port;
+{
+	int c;
+	SCM tok_buf;
+	if UNBNDP(port) port = cur_inp;
+	else ASSERT(NIMP(port) && OPINPORTP(port), port, ARG1, s_read);
+	do {
+	  c = flush_ws(port, (char *)NULL);
+	  if (EOF==c) return EOF_VAL;
+	  lungetc(c, port);
+	  tok_buf = makstr(30L);
+	} while (EOF_VAL==(tok_buf = lreadr(tok_buf, port)));
+	return tok_buf;
+}
+static SCM lreadr(tok_buf, port)
+     SCM tok_buf;
+SCM port;
+{
+	int c;
+	sizet j;
+	SCM p;
+tryagain:
+	c = flush_ws(port, s_read);
+	switch (c) {
+/*	case EOF: return EOF_VAL;*/
+#ifdef BRACKETS_AS_PARENS
+	case '[':
+#endif
+	case '(': return lreadparen(tok_buf, port, s_list);
+#ifdef BRACKETS_AS_PARENS
+	case ']':
+#endif
+	case ')': warn("unexpected \")\"", "");
+	  goto tryagain;
+	case '\'': return cons2(i_quote, lreadr(tok_buf, port), EOL);
+	case '`': return cons2(i_quasiquote, lreadr(tok_buf, port), EOL);
+	case ',':
+		c = lgetc(port);
+		if ('@'==c) p = i_uq_splicing;
+		else {
+			lungetc(c, port);
+			p = i_unquote;
+		}
+		return cons2(p, lreadr(tok_buf, port), EOL);
+	case '#':
+		c = lgetc(port);
+		switch (c) {
+#ifdef BRACKETS_AS_PARENS
+		case '[':
+#endif
+		case '(':
+			p = lreadparen(tok_buf, port, s_vector);
+			return NULLP(p) ? nullvect : vector(p);
+		case 't': case 'T': return BOOL_T;
+		case 'f': case 'F': return BOOL_F;
+		case 'b': case 'B': case 'o': case 'O':
+		case 'd': case 'D': case 'x': case 'X':
+		case 'i': case 'I': case 'e': case 'E':
+			lungetc(c, port);
+			c = '#';
+			goto num;
+		case '*':
+			j = read_token(c, tok_buf, port);
+			p = istr2bve(CHARS(tok_buf)+1, (long)(j-1));
+			if (NFALSEP(p)) return p;
+			else goto unkshrp;
+		case '\\':
+			c = lgetc(port);
+			j = read_token(c, tok_buf, port);
+			if (j==1) return MAKICHR(c);
+			if (c >= '0' && c < '8') {
+			  p = istr2int(CHARS(tok_buf), (long)j, 8);
+			  if (NFALSEP(p)) return MAKICHR(INUM(p));
+			}
+			for (c = 0;c<sizeof charnames/sizeof(char *);c++)
+			  if (charnames[c]
+			      && (0==strcmp(charnames[c], CHARS(tok_buf))))
+			    return MAKICHR(charnums[c]);
+			wta(UNDEFINED, "unknown # object: #\\", CHARS(tok_buf));
+		case '|':
+			j = 1;	/* here j is the comment nesting depth */
+lp:			c = lgetc(port);
+lpc:			switch (c) {
+			case EOF:
+			  wta(UNDEFINED, s_eofin, "balanced comment");
+			case LINE_INCREMENTORS:
+			  if (port==loadport) linum++;
+			default:
+			  goto lp;
+			case '|':
+			  if ('#' != (c = lgetc(port))) goto lpc;
+			  if (--j) goto lp;
+			  break;
+			case '#':
+			  if ('|' != (c = lgetc(port))) goto lpc;
+			  ++j; goto lp;
+			}
+			goto tryagain;
+		case '.':
+			p = lreadr(tok_buf, port);
+			return EVAL(p, (SCM)EOL);
+		default: callshrp:
+			p = CDR(intern("read:sharp", (sizeof "read:sharp")-1));
+			if NIMP(p) {
+			  p = apply(p, MAKICHR(c), acons(port, EOL, EOL));
+			  if (UNSPECIFIED==p) goto tryagain;
+			  return p;
+			}
+		      unkshrp: wta((SCM)MAKICHR(c), s_unknown_sharp, "");
+		}
+	case '\"':
+		j = 0;
+		while ('\"' != (c = lgetc(port))) {
+			ASSERT(EOF != c, UNDEFINED, s_eofin, s_string);
+			if (j+1 >= LENGTH(tok_buf)) grow_tok_buf(tok_buf);
+			if (c=='\\') switch (c = lgetc(port)) {
+			case '\n': continue;
+			case '0': c = '\0'; break;
+			case 'f': c = '\f'; break;
+			case 'n': c = '\n'; break;
+			case 'r': c = '\r'; break;
+			case 't': c = '\t'; break;
+			case 'a': c = '\007'; break;
+			case 'v': c = '\v'; break;
+			}
+			CHARS(tok_buf)[j] = c;
+			++j;
+		}
+		if (j==0) return nullstr;
+		CHARS(tok_buf)[j] = 0;
+		return makfromstr(CHARS(tok_buf), j);
+	case DIGITS:
+	case '.': case '-': case '+':
+num:
+		j = read_token(c, tok_buf, port);
+		p = istring2number(CHARS(tok_buf), (long)j, 10L);
+		if NFALSEP(p) return p;
+	        if (c=='#') {
+		  if ((j==2) && (lgetc(port)=='(')) {
+		    lungetc('(', port);
+		    c = CHARS(tok_buf)[1];
+		    goto callshrp;
+		  }
+		  wta(UNDEFINED, s_unknown_sharp, CHARS(tok_buf));
+		}
+	        goto tok;
+	default:
+		j = read_token(c, tok_buf, port);
+tok:
+		p = intern(CHARS(tok_buf), j);
+		return CAR(p);
+	}
+}
+
+#ifdef _UNICOS
+_Pragma("noopt");		/* # pragma _CRI noopt */
+#endif
+static sizet read_token(ic, tok_buf, port)
+     int ic;
+     SCM tok_buf;
+     SCM port;
+{
+	register sizet j = 1;
+	register int c = ic;
+	register char *p = CHARS(tok_buf);
+	p[0] = downcase[c];
+	while(1) {
+		if (j+1 >= LENGTH(tok_buf)) p = grow_tok_buf(tok_buf);
+		switch (c = lgetc(port)) {
+#ifdef BRACKETS_AS_PARENS
+		case '[': case ']':
+#endif
+		case '(': case ')': case '\"': case ';':
+		case ',': case '`': case '#':
+		case WHITE_SPACES:
+		case LINE_INCREMENTORS:
+			lungetc(c, port);
+		case EOF:
+			p[j] = 0;
+			return j;
+		default:
+			p[j++] = downcase[c];
+		}
+	}
+}
+#ifdef _UNICOS
+_Pragma("opt");			/* # pragma _CRI opt */
+#endif
+
+static SCM lreadparen(tok_buf, port, name)
+     SCM tok_buf;
+     SCM port;
+     char *name;
+{
+  SCM tmp, tl, ans;
+  int c = flush_ws(port, name);
+  if (')'==c
+#ifdef BRACKETS_AS_PARENS
+      || ']'==c
+#endif
+      ) return EOL;
+  lungetc(c, port);
+  if (i_dot==(tmp = lreadr(tok_buf, port))) {
+    ans = lreadr(tok_buf, port);
+  closeit:
+    if (')' != (c = flush_ws(port, name))
+#ifdef BRACKETS_AS_PARENS
+	&& ']' != c
+#endif
+	)
+      wta(UNDEFINED, "missing close paren", "");
+    return ans;
+  }
+  ans = tl = cons(tmp, EOL);
+  while (')' != (c = flush_ws(port, name))
+#ifdef BRACKETS_AS_PARENS
+	 && ']' != c
+#endif
+	 ) {
+    lungetc(c, port);
+    if (i_dot==(tmp = lreadr(tok_buf, port))) {
+      CDR(tl) = lreadr(tok_buf, port);
+      goto closeit;
+    }
+    tl = (CDR(tl) = cons(tmp, EOL));
+  }
+  return ans;
+}
+
+/* These procedures implement synchronization primitives.  Processors
+   with an atomic test-and-set instruction can use it here (and not
+   DEFER_INTS). */
+char s_tryarb[] = "try-arbiter";
+char s_relarb[] = "release-arbiter";
+long tc16_arbiter;
+SCM tryarb(arb)
+     SCM arb;
+{
+  ASSERT((TYP16(arb)==tc16_arbiter), arb, ARG1, s_tryarb);
+  DEFER_INTS;
+  if (CAR(arb) & (1L<<16))
+    arb = BOOL_F;
+  else {
+    CAR(arb) = tc16_arbiter | (1L<<16);
+    arb = BOOL_T;
+  }
+  ALLOW_INTS;
+  return arb;
+}
+SCM relarb(arb)
+     SCM arb;
+{
+  ASSERT((TYP16(arb)==tc16_arbiter), arb, ARG1, s_relarb);
+  if (!(CAR(arb) & (1L<<16))) return BOOL_F;
+  CAR(arb) = tc16_arbiter;
+  return BOOL_T;
+}
+SCM makarb(name)
+     SCM name;
+{
+  register SCM z;
+  NEWCELL(z);
+  CDR(z) = name;
+  CAR(z) = tc16_arbiter;
+  return z;
+}
+static int prinarb(exp, port, writing)
+     SCM exp; SCM port; int writing;
+{
+  lputs("#<arbiter ", port);
+  if (CAR(exp) & (1L<<16)) lputs("locked ", port);
+  iprin1(CDR(exp), port, writing);
+  lputc('>', port);
+  return !0;
+}
+
+static char s_tryload[] = "try-load";
+#define s_load (&s_tryload[4])
+
+struct errdesc {char *msg;char *s_response;short parent_err;};
+struct errdesc errmsgs[] = {
+  {"Wrong number of args", 0, 0},
+  {"numerical overflow", 0, FPE_SIGNAL},
+  {"Argument out of range", 0, FPE_SIGNAL},
+  {"Could not allocate", "out-of-storage", 0},
+  {"EXIT", "end-of-program", -1},
+  {"hang up", "hang-up", EXIT},
+  {"user interrupt", "user-interrupt", 0},
+  {"arithmetic error", "arithmetic-error", 0},
+  {"bus error", 0, 0},
+  {"segment violation", 0, 0},
+  {"alarm", "alarm-interrupt", 0}
+};
+
+int errjmp_bad = 1, ints_disabled = 1, sig_deferred = 0, alrm_deferred;
+SCM err_exp, err_env;
+char *err_pos, *err_s_subr;
+cell tmp_errobj = {(SCM)UNDEFINED, (SCM)EOL};
+cell tmp_loadpath = {(SCM)BOOL_F, (SCM)EOL};
+SCM *loc_errobj = (SCM *)&tmp_errobj;
+SCM *loc_loadpath = (SCM *)&tmp_loadpath;
+SCM loadport = UNDEFINED;
+long linum = 1;
+int verbose = 1;
+long cells_allocated = 0, lcells_allocated = 0,
+  mallocated = 0, lmallocated = 0,
+  rt = 0, gc_rt, gc_time_taken;
+long gc_cells_collected, gc_malloc_collected, gc_ports_collected;
+long gc_syms_collected;
+static void def_err_response P((void));
+
+int handle_it(i)
+     int i;
+{
+  char *name = errmsgs[i-WNA].s_response;
+  SCM proc;
+  if (errjmp_bad) return -1;	/* sends it to def_err_response */
+  if (name) {
+    NEWCELL(proc);		/* discard possibly-used cell */
+    proc = CDR(intern(name, (sizet)strlen(name)));
+    if NIMP(proc) {
+      apply(proc, EOL, EOL);
+      return i;
+    }
+  }
+  return errmsgs[i-WNA].parent_err;
+}
+static char s_eval_string[] = "eval-string";
+static char s_load_string[] = "load-string";
+SCM scm_eval_string(str)
+     SCM str;
+{
+  str = mkstrport(INUM0, str, OPN | RDNG, s_eval_string);
+  str = lread(str);
+  return EVAL(str, (SCM)EOL);
+}
+SCM scm_load_string(str)
+     SCM str;
+{
+  ASSERT(NIMP(str) && (STRINGP(str) || SYMBOLP(str)), str, ARG1,
+	 s_load_string);
+  str = mkstrport(INUM0, str, OPN | RDNG, s_load_string);
+  while(1) {
+    SCM form = lread(str);
+    if (EOF_VAL==form) break;
+    SIDEVAL(form, EOL);
+  }
+  return BOOL_T;
+}
+
+SCM exitval;			/* INUM with return value */
+extern char s_unexec[];
+SCM repl_driver(initpath)
+     char *initpath;
+{
+#ifdef _UNICOS
+  int i;
+#else
+  long i;
+#endif
+  CONT(rootcont)->stkbse = (STACKITEM *)&i;
+  i = setjmp(CONT(rootcont)->jmpbuf);
+#ifndef SHORT_INT
+  if (i) i = UNCOOK(i);
+#endif
+  /* printf("repl_driver got %d\n", i); */
+ drloop:
+  switch ((int)i) {
+  default: {
+    char *name = errmsgs[i-WNA].s_response;
+    if (name) {
+      SCM proc = CDR(intern(name, (sizet)strlen(name)));
+      if NIMP(proc) apply(proc, EOL, EOL);
+    }
+    if ((i = errmsgs[i-WNA].parent_err)) goto drloop;
+    def_err_response();
+    goto reset_toplvl;
+  }
+  case 0:
+    exitval = MAKINUM(EXIT_SUCCESS);
+    errjmp_bad = 0;
+    errno = 0;
+    alrm_deferred = 0;
+    sig_deferred = 0;
+    ints_disabled = 0;
+    if (dumped) {
+      lcells_allocated = cells_allocated;
+      lmallocated = mallocated;
+      rt = INUM(my_time());
+      gc_time_taken = 0;
+    }
+    else if (scm_ldfile(initpath)) /* load Scheme init files */
+      wta(*loc_errobj, "Could not open file", s_load);
+    scm_evstr("(boot-tail)");	/* initialization tail-call */
+  case -2:			/* abrt */
+  reset_toplvl:
+    errjmp_bad = 0;
+    alrm_deferred = 0;
+    sig_deferred = 0;
+    ints_disabled = 0;
+
+    /* Closing the loading file turned out to be a bad idea. */
+    /* But I will leave the code here in case someone wants it. */
+#ifdef CLOSE_LOADING_PORTS_ON_ABORT
+    if (NIMP(loadport) && OPINPORTP(loadport)) {
+      if (verbose > 1) {
+	lputs("; Aborting load (closing): ", cur_errp);
+	display(*loc_loadpath, cur_errp);
+	newline(cur_errp);
+      }
+      close_port(loadport);	/* close loading file. */
+    }
+#endif
+    *loc_loadpath = BOOL_F;
+    loadport = UNDEFINED;
+    repl();
+    err_pos = (char *)EXIT;
+    i = EXIT;
+    goto drloop;		/* encountered EOF on stdin */
+  case -1:			/* quit */
+    return exitval;
+  case -3:			/* restart. */
+    return 0;
+#ifdef CAN_DUMP
+  case -4:			/* dump */
+    igc(s_unexec, (STACKITEM *)0);
+    dumped = 1;
+    unexec(CHARS(*loc_errobj), execpath, 0, 0, 0);
+    goto reset_toplvl;
+#endif
+  }
+}
+
+SCM line_num()
+{
+  return MAKINUM(linum);
+}
+SCM prog_args()
+{
+  return progargs;
+}
+
+extern char s_heap[];
+extern sizet hplim_ind;
+extern CELLPTR *hplims;
+void growth_mon(obj, size, units)
+     char *obj;
+     long size;
+     char *units;
+{
+  if (verbose>2)
+    {
+      lputs("; grew ", cur_errp);
+      lputs(obj, cur_errp);
+      lputs(" to ", cur_errp);
+      intprint(size, 10, cur_errp);
+      lputc(' ', cur_errp);
+      lputs(units, cur_errp);
+      if ((verbose>4) && (obj==s_heap)) heap_report();
+      lputs("\n", cur_errp);
+    }
+}
+
+void gc_start(what)
+     char *what;
+{
+  if (verbose>3 && FPORTP(cur_errp)) {
+    ALLOW_INTS;
+    lputs(";GC(", cur_errp);
+    lputs(what, cur_errp);
+    lputs(")", cur_errp);
+    lfflush(cur_errp);
+    DEFER_INTS;
+  }
+  gc_rt = INUM(my_time());
+  gc_cells_collected = 0;
+  gc_malloc_collected = 0;
+  gc_ports_collected = 0;
+  gc_syms_collected = 0;
+}
+void gc_end()
+{
+  gc_rt = INUM(my_time()) - gc_rt;
+  gc_time_taken = gc_time_taken + gc_rt;
+  if (verbose>3) {
+    ALLOW_INTS;
+    if (!FPORTP(cur_errp)) lputs(";GC ", cur_errp);
+    intprint(time_in_msec(gc_rt), 10, cur_errp);
+    lputs(" cpu mSec, ", cur_errp);
+    intprint(gc_cells_collected, 10, cur_errp);
+    lputs(" cells, ", cur_errp);
+    intprint(gc_malloc_collected, 10, cur_errp);
+    lputs(" malloc, ", cur_errp);
+    intprint(gc_syms_collected, 10, cur_errp);
+    lputs(" syms, ", cur_errp);
+    intprint(gc_ports_collected, 10, cur_errp);
+    lputs(" ports collected\n", cur_errp);
+    lfflush(cur_errp);
+    DEFER_INTS;
+  }
+}
+void repl_report()
+{
+  if (verbose>1) {
+    lfflush(cur_outp);
+    lputs(";Evaluation took ", cur_errp);
+    intprint(time_in_msec(INUM(my_time())-rt), 10, cur_errp);
+    lputs(" mSec (", cur_errp);
+    intprint(time_in_msec(gc_time_taken), 10, cur_errp);
+    lputs(" in gc) ", cur_errp);
+    intprint(cells_allocated - lcells_allocated, 10, cur_errp);
+    lputs(" cells work, ", cur_errp);
+    intprint(mallocated - lmallocated, 10, cur_errp);
+    lputs(" bytes other\n", cur_errp);
+    lfflush(cur_errp);
+  }
+}
+SCM lroom(args)
+     SCM args;
+{
+  intprint(cells_allocated, 10, cur_errp);
+  lputs(" out of ", cur_errp);
+  intprint(heap_size, 10, cur_errp);
+  lputs(" cells in use, ", cur_errp);
+  intprint(mallocated, 10, cur_errp);
+  lputs(" bytes allocated (of ", cur_errp);
+  intprint(mtrigger, 10, cur_errp);
+  lputs(")\n", cur_errp);
+  if NIMP(args) {
+    heap_report();
+    lputs("\n", cur_errp);
+    stack_report();
+  }
+  return UNSPECIFIED;
+}
+void heap_report()
+{
+  sizet i = 0;
+  lputs("; heap segments:", cur_errp);
+  while(i<hplim_ind) {
+    lputs("\n; 0x", cur_errp);
+    intprint((long)hplims[i++], 16, cur_errp);
+    lputs(" - 0x", cur_errp);
+    intprint((long)hplims[i++], 16, cur_errp);
+  }
+}
+void exit_report()
+{
+  if (verbose>2) {
+    lputs(";Totals: ", cur_errp);
+    intprint(time_in_msec(INUM(my_time())), 10, cur_errp);
+    lputs(" mSec my time, ", cur_errp);
+    intprint(time_in_msec(INUM(your_time())), 10, cur_errp);
+    lputs(" mSec your time\n", cur_errp);
+  }
+}
+
+SCM prolixity(arg)
+     SCM arg;
+{
+  int old = verbose;
+  if (!UNBNDP(arg)) {
+    if FALSEP(arg) verbose = 1;
+    else verbose = INUM(arg);
+  }
+  return MAKINUM(old);
+}
+
+void repl()
+{
+  SCM x;
+  repl_report();
+  while(1) {
+    if OPOUTPORTP(cur_inp) {	/* This case for curses window */
+      lfflush(cur_outp);
+      if (verbose) lputs(PROMPT, cur_inp);
+      lfflush(cur_inp);
+    }
+    else {
+      if (verbose) lputs(PROMPT, cur_outp);
+      lfflush(cur_outp);
+    }
+    lcells_allocated = cells_allocated;
+    lmallocated = mallocated;
+    x = lread(cur_inp);
+    rt = INUM(my_time());
+    gc_time_taken = 0;
+    if (EOF_VAL==x) break;
+    if (!CRDYP(cur_inp))	/* assure newline read (and transcripted) */
+      lungetc(lgetc(cur_inp), cur_inp);
+#ifdef __TURBOC__
+    if ('\n' != CGETUN(cur_inp))
+      if OPOUTPORTP(cur_inp)	/* This case for curses window */
+	{lfflush(cur_outp); newline(cur_inp);}
+      else newline(cur_outp);
+#endif
+    x = EVAL(x, (SCM)EOL);
+    repl_report();
+    iprin1(x, cur_outp, 1);
+    lputc('\n', cur_outp);
+  }
+}
+SCM quit(n)
+     SCM n;
+{
+  if (UNBNDP(n) || BOOL_T==n) n = MAKINUM(EXIT_SUCCESS);
+  else if INUMP(n) exitval = n;
+  else exitval = MAKINUM(EXIT_FAILURE);
+  if (errjmp_bad) exit(INUM(exitval));
+  dowinds(EOL, ilength(dynwinds));
+  longjmp(CONT(rootcont)->jmpbuf, COOKIE(-1));
+}
+SCM abrt()
+{
+  if (errjmp_bad) exit(INUM(exitval));
+  dowinds(EOL, ilength(dynwinds));
+#ifdef CAUTIOUS
+  stacktrace = EOL;
+#endif
+  longjmp(CONT(rootcont)->jmpbuf, COOKIE(-2));
+}
+char s_restart[] = "restart";
+SCM restart()
+{
+  /* ASSERT(!dumped, UNDEFINED, "dumped can't", s_restart); */
+  dowinds(EOL, ilength(dynwinds));
+#ifdef CAUTIOUS
+  stacktrace = EOL;
+#endif
+  longjmp(CONT(rootcont)->jmpbuf, COOKIE(-3));
+}
+
+#ifdef CAN_DUMP
+char s_unexec[] = "unexec";
+SCM scm_unexec(newpath)
+     SCM newpath;
+{
+  ASSERT(NIMP(newpath) && STRINGP(newpath), newpath, ARG1, s_unexec);
+  *loc_errobj = newpath;
+# ifdef CAUTIOUS
+  stacktrace = EOL;
+# endif
+  longjmp(CONT(rootcont)->jmpbuf, COOKIE(-4));
+}
+#endif
+
+char s_execpath[] = "execpath";
+SCM scm_execpath(newpath)
+     SCM newpath;
+{
+  SCM retval = execpath ? makfrom0str(execpath) : BOOL_F;
+  if (UNBNDP(newpath))
+    return retval;
+  if (FALSEP(newpath)) {
+    if (execpath) free(execpath);
+    execpath = 0;
+    return retval;
+  }
+  ASSERT(NIMP(newpath) && STRINGP(newpath), newpath, ARG1, s_execpath);
+  if (execpath) free(execpath);
+  execpath = scm_cat_path(0L, CHARS(newpath), 0L);
+  return retval;
+}
+
+void han_sig()
+{
+  sig_deferred = 0;
+  if (INT_SIGNAL != handle_it(INT_SIGNAL))
+    wta(UNDEFINED, (char *)INT_SIGNAL, "");
+}
+void han_alrm()
+{
+  alrm_deferred = 0;
+  if (ALRM_SIGNAL != handle_it(ALRM_SIGNAL))
+    wta(UNDEFINED, (char *)ALRM_SIGNAL, "");
+}
+
+SCM tryload(filename)
+     SCM filename;
+{
+  ASSERT(NIMP(filename) && STRINGP(filename), filename, ARG1, s_load);
+  {
+    SCM oloadpath = *loc_loadpath;
+    SCM oloadport = loadport;
+    long olninum = linum;
+    SCM port, newform = BOOL_F;
+    port = open_file(filename, makfromstr("r", (sizet)sizeof(char)));
+    if FALSEP(port) return port;
+    *loc_loadpath = filename;
+    loadport = port;
+    linum = 1;
+    while(1) {
+      SCM form = newform;
+      newform = lread(port);
+      if (EOF_VAL==newform) {
+	close_port(port);
+	linum = olninum;
+	loadport = oloadport;
+	*loc_loadpath = oloadpath;
+	SIDEVAL(form, EOL);
+	return BOOL_T;
+      }
+      SIDEVAL(form, EOL);
+    }
+  }
+  return BOOL_T;
+}
+#ifdef CAUTIOUS
+void scm_print_stack(stk)
+     SCM stk;
+{
+  switch (ilength(stk)) {
+  case -1:
+    lputs("\n; circular stacktrace!", cur_errp);
+    return;
+  case -2:
+    lputs("\n; stacktrace not a list?", cur_errp);
+    iprin1(stk, cur_errp, 1);
+    return;
+  default:
+    while NNULLP(stk) {
+      SCM ste = CAR(stk);
+      lputc('\n', cur_errp);
+      iprin1(ste, cur_errp, 1);
+      stk = CDR(stk);
+    }
+  }
+}
+SCM scm_stack_trace()
+{
+  if (0==ilength(stacktrace)) return BOOL_F;
+  scm_print_stack(stacktrace);
+  return BOOL_T;
+}
+#endif
+
+static void err_head(str)
+     char *str;
+{
+  int oerrno = errno;
+  exitval = MAKINUM(EXIT_FAILURE);
+  if NIMP(cur_outp) lfflush(cur_outp);
+  lputc('\n', cur_errp);
+  if(BOOL_F != *loc_loadpath) {
+    iprin1(*loc_loadpath, cur_errp, 1);
+    lputs(", line ", cur_errp);
+    intprint((long)linum, 10, cur_errp);
+    lputs(": ", cur_errp);
+  }
+  lfflush(cur_errp);
+  errno = oerrno;
+  if (cur_errp==def_errp) {
+    if (errno>0) perror(str);
+    fflush(stderr);
+    return;
+  }
+}
+void warn(str1, str2)
+     char *str1, *str2;
+{
+  err_head("WARNING");
+  lputs("WARNING: ", cur_errp);
+  lputs(str1, cur_errp);
+  lputs(str2, cur_errp);
+  lputc('\n', cur_errp);
+  lfflush(cur_errp);
+}
+
+SCM lerrno(arg)
+     SCM arg;
+{
+  int old = errno;
+  if (!UNBNDP(arg)) {
+    if FALSEP(arg) errno = 0;
+    else errno = INUM(arg);
+  }
+  return MAKINUM(old);
+}
+static char s_perror[] = "perror";
+SCM lperror(arg)
+     SCM arg;
+{
+  ASSERT(NIMP(arg) && STRINGP(arg), arg, ARG1, s_perror);
+  err_head(CHARS(arg));
+  return UNSPECIFIED;
+}
+static void def_err_response()
+{
+  SCM obj = *loc_errobj;
+#ifdef CAUTIOUS
+  SCM stk = stacktrace;
+#endif
+  DEFER_INTS;
+  err_head("ERROR");
+  lputs("ERROR: ", cur_errp);
+  if (err_s_subr && *err_s_subr) {
+    lputs(err_s_subr, cur_errp);
+    lputs(": ", cur_errp);
+  }
+  if (err_pos==(char *)ARG1 && UNBNDP(*loc_errobj)) err_pos = (char *)WNA;
+#ifdef nosve
+  if ((~0x1fL) & (short)err_pos) lputs(err_pos, cur_errp);
+  else if (WNA>(short)err_pos) {
+    lputs("Wrong type in arg", cur_errp);
+    lputc(err_pos ? '0'+(short)err_pos : ' ', cur_errp);
+  }
+#else
+  if ((~0x1fL) & (long)err_pos) lputs(err_pos, cur_errp);
+  else if (WNA>(long)err_pos) {
+    lputs("Wrong type in arg", cur_errp);
+    lputc(err_pos ? '0'+(int)err_pos : ' ', cur_errp);
+  }
+#endif
+  else {
+    lputs(errmsgs[((int)err_pos)-WNA].msg, cur_errp);
+    goto outobj;
+  }
+  if (IMP(obj) || SYMBOLP(obj) || (TYP16(obj)==tc7_port)
+      || (NFALSEP(procedurep(obj))) || (NFALSEP(numberp(obj)))) {
+outobj:
+    if (!UNBNDP(obj)) {
+      lputs(((long)err_pos==WNA)?" given ":" ", cur_errp);
+      iprin1(obj, cur_errp, 1);
+    }
+  }
+  else lputs(" (see errobj)", cur_errp);
+#ifdef CAUTIOUS
+  if NNULLP(stk) scm_print_stack(stk);
+#endif
+  if UNBNDP(err_exp) goto getout;
+  if NIMP(err_exp) {
+    lputs("\n; in expression: ", cur_errp);
+    if NCONSP(err_exp) iprin1(err_exp, cur_errp, 1);
+    else if (UNDEFINED==CDR(err_exp))
+      iprin1(CAR(err_exp), cur_errp, 1);
+    else iprlist("(... ", err_exp, ')', cur_errp, 1);
+  }
+  if NULLP(err_env) lputs("\n; in top level environment.", cur_errp);
+  else {
+    SCM env = err_env;
+    lputs("\n; in scope:", cur_errp);
+    while NNULLP(env) {
+      lputc('\n', cur_errp);
+      lputs(";   ", cur_errp);
+      iprin1(CAR(CAR(env)), cur_errp, 1);
+      env = CDR(env);
+    }
+  }
+ getout:
+  lputc('\n', cur_errp);
+  lfflush(cur_errp);
+  err_exp = err_env = UNDEFINED;
+  if (errjmp_bad) {
+    iprin1(obj, cur_errp, 1);
+    lputs("\nFATAL ERROR DURING CRITICAL CODE SECTION\n", cur_errp);
+#ifdef vms
+    exit(EXIT_FAILURE);
+#else
+    exit(errno? (long)errno : EXIT_FAILURE);
+#endif
+  }
+  errno = 0;
+  ALLOW_INTS;
+}
+void everr(exp, env, arg, pos, s_subr)
+     SCM exp, env, arg;
+     char *pos, *s_subr;
+{
+  err_exp = exp;
+  err_env = env;
+  *loc_errobj = arg;
+  err_pos = pos;
+  err_s_subr = s_subr;
+#ifndef CAUTIOUS
+  if (((~0x1fL) & (long)pos) || (WNA>(long)pos)
+      || NIMP(dynwinds) || errjmp_bad)
+#endif
+    {
+      def_err_response();
+      dowinds(EOL, ilength(dynwinds));
+      abrt();
+    }
+#ifndef CAUTIOUS
+  /* We don't have to clear stacktrace because CAUTIOUS never gets here */
+  /* We don't have to dowinds() because dynwinds is EOL */
+  longjmp(CONT(rootcont)->jmpbuf, COOKIE((int)pos));
+  /* will do error processing at stack base */
+#endif
+}
+void wta(arg, pos, s_subr)
+     SCM arg;
+char *pos, *s_subr;
+{
+ everr(UNDEFINED, EOL, arg, pos, s_subr);
+}
+SCM cur_input_port()
+{
+  return cur_inp;
+}
+SCM cur_output_port()
+{
+  return cur_outp;
+}
+SCM cur_error_port()
+{
+  return cur_errp;
+}
+char s_cur_inp[] = "set-current-input-port";
+char s_cur_outp[] = "set-current-output-port";
+char s_cur_errp[] = "set-current-error-port";
+SCM set_inp(port)
+     SCM port;
+{
+  SCM oinp = cur_inp;
+  ASSERT(NIMP(port) && OPINPORTP(port), port, ARG1, s_cur_inp);
+  cur_inp = port;
+  return oinp;
+}
+SCM set_outp(port)
+     SCM port;
+{
+  SCM ooutp = cur_outp;
+  ASSERT(NIMP(port) && OPOUTPORTP(port), port, ARG1, s_cur_outp);
+  cur_outp = port;
+  return ooutp;
+}
+SCM set_errp(port)
+     SCM port;
+{
+  SCM oerrp = cur_errp;
+  ASSERT(NIMP(port) && OPOUTPORTP(port), port, ARG1, s_cur_errp);
+  cur_errp = port;
+  return oerrp;
+}
+
+static iproc subr0s[] = {
+	{&s_cur_inp[4], cur_input_port},
+	{&s_cur_outp[4], cur_output_port},
+	{&s_cur_errp[4], cur_error_port},
+	{"transcript-off", trans_off},
+	{"program-arguments", prog_args},
+	{"line-number", line_num},
+	{"abort", abrt},
+	{s_restart, restart},
+#ifdef CAUTIOUS
+	{"stack-trace", scm_stack_trace},
+#endif
+	{0, 0}};
+
+static iproc subr1s[] = {
+	{s_cur_inp, set_inp},
+	{s_cur_outp, set_outp},
+	{s_cur_errp, set_errp},
+	{"transcript-on", trans_on},
+	{s_tryload, tryload},
+	{s_load_string, scm_load_string},
+	{s_eval_string, scm_eval_string},
+	{s_perror, lperror},
+	{"make-arbiter", makarb},
+	{s_tryarb, tryarb},
+	{s_relarb, relarb},
+	{0, 0}};
+
+static iproc subr1os[] = {
+	{s_read, lread},
+	{s_read_char, scm_read_char},
+	{s_peek_char, peek_char},
+	{s_newline, newline},
+	{s_flush, lflush},
+#ifndef GO32
+	{s_char_readyp, char_readyp},
+#endif
+	{"quit", quit},
+	{"verbose", prolixity},
+	{"errno", lerrno},
+	{s_execpath, scm_execpath},
+	{0, 0}};
+
+static iproc subr2os[] = {
+	{s_write, lwrite},
+	{s_display, display},
+	{s_write_char, write_char},
+#ifdef CAN_DUMP
+	{s_unexec, scm_unexec},
+#endif
+	{0, 0}};
+
+static smobfuns arbsmob = {markcdr, free0, prinarb};
+char s_ccl[] = "char-code-limit";
+
+void init_repl( iverbose )
+     int iverbose;
+{
+	sysintern(s_ccl, MAKINUM(CHAR_CODE_LIMIT));
+	loc_errobj = &CDR(sysintern("errobj", UNDEFINED));
+	loc_loadpath = &CDR(sysintern("*load-pathname*", BOOL_F));
+	transcript = BOOL_F;
+	trans = 0;
+	linum = 1;
+	verbose = iverbose;
+	init_iprocs(subr0s, tc7_subr_0);
+	init_iprocs(subr1os, tc7_subr_1o);
+	init_iprocs(subr1s, tc7_subr_1);
+	init_iprocs(subr2os, tc7_subr_2o);
+	make_subr("room", tc7_lsubr, lroom);
+#ifndef GO32
+	add_feature(s_char_readyp);
+#endif
+#ifdef CAN_DUMP
+	if (!execpath) execpath = dld_find_executable(CHARS(CAR(progargs)));
+	add_feature("dump");
+	scm_ldstr("\
+(define (dump file . thunk)\n\
+  (cond ((null? thunk) (set! *interactive* #f) (set! *argv* #f))\n\
+	((not (car thunk)) (set! *argv* #f))\n\
+	((boolean? (car thunk)))\n\
+	(else (set! boot-tail (car thunk))))\n\
+  (set! restart exec-self)\n\
+  (unexec file))\n\
+");
+#endif
+#ifdef ARM_ULIB
+	set_erase();
+#endif
+	tc16_arbiter = newsmob(&arbsmob);
+}
+void final_repl()
+{
+  loc_errobj = (SCM *)&tmp_errobj;
+  loc_loadpath = (SCM *)&tmp_loadpath;
+  loadport = UNDEFINED;
+  transcript = BOOL_F;
+  trans = 0;
+  linum = 1;
+}
diff --git a/rgx.c b/rgx.c
new file mode 100644
index 0000000..e766083
--- /dev/null
+++ b/rgx.c
@@ -0,0 +1,661 @@
+#include "scm.h"
+#include "regex.h"
+#include <stdio.h>
+
+static char rcsid[] =
+   "$Id: rgx.c, v 1.20 1995/02/15 04:39:45 dpb Exp $";
+
+#ifdef HAVE_ALLOCA
+# include <alloca.h>
+# define ALLOCA_PROTECT typedef int foobazzz
+# define ALLOCA		alloca
+#else
+# define ALLOCA_PROTECT SCM alloca_protect=EOL
+# define ALLOCA(size)							\
+	(alloca_protect=cons(makstr((long)(size)), alloca_protect),	\
+	 (void *)CDR(CAR(alloca_protect)))
+
+#endif
+
+#ifdef _GNU_SOURCE
+/* following two lines stolen from GNU regex.c */
+# define CHAR_SET_SIZE 256
+# define ISUPPER(c) (isascii (c) && isupper (c))
+#endif
+
+/* forward function defs */
+
+SCM lregsearch();
+SCM lregsearchv();
+
+/* Posix regexp bindings.  */
+
+static char s_regex[] = "regex";
+static char s_regcomp[] = "regcomp", s_regerror[] = "regerror";
+static char s_regexec[] = "regexec", s_regmatp[] = "regmatch?";
+static char s_regsearch[] = "regsearch", s_regmatch[] = "regmatch";
+static char s_regsearchv[] = "regsearchv", s_regmatchv[] = "regmatchv";
+static char s_stringsplit[]  = "string-split";
+static char s_stringsplitv[] = "string-splitv";
+static char s_stringedit[] = "string-edit";
+
+#define s_error &s_regerror[3]
+
+#define RGX_INFO(obj) ((regex_info*)CDR(obj))
+#define RGX_PATTERN(obj) (((regex_info*)CDR(obj))->pattern)
+#define RGX(obj) (&((regex_info*)CDR(obj))->rgx)
+#ifndef _GNU_SOURCE
+# define RGX2(obj) (&((regex_info*)CDR(obj))->rgx_anchored)
+#endif
+
+#define FIXUP_REGEXP(prog)						\
+{									\
+    if (STRINGP(prog))							\
+	prog = lregcomp(prog, UNDEFINED);				\
+    if (NIMP(prog) && CONSP(prog) && STRINGP(CAR(prog)) &&		\
+	NIMP(CDR(prog)) && CONSP(CDR(prog)) && STRINGP(CAR(CDR(prog)))) \
+	prog = lregcomp(CAR(prog), CAR(CDR(prog)));			\
+}
+
+typedef struct regex_info {
+    SCM pattern;    /* string we compiled to create our reg exp */
+    regex_t rgx;
+#ifndef _GNU_SOURCE
+    int options;    /* for anchored pattern when matching */
+    regex_t rgx_anchored;
+#endif 
+} regex_info;
+
+sizet fregex(ptr)
+     CELLPTR ptr;
+{
+  regfree(RGX(ptr));
+#ifndef _GNU_SOURCE
+  /* options are null => we compiled the anchored pattern */
+  if (RGX_INFO(ptr)->options==NULL)
+    regfree(RGX2(ptr));
+#endif 
+  free(CHARS(ptr));
+  return sizeof(regex_t);
+}
+
+int prinregex(exp, port, writing)
+     SCM exp; SCM port; int writing;
+{
+  lputs("#<regex ", port);
+  intprint(CDR(exp), 16, port);
+  lputc(' ', port);
+  iprin1(RGX_PATTERN(exp), port, writing);
+  lputc('>', port);
+  return 1;
+}
+
+SCM markregex(ptr)
+     SCM ptr;
+{
+  SETGC8MARK(ptr);
+  SETGC8MARK(RGX_PATTERN(ptr));
+  return BOOL_F;
+}
+
+int tc16_rgx;
+static smobfuns rgxsmob = {markregex, fregex, prinregex};
+
+SCM lregerror(scode)
+     SCM scode;
+{
+  int code, len;
+  SCM str;
+  ASSERT(INUMP(scode), scode, ARG1, s_regerror);
+  code = INUM(scode);
+  if (code < 0)
+    return makfromstr("Invalid code", sizeof("Invalid code")-1);
+  /* XXX - is regerror posix or not? */
+#ifdef __REGEXP_LIBRARY_H__
+  /* XXX - gnu regexp doesn't use the re parameter, so we will
+     ignore it in a very untidy way. */
+  len = regerror(code, 0, 0, 0);
+  str = makstr(len-1);
+  regerror(code, 0, CHARS(str), len);
+#else
+  str = makfromstr(s_error, (sizet)5);
+#endif
+  return str;
+}
+
+SCM lregcomp(pattern, flags)
+     SCM pattern, flags;
+{
+  SCM z;
+  int i, options;
+  regex_t *prog;
+  regex_info *info;
+  char *flagchars;
+#ifdef _GNU_SOURCE
+  int fastmap = 0;
+  int ignore_case = 0;
+  char *err_msg;
+#endif
+
+  ASSERT(NIMP(pattern) && STRINGP(pattern), pattern, ARG1, s_regcomp);
+  ASSERT(UNBNDP(flags) || (NIMP(flags) && STRINGP(flags)), 
+	 flags, ARG2, s_regcomp);
+  NEWCELL(z);
+  DEFER_INTS;
+  SETCHARS(z, info=(regex_info*)must_malloc((long)sizeof(regex_info), s_regex));
+  prog = &(info->rgx);
+  CAR(z) = tc16_rgx;
+#ifdef __REGEXP_LIBRARY_H__
+  for(i=sizeof(regex_t);i--;((char *)prog)[i] = 0);
+# ifndef _GNU_SOURCE
+  {
+    regex_t *prog2;
+    prog2 = &(info->rgx_anchored);
+    for(i=sizeof(regex_t);i--;((char *)prog2)[i] = 0);
+  }
+# endif
+#endif
+
+  ALLOW_INTS;
+  info->pattern = pattern;
+
+#ifdef _GNU_SOURCE
+  options = RE_SYNTAX_POSIX_EXTENDED;
+#else
+  options = REG_EXTENDED;
+#endif
+
+  if (!UNBNDP(flags)) {
+    flagchars = CHARS(flags);
+    for (i=0; i<LENGTH(flags); i++)
+      switch (flagchars[i]) {
+#ifdef _GNU_SOURCE
+      case 'n': 
+	options |= RE_HAT_LISTS_NOT_NEWLINE;
+	options &= (~RE_DOT_NEWLINE);
+	break;
+      case 'i':
+	ignore_case = 1;
+	break;
+      case '0':
+	options &= (~RE_DOT_NOT_NULL);
+	break;
+      case 'f':
+	fastmap = 1;
+	break;
+#else
+      case 'n': 
+	options |= REG_NEWLINE;
+	break;
+      case 'i':
+	options |= REG_ICASE;
+	break;
+#endif
+      }
+  }
+
+#ifdef _GNU_SOURCE
+  DEFER_INTS;
+  if (fastmap)
+    prog->fastmap = must_malloc(CHAR_SET_SIZE, s_regex);
+  
+  if (ignore_case) {
+    prog->translate = must_malloc(CHAR_SET_SIZE, s_regex);
+    for (i = 0; i < CHAR_SET_SIZE; i++)
+      prog->translate[i] = ISUPPER (i) ? tolower (i) : i;
+  }
+
+  re_set_syntax(options);
+  err_msg = (char *)re_compile_pattern(CHARS(pattern), LENGTH(pattern), prog);
+  ALLOW_INTS;
+  prog->regs_allocated = REGS_FIXED;
+
+  /* if error, compile using regcomp to get the error number */
+  if (err_msg) {
+    int i;
+    char *tmppat;
+    SCM protect;
+
+    /* Fixup in case pattern has null characters */
+    tmppat = CHARS(protect=makstr(LENGTH(pattern)));
+    bcopy(CHARS(pattern), tmppat, LENGTH(pattern));
+    for (i=0; i<LENGTH(pattern); i++)
+      if (tmppat[i] == 0)
+	tmppat[i] = ' ';
+
+    i = regcomp(prog, tmppat, options);
+    z = MAKINUM(i);
+  }
+#else
+  info->options = options; 
+  i = regcomp(prog, CHARS(pattern), options);
+  if (i) z = MAKINUM(i);
+#endif
+  return z;
+}
+
+SCM lregexec(prog, str)
+     SCM prog, str;
+{
+  ALLOCA_PROTECT;
+
+  FIXUP_REGEXP(prog);
+  ASSERT(NIMP(prog) && tc16_rgx==CAR(prog), prog, ARG1, s_regexec);
+  ASSERT(NIMP(str) && STRINGP(str), str, ARG2, s_regexec);
+
+#ifdef _GNU_SOURCE
+  return lregsearchv(prog, str, EOL);
+#else  /* not _GNU_SOURCE */
+  {
+    size_t nsub;
+    SCM ans;
+    regmatch_t *pm;
+    int flags = 0;		/* XXX - optional arg? */
+
+    nsub = RGX(prog)->re_nsub + 1; /* XXX - is this posix? */
+    pm = ALLOCA(nsub * sizeof(regmatch_t));
+    if (regexec(RGX(prog), CHARS(str), nsub, pm, flags) != 0)
+      ans = BOOL_F;
+    else {
+      ans = make_vector(MAKINUM(2L * nsub), MAKINUM(-1L));
+      while (nsub--) {
+	VELTS(ans)[2*nsub+0] = MAKINUM(pm[nsub].rm_so);
+	VELTS(ans)[2*nsub+1] = MAKINUM(pm[nsub].rm_eo);
+      }
+    }
+    return ans;
+  }
+#endif /* _GNU_SOURCE */
+}
+
+SCM lregmatp(prog, str)
+     SCM prog, str;
+{
+  FIXUP_REGEXP(prog);
+  ASSERT(NIMP(prog) && tc16_rgx==CAR(prog), prog, ARG1, s_regmatp);
+  ASSERT(NIMP(str) && STRINGP(str), str, ARG2, s_regmatp);
+
+#ifdef _GNU_SOURCE
+  return (lregsearch(prog, str, EOL)==BOOL_F)?BOOL_F:BOOL_T;
+#else  /* not _GNU_SOURCE */
+  {
+    int flags = 0;		/* XXX - optional arg? */
+
+    flags = regexec(RGX(prog), CHARS(str), 0, NULL, flags);
+    if (!flags) return BOOL_T;
+    if (REG_NOMATCH!=flags) wta(MAKINUM(flags), s_error, s_regmatp);
+    return BOOL_F;
+  }
+#endif
+}
+
+#define SCALAR 0
+#define VECTOR 1
+
+#define MATCH  0
+#define SEARCH 1
+
+SCM lregsearchmatch(prog, str, args, search, vector)
+     SCM prog, str, args;
+     int vector, search;
+{
+  int len = ilength(args);
+  int start, size, nsub;
+  SCM matches;
+  ALLOCA_PROTECT;
+
+  FIXUP_REGEXP(prog);
+  ASSERT(NIMP(prog) && tc16_rgx==CAR(prog), prog, ARG1, s_regsearch);
+  ASSERT(NIMP(str) && STRINGP(str), str, ARG2, s_regsearch);
+  ASSERT(len<=2, args, WNA, s_regsearch);
+  ASSERT((len<1)||(INUMP(CAR(args))), CAR(args), ARG3, s_regsearch);
+  ASSERT((len<2)||(INUMP(CAR(CDR(args)))), CAR(CDR(args)), ARG4, s_regsearch);
+
+  start = (len>=1)?(INUM(CAR(args))):0;
+  size  = (len>=2)?(INUM(CAR(CDR(args)))):LENGTH(str);
+
+#ifdef _GNU_SOURCE
+  {
+    int ret, dir=1;
+    struct re_registers regs, *pregs=NULL;
+
+    if (search && start<0)
+      start *= -1, dir = -1;
+
+    if (vector) {
+      pregs = &regs;
+      nsub = RGX(prog)->re_nsub + 1;
+      regs.num_regs = nsub;
+
+      regs.start	  = ALLOCA(nsub * sizeof(regoff_t));
+      regs.end	  = ALLOCA(nsub * sizeof(regoff_t));
+    }
+
+    if (search)
+      ret = re_search(RGX(prog), CHARS(str), size, start, dir*size, pregs);
+    else
+      ret = re_match(RGX(prog), CHARS(str), size, start, pregs);
+	
+    if (ret < 0)
+      return BOOL_F;
+
+    if (!vector)
+      return MAKINUM(ret);
+
+    matches = make_vector(MAKINUM(2L * nsub), MAKINUM(-1L));
+    while (nsub--) {
+      VELTS(matches)[2*nsub+0] = MAKINUM(regs.start[nsub]);
+      VELTS(matches)[2*nsub+1] = MAKINUM(regs.end[nsub]);
+    }
+    return matches;
+  }
+#else  /* not _GNU_SOURCE */
+  {
+    regex_t *regexp;
+    regmatch_t *pm;
+    char *search_string;
+    if (size > LENGTH(str))
+      size = LENGTH(str);
+
+    if (start<0 || start >= size)
+      return BOOL_F;
+
+    if (size < LENGTH(str)) {
+      search_string = ALLOCA(size-start+1);
+      bcopy(CHARS(str)+start, search_string, size-start);
+      search_string[size-start] = 0;
+    } else
+      search_string = CHARS(str)+start;
+
+    nsub = RGX(prog)->re_nsub + 1;
+    pm = ALLOCA(nsub * sizeof(regmatch_t));
+    if (search)
+      regexp = RGX(prog);
+    else {
+      /* doing a match */
+      if (RGX_INFO(prog)->options) {
+	/* strlen & strcpy OK, posix patterns are null terminated */
+	char *pattern;
+
+	pattern = ALLOCA(strlen(CHARS(RGX_PATTERN(prog)))+2);
+	pattern[0] = '^';
+	strcpy(pattern+1, CHARS(RGX_PATTERN(prog)));
+	regcomp(RGX2(prog), pattern, RGX_INFO(prog)->options);
+	RGX_INFO(prog)->options = 0;
+      }
+      regexp = RGX2(prog);
+    }
+
+    if (regexec(regexp, search_string, nsub, pm, 0) != 0)
+      return BOOL_F;
+
+    if (vector) {
+      matches = make_vector(MAKINUM(2L * nsub), MAKINUM(-1L));
+      while (nsub--) {
+	VELTS(matches)[2*nsub+0] = MAKINUM(pm[nsub].rm_so + start);
+	VELTS(matches)[2*nsub+1] = MAKINUM(pm[nsub].rm_eo + start);
+      }
+      return matches;
+    }
+
+    if (search)
+      return MAKINUM(pm[0].rm_so + start);
+    else
+      return MAKINUM(pm[0].rm_eo - pm[0].rm_so);
+  }
+
+#endif /* _GNU_SOURCE */ 
+}
+
+SCM lregsearch(prog, str, args)
+     SCM prog, str, args;
+{
+  return lregsearchmatch(prog, str, args, SEARCH, SCALAR);
+}
+
+SCM lregsearchv(prog, str, args)
+     SCM prog, str, args;
+{
+  return lregsearchmatch(prog, str, args, SEARCH, VECTOR);
+}
+
+SCM lregmatch(prog, str, args)
+     SCM prog, str, args;
+{
+  return lregsearchmatch(prog, str, args, MATCH, SCALAR);
+}
+
+SCM lregmatchv(prog, str, args)
+     SCM prog, str, args;
+{
+  return lregsearchmatch(prog, str, args, MATCH, VECTOR);
+}
+
+SCM stringsplitutil(prog, str, vector)
+     SCM prog, str;
+     int vector;
+{
+  int anchor, match_start, match_end, num_substrings, num_elements;
+  int search_base;
+  SCM next_break, substrings, ret;
+  SCM st_start, st_end;
+
+  FIXUP_REGEXP(prog);
+  ASSERT(NIMP(prog) && tc16_rgx==CAR(prog), prog, ARG1, s_stringsplit);
+  ASSERT(NIMP(str) && STRINGP(str), str, ARG2, s_stringsplit);
+
+  substrings = EOL;
+  anchor = 0;
+  search_base = 0;
+  num_substrings = 0;
+  next_break = lregsearchv(prog, str, cons(MAKINUM(search_base), EOL));
+
+  while (next_break != BOOL_F) {
+    match_start = INUM(VELTS(next_break)[0]); 
+    match_end   = INUM(VELTS(next_break)[1]);
+
+    if (match_start < match_end) {
+      substrings=cons2(MAKINUM(anchor), MAKINUM(match_start), substrings);
+      anchor = match_end;
+      num_substrings++;
+    }
+
+    search_base = ((match_end>search_base)?match_end:(search_base+1));
+    next_break  = lregsearchv(prog, str, cons(MAKINUM(search_base), EOL));
+  }
+
+  /* get that tail bit */
+  if (anchor < LENGTH(str)) {
+    substrings = cons2(MAKINUM(anchor), MAKINUM(LENGTH(str)), substrings);
+    num_substrings++;
+  }
+
+  num_elements = vector?(2*num_substrings):num_substrings;
+  ret = make_vector(MAKINUM(num_elements), EOL);
+
+  while (num_substrings--) {
+    st_start = CAR(substrings);
+    st_end	 = CAR(CDR(substrings));
+
+    if (vector) {
+      VELTS(ret)[num_substrings*2+0] = st_start;
+      VELTS(ret)[num_substrings*2+1] = st_end;
+    } else
+      VELTS(ret)[num_substrings] = substring(str, st_start, st_end);
+
+    substrings = CDR(CDR(substrings));
+  }
+
+  return ret;
+}
+
+SCM lstringsplit(prog, str)
+     SCM prog, str;
+{
+  return stringsplitutil(prog, str, SCALAR);
+}
+
+SCM lstringsplitv(prog, str)
+     SCM prog, str;
+{
+  return stringsplitutil(prog, str, VECTOR);
+}
+    
+typedef struct _item {
+    struct _item *next;
+    char *string;
+    int start;
+    int end;
+} *editItem;
+
+#define PUSH(list, string_parm, start_parm, end_parm)	\
+    {							\
+	editItem item;					\
+							\
+	item = ALLOCA(sizeof(*item));			\
+	item->next = list;				\
+	list = item;					\
+	item->string = string_parm;			\
+	item->start  = start_parm;			\
+	item->end    = end_parm;			\
+    }
+
+/*  (string-edit <re> <edit-spec> <string> [<count>]) */
+SCM lstringedit(prog, editspec, args)
+     SCM prog, editspec, args;
+{
+  int match_start, match_end, search_base, editcount;
+  int total_len;
+  int i, args_len, anchor, maxsubnum;
+  int backslash;
+  char *ptr;
+  editItem editlist, substrings, edit;
+  SCM str, count, next_edit;
+  SCM result;
+  ALLOCA_PROTECT;
+
+  args_len = ilength(args);
+
+  FIXUP_REGEXP(prog);
+  ASSERT(NIMP(prog) && tc16_rgx==CAR(prog), prog, ARG1, s_stringedit);
+  ASSERT(NIMP(editspec) && STRINGP(editspec), editspec, ARG2, s_stringedit);
+  ASSERT((args_len==1)||(args_len==2), args, WNA, s_stringedit);
+
+  str = CAR(args);
+  ASSERT(NIMP(str)&&STRINGP(str), str, ARG3, s_stringedit);
+
+  if (args_len==2) {
+    count = CAR(CDR(args));
+    ASSERT(INUMP(count)||(count==BOOL_T), count, ARG4, s_stringedit);
+  } else
+    count = MAKINUM(1);
+
+  /* process the editspec - break it into a list of dotted pairs
+   * of integers for substrings to be inserted and
+   * integers representing matched subexpressions that
+   * should be inserted.
+   */ 
+
+  maxsubnum = RGX(prog)->re_nsub;
+  anchor = 0;
+  backslash = 0;
+  editlist = NULL;
+  ptr = CHARS(editspec);
+
+  for (i=0; i<LENGTH(editspec); i++) {
+    if (backslash && (ptr[i]>='0') && (ptr[i] <='9') &&
+	((ptr[i]-'0')<=maxsubnum))
+      {
+	if ((i-1)>anchor)
+	  PUSH(editlist, CHARS(editspec), anchor, i-1);
+
+	PUSH(editlist, CHARS(editspec), ptr[i]-'0', -1);
+	anchor = i+1;
+      }
+    backslash = (ptr[i] == '\\')?1:0;
+  }
+
+  if (anchor < LENGTH(editspec))
+    PUSH(editlist, CHARS(editspec), anchor, LENGTH(editspec));
+
+  /* now, reverse the list of edit items */ 
+  {
+    editItem prev, cur, next;
+
+    for (prev=NULL, cur=editlist; cur; prev=cur, cur=next) {
+      next = cur->next;
+      cur->next = prev;
+    }
+    editlist = prev;
+  }
+
+  anchor = 0;
+  search_base = 0;
+  editcount = 0;
+  substrings = NULL;
+
+  next_edit = lregsearchv(prog, str, cons(MAKINUM(search_base), EOL));
+
+  while (next_edit != BOOL_F) {
+    if (INUMP(count) && (editcount==INUM(count)))
+      break;
+
+    match_start = INUM(VELTS(next_edit)[0]); 
+    match_end   = INUM(VELTS(next_edit)[1]);
+
+    if (match_start < match_end) {
+      PUSH(substrings, CHARS(str), anchor, match_start);
+      anchor = match_end;
+    }
+
+    for (edit=editlist; edit; edit=edit->next) {
+      if (edit->end == -1) {
+	/* A backslash number in the original editspec */
+	PUSH(substrings, CHARS(str), 
+	     INUM(VELTS(next_edit)[edit->start*2+0]), 
+	     INUM(VELTS(next_edit)[edit->start*2+1]));
+      } else 
+	/* normal string in the editspec */
+	PUSH(substrings, edit->string, edit->start, edit->end);
+    }
+
+    editcount++;
+    search_base = ((match_end>search_base)?match_end:(search_base+1));
+    next_edit  = lregsearchv(prog, str, cons(MAKINUM(search_base), EOL));
+  }
+
+  /* get that tail bit */
+  if (anchor < LENGTH(str))
+    PUSH(substrings, CHARS(str), anchor, LENGTH(str));
+
+  /* assemble the result string */
+  for (edit=substrings, total_len=0; edit; edit=edit->next)
+    total_len += (edit->end - edit->start);
+
+  result = makstr(total_len);
+  ptr = CHARS(result) + total_len; /* point at the null at the end */
+
+  for (edit=substrings; edit; edit=edit->next) {
+    ptr -= (edit->end - edit->start);
+    bcopy(edit->string + edit->start, ptr, edit->end - edit->start);
+  }
+  return result;
+}
+#undef PUSH
+
+void init_rgx()
+{
+  tc16_rgx = newsmob(&rgxsmob);
+  make_subr(s_regcomp, tc7_subr_2o, lregcomp);
+  make_subr(s_regexec, tc7_subr_2, lregexec);
+  make_subr(s_regmatp, tc7_subr_2, lregmatp);
+  make_subr(s_regerror, tc7_subr_1, lregerror);
+  make_subr(s_regsearch, tc7_lsubr_2, lregsearch);
+  make_subr(s_regsearchv, tc7_lsubr_2, lregsearchv);
+  make_subr(s_regmatch, tc7_lsubr_2, lregmatch);
+  make_subr(s_regmatchv, tc7_lsubr_2, lregmatchv);
+  make_subr(s_stringsplit, tc7_subr_2, lstringsplit);
+  make_subr(s_stringsplitv, tc7_subr_2, lstringsplitv);
+  make_subr(s_stringedit, tc7_lsubr_2, lstringedit);
+  add_feature(s_regex);
+}
diff --git a/rope.c b/rope.c
new file mode 100644
index 0000000..c922046
--- /dev/null
+++ b/rope.c
@@ -0,0 +1,335 @@
+/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  
+ */
+
+/* "rope.c" interface between C and SCM.
+   Author: Aubrey Jaffer */
+
+#include "scm.h"
+
+				/* Numeric conversions */
+				/* Convert longs to SCM */
+SCM long2num(sl)
+     long sl;
+{
+  if (!FIXABLE(sl)) {
+# ifdef BIGDIG
+    return long2big(sl);
+# else
+#  ifdef FLOATS
+    return makdbl((double) sl, 0.0);
+#  else
+    return BOOL_F;
+#  endif
+# endif
+  }
+  return MAKINUM(sl);
+}
+SCM ulong2num(sl)
+     unsigned long sl;
+{
+  if (!POSFIXABLE(sl)) {
+#ifdef BIGDIG
+    return ulong2big(sl);
+#else
+# ifdef FLOATS
+    return makdbl((double) sl, 0.0);
+# else
+    return BOOL_F;
+# endif
+#endif
+  }
+  return MAKINUM(sl);
+}
+
+				/* Convert SCM to numbers */
+unsigned char num2uchar(num, pos, s_caller)
+     SCM num;
+     char *pos, *s_caller;
+{
+  unsigned long res = INUM(num);
+  ASSERT(INUMP(num) && (255L >= res),num,pos,s_caller);
+  return (unsigned char) res;
+}
+unsigned short num2ushort(num, pos, s_caller)
+     SCM num;
+     char *pos, *s_caller;
+{
+  unsigned long res = INUM(num);
+  ASSERT(INUMP(num) && (65535L >= res),num,pos,s_caller);
+  return (unsigned short) res;
+}
+unsigned long num2ulong(num, pos, s_caller)
+     SCM num;
+     char *pos, *s_caller;
+{
+  unsigned long res;
+  if INUMP(num) {
+    ASRTGO(0 < num, errout);
+    res = INUM((unsigned long)num);
+    return res;
+  }
+  ASRTGO(NIMP(num), errout);
+#ifdef FLOATS
+  if REALP(num) {
+    double u = REALPART(num);
+    if ((0 <= u) && (u <= (unsigned long)~0L)) {
+      res = u;
+      return res;
+    }
+  }
+#endif
+#ifdef BIGDIG
+  if (TYP16(num)==tc16_bigpos) {
+    sizet l = NUMDIGS(num);
+    ASRTGO(DIGSPERLONG >= l, errout);
+    res = 0;
+    for(;l--;) res = BIGUP(res) + BDIGITS(num)[l];
+    return res;
+  }
+#endif
+ errout: wta(num, pos, s_caller);
+}
+long num2long(num, pos, s_caller)
+     SCM num;
+     char *pos, *s_caller;
+{
+  long res;
+  if INUMP(num) {
+    res = INUM((long)num);
+    return res;
+  }
+  ASRTGO(NIMP(num), errout);
+# ifdef FLOATS
+  if REALP(num) {
+    double u = REALPART(num);
+    if (((MOST_NEGATIVE_FIXNUM * 4) <= u)
+	&& (u <= (MOST_POSITIVE_FIXNUM * 4 + 3))) {
+      res = u;
+      return res;
+    }
+  }
+# endif
+# ifdef BIGDIG
+  if BIGP(num) {
+    sizet l = NUMDIGS(num);
+    ASRTGO(DIGSPERLONG >= l, errout);
+    res = 0;
+    for(;l--;) res = BIGUP(res) + BDIGITS(num)[l];
+    ASRTGO(0<res, errout);
+    return (tc16_bigpos==TYP16(num) ? res : -res);
+  }
+# endif
+ errout: wta(num, pos, s_caller);
+}
+#ifdef FLOATS
+double num2dbl(num, pos, s_caller)
+     SCM num;
+     char *pos, *s_caller;
+{
+  if INUMP(num) return (double)INUM(num);
+  ASRTGO(NIMP(num), errout);
+  if REALP(num) return REALPART(num);
+#ifdef BIGDIG
+  if BIGP(num) return big2dbl(num);
+#endif
+ errout: wta(num, pos, s_caller);
+}
+#endif
+
+
+				/* Convert (arrays of) strings to SCM */
+SCM makfromstr(src, len)
+     char *src;
+     sizet len;
+{
+  SCM s;
+  register char *dst;
+  s = makstr((long)len);
+  dst = CHARS(s);
+  while (len--) *dst++ = *src++;
+  return s;
+}
+SCM makfrom0str(src)
+     char *src;
+{
+  if (!src) return BOOL_F;
+  return makfromstr(src, (sizet) strlen(src));
+}
+/* converts C array of strings to SCM list of strings. */
+/* If argc < 0, a null terminated array is assumed. */
+SCM makfromstrs(argc, argv)
+     int argc;
+     char **argv;
+{
+  int i = argc;
+  SCM lst = EOL;
+  if (0 > i) for(i = 0; argv[i]; i++);
+  while (i--) lst = cons(makfrom0str(argv[i]), lst);
+  return lst;
+}
+/* Converts SCM list of strings to NULL terminated array of strings. */
+/* INTS must be DEFERed around this call and the use of the returned array. */
+char **makargvfrmstrs(args, s_name)
+     SCM args;
+     char *s_name;
+{
+  char **argv;
+  int argc = ilength(args);
+  argv = (char **)must_malloc((1L+argc)*sizeof(char *), s_vector);
+  for(argc = 0; NNULLP(args); args=CDR(args), ++argc) {
+    ASSERT(NIMP(CAR(args)) && STRINGP(CAR(args)), CAR(args), ARG2, s_name);
+    {
+      sizet len = 1 + LENGTH(CAR(args));
+      char *dst = (char *)must_malloc((long)len, s_string);
+      char *src = CHARS(CAR(args));
+      while (len--) dst[len] = src[len];
+      argv[argc] = dst;
+    }
+  }
+  argv[argc] = 0;
+  return argv;
+}
+void must_free_argv(argv)
+     char **argv;
+{
+  char **av = argv;
+  while(!(*av)) free(*(av++));
+  free(argv);
+}
+
+				/* Hooks to call SCM from C */
+SCM scm_evstr(str)
+     char *str;
+{
+  SCM lsym;
+  NEWCELL(lsym);
+  SETLENGTH(lsym, strlen(str)+0L, tc7_ssymbol);
+  SETCHARS(lsym, str);
+  return scm_eval_string(lsym);
+}
+void scm_ldstr(str)
+     char *str;
+{
+  SCM lsym;
+  NEWCELL(lsym);
+  SETLENGTH(lsym, strlen(str)+0L, tc7_ssymbol);
+  SETCHARS(lsym, str);
+  scm_load_string(lsym);
+}
+int scm_ldfile(path)
+     char *path;
+{
+  SCM name = makfrom0str(path);
+  *loc_errobj = name;
+  return BOOL_F==tryload(name);
+}
+int scm_ldprog(path)
+     char *path;
+{
+  SCM name = makfrom0str(path);
+  *loc_errobj = name;
+  return
+    BOOL_F==scm_evstr("(try-load (in-vicinity (program-vicinity) errobj))");
+}
+
+				/* Get byte address of SCM array */
+#ifdef ARRAYS
+long	aind P((SCM ra, SCM args, char *what));
+unsigned long scm_addr(args, s_name)
+     SCM args;
+     char *s_name;
+{
+  long pos;
+  unsigned long ptr = 0;	/* gratuitous assignment squelches cc warn. */
+  SCM v;
+  ASRTGO(NIMP(args), wna);
+  v = CAR(args);
+  args = CDR(args);
+  if IMP(v) {goto badarg;}
+  else if ARRAYP(v) {
+    pos = aind(v, args, s_name);
+    v = ARRAY_V(v);
+  }
+  else {
+    if NIMP(args) {
+      ASSERT(CONSP(args) && INUMP(CAR(args)), args, ARG2, s_name);
+      pos = INUM(CAR(args));
+      ASRTGO(NULLP(CDR(args)), wna);
+    }
+    else if NULLP(args) pos = 0;
+    else {
+      ASSERT(INUMP(args), args, ARG2, s_name);
+      pos = INUM(args);
+    }
+    ASRTGO(pos >= 0 && pos < LENGTH(v), outrng);
+  }
+  switch TYP7(v) {
+  case tc7_string:
+    ptr = (unsigned long)&(CHARS(v)[pos]);
+    break;
+# ifdef FLOATS
+#  ifdef SINGLES
+  case tc7_fvect:
+    ptr = (unsigned long)&(((float *)CDR(v))[pos]);
+    break;
+#  endif
+  case tc7_cvect: pos = 2 * pos;
+  case tc7_dvect: ptr = (unsigned long)&(((double *)CDR(v))[pos]);
+    break;
+# endif
+  case tc7_bvect: ASRTGO(0==(pos%LONG_BIT), outrng);
+    pos = pos/LONG_BIT;
+  case tc7_uvect:
+  case tc7_ivect:
+  case tc7_vector: ptr = (unsigned long)&(VELTS(v)[pos]);
+    break;
+  outrng: wta(MAKINUM(pos), (char *)OUTOFRANGE, s_name);
+  default:
+  badarg: wta(v, (char *)ARG1, s_name);
+  wna: wta(UNDEFINED, (char *)WNA, s_name);
+  }
+  return ptr;
+}
+#endif /* ARRAYS */
+
+void init_rope()
+{
+}
diff --git a/sc2.c b/sc2.c
new file mode 100644
index 0000000..904458a
--- /dev/null
+++ b/sc2.c
@@ -0,0 +1,172 @@
+/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  
+ */
+
+/* "sc2.c" R2RS and R3RS procedures not in R4RS.
+   Author: Aubrey Jaffer */
+
+#include "scm.h"
+
+static char s_last_pair[] = "last-pair";
+SCM last_pair(sx)
+     SCM sx;
+{
+  register SCM res = sx;
+  register SCM x;
+  ASSERT(NIMP(res) && CONSP(res), res, ARG1, s_last_pair);
+  while (!0) {
+    x = CDR(res);
+    if (IMP(x) || NCONSP(x)) return res;
+    res = x;
+    x = CDR(res);
+    if (IMP(x) || NCONSP(x)) return res;
+    res = x;
+    sx = CDR(sx);
+    ASSERT(x != sx, sx, ARG1, s_last_pair);
+  }
+}
+
+static char s_subml[] = "substring-move-left!";
+SCM subml(str1, start1, args)
+     SCM str1, start1, args;
+{
+  SCM end1, str2, start2;
+  long i, j, e;
+  ASSERT(3==ilength(args), args, WNA, s_subml);
+  end1 = CAR(args); args = CDR(args);
+  str2 = CAR(args); args = CDR(args);
+  start2 = CAR(args);
+  ASSERT(NIMP(str1) && STRINGP(str1), str1, ARG1, s_subml);
+  ASSERT(INUMP(start1), start1, ARG2, s_subml);
+  ASSERT(INUMP(end1), end1, ARG3, s_subml);
+  ASSERT(NIMP(str2) && STRINGP(str2), str2, ARG4, s_subml);
+  ASSERT(INUMP(start2), start2, ARG5, s_subml);
+  i = INUM(start1), j = INUM(start2), e = INUM(end1);
+  ASSERT(i <= LENGTH(str1) && i >= 0, start1, OUTOFRANGE, s_subml);
+  ASSERT(j <= LENGTH(str2) && j >= 0, start2, OUTOFRANGE, s_subml);
+  ASSERT(e <= LENGTH(str1) && e >= 0, end1, OUTOFRANGE, s_subml);
+  ASSERT(e-i+j <= LENGTH(str2), start2, OUTOFRANGE, s_subml);
+  while(i<e) CHARS(str2)[j++] = CHARS(str1)[i++];
+  return UNSPECIFIED;
+}
+static char s_submr[] = "substring-move-right!";
+SCM submr(str1, start1, args)
+     SCM str1, start1, args;
+{
+  SCM end1, str2, start2;
+  long i, j, e;
+  ASSERT(3==ilength(args), args, WNA, s_submr);
+  end1 = CAR(args); args = CDR(args);
+  str2 = CAR(args); args = CDR(args);
+  start2 = CAR(args);
+  ASSERT(NIMP(str1) && STRINGP(str1), str1, ARG1, s_submr);
+  ASSERT(INUMP(start1), start1, ARG2, s_submr);
+  ASSERT(INUMP(end1), end1, ARG3, s_submr);
+  ASSERT(NIMP(str2) && STRINGP(str2), str2, ARG4, s_submr);
+  ASSERT(INUMP(start2), start2, ARG5, s_submr);
+  i = INUM(start1), j = INUM(start2), e = INUM(end1);
+  ASSERT(i <= LENGTH(str1) && i >= 0, start1, OUTOFRANGE, s_submr);
+  ASSERT(j <= LENGTH(str2) && j >= 0, start2, OUTOFRANGE, s_submr);
+  ASSERT(e <= LENGTH(str1) && e >= 0, end1, OUTOFRANGE, s_submr);
+  ASSERT((j = e-i+j) <= LENGTH(str2), start2, OUTOFRANGE, s_submr);
+  while(i<e) CHARS(str2)[--j] = CHARS(str1)[--e];
+  return UNSPECIFIED;
+}
+static char s_subfl[] = "substring-fill!";
+SCM subfl(str, start, args)
+     SCM str, start, args;
+{
+  SCM end, fill;
+  long i, e;
+  char c;
+  ASSERT(2==ilength(args), args, WNA, s_subfl);
+  end = CAR(args); args = CDR(args);
+  fill = CAR(args);
+  ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_subfl);
+  ASSERT(INUMP(start), start, ARG2, s_subfl);
+  ASSERT(INUMP(end), end, ARG3, s_subfl);
+  ASSERT(ICHRP(fill), fill, ARG4, s_subfl);
+  i = INUM(start), e = INUM(end);c = ICHR(fill);
+  ASSERT(i <= LENGTH(str) && i >= 0, start, OUTOFRANGE, s_subfl);
+  ASSERT(e <= LENGTH(str) && e >= 0, end, OUTOFRANGE, s_subfl);
+  while(i<e) CHARS(str)[i++] = c;
+  return UNSPECIFIED;
+}
+
+static char s_strnullp[] = "string-null?";
+SCM strnullp(str)
+     SCM str;
+{
+  ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_strnullp);
+  if LENGTH(str) return BOOL_F;
+  else return BOOL_T;
+}
+
+static char s_appendb[] = "append!";
+SCM appendb(args)
+     SCM args;
+{
+  SCM arg;
+ tail:
+  if NULLP(args) return EOL;
+  arg = CAR(args);
+  ASSERT(NULLP(arg) || (NIMP(arg) && CONSP(arg)), arg, ARG1, s_appendb);
+  args = CDR(args);
+  if NULLP(args) return arg;
+  if NULLP(arg) goto tail;
+  CDR(last_pair(arg)) = appendb(args);
+  return arg;
+}
+
+static iproc lsubr2s[] = {
+  {s_subml, subml},
+  {s_submr, submr},
+  {s_subfl, subfl},
+  {0, 0}};
+
+void init_sc2()
+{
+  make_subr(s_last_pair, tc7_subr_1, last_pair);
+  make_subr(s_strnullp, tc7_subr_1, strnullp);
+  make_subr(s_appendb, tc7_lsubr, appendb);
+  init_iprocs(lsubr2s, tc7_lsubr_2);
+  add_feature("rev2-procedures");
+  add_feature("rev3-procedures");
+}
diff --git a/scl.c b/scl.c
new file mode 100644
index 0000000..393d0f0
--- /dev/null
+++ b/scl.c
@@ -0,0 +1,2393 @@
+/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  
+ */
+
+/* "scl.c" non-IEEE utility functions and non-integer arithmetic.
+   Authors: Jerry D. Hedden and Aubrey Jaffer */
+
+#include "scm.h"
+
+#ifdef FLOATS
+# include <math.h>
+
+static char s_makrect[] = "make-rectangular", s_makpolar[] = "make-polar",
+	    s_magnitude[] = "magnitude", s_angle[] = "angle",
+	    s_real_part[] = "real-part", s_imag_part[] = "imag-part",
+	    s_in2ex[] = "inexact->exact";
+static char s_expt[] = "$expt", s_atan2[] = "$atan2";
+static char s_memv[] = "memv", s_assv[] = "assv";
+#endif
+
+SCM sys_protects[NUM_PROTECTS];
+sizet num_protects = NUM_PROTECTS;
+
+char		s_inexactp[] = "inexact?";
+static char     s_zerop[] = "zero?",
+		s_positivep[] = "positive?", s_negativep[] = "negative?";
+static char     s_eqp[] = "=", s_lessp[] = "<", s_grp[] = ">";
+static char     s_leqp[] = "<=", s_greqp[] = ">=";
+static char     s_max[] = "max", s_min[] = "min";
+char		s_sum[] = "+", s_difference[] = "-", s_product[] = "*",
+		s_divide[] = "/";
+static char     s_number2string[] = "number->string",
+		s_str2number[] = "string->number";
+
+static char s_list_tail[] = "list-tail";
+static char s_str2list[] = "string->list";
+static char s_st_copy[] = "string-copy", s_st_fill[] = "string-fill!";
+static char s_vect2list[] = "vector->list", s_ve_fill[] = "vector-fill!";
+
+/*** NUMBERS -> STRINGS ***/
+#ifdef FLOATS
+int dblprec;
+static double fx[] = {0.0, 5e-1, 5e-2, 5e-3, 5e-4, 5e-5,
+			   5e-6, 5e-7, 5e-8, 5e-9, 5e-10,
+			   5e-11,5e-12,5e-13,5e-14,5e-15,
+			   5e-16,5e-17,5e-18,5e-19,5e-20};
+
+static sizet idbl2str(f, a)
+     double f;
+char *a;
+{
+  int efmt, dpt, d, i, wp = dblprec;
+  sizet ch = 0;
+  int exp = 0;
+
+  if (f==0.0) goto zero;	/*{a[0]='0'; a[1]='.'; a[2]='0'; return 3;}*/
+  if (f < 0.0) {f = -f;a[ch++]='-';}
+  else if (f > 0.0) ;
+  else goto funny;
+  if IS_INF(f) {
+    if (ch==0) a[ch++]='+';
+  funny: a[ch++]='#'; a[ch++]='.'; a[ch++]='#'; return ch;
+  }
+# ifdef DBL_MIN_10_EXP		/* Prevent unnormalized values, as from
+			make-uniform-vector, from causing infinite loops. */
+  while (f < 1.0) {f *= 10.0;  if (exp-- < DBL_MIN_10_EXP) goto funny;}
+  while (f > 10.0) {f *= 0.10; if (exp++ > DBL_MAX_10_EXP) goto funny;}
+# else
+  while (f < 1.0) {f *= 10.0; exp--;}
+  while (f > 10.0) {f /= 10.0; exp++;}
+# endif
+  if (f+fx[wp] >= 10.0) {f = 1.0; exp++;}
+ zero:
+# ifdef ENGNOT
+  dpt = (exp+9999)%3;
+  exp -= dpt++;
+  efmt = 1;
+# else
+  efmt = (exp < -3) || (exp > wp+2);
+  if (!efmt)
+    if (exp < 0) {
+      a[ch++] = '0';
+      a[ch++] = '.';
+      dpt = exp;
+      while (++dpt)  a[ch++] = '0';
+    } else
+      dpt = exp+1;
+  else
+    dpt = 1;
+# endif
+
+  do {
+    d = f;
+    f -= d;
+    a[ch++] = d+'0';
+    if (f < fx[wp])  break;
+    if (f+fx[wp] >= 1.0) {
+      a[ch-1]++;
+      break;
+    }
+    f *= 10.0;
+    if (!(--dpt))  a[ch++] = '.';
+  } while (wp--);
+
+  if (dpt > 0)
+# ifndef ENGNOT
+    if ((dpt > 4) && (exp > 6)) {
+      d = (a[0]=='-'?2:1);
+      for (i = ch++; i > d; i--)
+	a[i] = a[i-1];
+      a[d] = '.';
+      efmt = 1;
+    } else
+# endif
+      {
+	while (--dpt)  a[ch++] = '0';
+	a[ch++] = '.';
+      }
+  if (a[ch-1]=='.')  a[ch++]='0'; /* trailing zero */
+  if (efmt && exp) {
+    a[ch++] = 'e';
+    if (exp < 0) {
+      exp = -exp;
+      a[ch++] = '-';
+    }
+    for (i = 10; i <= exp; i *= 10);
+    for (i /= 10; i; i /= 10) {
+      a[ch++] = exp/i + '0';
+      exp %= i;
+    }
+  }
+  return ch;
+}
+
+static sizet iflo2str(flt, str)
+     SCM flt;
+     char *str;
+{
+  sizet i;
+# ifdef SINGLES
+  if SINGP(flt) i = idbl2str(FLO(flt), str);
+  else
+# endif
+    i = idbl2str(REAL(flt), str);
+  if CPLXP(flt) {
+              if(0 <= IMAG(flt)) /* jeh */
+                str[i++] = '+'; /* jeh */
+    i += idbl2str(IMAG(flt), &str[i]);
+    str[i++] = 'i';
+  }
+  return i;
+}
+#endif				/* FLOATS */
+
+sizet iint2str(num, rad, p)
+     long num;
+     int rad;
+     char *p;
+{
+  sizet j;
+  register int i = 1, d;
+  register long n = num;
+  if (n < 0) {n = -n; i++;}
+  for (n /= rad;n > 0;n /= rad) i++;
+  j = i;
+  n = num;
+  if (n < 0) {n = -n; *p++ = '-'; i--;}
+  while (i--) {
+    d = n % rad;
+    n /= rad;
+    p[i] = d + ((d < 10) ? '0' : 'a' - 10);
+  }
+  return j;
+}
+#ifdef BIGDIG
+static SCM big2str(b, radix)
+     SCM b;
+     register unsigned int radix;
+{
+  SCM t = copybig(b, 0);	/* sign of temp doesn't matter */
+  register BIGDIG *ds = BDIGITS(t);
+  sizet i = NUMDIGS(t);
+  sizet j = radix==16 ? (BITSPERDIG*i)/4+2
+    : radix >= 10 ? (BITSPERDIG*i*241L)/800+2
+      : (BITSPERDIG*i)+2;
+  sizet k = 0;
+  sizet radct = 0;
+      sizet ch; /* jeh */
+  BIGDIG radpow = 1, radmod = 0;
+  SCM ss = makstr((long)j);
+  char *s = CHARS(ss), c;
+  while ((long) radpow * radix < BIGRAD) {
+    radpow *= radix;
+    radct++;
+  }
+  s[0] = tc16_bigneg==TYP16(b) ? '-' : '+';
+  while ((i || radmod) && j) {
+    if (k==0) {
+      radmod = (BIGDIG)divbigdig(ds, i, radpow);
+      k = radct;
+      if (!ds[i-1]) i--;
+    }
+    c = radmod % radix; radmod /= radix; k--;
+    s[--j] = c < 10 ? c + '0' : c + 'a' - 10;
+  }
+      ch = s[0]=='-' ? 1 : 0; /* jeh */
+  if (ch < j) { /* jeh */
+    for(i = j;j < LENGTH(ss);j++) s[ch+j-i] = s[j]; /* jeh */
+    resizuve(ss, (SCM)MAKINUM(ch+LENGTH(ss)-i)); /* jeh */
+  }
+  return ss;
+}
+#endif
+SCM number2string(x, radix)
+     SCM x, radix;
+{
+  if UNBNDP(radix) radix=MAKINUM(10L);
+  else ASSERT(INUMP(radix), radix, ARG2, s_number2string);
+#ifdef FLOATS
+  if NINUMP(x) {
+    char num_buf[FLOBUFLEN];
+# ifdef BIGDIG
+    ASRTGO(NIMP(x), badx);
+    if BIGP(x) return big2str(x, (unsigned int)INUM(radix));
+#  ifndef RECKLESS
+    if (!(INEXP(x)))
+    badx: wta(x, (char *)ARG1, s_number2string);
+#  endif
+# else
+    ASSERT(NIMP(x) && INEXP(x), x, ARG1, s_number2string);
+# endif
+    return makfromstr(num_buf, iflo2str(x, num_buf));
+  }
+#else
+# ifdef BIGDIG
+  if NINUMP(x) {
+    ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_number2string);
+    return big2str(x, (unsigned int)INUM(radix));
+  }
+# else
+  ASSERT(INUMP(x), x, ARG1, s_number2string);
+# endif
+#endif
+  {
+    char num_buf[INTBUFLEN];
+    return makfromstr(num_buf, iint2str(INUM(x), (int)INUM(radix), num_buf));
+  }
+}
+/* These print routines are stubbed here so that repl.c doesn't need
+   FLOATS or BIGDIGs conditionals */
+int floprint(sexp, port, writing)
+     SCM sexp;
+     SCM port;
+     int writing;
+{
+#ifdef FLOATS
+  char num_buf[FLOBUFLEN];
+  lfwrite(num_buf, (sizet)sizeof(char), iflo2str(sexp, num_buf), port);
+#else
+  ipruk("float", sexp, port);
+#endif
+  return !0;
+}
+int bigprint(exp, port, writing)
+     SCM exp;
+     SCM port;
+     int writing;
+{
+#ifdef BIGDIG
+  exp = big2str(exp, (unsigned int)10);
+  lfwrite(CHARS(exp), (sizet)sizeof(char), (sizet)LENGTH(exp), port);
+#else
+  ipruk("bignum", exp, port);
+#endif
+  return !0;
+}
+/*** END nums->strs ***/
+
+/*** STRINGS -> NUMBERS ***/
+#ifdef BIGDIG
+SCM istr2int(str, len, radix)
+     char *str;
+     long len;
+     register long radix;
+{
+  sizet j;
+  register sizet k, blen = 1;
+  sizet i = 0;
+  int c;
+  SCM res;
+  register BIGDIG *ds;
+  register unsigned long t2;
+
+  if (0 >= len) return BOOL_F;	/* zero length */
+  if (10==radix) j = 1+(84*len)/(BITSPERDIG*25);
+  else j = (8 < radix) ? 1+(4*len)/BITSPERDIG : 1+(3*len)/BITSPERDIG;
+  switch (str[0]) {		/* leading sign */
+  case '-':
+  case '+': if (++i==len) return BOOL_F; /* bad if lone `+' or `-' */
+  }
+  res = mkbig(j, '-'==str[0]);
+  ds = BDIGITS(res);
+  for (k = j;k--;) ds[k] = 0;
+  do {
+    switch (c = str[i++]) {
+    case DIGITS:
+      c = c - '0';
+      goto accumulate;
+    case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+      c = c-'A'+10;
+      goto accumulate;
+    case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+      c = c-'a'+10;
+    accumulate:
+      if (c >= radix) return BOOL_F; /* bad digit for radix */
+      k = 0;
+      t2 = c;
+    moretodo:
+      while(k < blen) {
+/*	printf("k = %d, blen = %d, t2 = %ld, ds[k] = %d\n", k, blen, t2, ds[k]);*/
+	t2 += ds[k]*radix;
+	ds[k++] = BIGLO(t2);
+	t2 = BIGDN(t2);
+      }
+      ASSERT(blen <= j, (SCM)MAKINUM(blen), OVFLOW, "bignum");
+      if (t2) {blen++; goto moretodo;}
+      break;
+    default:
+      return BOOL_F;		/* not a digit */
+    }
+  } while (i < len);
+  if (blen * BITSPERDIG/CHAR_BIT <= sizeof(SCM))
+    if INUMP(res = big2inum(res, blen)) return res;
+  if (j==blen) return res;
+  return adjbig(res, blen);
+}
+#else
+SCM istr2int(str, len, radix)
+     register char *str;
+     long len;
+     register long radix;
+{
+  register long n = 0, ln;
+  register int c;
+  register int i = 0;
+  int lead_neg = 0;
+  if (0 >= len) return BOOL_F;	/* zero length */
+  switch (*str) {		/* leading sign */
+  case '-': lead_neg = 1;
+  case '+': if (++i==len) return BOOL_F; /* bad if lone `+' or `-' */
+  }
+
+  do {
+    switch (c = str[i++]) {
+    case DIGITS:
+      c = c - '0';
+      goto accumulate;
+    case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+      c = c-'A'+10;
+      goto accumulate;
+    case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+      c = c-'a'+10;
+    accumulate:
+      if (c >= radix) return BOOL_F; /* bad digit for radix */
+      ln = n;
+      n = n * radix - c;
+      /* Negation is a workaround for HP700 cc bug */
+      if (n > ln || (-n > -MOST_NEGATIVE_FIXNUM)) goto ovfl;
+      break;
+    default:
+      return BOOL_F;		/* not a digit */
+    }
+  } while (i < len);
+  if (!lead_neg) if ((n = -n) > MOST_POSITIVE_FIXNUM) goto ovfl;
+  return MAKINUM(n);
+ ovfl:				/* overflow scheme integer */
+  return BOOL_F;
+}
+#endif
+
+#ifdef FLOATS
+SCM istr2flo(str, len, radix)
+     register char *str;
+     register long len;
+     register long radix;
+{
+  register int c, i = 0;
+  double lead_sgn;
+  double res = 0.0, tmp = 0.0;
+  int flg = 0;
+  int point = 0;
+  SCM second;
+
+  if (i >= len) return BOOL_F;	/* zero length */
+
+  switch (*str) {		/* leading sign */
+  case '-': lead_sgn = -1.0; i++; break;
+  case '+': lead_sgn = 1.0; i++; break;
+    default : lead_sgn = 0.0;
+  }
+  if (i==len) return BOOL_F;	/* bad if lone `+' or `-' */
+
+  if (str[i]=='i' || str[i]=='I') { /* handle `+i' and `-i'   */
+    if (lead_sgn==0.0) return BOOL_F; /* must have leading sign */
+    if (++i < len) return BOOL_F; /* `i' not last character */
+    return makdbl(0.0, lead_sgn);
+  }
+  do {				/* check initial digits */
+    switch (c = str[i]) {
+    case DIGITS:
+      c = c - '0';
+      goto accum1;
+    case 'D': case 'E': case 'F':
+      if (radix==10) goto out1; /* must be exponent */
+    case 'A': case 'B': case 'C':
+      c = c-'A'+10;
+      goto accum1;
+    case 'd': case 'e': case 'f':
+      if (radix==10) goto out1;
+    case 'a': case 'b': case 'c':
+      c = c-'a'+10;
+    accum1:
+      if (c >= radix) return BOOL_F; /* bad digit for radix */
+      res = res * radix + c;
+      flg = 1;			/* res is valid */
+      break;
+    default:
+      goto out1;
+    }
+  } while (++i < len);
+ out1:
+
+  /* if true, then we did see a digit above, and res is valid */
+  if (i==len) goto done;
+
+  /* By here, must have seen a digit,
+     or must have next char be a `.' with radix==10 */
+  if (!flg)
+    if (!(str[i]=='.' && radix==10))
+      return BOOL_F;
+
+  while (str[i]=='#') {		/* optional sharps */
+    res *= radix;
+    if (++i==len) goto done;
+  }
+
+  if (str[i]=='/') {
+    while (++i < len) {
+      switch (c = str[i]) {
+      case DIGITS:
+	c = c - '0';
+	goto accum2;
+      case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+	c = c-'A'+10;
+	goto accum2;
+      case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+	c = c-'a'+10;
+      accum2:
+	if (c >= radix) return BOOL_F;
+	tmp = tmp * radix + c;
+	break;
+      default:
+	goto out2;
+      }
+    }
+  out2:
+    if (tmp==0.0) return BOOL_F; /* `slash zero' not allowed */
+    if (i < len)
+      while (str[i]=='#') {	/* optional sharps */
+	tmp *= radix;
+	if (++i==len) break;
+      }
+    res /= tmp;
+    goto done;
+  }
+
+  if (str[i]=='.') {		/* decimal point notation */
+    if (radix != 10) return BOOL_F; /* must be radix 10 */
+    while (++i < len) {
+      switch (c = str[i]) {
+      case DIGITS:
+	point--;
+	res = res*10.0 + c-'0';
+	flg = 1;
+	break;
+      default:
+	goto out3;
+      }
+    }
+  out3:
+    if (!flg) return BOOL_F;	/* no digits before or after decimal point */
+    if (i==len) goto adjust;
+    while (str[i]=='#') {	/* ignore remaining sharps */
+      if (++i==len) goto adjust;
+    }
+  }
+
+  switch (str[i]) {		/* exponent */
+  case 'd': case 'D':
+  case 'e': case 'E':
+  case 'f': case 'F':
+  case 'l': case 'L':
+  case 's': case 'S': {
+    int expsgn = 1, expon = 0;
+    if (radix != 10) return BOOL_F; /* only in radix 10 */
+    if (++i==len) return BOOL_F; /* bad exponent */
+    switch (str[i]) {
+    case '-':  expsgn=(-1);
+    case '+':  if (++i==len) return BOOL_F; /* bad exponent */
+    }
+    if (str[i] < '0' || str[i] > '9') return BOOL_F; /* bad exponent */
+    do {
+      switch (c = str[i]) {
+      case DIGITS:
+	expon = expon*10 + c-'0';
+	if (expon > MAXEXP)  return BOOL_F; /* exponent too large */
+	break;
+      default:
+	goto out4;
+      }
+    } while (++i < len);
+  out4:
+    point += expsgn*expon;
+  }
+  }
+
+ adjust:
+  if (point >= 0)
+    while (point--)  res *= 10.0;
+  else
+# ifdef _UNICOS
+    while (point++)  res *= 0.1;
+# else
+    while (point++)  res /= 10.0;
+# endif
+
+ done:
+  /* at this point, we have a legitimate floating point result */
+  if (lead_sgn==-1.0)  res = -res;
+  if (i==len) return makdbl(res, 0.0);
+
+  if (str[i]=='i' || str[i]=='I') { /* pure imaginary number  */
+    if (lead_sgn==0.0) return BOOL_F; /* must have leading sign */
+    if (++i < len) return BOOL_F; /* `i' not last character */
+    return makdbl(0.0, res);
+  }
+
+  switch (str[i++]) {
+  case '-':  lead_sgn = -1.0; break;
+  case '+':  lead_sgn = 1.0;  break;
+  case '@': {			/* polar input for complex number */
+    /* get a `real' for angle */
+    second = istr2flo(&str[i], (long)(len-i), radix);
+    if (!(INEXP(second))) return BOOL_F; /* not `real' */
+    if (CPLXP(second))    return BOOL_F; /* not `real' */
+    tmp = REALPART(second);
+    return makdbl(res*cos(tmp), res*sin(tmp));
+  }
+  default: return BOOL_F;
+  }
+
+  /* at this point, last char must be `i' */
+  if (str[len-1] != 'i' && str[len-1] != 'I') return BOOL_F;
+  /* handles `x+i' and `x-i' */
+  if (i==(len-1))  return makdbl(res, lead_sgn);
+  /* get a `ureal' for complex part */
+  second = istr2flo(&str[i], (long)((len-i)-1), radix);
+  if (!(INEXP(second))) return BOOL_F; /* not `ureal' */
+  if (CPLXP(second))    return BOOL_F; /* not `ureal' */
+  tmp = REALPART(second);
+  if (tmp < 0.0)	return BOOL_F; /* not `ureal' */
+  return makdbl(res, (lead_sgn*tmp));
+}
+#endif				/* FLOATS */
+
+
+SCM istring2number(str, len, radix)
+     char *str;
+     long len;
+     long radix;
+{
+  int i = 0;
+  char ex = 0;
+  char ex_p = 0, rx_p = 0;	/* Only allow 1 exactness and 1 radix prefix */
+  SCM res;
+  if (len==1)
+    if (*str=='+' || *str=='-') /* Catches lone `+' and `-' for speed */
+      return BOOL_F;
+
+  while ((len-i) >= 2  &&  str[i]=='#' && ++i)
+    switch (str[i++]) {
+    case 'b': case 'B':  if (rx_p++) return BOOL_F; radix = 2;  break;
+    case 'o': case 'O':  if (rx_p++) return BOOL_F; radix = 8;  break;
+    case 'd': case 'D':  if (rx_p++) return BOOL_F; radix = 10; break;
+    case 'x': case 'X':  if (rx_p++) return BOOL_F; radix = 16; break;
+    case 'i': case 'I':  if (ex_p++) return BOOL_F; ex = 2;     break;
+    case 'e': case 'E':  if (ex_p++) return BOOL_F; ex = 1;     break;
+    default:  return BOOL_F;
+    }
+
+  switch (ex) {
+  case 1:
+    return istr2int(&str[i], len-i, radix);
+  case 0:
+    res = istr2int(&str[i], len-i, radix);
+    if NFALSEP(res) return res;
+#ifdef FLOATS
+  case 2: return istr2flo(&str[i], len-i, radix);
+#endif
+  }
+  return BOOL_F;
+}
+
+
+SCM string2number(str, radix)
+     SCM str, radix;
+{
+  if UNBNDP(radix) radix=MAKINUM(10L);
+  else ASSERT(INUMP(radix), radix, ARG2, s_str2number);
+  ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_str2number);
+  return istring2number(CHARS(str), LENGTH(str), INUM(radix));
+}
+/*** END strs->nums ***/
+
+#ifdef FLOATS
+SCM makdbl (x, y)
+     double x, y;
+{
+  SCM z;
+  if ((y==0.0) && (x==0.0)) return flo0;
+  NEWCELL(z);
+  DEFER_INTS;
+  if (y==0.0) {
+# ifdef SINGLES
+    float fx;
+#  ifndef SINGLESONLY
+    if ((-FLTMAX < x) && (x < FLTMAX) && ((fx=x)==x))
+#  endif
+      {
+	CAR(z) = tc_flo;
+	FLO(z) = x;
+	ALLOW_INTS;
+	return z;
+      }
+# endif				/* def SINGLES */
+    CDR(z) = (SCM)must_malloc(1L*sizeof(double), "real");
+    CAR(z) = tc_dblr;
+  }
+  else {
+    CDR(z) = (SCM)must_malloc(2L*sizeof(double), "complex");
+    CAR(z) = tc_dblc;
+    IMAG(z) = y;
+  }
+  REAL(z) = x;
+  ALLOW_INTS;
+  return z;
+}
+
+SCM eqv(x, y)
+     SCM x, y;
+{
+  if (x==y) return BOOL_T;
+  if IMP(x) return BOOL_F;
+  if IMP(y) return BOOL_F;
+  /* this ensures that types and length are the same. */
+  if (CAR(x) != CAR(y)) return BOOL_F;
+  if NUMP(x) {
+# ifdef BIGDIG
+    if BIGP(x) return (0==bigcomp(x, y)) ? BOOL_T : BOOL_F;
+# endif
+    if (REALPART(x) != REALPART(y)) return BOOL_F;
+    if (CPLXP(x) && (IMAG(x) != IMAG(y))) return BOOL_F;
+    return BOOL_T;
+  }
+  return BOOL_F;
+}
+SCM memv(x, lst)			/* m.borza  12.2.91 */
+SCM x, lst;
+{
+  for(;NIMP(lst);lst = CDR(lst)) {
+    ASRTGO(CONSP(lst), badlst);
+    if NFALSEP(eqv(CAR(lst), x)) return lst;
+  }
+# ifndef RECKLESS
+  if (!(NULLP(lst)))
+    badlst: wta(lst, (char *)ARG2, s_memv);
+# endif
+  return BOOL_F;
+}
+SCM assv(x, alist)		/* m.borza  12.2.91 */
+SCM x, alist;
+{
+  SCM tmp;
+  for(;NIMP(alist);alist = CDR(alist)) {
+    ASRTGO(CONSP(alist), badlst);
+    tmp = CAR(alist);
+    ASRTGO(NIMP(tmp) && CONSP(tmp), badlst);
+    if NFALSEP(eqv(CAR(tmp), x)) return tmp;
+  }
+# ifndef RECKLESS
+  if (!(NULLP(alist)))
+    badlst: wta(alist, (char *)ARG2, s_assv);
+# endif
+  return BOOL_F;
+}
+#endif				/* FLOATS */
+
+SCM list_tail(lst, k)
+     SCM lst, k;
+{
+  register long i;
+  ASSERT(INUMP(k), k, ARG2, s_list_tail);
+  i = INUM(k);
+  while (i-- > 0) {
+    ASSERT(NIMP(lst) && CONSP(lst), lst, ARG1, s_list_tail);
+    lst = CDR(lst);
+  }
+  return lst;
+}
+
+SCM string2list(str)
+     SCM str;
+{
+  long i;
+  SCM res = EOL;
+  unsigned char *src;
+  ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_str2list);
+  src = UCHARS(str);
+  for(i = LENGTH(str)-1;i >= 0;i--) res = cons((SCM)MAKICHR(src[i]), res);
+  return res;
+}
+SCM string_copy(str)
+     SCM str;
+{
+  ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_st_copy);
+  return makfromstr(CHARS(str), (sizet)LENGTH(str));
+}
+SCM string_fill(str, chr)
+     SCM str, chr;
+{
+  register char *dst, c;
+  register long k;
+  ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_st_fill);
+  ASSERT(ICHRP(chr), chr, ARG2, s_st_fill);
+  c = ICHR(chr);
+  dst = CHARS(str);
+  for(k = LENGTH(str)-1;k >= 0;k--) dst[k] = c;
+  return UNSPECIFIED;
+}
+SCM vector2list(v)
+     SCM v;
+{
+  SCM res = EOL;
+  long i;
+  SCM *data;
+  ASSERT(NIMP(v) && VECTORP(v), v, ARG1, s_vect2list);
+  data = VELTS(v);
+  for(i = LENGTH(v)-1;i >= 0;i--) res = cons(data[i], res);
+  return res;
+}
+SCM vector_fill(v, fill)
+     SCM v, fill;
+{
+  register long i;
+  register SCM *data;
+  ASSERT(NIMP(v) && VECTORP(v), v, ARG1, s_ve_fill);
+  data = VELTS(v);
+  for(i = LENGTH(v)-1;i >= 0;i--) data[i] = fill;
+  return UNSPECIFIED;
+}
+static SCM vector_equal(x, y)
+     SCM x, y;
+{
+  long i;
+  for(i = LENGTH(x)-1;i >= 0;i--)
+    if FALSEP(equal(VELTS(x)[i], VELTS(y)[i])) return BOOL_F;
+  return BOOL_T;
+}
+SCM bigequal(x, y)
+     SCM x, y;
+{
+#ifdef BIGDIG
+  if (0==bigcomp(x, y)) return BOOL_T;
+#endif
+  return BOOL_F;
+}
+SCM floequal(x, y)
+     SCM x, y;
+{
+#ifdef FLOATS
+  if (REALPART(x) != REALPART(y)) return BOOL_F;
+  if (!(CPLXP(x) && (IMAG(x) != IMAG(y)))) return BOOL_T;
+#endif
+  return BOOL_F;
+}
+SCM equal(x, y)
+     SCM x, y;
+{
+  CHECK_STACK;
+ tailrecurse: POLL;
+	if (x==y) return BOOL_T;
+	if IMP(x) return BOOL_F;
+	if IMP(y) return BOOL_F;
+	if (CONSP(x) && CONSP(y)) {
+		if FALSEP(equal(CAR(x), CAR(y))) return BOOL_F;
+		x = CDR(x);
+		y = CDR(y);
+		goto tailrecurse;
+	}
+	/* this ensures that types and length are the same. */
+	if (CAR(x) != CAR(y)) return BOOL_F;
+	switch (TYP7(x)) {
+        default: return BOOL_F;
+	case tc7_string: return st_equal(x, y);
+	case tc7_vector: return vector_equal(x, y);
+	case tc7_smob: {
+	        int i = SMOBNUM(x);
+	        if (!(i < numsmob)) return BOOL_F;
+	        if (smobs[i].equalp) return (smobs[i].equalp)(x, y);
+		else return BOOL_F;
+	      }
+	case tc7_bvect: case tc7_uvect: case tc7_ivect:
+	case tc7_fvect:	case tc7_cvect: case tc7_dvect: {
+	        SCM (*pred)() = smobs[0x0ff & (tc16_array>>8)].equalp;
+	        if (pred) return (*pred)(x, y);
+		else return BOOL_F;
+	      }
+	}
+	return BOOL_F;
+}
+
+SCM numberp(x)
+     SCM x;
+{
+  if INUMP(x) return BOOL_T;
+#ifdef FLOATS
+  if (NIMP(x) && NUMP(x)) return BOOL_T;
+#else
+# ifdef BIGDIG
+  if (NIMP(x) && NUMP(x)) return BOOL_T;
+# endif
+#endif
+  return BOOL_F;
+}
+#ifdef FLOATS
+SCM realp(x)
+     SCM x;
+{
+  if INUMP(x) return BOOL_T;
+  if IMP(x) return BOOL_F;
+  if REALP(x) return BOOL_T;
+# ifdef BIGDIG
+  if BIGP(x) return BOOL_T;
+# endif
+  return BOOL_F;
+}
+SCM intp(x)
+     SCM x;
+{
+  double r;
+  if INUMP(x) return BOOL_T;
+  if IMP(x) return BOOL_F;
+# ifdef BIGDIG
+  if BIGP(x) return BOOL_T;
+# endif
+  if (!INEXP(x)) return BOOL_F;
+  if CPLXP(x) return BOOL_F;
+  r = REALPART(x);
+  if (r==floor(r)) return BOOL_T;
+  return BOOL_F;
+}
+#endif				/* FLOATS */
+
+SCM inexactp(x)
+     SCM x;
+{
+#ifdef FLOATS
+  if (NIMP(x) && INEXP(x)) return BOOL_T;
+#endif
+  return BOOL_F;
+}
+SCM eqp(x, y)
+     SCM x, y;
+{
+#ifdef FLOATS
+  SCM t;
+  if NINUMP(x) {
+# ifdef BIGDIG
+#  ifndef RECKLESS
+    if (!(NIMP(x)))
+    badx: wta(x, (char *)ARG1, s_eqp);
+#  endif
+    if BIGP(x) {
+      if INUMP(y) return BOOL_F;
+      ASRTGO(NIMP(y), bady);
+      if BIGP(y) return (0==bigcomp(x, y)) ? BOOL_T : BOOL_F;
+      ASRTGO(INEXP(y), bady);
+    bigreal:
+      return (REALP(y) && (big2dbl(x)==REALPART(y))) ? BOOL_T : BOOL_F;
+    }
+    ASRTGO(INEXP(x), badx);
+# else
+    ASSERT(NIMP(x) && INEXP(x), x, ARG1, s_eqp);
+# endif
+    if INUMP(y) {t = x; x = y; y = t; goto realint;}
+# ifdef BIGDIG
+    ASRTGO(NIMP(y), bady);
+    if BIGP(y) {t = x; x = y; y = t; goto bigreal;}
+    ASRTGO(INEXP(y), bady);
+# else
+    ASRTGO(NIMP(y) && INEXP(y), bady);
+# endif
+    if (REALPART(x) != REALPART(y)) return BOOL_F;
+    if CPLXP(x)
+      return (CPLXP(y) && (IMAG(x)==IMAG(y))) ? BOOL_T : BOOL_F;
+    return CPLXP(y) ? BOOL_F : BOOL_T;
+  }
+  if NINUMP(y) {
+# ifdef BIGDIG
+    ASRTGO(NIMP(y), bady);
+    if BIGP(y) return BOOL_F;
+#  ifndef RECKLESS
+    if (!(INEXP(y)))
+    bady: wta(y, (char *)ARG2, s_eqp);
+#  endif
+# else
+#  ifndef RECKLESS
+    if (!(NIMP(y) && INEXP(y)))
+    bady: wta(y, (char *)ARG2, s_eqp);
+#  endif
+# endif
+  realint:
+    return (REALP(y) && (((double)INUM(x))==REALPART(y))) ? BOOL_T : BOOL_F;
+  }
+#else
+# ifdef BIGDIG
+  if NINUMP(x) {
+    ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_eqp);
+    if INUMP(y) return BOOL_F;
+    ASRTGO(NIMP(y) && BIGP(y), bady);
+    return (0==bigcomp(x, y)) ? BOOL_T : BOOL_F;
+  }
+  if NINUMP(y) {
+#  ifndef RECKLESS
+    if (!(NIMP(y) && BIGP(y)))
+    bady: wta(y, (char *)ARG2, s_eqp);
+#  endif
+    return BOOL_F;
+  }
+# else
+  ASSERT(INUMP(x), x, ARG1, s_eqp);
+  ASSERT(INUMP(y), y, ARG2, s_eqp);
+# endif
+#endif
+  return ((long)x==(long)y) ? BOOL_T : BOOL_F;
+}
+SCM lessp(x, y)
+     SCM x, y;
+{
+#ifdef FLOATS
+  if NINUMP(x) {
+# ifdef BIGDIG
+#  ifndef RECKLESS
+    if (!(NIMP(x)))
+    badx: wta(x, (char *)ARG1, s_lessp);
+#  endif
+    if BIGP(x) {
+      if INUMP(y) return BIGSIGN(x) ? BOOL_T : BOOL_F;
+      ASRTGO(NIMP(y), bady);
+      if BIGP(y) return (1==bigcomp(x, y)) ? BOOL_T : BOOL_F;
+      ASRTGO(REALP(y), bady);
+      return (big2dbl(x) < REALPART(y)) ? BOOL_T : BOOL_F;
+    }
+    ASRTGO(REALP(x), badx);
+# else
+    ASSERT(NIMP(x) && REALP(x), x, ARG1, s_lessp);
+# endif
+    if INUMP(y) return (REALPART(x) < ((double)INUM(y))) ? BOOL_T : BOOL_F;
+# ifdef BIGDIG
+    ASRTGO(NIMP(y), bady);
+    if BIGP(y) return (REALPART(x) < big2dbl(y)) ? BOOL_T : BOOL_F;
+    ASRTGO(REALP(y), bady);
+# else
+    ASRTGO(NIMP(y) && REALP(y), bady);
+# endif
+    return (REALPART(x) < REALPART(y)) ? BOOL_T : BOOL_F;
+  }
+  if NINUMP(y) {
+# ifdef BIGDIG
+    ASRTGO(NIMP(y), bady);
+    if BIGP(y) return BIGSIGN(y) ? BOOL_F : BOOL_T;
+#  ifndef RECKLESS
+    if (!(REALP(y)))
+    bady: wta(y, (char *)ARG2, s_lessp);
+#  endif
+# else
+#  ifndef RECKLESS
+    if (!(NIMP(y) && REALP(y)))
+    bady: wta(y, (char *)ARG2, s_lessp);
+#  endif
+# endif
+    return (((double)INUM(x)) < REALPART(y)) ? BOOL_T : BOOL_F;
+  }
+#else
+# ifdef BIGDIG
+  if NINUMP(x) {
+    ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_lessp);
+    if INUMP(y) return BIGSIGN(x) ? BOOL_T : BOOL_F;
+    ASRTGO(NIMP(y) && BIGP(y), bady);
+    return (1==bigcomp(x, y)) ? BOOL_T : BOOL_F;
+  }
+  if NINUMP(y) {
+#  ifndef RECKLESS
+    if (!(NIMP(y) && BIGP(y)))
+    bady: wta(y, (char *)ARG2, s_lessp);
+#  endif
+    return BIGSIGN(y) ? BOOL_F : BOOL_T;
+  }
+# else
+  ASSERT(INUMP(x), x, ARG1, s_lessp);
+  ASSERT(INUMP(y), y, ARG2, s_lessp);
+# endif
+#endif
+  return ((long)x < (long)y) ? BOOL_T : BOOL_F;
+}
+SCM greaterp(x, y)
+     SCM x, y;
+{
+  return lessp(y, x);
+}
+SCM leqp(x, y)
+     SCM x, y;
+{
+  return BOOL_NOT(lessp(y, x));
+}
+SCM greqp(x, y)
+     SCM x, y;
+{
+  return BOOL_NOT(lessp(x, y));
+}
+SCM zerop(z)
+     SCM z;
+{
+#ifdef FLOATS
+  if NINUMP(z) {
+# ifdef BIGDIG
+    ASRTGO(NIMP(z), badz);
+    if BIGP(z) return BOOL_F;
+#  ifndef RECKLESS
+    if (!(INEXP(z)))
+      badz: wta(z, (char *)ARG1, s_zerop);
+#  endif
+# else
+    ASSERT(NIMP(z) && INEXP(z), z, ARG1, s_zerop);
+# endif
+    return (z==flo0) ? BOOL_T : BOOL_F;
+  }
+#else
+# ifdef BIGDIG
+  if NINUMP(z) {
+    ASSERT(NIMP(z) && BIGP(z), z, ARG1, s_zerop);
+    return BOOL_F;
+  }
+# else
+  ASSERT(INUMP(z), z, ARG1, s_zerop);
+# endif
+#endif
+  return (z==INUM0) ? BOOL_T: BOOL_F;
+}
+SCM positivep(x)
+     SCM x;
+{
+#ifdef FLOATS
+  if NINUMP(x) {
+# ifdef BIGDIG
+    ASRTGO(NIMP(x), badx);
+    if BIGP(x) return TYP16(x)==tc16_bigpos ? BOOL_T : BOOL_F;
+#  ifndef RECKLESS
+    if (!(REALP(x)))
+      badx: wta(x, (char *)ARG1, s_positivep);
+#  endif
+# else
+    ASSERT(NIMP(x) && REALP(x), x, ARG1, s_positivep);
+# endif
+    return (REALPART(x) > 0.0) ? BOOL_T : BOOL_F;
+  }
+#else
+# ifdef BIGDIG
+  if NINUMP(x) {
+    ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_positivep);
+    return TYP16(x)==tc16_bigpos ? BOOL_T : BOOL_F;
+  }
+# else
+  ASSERT(INUMP(x), x, ARG1, s_positivep);
+# endif
+#endif
+  return (x > INUM0) ? BOOL_T : BOOL_F;
+}
+SCM negativep(x)
+     SCM x;
+{
+#ifdef FLOATS
+  if NINUMP(x) {
+# ifdef BIGDIG
+    ASRTGO(NIMP(x), badx);
+    if BIGP(x) return TYP16(x)==tc16_bigpos ? BOOL_F : BOOL_T;
+#  ifndef RECKLESS
+    if (!(REALP(x)))
+      badx: wta(x, (char *)ARG1, s_negativep);
+#  endif
+# else
+    ASSERT(NIMP(x) && REALP(x), x, ARG1, s_negativep);
+# endif
+    return (REALPART(x) < 0.0) ? BOOL_T : BOOL_F;
+  }
+#else
+# ifdef BIGDIG
+  if NINUMP(x) {
+    ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_negativep);
+    return (TYP16(x)==tc16_bigneg) ? BOOL_T : BOOL_F;
+  }
+# else
+  ASSERT(INUMP(x), x, ARG1, s_negativep);
+# endif
+#endif
+  return (x < INUM0) ? BOOL_T : BOOL_F;
+}
+
+SCM lmax(x, y)
+     SCM x, y;
+{
+#ifdef FLOATS
+  double z;
+#endif
+  if UNBNDP(y) {
+#ifndef RECKLESS
+    if (!(NUMBERP(x)))
+    badx: wta(x, (char *)ARG1, s_max);
+#endif
+    return x;
+  }
+#ifdef FLOATS
+  if NINUMP(x) {
+# ifdef BIGDIG
+    ASRTGO(NIMP(x), badx);
+    if BIGP(x) {
+      if INUMP(y) return BIGSIGN(x) ? y : x;
+      ASRTGO(NIMP(y), bady);
+      if BIGP(y) return (1==bigcomp(x, y)) ? y : x;
+      ASRTGO(REALP(y), bady);
+      z = big2dbl(x);
+      return (z < REALPART(y)) ? y : makdbl(z, 0.0);
+    }
+    ASRTGO(REALP(x), badx);
+# else
+    ASSERT(NIMP(x) && REALP(x), x, ARG1, s_max);
+# endif
+    if INUMP(y) return (REALPART(x) < (z = INUM(y))) ? makdbl(z, 0.0) : x;
+# ifdef BIGDIG
+    ASRTGO(NIMP(y), bady);
+    if BIGP(y) return (REALPART(x) < (z = big2dbl(y))) ? makdbl(z, 0.0) : x;
+    ASRTGO(REALP(y), bady);
+# else
+    ASRTGO(NIMP(y) && REALP(y), bady);
+# endif
+    return (REALPART(x) < REALPART(y)) ? y : x;
+  }
+  if NINUMP(y) {
+# ifdef BIGDIG
+    ASRTGO(NIMP(y), bady);
+    if BIGP(y) return BIGSIGN(y) ? x : y;
+#  ifndef RECKLESS
+    if (!(REALP(y)))
+    bady: wta(y, (char *)ARG2, s_max);
+#  endif
+# else
+#  ifndef RECKLESS
+    if (!(NIMP(y) && REALP(y)))
+    bady: wta(y, (char *)ARG2, s_max);
+#  endif
+# endif
+    return ((z = INUM(x)) < REALPART(y)) ? y : makdbl(z, 0.0);
+  }
+#else
+# ifdef BIGDIG
+  if NINUMP(x) {
+    ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_max);
+    if INUMP(y) return BIGSIGN(x) ? y : x;
+    ASRTGO(NIMP(y) && BIGP(y), bady);
+    return (1==bigcomp(x, y)) ? y : x;
+  }
+  if NINUMP(y) {
+#  ifndef RECKLESS
+    if (!(NIMP(y) && BIGP(y)))
+    bady: wta(y, (char *)ARG2, s_max);
+#  endif
+    return BIGSIGN(y) ? x : y;
+  }
+# else
+  ASSERT(INUMP(x), x, ARG1, s_max);
+  ASSERT(INUMP(y), y, ARG2, s_max);
+# endif
+#endif
+  return ((long)x < (long)y) ? y : x;
+}
+
+SCM lmin(x, y)
+     SCM x, y;
+{
+#ifdef FLOATS
+  double z;
+#endif
+  if UNBNDP(y) {
+#ifndef RECKLESS
+    if (!(NUMBERP(x)))
+    badx: wta(x, (char *)ARG1, s_min);
+#endif
+    return x;
+  }
+#ifdef FLOATS
+  if NINUMP(x) {
+# ifdef BIGDIG
+    ASRTGO(NIMP(x), badx);
+    if BIGP(x) {
+      if INUMP(y) return BIGSIGN(x) ? x : y;
+      ASRTGO(NIMP(y), bady);
+      if BIGP(y) return (-1==bigcomp(x, y)) ? y : x;
+      ASRTGO(REALP(y), bady);
+      z = big2dbl(x);
+      return (z > REALPART(y)) ? y : makdbl(z, 0.0);
+    }
+    ASRTGO(REALP(x), badx);
+# else
+    ASSERT(NIMP(x) && REALP(x), x, ARG1, s_min);
+# endif
+    if INUMP(y) return (REALPART(x) > (z = INUM(y))) ? makdbl(z, 0.0) : x;
+# ifdef BIGDIG
+    ASRTGO(NIMP(y), bady);
+    if BIGP(y) return (REALPART(x) > (z = big2dbl(y))) ? makdbl(z, 0.0) : x;
+    ASRTGO(REALP(y), bady);
+# else
+    ASRTGO(NIMP(y) && REALP(y), bady);
+# endif
+    return (REALPART(x) > REALPART(y)) ? y : x;
+  }
+  if NINUMP(y) {
+# ifdef BIGDIG
+    ASRTGO(NIMP(y), bady);
+    if BIGP(y) return BIGSIGN(y) ? y : x;
+#  ifndef RECKLESS
+    if (!(REALP(y)))
+    bady: wta(y, (char *)ARG2, s_min);
+#  endif
+# else
+#  ifndef RECKLESS
+    if (!(NIMP(y) && REALP(y)))
+    bady: wta(y, (char *)ARG2, s_min);
+#  endif
+# endif
+    return ((z = INUM(x)) > REALPART(y)) ? y : makdbl(z, 0.0);
+  }
+#else
+# ifdef BIGDIG
+  if NINUMP(x) {
+    ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_min);
+    if INUMP(y) return BIGSIGN(x) ? x : y;
+    ASRTGO(NIMP(y) && BIGP(y), bady);
+    return (-1==bigcomp(x, y)) ? y : x;
+  }
+  if NINUMP(y) {
+#  ifndef RECKLESS
+    if (!(NIMP(y) && BIGP(y)))
+    bady: wta(y, (char *)ARG2, s_min);
+#  endif
+    return BIGSIGN(y) ? y : x;
+  }
+# else
+  ASSERT(INUMP(x), x, ARG1, s_min);
+  ASSERT(INUMP(y), y, ARG2, s_min);
+# endif
+#endif
+  return ((long)x > (long)y) ? y : x;
+}
+
+SCM sum(x, y)
+     SCM x, y;
+{
+  if UNBNDP(y) {
+    if UNBNDP(x) return INUM0;
+#ifndef RECKLESS
+    if (!(NUMBERP(x)))
+    badx: wta(x, (char *)ARG1, s_sum);
+#endif
+    return x;
+  }
+#ifdef FLOATS
+  if NINUMP(x) {
+    SCM t;
+# ifdef BIGDIG
+    ASRTGO(NIMP(x), badx);
+    if BIGP(x) {
+      if INUMP(y) {t = x; x = y; y = t; goto intbig;}
+      ASRTGO(NIMP(y), bady);
+      if BIGP(y) {
+	if (NUMDIGS(x) > NUMDIGS(y)) {t = x; x = y; y = t;}
+	return addbig(BDIGITS(x), NUMDIGS(x), BIGSIGN(x), y, 0);
+      }
+      ASRTGO(INEXP(y), bady);
+    bigreal: return makdbl(big2dbl(x)+REALPART(y), CPLXP(y)?IMAG(y):0.0);
+    }
+    ASRTGO(INEXP(x), badx);
+# else
+    ASRTGO(NIMP(x) && INEXP(x), badx);
+# endif
+    if INUMP(y) {t = x; x = y; y = t; goto intreal;}
+# ifdef BIGDIG
+    ASRTGO(NIMP(y), bady);
+    if BIGP(y) {t = x; x = y; y = t; goto bigreal;}
+#  ifndef RECKLESS
+    else if (!(INEXP(y)))
+    bady: wta(y, (char *)ARG2, s_sum);
+#  endif
+# else
+#  ifndef RECKLESS
+    if (!(NIMP(y) && INEXP(y)))
+    bady: wta(y, (char *)ARG2, s_sum);
+#  endif
+# endif
+    { double i = 0.0;
+      if CPLXP(x) i = IMAG(x);
+      if CPLXP(y) i += IMAG(y);
+      return makdbl(REALPART(x)+REALPART(y), i); }
+  }
+  if NINUMP(y) {
+# ifdef BIGDIG
+    ASRTGO(NIMP(y), bady);
+    if BIGP(y)
+    intbig: {
+#  ifndef DIGSTOOBIG
+      long z = pseudolong(INUM(x));
+      return addbig((BIGDIG *)&z, DIGSPERLONG, (x < 0) ? 0x0100 : 0, y, 0);
+#  else
+      BIGDIG zdigs[DIGSPERLONG];
+      longdigs(INUM(x), zdigs);
+      return addbig(zdigs, DIGSPERLONG, (x < 0) ? 0x0100 : 0, y, 0);
+#  endif
+    }
+    ASRTGO(INEXP(y), bady);
+# else
+    ASRTGO(NIMP(y) && INEXP(y), bady);
+# endif
+  intreal: return makdbl(INUM(x)+REALPART(y), CPLXP(y)?IMAG(y):0.0);
+  }
+#else
+# ifdef BIGDIG
+  if NINUMP(x) {
+    SCM t;
+    ASRTGO(NIMP(x) && BIGP(x), badx);
+    if INUMP(y) {t = x; x = y; y = t; goto intbig;}
+    ASRTGO(NIMP(y) && BIGP(y), bady);
+    if (NUMDIGS(x) > NUMDIGS(y)) {t = x; x = y; y = t;}
+    return addbig(BDIGITS(x), NUMDIGS(x), BIGSIGN(x), y, 0);
+  }
+  if NINUMP(y) {
+#  ifndef RECKLESS
+    if (!(NIMP(y) && BIGP(y)))
+    bady: wta(y, (char *)ARG2, s_sum);
+#  endif
+    intbig: {
+#  ifndef DIGSTOOBIG
+      long z = pseudolong(INUM(x));
+      return addbig(&z, DIGSPERLONG, (x < 0) ? 0x0100 : 0, y, 0);
+#  else
+      BIGDIG zdigs[DIGSPERLONG];
+      longdigs(INUM(x), zdigs);
+      return addbig(zdigs, DIGSPERLONG, (x < 0) ? 0x0100 : 0, y, 0);
+#  endif
+    }
+  }
+# else
+  ASRTGO(INUMP(x), badx);
+  ASSERT(INUMP(y), y, ARG2, s_sum);
+# endif
+#endif
+  x = INUM(x)+INUM(y);
+  if FIXABLE(x) return MAKINUM(x);
+#ifdef BIGDIG
+  return long2big(x);
+#else
+# ifdef FLOATS
+  return makdbl((double)x, 0.0);
+# else
+  wta(y, (char *)OVFLOW, s_sum);
+# endif
+#endif
+}
+
+SCM difference(x, y)
+     SCM x, y;
+{
+#ifdef FLOATS
+  if NINUMP(x) {
+# ifndef RECKLESS
+    if (!(NIMP(x)))
+    badx: wta(x, (char *)ARG1, s_difference);
+# endif
+    if UNBNDP(y) {
+# ifdef BIGDIG
+      if BIGP(x) {
+	x = copybig(x, !BIGSIGN(x));
+	return NUMDIGS(x) * BITSPERDIG/CHAR_BIT <= sizeof(SCM) ?
+	  big2inum(x, NUMDIGS(x)) : x;
+      }
+# endif
+      ASRTGO(INEXP(x), badx);
+      return makdbl(-REALPART(x), CPLXP(x)?-IMAG(x):0.0);
+    }
+    if INUMP(y) return sum(x, MAKINUM(-INUM(y)));
+# ifdef BIGDIG
+    ASRTGO(NIMP(y), bady);
+    if BIGP(x) {
+      if BIGP(y) return (NUMDIGS(x) < NUMDIGS(y)) ?
+		   addbig(BDIGITS(x), NUMDIGS(x), BIGSIGN(x), y, 0x0100) :
+		   addbig(BDIGITS(y), NUMDIGS(y), BIGSIGN(y) ^ 0x0100, x, 0);
+      ASRTGO(INEXP(y), bady);
+      return makdbl(big2dbl(x)-REALPART(y), CPLXP(y)?-IMAG(y):0.0);
+    }
+    ASRTGO(INEXP(x), badx);
+    if BIGP(y) return makdbl(REALPART(x)-big2dbl(y), CPLXP(x)?IMAG(x):0.0);
+    ASRTGO(INEXP(y), bady);
+# else
+    ASRTGO(INEXP(x), badx);
+    ASRTGO(NIMP(y) && INEXP(y), bady);
+# endif
+    if CPLXP(x)
+      if CPLXP(y)
+	return makdbl(REAL(x)-REAL(y), IMAG(x)-IMAG(y));
+      else
+	return makdbl(REAL(x)-REALPART(y), IMAG(x));
+    return makdbl(REALPART(x)-REALPART(y), CPLXP(y)?-IMAG(y):0.0);
+  }
+  if UNBNDP(y) {x = -INUM(x); goto checkx;}
+  if NINUMP(y) {
+# ifdef BIGDIG
+    ASRTGO(NIMP(y), bady);
+    if BIGP(y) {
+#  ifndef DIGSTOOBIG
+      long z = pseudolong(INUM(x));
+      return addbig((BIGDIG *)&z, DIGSPERLONG, (x < 0) ? 0x0100 : 0, y, 0x0100);
+#  else
+      BIGDIG zdigs[DIGSPERLONG];
+      longdigs(INUM(x), zdigs);
+      return addbig(zdigs, DIGSPERLONG, (x < 0) ? 0x0100 : 0, y, 0x0100);
+#  endif
+    }
+#  ifndef RECKLESS
+    if (!(INEXP(y)))
+    bady: wta(y, (char *)ARG2, s_difference);
+#  endif
+# else
+#  ifndef RECKLESS
+    if (!(NIMP(y) && INEXP(y)))
+    bady: wta(y, (char *)ARG2, s_difference);
+#  endif
+# endif
+    return makdbl(INUM(x)-REALPART(y), CPLXP(y)?-IMAG(y):0.0);
+  }
+#else
+# ifdef BIGDIG
+  if NINUMP(x) {
+    ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_difference);
+    if UNBNDP(y) {
+      x = copybig(x, !BIGSIGN(x));
+      return NUMDIGS(x) * BITSPERDIG/CHAR_BIT <= sizeof(SCM) ?
+		big2inum(x, NUMDIGS(x)) : x;
+    }
+    if INUMP(y) {
+#  ifndef DIGSTOOBIG
+      long z = pseudolong(INUM(y));
+      return addbig(&z, DIGSPERLONG, (y < 0) ? 0 : 0x0100, x, 0);
+#  else
+      BIGDIG zdigs[DIGSPERLONG];
+      longdigs(INUM(x), zdigs);
+      return addbig(zdigs, DIGSPERLONG, (y < 0) ? 0 : 0x0100, x, 0);
+#  endif
+    }
+    ASRTGO(NIMP(y) && BIGP(y), bady);
+    return (NUMDIGS(x) < NUMDIGS(y)) ?
+		   addbig(BDIGITS(x), NUMDIGS(x), BIGSIGN(x), y, 0x0100) :
+		   addbig(BDIGITS(y), NUMDIGS(y), BIGSIGN(y) ^ 0x0100, x, 0);
+  }
+  if UNBNDP(y) {x = -INUM(x); goto checkx;}
+  if NINUMP(y) {
+#  ifndef RECKLESS
+    if (!(NIMP(y) && BIGP(y)))
+    bady: wta(y, (char *)ARG2, s_difference);
+#  endif
+    {
+#  ifndef DIGSTOOBIG
+      long z = pseudolong(INUM(x));
+      return addbig(&z, DIGSPERLONG, (x < 0) ? 0x0100 : 0, y, 0x0100);
+#  else
+      BIGDIG zdigs[DIGSPERLONG];
+      longdigs(INUM(x), zdigs);
+      return addbig(zdigs, DIGSPERLONG, (x < 0) ? 0x0100 : 0, y, 0x0100);
+#  endif
+    }
+  }
+# else
+  ASSERT(INUMP(x), x, ARG1, s_difference);
+  if UNBNDP(y) {x = -INUM(x); goto checkx;}
+  ASSERT(INUMP(y), y, ARG2, s_difference);
+# endif
+#endif
+  x = INUM(x)-INUM(y);
+ checkx:
+  if FIXABLE(x) return MAKINUM(x);
+#ifdef BIGDIG
+  return long2big(x);
+#else
+# ifdef FLOATS
+  return makdbl((double)x, 0.0);
+# else
+  wta(y, (char *)OVFLOW, s_difference);
+# endif
+#endif
+}
+
+SCM product(x, y)
+     SCM x, y;
+{
+  if UNBNDP(y) {
+    if UNBNDP(x) return MAKINUM(1L);
+#ifndef RECKLESS
+    if (!(NUMBERP(x)))
+    badx: wta(x, (char *)ARG1, s_product);
+#endif
+    return x;
+  }
+#ifdef FLOATS
+  if NINUMP(x) {
+    SCM t;
+# ifdef BIGDIG
+    ASRTGO(NIMP(x), badx);
+    if BIGP(x) {
+      if INUMP(y) {t = x; x = y; y = t; goto intbig;}
+      ASRTGO(NIMP(y), bady);
+      if BIGP(y) return mulbig(BDIGITS(x), NUMDIGS(x), BDIGITS(y), NUMDIGS(y),
+			       BIGSIGN(x) ^ BIGSIGN(y));
+      ASRTGO(INEXP(y), bady);
+    bigreal: {
+      double bg = big2dbl(x);
+      return makdbl(bg*REALPART(y), CPLXP(y)?bg*IMAG(y):0.0); }
+    }
+    ASRTGO(INEXP(x), badx);
+# else
+    ASRTGO(NIMP(x) && INEXP(x), badx);
+# endif
+    if INUMP(y) {t = x; x = y; y = t; goto intreal;}
+# ifdef BIGDIG
+    ASRTGO(NIMP(y), bady);
+    if BIGP(y) {t = x; x = y; y = t; goto bigreal;}
+#  ifndef RECKLESS
+    else if (!(INEXP(y)))
+    bady: wta(y, (char *)ARG2, s_product);
+#  endif
+# else
+#  ifndef RECKLESS
+    if (!(NIMP(y) && INEXP(y)))
+    bady: wta(y, (char *)ARG2, s_product);
+#  endif
+# endif
+    if CPLXP(x)
+      if CPLXP(y)
+	return makdbl(REAL(x)*REAL(y)-IMAG(x)*IMAG(y),
+		      REAL(x)*IMAG(y)+IMAG(x)*REAL(y));
+      else
+	return makdbl(REAL(x)*REALPART(y), IMAG(x)*REALPART(y));
+    return makdbl(REALPART(x)*REALPART(y),
+		  CPLXP(y)?REALPART(x)*IMAG(y):0.0);
+  }
+  if NINUMP(y) {
+# ifdef BIGDIG
+    ASRTGO(NIMP(y), bady);
+    if BIGP(y) {
+    intbig: if (INUM0==x) return x; if (MAKINUM(1L)==x) return y;
+      {
+#  ifndef DIGSTOOBIG
+	long z = pseudolong(INUM(x));
+	return mulbig((BIGDIG *)&z, DIGSPERLONG, BDIGITS(y), NUMDIGS(y),
+		      BIGSIGN(y) ? (x>0) : (x<0));
+#  else
+	BIGDIG zdigs[DIGSPERLONG];
+	longdigs(INUM(x), zdigs);
+	return mulbig(zdigs, DIGSPERLONG, BDIGITS(y), NUMDIGS(y),
+		      BIGSIGN(y) ? (x>0) : (x<0));
+#  endif
+      }
+    }
+    ASRTGO(INEXP(y), bady);
+# else
+    ASRTGO(NIMP(y) && INEXP(y), bady);
+# endif
+  intreal: return makdbl(INUM(x)*REALPART(y), CPLXP(y)?INUM(x)*IMAG(y):0.0);
+  }
+#else
+# ifdef BIGDIG
+  if NINUMP(x) {
+    ASRTGO(NIMP(x) && BIGP(x), badx);
+    if INUMP(y) {SCM t = x; x = y; y = t; goto intbig;}
+    ASRTGO(NIMP(y) && BIGP(y), bady);
+    return mulbig(BDIGITS(x), NUMDIGS(x), BDIGITS(y), NUMDIGS(y),
+		  BIGSIGN(x) ^ BIGSIGN(y));
+  }
+  if NINUMP(y) {
+#  ifndef RECKLESS
+    if (!(NIMP(y) && BIGP(y)))
+    bady: wta(y, (char *)ARG2, s_product);
+#  endif
+  intbig: if (INUM0==x) return x; if (MAKINUM(1L)==x) return y;
+    {
+#  ifndef DIGSTOOBIG
+      long z = pseudolong(INUM(x));
+      return mulbig(&z, DIGSPERLONG, BDIGITS(y), NUMDIGS(y),
+		    BIGSIGN(y) ? (x>0) : (x<0));
+#  else
+      BIGDIG zdigs[DIGSPERLONG];
+      longdigs(INUM(x), zdigs);
+      return mulbig(zdigs, DIGSPERLONG, BDIGITS(y), NUMDIGS(y),
+		    BIGSIGN(y) ? (x>0) : (x<0));
+#  endif
+    }
+  }
+# else
+  ASRTGO(INUMP(x), badx);
+  ASSERT(INUMP(y), y, ARG2, s_product);
+# endif
+#endif
+  {
+    long i, j, k;
+    i = INUM(x);
+    if (0==i) return x;
+    j = INUM(y);
+    k = i * j;
+    y = MAKINUM(k);
+    if (k != INUM(y) || k/i != j)
+#ifdef BIGDIG
+      { int sgn = (i < 0) ^ (j < 0);
+# ifndef DIGSTOOBIG
+	i = pseudolong(i);
+	j = pseudolong(j);
+	return mulbig((BIGDIG *)&i, DIGSPERLONG,
+		      (BIGDIG *)&j, DIGSPERLONG, sgn);
+# else /* DIGSTOOBIG */
+	BIGDIG idigs[DIGSPERLONG];
+	BIGDIG jdigs[DIGSPERLONG];
+	longdigs(i, idigs);
+	longdigs(j, jdigs);
+	return mulbig(idigs, DIGSPERLONG, jdigs, DIGSPERLONG, sgn);
+# endif
+      }
+#else
+# ifdef FLOATS
+    return makdbl(((double)i)*((double)j), 0.0);
+# else
+    wta(y, (char *)OVFLOW, s_product);
+# endif
+#endif
+    return y;
+  }
+}
+
+SCM divide(x, y)
+     SCM x, y;
+{
+#ifdef FLOATS
+  double d, r, i, a;
+  if NINUMP(x) {
+# ifndef RECKLESS
+    if (!(NIMP(x)))
+    badx: wta(x, (char *)ARG1, s_divide);
+# endif
+    if UNBNDP(y) {
+# ifdef BIGDIG
+      if BIGP(x) return makdbl(1.0/big2dbl(x), 0.0);
+# endif
+      ASRTGO(INEXP(x), badx);
+      if REALP(x) return makdbl(1.0/REALPART(x), 0.0);
+      r = REAL(x);  i = IMAG(x);  d = r*r+i*i;
+      return makdbl(r/d, -i/d);
+    }
+# ifdef BIGDIG
+    if BIGP(x) {
+      SCM z;
+      if INUMP(y) {
+        z = INUM(y);
+        ASSERT(z, y, OVFLOW, s_divide);
+	if (1==z) return x;
+        if (z < 0) z = -z;
+        if (z < BIGRAD) {
+          SCM w = copybig(x, BIGSIGN(x) ? (y>0) : (y<0));
+          return divbigdig(BDIGITS(w), NUMDIGS(w), (BIGDIG)z) ?
+	    makdbl(big2dbl(x)/INUM(y), 0.0) : normbig(w);
+	}
+#  ifndef DIGSTOOBIG
+        z = pseudolong(z);
+        z = divbigbig(BDIGITS(x), NUMDIGS(x), (BIGDIG *)&z, DIGSPERLONG,
+                      BIGSIGN(x) ? (y>0) : (y<0), 3);
+#  else
+	{ BIGDIG zdigs[DIGSPERLONG];
+	  longdigs(z, zdigs);
+	  z = divbigbig(BDIGITS(x), NUMDIGS(x), zdigs, DIGSPERLONG,
+			BIGSIGN(x) ? (y>0) : (y<0), 3);}
+#  endif
+        return z ? z : makdbl(big2dbl(x)/INUM(y), 0.0);
+      }
+      ASRTGO(NIMP(y), bady);
+      if BIGP(y) {
+	z = divbigbig(BDIGITS(x), NUMDIGS(x), BDIGITS(y), NUMDIGS(y),
+		      BIGSIGN(x) ^ BIGSIGN(y), 3);
+	return z ? z : makdbl(big2dbl(x)/big2dbl(y), 0.0);
+      }
+      ASRTGO(INEXP(y), bady);
+      if REALP(y) return makdbl(big2dbl(x)/REALPART(y), 0.0);
+      a = big2dbl(x);
+      goto complex_div;
+    }
+# endif
+    ASRTGO(INEXP(x), badx);
+    if INUMP(y) {d = INUM(y); goto basic_div;}
+# ifdef BIGDIG
+    ASRTGO(NIMP(y), bady);
+    if BIGP(y) {d = big2dbl(y); goto basic_div;}
+    ASRTGO(INEXP(y), bady);
+# else
+    ASRTGO(NIMP(y) && INEXP(y), bady);
+# endif
+    if REALP(y) {
+      d = REALPART(y);
+    basic_div: return makdbl(REALPART(x)/d, CPLXP(x)?IMAG(x)/d:0.0);
+    }
+    a = REALPART(x);
+    if REALP(x) goto complex_div;
+    r = REAL(y);  i = IMAG(y);  d = r*r+i*i;
+    return makdbl((a*r+IMAG(x)*i)/d, (IMAG(x)*r-a*i)/d);
+  }
+  if UNBNDP(y) {
+    if ((MAKINUM(1L)==x) || (MAKINUM(-1L)==x)) return x;
+    return makdbl(1.0/((double)INUM(x)), 0.0);
+  }
+  if NINUMP(y) {
+# ifdef BIGDIG
+    ASRTGO(NIMP(y), bady);
+    if BIGP(y) return makdbl(INUM(x)/big2dbl(y), 0.0);
+#  ifndef RECKLESS
+    if (!(INEXP(y)))
+    bady: wta(y, (char *)ARG2, s_divide);
+#  endif
+# else
+#  ifndef RECKLESS
+    if (!(NIMP(y) && INEXP(y)))
+    bady: wta(y, (char *)ARG2, s_divide);
+#  endif
+# endif
+    if REALP(y) return makdbl(INUM(x)/REALPART(y), 0.0);
+    a = INUM(x);
+  complex_div:
+    r = REAL(y);  i = IMAG(y);  d = r*r+i*i;
+    return makdbl((a*r)/d, (-a*i)/d);
+  }
+#else
+# ifdef BIGDIG
+  if NINUMP(x) {
+    SCM z;
+    ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_divide);
+    if UNBNDP(y) goto ov;
+    if INUMP(y) {
+      z = INUM(y);
+      if (!z) goto ov;
+      if (1==z) return x;
+      if (z < 0) z = -z;
+      if (z < BIGRAD) {
+        SCM w = copybig(x, BIGSIGN(x) ? (y>0) : (y<0));
+        if (divbigdig(BDIGITS(w), NUMDIGS(w), (BIGDIG)z)) goto ov;
+        return w;
+      }
+#  ifndef DIGSTOOBIG
+      z = pseudolong(z);
+      z = divbigbig(BDIGITS(x), NUMDIGS(x), &z, DIGSPERLONG,
+		    BIGSIGN(x) ? (y>0) : (y<0), 3);
+#  else
+      { BIGDIG zdigs[DIGSPERLONG];
+	longdigs(z, zdigs);
+	z = divbigbig(BDIGITS(x), NUMDIGS(x), zdigs, DIGSPERLONG,
+		      BIGSIGN(x) ? (y>0) : (y<0), 3);}
+#  endif
+    } else {
+      ASRTGO(NIMP(y) && BIGP(y), bady);
+      z = divbigbig(BDIGITS(x), NUMDIGS(x), BDIGITS(y), NUMDIGS(y),
+		    BIGSIGN(x) ^ BIGSIGN(y), 3);
+    }
+    if (!z) goto ov;
+    return z;
+  }
+  if UNBNDP(y) {
+    if ((MAKINUM(1L)==x) || (MAKINUM(-1L)==x)) return x;
+    goto ov;
+  }
+  if NINUMP(y) {
+#  ifndef RECKLESS
+    if (!(NIMP(y) && BIGP(y)))
+    bady: wta(y, (char *)ARG2, s_divide);
+#  endif
+    goto ov;
+  }
+# else
+  ASSERT(INUMP(x), x, ARG1, s_divide);
+  if UNBNDP(y) {
+    if ((MAKINUM(1L)==x) || (MAKINUM(-1L)==x)) return x;
+    goto ov;
+  }
+  ASSERT(INUMP(y), y, ARG2, s_divide);
+# endif
+#endif
+  {
+    long z = INUM(y);
+    if ((0==z) || INUM(x)%z) goto ov;
+    z = INUM(x)/z;
+    if FIXABLE(z) return MAKINUM(z);
+#ifdef BIGDIG
+    return long2big(z);
+#endif
+#ifdef FLOATS
+  ov: return makdbl(((double)INUM(x))/((double)INUM(y)), 0.0);
+#else
+  ov: wta(x, (char *)OVFLOW, s_divide);
+#endif
+  }
+}
+
+#ifdef FLOATS
+double lasinh(x)
+     double x;
+{
+  return log(x+sqrt(x*x+1));
+}
+
+double lacosh(x)
+     double x;
+{
+  return log(x+sqrt(x*x-1));
+}
+
+double latanh(x)
+     double x;
+{
+  return 0.5*log((1+x)/(1-x));
+}
+
+double ltrunc(x)
+     double x;
+{
+  if (x < 0.0) return -floor(-x);
+  return floor(x);
+}
+double round(x)
+     double x;
+{
+  double plus_half = x + 0.5;
+  double result = floor(plus_half);
+  /* Adjust so that the round is towards even.  */
+  return (plus_half==result && plus_half / 2 != floor(plus_half / 2))
+    ? result - 1 : result;
+}
+
+struct dpair {double x, y;};
+
+void two_doubles(z1, z2, sstring, xy)
+     SCM z1, z2;
+     char *sstring;
+     struct dpair *xy;
+{
+  if INUMP(z1) xy->x = INUM(z1);
+  else {
+# ifdef BIGDIG
+    ASRTGO(NIMP(z1), badz1);
+    if BIGP(z1) xy->x = big2dbl(z1);
+    else {
+#  ifndef RECKLESS
+      if (!(REALP(z1)))
+      badz1: wta(z1, (char *)ARG1, sstring);
+#  endif
+      xy->x = REALPART(z1);}
+# else
+    {ASSERT(NIMP(z1) && REALP(z1), z1, ARG1, sstring);
+     xy->x = REALPART(z1);}
+# endif
+  }
+  if INUMP(z2) xy->y = INUM(z2);
+  else {
+# ifdef BIGDIG
+    ASRTGO(NIMP(z2), badz2);
+    if BIGP(z2) xy->y = big2dbl(z2);
+    else {
+#  ifndef RECKLESS
+      if (!(REALP(z2)))
+      badz2: wta(z2, (char *)ARG2, sstring);
+#  endif
+      xy->y = REALPART(z2);}
+# else
+    {ASSERT(NIMP(z2) && REALP(z2), z2, ARG2, sstring);
+     xy->y = REALPART(z2);}
+# endif
+  }
+}
+
+SCM expt(z1, z2)
+     SCM z1, z2;
+{
+  struct dpair xy;
+  two_doubles(z1, z2, s_expt, &xy);
+  return makdbl(pow(xy.x, xy.y), 0.0);
+}
+SCM latan2(z1, z2)
+     SCM z1, z2;
+{
+  struct dpair xy;
+  two_doubles(z1, z2, s_atan2, &xy);
+  return makdbl(atan2(xy.x, xy.y), 0.0);
+}
+SCM makrect(z1, z2)
+     SCM z1, z2;
+{
+  struct dpair xy;
+  two_doubles(z1, z2, s_makrect, &xy);
+  return makdbl(xy.x, xy.y);
+}
+SCM makpolar(z1, z2)
+     SCM z1, z2;
+{
+  struct dpair xy;
+  two_doubles(z1, z2, s_makpolar, &xy);
+  return makdbl(xy.x*cos(xy.y), xy.x*sin(xy.y));
+}
+
+SCM real_part(z)
+     SCM z;
+{
+  if NINUMP(z) {
+# ifdef BIGDIG
+    ASRTGO(NIMP(z), badz);
+    if BIGP(z) return z;
+#  ifndef RECKLESS
+    if (!(INEXP(z)))
+    badz: wta(z, (char *)ARG1, s_real_part);
+#  endif
+# else
+    ASSERT(NIMP(z) && INEXP(z), z, ARG1, s_real_part);
+# endif
+    if CPLXP(z) return makdbl(REAL(z), 0.0);
+  }
+  return z;
+}
+SCM imag_part(z)
+     SCM z;
+{
+  if INUMP(z) return INUM0;
+# ifdef BIGDIG
+  ASRTGO(NIMP(z), badz);
+  if BIGP(z) return INUM0;
+#  ifndef RECKLESS
+  if (!(INEXP(z)))
+  badz: wta(z, (char *)ARG1, s_imag_part);
+#  endif
+# else
+  ASSERT(NIMP(z) && INEXP(z), z, ARG1, s_imag_part);
+# endif
+  if CPLXP(z) return makdbl(IMAG(z), 0.0);
+  return flo0;
+}
+SCM magnitude(z)
+     SCM z;
+{
+  if INUMP(z) return absval(z);
+# ifdef BIGDIG
+  ASRTGO(NIMP(z), badz);
+  if BIGP(z) return absval(z);
+#  ifndef RECKLESS
+  if (!(INEXP(z)))
+  badz: wta(z, (char *)ARG1, s_magnitude);
+#  endif
+# else
+  ASSERT(NIMP(z) && INEXP(z), z, ARG1, s_magnitude);
+# endif
+  if CPLXP(z)
+    {
+      double i = IMAG(z), r = REAL(z);
+      return makdbl(sqrt(i*i+r*r), 0.0);
+    }
+  return makdbl(fabs(REALPART(z)), 0.0);
+}
+
+SCM angle(z)
+     SCM z;
+{
+  double x, y = 0.0;
+  if INUMP(z) {x = (z>=INUM0) ? 1.0 : -1.0; goto do_angle;}
+# ifdef BIGDIG
+  ASRTGO(NIMP(z), badz);
+  if BIGP(z) {x = (TYP16(z)==tc16_bigpos) ? 1.0 : -1.0; goto do_angle;}
+#  ifndef RECKLESS
+  if (!(INEXP(z))) {
+    badz: wta(z, (char *)ARG1, s_angle);}
+#  endif
+# else
+  ASSERT(NIMP(z) && INEXP(z), z, ARG1, s_angle);
+# endif
+  if REALP(z) {x = REALPART(z); goto do_angle;}
+  x = REAL(z); y = IMAG(z);
+do_angle:
+  return makdbl(atan2(y, x), 0.0);
+}
+
+double floident(z)
+     double z;
+{
+  return z;
+}
+SCM in2ex(z)
+     SCM z;
+{
+  if INUMP(z) return z;
+# ifdef BIGDIG
+  ASRTGO(NIMP(z), badz);
+  if BIGP(z) return z;
+#  ifndef RECKLESS
+  if (!(REALP(z)))
+    badz: wta(z, (char *)ARG1, s_in2ex);
+#  endif
+# else
+  ASSERT(NIMP(z) && REALP(z), z, ARG1, s_in2ex);
+# endif
+# ifdef BIGDIG
+  {
+    double u = floor(REALPART(z)+0.5);
+    if ((u <= MOST_POSITIVE_FIXNUM) && (-u <= -MOST_NEGATIVE_FIXNUM)) {
+      /* Negation is a workaround for HP700 cc bug */
+      SCM ans = MAKINUM((long)u);
+      if (INUM(ans)==(long)u) return ans;
+    }
+    ASRTGO(!IS_INF(u), badz);	/* problem? */
+    return dbl2big(u);
+  }
+# else
+  return MAKINUM((long)floor(REALPART(z)+0.5));
+# endif
+}
+#else				/* ~FLOATS */
+static char s_trunc[] = "truncate";
+SCM numident(x)
+     SCM x;
+{
+  ASSERT(INUMP(x), x, ARG1, s_trunc);
+  return x;
+}
+#endif				/* FLOATS */
+
+#ifdef BIGDIG
+# ifdef FLOATS
+SCM dbl2big(d)
+     double d;			/* must be integer */
+{
+  sizet i = 0;
+  long c;
+  BIGDIG *digits;
+  SCM ans;
+  double u = (d < 0)?-d:d;
+  while (0 != floor(u)) {u /= BIGRAD;i++;}
+  ans = mkbig(i, d < 0);
+  digits = BDIGITS(ans);
+  while (i--) {
+    u *= BIGRAD;
+    c = floor(u);
+    u -= c;
+    digits[i] = c;
+  }
+  ASSERT(0==u, INUM0, OVFLOW, "dbl2big");
+  return ans;
+}
+double big2dbl(b)
+     SCM b;
+{
+  double ans = 0.0;
+  sizet i = NUMDIGS(b);
+  BIGDIG *digits = BDIGITS(b);
+  while (i--) ans = digits[i] + BIGRAD*ans;
+  if (tc16_bigneg==TYP16(b)) return -ans;
+  return ans;
+}
+# endif
+#endif
+
+unsigned long hasher(obj, n, d)
+     SCM obj;
+     unsigned long n;
+     sizet d;
+{
+  switch (7 & (int) obj) {
+  case 2: case 6:		/* INUMP(obj) */
+    return INUM(obj) % n;
+  case 4:
+    if ICHRP(obj)
+      return (unsigned)(downcase[ICHR(obj)]) % n;
+    switch ((int) obj) {
+#ifndef SICP
+    case (int) EOL: d = 256; break;
+#endif
+    case (int) BOOL_T: d = 257; break;
+    case (int) BOOL_F: d = 258; break;
+    case (int) EOF_VAL: d = 259; break;
+    default: d = 263;		/* perhaps should be error */
+    }
+    return d % n;
+  default: return 263 % n;	/* perhaps should be error */
+  case 0:
+    switch TYP7(obj) {
+    default: return 263 % n;
+    case tc7_smob:
+      switch TYP16(obj) {
+      case tcs_bignums:
+      bighash: return INUM(modulo(obj, MAKINUM(n)));
+      default: return 263 % n;
+#ifdef FLOATS
+      case tc16_flo:
+	if REALP(obj) {
+	  double r = REALPART(obj);
+	  if (floor(r)==r) {
+	    obj = in2ex(obj);
+	    if IMP(obj) return INUM(obj) % n;
+	    goto bighash;
+	  }
+	}
+	obj = number2string(obj, MAKINUM(10));
+#endif
+      }
+    case tcs_symbols: case tc7_string:
+      return strhash(UCHARS(obj), (sizet) LENGTH(obj), n);
+    case tc7_vector: {
+      sizet len = LENGTH(obj);
+      SCM *data = VELTS(obj);
+      if (len>5) {
+	sizet i = d/2;
+	unsigned long h = 1;
+	while (i--) h = ((h<<8) + (hasher(data[h % len], n, 2))) % n;
+	return h;
+      }
+      else {
+	sizet i = len;
+	unsigned long h = (n)-1;
+	while (i--) h = ((h<<8) + (hasher(data[i], n, d/len))) % n;
+	return h;
+      }
+    }
+    case tcs_cons_imcar: case tcs_cons_nimcar:
+      if (d) return (hasher(CAR(obj), n, d/2)+hasher(CDR(obj), n, d/2)) % n;
+      else return 1;
+    case tc7_port:
+      return ((RDNG & CAR(obj)) ? 260 : 261) % n;
+    case tcs_closures: case tc7_contin: case tcs_subrs:
+      return 262 % n;
+    }
+  }
+}
+
+static char s_hashv[] = "hashv", s_hashq[] = "hashq";
+extern char s_obunhash[];
+#define s_hash (&s_obunhash[9])
+
+SCM hash(obj, n)
+     SCM obj;
+     SCM n;
+{
+  ASSERT(INUMP(n) && 0 <= n, n, ARG2, s_hash);
+  return MAKINUM(hasher(obj, INUM(n), 10));
+}
+
+SCM hashv(obj, n)
+     SCM obj;
+     SCM n;
+{
+  ASSERT(INUMP(n) && 0 <= n, n, ARG2, s_hashv);
+  if ICHRP(obj) return MAKINUM((unsigned)(downcase[ICHR(obj)]) % INUM(n));
+  if (NIMP(obj) && NUMP(obj)) return MAKINUM(hasher(obj, INUM(n), 10));
+  else return MAKINUM(obj % INUM(n));
+}
+
+SCM hashq(obj, n)
+     SCM obj;
+     SCM n;
+{
+  ASSERT(INUMP(n) && 0 <= n, n, ARG2, s_hashq);
+  return MAKINUM((((unsigned) obj) >> 1) % INUM(n));
+}
+
+static iproc subr1s[] = {
+	{"number?", numberp},
+	{"complex?", numberp},
+	{s_inexactp, inexactp},
+#ifdef FLOATS
+	{"real?", realp},
+	{"rational?", realp},
+	{"integer?", intp},
+	{s_real_part, real_part},
+	{s_imag_part, imag_part},
+	{s_magnitude, magnitude},
+	{s_angle, angle},
+	{s_in2ex, in2ex},
+#else
+	{"real?", numberp},
+	{"rational?", numberp},
+	{"integer?", exactp},
+	{"floor", numident},
+	{"ceiling", numident},
+	{s_trunc, numident},
+	{"round", numident},
+#endif
+	{s_zerop, zerop},
+	{s_positivep, positivep},
+	{s_negativep, negativep},
+	{s_str2list, string2list},
+	{"list->string", string},
+	{s_st_copy, string_copy},
+	{"list->vector", vector},
+	{s_vect2list, vector2list},
+	{0, 0}};
+
+static iproc asubrs[] = {
+	{s_difference, difference},
+	{s_divide, divide},
+	{s_max, lmax},
+	{s_min, lmin},
+	{s_sum, sum},
+	{s_product, product},
+	{0, 0}};
+
+static iproc subr2s[] = {
+#ifdef FLOATS
+	{s_makrect, makrect},
+	{s_makpolar, makpolar},
+	{s_memv, memv},
+	{s_assv, assv},
+	{s_atan2, latan2},
+	{s_expt, expt},
+#else
+	{"memv", memq},
+	{"assv", assq},
+#endif
+	{s_list_tail, list_tail},
+	{s_ve_fill, vector_fill},
+	{s_st_fill, string_fill},
+	{s_hash, hash},
+	{s_hashv, hashv},
+	{s_hashq, hashq},
+	{0, 0}};
+
+static iproc subr2os[] = {
+	{s_str2number, string2number},
+	{s_number2string, number2string},
+	{0, 0}};
+
+static iproc rpsubrs[] = {
+#ifdef FLOATS
+	{"eqv?", eqv},
+#else
+	{"eqv?", eq},
+#endif
+	{s_eqp, eqp},
+	{s_lessp, lessp},
+	{s_grp, greaterp},
+	{s_leqp, leqp},
+	{s_greqp, greqp},
+	{0, 0}};
+
+#ifdef FLOATS
+static dblproc cxrs[] = {
+	{"floor", floor},
+	{"ceiling", ceil},
+	{"truncate", ltrunc},
+	{"round", round},
+	{"$sqrt", sqrt},
+	{"$abs", fabs},
+	{"$exp", exp},
+	{"$log", log},
+	{"$sin", sin},
+	{"$cos", cos},
+	{"$tan", tan},
+	{"$asin", asin},
+	{"$acos", acos},
+	{"$atan", atan},
+	{"$sinh", sinh},
+	{"$cosh", cosh},
+	{"$tanh", tanh},
+	{"$asinh", lasinh},
+	{"$acosh", lacosh},
+	{"$atanh", latanh},
+	{"exact->inexact", floident},
+	{0, 0}};
+#endif
+
+#ifdef FLOATS
+# ifndef DBL_DIG
+static void add1(f, fsum)
+     double f, *fsum;
+{
+  *fsum = f + 1.0;
+}
+# endif
+#endif
+
+void init_scl()
+{
+  init_iprocs(subr1s, tc7_subr_1);
+  init_iprocs(subr2os, tc7_subr_2o);
+  init_iprocs(subr2s, tc7_subr_2);
+  init_iprocs(asubrs, tc7_asubr);
+  init_iprocs(rpsubrs, tc7_rpsubr);
+#ifdef SICP
+  add_feature("sicp");
+#endif
+#ifdef FLOATS
+  init_iprocs((iproc *)cxrs, tc7_cxr);
+  NEWCELL(flo0);
+# ifdef SINGLES
+  CAR(flo0) = tc_flo;
+  FLO(flo0) = 0.0;
+# else
+  CDR(flo0) = (SCM)must_malloc(1L*sizeof(double), "real");
+  REAL(flo0) = 0.0;
+  CAR(flo0) = tc_dblr;
+# endif
+# ifdef DBL_DIG
+  dblprec = (DBL_DIG > 20) ? 20 : DBL_DIG;
+# else
+  {				/* determine floating point precision */
+    double f = 0.1;
+    double fsum = 1.0+f;
+    while (fsum != 1.0) {
+      f /= 10.0;
+      if (++dblprec > 20) break;
+      add1(f, &fsum);
+    }
+    dblprec = dblprec-1;
+  }
+# endif /* DBL_DIG */
+#endif
+}
diff --git a/scm.1 b/scm.1
new file mode 100644
index 0000000..d536061
--- /dev/null
+++ b/scm.1
@@ -0,0 +1,335 @@
+.\" dummy line
+.TH SCM "Jan 9 1995"
+.UC 4
+.SH NAME
+scm \- a Scheme Language Interpreter
+.SH SYNOPSIS
+.B scm
+[-a
+.I kbytes
+]
+[-ibvqmu]
+[-p
+.I number
+]
+[-c
+.I expression
+]
+[-e
+.I expression
+]
+[-f
+.I filename
+]
+[-l
+.I filename
+]
+[-d
+.I filename
+]
+[-r
+.I feature
+]
+[-- | - | -s]
+[filename] [arguments ...]
+.br
+.sp 0.3
+.SH DESCRIPTION
+.I Scm
+is a Scheme interpreter.
+.PP
+Upon startup
+.I scm
+loads the file specified by by the environment variable SCM_INIT_PATH
+or by the parameter IMPLINIT in the makefile (or scmfig.h) if
+SCM_INIT_PATH is not defined.  The makefiles attempt to set IMPLINIT
+to "Init.scm" in the source directory.
+
+Unless the option
+.I -no-init-file
+occurs in the command line, "Init.scm" checks to see if there is file
+"ScmInit.scm" in the path specified by the environment variable HOME
+(or in the current directory if HOME is undefined).  If it finds such
+a file it is loaded.
+
+"Init.scm" then looks for command input from one of three sources:
+From an option on the command line, from a file named on the command
+line, or from standard input.
+
+.SH OPTIONS
+The options are processed in the order specified on the command line.
+.TP 5
+.BI -a kbytes
+specifies that
+.I scm
+should allocate an initial heapsize of
+.I kbytes.
+This option, if present, must be the first on the command line.
+.TP
+.BI -no-init-file
+Inhibits the loading of "ScmInit.scm" as described above.
+.TP
+.BI -e expression
+.TP
+.BI -c expression
+specifies that the scheme expression
+.I expression
+is to be evaluated.  These options are inspired by
+.I perl
+and
+.I sh
+respectively.
+On Amiga systems the entire option and argument need to be enclosed in
+qoutes.  For instance "-e(newline)".
+.TP
+.BI -r feature
+requires
+.I feature.
+This will load a file from SLIB if that
+.I feature
+is not already supported.  If
+.I feature
+is 2, 3, 4, or 5
+.I scm
+will require the features neccessary to support R2RS, R3RS, R4RS, or
+proposed R5RS, respectively.
+.TP
+.BI -l filename
+.TP
+.BI -f filename
+loads
+.I filename.
+.I Scm
+will load the first (unoptioned) file named on the command line if no
+-c, -e, -f, -l, or -s option preceeds it.
+.TP
+.BI -d filename
+opens (read-only) the extended relational database
+.I filename.
+If
+.I filename
+contains initialization code, it will be run when the database is
+opened.
+.TP
+.BI -p level
+sets the prolixity (verboseness) to
+.I level.
+This is the same as the
+.I scm
+command (verobse
+.I level
+).
+.TP
+.B -v
+(verbose mode) specifies that
+.I scm
+will print prompts, evaluation times, notice of loading files, and
+garbage collection statistics.  This is the same as
+.I -p3.
+.TP
+.B -q
+(quiet mode) specifies that
+.I scm
+will print no extra information.  This is the same as
+.I -p0.
+.TP
+.B -m
+specifies that subsequent loads, evaluations, and user interactions
+will be with R4RS macro capability.  To use a specific R4RS macro
+implementation from SLIB (instead of SLIB's default) put
+.I -r macropackage
+before
+.I -m
+on the command line.
+.TP
+.B -u
+specifies that subsequent loads, evaluations, and user interactions
+will be without R4RS macro capability.  R4RS macro capability can be
+restored by a subsequent
+.I -m
+on the command line or from Scheme code.
+.TP
+.B -i
+specifies that
+.I scm
+should run interactively.  That means that
+.I scm
+will not terminate until the
+.I (quit)
+or
+.I (exit)
+command is given, even if there are errors.  It also sets the
+prolixity level to 2 if it is less than 2.  This will print
+prompts, evaluation times, and notice of loading files.  The prolixity
+level can be set by subsequent options.  If
+.I scm
+is started from a tty, it will assume that it should be interactive
+unless given a subsequent
+.I -b
+option.
+.TP
+.B -b
+specifies that
+.I scm
+should run non-interactively.  That means that
+.I scm
+will terminate after processing the command line or if there are
+errors.
+.TP
+.B -s
+specifies, by analogy with
+.I sh,
+that further options are to be treated as program aguments.
+.TP
+.BI -
+.BI --
+specifies that there are no more options on the command line.
+.SH ENVIRONMENT VARIABLES
+.TP 5
+.B SCM_INIT_PATH
+is the pathname where
+.I scm
+will look for its initialization code.  The default is the file
+"Init.scm" in the source directory.
+.TP
+.B SCHEME_LIBRARY_PATH
+is the SLIB Scheme library directory.
+.TP
+.B HOME
+is the directory where "Init.scm" will look for the user
+initialization file "ScmInit.scm".
+.SH SCHEME VARIABLES
+.TP 5
+.B *argv*
+contains the list of arguments to the program.
+.I *argv*
+can change during argument processing.  This list is
+suitable for use as an argument to SLIB
+.I getopt.
+.TP
+.B *R4RS-macro*
+controls whether loading and interaction support R4RS macros.  Define
+this in "ScmInit.scm" or files specified on the command line.  This
+can be overridden by subsequent -m and -u options.
+.TP
+.B *interactive*
+controls interactivity as explained for the -i and -b options.  Define
+this in "ScmInit.scm" or files specified on the command line.  This
+can be overridden by subsequent -i and -b options.
+.SH EXAMPLES
+.ne 5
+.TP 5
+% scm foo.scm arg1 arg2 arg3
+.br	
+Load and execute the contents of foo.scm.  Parameters
+arg1 arg2 and arg3 are stored in the global list *argv*.
+.TP
+% scm -f foo.scm arg1 arg2 arg3
+.br
+The same.
+.TP
+% scm -s foo.scm arg1 arg2
+.br
+Set *argv* to ("foo.scm" "arg1" "arg2") and enter interactive session.
+.TP
+% scm -e '(display (list-ref *argv* *optind*))' bar
+.br
+Print ``bar''
+.TP
+% scm -rpretty-print -r format -i
+.br
+Load pretty-print and format and enter interactive mode.
+.TP
+% scm -r5
+.br
+Load dynamic-wind, values, and R4RS macros and enter interactive (with
+macros) mode.
+.TP
+% scm -r5 -r4
+.br
+Like above but rev4-optional-procedures are also loaded.
+.SH FEATURES
+.PP
+Runs under Amiga, Atari-ST, MacOS, MS-DOS, OS/2, NOS/VE, Unicos, VMS,
+Unix and similar systems.  Support for ASCII and EBCDIC character
+sets.
+.PP
+Conforms to Revised^4 Report on the Algorithmic Language Scheme
+and the IEEE P1178 specification.
+.PP
+Support for SICP, R2RS, R3RS, and (proposed) R5RS scheme code.
+.PP
+Many Common Lisp functions:
+logand, logor, logxor, lognot, ash, logcount, integer-length,
+bit-extract, defmacro, macroexpand, macroexpand1, gentemp,
+defvar, force-output, software-type, get-decoded-time,
+get-internal-run-time, get-internal-real-time, delete-file,
+rename-file, copy-tree, acons, and eval.
+.PP
+Char-code-limit, most-positive-fixnum, most-negative-fixnum,
+and internal-time-units-per-second constants.  *Features* and
+*load-pathname* variables.
+.PP
+Arrays and bit-vectors.  String ports and software emulation ports.
+I/O extensions providing most of ANSI C and POSIX.1 facilities.
+.PP
+User definable responses to interrupts and errors,
+Process-syncronization primitives, String regular expression matching,
+and the CURSES screen management package.
+.PP
+Available add-on packages including an interactive debugger, database,
+X-window graphics, BGI graphics, Motif, and Open-Windows packages.
+.PP
+A compiler (HOBBIT, available separately) and dynamic linking of
+compiled modules.
+.PP
+Setable levels of monitoring and timing information printed
+interactively (the `verbose' function).  Restart, quit, and exec.
+.SH FILES
+.TP
+code.doc
+.br
+Documentation on the internal representation and how to extend or
+include scm in other programs.
+.TP
+scm.texi
+.br
+Documentation of SCM in Texinfo format.
+.SH AUTHOR
+Aubrey Jaffer
+.br
+(jaffer@ai.mit.edu)
+.SH BUGS
+.SH SEE ALSO
+The Scheme specifications for details on specific procedures
+(ftp-swiss.ai.mit.edu:archive/scheme-reports/) or
+.PP
+IEEE Std 1178-1990,
+.br
+IEEE Standard for the Scheme Programming Language,
+.br
+Institute of Electrical and Electronic Engineers, Inc.,
+.br
+New York, NY, 1991
+.PP
+Brian Harvey and Matthew Wright
+.br
+Simply Scheme: Introducing Computer Science_
+.br
+MIT Press, 1994
+ISBN 0-262-08226-8
+.PP
+R. Kent Dybvig, The Scheme Programming Language,
+.br
+Prentice-Hall Inc, Englewood Cliffs, New Jersey 07632, USA
+.PP
+H. Abelson, G. J. Sussman, and J. Sussman,
+.br
+Structure and Interpretation of Computer Programs,
+.br
+The MIT Press, Cambridge, Massachusetts, USA
+.PP
+Enhancements in
+.I scm
+not in the standards are detailed in MANUAL in the source directory.
+
diff --git a/scm.c b/scm.c
new file mode 100644
index 0000000..ce8e834
--- /dev/null
+++ b/scm.c
@@ -0,0 +1,940 @@
+/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  
+ */
+
+/* "scm.c" top level and interrupt code.
+   Author: Aubrey Jaffer */
+
+#include <signal.h>
+#include "scm.h"
+#include "patchlvl.h"
+
+#ifdef __IBMC__
+# include <io.h>
+#endif
+
+#ifndef STDC_HEADERS
+	int alarm P((unsigned int));
+	int pause P((void));
+	unsigned int sleep P((unsigned int seconds));
+	char *getenv P((const char *name));
+	int system P((const char *));
+#endif
+#ifdef hpux
+# define const /**/
+#endif
+
+void	final_repl P((void));
+void	init_dynl P((void));
+void	init_eval P((void));
+void	init_features P((void));
+void	init_io P((void));
+void	init_ioext P((void));
+void	init_repl P((int iverbose));
+void	init_sc2 P((void));
+void	init_scl P((void));
+void	init_signals P((void));
+void	init_subrs P((void));
+void	init_tables P((void));
+void	init_time P((void));
+void	init_types P((void));
+void	init_unif P((void));
+void	init_ramap P((void));
+
+void init_banner()
+{
+  fputs("SCM version ", stderr);
+  fputs(SCMVERSION, stderr);
+  fputs(", Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996 \
+Free Software Foundation.\n\
+SCM comes with ABSOLUTELY NO WARRANTY; for details type `(terms)'.\n\
+This is free software, and you are welcome to redistribute it\n\
+under certain conditions; type `(terms)' for details.\n", stderr);
+}
+
+SCM scm_init_extensions()
+{
+#ifdef COMPILED_INITS
+    COMPILED_INITS;		/* initialize statically linked add-ons */
+#endif
+    return UNSPECIFIED;
+}
+
+#if (__TURBOC__==1)
+# define signal ssignal		/* Needed for TURBOC V1.0 */
+#endif
+
+/* SIGRETTYPE is the type that signal handlers return.  See <signal.h>*/
+
+#ifdef RETSIGTYPE
+# define SIGRETTYPE RETSIGTYPE
+#else
+# ifdef STDC_HEADERS
+#  if (__TURBOC__==1)
+#   define SIGRETTYPE int
+#  else
+#   define SIGRETTYPE void
+#  endif
+# else
+#  ifdef linux
+#   define SIGRETTYPE void
+#  else
+#   define SIGRETTYPE int
+#  endif
+# endif
+#endif
+
+#ifdef vms
+# ifdef __GNUC__
+#  define SIGRETTYPE int
+# endif
+#endif
+
+#ifdef SIGHUP
+static SIGRETTYPE hup_signal(sig)
+     int sig;
+{
+	signal(SIGHUP, hup_signal);
+	wta(UNDEFINED, (char *)HUP_SIGNAL, "");
+}
+#endif
+static SIGRETTYPE int_signal(sig)
+     int sig;
+{
+	sig = errno;
+	signal(SIGINT, int_signal);
+	if (ints_disabled) sig_deferred = 1;
+	else han_sig();
+	errno = sig;
+}
+
+/* If doesn't have SIGFPE, disable FLOATS for the rest of this file. */
+
+#ifndef SIGFPE
+# undef FLOATS
+#endif
+
+#ifdef FLOATS
+static SIGRETTYPE fpe_signal(sig)
+     int sig;
+{
+	signal(SIGFPE, fpe_signal);
+	wta(UNDEFINED, (char *)FPE_SIGNAL, "");
+}
+#endif
+#ifdef SIGBUS
+static SIGRETTYPE bus_signal(sig)
+     int sig;
+{
+	signal(SIGBUS, bus_signal);
+	wta(UNDEFINED, (char *)BUS_SIGNAL, "");
+}
+#endif
+#ifdef SIGSEGV			/* AMIGA lacks! */
+static SIGRETTYPE segv_signal(sig)
+     int sig;
+{
+	signal(SIGSEGV, segv_signal);
+	wta(UNDEFINED, (char *)SEGV_SIGNAL, "");
+}
+#endif
+#ifdef atarist
+# undef SIGALRM			/* only available via MiNT libs */
+#endif
+#ifdef GO32
+# undef SIGALRM
+#endif
+#ifdef __HIGHC__
+# undef SIGALRM
+#endif
+#ifdef SIGALRM
+static SIGRETTYPE alrm_signal(sig)
+     int sig;
+{
+	sig = errno;
+	signal(SIGALRM, alrm_signal);
+	if (ints_disabled) alrm_deferred = 1;
+	else han_alrm();
+	errno = sig;
+}
+static char s_alarm[] = "alarm";
+SCM lalarm(i)
+     SCM i;
+{
+  unsigned int j;
+  ASSERT(INUMP(i) && (INUM(i) >= 0), i, ARG1, s_alarm);
+  SYSCALL(j = alarm(INUM(i)););
+  return MAKINUM(j);
+}
+# ifndef AMIGA
+SCM l_pause()
+{
+  pause();
+  return UNSPECIFIED;
+}
+# endif
+#endif /* SIGALRM */
+
+#ifdef _WIN32
+# include <windows.h>
+#endif
+#ifndef AMIGA
+# ifndef _Windows
+static char s_sleep[] = "sleep";
+SCM l_sleep(i)
+     SCM i;
+{
+  unsigned int j = 0;
+  ASSERT(INUMP(i) && (INUM(i) >= 0), i, ARG1, s_sleep);
+#  ifdef __HIGHC__
+  SYSCALL(sleep(INUM(i)););
+#  else
+#   ifdef _WIN32
+  Sleep(INUM(i));
+#   else
+  SYSCALL(j = sleep(INUM(i)););
+#   endif
+  return MAKINUM(j);
+}
+#  endif
+# endif
+#endif
+
+#ifndef _WIN32
+# ifndef GO32
+#  ifndef sun
+/* int raise P((int sig)); */
+static char s_raise[] = "raise";
+SCM l_raise(sig)
+     SCM sig;
+{
+  ASSERT(INUMP(sig), sig, ARG1, s_raise);
+#   ifdef vms
+  return MAKINUM(gsignal((int)INUM(sig)));
+#   else
+#    ifndef __TURBOC__
+#     ifdef STDC_HEADERS
+  return kill(getpid (), (int)INUM(sig)) ? BOOL_F : BOOL_T;
+#     else
+  return raise((int)INUM(sig)) ? BOOL_F : BOOL_T;
+#     endif
+#    else
+  return raise((int)INUM(sig)) ? BOOL_F : BOOL_T;
+#    endif
+#   endif
+}
+#  endif
+# endif
+#endif
+#ifdef TICKS
+unsigned int tick_count = 0, ticken = 0;
+SCM *loc_tick_signal;
+void tick_signal()
+{
+  if (ticken && NIMP(*loc_tick_signal)) {
+    ticken = 0;
+    apply(*loc_tick_signal, EOL, EOL);
+  }
+}
+static char s_ticks[] = "ticks";
+SCM lticks(i)
+     SCM i;
+{
+  SCM j = ticken ? tick_count : 0;
+  if (!UNBNDP(i)) ticken = tick_count = INUM(i);
+  return MAKINUM(j);
+}
+#endif
+
+#ifdef SIGHUP
+static SIGRETTYPE (*oldhup)();
+#endif
+static SIGRETTYPE (*oldint)();
+#ifdef FLOATS
+static SIGRETTYPE (*oldfpe)();
+#endif
+#ifdef SIGBUS
+static SIGRETTYPE (*oldbus)();
+#endif
+#ifdef SIGSEGV			/* AMIGA lacks! */
+static SIGRETTYPE (*oldsegv)();
+#endif
+#ifdef SIGALRM
+static SIGRETTYPE (*oldalrm) ();
+#endif
+#ifdef SIGPIPE
+static SIGRETTYPE (*oldpipe) ();
+#endif
+
+int dumped = 0;			/* Is this an invocation of unexec exe? */
+
+#ifdef SHORT_ALIGN
+typedef short STACKITEM;
+#else
+typedef long STACKITEM;
+#endif
+/* See scm.h for definition of P */
+void  init_storage P((STACKITEM *stack_start_ptr, long init_heap_size));
+
+void init_scm( iverbose, buf0stdin, init_heap_size )
+     int iverbose;
+     int buf0stdin;
+     long init_heap_size;
+{
+  STACKITEM i;
+  if (2 <= iverbose) init_banner();
+  if (!dumped) {
+    init_types();
+    init_tables();
+    init_storage(&i, init_heap_size); /* CONT(rootcont)->stkbse gets set here */
+    if (buf0stdin) CAR(def_inp) |= BUF0;
+    init_features();
+    init_subrs();
+    init_io();
+    init_scl();
+    init_eval();
+    init_time();
+    init_repl( iverbose );
+    init_unif();
+  }}
+
+void init_signals()
+{
+  oldint = signal(SIGINT, int_signal);
+#ifdef SIGHUP
+  oldhup = signal(SIGHUP, hup_signal);
+#endif
+#ifdef FLOATS
+  oldfpe = signal(SIGFPE, fpe_signal);
+#endif
+#ifdef SIGBUS
+  oldbus = signal(SIGBUS, bus_signal);
+#endif
+#ifdef SIGSEGV			/* AMIGA lacks! */
+  oldsegv = signal(SIGSEGV, segv_signal);
+#endif
+#ifdef SIGALRM
+  alarm(0);			/* kill any pending ALRM interrupts */
+  oldalrm = signal(SIGALRM, alrm_signal);
+#endif
+#ifdef SIGPIPE
+  oldpipe = signal(SIGPIPE, SIG_IGN);
+#endif
+#ifdef ultrix
+  siginterrupt(SIGINT, 1);
+  siginterrupt(SIGALRM, 1);
+  siginterrupt(SIGHUP, 1);
+  siginterrupt(SIGPIPE, 1);
+#endif /* ultrix */
+}
+
+/* This is used in preparation for a possible fork().  Ignore all
+   signals before the fork so that child will catch only if it
+   establishes a handler */
+void ignore_signals()
+{
+#ifdef ultrix
+  siginterrupt(SIGINT, 0);
+  siginterrupt(SIGALRM, 0);
+  siginterrupt(SIGHUP, 0);
+  siginterrupt(SIGPIPE, 0);
+#endif /* ultrix */
+  signal(SIGINT, SIG_IGN);
+#ifdef SIGHUP
+  signal(SIGHUP, SIG_DFL);
+#endif
+#ifdef FLOATS
+  signal(SIGFPE, SIG_DFL);
+#endif
+#ifdef SIGBUS
+  signal(SIGBUS, SIG_DFL);
+#endif
+#ifdef SIGSEGV			/* AMIGA lacks! */
+  signal(SIGSEGV, SIG_DFL);
+#endif
+  /* Some documentation claims that ALRMs are cleared accross forks.
+     If this is not always true then the value returned by alarm(0)
+     will have to be saved and unignore_signals() will have to
+     reinstate it. */
+  /* This code should be neccessary only if the forked process calls
+     alarm() without establishing a handler:
+#ifdef SIGALRM
+     oldalrm = signal(SIGALRM, SIG_DFL);
+#endif */
+  /* These flushes are per warning in man page on fork(). */
+  fflush(stdout);
+  fflush(stderr);
+}
+
+void unignore_signals()
+{
+  signal(SIGINT, int_signal);
+#ifdef SIGHUP
+  signal(SIGHUP, hup_signal);
+#endif
+#ifdef FLOATS
+  signal(SIGFPE, fpe_signal);
+#endif
+#ifdef SIGBUS
+  signal(SIGBUS, bus_signal);
+#endif
+#ifdef SIGSEGV			/* AMIGA lacks! */
+  signal(SIGSEGV, segv_signal);
+#endif
+#ifdef SIGALRM
+  signal(SIGALRM, alrm_signal);
+#endif
+#ifdef ultrix
+  siginterrupt(SIGINT, 1);
+  siginterrupt(SIGALRM, 1);
+  siginterrupt(SIGHUP, 1);
+  siginterrupt(SIGPIPE, 1);
+#endif /* ultrix */
+}
+
+void restore_signals()
+{
+#ifdef ultrix
+  siginterrupt(SIGINT, 0);
+  siginterrupt(SIGALRM, 0);
+  siginterrupt(SIGHUP, 0);
+  siginterrupt(SIGPIPE, 0);
+#endif /* ultrix */
+  signal(SIGINT, oldint);
+#ifdef SIGHUP
+  signal(SIGHUP, oldhup);
+#endif
+#ifdef FLOATS
+  signal(SIGFPE, oldfpe);
+#endif
+#ifdef SIGBUS
+  signal(SIGBUS, oldbus);
+#endif
+#ifdef SIGSEGV			/* AMIGA lacks! */
+  signal(SIGSEGV, oldsegv);
+#endif
+#ifdef SIGPIPE
+  signal(SIGPIPE, oldpipe);
+#endif
+#ifdef SIGALRM
+  alarm(0);			/* kill any pending ALRM interrupts */
+  signal(SIGALRM, oldalrm);
+#endif
+}
+
+int run_scm(argc, argv, iverbose, buf0stdin, initpath)
+     int argc;
+     char **argv;
+     int iverbose;
+     int buf0stdin;
+     char *initpath;
+{
+  SCM i;
+  do {
+    i = 0L;
+    if ((2 <= argc) && argv[1] && (0==strncmp("-a", argv[1], 2))) {
+      char *str = (0==argv[1][2] && 3 <= argc && argv[2]) ?argv[2]:&argv[1][2];
+      do {
+	switch (*str) {
+	case DIGITS:
+	  i = i * 10 + (*str - '0');
+	  if (i <= 10000L) continue; /* the size limit should match Init.scm */
+	default:
+	  i = 0L;
+	}
+	break;
+      } while (* ++str);
+    }
+    init_scm(iverbose, buf0stdin, (0 >= i) ? 0L : 1024L * i); /* size in Kb */
+    progargs = EOL;
+    progargs = makfromstrs(argc, argv);
+
+    if (!dumped) {
+#ifdef HAVE_DYNL
+      init_dynl();
+#endif
+#ifdef INITS
+      INITS;			/* call initialization of extension files */
+#endif
+    }
+    init_signals();
+    i = repl_driver(initpath);
+    restore_signals();
+#ifdef TICKS
+    ticken = 0;
+#endif
+#ifdef FINALS
+    FINALS;			/* call shutdown of extensions files */
+#endif /* for compatability with older modules */
+    /* call finalization of user extensions */
+    while (num_finals--) (finals[num_finals])();
+    final_repl();
+    free_storage();		/* free all allocated memory */
+    if (i) break;
+    dumped = 0;
+    if (2 <= iverbose) fputs(";RESTART\n", stderr);
+  } while (!0);
+  if (2 <= iverbose) fputs(";EXIT\n", stderr);
+  fflush(stderr);
+  return (int)INUM(i);
+}
+
+#ifdef vms
+# define SYSTNAME "vms"
+#endif
+#ifdef unix
+# define DIRSEP "/"
+# ifndef MSDOS			/* DJGPP defines both */
+#  define SYSTNAME "unix"
+# endif
+#endif
+#ifdef MWC
+# define SYSTNAME "coherent"
+# define DIRSEP "/"
+#endif
+#ifdef _Windows
+# define SYSTNAME "windows"
+# define DIRSEP "\\"
+#else
+# ifdef MSDOS
+#  define SYSTNAME "ms-dos"
+#  ifndef unix
+#   define DIRSEP "\\"
+#  endif
+# endif
+#endif
+#ifdef __EMX__
+# define SYSTNAME "os/2"
+# define DIRSEP "\\"
+#endif
+#ifdef __IBMC__
+# define SYSTNAME "os/2"
+# define DIRSEP "\\"
+#endif
+#ifdef THINK_C
+# define SYSTNAME "thinkc"
+# define DIRSEP ":"
+#endif
+#ifdef AMIGA
+# define SYSTNAME "amiga"
+# define DIRSEP "/"
+#endif
+#ifdef atarist
+# define SYSTNAME "atarist"
+# define DIRSEP "\\"
+#endif
+#ifdef mach
+# define SYSTNAME "mach"
+# define DIRSEP "/"
+#endif
+#ifdef ARM_ULIB
+# define SYSTNAME "acorn"
+#endif
+#ifdef nosve
+# define INIT_FILE_NAME "Init_scm";
+# define DIRSEP "."
+#endif
+
+SCM softtype()
+{
+#ifdef nosve
+  return CAR(intern("nosve", 5));
+#else
+  return CAR(intern(SYSTNAME, sizeof SYSTNAME/sizeof(char) -1));
+#endif
+}
+
+/* Concatentate str2 onto str1 at position n and return concatenated
+   string if file exists; 0 otherwise. */
+
+char *scm_cat_path(str1, str2, n)
+     char *str1;
+     const char *str2;
+     long n;
+{
+  if (!n) n = strlen(str2);
+  if (str1)
+    {
+      long len = strlen(str1);
+      str1 = (char *)realloc(str1, (sizet)(len + n + 1));
+      if (!str1) return 0;
+      strncat(str1 + len, str2, n);
+      return str1;
+    }
+  str1 = (char *)malloc((sizet)(n + 1));
+  if (!str1) return 0;
+  str1[0] = 0;
+  strncat(str1, str2, n);
+  return str1;
+}
+
+char *scm_try_path(path)
+     char *path;
+{
+  FILE *f;
+  /* fprintf(stderr, "Trying %s\n", path);fflush(stderr); */
+  if (!path) return 0;
+  SYSCALL(f = fopen(path, "r"););
+  if (f) {
+    fclose(f);
+    return path;
+  }
+  free(path);
+  return 0;
+}
+
+char *scm_sep_init_try(path, sep, initname)
+     char *path;
+     const char *sep, *initname;
+{
+  if (path) path = scm_cat_path(path, sep, 0L);
+  if (path) path = scm_cat_path(path, initname, 0L);
+  return scm_try_path(path);
+}
+
+#ifdef MSDOS
+char *dld_find_executable(file)
+     const char *file;
+{
+  return scm_cat_path(0L, file, 0L);
+}
+#endif
+
+#ifndef INIT_FILE_NAME
+# define INIT_FILE_NAME "Init.scm"
+#endif
+#ifndef DIRSEP
+# define DIRSEP "/"
+#endif
+#ifndef GENERIC_NAME
+# define GENERIC_NAME "scm"
+#endif
+
+/* Given dld_find_executable()'s best guess for the pathname of this
+   executable, find (and verify the existence of) initname in the
+   implementation-vicinity of this program.  Returns a newly allocated
+   string if successful, 0 if not */
+
+char *scm_find_impl_file(exec_path, generic_name, initname, sep)
+     char *exec_path;
+     const char *generic_name, *initname, *sep;
+{
+  char *sepptr = strrchr(exec_path, sep[0]);
+  char *extptr = exec_path + strlen(exec_path);
+  char *path = 0;
+  if (sepptr) {
+    long sepind = sepptr - exec_path + 1L;
+
+    /* In case exec_path is in the source directory, look first in
+       exec_path's directory. */
+    path = scm_cat_path(0L, exec_path, sepind - 1L);
+    path = scm_sep_init_try(path, sep, initname);
+    if (path) return path;
+
+#ifdef MSDOS
+    if (!strcmp(extptr - 4, ".exe") || !strcmp(extptr - 4, ".com") ||
+	!strcmp(extptr - 4, ".EXE") || !strcmp(extptr - 4, ".COM"))
+      extptr = extptr - 4;
+#endif
+
+    if (generic_name &&
+	!strncmp(exec_path + sepind, generic_name, extptr - exec_path))
+      generic_name = 0;
+
+    /* If exec_path is in directory "exe" or "bin": */
+    path = scm_cat_path(0L, exec_path, sepind - 1L);
+    sepptr = path + sepind - 4;
+    if (!strcmp(sepptr, "exe") || !strcmp(sepptr, "bin") ||
+	!strcmp(sepptr, "EXE") || !strcmp(sepptr, "BIN")) {
+      char *peer;
+
+      /* Look for initname in peer directory "lib". */
+      if (path) {
+	strncpy(sepptr, "lib", 3);
+	path = scm_sep_init_try(path, sep, initname);
+	if (path) return path;
+      }
+
+      /* Look for initname in peer directories "lib" and "src" in
+	 subdirectory with the name of the executable (sans any type
+	 extension like .EXE). */
+      for(peer="lib";!0;peer="src") {
+	path = scm_cat_path(0L, exec_path, extptr - exec_path + 0L);
+	if (path) {
+	  strncpy(path + sepind - 4, peer, 3);
+	  path[extptr - exec_path] = 0;
+	  path = scm_sep_init_try(path, sep, initname);
+	  if (path) return path;
+	}
+	if (!strcmp(peer,"src")) break;
+      }
+
+      if (generic_name) {
+
+	/* Look for initname in peer directories "lib" and "src" in
+	   subdirectory with the generic name. */
+	for(peer="lib";!0;peer="src") {
+	  path = scm_cat_path(0L, exec_path, sepind);
+	  if (path) {
+	    strncpy(path + sepind - 4, "lib", 3);
+	    path = scm_cat_path(path, generic_name, 0L);
+	    path = scm_sep_init_try(path, sep, initname);
+	    if (path) return path;
+	  }
+	  if (!strcmp(peer,"src")) break;
+	}}}
+
+#ifdef MSDOS
+    if (strlen(extptr)) {
+      /* If exec_path has type extension, look in a subdirectory with
+	 the name of the executable sans the executable file's type
+	 extension. */
+      path = scm_cat_path(0L, exec_path, extptr - exec_path + 0L);
+      path = scm_sep_init_try(path, sep, initname);
+      if (path) return path;
+
+      if (generic_name) {
+
+	/* Also look in generic_name subdirectory. */
+	path = scm_cat_path(0L, exec_path, sepind);
+	if (path) path = scm_cat_path(path, generic_name, 0L);
+	path = scm_sep_init_try(path, sep, initname);
+	if (path) return path;
+      }}
+#endif
+  }
+  else {
+
+    /* We don't have a parse-able exec_path.  The only path to try is
+       just initname. */
+    path = scm_cat_path(0L, initname, 0L);
+    if (path) path = scm_try_path(path);
+    if (path) return path;
+  }
+  return 0;
+}
+
+#ifndef RTL
+char *execpath = 0;
+int main( argc, argv )
+     int argc;
+     char **argv;
+{
+  int retval, buf0stdin = 0;
+  char *getenvpath, *implpath = 0;
+
+# ifndef nosve
+  getenvpath = getenv("SCM_INIT_PATH");
+  if (getenvpath) implpath = scm_cat_path(0L, getenvpath, 0L);
+  if (implpath) {
+
+    /* The value of the environment variable supersedes other
+       locations, as long as the file exists. */
+    implpath = scm_try_path(implpath);
+    if (!implpath) {
+      fputs("Value of SCM_INIT_PATH (=\"", stderr);
+      fputs(getenvpath, stderr);
+      fputs("\") not found; Trying elsewhere\n", stderr);
+    }
+  }
+# endif
+
+  if (!implpath) {
+    execpath = dld_find_executable(argv[0]);
+    if (execpath) {
+      /* fprintf(stderr, "dld found exe \"%s\"\n", execpath); fflush(stderr); */
+      implpath = scm_find_impl_file(execpath,
+				    GENERIC_NAME, INIT_FILE_NAME, DIRSEP);
+      /* fprintf(stderr, "scm_find_impl_file returned \"%s\"\n", implpath); fflush(stderr); */
+    }
+# ifdef IMPLINIT
+    if (!implpath) implpath = scm_cat_path(0L, IMPLINIT, 0L);
+# endif
+  }
+# ifndef GO32
+  if (isatty(fileno(stdin))) {
+    buf0stdin = !0;		/* stdin gets marked BUF0 in init_scm() */
+#  ifndef NOSETBUF
+#   ifndef _DCC
+#    ifndef ultrix
+#     ifndef __WATCOMC__
+#      ifndef THINK_C
+#       if (__TURBOC__ != 1)
+#        ifndef _Windows
+    setbuf(stdin, 0);		/* Often setbuf isn't actually required */
+#        endif
+#       endif
+#      endif
+#     endif
+#    endif
+#   endif
+  }
+#  endif
+# endif
+  retval = run_scm(argc, argv,
+		   (isatty(fileno(stdin)) && isatty(fileno(stdout)))
+		   ? (argc <= 1) ? 2 : 1 : 0,
+		   buf0stdin,
+		   implpath ? implpath : "");
+  if (implpath) free(implpath);
+  if (execpath) free(execpath);
+  return retval;
+}
+#endif
+
+#ifndef _Windows
+char s_system[] = "system";
+SCM lsystem(cmd)
+     SCM cmd;
+{
+  ASSERT(NIMP(cmd) && STRINGP(cmd), cmd, ARG1, s_system);
+  ignore_signals();
+# ifdef AZTEC_C
+  cmd = MAKINUM(Execute(CHARS(cmd), 0, 0));
+# else
+  cmd = MAKINUM(0L+system(CHARS(cmd)));
+# endif
+  unignore_signals();
+  return cmd;
+}
+#endif
+
+char s_getenv[] = "getenv";
+char *getenv();
+SCM lgetenv(nam)
+     SCM nam;
+{
+  char *val;
+  ASSERT(NIMP(nam) && STRINGP(nam), nam, ARG1, s_getenv);
+  val = getenv(CHARS(nam));
+  if (!val) return BOOL_F;
+  return makfrom0str(val);
+}
+
+#ifdef vms
+# include <descrip.h>
+# include <ssdef.h>
+char s_ed[] = "ed";
+SCM ed(fname)
+     SCM fname;
+{
+  struct dsc$descriptor_s d;
+  ASSERT(NIMP(fname) && STRINGP(fname), fname, ARG1, s_ed);
+  d.dsc$b_dtype = DSC$K_DTYPE_T;
+  d.dsc$b_class = DSC$K_CLASS_S;
+  d.dsc$w_length = LENGTH(fname);
+  d.dsc$a_pointer = CHARS(fname);
+  /* I don't know what VMS does with signal handlers across the
+     edt$edit call. */
+  ignore_signals();
+  edt$edit(&d);
+  unignore_signals();
+  return fname;
+}
+SCM vms_debug()
+{
+  lib$signal(SS$_DEBUG);
+  return UNSPECIFIED;
+}
+#endif
+
+static iproc subr0s[] = {
+	{"software-type", softtype},
+	{"scm_init_extensions", scm_init_extensions},
+#ifdef vms
+	{"vms-debug", vms_debug},
+#endif
+#ifdef SIGALRM
+# ifndef AMIGA
+	{"pause", l_pause},
+# endif
+#endif
+	{0, 0}};
+static iproc subr1s[] = {
+	{s_getenv, lgetenv},
+#ifndef _Windows
+	{s_system, lsystem},
+#endif
+#ifdef vms
+	{s_ed, ed},
+#endif
+#ifdef SIGALRM
+	{s_alarm, lalarm},
+#endif
+#ifndef AMIGA
+# ifndef _Windows
+	{s_sleep, l_sleep},
+# endif
+#endif
+#ifndef GO32
+# ifndef sun
+#  ifndef _WIN32
+	{s_raise, l_raise},
+#  endif
+# endif
+#endif
+	{0, 0}};
+
+SCM *loc_features;
+void add_feature(str)
+     char* str;
+{
+  *loc_features = cons(CAR(intern(str, strlen(str))), *loc_features);
+}
+void init_features()
+{
+  loc_features = &CDR(sysintern("*features*", EOL));
+  init_iprocs(subr0s, tc7_subr_0);
+  init_iprocs(subr1s, tc7_subr_1);
+#ifdef TICKS
+  loc_tick_signal = &CDR(sysintern("ticks-interrupt", UNDEFINED));
+  make_subr(s_ticks, tc7_subr_1o, lticks);
+#endif
+#ifdef RECKLESS
+  add_feature("reckless");
+#endif
+#ifndef _Windows
+  add_feature(s_system);
+#endif
+#ifdef vms
+  add_feature(s_ed);
+#endif
+  sysintern("*scm-version*", makfrom0str(SCMVERSION));
+}
diff --git a/scm.doc b/scm.doc
new file mode 100644
index 0000000..eaa34e0
--- /dev/null
+++ b/scm.doc
@@ -0,0 +1,330 @@
+
+
+
+SCM(Jan 9 1995)                                   SCM(Jan 9 1995)
+
+
+NAME
+       scm - a Scheme Language Interpreter
+
+SYNOPSIS
+       scm  [-a  kbytes ] [-ibvqmu] [-p number ] [-c expression ]
+       [-e expression ] [-f filename ] [-l filename ]  [-d  file-
+       name  ]  [-r feature ] [-- | - | -s] [filename] [arguments
+       ...]
+
+DESCRIPTION
+       Scm is a Scheme interpreter.
+
+       Upon startup scm loads the file specified by by the  envi-
+       ronment   variable   SCM_INIT_PATH  or  by  the  parameter
+       IMPLINIT in the makefile (or scmfig.h) if SCM_INIT_PATH is
+       not  defined.   The  makefiles  attempt to set IMPLINIT to
+       "Init.scm" in the source directory.
+
+       Unless the option  -no-init-file  occurs  in  the  command
+       line,   "Init.scm"   checks   to  see  if  there  is  file
+       "ScmInit.scm" in the path  specified  by  the  environment
+       variable  HOME  (or  in  the  current directory if HOME is
+       undefined).  If it finds such a file it is loaded.
+
+       "Init.scm" then looks for command input from one of  three
+       sources:  From  an option on the command line, from a file
+       named on the command line, or from standard input.
+
+
+OPTIONS
+       The options are processed in the order  specified  on  the
+       command line.
+
+       -akbytes
+            specifies  that  scm should allocate an initial heap-
+            size of kbytes.  This option, if present, must be the
+            first on the command line.
+
+       -no-init-file
+            Inhibits  the  loading  of "ScmInit.scm" as described
+            above.
+
+       -eexpression
+
+       -cexpression
+            specifies that the scheme expression expression is to
+            be evaluated.  These options are inspired by perl and
+            sh respectively.  On Amiga systems the entire  option
+            and  argument  need  to  be  enclosed in qoutes.  For
+            instance "-e(newline)".
+
+       -rfeature
+            requires feature.  This will load a file from SLIB if
+            that feature is not already supported.  If feature is
+
+
+
+                                                                1
+
+
+
+
+
+SCM(Jan 9 1995)                                   SCM(Jan 9 1995)
+
+
+            2, 3, 4, or 5 scm will require the  features  necces-
+            sary  to  support R2RS, R3RS, R4RS, or proposed R5RS,
+            respectively.
+
+       -lfilename
+
+       -ffilename
+            loads filename.  Scm will load the first (unoptioned)
+            file  named on the command line if no -c, -e, -f, -l,
+            or -s option preceeds it.
+
+       -dfilename
+            opens (read-only) the  extended  relational  database
+            filename.   If filename contains initialization code,
+            it will be run when the database is opened.
+
+       -plevel
+            sets the prolixity (verboseness) to level.   This  is
+            the same as the scm command (verobse level ).
+
+       -v   (verbose mode) specifies that scm will print prompts,
+            evaluation  times,  notice  of  loading  files,   and
+            garbage  collection  statistics.  This is the same as
+            -p3.
+
+       -q   (quiet mode) specifies that scm will print  no  extra
+            information.  This is the same as -p0.
+
+       -m   specifies  that  subsequent  loads,  evaluations, and
+            user interactions will be with R4RS macro capability.
+            To use a specific R4RS macro implementation from SLIB
+            (instead  of  SLIB's  default)  put  -r  macropackage
+            before -m on the command line.
+
+       -u   specifies  that  subsequent  loads,  evaluations, and
+            user interactions will be without R4RS macro capabil-
+            ity.  R4RS macro capability can be restored by a sub-
+            sequent -m on the command line or from Scheme code.
+
+       -i   specifies that scm should  run  interactively.   That
+            means that scm will not terminate until the (quit) or
+            (exit) command is given, even if  there  are  errors.
+            It  also  sets the prolixity level to 2 if it is less
+            than 2.  This will print prompts,  evaluation  times,
+            and notice of loading files.  The prolixity level can
+            be set by subsequent options.  If scm is started from
+            a  tty,  it will assume that it should be interactive
+            unless given a subsequent -b option.
+
+       -b   specifies  that  scm  should  run  non-interactively.
+            That  means  that scm will terminate after processing
+            the command line or if there are errors.
+
+       -s   specifies, by analogy with sh, that  further  options
+
+
+
+                                                                2
+
+
+
+
+
+SCM(Jan 9 1995)                                   SCM(Jan 9 1995)
+
+
+            are to be treated as program aguments.
+
+       -    --  specifies  that  there are no more options on the
+            command line.
+
+ENVIRONMENT VARIABLES
+       SCM_INIT_PATH
+            is the pathname where scm will look for its  initial-
+            ization  code.  The default is the file "Init.scm" in
+            the source directory.
+
+       SCHEME_LIBRARY_PATH
+            is the SLIB Scheme library directory.
+
+       HOME is the directory where "Init.scm" will look  for  the
+            user initialization file "ScmInit.scm".
+
+SCHEME VARIABLES
+       *argv*
+            contains  the  list  of  arguments  to  the  program.
+            *argv* can change during argument  processing.   This
+            list  is  suitable  for  use  as  an argument to SLIB
+            getopt.
+
+       *R4RS-macro*
+            controls whether loading and interaction support R4RS
+            macros.  Define this in "ScmInit.scm" or files speci-
+            fied on the command line.  This can be overridden  by
+            subsequent -m and -u options.
+
+       *interactive*
+            controls interactivity as explained for the -i and -b
+            options.  Define this in "ScmInit.scm" or files spec-
+            ified on the command line.  This can be overridden by
+            subsequent -i and -b options.
+
+EXAMPLES
+       % scm foo.scm arg1 arg2 arg3
+            Load and execute the contents of foo.scm.  Parameters
+            arg1  arg2  and  arg3  are  stored in the global list
+            *argv*.
+
+       % scm -f foo.scm arg1 arg2 arg3
+            The same.
+
+       % scm -s foo.scm arg1 arg2
+            Set *argv* to ("foo.scm"  "arg1"  "arg2")  and  enter
+            interactive session.
+
+       % scm -e '(display (list-ref *argv* *optind*))' bar
+            Print ``bar''
+
+       % scm -rpretty-print -r format -i
+            Load  pretty-print  and  format and enter interactive
+
+
+
+                                                                3
+
+
+
+
+
+SCM(Jan 9 1995)                                   SCM(Jan 9 1995)
+
+
+            mode.
+
+       % scm -r5
+            Load dynamic-wind, values, and R4RS macros and  enter
+            interactive (with macros) mode.
+
+       % scm -r5 -r4
+            Like  above  but  rev4-optional-procedures  are  also
+            loaded.
+
+FEATURES
+       Runs under Amiga, Atari-ST, MacOS, MS-DOS,  OS/2,  NOS/VE,
+       Unicos,  VMS, Unix and similar systems.  Support for ASCII
+       and EBCDIC character sets.
+
+       Conforms to Revised^4 Report on the  Algorithmic  Language
+       Scheme and the IEEE P1178 specification.
+
+       Support  for  SICP, R2RS, R3RS, and (proposed) R5RS scheme
+       code.
+
+       Many Common Lisp functions: logand, logor, logxor, lognot,
+       ash,   logcount,  integer-length,  bit-extract,  defmacro,
+       macroexpand, macroexpand1, gentemp, defvar,  force-output,
+       software-type,   get-decoded-time,  get-internal-run-time,
+       get-internal-real-time,  delete-file,  rename-file,  copy-
+       tree, acons, and eval.
+
+       Char-code-limit,    most-positive-fixnum,   most-negative-
+       fixnum,  and   internal-time-units-per-second   constants.
+       *Features* and *load-pathname* variables.
+
+       Arrays  and bit-vectors.  String ports and software emula-
+       tion ports.  I/O extensions providing most of ANSI  C  and
+       POSIX.1 facilities.
+
+       User  definable  responses  to interrupts and errors, Pro-
+       cess-syncronization primitives, String regular  expression
+       matching, and the CURSES screen management package.
+
+       Available  add-on packages including an interactive debug-
+       ger, database, X-window graphics, BGI graphics, Motif, and
+       Open-Windows packages.
+
+       A  compiler  (HOBBIT,  available  separately)  and dynamic
+       linking of compiled modules.
+
+       Setable  levels  of  monitoring  and  timing   information
+       printed  interactively (the `verbose' function).  Restart,
+       quit, and exec.
+
+FILES
+       code.doc
+              Documentation on the  internal  representation  and
+
+
+
+                                                                4
+
+
+
+
+
+SCM(Jan 9 1995)                                   SCM(Jan 9 1995)
+
+
+              how to extend or include scm in other programs.
+
+       scm.texi
+              Documentation of SCM in Texinfo format.
+
+AUTHOR
+       Aubrey Jaffer
+       (jaffer@ai.mit.edu)
+
+BUGS
+SEE ALSO
+       The  Scheme  specifications for details on specific proce-
+       dures (ftp-swiss.ai.mit.edu:archive/scheme-reports/) or
+
+       IEEE Std 1178-1990,
+       IEEE Standard for the Scheme Programming Language,
+       Institute of Electrical and Electronic Engineers, Inc.,
+       New York, NY, 1991
+
+       Brian Harvey and Matthew Wright
+       Simply Scheme: Introducing Computer Science_
+       MIT Press, 1994 ISBN 0-262-08226-8
+
+       R. Kent Dybvig, The Scheme Programming Language,
+       Prentice-Hall Inc, Englewood Cliffs, New Jersey 07632, USA
+
+       H. Abelson, G. J. Sussman, and J. Sussman,
+       Structure and Interpretation of Computer Programs,
+       The MIT Press, Cambridge, Massachusetts, USA
+
+       Enhancements  in  scm not in the standards are detailed in
+       MANUAL in the source directory.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+                                                                5
+
+
diff --git a/scm.h b/scm.h
new file mode 100644
index 0000000..1f01292
--- /dev/null
+++ b/scm.h
@@ -0,0 +1,817 @@
+/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  
+ */
+
+/* "scm.h" SCM data types and external functions. */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+typedef long SCM;
+typedef struct {SCM car, cdr;} cell;
+typedef struct {long sname;SCM (*cproc)();} subr;
+typedef struct {char *string;SCM (*cproc)();} iproc;
+typedef struct {long sname;double (*dproc)();} dsubr;
+
+#include <stdio.h>
+#include "scmfig.h"
+
+#ifdef USE_ANSI_PROTOTYPES
+# define P(s) s
+#else
+# define P(s) ()
+#endif
+
+#ifndef STDC_HEADERS
+	int isatty P((int));
+#endif
+
+typedef struct {
+  SCM	(*mark)P((SCM));
+  sizet	(*free)P((CELLPTR));
+  int	(*print)P((SCM exp, SCM port, int writing));
+  SCM	(*equalp)P((SCM, SCM));
+} smobfuns;
+
+typedef struct {
+  SCM	(*mark)P((SCM ptr));
+  int	(*free)P((FILE *p));
+  int	(*print)P((SCM exp, SCM port, int writing));
+  SCM	(*equalp)P((SCM, SCM));
+  int	(*fputc)P((int c, FILE *p));
+  int	(*fputs)P((char *s, FILE *p));
+  sizet	(*fwrite)P((char *s, sizet siz, sizet num, FILE *p));
+  int	(*fflush)P((FILE *stream));
+  int	(*fgetc)P((FILE *p));
+  int	(*fclose)P((FILE *p));
+} ptobfuns;
+
+typedef struct {
+  SCM v;
+  sizet base;
+} array;
+typedef struct {
+  long lbnd;
+  long ubnd;
+  long inc;
+} array_dim;
+
+#ifdef FLOATS
+typedef struct {char *string;double (*cproc)P((double));} dblproc;
+# ifdef SINGLES
+#  ifdef CDR_DOUBLES
+typedef struct {SCM type;double num;} flo;
+#  else
+typedef struct {SCM type;float num;} flo;
+#  endif
+# endif
+typedef struct {SCM type;double *real;} dbl;
+#endif
+
+#define IMP(x) (6 & (int)(x))
+#define NIMP(x) (!IMP(x))
+
+#define INUMP(x) (2 & (int)(x))
+#define NINUMP(x) (!INUMP(x))
+#define INUM0 ((SCM) 2)
+#define ICHRP(x) ((0xff & (int)(x))==0xf4)
+#define ICHR(x) ((unsigned char)((x)>>8))
+#define MAKICHR(x) (((x)<<8)+0xf4L)
+
+#define ILOCP(n) ((0xff & (int)(n))==0xfc)
+#define ILOC00	(0x000000fcL)
+#define IDINC	(0x00100000L)
+#define ICDR	(0x00080000L)
+#define IFRINC	(0x00000100L)
+#define IDSTMSK	(-IDINC)
+#define IFRAME(n) ((int)((ICDR-IFRINC)>>8) & ((int)(n)>>8))
+#define IDIST(n) (((unsigned long)(n))>>20)
+#define ICDRP(n) (ICDR & (n))
+
+/* ISYMP tests for ISPCSYM and ISYM */
+#define ISYMP(n) ((0x187 & (int)(n))==4)
+/* IFLAGP tests for ISPCSYM, ISYM and IFLAG */
+#define IFLAGP(n) ((0x87 & (int)(n))==4)
+#define ISYMNUM(n) ((int)((n)>>9))
+#define ISYMCHARS(n) (isymnames[ISYMNUM(n)])
+#define MAKSPCSYM(n) (((n)<<9)+((n)<<3)+4L)
+#define MAKISYM(n) (((n)<<9)+0x74L)
+#define MAKIFLAG(n) (((n)<<9)+0x174L)
+
+extern char *isymnames[];
+#define NUM_ISPCSYM 14
+#define IM_AND MAKSPCSYM(0)
+#define IM_BEGIN MAKSPCSYM(1)
+#define IM_CASE MAKSPCSYM(2)
+#define IM_COND MAKSPCSYM(3)
+#define IM_DO MAKSPCSYM(4)
+#define IM_IF MAKSPCSYM(5)
+#define IM_LAMBDA MAKSPCSYM(6)
+#define IM_LET MAKSPCSYM(7)
+#define IM_LETSTAR MAKSPCSYM(8)
+#define IM_LETREC MAKSPCSYM(9)
+#define IM_OR MAKSPCSYM(10)
+#define IM_QUOTE MAKSPCSYM(11)
+#define IM_SET MAKSPCSYM(12)
+#define IM_DEFINE MAKSPCSYM(13)
+
+#define s_and (ISYMCHARS(IM_AND)+2)
+#define s_begin (ISYMCHARS(IM_BEGIN)+2)
+#define s_case (ISYMCHARS(IM_CASE)+2)
+#define s_cond (ISYMCHARS(IM_COND)+2)
+#define s_do (ISYMCHARS(IM_DO)+2)
+#define s_if (ISYMCHARS(IM_IF)+2)
+#define s_lambda (ISYMCHARS(IM_LAMBDA)+2)
+#define s_let (ISYMCHARS(IM_LET)+2)
+#define s_letstar (ISYMCHARS(IM_LETSTAR)+2)
+#define s_letrec (ISYMCHARS(IM_LETREC)+2)
+#define s_or (ISYMCHARS(IM_OR)+2)
+#define s_quote (ISYMCHARS(IM_QUOTE)+2)
+#define s_set (ISYMCHARS(IM_SET)+2)
+#define s_define (ISYMCHARS(IM_DEFINE)+2)
+
+extern SCM i_dot, i_quote, i_quasiquote, i_unquote, i_uq_splicing;
+#define s_apply (ISYMCHARS(IM_APPLY)+2)
+
+/* each symbol defined here must have a unique number which */
+ /* corresponds to it's position in isymnames[] in sys.c */
+#define IM_APPLY MAKISYM(14)
+#define IM_CONT MAKISYM(15)
+
+#define NUM_ISYMS 16
+
+#define BOOL_F MAKIFLAG(NUM_ISYMS+0)
+#define BOOL_T MAKIFLAG(NUM_ISYMS+1)
+#define UNDEFINED MAKIFLAG(NUM_ISYMS+2)
+#define EOF_VAL MAKIFLAG(NUM_ISYMS+3)
+#ifdef SICP
+# define EOL BOOL_F
+#else
+# define EOL MAKIFLAG(NUM_ISYMS+4)
+#endif
+#define UNSPECIFIED MAKIFLAG(NUM_ISYMS+5)
+
+/* Now some unnamed flags used as magic cookies by repl_driver. */
+/* Argument n can range from -4 to 16 */
+#ifdef SHORT_INT
+#define COOKIE(n) (n)
+#define UNCOOK(f) (f)
+#else
+#define COOKIE(n) MAKIFLAG(NUM_ISYMS+6+4+n)
+#define UNCOOK(f) (ISYMNUM(f)-(NUM_ISYMS+6+4))
+#endif
+
+#define FALSEP(x) (BOOL_F==(x))
+#define NFALSEP(x) (BOOL_F != (x))
+/* BOOL_NOT returns the other boolean.  The order of ^s here is
+   important for Borland C++. */
+#define BOOL_NOT(x)  ((x) ^ (BOOL_T ^ BOOL_F))
+#define NULLP(x) (EOL==(x))
+#define NNULLP(x) (EOL != (x))
+#define UNBNDP(x) (UNDEFINED==(x))
+#define CELLP(x) (!NCELLP(x))
+#define NCELLP(x) ((sizeof(cell)-1) & (int)(x))
+
+#define GCMARKP(x) (1 & (int)CDR(x))
+#define GC8MARKP(x) (0x80 & (int)CAR(x))
+#define SETGCMARK(x) CDR(x) |= 1;
+#define CLRGCMARK(x) CDR(x) &= ~1L;
+#define SETGC8MARK(x) CAR(x) |= 0x80;
+#define CLRGC8MARK(x) CAR(x) &= ~0x80L;
+#define TYP3(x) (7 & (int)CAR(x))
+#define TYP7(x) (0x7f & (int)CAR(x))
+#define TYP7S(x) (0x7d & (int)CAR(x))
+#define TYP16(x) (0xffff & (int)CAR(x))
+#define TYP16S(x) (0xfeff & (int)CAR(x))
+#define GCTYP16(x) (0xff7f & (int)CAR(x))
+
+#define NCONSP(x) (1 & (int)CAR(x))
+#define CONSP(x) (!NCONSP(x))
+#define ECONSP(x) (CONSP(x) || (1==TYP3(x)))
+#define NECONSP(x) (NCONSP(x) && (1 != TYP3(x)))
+
+#define CAR(x) (((cell *)(SCM2PTR(x)))->car)
+#define CDR(x) (((cell *)(SCM2PTR(x)))->cdr)
+#define GCCDR(x) (~1L & CDR(x))
+#define SETCDR(x, v) CDR(x) = (SCM)(v)
+
+#define CLOSUREP(x) (TYP3(x)==tc3_closure)
+#define CODE(x) (CAR(x)-tc3_closure)
+#define SETCODE(x, e) CAR(x) = (e)+tc3_closure
+#define ENV(x) CDR(x)
+
+#define PORTP(x) (TYP7(x)==tc7_port)
+#define OPPORTP(x) (((0x7f | OPN) & CAR(x))==(tc7_port | OPN))
+#define OPINPORTP(x) (((0x7f | OPN | RDNG) & CAR(x))==(tc7_port | OPN | RDNG))
+#define OPOUTPORTP(x) (((0x7f | OPN | WRTNG) & CAR(x))==(tc7_port | OPN | WRTNG))
+#define OPIOPORTP(x) (((0x7f | OPN | RDNG | WRTNG) & CAR(x))==(tc7_port | OPN | RDNG | WRTNG))
+#define FPORTP(x) (TYP16S(x)==tc7_port)
+#define OPFPORTP(x) (((0xfeff | OPN) & CAR(x))==(tc7_port | OPN))
+#define OPINFPORTP(x) (((0xfeff | OPN | RDNG) & CAR(x))==(tc7_port | OPN | RDNG))
+#define OPOUTFPORTP(x) (((0xfeff | OPN | WRTNG) & CAR(x))==(tc7_port | OPN | WRTNG))
+
+#define INPORTP(x) (((0x7f | RDNG) & CAR(x))==(tc7_port | RDNG))
+#define OUTPORTP(x) (((0x7f | WRTNG) & CAR(x))==(tc7_port | WRTNG))
+#define OPENP(x) (OPN & CAR(x))
+#define CLOSEDP(x) (!OPENP(x))
+#define STREAM(x) ((FILE *)(CDR(x)))
+#define SETSTREAM SETCDR
+#define CRDYP(port) (CAR(port) & CRDY)
+#define CLRDY(port) {CAR(port) &= CUC;}
+#define CGETUN(port) ((int)SRS(CAR(port), 22))
+#define CUNGET(c, port) {CAR(port) += ((long)c<<22) + CRDY;}
+
+#define tc_socket (tc7_port | OPN)
+#define SOCKP(x) (((0x7f | OPN | RDNG | WRTNG) & CAR(x))==(tc_socket))
+#define SOCKTYP(x) (CAR(x)>>24)
+
+#define DIRP(x) (NIMP(x) && (TYP16(x)==(tc16_dir)))
+#define OPDIRP(x) (NIMP(x) && (CAR(x)==(tc16_dir | OPN)))
+
+#ifdef FLOATS
+# define INEXP(x) (TYP16(x)==tc16_flo)
+# define CPLXP(x) (CAR(x)==tc_dblc)
+# define REAL(x) (*(((dbl *) (SCM2PTR(x)))->real))
+# define IMAG(x) (*((double *)(CHARS(x)+sizeof(double))))
+/* ((&REAL(x))[1]) */
+# ifdef SINGLES
+#  define REALP(x) ((~REAL_PART & CAR(x))==tc_flo)
+#  define SINGP(x) (CAR(x)==tc_flo)
+#  define FLO(x) (((flo *)(SCM2PTR(x)))->num)
+#  define REALPART(x) (SINGP(x)?0.0+FLO(x):REAL(x))
+# else /* SINGLES */
+#  define REALP(x) (CAR(x)==tc_dblr)
+#  define REALPART REAL
+# endif /* SINGLES */
+#endif
+
+#ifdef FLOATS
+# define NUMBERP(x) (INUMP(x) || (NIMP(x) && NUMP(x)))
+#else
+# ifdef BIGDIG
+#  define NUMBERP(x) (INUMP(x) || (NIMP(x) && NUMP(x)))
+# else
+#  define NUMBERP INUMP
+# endif
+#endif
+#define NUMP(x) ((0xfcff & (int)CAR(x))==tc7_smob)
+#define BIGP(x) (TYP16S(x)==tc16_bigpos)
+#define BIGSIGN(x) (0x0100 & (int)CAR(x))
+#define BDIGITS(x) ((BIGDIG *)(CDR(x)))
+#define NUMDIGS(x) ((sizet)(CAR(x)>>16))
+#define SETNUMDIGS(x, v, t) CAR(x) = (((v)+0L)<<16)+(t)
+
+#define SNAME(x) ((CAR(x)>>8)?(SCM)(heap_org+(CAR(x)>>8)):nullstr)
+#define SUBRF(x) (((subr *)(SCM2PTR(x)))->cproc)
+#define DSUBRF(x) (((dsubr *)(SCM2PTR(x)))->dproc)
+#define CCLO_SUBR(x) (VELTS(x)[0])
+
+#define SYMBOLP(x) (TYP7S(x)==tc7_ssymbol)
+#define STRINGP(x) (TYP7(x)==tc7_string)
+#define NSTRINGP(x) (!STRINGP(x))
+#define VECTORP(x) (TYP7(x)==tc7_vector)
+#define NVECTORP(x) (!VECTORP(x))
+#define LENGTH(x) (((unsigned long)CAR(x))>>8)
+#define LENGTH_MAX (0xffffffL)
+#define SETLENGTH(x, v, t) CAR(x) = ((v)<<8)+(t)
+#define CHARS(x) ((char *)(CDR(x)))
+#define UCHARS(x) ((unsigned char *)(CDR(x)))
+#define VELTS(x) ((SCM *)CDR(x))
+#define SETCHARS SETCDR
+#define SETVELTS SETCDR
+
+extern long tc16_array;
+#define ARRAYP(a) (tc16_array==TYP16(a))
+#define ARRAY_V(a) (((array *)CDR(a))->v)
+/*#define ARRAY_NDIM(x) NUMDIGS(x)*/
+#define ARRAY_NDIM(x) ((sizet)(CAR(x)>>17))
+#define ARRAY_CONTIGUOUS 0x10000
+#define ARRAY_CONTP(x) (ARRAY_CONTIGUOUS & (int)CAR(x))
+#define ARRAY_BASE(a) (((array *)CDR(a))->base)
+#define ARRAY_DIMS(a) ((array_dim *)(CHARS(a)+sizeof(array)))
+
+#define FREEP(x) (CAR(x)==tc_free_cell)
+#define NFREEP(x) (!FREEP(x))
+
+#define SMOBNUM(x) (0x0ff & (CAR(x)>>8));
+#define PTOBNUM(x) (0x0ff & (CAR(x)>>8));
+
+#define DIGITS '0':case '1':case '2':case '3':case '4':\
+		case '5':case '6':case '7':case '8':case '9'
+
+/* Aggregated types for dispatch in switch statements. */
+
+#define tcs_cons_imcar 2:case 4:case 6:case 10:\
+		 case 12:case 14:case 18:case 20:\
+		 case 22:case 26:case 28:case 30:\
+		 case 34:case 36:case 38:case 42:\
+		 case 44:case 46:case 50:case 52:\
+		 case 54:case 58:case 60:case 62:\
+		 case 66:case 68:case 70:case 74:\
+		 case 76:case 78:case 82:case 84:\
+		 case 86:case 90:case 92:case 94:\
+		 case 98:case 100:case 102:case 106:\
+		 case 108:case 110:case 114:case 116:\
+		 case 118:case 122:case 124:case 126
+#define tcs_cons_nimcar 0:case 8:case 16:case 24:\
+		 case 32:case 40:case 48:case 56:\
+		 case 64:case 72:case 80:case 88:\
+		 case 96:case 104:case 112:case 120
+#define tcs_cons_gloc 1:case 9:case 17:case 25:\
+		 case 33:case 41:case 49:case 57:\
+		 case 65:case 73:case 81:case 89:\
+		 case 97:case 105:case 113:case 121
+
+#define tcs_closures   3:case 11:case 19:case 27:\
+		 case 35:case 43:case 51:case 59:\
+		 case 67:case 75:case 83:case 91:\
+		 case 99:case 107:case 115:case 123
+#define tcs_subrs tc7_asubr:case tc7_subr_0:case tc7_subr_1:case tc7_cxr:\
+	case tc7_subr_3:case tc7_subr_2:case tc7_rpsubr:case tc7_subr_1o:\
+	case tc7_subr_2o:case tc7_lsubr_2:case tc7_lsubr
+#define tcs_symbols tc7_ssymbol:case tc7_msymbol
+#define tcs_bignums tc16_bigpos:case tc16_bigneg
+
+#define tc3_cons	0
+#define tc3_cons_gloc	1
+#define tc3_closure	3
+
+#define tc7_ssymbol	5
+#define tc7_msymbol	7
+#define tc7_string	13
+#define tc7_vector	15
+#define tc7_bvect	21
+/* spare 23 */
+#define tc7_ivect	29
+#define tc7_uvect	31
+/* spare 37 39 */
+#define tc7_fvect	45
+#define tc7_dvect	47
+#define tc7_cvect	53
+#define tc7_port	55
+#define tc7_contin	61
+#define tc7_cclo	63
+
+/* spare 69 71 77 79 */
+#define tc7_subr_0	85
+#define tc7_subr_1	87
+#define tc7_cxr		93
+#define tc7_subr_3	95
+#define tc7_subr_2	101
+#define tc7_asubr	103
+#define tc7_subr_1o	109
+#define tc7_subr_2o	111
+#define tc7_lsubr_2	117
+#define tc7_lsubr	119
+#define tc7_rpsubr	125
+
+#define tc7_smob	127
+#define tc_free_cell	127
+
+#define tc16_flo	0x017f
+#define tc_flo		0x017fL
+
+#define REAL_PART	(1L<<16)
+#define IMAG_PART	(2L<<16)
+#define tc_dblr		(tc16_flo|REAL_PART)
+#define tc_dblc		(tc16_flo|REAL_PART|IMAG_PART)
+
+#define tc16_bigpos	0x027f
+#define tc16_bigneg	0x037f
+
+#define OPN		(1L<<16)
+#define RDNG		(2L<<16)
+#define WRTNG		(4L<<16)
+#define BUF0		(8L<<16)
+#define CRDY		(32L<<16)
+#define CUC		0x001fffffL
+
+extern sizet numsmob, numptob;
+extern smobfuns *smobs;
+extern ptobfuns *ptobs;
+extern ptobfuns pipob;
+#define tc16_fport (tc7_port + 0*256L)
+#define tc16_pipe (tc7_port + 1*256L)
+#define tc16_strport (tc7_port + 2*256L)
+#define tc16_sfport (tc7_port + 3*256L)
+extern long tc16_dir;
+
+extern SCM sys_protects[];
+#define cur_inp sys_protects[0]
+#define cur_outp sys_protects[1]
+#define cur_errp sys_protects[2]
+#define def_inp sys_protects[3]
+#define def_outp sys_protects[4]
+#define def_errp sys_protects[5]
+#define listofnull sys_protects[6]
+#define undefineds sys_protects[7]
+#define nullvect sys_protects[8]
+#define nullstr sys_protects[9]
+#define progargs sys_protects[10]
+#define transcript sys_protects[11]
+#define rootcont sys_protects[12]
+#define dynwinds sys_protects[13]
+#define stacktrace sys_protects[14]
+#ifdef FLOATS
+# define flo0 sys_protects[15]
+# define NUM_PROTECTS 16
+#else
+# define NUM_PROTECTS 15
+#endif
+
+/* now for connects between source files */
+
+extern sizet num_finals;
+extern void (**finals)P((void));
+extern unsigned char upcase[], downcase[];
+extern SCM symhash;
+extern int symhash_dim;
+extern long heap_size;
+extern CELLPTR heap_org;
+extern SCM freelist;
+extern long gc_cells_collected, gc_malloc_collected, gc_ports_collected;
+extern long gc_syms_collected;
+extern long cells_allocated, lcells_allocated, mallocated, lmallocated;
+extern long mtrigger;
+extern SCM *loc_loadpath;
+extern SCM *loc_errobj;
+extern SCM loadport;
+extern long linum;
+extern int errjmp_bad, ints_disabled, sig_deferred, alrm_deferred;
+extern SCM exitval;
+extern int cursinit;
+extern unsigned int poll_count, tick_count;
+extern int dumped;
+extern char *execpath;
+
+/* strings used in several source files */
+
+extern char s_read[], s_write[], s_newline[], s_system[];
+extern char s_make_string[], s_make_vector[], s_list[], s_op_pipe[];
+#define s_string (s_make_string+5)
+#define s_vector (s_make_vector+5)
+#define s_pipe (s_op_pipe+5)
+extern char s_make_sh_array[];
+#define s_array (s_make_sh_array+12)
+extern char s_ccl[];
+#define s_limit (s_ccl+10)
+extern char s_close_port[];
+#define s_port_type (s_close_port+6)
+
+/* function prototypes */
+
+void	gc_mark P((SCM p));
+void	han_sig P((void));
+void	han_alrm P((void));
+char	*must_malloc P((long len, char *what));
+char	*must_realloc P((char *where, long olen, long len, char *what));
+void	must_free P((char *obj));
+long	ilength P((SCM sx));
+SCM	hash P((SCM obj, SCM n));
+SCM	hashv P((SCM obj, SCM n));
+SCM	hashq P((SCM obj, SCM n));
+SCM	obhash P((SCM obj));
+SCM	obunhash P((SCM obj));
+unsigned long strhash P((unsigned char *str, sizet len, unsigned long n));
+unsigned long hasher P((SCM obj, unsigned long n, sizet d));
+SCM	repl_driver P((char *initpath));
+SCM	lroom P((SCM args));
+long	newsmob P((smobfuns *smob));
+long	newptob P((ptobfuns *ptob));
+void	prinport P((SCM exp, SCM port, char *type));
+void	repl P((void));
+void	growth_mon P((char *obj, long size, char *units));
+void	gc_start P((char *what));
+void	gc_end P((void));
+void	heap_report P((void));
+void	exit_report P((void));
+void	stack_report P((void));
+void	iprin1 P((SCM exp, SCM port, int writing));
+void	intprint P((long n, int radix, SCM port));
+void	iprlist P((char *hdr, SCM exp, int tlr, SCM port, int writing));
+void	lputc P((int c, SCM port));
+void	lputs P((char *s, SCM port));
+int	lfwrite P((char *ptr, sizet size, sizet nitems, SCM port));
+int	lgetc P((SCM port));
+void	lungetc P((int c, SCM port));
+char	*grow_tok_buf P((SCM tok_buf));
+long	mode_bits P((char *modes));
+long	time_in_msec P((long x));
+SCM	my_time P((void));
+SCM	your_time P((void));
+void	init_iprocs P((iproc *subra, int type));
+void	init_scm P((int iverbose, int buf0stdin, long init_heap_size));
+SCM	scm_init_extensions P((void));
+void	ignore_signals P((void));
+void	unignore_signals P((void));
+void	free_storage P((void));
+void	add_feature P((char *str));
+int	raprin1 P((SCM exp, SCM port, int writing));
+SCM	markcdr P((SCM ptr));
+SCM	mark0 P((SCM ptr));
+SCM	equal0 P((SCM ptr1, SCM ptr2));
+sizet	free0 P((CELLPTR ptr));
+void	warn P((char *str1, char *str2));
+void	everr P((SCM exp, SCM env, SCM arg, char *pos, char *s_subr));
+void	wta P((SCM arg, char *pos, char *s_subr));
+SCM	intern P((char *name, sizet len));
+SCM	sysintern P((char *name, SCM val));
+SCM	sym2vcell P((SCM sym));
+SCM	makstr P((long len));
+SCM	make_subr P((char *name, int type, SCM (*fcn)()));
+SCM	closure P((SCM code, SCM env));
+SCM	makprom P((SCM code));
+SCM	force P((SCM x));
+SCM	makarb P((SCM name));
+SCM	tryarb P((SCM arb));
+SCM	relarb P((SCM arb));
+SCM	ceval P((SCM x, SCM env));
+SCM	prolixity P((SCM arg));
+SCM	gc_for_newcell P((void));
+SCM	gc P((void));
+SCM	tryload P((SCM filename));
+SCM	acons P((SCM w, SCM x, SCM y));
+SCM	cons2 P((SCM w, SCM x, SCM y));
+SCM	resizuve P((SCM vect, SCM len));
+SCM	lnot P((SCM x));
+SCM	booleanp P((SCM obj));
+SCM	eq P((SCM x, SCM y));
+SCM	equal P((SCM x, SCM y));
+SCM	consp P((SCM x));
+SCM	cons P((SCM x, SCM y));
+SCM	nullp P((SCM x));
+SCM	setcar P((SCM pair, SCM value));
+SCM	setcdr P((SCM pair, SCM value));
+SCM	listp P((SCM x));
+SCM	list P((SCM objs));
+SCM	length P((SCM x));
+SCM	append P((SCM args));
+SCM	reverse P((SCM lst));
+SCM	list_ref P((SCM lst, SCM k));
+SCM	memq P((SCM x, SCM lst));
+SCM	member P((SCM x, SCM lst));
+SCM	memv P((SCM x, SCM lst));
+SCM	assq P((SCM x, SCM alist));
+SCM	assoc P((SCM x, SCM alist));
+SCM	symbolp P((SCM x));
+SCM	symbol2string P((SCM s));
+SCM	string2symbol P((SCM s));
+SCM	numberp P((SCM x));
+SCM	exactp P((SCM x));
+SCM	inexactp P((SCM x));
+SCM	eqp P((SCM x, SCM y));
+SCM	lessp P((SCM x, SCM y));
+SCM	zerop P((SCM z));
+SCM	positivep P((SCM x));
+SCM	negativep P((SCM x));
+SCM	oddp P((SCM n));
+SCM	evenp P((SCM n));
+SCM	lmax P((SCM x, SCM y));
+SCM	lmin P((SCM x, SCM y));
+SCM	sum P((SCM x, SCM y));
+SCM	difference P((SCM x, SCM y));
+SCM	product P((SCM x, SCM y));
+SCM	divide P((SCM x, SCM y));
+SCM	lquotient P((SCM x, SCM y));
+SCM	absval P((SCM x));
+SCM	lremainder P((SCM x, SCM y));
+SCM	modulo P((SCM x, SCM y));
+SCM	lgcd P((SCM x, SCM y));
+SCM	llcm P((SCM n1, SCM n2));
+SCM	number2string P((SCM x, SCM radix));
+SCM	istring2number P((char *str, long len, long radix));
+SCM	string2number P((SCM str, SCM radix));
+SCM	istr2flo P((char *str, long len, long radix));
+SCM	mkbig P((sizet nlen, int sign));
+SCM	mkstrport P((SCM pos, SCM str, long modes, char *caller));
+SCM	long2big P((long n));
+SCM	ulong2big P((unsigned long n));
+SCM	big2inum P((SCM b, sizet l));
+sizet	iint2str P((long num, int rad, char *p));
+SCM	floequal P((SCM x, SCM y));
+SCM	uve_equal P((SCM u, SCM v));
+SCM	raequal P((SCM ra0, SCM ra1));
+SCM	array_equal P((SCM u, SCM v));
+int     rafill P((SCM ra, SCM fill, SCM ignore));
+SCM	uve_fill P((SCM uve, SCM fill));
+SCM	array_fill P((SCM ra, SCM fill));
+SCM	array_prot P((SCM ra));
+int	bigprint P((SCM exp, SCM port, int writing));
+int	floprint P((SCM sexp, SCM port, int writing));
+SCM	istr2int P((char *str, long len, long radix));
+SCM	istr2bve P((char *str, long len));
+void	ipruk P((char *hdr, SCM ptr, SCM port));
+SCM	charp P((SCM x));
+SCM	char_lessp P((SCM x, SCM y));
+SCM	chci_eq P((SCM x, SCM y));
+SCM	chci_lessp P((SCM x, SCM y));
+SCM	char_alphap P((SCM chr));
+SCM	char_nump P((SCM chr));
+SCM	char_whitep P((SCM chr));
+SCM	char_upperp P((SCM chr));
+SCM	char_lowerp P((SCM chr));
+SCM	char2int P((SCM chr));
+SCM	int2char P((SCM n));
+SCM	char_upcase P((SCM chr));
+SCM	char_downcase P((SCM chr));
+SCM	stringp P((SCM x));
+SCM	string P((SCM chrs));
+SCM	make_string P((SCM k, SCM chr));
+SCM	string2list P((SCM str));
+SCM	st_length P((SCM str));
+SCM	st_ref P((SCM str, SCM k));
+SCM	st_set P((SCM str, SCM k, SCM chr));
+SCM	st_equal P((SCM s1, SCM s2));
+SCM	stci_equal P((SCM s1, SCM s2));
+SCM	st_lessp P((SCM s1, SCM s2));
+SCM	stci_lessp P((SCM s1, SCM s2));
+SCM	substring P((SCM str, SCM start, SCM end));
+SCM	st_append P((SCM args));
+SCM	vectorp P((SCM x));
+SCM	vector_length P((SCM v));
+SCM	vector P((SCM l));
+SCM	vector_ref P((SCM v, SCM k));
+SCM	vector_set P((SCM v, SCM k, SCM obj));
+SCM	make_vector P((SCM k, SCM fill));
+SCM	vector2list P((SCM v));
+SCM	for_each P((SCM proc, SCM arg1, SCM args));
+SCM	procedurep P((SCM obj));
+SCM	apply P((SCM proc, SCM arg1, SCM args));
+SCM	map P((SCM proc, SCM arg1, SCM args));
+SCM	scm_make_cont P((void));
+SCM	copytree P((SCM obj));
+SCM	eval P((SCM obj));
+SCM	input_portp P((SCM x));
+SCM	output_portp P((SCM x));
+SCM	cur_input_port P((void));
+SCM	cur_output_port P((void));
+SCM	i_setbuf0 P((SCM port));
+SCM	open_file P((SCM filename, SCM modes));
+SCM	open_pipe P((SCM pipestr, SCM modes));
+SCM	close_port P((SCM port));
+SCM	lread P((SCM port));
+SCM	scm_read_char P((SCM port));
+SCM	peek_char P((SCM port));
+SCM	eof_objectp P((SCM x));
+SCM	lwrite P((SCM obj, SCM port));
+SCM	display P((SCM obj, SCM port));
+SCM	newline P((SCM port));
+SCM	write_char P((SCM chr, SCM port));
+SCM	file_position P((SCM port));
+SCM	file_set_position P((SCM port, SCM pos));
+SCM	lgetenv P((SCM nam));
+SCM	prog_args P((void));
+SCM	makacro P((SCM code));
+SCM	makmacro P((SCM code));
+SCM	makmmacro P((SCM code));
+void	poll_routine P((void));
+void	tick_signal P((void));
+void	stack_check P((void));
+SCM	list2ura P((SCM ndim, SCM prot, SCM lst));
+SCM	make_ra P((int ndim));
+SCM	makflo P((float x));
+SCM	arrayp P((SCM v, SCM prot));
+SCM	array_contents P((SCM ra, SCM strict));
+SCM     uve_read P((SCM v, SCM port));
+SCM     uve_write P((SCM v, SCM port));
+SCM     ura_read P((SCM v, SCM port));
+SCM     ura_write P((SCM v, SCM port));
+SCM	aset P((SCM v, SCM obj, SCM args));
+SCM	aref P((SCM v, SCM args));
+SCM	cvref P((SCM v, sizet pos, SCM last));
+SCM	quit P((SCM n));
+void	add_final P((void (*final)(void)));
+SCM	makcclo P((SCM proc, long len));
+SCM	make_uve P((long k, SCM prot));
+SCM	ra2contig P((SCM ra, int copy));
+SCM	sc2array P((SCM s, SCM ra, SCM prot));
+SCM	array_copy P((SCM src, SCM dst));
+long	aind P((SCM ra, SCM args, char *what));
+SCM	scm_eval_string P((SCM str));
+SCM	scm_load_string P((SCM str));
+void	scm_print_stack P((SCM stk));
+char *	dld_find_executable P((const char* command));
+SCM	scm_unexec P((const SCM pathname));
+char *	scm_cat_path P((char *str1, const char *str2, long n));
+
+				/* Defined in "rope.c" */
+SCM	 long2num P((long n));
+SCM	ulong2num P((unsigned long n));
+unsigned char  num2uchar  P((SCM num, char *pos, char *s_caller));
+unsigned short num2ushort P((SCM num, char *pos, char *s_caller));
+unsigned long  num2ulong  P((SCM num, char *pos, char *s_caller));
+	 long  num2long   P((SCM num, char *pos, char *s_caller));
+        double num2dbl    P((SCM num, char *pos, char *s_caller));
+SCM	makfromstr  P((char *src, sizet len));
+SCM	makfromstrs P((int argc, char **argv));
+SCM	makfrom0str P((char *scr));
+char  **makargvfrmstrs P((SCM args, char *s_v));
+void	must_free_argv P((char **argv));
+SCM	scm_evstr  P((char *str));
+void	scm_ldstr  P((char *str));
+int	scm_ldfile P((char *path));
+int	scm_ldprog P((char *path));
+unsigned long scm_addr P((SCM args, char *name));
+
+#ifdef FLOATS
+SCM	makdbl P((double x, double y));
+SCM	dbl2big P((double d));
+double	big2dbl P((SCM b));
+double	lasinh P((double x));
+double	lacosh P((double x));
+double	latanh P((double x));
+double	ltrunc P((double x));
+double	round P((double x));
+double	floident P((double x));
+#endif
+
+#ifdef BIGDIG
+void	longdigs P((long x, BIGDIG digs [DIGSPERLONG ]));
+SCM	adjbig P((SCM b, sizet nlen));
+SCM	normbig P((SCM b));
+SCM	copybig P((SCM b, int sign));
+SCM	addbig P((BIGDIG *x, sizet nx, int xsgn, SCM bigy, int sgny));
+SCM	mulbig P((BIGDIG *x, sizet nx, BIGDIG *y, sizet ny, int sgn));
+unsigned int divbigdig P((BIGDIG *ds, sizet h, BIGDIG div));
+SCM	divbigint P((SCM x, long z, int sgn, int mode));
+SCM	divbigbig P((BIGDIG *x, sizet nx, BIGDIG *y, sizet ny, int sgn,
+		   int modes));
+long	 pseudolong P((long x));
+#endif
+int	bigcomp P((SCM x, SCM y));
+SCM	bigequal P((SCM x, SCM y));
+
+#ifdef RECKLESS
+# define ASSERT(_cond, _arg, _pos, _subr) ;
+# define ASRTGO(_cond, _label) ;
+#else
+# define ASSERT(_cond, _arg, _pos, _subr) if(!(_cond))wta(_arg, (char *)(_pos), _subr);
+# define ASRTGO(_cond, _label) if(!(_cond)) goto _label;
+#endif
+
+#define ARGn 0
+#define ARG1 1
+#define ARG2 2
+#define ARG3 3
+#define ARG4 4
+#define ARG5 5
+  /* following must match entry indexes in errmsgs[] */
+#define WNA 6
+#define OVFLOW 7
+#define OUTOFRANGE 8
+#define NALLOC 9
+#define EXIT 10
+#define HUP_SIGNAL 11
+#define INT_SIGNAL 12
+#define FPE_SIGNAL 13
+#define BUS_SIGNAL 14
+#define SEGV_SIGNAL 15
+#define ALRM_SIGNAL 16
+
+#define EVAL(x, env) (IMP(x)?(x):ceval((x), (env)))
+#define SIDEVAL(x, env) if NIMP(x) ceval((x), (env))
+
+#define NEWCELL(_into) {if IMP(freelist) _into = gc_for_newcell();\
+	else {_into = freelist;freelist = CDR(freelist);++cells_allocated;}}
+
+#ifdef __cplusplus
+}
+#endif
diff --git a/scm.texi b/scm.texi
new file mode 100644
index 0000000..d7270f6
--- /dev/null
+++ b/scm.texi
@@ -0,0 +1,6911 @@
+\input texinfo @c -*-texinfo-*-
+@c %**start of header
+@setfilename scm.info
+@settitle SCM
+@setchapternewpage on
+@c Choices for setchapternewpage are {on,off,odd}.
+@paragraphindent 2
+@c %**end of header
+
+@iftex
+@finalout
+@c DL: lose the egregious vertical whitespace, esp. around examples
+@c but paras in @defun-like things don't have parindent
+@parskip 4pt plus 1pt
+@end iftex
+
+@titlepage
+@title SCM
+@subtitle Scheme Implementation
+@subtitle Version 4e6
+@subtitle March 1996
+@author by Aubrey Jaffer
+
+@page
+@vskip 0pt plus 1filll
+Copyright @copyright{} 1990, 1991, 1992, 1993, 1994, 1995, 1996 Free Software Foundation
+
+Permission is granted to make and distribute verbatim copies of
+this manual provided the copyright notice and this permission notice
+are preserved on all copies.
+
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided that the entire
+resulting derived work is distributed under the terms of a permission
+notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions,
+except that this permission notice may be stated in a translation approved
+by the author.
+@end titlepage
+
+@node Top, Copying, (dir), (dir)
+
+
+@ifinfo
+This manual documents the SCM Scheme implementation.  The most recent
+information about SCM can be found on SCM's @dfn{WWW} home page:
+@center http://www-swiss.ai.mit.edu/~jaffer/SCM.html
+
+
+Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996 Free Software Foundation
+
+Permission is granted to make and distribute verbatim copies of
+this manual provided the copyright notice and this permission notice
+are preserved on all copies.
+
+@ignore
+Permission is granted to process this file through TeX and print the
+results, provided the printed document carries copying permission
+notice identical to this one except for the removal of this paragraph
+(this paragraph not being relevant to the printed manual).
+
+@end ignore
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided that the entire
+resulting derived work is distributed under the terms of a permission
+notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions,
+except that this permission notice may be stated in a translation approved
+by the author.
+@end ifinfo
+
+@menu
+* Copying::                     Conditions for copying and changing SCM.
+* Overview::                    Whats here and how to start using it.
+* Installing SCM::              Where it goes and how to get it there.
+* The Language::                Reference.
+* Packages::                    Optional Capabilities.
+* The Implementation::          How it works.
+* Procedure and Macro Index::   
+* Variable Index::              
+* Type Index::                  
+@end menu
+
+@node Copying, Overview, Top, Top
+@chapter Copying
+
+@center COPYRIGHT (c) 1989 BY
+@center PARADIGM ASSOCIATES INCORPORATED, CAMBRIDGE, MASSACHUSETTS.
+@center ALL RIGHTS RESERVED
+
+@noindent
+Permission to use, copy, modify, distribute and sell this software
+and its documentation for any purpose and without fee is hereby
+granted, 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 Paradigm Associates
+Inc not be used in advertising or publicity pertaining to distribution
+of the software without specific, written prior permission.
+
+@noindent
+PARADIGM DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL
+PARADIGM 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.
+
+@noindent
+gjc@@paradigm.com
+@flushright
+Phone: 617-492-6079
+@end flushright
+@flushleft
+Paradigm Associates Inc
+29 Putnam Ave, Suite 6
+Cambridge, MA 02138
+@end flushleft
+
+@sp 2
+
+@center Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995
+@center Free Software Foundation, Inc.
+@center 675 Mass Ave, Cambridge, MA 02139, USA
+
+@noindent
+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.
+
+@center NO WARRANTY
+
+@noindent
+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.
+
+@noindent
+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.
+
+@node Overview, Installing SCM, Copying, Top
+@chapter Overview
+
+@noindent
+Scm is a portable Scheme implementation written in C.  Scm provides a
+machine independent platform for [JACAL], a symbolic algebra system.
+
+@iftex
+@noindent
+The most recent information about SCM can be found on SCM's @dfn{WWW}
+home page:
+@ifset html
+<A HREF="http://www-swiss.ai.mit.edu/~jaffer/SCM.html">
+@end ifset
+
+@center http://www-swiss.ai.mit.edu/~jaffer/SCM.html
+
+@ifset html
+</A>
+@end ifset
+@end iftex
+
+@menu
+* SCM Features::                
+* SCM Authors::                 
+* Bibliography::                
+* Invoking SCM::                
+* SCM Options::                 
+* SCM Variables::               
+* SCM Examples::                
+* SCM Session::                 
+* Editing Scheme Code::         
+* Debugging Scheme Code::       
+@end menu
+
+@node SCM Features, SCM Authors, Overview, Overview
+@section Features
+
+@itemize @bullet
+@item
+Conforms to Revised^4 Report on the Algorithmic Language Scheme [R4RS]
+and the [IEEE] P1178 specification.
+@item
+Support for [SICP], [R2RS], [R3RS], and (proposed) [R5RS] scheme code.
+@item
+Runs under Amiga, Atari-ST, MacOS, MS-DOS, OS/2, NOS/VE, Unicos, VMS,
+Unix and similar systems.  Supports ASCII and EBCDIC character sets.
+@item
+Is fully documented in @TeX{}info form, allowing documentation to be
+generated in info, @TeX{}, html, nroff, and troff formats.
+@item
+Supports inexact real and complex numbers, 30 bit immediate integers and
+large precision integers.
+@item
+Many Common Lisp functions: @code{logand}, @code{logor}, @code{logxor},
+@code{lognot}, @code{ash}, @code{logcount}, @code{integer-length},
+@code{bit-extract}, @code{defmacro}, @code{macroexpand},
+@code{macroexpand1}, @code{gentemp}, @code{defvar}, @code{force-output},
+@code{software-type}, @code{get-decoded-time},
+@code{get-internal-run-time}, @code{get-internal-real-time},
+@code{delete-file}, @code{rename-file}, @code{copy-tree}, @code{acons},
+and @code{eval}.
+@item
+@code{Char-code-limit}, @code{most-positive-fixnum},
+@code{most-negative-fixnum}, @code{and internal-time-units-per-second}
+constants.  @code{*Features*} and @code{*load-pathname*} variables.
+@item
+Arrays and bit-vectors.  String ports and software emulation ports.
+I/O extensions providing ANSI C and POSIX.1 facilities.
+@item
+Interfaces to standard libraries including REGEX string regular
+expression matching and the CURSES screen management package.
+@item
+Available add-on packages including an interactive debugger, database,
+X-window graphics, BGI graphics, Motif, and Open-Windows packages.
+@item
+A compiler (HOBBIT, available separately) and dynamic linking of
+compiled modules.
+@item
+User definable responses to interrupts and errors,
+Process-syncronization primitives.  Setable levels of monitoring and
+timing information printed interactively (the @code{verbose} function).
+@code{Restart}, @code{quit}, and @code{exec}.
+@end itemize
+
+@node SCM Authors, Bibliography, SCM Features, Overview
+@section Authors
+
+@table @b
+@item Aubrey Jaffer (jaffer@@ai.mit.edu)
+Most of SCM.
+@item Radey Shouman
+Arrays. @code{gsubr}s, compiled closures, and records.
+@item Jerry D. Hedden
+Real and Complex functions.  Fast mixed type arithmetics.
+@item Hugh Secker-Walker
+Syntax checking and memoization of special forms by evaluator.  Storage
+allocation strategy and parameters.
+@item George Carrette
+@dfn{Siod}, written by George Carrette, was the starting point for SCM.
+The major innovations taken from Siod are the evaluator's use of the
+C-stack and being able to garbage collect off the C-stack
+(@pxref{Garbage Collection}).
+@end table
+
+@noindent
+There are many other contributors to SCM.  They are acknowledged in the
+file @file{ChangeLog}, a log of changes that have been made to scm.
+
+@node Bibliography, Invoking SCM, SCM Authors, Overview
+@section Bibliography
+
+@table @asis
+@item [IEEE]
+@pindex IEEE
+@cite{IEEE Standard 1178-1990.  IEEE Standard for the Scheme
+Programming Language.}  IEEE, New York, 1991.
+
+@item [Simply]
+@pindex Simply
+Brian Harvey and Matthew Wright.
+@ifset html
+<A HREF="http://HTTP.CS.Berkeley.EDU/~bh/simply-toc.html">
+@end ifset
+@cite{Simply Scheme: Introducing Computer Science}
+@ifset html
+</A>
+@end ifset
+MIT Press, 1994 ISBN 0-262-08226-8
+
+@item [SICP]
+@pindex SICP
+Harold Abelson and Gerald Jay Sussman with Julie Sussman.
+@cite{Structure and Interpretation of Computer Programs.}
+MIT Press, Cambridge, 1985.
+
+@item [R4RS]
+@pindex R4RS
+William Clinger and Jonathan Rees, Editors.
+@ifset html
+<A HREF="r4rs_toc.html">
+@end ifset
+Revised(4) Report on the Algorithmic Language Scheme.
+@ifset html
+</A>
+@end ifset
+@cite{ACM Lisp Pointers} Volume IV, Number 3 (July-September 1991),
+pp. 1-55.
+@ifinfo
+
+@ref{Top, , , r4rs, Revised(4) Report on the Algorithmic Language
+Scheme}.
+@end ifinfo
+
+@item [GUILE]
+@pindex GUILE
+Tom Lord.
+@ifset html
+<A HREF="http://www.cygnus.com/library/ctr/guile.html">
+@end ifset
+The Guile Architecture for Ubiquitous Computing.
+@ifset html
+</A>
+@end ifset
+@cite{Usenix Symposium on Tcl/Tk}, 1995.
+
+@item [SLIB]
+@pindex SLIB
+Todd R. Eigenschink, Dave Love, and Aubrey Jaffer.
+@ifset html
+<A HREF="slib_toc.html">
+@end ifset
+SLIB, The Portable Scheme Library.
+@ifset html
+</A>
+@end ifset
+Version 2a3, June 1995.
+@ifinfo
+
+@ref{Top, , , slib, SLIB}.
+@end ifinfo
+
+@item [JACAL]
+@pindex JACAL
+Aubrey Jaffer.
+@ifset html
+<A HREF="jacal_toc.html">
+@end ifset
+JACAL Symbolic Mathematics System.
+@ifset html
+</A>
+@end ifset
+Version 1a5, April 1994.
+@ifinfo
+
+@ref{Top, , , jacal, JACAL}.
+@end ifinfo
+@end table
+
+@table @file
+@item scm.texi
+@itemx scm.info
+Documentation of @code{scm} extensions (beyond Scheme standards).
+Documentation on the internal representation and how to extend or
+include @code{scm} in other programs.
+@end table
+
+@node Invoking SCM, SCM Options, Bibliography, Overview
+@section Invoking SCM
+
+@quotation
+@exdent @b{ scm } [-a @i{kbytes}] [-ibvqmu] [-p @i{number}]
+@w{[-c @i{expression}]} @w{[-e @i{expression}]} @w{[-f @i{filename}]}
+@w{[-l @i{filename}]} @w{[-r @i{feature}]} @w{[-- | - | -s]}
+@w{[@i{filename}]} @w{[@i{arguments} @dots{}]}
+@end quotation
+
+@noindent
+Upon startup @code{scm} loads the file specified by by the environment
+variable @var{SCM_INIT_PATH}.
+
+@noindent
+If @var{SCM_INIT_PATH} is not defined or if the file it names is not
+present, @code{scm} tries to find the directory containing the
+executable file.  If it is able to locate the executable, @code{scm}
+looks for the initialization file (usually @file{Init.scm}) in
+platform-dependent directories relative to this directory.
+@xref{File-System Habitat} for a blow-by-blow description.
+
+@noindent
+As a last resort (if initialization file cannot be located), the C
+compile parameter @var{IMPLINIT} (defined in the makefile or
+@file{scmfig.h}) is tried.
+
+@noindent
+Unless the option @code{-no-init-file} or @code{--no-init-file} occurs
+in the command line, @file{Init.scm} checks to see if there is file
+@file{ScmInit.scm} in the path specified by the environment variable
+@var{HOME} (or in the current directory if @var{HOME} is undefined). If
+it finds such a file it is loaded.
+
+@noindent
+@file{Init.scm} then looks for command input from one of three sources:
+From an option on the command line, from a file named on the command
+line, or from standard input.
+
+@noindent
+This explanation applies to SCMLIT or other builds of SCM.
+
+@noindent
+Scheme-code files can also invoke SCM and its variants.  @xref{Syntax
+Extensions, #!}.
+
+@node SCM Options, SCM Variables, Invoking SCM, Overview
+@section Options
+
+@noindent
+The options are processed in the order specified on the command line.
+
+@deffn {Command Option} -a kb
+specifies that @code{scm} should allocate an initial heapsize of
+@var{kb} kilobytes. This option, if present, must be the first on
+the command line.  If not specified, the default is
+@code{INIT_HEAP_SIZE} in source file @file{setjump.h} which the
+distribution sets at @code{25000*sizeof(cell)}.
+@end deffn
+
+@deffn {Command Option} -no-init-file
+@deffnx {Command Option} --no-init-file
+Inhibits the loading of @file{ScmInit.scm} as described above.
+@end deffn
+
+@deffn {Command Option} -e expression
+@deffnx {Command Option} -c expression
+specifies that the scheme expression @var{expression} is to be
+evaluated. These options are inspired by @code{perl} and @code{sh}
+respectively. On Amiga systems the entire option and argument need to be
+enclosed in quotes. For instance @samp{"-e(newline)"}.
+@end deffn
+
+@deffn {Command Option} -r feature
+requires @var{feature}. This will load a file from [SLIB] if that
+@var{feature} is not already supported. If @var{feature} is 2, 3, 4, or
+5 @code{scm} will require the features neccessary to support [R2RS],
+[R3RS], [R4RS], or proposed [R5RS], respectively.
+@end deffn
+
+@deffn {Command Option} -l filename
+@deffnx {Command Option} -f filename
+loads @var{filename}. @code{Scm} will load the first (unoptioned) file
+named on the command line if no @code{-c}, @code{-e}, @code{-f},
+@code{-l},  or @code{-s} option preceeds
+it.
+@end deffn
+
+@deffn {Command Option} -p level
+sets the prolixity (verboseness) to @var{level}. This is the same as
+the @code{scm} command (verobse @var{level}).
+@end deffn
+
+@deffn {Command Option} -v
+(verbose mode) specifies that @code{scm} will print prompts, evaluation
+times, notice of loading files, and garbage collection statistics. This
+is the same as @code{-p3}.
+@end deffn
+
+@deffn {Command Option} -q
+(quiet mode) specifies that @code{scm} will print no extra
+information. This is the same as @code{-p0}.
+@end deffn
+
+@deffn {Command Option} -m
+specifies that subsequent loads, evaluations, and user interactions will
+be with [R4RS] macro capability. To use a specific [R4RS] macro
+implementation from [SLIB] (instead of [SLIB]'s default) put @code{-r}
+@var{macropackage} before @code{-m} on the command line.
+@end deffn
+
+@deffn {Command Option} -u
+specifies that subsequent loads, evaluations, and user interactions will
+be without [R4RS] macro capability. [R4RS] macro capability can
+be restored by a subsequent @code{-m} on the command line or from Scheme
+code.
+@end deffn
+
+@deffn {Command Option} -i
+specifies that @code{scm} should run interactively. That means that
+@code{scm} will not terminate until the @code{(quit)} or @code{(exit)}
+command is given, even if there are errors. It also sets the prolixity
+level to 2 if it is less than 2. This will print prompts, evaluation
+times, and notice of loading files. The prolixity level can be set by
+subsequent options. If @code{scm} is started from a tty, it will assume
+that it should be interactive unless given a subsequent @code{-b}
+option.
+@end deffn
+
+@deffn {Command Option} -b
+specifies that @code{scm} should run non-interactively. That means that
+@code{scm} will terminate after processing the command line or if there
+are errors.
+@end deffn
+
+@deffn {Command Option} -s
+specifies, by analogy with @code{sh}, that further options are to be
+treated as program aguments.
+@end deffn
+
+@deffn {Command Option} -
+@deffnx {Command Option} --
+specifies that there are no more options on the command line.
+@end deffn
+
+@deffn {Command Option} -d filename
+loads SLIB database-utilities and opens @var{filename} as a database.
+@end deffn
+
+@deffn {Command Option} -o filename
+saves the current SCM session as the executable program @file{filename}.
+This option works only in SCM builds supporting @code{dump}
+(@pxref{Dump}).
+
+If options appear on the command line after @samp{-o @var{filename}},
+then the saved session will continue with processing those options when
+it is invoked.  Otherwise the (new) command line is processed as usual
+when the saved image is invoked.
+@end deffn
+
+@deffn {Command Option} --help
+prints usage information and URL; then exit.
+@end deffn
+
+@deffn {Command Option} --version
+prints version information and exit.
+@end deffn
+
+@node SCM Variables, SCM Examples, SCM Options, Overview
+@section Environment Variables
+
+@defvr {Environment Variable} SCM_INIT_PATH
+is the pathname where @code{scm} will look for its initialization
+code. The default is the file @file{Init.scm} in the source directory.
+@end defvr
+
+@defvr {Environment Variable} SCHEME_LIBRARY_PATH
+is the [SLIB] Scheme library directory.
+@end defvr
+
+@defvr {Environment Variable} HOME
+is the directory where @file{Init.scm} will look for the user
+initialization file @file{ScmInit.scm}.
+@end defvr
+
+@section Scheme Variables
+
+@defvar *argv*
+contains the list of arguments to the program. @code{*argv*} can change
+during argument processing. This list is suitable for use as an argument
+to [SLIB] @code{getopt}.
+@end defvar
+
+@defvar *R4RS-macro*
+controls whether loading and interaction support [R4RS] macros. Define
+this in @file{ScmInit.scm} or files specified on the command line. This
+can be overridden by subsequent @code{-m} and @code{-u} options.
+@end defvar
+
+@defvar *interactive*
+controls interactivity as explained for the @code{-i} and @code{-b}
+options. Define this in @file{ScmInit.scm} or files specified on the
+command line. This can be overridden by subsequent @code{-i} and
+@code{-b} options.
+@end defvar
+
+@node SCM Examples, SCM Session, SCM Variables, Overview
+@section Examples
+
+@table @code
+@item % scm foo.scm
+Loads and executes the contents of @file{foo.scm} and then enters
+interactive session.
+
+@item % scm -f foo.scm arg1 arg2 arg3
+Parameters @code{arg1}, @code{arg2}, and @code{arg3} are stored in the
+global list @code{*argv*}; Loads and executes the contents of
+@file{foo.scm} and exits.
+
+@item % scm -s foo.scm arg1 arg2
+Sets *argv* to @code{("foo.scm" "arg1" "arg2")} and enters interactive
+session.
+
+@item % scm -e `(write (list-ref *argv* *optind*))' bar
+Prints @samp{"bar"}.
+
+@item % scm -rpretty-print -r format -i
+Loads @code{pretty-print} and @code{format} and enters interactive
+session.
+
+@item % scm -r5
+Loads @code{dynamic-wind}, @code{values}, and [R4RS] macros and enters
+interactive (with macros) session.
+
+@item % scm -r5 -r4
+Like above but @code{rev4-optional-procedures} are also loaded.
+@end table
+
+@node SCM Session, Editing Scheme Code, SCM Examples, Overview
+@section SCM Session
+
+@itemize @bullet
+@item
+Options, file loading and features can be specified from the command
+line.  @xref{System interface, , , scm, SCM}.  @xref{Require, , , slib,
+SLIB}.
+@item
+Typing the end-of-file character at the top level session (while SCM is
+not waiting for parenthesis closure) causes SCM to exit.
+@item
+Typing the interrupt character aborts evaluation of the current form
+and resumes the top level read-eval-print loop.
+@end itemize
+
+@node Editing Scheme Code, Debugging Scheme Code, SCM Session, Overview
+@section Editing Scheme Code
+
+@table @asis
+@item Gnu Emacs:
+Editing of Scheme code is supported by emacs.  Buffers holding files
+ending in .scm are automatically put into scheme-mode.
+
+If your Emacs can run a process in a buffer you can use the Emacs
+command @samp{M-x run-scheme} with SCM.  However, the run-scheme
+(@file{xscheme.el}) which comes included with Gnu Emacs 18 will work
+only with MIT Cscheme.  If you are using Emacs 18, get the emacs
+packages:
+      
+@ifclear html
+@itemize @bullet
+@item
+ftp-swiss.ai.mit.edu:/pub/scheme-editor-packages/cmuscheme.el
+@item
+ftp-swiss.ai.mit.edu:/pub/scheme-editor-packages/comint.el
+@end itemize
+@end ifclear
+
+@ifset html
+<A HREF="file://ftp-swiss.ai.mit.edu/pub/scheme-editor-packages/cmuscheme.el">
+ftp-swiss.ai.mit.edu:/pub/scheme-editor-packages/cmuscheme.el
+</A>
+<A HREF="file://ftp-swiss.ai.mit.edu/pub/scheme-editor-packages/comint.el">
+ftp-swiss.ai.mit.edu:/pub/scheme-editor-packages/comint.el
+</A>
+@end ifset
+
+These files are already standard in Emacs 19.
+
+If your Emacs can not run a process in a buffer, see ``under other
+systems'' below.
+
+@item Epsilon (MS-DOS):
+There is lisp (and scheme) mode available by use of the package
+@samp{LISP.E}.  It offers several different indentation formats.  With
+this package, buffers holding files ending in @samp{.L}, @samp{.LSP},
+@samp{.S}, and @samp{.SCM} (my modification) are automatically put into
+lisp-mode.
+
+It is possible to run a process in a buffer under Epsilon.  With Epsilon
+5.0 the command line options @samp{-e512 -m0} are neccessary to manage
+RAM properly.  It has been reported that when compiling SCM with Turbo
+C, you need to @samp{#define NOSETBUF} for proper operation in a process
+buffer with Epsilon 5.0.
+
+One can also call out to an editor from SCM if RAM is at a premium; See
+``under other systems'' below.
+
+@item other systems:
+Define the environment variable @samp{EDITOR} to be the name of the
+editing program you use.  The SCM procedure @code{(ed arg1 @dots{})}
+will invoke your editor and return to SCM when you exit the editor.  The
+following definition is convenient:
+
+@example
+(define (e) (ed "work.scm") (load "work.scm"))
+@end example
+
+Typing @samp{(e)} will invoke the editor with the file of interest.
+After editing, the modified file will be loaded.
+@end table
+
+@node Debugging Scheme Code,  , Editing Scheme Code, Overview
+@section Debugging Scheme Code
+
+@noindent
+The @code{cautious} and @code{stack-limit} options of @code{build}
+(@pxref{Build Options}) support debugging in Scheme.
+
+@table @dfn
+@item CAUTIOUS
+If SCM is built with the @samp{CAUTIOUS} flag, then when an error
+occurs, a @dfn{stack trace} of certain pending calls are printed as part
+of the default error response.  A (memoized) expression and newline are
+printed for each partially evaluated combination whose procedure is not
+builtin.  @xref{Memoized Expressions} for how to read memoized
+expressions.
+
+Also as the result of the @samp{CAUTIOUS} flag, both @code{error} and
+@code{user-interrupt} (invoked by @key{C-c}) to print stack traces and
+conclude by calling @code{breakpoint} (@pxref{Breakpoints, , , slib,
+SLIB}) instead of aborting to top level.  Under either condition,
+program execution can be resumed by @code{(continue)}.
+
+In this configuration one can interrupt a running Scheme program with
+@key{C-c}, inspect or modify top-level values, trace or untrace
+procedures, and continue execution with @code{(continue)}.
+
+@item STACK_LIMIT
+If SCM is built with the @samp{STACK_LIMIT} flag, the interpreter will
+check stack size periodically.  If the size of stack exceeds a certain
+amount (default is @code{HEAP_SEG_SIZE/2}), SCM generates a
+@code{segment violation} interrupt.
+
+The usefulness of @samp{STACK_LIMIT} depends on the user.  I don't use
+it; but the user I added this feature for got primarily this type of
+error.
+@end table
+
+@noindent
+There are several SLIB macros which so useful that SCM automatically
+loads the appropriate module from SLIB if they are invoked.
+
+@defmac trace proc1 @dots{}
+Traces the top-level named procedures given as arguments.
+@defmacx trace
+With no arguments, makes sure that all the currently traced identifiers
+are traced (even if those identifiers have been redefined) and returns a
+list of the traced identifiers.
+@end defmac
+
+@defmac untrace proc1 @dots{}
+Turns tracing off for its arguments.
+@defmacx untrace
+With no arguments, untraces all currently traced identifiers and returns
+a list of these formerly traced identifiers.
+@end defmac
+
+The routine I use most for debugging is:
+
+@deffn Procedure print arg1 ...
+@code{Print} writes all its arguments, separated by spaces.
+@code{Print} outputs a @code{newline} at the end and returns the value
+of the last argument.
+
+One can just insert @samp{(print '<proc-name>} and @samp{)} around an
+expression in order to see its value as a program operates.
+@end deffn
+
+@noindent
+Sometimes more elaborate measures are needed to print values in a useful
+manner.  When the values to be printed may have very large (or infinite)
+external representations, @ref{Quick Print, , , slib, SLIB}, can be
+used.
+
+When @code{trace} is not sufficient to find program flow problems,
+@ifset html
+<A HREF="http://www.cs.tut.fi/staff/pk/scheme/psd/article/article.html">
+@end ifset
+SLIB-PSD, the Portable Scheme Debugger
+@ifset html
+</A>
+@end ifset
+offers source code debugging from
+GNU Emacs.  PSD runs slowly, so start by instrumenting only a few
+functions at a time.
+@lisp
+ftp-swiss.ai.mit.edu:pub/scm/slib-psd1-3.tar.gz
+prep.ai.mit.edu:pub/gnu/jacal/slib-psd1-3.tar.gz
+ftp.maths.tcd.ie:pub/bosullvn/jacal/slib-psd1-3.tar.gz
+ftp.cs.indiana.edu:/pub/scheme-repository/utl/slib-psd1-3.tar.gz
+@end lisp
+
+
+@node Installing SCM, The Language, Overview, Top
+@chapter Installing SCM
+
+@menu
+* File-System Habitat::         All the usual suspects.
+* Executable Pathname::         Where did I come from?
+* Making SCM::                  
+* Building SCM::                
+* SLIB::                        REQUIREd reading.
+* Installing Dynamic Linking::  
+* Saving Images::               Make Fast-Booting Executables
+* Automatic C Preprocessor Definitions::  
+* Problems Compiling::          
+* Problems Linking::            
+* Problems Running::            
+* Testing::                     
+* Reporting Problems::          
+@end menu
+
+@node File-System Habitat, Executable Pathname, Installing SCM, Installing SCM
+@section File-System Habitat
+
+@noindent
+Where should software reside?  Although individually a minor annoyance,
+cumulatively this question represents many thousands of frustrated user
+hours spent trying to find support files or guessing where packages need
+to be installed.  Even simple programs require proper habitat; games
+need to find their score files.
+
+@noindent
+Aren't there standards for this?  Some Operating Systems have devised
+regimes of software habitats -- only to have them violated by large
+software packages and imports from other OS varieties.
+
+@noindent
+In some programs, the expected locations of support files are fixed at
+time of compilation.  This means that the program may not run on
+configurations unanticipated by the authors.  Compiling locations into a
+program also can make it immovable -- necessitating recompilation to
+install it.
+
+@quotation
+Programs of the world unite!  You have nothing to lose but loss itself.
+@end quotation
+
+@noindent
+The function @code{scm_find_impl_file} in @file{scm.c} is an attempt to
+create a utility (for inclusion in programs) which will hide the details
+of platform-dependent file habitat conventions.  It takes as input the
+pathname of the executable file which is running.  If there are systems
+for which this information is either not available or unrelated to the
+locations of support files, then a higher level interface will be
+needed.
+
+@deftypefun char *scm_find_impl_file(char *@var{exec_path}, char
+*@var{generic_name}, char *@var{initname}, char *@var{sep}) Given the
+pathname of this executable (@var{exec_path}), test for the existence of
+@var{initname} in the implementation-vicinity of this program.  Return a
+newly allocated string of the path if successful, 0 if not.  The
+@var{sep} argument is a @emph{mull-terminated string} of the character
+used to separate directory components.
+@end deftypefun
+
+@itemize @bullet
+@item
+One convention is to install the support files for an executable program
+in the same directory as the program.  This possibility is tried first,
+which satisfies not only programs using this convention, but also
+uninstalled builds when testing new releases, etc.
+
+@item
+Another convention is to install the executables in a directory named
+@file{bin}, @file{BIN}, @file{exe}, or @file{EXE} and support files in a
+directroy named @file{lib}, which is a peer the executable directory.
+This arrangement allows multiple executables can be stored in a single
+directory.  For example, the executable might be in
+@samp{/usr/local/bin/} and initialization file in
+@samp{/usr/local/lib/}.
+
+If the executable directory name matches, the peer directroy @file{lib}
+is tested for @var{initname}.
+
+@item
+Sometimes @file{lib} directories become too crowded.  So we look in any
+subdirectories of @file{lib} or @file{src} having the name (sans type
+suffix such as @samp{.EXE}) of the program we are running.  For example,
+the executable might be @samp{/usr/local/bin/foo} and initialization
+file in @samp{/usr/local/lib/foo/}.
+
+@item
+But the executable name may not be the usual program name; So also look
+in any @var{generic_name} subdirectories of @file{lib} or @file{src}
+peers.
+
+@item
+Finally, if the name of the executable file being run has a (system
+dependent) suffix which is not needed to invoke the program, then look
+in a subdirectory (of the one containing the executable file) named for
+the executable (without the suffix); And look in a @var{generic_name}
+subdirectory.  For example, the executable might be
+@samp{C:\foo\bar.exe} and the initialization file in @samp{C:\foo\bar\}.
+@end itemize
+
+
+@node Executable Pathname, Making SCM, File-System Habitat, Installing SCM
+@section Executable Pathname
+
+@noindent
+When a program is executed by MS-DOS, the full pathname of that
+executable is available in @code{argv[0]}.  This value can be passed to
+@code{dld_find_executable} (@pxref{File-System Habitat}).
+
+In order to find the habitat for a unix program, we first need to know
+the full pathname for the associated executable file.
+
+@deftypefun char *dld_find_executable (const char *@var{command})
+@code{dld_find_executable} returns the absolute path name of the file
+that would be executed if @var{command} were given as a command.  It
+looks up the environment variable @var{PATH}, searches in each of the
+directory listed for @var{command}, and returns the absolute path name
+for the first occurrence.  Thus, it is advisable to invoke
+@code{dld_init} as:
+
+@example
+main (int argc, char **argv)
+@{
+    @dots{}
+    if (dld_init (dld_find_executable (argv[0]))) @{
+        @dots{}
+    @}
+    @dots{}
+@}
+@end example
+
+@quotation
+@strong{Note:} If the current process is executed using the
+@code{execve} call without passing the correct path name as argument 0,
+@code{dld_find_executable (argv[0]) } will also fail to locate the
+executable file.
+@end quotation
+
+@code{dld_find_executable} returns zero if @code{command} is not found
+in any of the directories listed in @code{PATH}.
+@end deftypefun
+
+@node Making SCM, Building SCM, Executable Pathname, Installing SCM
+@section Making SCM
+
+The SCM distribution has @dfn{Makefile} which contains rules for making
+@dfn{scmlit}, a ``bare-bones'' version of SCM sufficient for running
+@file{build.scm}.  @file{build.scm} is used to compile (or create
+scripts to compile) full featured versions.
+
+Makefiles are not portable to the majority of platforms.  If
+@file{Makefile} works for you, good; If not, I don't want to hear about
+it.  If you need to compile SCM without build.scm, there are several
+ways to proceed:
+
+@itemize @bullet
+@item
+Use SCM on a different platform to run @file{build.scm} to create a
+script to build SCM;
+
+@item
+Use another implementation of Scheme to run @file{build.scm} to create a
+script to build SCM;
+
+@item
+Create your own script or @file{Makefile}.
+
+@item
+Buy a SCM executable from jaffer@@ai.mit.edu.  See the end of the
+@file{ANNOUNCE} file in the distribution for details.
+
+@item
+Use scmconfig (From: bos@@scrg.cs.tcd.ie):
+
+Build and install scripts using GNU @dfn{autoconf} are available from
+@file{scmconfig4e6.tar.gz} in the distribution directories.  See
+@file{README.unix} in @file{scmconfig4e6.tar.gz} for further
+instructions.
+@end itemize
+
+
+@node Building SCM, SLIB, Making SCM, Installing SCM
+@section Building SCM
+
+The file @dfn{build.scm} builds and runs a relational database of how to
+compile and link SCM executables.  It has information for most platforms
+which SCM has been ported to (of which I have been notified).  Some of
+this information is old, incorrect, or incomplete.  Send corrections and
+additions to jaffer@@ai.mit.edu.
+
+@menu
+* Invoking Build::              
+* Build Options::               
+@end menu
+
+@node Invoking Build, Build Options, Building SCM, Building SCM
+@subsection Invoking Build
+
+The @emph{all} method will also work for MS-DOS and unix.  Use
+the @emph{all} method if you encounter problems with @file{build.scm}.
+
+@table @asis
+@item MS-DOS
+From the SCM source directory, type @samp{build} followed by up to 9
+command line arguments.
+
+@item unix
+From the SCM source directory, type @samp{build.scm} followed by command
+line arguments.
+
+@item @emph{all}
+From the SCM source directory, start @samp{scm} or @samp{scmlit} and
+type @code{(load "build.scm")}.  Alternatively, start @samp{scm} or
+@samp{scmlit} with the command line argument @samp{-ilbuild}.
+
+@end table
+
+@node Build Options,  , Invoking Build, Building SCM
+@subsection Build Options
+
+@noindent
+The options to @dfn{build} specify what, where, and how to build a SCM
+program or dynamically linked module.  These options are unrelated to
+the SCM command line options.
+
+@deffn {Build Option} -p @var{platform-name}
+@deffnx {Build Option} ---platform=@var{platform-name}
+specifies that the compilation should be for a computer/operating-system
+combination called @var{platform-name}.  @emph{Note:} The case of
+@var{platform-name} is distinguised.  The current @var{platform-name}s
+are all lower-case.
+
+The platforms defined by table @dfn{platform} in @file{build.scm} are:
+@end deffn
+@example
+name              processor         operating-system  compiler
+symbol            processor-family  operating-system  symbol
+symbol            atom              symbol            symbol
+================= ================= ================= =================
+*unknown*         *unknown*         unix              *unknown*
+acorn-unixlib     acorn             *unknown*         *unknown*
+aix               powerpc           aix               *unknown*
+amiga-aztec       m68000            amiga             aztec
+amiga-dice-c      m68000            amiga             dice-c
+amiga-sas/c-5.10  m68000            amiga             sas/c
+atari-st-gcc      m68000            atari.st          gcc
+atari-st-turbo-c  m68000            atari.st          turbo-c
+borland-c-3.1     8086              ms-dos            borland-c
+djgpp             i386              ms-dos            gcc
+gcc               *unknown*         unix              gcc
+highc.31          i386              ms-dos            highc
+hp-ux             hp-risc           hp-ux             *unknown*
+linux             i386              linux             gcc
+linux-elf         i386              linux             gcc
+microsoft-c       8086              ms-dos            microsoft-c
+microsoft-c-nt    i386              ms-dos            microsoft-c       
+microsoft-quick-c 8086              ms-dos            microsoft-quick-c
+ms-dos            8086              ms-dos            *unknown*
+os/2-cset         i386              os/2              c-set++
+os/2-emx          i386              os/2              gcc
+sun               sparc             sun-os            *unknown*
+svr4              *unknown*         unix              *unknown*
+turbo-c-2         8086              ms-dos            turbo-c
+unicos            cray              unicos            *unknown*
+unix              *unknown*         unix              *unknown*
+vms               vax               vms               *unknown*
+vms-gcc           vax               vms               gcc
+watcom-9.0        i386              ms-dos            watcom
+@end example
+
+@deffn {Build Option} -o @var{filename}
+@deffnx {Build Option} ---outname=@var{filename}
+specifies that the compilation should produce an executable or object
+name of @var{filename}.  The default is @samp{scm}.  Executable suffixes
+will be added if neccessary, e.g. @samp{scm} @result{} @samp{scm.exe}.
+@end deffn
+
+@deffn {Build Option} -l @var{libname} @dots{}
+@deffnx {Build Option} ---libraries=@var{libname}
+specifies that the @var{libname} should be linked with the executable
+produced.  If compile flags or include directories (@samp{-I}) are
+needed, they are automatically supplied for compilations.  The @samp{c}
+library is always included.  SCM @dfn{features} specify any libraries
+they need; so you shouldn't need this option often.
+@end deffn
+
+@deffn {Build Option} -D @var{definition} @dots{}
+@deffnx {Build Option} ---defines=@var{definition}
+specifies that the @var{definition} should be made in any C source
+compilations.  If compile flags or include directories (@samp{-I}) are
+needed, they are automatically supplied for compilations.  SCM
+@dfn{features} specify any flags they need; so you shouldn't need this
+option often.
+@end deffn
+
+@deffn {Build Option} ---compiler-options=@var{flag}
+specifies that that @var{flag} will be put on compiler command-lines.
+@end deffn
+
+@deffn {Build Option} ---linker-options=@var{flag}
+specifies that that @var{flag} will be put on linker command-lines.
+@end deffn
+
+@deffn {Build Option} -s @var{pathname}
+@deffnx {Build Option} ---scheme-initial=@var{pathname}
+specifies that @var{pathname} should be the default location of the SCM
+initialization file @file{Init.scm}.  SCM tries several likely locations
+before resorting to @var{pathname} (@pxref{File-System Habitat}).
+If not specified, the current directory (where build is building) is
+used.
+@end deffn
+
+@deffn {Build Option} -c @var{pathname} @dots{}
+@deffnx {Build Option} ---c-source-files=@var{pathname}
+specifies that the C source files @var{pathname} @dots{} are to be
+compiled.
+@end deffn
+
+@deffn {Build Option} -j @var{pathname} @dots{}
+@deffnx {Build Option} ---object-files=@var{pathname}
+specifies that the object files @var{pathname} @dots{} are to be linked.
+@end deffn
+
+@deffn {Build Option} -i @var{call} @dots{}
+@deffnx {Build Option} ---initialization=@var{call}
+specifies that the C functions @var{call} @dots{} are to be
+invoked during initialization.
+@end deffn
+
+@deffn {Build Option} -t @var{build-what}
+@deffnx {Build Option} ---type=@var{build-what}
+specifies in general terms what sort of thing to build.  The choices
+are:
+@table @samp
+@item exe
+executable program.
+@item lib
+library module.
+@item dlls
+archived dynamically linked library object files.
+@item dll
+dynamically linked library object file.
+@end table
+
+The default is to build an executable.
+@end deffn
+
+@deffn {Build Option} -h @var{batch-syntax}
+@deffnx {Build Option} --batch-dialect=@var{batch-syntax}
+specifies how to build.  The default is to create a batch file for the
+host system.  The SLIB file @file{batch.scm} knows how to create batch
+files for:
+@itemize @bullet
+@item
+unix
+@item
+dos
+@item
+vms
+@item
+system
+
+This option executes the compilation and linking commands through the
+use of the @code{system} procedure.
+@item
+*unknown*
+
+This option outputs Scheme code.
+@end itemize
+@end deffn
+
+@deffn {Build Option} -w @var{batch-filename}
+@deffnx {Build Option} --script-name=@var{batch-filename}
+specifies where to write the build script.  The default is to display it
+on @code{(current-output-port)}.
+@end deffn
+
+@deffn {Build Option} -F @var{feature} @dots{}
+@deffnx {Build Option} ---features=@var{feature}
+specifies to build the given features into the executable.  The defined
+features are:
+
+@table @dfn
+@item lit
+@itemx none
+Lightweight -- no features
+
+@item cautious
+Normally, the number of arguments arguments to interpreted closures
+ (from LAMBDA) are checked if the function part of a form is not a
+symbol or only the first time the form is executed if the function part
+is a symbol.  defining @samp{reckless} disables any checking.  If you
+want to have SCM always check the number of arguments to interpreted
+closures define feature @samp{cautious}.
+
+@item careful-interrupt-masking
+Define this for extra checking of interrupt masking.  This is for
+debugging C code in @file{sys.c} and @file{repl.c}.
+
+@item debug
+Turns on features @samp{cautious} @samp{careful-interrupt-masking}
+@samp{stack-limit} and uses @code{-g} flags for debugging SCM source
+code.
+
+@item reckless
+If your scheme code runs without any errors you can disable almost all
+error checking by compiling all files with @samp{reckless}.
+
+@item stack-limit
+Use to enable checking for stack overflow.  Define value of the C
+preprocessor variable @var{STACK_LIMIT} to be the size to which SCM
+should allow the stack to grow.  STACK_LIMIT should be less than the
+maximum size the hardware can support, as not every routine checks the
+stack.
+
+@item bignums
+Large precision integers.
+
+@item arrays
+Use if you want arrays, uniform-arrays and uniform-vectors.
+
+@item array-for-each
+array-map! and array-for-each (arrays must also be defined).
+
+@item inexact
+Use if you want floating point numbers.
+
+@item engineering-notation
+Use if you want floats to display in engineering notation (exponents
+always multiples of 3) instead of scientific notation.
+
+@item single-precision-only
+Use if you want all inexact real numbers to be single precision.  This
+only has an effect if SINGLES is also defined (which is the default).
+This does not affect complex numbers.
+
+@item sicp
+Use if you want to run code from:
+
+H. Abelson, G. J. Sussman, and J. Sussman,
+Structure and Interpretation of Computer Programs,
+The MIT Press, Cambridge, Massachusetts, USA
+
+@code{(eq? '() '#f)} is the major difference.
+
+@item rev2-procedures
+These procedures were specified in the @cite{Revised^2 Report on Scheme}
+but not in @cite{R4RS}.
+
+@item record
+The Record package provides a facility for user to define their own
+record data types.  See SLIB for documentation.
+
+@item compiled-closure
+Use if you want to use compiled closures.
+
+@item generalized-c-arguments
+@code{make_gsubr} for arbitrary (< 11) arguments to C functions.
+
+@item tick-interrupts
+Use if you want the ticks and ticks-interrupt functions.
+
+@item i/o-extensions
+Commonly available I/O extensions: @dfn{exec}, line I/O, file
+positioning, file delete and rename, and directory functions.
+
+@item turtlegr
+@dfn{Turtle} graphics calls for both Borland-C and X11 from
+sjm@@ee.tut.fi.
+
+@item curses
+For the @dfn{curses} screen management package.
+
+@item edit-line
+interface to the editline or GNU readline library.
+
+@item regex
+String regular expression matching.
+
+@item socket
+BSD @dfn{socket} interface.
+
+@item posix
+Posix functions available on all @dfn{Unix-like} systems.  fork and
+process functions, user and group IDs, file permissions, and @dfn{link}.
+
+@item unix
+Those unix features which have not made it into the Posix specs: nice,
+acct, lstat, readlink, symlink, mknod and sync.
+
+@item windows
+Microsoft Windows executable.
+
+@item dynamic-linking
+Be able to load compiled files while running.
+
+@item dump
+Convert a running scheme program into an executable file.
+
+@item heap-can-shrink
+Use if you want segments of unused heap to not be freed up after garbage
+collection.  This may reduce time in GC for *very* large working sets.
+
+@item cheap-continuations
+If you only need straight stack continuations, executables compile with
+this feature will run faster and use less storage than not having it.
+Machines with unusual stacks @emph{need} this.  Also, if you incorporate
+new C code into scm which uses VMS system services or library routines
+(which need to unwind the stack in an ordrly manner) you may need to
+use this feature.
+
+@item memoize-local-bindings
+Saves the interpeter from having to look up local bindings for every
+identifier reference
+
+@end table
+@end deffn
+
+@node SLIB, Installing Dynamic Linking, Building SCM, Installing SCM
+@section SLIB
+
+@noindent
+[SLIB] is a portable Scheme library meant to provide compatibility and
+utility functions for all standard Scheme implementations.  Although
+SLIB is not @emph{neccessary} to run SCM, I strongly suggest you obtain
+and install it.  Bug reports about running SCM without SLIB have very
+low priority.  SLIB is available from the same sites as SCM:
+
+@ifclear html
+@itemize @bullet
+@item
+ftp-swiss.ai.mit.edu:/pub/scm/slib2a6.tar.gz
+@item
+prep.ai.mit.edu:/pub/gnu/jacal/slib2a6.tar.gz
+@item
+ftp.maths.tcd.ie:pub/bosullvn/jacal/slib2a6.tar.gz
+@item
+ftp.cs.indiana.edu:/pub/scheme-repository/imp/slib2a6.tar.gz
+@end itemize
+@end ifclear
+
+@ifset html
+<A HREF="file://ftp-swiss.ai.mit.edu/pub/scm/slib2a6.tar.gz">
+ftp-swiss.ai.mit.edu:/pub/scm/slib2a6.tar.gz
+</A>
+<A HREF="file://prep.ai.mit.edu/pub/gnu/jacal/slib2a6.tar.gz">
+prep.ai.mit.edu:/pub/gnu/jacal/slib2a6.tar.gz
+</A>
+<A HREF="file://ftp.maths.tcd.ie/pub/bosullvn/jacal/slib2a6.tar.gz">
+ftp.maths.tcd.ie:pub/bosullvn/jacal/slib2a6.tar.gz
+</A>
+<A HREF="file://ftp.cs.indiana.edu/pub/scheme-repository/code/lib/slib2a6.tar.gz">
+ftp.cs.indiana.edu:/pub/scheme-repository/code/lib/slib2a6.tar.gz
+</A>
+@end ifset
+
+@noindent
+Unpack SLIB (@samp{tar xzf slib2a6.tar.gz} or @samp{unzip -ao
+slib2a6.zip}) in an appropriate directory for your system; both
+@code{tar} and @code{unzip} will create the directory @file{slib}.
+
+@noindent
+Then create a file @file{require.scm} in the SCM
+@dfn{implementation-vicinity} (this is the same directory as where the
+file @file{Init.scm} is installed).  @file{require.scm} should have the
+contents:
+
+@example
+(define (library-vicinity) "/usr/local/lib/slib/")
+(load (in-vicinity (library-vicinity) "require"))
+@end example
+
+@noindent
+where the pathname string @file{/usr/local/lib/slib/} is to be replaced
+by the pathname into which you installed SLIB.  Absolute pathnames are
+recommended here; if you use a relative pathname, SLIB can get confused
+when the working directory is changed (@pxref{I/O-Extensions, chmod}).
+The way to specify a relative pathname is to append it to the
+implementation-vicinity, which is absolute:
+
+@example
+(define library-vicinity
+  (let ((lv (string-append (implementation-vicinity) "../slib/")))
+    (lambda () lv)))
+(load (in-vicinity (library-vicinity) "require"))
+@end example
+
+@noindent
+Alternatively, you can set the (shell) environment variable
+@code{SCHEME_LIBRARY_PATH} to the pathname of the SLIB directory
+(@pxref{SCM Variables, SCHEME_LIBRARY_PATH, Environment Variables}).  If
+set, the environment variable overrides @file{require.scm}.  Again,
+absolute pathnames are recommended.
+
+
+@node Installing Dynamic Linking, Saving Images, SLIB, Installing SCM
+@section Installing Dynamic Linking
+
+@noindent
+Dynamic linking has not been ported to all platforms.  Operating systems
+in the BSD family (a.out binary format) can usually be ported to
+@dfn{DLD}.  The @dfn{dl} library (@code{#define SUN_DL} for SCM) was a
+proposed POSIX standard and may be available on other machines with
+@dfn{COFF} binary format.  For notes about porting to MS-Windows and
+finishing the port to VMS @ref{Finishing Dynamic Linking}.
+
+@noindent
+@dfn{DLD} is a library package of C functions that performs @dfn{dynamic
+link editing} on Linux, VAX (Ultrix), Sun 3 (SunOS 3.4 and 4.0),
+SPARCstation (SunOS 4.0), Sequent Symmetry (Dynix), and Atari ST.  It is
+available from:
+
+@ifclear html
+@itemize @bullet
+@item
+prep.ai.mit.edu:pub/gnu/dld-3.3.tar.gz
+@end itemize
+@end ifclear
+
+@ifset html
+<A HREF="ftp://prep.ai.mit.edu/pub/gnu/dld-3.3.tar.gz">
+prep.ai.mit.edu:pub/gnu/dld-3.3.tar.gz
+</A>
+@end ifset
+
+@noindent
+These notes about using libdl on SunOS are from @file{gcc.info}:
+
+@quotation
+On a Sun, linking using GNU CC fails to find a shared library and
+reports that the library doesn't exist at all.
+
+This happens if you are using the GNU linker, because it does only
+static linking and looks only for unshared libraries.  If you have
+a shared library with no unshared counterpart, the GNU linker
+won't find anything.
+
+We hope to make a linker which supports Sun shared libraries, but
+please don't ask when it will be finished--we don't know.
+
+Sun forgot to include a static version of @file{libdl.a} with some
+versions of SunOS (mainly 4.1).  This results in undefined symbols when
+linking static binaries (that is, if you use @samp{-static}).  If you
+see undefined symbols @samp{_dlclose}, @samp{_dlsym} or @samp{_dlopen}
+when linking, compile and link against the file
+@file{mit/util/misc/dlsym.c} from the MIT version of X windows.
+@end quotation
+
+
+@node Saving Images, Automatic C Preprocessor Definitions, Installing Dynamic Linking, Installing SCM
+@section Saving Images
+
+@noindent
+In SCM, the ability to save running program images is called @dfn{dump}
+(@pxref{Dump}).  In order to make @code{dump} available to SCM, build
+with feature @samp{dump}.  @code{dump}ed executables are compatible with
+dynamic linking.
+
+@noindent
+Most of the code for @dfn{dump} is taken from
+@file{emacs-19.34/src/unex*.c}.  No modifications to the emacs source
+code were required to use @file{unexelf.c}.  Dump has not been ported to
+all platforms.  If @file{unexec.c} or @file{unexelf.c} don't work for
+you, try using the appropriate @file{unex*.c} file from emacs.
+
+
+
+@node Automatic C Preprocessor Definitions, Problems Compiling, Saving Images, Installing SCM
+@section Automatic C Preprocessor Definitions
+
+These @samp{#defines} are automatically provided by preprocessors of
+various C compilers.  SCM uses the presence or absence of these
+definitions to configure @dfn{include file} locations and aliases for
+library functions.  If the definition(s) corresponding to your system
+type is missing as your system is configured, add @code{-D@var{flag}} to
+the compilation command lines or add a @code{#define @var{flag}} line to
+@file{scmfig.h} or the beginning of @file{scmfig.h}.
+
+@example
+#define         Platforms:
+-------         ----------
+ARM_ULIB        Huw Rogers free unix library for acorn archimedes
+AZTEC_C         Aztec_C 5.2a
+_DCC            Dice C on AMIGA
+__GNUC__        Gnu CC (and DJGPP)
+__EMX__         Gnu C port (gcc/emx 0.8e) to OS/2 2.0
+__HIGHC__       MetaWare High C
+__IBMC__        C-Set++ on OS/2 2.1
+_MSC_VER        MS VisualC++ 4.2
+MWC             Mark Williams C on COHERENT
+_QC             Microsoft QuickC
+__STDC__        ANSI C compliant
+__TURBOC__      Turbo C and Borland C
+__WATCOMC__     Watcom C on MS-DOS
+__ZTC__         Zortech C
+
+_AIX            AIX operating system
+AMIGA           SAS/C 5.10 or Dice C on AMIGA
+atarist         ATARI-ST under Gnu CC
+GNUDOS          DJGPP (obsolete in version 1.08)
+__GO32__        DJGPP (future?)
+hpux            HP-UX
+linux           Linux
+MCH_AMIGA       Aztec_c 5.2a on AMIGA
+MSDOS           Microsoft C 5.10 and 6.00A
+__MSDOS__       Turbo C, Borland C, and DJGPP
+nosve           Control Data NOS/VE
+SVR2            System V Revision 2.
+THINK_C         developement environment for the Macintosh
+ultrix          VAX with ULTRIX operating system.
+unix            most Unix and similar systems and DJGPP (!?)
+__unix__        Gnu CC and DJGPP
+_UNICOS         Cray operating system
+_Windows        Borland C 3.1 compiling for Windows
+_WIN32          MS VisualC++ 4.2 under Windows-NT
+vms             (and VMS) VAX-11 C under VMS.
+
+hp9000s800      HP RISC processor
+__i386__        DJGPP
+i386            DJGPP
+MULTIMAX        Encore computer
+pyr             Pyramid 9810 processor
+sparc           SPARC processor
+sequent         Sequent computer
+tahoe           CCI Tahoe processor
+@end example
+
+@node Problems Compiling, Problems Linking, Automatic C Preprocessor Definitions, Installing SCM
+@section Problems Compiling
+
+@table @asis
+@item FILE: PROBLEM
+HOW TO FIX
+@item *.c: include file not found
+Correct the status of STDC_HEADERS in @file{scmfig.h}
+
+fix #include statement or add #define for system type to
+@file{scmfig.h}.
+@item *.c: Function should return a value in @dots{}
+@itemx *.c: Parameter '@dots{}' is never used in @dots{}
+@itemx *.c: Condition is always false in @dots{}
+@itemx *.c: Unreachable code in function @dots{}
+Ignore.
+@item scm.c: assignment between incompatible types
+change SIGRETTYPE in @file{scm.c}.
+@item time.c: CLK_TCK redefined
+incompatablility between <stdlib.h> and <sys/types.h>.  remove
+STDC_HEADERS in @file{scmfig.h}.
+
+edit <sys/types.h> to remove incompatability.
+@item subr.c: Possibly incorrect assignment in function lgcd
+Ignore.
+@item sys.c: statement not reached
+@itemx sys.c: constant in conditional expression
+ignore
+@item sys.c: `???' undeclared, outside of functions
+#undef STDC_HEADERS in @file{scmfig.h}.
+@item scl.c: syntax error
+#define SYSTNAME to your system type in @file{scl.c} (softtype)
+@end table
+
+@node Problems Linking, Problems Running, Problems Compiling, Installing SCM
+@section Problems Linking
+
+@table @asis
+@item PROBLEM
+HOW TO FIX
+@item _sin etc. missing.
+uncomment LIBS in makefile
+@end table
+
+@node Problems Running, Testing, Problems Linking, Installing SCM
+@section Problems Running
+
+@table @asis
+@item PROBLEM
+HOW TO FIX
+@item Opening message and then machine crashes.
+Change memory model option to C compiler (or makefile).
+
+Make sure @code{sizet} definition is correct in @file{scmfig.h}.
+
+Reduce size of HEAP_SEG_SIZE in @file{setjump.h}.
+@item Input hangs
+#define NOSETBUF
+@item ERROR: heap: need larger initial
+Need to increase the initial heap allocation using -a<kb> or
+INIT_HEAP_SIZE.
+@item ERROR: Could not allocate @dots{}
+Check @code{sizet} definition.
+
+Use 32 bit compiler mode.
+
+Don't try to run as subproccess
+@item remove @dots{} in scmfig.h and recompile scm
+@itemx add @dots{} in scmfig.h and recompile scm
+Do it and recompile files.
+@item ERROR: @file{Init.scm} not found
+Assign correct IMPLINIT in makefile or @file{scmfig.h} or define
+environment variable @code{SCM_INIT_PATH} to be the full pathname of
+@file{Init.scm} (@pxref{Installing SCM}).
+@item WARNING: require.scm not found
+define environment variable @code{SCHEME_LIBRARY_PATH} to be the full
+pathname of the scheme library [SLIB] or change @code{library-vicinity} in
+@file{Init.scm} to point to library or remove. @xref{Installation, , , slib,
+SLIB}.
+
+Make sure the value of @code{(library-vicinity)} has a trailing file
+separator (like @key{/} or @key{\}).
+@end table
+
+@node Testing, Reporting Problems, Problems Running, Installing SCM
+@section Testing
+
+@noindent
+Loading @file{r4rstest.scm} in the distribution will run an [R4RS]
+conformance test on @code{scm}.
+
+@example
+> (load "r4rstest.scm")
+@print{}
+;loading "r4rstest.scm"
+SECTION(2 1)
+SECTION(3 4)
+ #<primitive-procedure boolean?>
+    #<primitive-procedure char?>
+       #<primitive-procedure null?>
+          #<primitive-procedure number?>
+@dots{}
+@end example
+
+@noindent
+Loading @file{pi.scm} in the distribution will enable you to compute
+digits of pi.
+
+@example
+> (load "pi")
+;loading "pi"
+;done loading "pi.scm"
+;Evaluation took 20 mSec (0 in gc) 767 cells work, 233 bytes other
+#<unspecified>
+> (pi 100 5)
+00003 14159 26535 89793 23846 26433 83279 50288 41971 69399
+37510 58209 74944 59230 78164 06286 20899 86280 34825 34211
+70679
+;Evaluation took 550 mSec (60 in gc) 36976 cells work, 1548 bytes other
+#<unspecified>
+@end example
+
+@noindent
+Loading @file{bench.scm} will compute and display performance statistics
+of SCM running @file{pi.scm}.  @samp{make bench} or @samp{make benchlit}
+appends the performance report to the file @file{BenchLog}, facilitating
+tracking effects of changes to SCM on performance.
+
+@table @asis
+@item PROBLEM
+HOW TO FIX
+@item Runs some and then machine crashes.
+See above under machine crashes.
+@item Runs some and then ERROR: @dots{} (after a GC has happened)
+Remove optimization option to C compiler and recompile.
+
+@code{#define SHORT_ALIGN} in @file{scmfig.h}.
+@item Some symbol names print incorrectly.
+Change memory model option to C compiler (or makefile).
+
+Check that @code{HEAP_SEG_SIZE} fits within @code{sizet}.
+
+Increase size of @code{HEAP_SEG_SIZE} (or @code{INIT_HEAP_SIZE} if it is
+smaller than @code{HEAP_SEG_SIZE}).
+@item ERROR: Rogue pointer in Heap.
+See above under machine crashes.
+@item Newlines don't appear correctly in output files.
+Check file mode (define OPEN_@dots{} in @file{Init.scm}
+@item Spaces or control characters appear in symbol names
+Check character defines in @file{scmfig.h}.
+@item Negative numbers turn positive.
+Check SRS in @file{scmfig.h}.
+@item VMS: Couldn't unwind stack
+@itemx VAX: botched longjmp
+@code{#define CHEAP_CONTIUATIONS} in @file{scmfig.h}.
+@item Sparc(SUN-4) heap is growing out of control
+You are experiencing a GC problem peculiar to the Sparc.  The problem is
+that SCM doesn't know how to clear register windows.  Every location
+which is not reused still gets marked at GC time.  This causes lots of
+stuff which should be collected to not be.  This will be a problem with
+any @emph{conservative} GC until we find what instruction will clear the
+register windows.  This problem is exacerbated by using lots of
+call-with-current-continuations.
+@end table
+
+@node Reporting Problems,  , Testing, Installing SCM
+@section Reporting Problems
+
+@noindent
+Reported problems and solutions are grouped under Compiling, Linking,
+Running, and Testing.  If you don't find your problem listed there, you
+can send a bug report to @code{jaffer@@ai.mit.edu}.  The bug report
+should include:
+
+@enumerate
+@item
+The version of SCM (printed when SCM is invoked with no arguments).
+@item
+The type of computer you are using.
+@item
+The name and version of your computer's operating system.
+@item
+The values of the environment variables @code{SCM_INIT_PATH} and
+@code{SCHEME_LIBRARY_PATH}.
+@item
+The name and version of your C compiler.
+@item
+If you are using an executable from a distribution, the name, vendor,
+and date of that distribution.  In this case, corresponding with the
+vendor is recommended.
+@end enumerate
+
+@node The Language, Packages, Installing SCM, Top
+@chapter The Language
+
+This section describes features which are either present in all builds
+of SCM or which must be enabled when SCM is compiled.
+
+@menu
+* Standards Compliance::        Links to sections in [R4RS] and [SLIB]
+* System Interface::            Like how to exit
+* Errors::                      
+* Memoized Expressions::        What #@@0+1 and #@@? mean
+* Internal State::              GC, errors, and diagnostics
+* Miscellaneous Procedures::    
+* Time::                        Both real time and processor time
+* Interrupts::                  and exceptions
+* Process Synchronization::     Because interrupts are preemptive
+* Files and Ports::             
+* Soft Ports::                  Emulate I/O devices
+* Syntax Extensions::           and how to Define New Syntax
+* Low Level Syntactic Hooks::   
+@end menu
+
+@node Standards Compliance, System Interface, The Language, The Language
+@section Standards Compliance
+
+@noindent
+Scm conforms to the
+@ifset html
+[IEEE],
+@end ifset
+@cite{IEEE Standard 1178-1990.  IEEE Standard for the Scheme Programming
+Language.}
+@ifclear html
+(@pxref{Bibliography}),
+@end ifclear
+and
+@ifset html
+[R4RS], <A HREF="r4rs_toc.html">
+@end ifset
+@cite{Revised(4) Report on the Algorithmic Language Scheme}.
+@ifset html
+</A>
+@end ifset
+@ifinfo
+@ref{Top, , , r4rs, Revised(4) Report on the Algorithmic Language
+Scheme}.
+@end ifinfo
+All the required features of these specifications are supported.
+Many of the optional features are supported as well.
+
+@subheading Optionals of [R4RS] Supported by SCM
+
+@table @asis
+@item two clause @code{if}: @code{(if <test> <consequent>)}
+@xref{Conditionals, , , r4rs, Revised(4) Scheme}.
+@item @code{let*}
+@itemx named @code{let}
+@xref{Binding constructs, , , r4rs, Revised(4) Scheme}.
+@item @code{do}
+@xref{Iteration, , , r4rs, Revised(4) Scheme}.
+@item All varieties of @code{define}
+@xref{Definitions, , , r4rs, Revised(4) Scheme}.
+@item @code{list-tail}
+@xref{Pairs and lists, , , r4rs, Revised(4) Scheme}.
+@item @code{string-copy}
+@itemx @code{string-fill!}
+@xref{Strings, , , r4rs, Revised(4) Scheme}.
+@item @code{make-vector} of two arguments
+@itemx @code{vector-fill!}
+@xref{Vectors, , , r4rs, Revised(4) Scheme}.
+@item @code{apply} of more than 2 arguments
+@xref{Control features, , , r4rs, Revised(4) Scheme}.
+@item @code{-} and @code{/} of more than 2 arguments
+@itemx @code{exp}
+@itemx @code{log}
+@itemx @code{sin}
+@itemx @code{cos}
+@itemx @code{tan}
+@itemx @code{asin}
+@itemx @code{acos}
+@itemx @code{atan}
+@itemx @code{sqrt}
+@itemx @code{expt}
+@itemx @code{make-rectangular}
+@itemx @code{make-polar}
+@itemx @code{real-part}
+@itemx @code{imag-part}
+@itemx @code{magnitude}
+@itemx @code{angle}
+@itemx @code{exact->inexact}
+@itemx @code{inexact->exact}
+@xref{Numerical operations, , , r4rs, Revised(4) Scheme}.
+@item @code{delay}
+@itemx @code{force}
+@xref{Control features, , , r4rs, Revised(4) Scheme}.
+@itemx @code{with-input-from-file}
+@itemx @code{with-output-to-file}
+@xref{Ports, , , r4rs, Revised(4) Scheme}.
+@itemx @code{char-ready?}
+@xref{Input, , , r4rs, Revised(4) Scheme}.
+@itemx @code{transcript-on}
+@itemx @code{transcript-off}
+@xref{System interface, , , r4rs, Revised(4) Scheme}.
+@end table
+
+@subheading Optionals of [R4RS] not Supported by SCM
+
+@table @asis
+@item @code{numerator}
+@itemx @code{denominator}
+@itemx @code{rationalize}
+@xref{Numerical operations, , , r4rs, Revised(4) Scheme}.
+@item [R4RS] appendix Macros
+@xref{Macros, , , r4rs, Revised(4) Scheme}.
+@end table
+
+@subheading [SLIB] Features of SCM and SCMLIT
+
+@table @code
+@item delay
+@itemx full-continuation
+@itemx ieee-p1178
+@itemx object-hash
+@itemx rev4-report
+@itemx source
+See SLIB file @file{Template.scm}.
+@item current-time
+@xref{Time, , , slib, SLIB}.
+@item defmacro
+@xref{Defmacro, , , slib, SLIB}.
+@item dynamic-wind
+@xref{Dynamic-Wind, , , slib, SLIB}.
+@item eval
+@xref{System, , , slib, SLIB}.
+@item getenv
+@itemx system
+@xref{System Interface, , , slib, SLIB}.
+@item hash
+@xref{Hashing, , , slib, SLIB}.
+@item logical
+@xref{Bit-Twiddling, , , slib, SLIB}.
+@item multiarg-apply
+@xref{Multi-argument Apply, , , slib, SLIB}.
+@item multiarg/and-
+@xref{Multi-argument / and -, , , slib, SLIB}.
+@item rev4-optional-procedures
+@xref{Rev4 Optional Procedures, , , slib, SLIB}.
+@item string-port
+@xref{String Ports, , , slib, SLIB}.
+@item tmpnam
+@xref{Input/Output, , , slib, SLIB}.
+@item transcript
+@xref{Transcripts, , , slib, SLIB}.
+@item vicinity
+@xref{Vicinity, , , slib, SLIB}.
+@item with-file
+@xref{With-File, , , slib, SLIB}.
+@end table
+
+@subheading [SLIB] Features of SCM
+
+@table @code
+@item array
+@xref{Arrays, , , slib, SLIB}.
+@item array-for-each
+@xref{Array Mapping, , , slib, SLIB}.
+@item bignum
+@itemx complex
+@itemx inexact
+@itemx rational
+@itemx real
+@xref{Require, , , slib, SLIB}.
+@end table
+
+@node System Interface, Errors, Standards Compliance, The Language
+@section System Interface
+
+@noindent
+For documentation of the procedures @code{getenv} and @code{system}
+@xref{System Interface, , , slib, SLIB}.
+
+@defun quit
+@defunx quit n
+@defunx exit
+@defunx exit n
+Aliases for @code{exit} (@pxref{System, exit, , slib, SLIB}).  On many
+systems, SCM can also tail-call another program.  @xref{I/O-Extensions,
+execp}.
+@end defun
+
+@defun vms-debug
+If SCM is compiled under VMS these commands will invoke the editor or
+debugger respectively.
+@end defun
+
+@defun ed filename
+If SCM is compiled under VMS @code{ed} will invoke the editor with a
+single the single argument @var{filename}.
+
+@defunx ed arg1 @dots{}
+Otherwise, the value of the environment variable @code{EDITOR} (or just
+@code{ed} if it isn't defined) is invoked as a command with arguments
+@var{arg1} @dots{}.
+@end defun
+
+@defun program-arguments
+Returns a list of strings of the arguments scm was called with.
+@end defun
+
+@defun errno
+@defunx errno n
+With no argument returns the current value of the system variable
+@code{errno}.  When given an argument, @code{errno} sets the system
+variable @code{errno} to @var{n} and returns the previous value of
+@code{errno}.  @code{(errno 0)} will clear outstanding errors.  This is
+recommended after @code{try-load} returns @code{#f} since this occurs
+when the file could not be opened.
+@end defun
+
+@defun perror string
+Prints on standard error output the argument @var{string}, a colon,
+followed by a space, the error message corresponding to the current
+value of @code{errno} and a newline.  The value returned is unspecified.
+@end defun
+
+@node Errors, Memoized Expressions, System Interface, The Language
+@section Errors
+
+@noindent
+A computer-language implementation designer faces choices of how
+reflexive to make the implementation in handling exceptions and errors;
+that is, how much of the error and exception routines should be written
+in the language itself.  The design of a portable implementation is
+further constrained by the need to have (almost) all errors print
+meaningful messages, even when the implementation itself is not
+functioning correctly.  Therefore, SCM implements much of its error
+response code in C.
+
+@noindent
+The following common error and conditions are handled by C code.  Those
+with callback names after them can also be handled by Scheme code
+(@pxref{Interrupts}).  If the callback identifier is not defined at top
+level, the default error handler (C code) is invoked.  There are many
+other error messages which are not treated specially.
+
+@enumerate 0
+@item
+Wrong type in arg 0
+@item
+Wrong type in arg 1
+@item
+Wrong type in arg 2
+@item
+Wrong type in arg 3
+@item
+Wrong type in arg 4
+@item
+Wrong type in arg 5
+@item
+Wrong number of args
+@item
+numerical overflow
+@item
+Argument out of range
+@item
+Could not allocate @code{(out-of-storage)}
+@item
+EXIT @code{(end-of-program)}
+@item
+hang up @code{(hang-up)}
+@item
+user interrupt @code{(user-interrupt)}
+@item
+arithmetic error @code{(arithmetic-error)}
+@item
+bus error
+@item
+segment violation
+@item
+alarm @code{(alarm-interrupt)}
+@end enumerate
+
+@defvar errobj
+If SCM encounters a non-fatal error it aborts evaluation of the current
+form, prints a message explaining the error, and resumes the top level
+read-eval-print loop.  The value of @var{errobj} is the offending object
+if appropriate.  The builtin procedure @code{error} does @emph{not} set
+@var{errobj}.
+@end defvar
+
+@defun error arg1 arg2 arg3 @dots{}
+Alias for @ref{System, error, , slib, SLIB}.  Outputs an error message
+containing the arguments, aborts evaluation of the current form and
+resumes the top level read-eval-print loop.  Error is defined in
+@file{Init.scm}; Feel free to redefine it to suit your purposes.
+@end defun
+
+@subsection CAUTIOUS enhancements
+
+@noindent
+If SCM is built with the @samp{CAUTIOUS} flag, then when an error
+occurs, a @dfn{stack trace} of certain pending calls are printed as part
+of the default error response.  A (memoized) expression and newline are
+printed for each partially evaluated combination whose procedure is not
+builtin.  @xref{Memoized Expressions} for how to read memoized
+expressions.
+
+@noindent
+Also as the result of the @samp{CAUTIOUS} flag, both @code{error} and
+@code{user-interrupt} (invoked by @key{C-c}) are defined to print stack
+traces and conclude by calling @code{breakpoint} (@pxref{Breakpoints, ,
+, slib, SLIB}).  This allows the user to interract with SCM as with Lisp
+systems.
+
+@defun stack-trace
+Prints information describing the stack of partially evaluated
+expressions.  @code{stack-trace} returns @code{#t} if any lines were
+printed and @code{#f} otherwise.  See @file{Init.scm} for an example of
+the use of @code{stack-trace}.
+@end defun
+
+@node Memoized Expressions, Internal State, Errors, The Language
+@section Memoized Expressions
+
+@noindent
+SCM memoizes the address of each occurence of an identifier's value when
+first encountering it in a source expression.  Subsequent executions of
+that memoized expression is faster because the memoized reference
+encodes where in the top-level or local environment its value is.
+
+@noindent
+When procedures are displayed, the memoized locations appear in a format
+different from references which have not yet been executed.  I find this
+a convenient aid to locating bugs and untested expressions.
+
+@itemize @bullet
+@item
+The names of memoized lexically bound identifiers are replaced with
+@r{#@@}@i{<m>}@r{-}@i{<n>}, where @i{<m>} is the number of binding
+contours back and @i{<n>} is the index of the value in that
+binding countour.
+@item
+The names of identifiers which are not lexiallly bound but defined at
+top-level have @r{#@@} prepended.
+@end itemize
+
+@noindent
+For instance, @code{open-input-file} is defined as follows in
+@file{Init.scm}:
+
+@example
+(define (open-input-file str)
+  (or (open-file str OPEN_READ)
+      (and (procedure? could-not-open) (could-not-open) #f)
+      (error "OPEN-INPUT-FILE couldn't open file " str)))
+@end example
+
+@noindent
+If @code{open-input-file} has not yet been used, the displayed procedure
+is similar to the original definition (lines wrapped for readability):
+
+@example
+open-input-file @result{}
+#<CLOSURE (str) (or (open-file str open_read)
+ (and (procedure? could-not-open) (could-not-open) #f)
+ (error "OPEN-INPUT-FILE couldn't open file " str))>
+@end example
+
+@noindent
+If we open a file using @code{open-input-file}, the sections of code
+used become memoized:
+
+@example
+(open-input-file "r4rstest.scm") @result{} #<input-port 3>
+open-input-file @result{}
+#<CLOSURE (str) (#@@or (#@@open-file #@@0+0 #@@open_read)
+ (and (procedure? could-not-open) (could-not-open) #f)
+ (error "OPEN-INPUT-FILE couldn't open file " str))>
+@end example
+
+@noindent
+If we cause @code{open-input-file} to execute other sections of code,
+they too become memoized:
+
+@example
+(open-input-file "foo.scm") @result{}
+
+ERROR: No such file or directory
+ERROR: OPEN-INPUT-FILE couldn't open file  "foo.scm"
+
+open-input-file @result{}
+#<CLOSURE (str) (#@@or (#@@open-file #@@0+0 #@@open_read)
+ (#@@and (#@@procedure? #@@could-not-open) (could-not-open) #f)
+ (#@@error "OPEN-INPUT-FILE couldn't open file " #@@0+0))>
+@end example
+
+
+@node Internal State, Miscellaneous Procedures, Memoized Expressions, The Language
+@section Internal State
+
+@defvar *interactive*
+The variable @var{*interactive*} determines whether the SCM session is
+interactive, or should quit after the command line is processed.
+@var{*interactive*} is controlled directly by the command-line options
+@samp{-b}, @samp{-i}, and @samp{-s} (@pxref{Invoking SCM}).  If none of
+these options are specified, the rules to determine interactivity are
+more complicated; see @file{Init.scm} for details.
+@end defvar
+
+@defun abort
+Resumes the top level Read-Eval-Print loop.
+@end defun
+
+@defun restart
+Restarts the SCM program with the same arguments as it was originally
+invoked.  All @samp{-l} loaded files are loaded again; If those files
+have changed, those changes will be reflected in the new session.
+
+@emph{Note:} When running a saved executable (@pxref{Dump}),
+@code{restart} is redefined to be @code{exec-self}.
+@end defun
+
+@defun exec-self
+Exits and immediately re-invokes the same executable with the same
+arguments.  If the executable file has been changed or replaced since
+the beginning of the current session, the @emph{new} executable will be
+invoked.  This differentiates @code{exec-self} from @code{restart}.
+@end defun
+
+@defun verbose n
+Controls how much monitoring information is printed.
+If @var{n} is:
+
+@table @asis
+@item 0
+no prompt or information is printed.
+@item >= 1
+a prompt is printed.
+@item >= 2
+the CPU time is printed after each top level form evaluated.
+@item >= 3
+messages about heap growth are printed.
+@item >= 4
+garbage collection (@pxref{Garbage Collection}) messages are printed.
+@item >= 5
+a warning will be printed for each top-level symbol which is defined
+more than one time.
+@end table
+@end defun
+
+@defun gc
+Scans all of SCM objects and reclaims for further use those that are
+no longer accessible.
+@end defun
+
+@defun room
+@defunx room #t
+Prints out statistics about SCM's current use of storage.  @code{(room #t)}
+also gives the hexadecimal heap segment and stack bounds.
+@end defun
+
+@defvr Constant *scm-version*
+Contains the version string (e.g. @file{4e6}) of SCM.
+@end defvr
+
+@noindent
+For other configuration constants and procedures @xref{Configuration, ,
+, slib, SLIB}.
+
+@node Miscellaneous Procedures, Time, Internal State, The Language
+@section Miscellaneous Procedures
+
+@defun try-load filename
+If the string @var{filename} names an existing file, the try-load
+procedure reads Scheme source code expressions and definitions from the
+file and evaluates them sequentially and returns @code{#t}.  If not,
+try-load returns @code{#f}.  The try-load procedure does not affect the
+values returned by @code{current-input-port} and
+@code{current-output-port}.
+@end defun
+
+@defvar *load-pathname*
+Is set to the pathname given as argument to @code{load},
+@code{try-load}, and @code{dyn:link} (@pxref{Compiling And Linking}).
+@code{*load-pathname*} is used to compute the value of @ref{Vicinity,
+program-vicinity, , slib, SLIB}.
+@end defvar
+
+@defun line-number
+Returns the current line number of the file currently being loaded.
+@end defun
+
+@defun eval obj
+Alias for @ref{System, eval, , slib, SLIB}.
+@end defun
+
+@defun eval-string str
+Returns the result of reading an expression from @var{str} and
+evaluating it.  @code{eval-string} does not change
+@code{*load-pathname*} or  @code{line-number}.
+@end defun
+
+@defun load-string str
+Reads and evaluates all the expressions from @var{str}.  As with
+@code{load}, the value returned is unspecified.  @code{eval-string} does
+not change @code{*load-pathname*} or @code{line-number}.
+@end defun
+
+@defun vector-set-length! object length
+Change the length of string, vector, bit-vector, or uniform-array
+@var{object} to @var{length}.  If this shortens @var{object} then the
+remaining contents are lost.  If it enlarges @var{object} then the
+contents of the extended part are undefined but the original part is
+unchanged.  It is an error to change the length of literal datums.  The
+new object is returned.
+@end defun
+
+@defun copy-tree obj
+@xref{Tree Operations, copy-tree, , slib, SLIB}.  This extends the SLIB
+version by also copying vectors.
+@end defun
+
+@defun acons obj1 obj2 obj3
+Returns (cons (cons obj1 obj2) obj3).  The expression (set! a-list
+(acons key datum a-list)) adds a new association to a-list.
+@end defun
+
+@defun terms
+This command displays the GNU General Public License.
+@end defun
+
+@defun list-file filename
+Displays the text contents of @var{filename}.
+@end defun
+
+@deffn Procedure print arg1 ...
+@code{Print} writes all its arguments, separated by spaces.
+@code{Print} outputs a @code{newline} at the end and returns the value
+of the last argument.
+@end deffn
+
+@node Time, Interrupts, Miscellaneous Procedures, The Language
+@section Time
+
+@defvr Constant internal-time-units-per-second
+
+Is the integer number of internal time units in a second.
+@end defvr
+
+@defun get-internal-run-time
+Returns the integer run time in internal time units from an unspecified
+starting time.  The difference of two calls to
+@code{get-internal-run-time} divided by
+@code{internal-time-units-per-second} will give elapsed run time in
+seconds.
+@end defun
+
+@defun get-internal-real-time
+Returns the integer time in internal time units from an unspecified
+starting time.  The difference of two calls to
+@code{get-internal-real-time} divided by
+@code{interal-time-units-per-second} will give elapsed real time in
+seconds.
+@end defun
+
+@defun current-time
+Returns the time since 00:00:00 GMT, January 1, 1970, measured in
+seconds.  @xref{Time, current-time, , slib, SLIB}.  @code{current-time} is
+used in @ref{Time, , , slib, SLIB}.
+@end defun
+
+@node Interrupts, Process Synchronization, Time, The Language
+@section Interrupts
+
+@defun ticks n
+Returns the number of ticks remaining till the next tick interrupt.
+Ticks are an arbitrary unit of evaluation.  Ticks can vary greatly in
+the amount of time they represent.
+
+If @var{n} is 0, any ticks request is canceled.  Otherwise a
+@code{ticks-interrupt} will be signaled @var{n} from the current time.
+@code{ticks} is supported if SCM is compiled with the @code{ticks} flag
+defined.
+@end defun
+
+@deffn {Callback procedure} ticks-interrupt @dots{}
+Establishes a response for tick interrupts.  Another tick interrupt will
+not occur unless @code{ticks} is called again.  Program execution will
+resume if the handler returns.  This procedure should (abort) or some
+other action which does not return if it does not want processing to
+continue.
+@end deffn
+
+@defun alarm secs
+Returns the number of seconds remaining till the next alarm interrupt.
+If @var{secs} is 0, any alarm request is canceled.  Otherwise an
+@code{alarm-interrupt} will be signaled @var{secs} from the current
+time.  ALARM is not supported on all systems.
+@end defun
+
+@deffn {Callback procedure} user-interrupt @dots{}
+@deffnx {Callback procedure} alarm-interrupt @dots{}
+Establishes a response for @code{SIGINT} (control-C interrupt) and
+@code{SIGALRM} interrupts.  Program execution will resume if the handler
+returns.  This procedure should @code{(abort)} or some other action
+which does not return if it does not want processing to continue after
+it returns.
+
+Interrupt handlers are disabled during execution @code{system} and
+@code{ed} procedures.
+
+To unestablish a response for an interrupt set the handler symbol to
+@code{#f}.  For instance, @code{(set! user-interrupt #f)}.
+@end deffn
+
+@deffn {Callback procedure} out-of-storage @dots{}
+@deffnx {Callback procedure} could-not-open @dots{}
+@deffnx {Callback procedure} end-of-program @dots{}
+@deffnx {Callback procedure} hang-up @dots{}
+@deffnx {Callback procedure} arithmetic-error @dots{}
+Establishes a response for storage allocation error, file opening
+error, end of program, SIGHUP (hang up interrupt) and arithmetic
+errors respectively.  This procedure should (abort) or some other
+action which does not return if it does not want the default error
+message to also be displayed.  If no procedure is defined for @var{hang-up}
+then @var{end-of-program} (if defined) will be called.
+
+To unestablish a response for an error set the handler symbol to
+@code{#f}.  For instance, @code{(set! could-not-open #f)}.
+@end deffn
+
+@node Process Synchronization, Files and Ports, Interrupts, The Language
+@section Process Synchronization
+
+@defun make-arbiter name
+
+Returns an object of type arbiter and name @var{name}.  Its state is
+initially unlocked.
+@end defun
+
+@defun try-arbiter arbiter
+
+Returns @code{#t} and locks @var{arbiter} if @var{arbiter} was unlocked.
+Otherwise, returns @code{#f}.
+@end defun
+
+@defun release-arbiter arbiter
+
+Returns @code{#t} and unlocks @var{arbiter} if @var{arbiter} was locked.
+Otherwise, returns @code{#f}.
+@end defun
+
+@node Files and Ports, Soft Ports, Process Synchronization, The Language
+@section Files and Ports
+
+@noindent
+These procedures generalize and extend the standard capabilities in
+@ref{Ports, , ,r4rs, Revised(4) Scheme}.
+
+@defun open-file string modes
+Returns a port capable of receiving or delivering characters as
+specified by the @var{modes} string.  If a file cannot be opened
+@code{#f} is returned.
+@end defun
+
+@defvr Constant open_read
+@defvrx Constant open_write
+@defvrx Constant open_both
+Contain modes strings specifying that a file is to be opened for
+reading, writing, and both reading and writing respectively.
+@end defvr
+
+@defun _ionbf modestr
+Returns a version of modestr which when open-file is called with it as
+the second argument will return an unbuffered port.  A non-file
+input-port must be unbuffered in order for char-ready? to work correctly
+on it.  The initial value of (current-input-port) is unbuffered if the
+platform supports it.
+@end defun
+
+@defun close-port port
+Closes @var{port}.  The same as close-input-port and close-output-port.
+@end defun
+
+@defun open-io-file filename
+@defunx close-io-port port
+These functions are analogous to the standard scheme file functions.
+The ports are open to @var{filename} in read/write mode.  Both input and
+output functions can be used with io-ports.  An end of file must be read
+or a file-set-position done on the port between a read operation and a
+write operation or vice-versa.
+@end defun
+
+@defun current-error-port
+Returns the current port to which diagnostic output is directed.
+@end defun
+
+@defun with-error-to-file string thunk
+@var{thunk} must be a procedure of no arguments, and string must be a
+string naming a file.  The file is opened for output, an output port
+connected to it is made the default value returned by
+current-error-port, and the @var{thunk} is called with no arguments.  When
+the thunk returns, the port is closed and the previous default is
+restored.  With-error-to-file returns the value yielded by @var{thunk}.
+@end defun
+
+@defun with-input-from-port port thunk
+@defunx with-output-to-port port thunk
+@defunx with-error-to-port port thunk
+These routines differ from with-input-from-file, with-output-to-file,
+and with-error-to-file in that the first argument is a port, rather
+than a string naming a file.
+@end defun
+
+@deffn {procedure} char-ready? 
+@deffnx {procedure} char-ready? port
+
+Returns @code{#t} if a character is ready on the input @var{port} and
+returns @code{#f} otherwise.  If @code{char-ready?} returns @code{#t}
+then
+@findex char-ready
+the next @code{read-char} operation on the given @var{port} is
+guaranteed
+@findex read-char
+not to hang.  If the @var{port} is at end of file then
+@code{char-ready?} returns @code{#t}.
+@findex char-ready?
+@var{Port} may be omitted, in which case it defaults to
+the value returned by @code{current-input-port}.
+@findex current-input-port
+
+@emph{Rationale:}  @code{Char-ready?} exists to make it possible for a program to
+@findex char-ready?
+accept characters from interactive ports without getting stuck waiting
+for input.  Any input editors associated with such ports must ensure
+that characters whose existence has been asserted by @code{char-ready?}
+@findex char-ready?
+cannot be rubbed out.  If @code{char-ready?} were to return @code{#f} at
+end of file, a port at end of file would be indistinguishable from an
+interactive port that has no ready characters.
+@c end rationale
+@end deffn
+
+
+@node Soft Ports, Syntax Extensions, Files and Ports, The Language
+@section Soft Ports
+
+@noindent
+A @dfn{soft-port} is a port based on a vector of procedures capable of
+accepting or delivering characters.  It allows emulation of I/O ports.
+
+@defun make-soft-port vector modes
+Returns a port capable of receiving or delivering characters as
+specified by the @var{modes} string (@pxref{Files and Ports,
+open-file}).  @var{vector} must be a vector of length 6.  Its components
+are as follows:
+
+@enumerate 0
+@item
+procedure accepting one character for output
+@item
+procedure accepting a string for output
+@item
+thunk for flushing output
+@item
+thunk for getting one character
+@item
+thunk for closing port (not by garbage collection)
+@end enumerate
+
+For an output-only port only elements 0, 1, 2, and 4 need be
+procedures.  For an input-only port only elements 3 and 4 need be
+procedures.  Thunks 2 and 4 can instead be @code{#f} if there is no useful
+operation for them to perform.
+
+If thunk 3 returns @code{#f} or an @code{eof-object} (@pxref{Input,
+eof-object?, ,r4rs, Revised(4) Scheme}) it indicates that the port has
+reached end-of-file.  For example:
+
+@example
+(define stdout (current-output-port))
+(define p (make-soft-port
+           (vector
+            (lambda (c) (write c stdout))
+            (lambda (s) (display s stdout))
+            (lambda () (display "." stdout))
+            (lambda () (char-upcase (read-char)))
+            (lambda () (display "@@" stdout)))
+           "rw"))
+
+(write p p) @result{} #<input-output-soft#\space45d10#\>
+@end example
+@end defun
+
+@node Syntax Extensions, Low Level Syntactic Hooks, Soft Ports, The Language
+@section Syntax Extensions
+
+@deffn {Read syntax} #. expression
+Is read as the object resulting from the evaluation of @var{expression}.
+This substitution occurs even inside quoted structure.
+
+In order to allow compiled code to work with @code{#.} it is good
+practice to define those symbols used inside of @var{expression} with
+@code{#.(define @dots{})}.  For example:
+
+@example
+#.(define foo 9)                        @result{} #<unspecified>
+'(#.foo #.(+ foo foo))                  @result{} (9 18)
+@end example
+@end deffn
+
+@deffn {Read syntax} #+ feature form
+If feature is @code{provided?} (by @code{*features*}) then @var{form} is
+read as a scheme expression.  If not, then @var{form} is treated as
+whitespace.
+
+Feature is a boolean expression composed of symbols and @code{and},
+@code{or}, and @code{not} of boolean expressions.
+
+For more information on @code{provided?} and @code{*features*},
+@xref{Require, , , slib, SLIB}.
+@end deffn
+
+@deffn {Read syntax} #- feature form
+is equivalent to @code{#+(not feature) expression}.
+@end deffn
+
+@deffn {Read syntax} #' form
+is equivalent to @var{form} (for compatibility with common-lisp).
+@end deffn
+
+@deffn {Read syntax} #| any thing |#
+Is a balanced comment.  Everything up to the matching @code{|#} is
+ignored by the @code{read}.  Nested @code{#|@dots{}|#} can occur inside
+@var{any thing}.
+@end deffn
+
+@deffn {Read syntax} #! any thing
+On the first line of a file will be ignored when loaded by SCM.  This
+makes SCM files usable as POSIX shell scripts if the first line is:
+
+@example
+#!/usr/local/bin/scm
+@end example
+
+When such a file is invoked it executes /usr/local/bin/scm with the
+name of this file as the first argument.  The following shell script
+will print factorial of its argument:
+@example
+#!/usr/local/bin/scm
+;;; -*-scheme-*- tells emacs this is a scheme file.
+(define (fact n) (if (< n 2) 1 (* n (fact (+ -1 n)))))
+(display (fact (string->number (caddr (program-arguments)))))
+(newline)
+(quit)
+@end example
+
+This technique has some drawbacks:
+@itemize @bullet
+@item
+Some Unixes limit the length of the @samp{#!} interpreter line to the
+size of an object file header, which can be as small as 32 bytes.
+@item
+A full, explicit pathname must be specified, perhaps requiring more than
+32 bytes and making scripts vulnerable to programs being moved.
+@end itemize
+
+The following approach solves both problems -- at the expense of
+slightly slower startup.  @code{type;} should appear on every line to be
+executed by the shell.  These lines do not have the length restriction
+mentioned above.  Also, @code{/bin/sh} searches the directories listed
+in the `PATH' environment variable for @samp{scm}, eliminating the need
+to know absolute locations in order to invoke a program.
+@example
+#!/bin/sh
+type;exec scm $0 $*
+;;; -*-scheme-*- tells emacs this is a scheme file.
+(define (fact n) (if (< n 2) 1 (* n (fact (+ -1 n)))))
+(display (fact (string->number (caddr (program-arguments)))))
+(newline)
+(quit)
+@end example
+@end deffn
+
+@defspec defined? symbol
+Equivalent to @code{#t} if @var{symbol} is a syntactic keyword (such as
+@code{if}) or a symbol with a value in the top level environment
+(@pxref{Variables and regions, , ,r4rs, Revised(4) Scheme}).  Otherwise
+equivalent to @code{#f}.
+@end defspec
+
+@defspec defvar identifier initial-value
+If @var{identifier} is unbound in the top level environment, then
+@var{identifier} is @code{define}d to the result of evaluating the form
+@var{initial-value} as if the @code{defvar} form were instead the form
+@code{(define identifier initial-value)} .  If @var{identifier} already
+has a value, then @var{initial-value} is @emph{not} evaluated and
+@var{identifier}'s value is not changed.
+@end defspec
+
+@noindent
+SCM also supports the following constructs from Common Lisp:
+@code{defmacro}, @code{macroexpand}, @code{macroexpand-1}, and
+@code{gentemp}.  @xref{Defmacro, , , slib, SLIB}.
+
+
+@node Low Level Syntactic Hooks,  , Syntax Extensions, The Language
+@section Low Level Syntactic Hooks
+
+@deffn {Callback procedure} read:sharp c port
+If a @key{#} followed by a character (for a non-standard syntax) is
+encountered by @code{read}, @code{read} will call the value of the
+symbol @code{read:sharp} with arguments the character and the port being
+read from.  The value returned by this function will be the value of
+@code{read} for this expression unless the function returns
+@code{#<unspecified>} in which case the expression will be treated as
+whitespace.  @code{#<unspecified>} is the value returned by the
+expression @code{(if #f #f)}.
+
+@emph{Note:} When adding new @key{#} syntaxes, have your code save the
+previous value of @code{read:sharp} when defining it.  Call this saved
+value if an invocation's syntax is not recognized.  This will allow
+@code{#+}, @code{#-}, @code{#!}, and @ref{Uniform Array}s to still be
+supported (as they use @code{read:sharp}).
+@end deffn
+
+@defun procedure->syntax proc
+Returns a @dfn{macro} which, when a symbol defined to this value appears
+as the first symbol in an expression, returns the result of applying
+@var{proc} to the expression and the environment.
+@end defun
+
+@defun procedure->macro proc
+@defunx procedure->memoizing-macro proc
+Returns a @dfn{macro} which, when a symbol defined to this value appears
+as the first symbol in an expression, evaluates the result of applying
+@var{proc} to the expression and the environment.  The value returned
+from @var{proc} which has been passed to
+@code{PROCEDURE->MEMOIZING-MACRO} replaces the form passed to
+@var{proc}.  For example:
+
+@example
+(define trace
+  (procedure->macro
+   (lambda (x env) `(set! ,(cadr x) (tracef ,(cadr x) ',(cadr x))))))
+
+(trace @i{foo}) @equiv{} (set! @i{foo} (tracef @i{foo} '@i{foo})).
+@end example
+
+An @dfn{environment} is a list of @dfn{environment frames}.  There are 2
+types of environment frames:
+
+@table @code
+@item ((lambda (variable1 @dots{}) @dots{}) value1 @dots{})
+@itemx (let ((variable1 value1) (variable2 value2) @dots{}) @dots{})
+@itemx (letrec ((variable1 value1)  @dots{}) @dots{})
+result in a single enviroment frame:
+@example
+((variable1 @dots{}) value1 @dots{})
+@end example
+
+@item (let ((variable1 value1)) @dots{})
+@itemx (let* ((variable1 value1) @dots{}) @dots{})
+result in an environment frame for each variable:
+@example
+(variable1 . value1) (variable2 .  value2) @dots{}
+@end example
+@end table
+@end defun
+
+@defspec @@apply procedure argument-list
+Returns the result of applying procedure to argument-list.  (apply
+procedure argument-list) will produce the same result.
+@end defspec
+
+@defspec @@call-with-current-continuation procedure)
+Returns the result of applying @var{procedure} to the current
+continuation.  A @dfn{continuation} is a SCM object of type
+@code{contin} (@pxref{Continuations}).  The procedure
+@code{(call-with-current-continuation @var{procedure})} is defined to
+have the same effect as @code{(@@call-with-current-continuation
+procedure)}.
+@end defspec
+
+
+@node Packages, The Implementation, The Language, Top
+@chapter Packages
+
+@menu
+* Executable path::             
+* Compiling And Linking::       Hobbit and Dynamic Linking
+* Dynamic Linking::             
+* Dump::                        Create Fast-Booting Executables
+* Numeric::                     Numeric Language Extensions
+* Arrays::                      As in APL
+* I/O-Extensions::              'i/o-extensions
+* Posix Extensions::            'posix
+* Regular Expression Pattern Matching::  'regex
+* Line Editing::                'edit-line
+* Curses::                      Screen Control
+* Sockets::                     Cruise the Net
+@end menu
+
+@node Executable path, Compiling And Linking, Packages, Packages
+@section Executable path
+
+In order to dump a saved executable or to dynamically-link using DLD,
+SCM must know where its executable file is.  Sometimes SCM
+(@pxref{Executable Pathname}) guesses incorrectly the location of the
+currently running executable.  In that case, the correct path can be set
+by calling @code{execpath} with the pathname.
+
+@defun execpath
+Returns the path (string) which SCM uses to find the executable file
+whose invocation the currently running session is, or #f if the path is
+not set.
+@defunx execpath #f
+@defunx execpath newpath
+Sets the path to @code{#f} or @var{newpath}, respectively.  The old path
+is returned.
+@end defun
+
+@node Compiling And Linking, Dynamic Linking, Executable path, Packages
+@section Compiling And Linking
+
+@defun compile-file name1 name2 @dots{}
+If the HOBBIT compiler is installed in the
+@code{(implementation-vicinity)}, compiles the files @var{name1}
+@var{name2} @dots{} to an object file name @var{name1}<object-suffix>,
+where <object-suffix> is the object file suffix for your computer (for
+instance, @file{.o}).  @var{name1} must be in the current directory;
+@var{name2} @dots{} can be in other directories.
+@end defun
+
+@defun link-named-scm name module1 @dots{}
+Creates a new SCM executable with name @var{name}.  @var{name} will
+include the object modules @var{module1} @dots{} which can be produced
+with @code{compile-file}.
+
+@example
+cd ~/scm/
+scm -e'(link-named-scm"cute""cube")'
+(delete-file "scmflags.h")
+(call-with-output-file
+  "scmflags.h"
+  (lambda (fp)
+    (for-each
+      (lambda (string) (write-line string fp))
+      '("#define IMPLINIT \"/home/jaffer/scm/Init.scm\""
+        "#define COMPILED_INITS init_cube();"
+        "#define BIGNUMS"
+        "#define FLOATS"
+        "#define ARRAYS"))))
+(system "gcc -Wall -O2 -c continue.c findexec.c time.c
+ repl.c scl.c eval.c sys.c subr.c unif.c rope.c scm.c")
+@dots{}
+scm.c: In function `scm_init_extensions':
+scm.c:95: warning: implicit declaration of function `init_cube'
+scm.c: In function `scm_cat_path':
+scm.c:589: warning: implicit declaration of function `realloc'
+scm.c:594: warning: implicit declaration of function `malloc'
+scm.c: In function `scm_try_path':
+scm.c:612: warning: implicit declaration of function `free'
+(system "cc -o cute continue.o findexec.o time.o repl.o scl.o
+ eval.o sys.o subr.o unif.o rope.o scm.o cube.o  -lm -lc")
+
+Compilation finished at Sun Jul 21 00:59:17
+@end example
+@end defun
+
+@node Dynamic Linking, Dump, Compiling And Linking, Packages
+@section Dynamic Linking
+
+@noindent
+If SCM has been compiled with @file{dynl.c} then the additional
+properties of load and require (from [SLIB]) specified here are
+supported.  The @code{require} forms are preferred.  The variable
+@code{*catalog*} can be extended to define other @code{require}-able
+packages.  See @file{Link.scm} for details.
+
+@defun load filename lib1 @dots{}
+In addition to the [R4RS] requirement of loading Scheme expressions if
+@var{filename} is a Scheme source file, @code{load} will also
+dynamically load/link object files (produced by @code{compile-file}, for
+instance).  The object-suffix need not be given to load.  For example,
+
+@example
+(load (in-vicinity (implementation-vicinity) "sc2"))
+or (load (in-vicinity (implementation-vicinity) "sc2.o"))
+or (require 'rev2-procedures)
+or (require 'rev3-procedures)
+@end example
+
+will load/link @file{sc2.o} if it exists.
+
+The @var{lib1} @dots{} pathnames are for additional libraries which may be
+needed for object files not produced by the Hobbit compiler.  For
+instance, crs is linked on Linux by
+
+@example
+(load (in-vicinity (implementation-vicinity) "crs.o")
+      (usr:lib "ncurses") (usr:lib "c"))
+or (require 'curses)
+@end example
+
+Turtlegr graphics library is linked by:
+
+@example
+(load (in-vicinity (implementation-vicinity) "turtlegr")
+      (usr:lib "X11") (usr:lib "c") (usr:lib "m"))
+or (require 'turtle-graphics)
+@end example
+
+And the string regular expression (@pxref{Regular Expression Pattern
+Matching}) package is linked by:
+
+@example
+(load (in-vicinity (implementation-vicinity) "rgx") (usr:lib "c"))
+@end example
+or
+@example
+(require 'regex)
+@end example
+@end defun
+
+@defun require 'db
+@defunx require 'wb
+Either form will dynamically load the WB database system from the
+wb:vicinity (@file{../wb/}) specified in @file{Link.scm}.  See
+@file{scm/ANNOUNCE} for ftp sites where WB is available.
+@end defun
+
+@noindent
+The following functions comprise the low-level Scheme interface to
+dynamic linking.  See the file @file{Link.scm} in the SCM distribution
+for an example of their use.
+
+@defun dyn:link filename
+@var{filename} should be a string naming an @dfn{object} or
+@dfn{archive} file, the result of C-compiling.  The @code{dyn:link}
+procedure links and loads @var{filename} into the current SCM session.
+If successfull, @code{dyn:link} returns a @dfn{link-token} suitable for
+passing as the second argument to @code{dyn:call}.  If not successful,
+@code{#f} is returned.
+@end defun
+
+@defun dyn:call name link-token
+@var{link-token} should be the value returned by a call to
+@code{dyn:link}.  @var{name} should be the name of C function of no
+arguments defined in the file named @var{filename} which was succesfully
+@code{dyn:link}ed in the current SCM session.  The @code{dyn:call}
+procedure calls the C function corresponding to @var{name}.  If
+successful, @code{dyn:call} returns @code{#t}; If not successful,
+@code{#f} is returned.
+
+@code{dyn:call} is used to call the @dfn{init_@dots{}} function after
+loading SCM object files.  The init_@dots{} function then makes the
+identifiers defined in the file accessible as Scheme procedures.
+@end defun
+
+@defun dyn:main-call name link-token arg1 @dots{}
+@var{link-token} should be the value returned by a call to
+@code{dyn:link}.  @var{name} should be the name of C function of 2
+arguments, @code{(int argc, char **argv)}, defined in the file named
+@var{filename} which was succesfully @code{dyn:link}ed in the current
+SCM session.  The @code{dyn:main-call} procedure calls the C function
+corresponding to @var{name} with @code{argv} style arguments, such as
+are given to C @code{main} functions.  If successful,
+@code{dyn:main-call} returns the integer returned from the call to
+@var{name}.
+
+@code{dyn:main-call} can be used to call a @code{main} procedure from
+SCM.  For example, I link in and @code{dyn:main-call} a large C program,
+the low level routines of which callback (@pxref{Callbacks}) into SCM
+(which emulates PCI hardware).
+@end defun
+
+@defun dyn:unlink link-token
+@var{link-token} should be the value returned by a call to
+@code{dyn:link}.  The @code{dyn:unlink} procedure removes the previously
+loaded file from the current SCM session.  If successful,
+@code{dyn:unlink} returns @code{#t}; If not successful, @code{#f} is
+returned.
+@end defun
+
+@defun usr:lib lib
+Returns the pathname of the C library named lib.  For example:
+@code{(usr:lib "m")} could return @code{"/usr/lib/libm.a"}, the path of
+the C math library.
+@end defun
+
+@node Dump, Numeric, Dynamic Linking, Packages
+@section Dump
+
+@dfn{Dump}, (also known as @dfn{unexec}), saves the continuation of an
+entire SCM session to an executable file, which can then be invoked as a
+program.  Dumped executables start very quickly, since no Scheme code
+has to be loaded.
+
+@noindent
+There are constraints on which sessions are savable using @code{dump}
+
+@itemize @bullet
+@item
+Saved continuations are invalid in subsequent invocations; they cause
+segmentation faults and other unpleasant side effects.
+@item
+Although DLD (@pxref{Dynamic Linking}) can be used to load compiled
+modules both before and after dumping, @samp{SUN_DL} ELF systems can
+load compiled modules only after dumping.  This can be worked around by
+compiling in those features you wish to @code{dump}.
+@item
+Ports (other than @code{current-input-port}, @code{current-output-port},
+@code{current-error-port}), X windows, etc. are invalid in subsequent
+invocations.
+
+This restriction could be removed; @xref{Improvements To Make}.
+@item
+@code{Dump} should only be called from a loading file when the call to
+dump is the last expression in that file.
+@item
+@code{Dump} can be called from the command line.
+@end itemize
+
+@defun dump newpath
+@defunx dump newpath #f
+@defunx dump newpath #t
+@defunx dump newpath thunk
+@itemize @bullet
+@item
+Calls @code{gc}.
+@item
+Creates an executable program named @var{newpath} which continues the
+state of the current SCM session when invoked.  The optional argument
+@var{thunk}, if provided, should be a procedure of no arguments.  This
+procedure will be called in the restored executable.
+
+If the optional argument is missing or a boolean, SCM's standard command
+line processing will be called in the restored executable.
+
+If the second argument to @code{dump} is @code{#t}, argument processing
+will continue from the command line passed to the dumping session.  If
+the second argument is missing or @code{#f} then the command line
+arguments of the restoring invocation will be processed.
+@item
+Resumes the top level Read-Eval-Print loop.  This is done instead of
+continuing normally to avoid creating a saved continuation in the dumped
+executable.
+@end itemize
+
+@code{dump} may set the values of @code{boot-tail}, @code{*argv*},
+@code{restart}, and @var{*interactive*}.  @code{dump} returns an
+unspecified value.
+@end defun
+
+When a dumped executable is invoked, the variable @var{*interactive*}
+(@pxref{System Interface}) has the value it possessed when @code{dump}
+created it.  Calling @code{dump} with a single argument sets
+@var{*interactive*} to @code{#f}, which is the state it has at the
+beginning of command line processing.
+
+The procedure @code{program-arguments} returns the command line
+arguments for the curent invocation.  More specifically,
+@code{program-arguments} for the restored session are @emph{not} saved
+from the dumping session.  Command line processing is done on
+the value of the identifier @code{*argv*}.
+
+The thunk @code{boot-tail} is called by SCM to process command line
+arguments.  @code{dump} sets @code{boot-tail} to the @var{thunk} it is
+called with.
+
+The following example shows how to create @samp{rscm}, which is like
+regular scm, but which loads faster and has the @samp{random} package
+alreadly provided.
+
+@example
+bash$ scm -rrandom
+> (dump "rscm")
+#<unspecified>
+> (quit)
+bash$ ./rscm -lpi.scm -e"(pi (random 200) 5)"
+00003 14159 26535 89793 23846 26433 83279 50288 41971 69399
+37510 58209 74944 59230 78164 06286 20899 86280 34825 34211
+70679 82148 08651 32823 06647 09384 46095 50582 23172 53594
+08128 48111 74502 84102 70193 85211 05559 64462 29489 
+bash$ 
+@end example
+
+This task can also be accomplished using the @samp{-o} command line
+option (@pxref{SCM Options}).
+
+@example
+bash$ scm -rrandom -o rscm
+> (quit)
+bash$ ./rscm -lpi.scm -e"(pi (random 200) 5)"
+00003 14159 26535 89793 23846 26433 83279 50288 41971 69399
+37510 58209 74944 59230 78164 06286 20899 86280 34825 34211
+70679 82148 08651 32823 06647 09384 46095 50582 23172 53594
+08128 48111 74502 84102 70193 85211 05559 64462 29489 
+bash$ 
+@end example
+
+@node Numeric, Arrays, Dump, Packages
+@section Numeric
+
+@defvr Constant most-positive-fixnum
+The immediate integer closest to positive infinity.
+@xref{Configuration, , , slib, SLIB}.
+@end defvr
+
+@defvr Constant most-negative-fixnum
+The immediate integer closest to negative infinity.
+@end defvr
+
+@noindent
+These procedures augment the standard capabilities in @ref{Numerical
+operations, , ,r4rs, Revised(4) Scheme}.
+
+@defun sinh z
+@defunx cosh z
+@defunx tanh z
+Return the hyperbolic sine, cosine, and tangent of @var{z}
+@end defun
+
+@defun asinh z
+@defunx acosh z
+@defunx atanh z
+Return the inverse hyperbolic sine, cosine, and tangent of @var{z}
+@end defun
+
+@defun $sqrt x
+@defunx $abs x
+@defunx $exp x
+@defunx $log x
+@defunx $sin x
+@defunx $cos x
+@defunx $tan x
+@defunx $asin x
+@defunx $acos x
+@defunx $atan x
+
+@defunx $sinh x
+@defunx $cosh x
+@defunx $tanh x
+@defunx $asinh x
+@defunx $acosh x
+@defunx $atanh x
+Real-only versions of these popular functions.  The argument @var{x}
+must be a real number.  It is an error if the value which should be
+returned by a call to these procedures is @emph{not} real.
+@end defun
+
+@defun $atan2 y x
+Computes @code{(angle (make-rectangular x y))} for real numbers @var{y}
+and @var{x}.
+@end defun
+
+@defun $expt x1 x2
+Returns real number @var{x1} raised to the real power @var{x2}.  It is
+an error if the value which should be returned by a call to @code{$expt}
+is not real.
+@end defun
+
+@node Arrays, I/O-Extensions, Numeric, Packages
+@section Arrays
+
+@menu
+* Conventional Arrays::         
+* Array Mapping::               
+* Uniform Array::               
+* Bit Vectors::                 
+@end menu
+
+@node Conventional Arrays, Array Mapping, Arrays, Arrays
+@subsection Conventional Arrays
+
+@dfn{Arrays} read and write as a @code{#} followed by the @dfn{rank}
+(number of dimensions) followed by what appear as lists (of lists) of
+elements.  The lists must be nested to the depth of the rank.  For each
+depth, all lists must be the same length.
+@example
+(make-array 'ho 3 3) @result{}
+#2((ho ho ho) (ho ho ho) (ho ho ho))
+@end example
+
+Unshared conventional (not uniform) 0-based arrays of rank 1 (dimension)
+are equivalent to (and can't be distinguished from) vectors.
+@example
+(make-array 'ho 3) @result{} (ho ho ho)
+@end example
+
+When constructing an array, @var{bound} is either an inclusive range of
+indices expressed as a two element list, or an upper bound expressed
+as a single integer.  So
+@example
+(make-array 'foo 3 3) @equiv{} (make-array 'foo '(0 2) '(0 2))
+@end example
+
+@defun array? obj
+Returns @code{#t} if the @var{obj} is an array, and @code{#f} if not.
+@end defun
+
+@defun make-array initial-value bound1 bound2 @dots{}
+Creates and returns an array that has as many dimensions as there are
+@var{bound}s and fills it with @var{initial-value}.
+@end defun
+
+@defun array-ref array index1 index2 @dots{}
+Returns the @var{index1}, @var{index2}, @dots{}'th element of
+@var{array}.
+@end defun
+
+@defun array-in-bounds? array index1 index2 @dots{}
+Returns @code{#t} if its arguments would be acceptable to @var{array-ref}.
+@end defun
+
+@defun array-set! array new-value index1 index2 @dots{}
+Sets the @var{index1}, @var{index2}, @dots{}'th element of @var{array}
+to @var{new-value}.  The value returned by @code{array-set!} is
+unspecified.
+@end defun
+
+@defun make-shared-array array mapper bound1 bound2 @dots{}
+@code{make-shared-array} can be used to create shared subarrays of other
+arrays.  The @var{mapper} is a function that translates coordinates in
+the new array into coordinates in the old array.  A @var{mapper} must be
+linear, and its range must stay within the bounds of the old array, but
+it can be otherwise arbitrary.  A simple example:
+@example
+(define fred (make-array #f 8 8))
+(define freds-diagonal
+  (make-shared-array fred (lambda (i) (list i i)) 8))
+(array-set! freds-diagonal 'foo 3)
+(array-ref fred 3 3) @result{} foo
+(define freds-center
+  (make-shared-array fred (lambda (i j) (list (+ 3 i) (+ 3 j))) 2 2))
+(array-ref freds-center 0 0) @result{} foo
+@end example
+@end defun
+
+@defun transpose-array array dim0 dim1 @dots{}
+Returns an array sharing contents with @var{array}, but with dimensions
+arranged in a different order.  There must be one @var{dim} argument for
+each dimension of @var{array}.  @var{dim0}, @var{dim1}, @dots{} should
+be integers between 0 and the rank of the array to be returned.  Each
+integer in that range must appear at least once in the argument list.
+
+The values of @var{dim0}, @var{dim1}, @dots{} correspond to dimensions
+in the array to be returned, their positions in the argument list to
+dimensions of @var{array}.  Several @var{dim}s may have the same value,
+in which case the returned array will have smaller rank than
+@var{array}.
+
+examples:
+@example
+(transpose-array '#2((a b) (c d)) 1 0) @result{} #2((a c) (b d))
+(transpose-array '#2((a b) (c d)) 0 0) @result{} #1(a d)
+(transpose-array '#3(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1 1 0) @result{}
+                #2((a 4) (b 5) (c 6))
+@end example
+@end defun
+
+@defun enclose-array array dim0 dim1 @dots{}
+@var{dim0}, @var{dim1} @dots{} should be nonnegative integers less than
+the rank of @var{array}.  @var{enclose-array} returns an array
+resembling an array of shared arrays.  The dimensions of each shared
+array are the same as the @var{dim}th dimensions of the original array,
+the dimensions of the outer array are the same as those of the original
+array that did not match a @var{dim}.
+
+An enclosed array is not a general Scheme array.  Its elements may not
+be set using @code{array-set!}.  Two references to the same element of
+an enclosed array will be @code{equal?} but will not in general be
+@code{eq?}.  The value returned by @var{array-prototype} when given an
+enclosed array is unspecified.
+
+examples:
+@example
+(enclose-array '#3(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1) @result{}
+   #<enclosed-array (#1(a d) #1(b e) #1(c f)) (#1(1 4) #1(2 5) #1(3 6))>
+
+(enclose-array '#3(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1 0) @result{}
+   #<enclosed-array #2((a 1) (d 4)) #2((b 2) (e 5)) #2((c 3) (f 6))>
+@end example
+@end defun
+
+@defun array-shape array
+Returns a list of inclusive bounds of integers.
+@example
+(array-shape (make-array 'foo '(-1 3) 5)) @result{} ((-1 3) (0 4))
+@end example
+@end defun
+
+@defun array-dimensions array
+@code{Array-dimensions} is similar to @code{array-shape} but replaces
+elements with a @code{0} minimum with one greater than the maximum. So:
+@example
+(array-dimensions (make-array 'foo '(-1 3) 5)) @result{} ((-1 3) 5)
+@end example
+@end defun
+
+@defun array-rank obj
+Returns the number of dimensions of @var{obj}.  If @var{obj} is not an
+array, @code{0} is returned.
+@end defun
+
+@defun array->list array
+Returns a list consisting of all the elements, in order, of @var{array}.
+@end defun
+
+@defun array-copy! source destination
+Copies every element from vector or array @var{source} to the
+corresponding element of @var{destination}.  @var{destination} must have
+the same rank as @var{source}, and be at least as large in each
+dimension.  The order of copying is unspecified.
+@end defun
+
+@defun serial-array-copy! source destination
+Same as @code{array-copy!} but guaranteed to copy in row-major order.
+@end defun
+
+@defun array-fill! array fill
+Stores @var{fill} in every element of @var{array}.  The value returned
+is unspecified.
+@end defun
+
+@defun array-equal? array0 array1 @dots{}
+Returns @code{#t} iff all arguments are arrays with the same shape, the
+same type, and have corresponding elements which are either
+@code{equal?}  or @code{array-equal?}.  This function differs from
+@code{equal?} in that a one dimensional shared array may be
+@var{array-equal?} but not @var{equal?} to a vector or uniform vector.
+@end defun
+
+@defun array-contents array
+@defunx array-contents array strict
+If @var{array} may be @dfn{unrolled} into a one dimensional shared array
+without changing their order (last subscript changing fastest), then
+@code{array-contents} returns that shared array, otherwise it returns
+@code{#f}.  All arrays made by @var{make-array} and
+@var{make-uniform-array} may be unrolled, some arrays made by
+@var{make-shared-array} may not be.
+
+If the optional argument @var{strict} is provided, a shared array will
+be returned only if its elements are stored internally contiguous in
+memory.
+@end defun
+
+@node Array Mapping, Uniform Array, Conventional Arrays, Arrays
+@subsection Array Mapping
+
+@defun array-map! array0 proc array1 @dots{}
+
+If @var{array1}, @dots{} are arrays, they must have the same number of
+dimensions as @var{array0} and have a range for each index which
+includes the range for the corresponding index in @var{array0}.
+If they are scalars, that is, not arrays, vectors, or strings, then
+they will be converted internally to arrays of the appropriate shape.
+@var{proc} is applied to each tuple of elements of @var{array1} @dots{}
+and the result is stored as the corresponding element in @var{array0}.
+The value returned is unspecified.  The order of application is
+unspecified.
+
+@end defun
+
+@defun serial-array-map! array0 proc array1 @dots{}
+Same as @var{array-map!}, but guaranteed to apply @var{proc} in
+row-major order.
+@end defun
+
+@defun array-for-each proc array0 @dots{}
+@var{proc} is applied to each tuple of elements of @var{array0} @dots{}
+in row-major order.  The value returned is unspecified.
+@end defun
+
+@defun array-index-map! array proc
+applies @var{proc} to the indices of each element of @var{array} in
+turn, storing the result in the corresponding element.  The value
+returned and the order of application are unspecified.
+
+One can implement @var{array-indexes} as
+@example
+(define (array-indexes array)
+    (let ((ra (apply make-array #f (array-shape array))))
+      (array-index-map! ra (lambda x x))
+      ra))
+@end example
+Another example:
+@example
+(define (apl:index-generator n)
+    (let ((v (make-uniform-vector n 1)))
+      (array-index-map! v (lambda (i) i))
+      v))
+@end example
+@end defun
+
+@defun scalar->array scalar array prototype
+Returns a uniform array of the same shape as @var{array}, having only
+one shared element, which is @code{eqv?} to @var{scalar}.
+If the optional argument @var{prototype} is supplied it will be used
+as the prototype for the returned array.  Otherwise the returned array
+will be of the same type as @code{array} if that is possible, and
+a conventional array if it is not.  This function is used internally
+by @code{array-map!} and friends to handle scalar arguments.
+@end defun
+
+@node Uniform Array, Bit Vectors, Array Mapping, Arrays
+@subsection Uniform Array
+
+@noindent
+@dfn{Uniform Arrays} and vectors are arrays whose elements are all of
+the same type.  Uniform vectors occupy less storage than conventional
+vectors.  Uniform Array procedures also work on vectors,
+uniform-vectors, bit-vectors, and strings.
+
+@noindent
+@var{prototype} arguments in the following procedures are interpreted
+according to the table:
+
+@example
+prototype       type                             display prefix
+
+#t              boolean (bit-vector)                    #b
+#\a             char (string)                           #a
+integer >0      unsigned integer                        #u
+integer <0      signed integer                          #e
+1.0             float (single precision)                #s
+1/3             double (double precision float)         #i
++i              complex (double precision)              #c
+()              conventional vector                     #
+@end example
+
+@noindent
+Unshared uniform character 0-based arrays of rank 1 (dimension)
+are equivalent to (and can't be distinguished from) strings.
+@example
+(make-uniform-array #\a 3) @result{} "$q2"
+@end example
+
+@noindent
+Unshared uniform boolean 0-based arrays of rank 1 (dimension) are
+equivalent to (and can't be distinguished from) @ref{Bit Vectors,
+bit-vectors}.
+@example
+(make-uniform-array #t 3) @result{} #*000
+@equiv{}
+#b(#f #f #f) @result{} #*000
+@equiv{}
+#1b(#f #f #f) @result{} #*000
+@end example
+
+@noindent
+Other uniform vectors are written in a form similar to that of vectors,
+except that a single character from the above table is put between
+@code{#} and @code{(}.  For example, @code{'#e(3 5 9)} returns a uniform
+vector of signed integers.
+
+@defun uniform-vector-ref uve index
+Returns the element at the @var{index} element in @var{uve}.
+@end defun
+
+@defun uniform-vector-set! uve index new-value
+Sets the element at the @var{index} element in @var{uve} to
+@var{new-value}.  The value returned by @code{uniform-vector-set!} is
+unspecified.
+@end defun
+
+@defun array? obj prototype
+Returns @code{#t} if the @var{obj} is an array of type corresponding to
+@var{prototype}, and @code{#f} if not.
+@end defun
+
+@defun make-uniform-array prototype bound1 bound2 @dots{}
+Creates and returns a uniform array of type corresponding to
+@var{prototype} that has as many dimensions as there are @var{bound}s
+and fills it with @var{prototype}.
+@end defun
+
+@defun array-prototype array
+Returns an object that would produce an array of the same type as
+@var{array}, if used as the @var{prototype} for
+@code{make-uniform-array}.
+@end defun
+
+@defun list->uniform-array rank prot lst
+@defunx list->uniform-vector prot lst
+Returns a uniform array of the type indicated by prototype @var{prot}
+with elements the same as those of @var{lst}.  Elements must be of the
+appropriate type, no coercions are done.
+@end defun
+
+@defun uniform-vector-fill! uve fill
+Stores @var{fill} in every element of @var{uve}.  The value returned is
+unspecified.
+@end defun
+
+@defun uniform-vector-length uve
+Returns the number of elements in @var{uve}.
+@end defun
+
+@defun dimensions->uniform-array dims prototype fill
+@defunx dimensions->uniform-array dims prototype
+@defunx make-uniform-vector length prototype fill
+@defunx make-uniform-vector length prototype
+Creates and returns a uniform array or vector of type corresponding to
+@var{prototype} with dimensions @var{dims} or length @var{length}.  If
+the @var{fill} argument is supplied, the returned array is filled with
+this value.
+@end defun
+
+@defun uniform-array-read! ura
+@defunx uniform-array-read! ura port
+@defunx uniform-vector-read! uve
+@defunx uniform-vector-read! uve port
+Attempts to read all elements of @var{ura}, in lexicographic order, as
+binary objects from @var{port}.  If an end of file is encountered during
+uniform-array-read! the objects up to that point only are put into @var{ura}
+(starting at the beginning) and the remainder of the array is
+unchanged.
+
+@code{uniform-array-read!} returns the number of objects read.
+@var{port} may be omitted, in which case it defaults to the value
+returned by @code{(current-input-port)}.
+@end defun
+
+@defun uniform-array-write ura
+@defunx uniform-array-write ura port
+@defunx uniform-vector-write uve
+@defunx uniform-vector-write uve port
+Writes all elements of @var{ura} as binary objects to @var{port}. The
+number of of objects actually written is returned. @var{port} may be
+omitted, in which case it defaults to the value returned by
+@code{(current-output-port)}.
+@end defun
+
+@node Bit Vectors,  , Uniform Array, Arrays
+@subsection Bit Vectors
+
+@noindent
+Bit vectors can be written and read as a sequence of @code{0}s and
+@code{1}s prefixed by @code{#*}.
+
+@example
+#b(#f #f #f #t #f #t #f) @result{} #*0001010
+@end example
+
+@noindent
+Some of these operations will eventually be generalized to other
+uniform-arrays.
+
+@defun bit-count bool bv
+Returns the number occurrences of @var{bool} in @var{bv}.
+@end defun
+
+@defun bit-position bool bv k
+Returns the minimum index of an occurrence of @var{bool} in @var{bv}
+which is at least @var{k}.  If no @var{bool} occurs within the specified
+range @code{#f} is returned.
+@end defun
+
+@defun bit-invert! bv
+Modifies @var{bv} by replacing each element with its negation.
+@end defun
+
+@defun bit-set*! bv uve bool
+If uve is a bit-vector @var{bv} and uve must be of the same length.  If
+@var{bool} is @code{#t}, uve is OR'ed into @var{bv}; If @var{bool} is @code{#f}, the
+inversion of uve is AND'ed into @var{bv}.
+
+If uve is a unsigned integer vector all the elements of uve must be
+between 0 and the @code{LENGTH} of @var{bv}.  The bits of @var{bv}
+corresponding to the indexes in uve are set to @var{bool}.
+
+The return value is unspecified.
+@end defun
+
+@defun bit-count* bv uve bool
+Returns
+@example
+(bit-count (bit-set*! (if bool bv (bit-invert! bv)) uve #t) #t).
+@end example
+@var{bv} is not modified.
+@end defun
+
+
+@node I/O-Extensions, Posix Extensions, Arrays, Packages
+@section I/O-Extensions
+
+@noindent
+If @code{'i/o-extensions} is provided (by linking in @file{ioext.o}),
+@ref{Line I/O, , , slib, SLIB}, and the following functions are defined:
+
+@defun isatty? port
+Returns @code{#t} if @var{port} is input or output to a serial non-file device.
+@end defun
+
+@defun stat <port-or-string>
+Returns a vector of integers describing the argument.  The argument
+can be either a string or an open input port. If the argument is an
+open port then the returned vector describes the file to which the
+port is opened; If the argument is a string then the returned vector
+describes the file named by that string.  If there exists no file with
+the name string, or if the file cannot be accessed @code{#f} is returned.
+The elements of the returned vector are as follows:
+
+
+@table @r
+@item 0  st_dev
+ID of device containing a directory entry for this file
+@item 1  st_ino
+Inode number
+@item 2  st_mode
+File type, attributes, and access control summary
+@item 3  st_nlink
+Number of links
+@item 4  st_uid
+User ID of file owner
+@item 5  st_gid
+Group ID of file group
+@item 6  st_rdev
+Device ID; this entry defined only for char or blk spec files
+@item 7  st_size
+File size (bytes)
+@item 8  st_atime
+Time of last access
+@item 9  st_mtime
+Last modification time
+@item 10 st_ctime
+Last file status change time
+@end table
+@end defun
+
+@defun getpid
+Returns the process ID of the current process.
+@end defun
+
+@defun file-position port
+Returns the current position of the character in @var{port} which will
+next be read or written.  If @var{port} is not open to a file the result
+is unspecified.
+@end defun
+
+@defun file-set-position port integer
+Sets the current position in @var{port} which will next be read or
+written.  If @var{port} is not open to a file the action of
+@code{file-set-position} is unspecified.  The result of
+@code{file-set-position} is unspecified.
+@end defun
+
+@defun reopen-file filename modes port
+Closes port @var{port} and reopens it with @var{filename} and
+@var{modes}.  @code{reopen-file} returns @code{#t} if successful,
+@code{#f} if not.
+@end defun
+
+@defun duplicate-port port modes
+Creates and returns a @dfn{duplicate} port from @var{port}.  Duplicate
+@emph{unbuffered} ports share one file position.  @var{modes} are as for
+@ref{Files and Ports, open-file}.
+@end defun
+
+@defun redirect-port! from-port to-port
+Closes @var{to-port} and makes @var{to-port} be a duplicate of
+@var{from-port}.  @code{redirect-port!} returns @var{to-port} if
+successful, @code{#f} if not.  If unsuccessful, @var{to-port} is not
+closed.
+@end defun
+
+@defun opendir dirname
+Returns a @dfn{directory} object corresponding to the file system
+directory named @var{dirname}.  If unsuccessful, returns @code{#f}.
+@end defun
+
+@defun readdir dir
+Returns the string name of the next entry from the directory @var{dir}.
+If there are no more entries in the directory, @code{readdir} returns a
+@code{#f}.
+@end defun
+
+@defun rewinddir dir
+Reinitializes @var{dir} so that the next call to @code{readdir} with
+@var{dir} will return the first entry in the directory again.
+@end defun
+
+@defun closedir dir
+Closes @var{dir} and returns @code{#t}.  If @var{dir} is already
+closed,, @code{closedir} returns a @code{#f}.
+@end defun
+
+@defun mkdir path mode
+The @code{mkdir} function creates a new, empty directory whose name is
+@var{path}.  The integer argument @var{mode} specifies the file
+permissions for the new directory.  @xref{The Mode Bits for Access
+Permission, , , libc, Gnu C Library}, for more information about this.
+
+@code{mkdir} returns if successful, @code{#f} if not.
+@end defun
+
+@defun rmdir path
+The @code{rmdir} function deletes the directory @var{path}.  The
+directory must be empty before it can be removed.  @code{rmdir} returns
+if successful, @code{#f} if not.
+@end defun
+
+@defun chdir filename
+Changes the current directory to @var{filename}.  If @var{filename} does not
+exist or is not a directory, @code{#f} is returned.  Otherwise, @code{#t} is
+returned.
+@end defun
+
+@defun getcwd
+The function @code{getcwd} returns a string containing the absolute file
+name representing the current working directory.  If this string cannot
+be obtained, @code{#f} is returned.
+@end defun
+
+@defun rename-file oldfilename newfilename
+Renames the file specified by @var{oldfilename} to @var{newfilename}.
+If the renaming is successful, @code{#t} is returned.  Otherwise,
+@code{#f} is returned.
+@end defun
+
+@defun chmod file mode
+The function @code{chmod} sets the access permission bits for the file
+named by @var{file} to @var{mode}.  The @var{file} argument may be a
+string containing the filename or a port open to the file.
+
+@code{chmod} returns if successful, @code{#f} if not.
+@end defun
+
+@defun utime pathname acctime modtime
+Sets the file times associated with the file named @var{pathname} to
+have access time @var{acctime} and modification time @var{modtime}.
+@code{utime} returns if successful, @code{#f} if not.
+@end defun
+
+@defun umask mode
+The function @code{umask} sets the file creation mask of the current
+process to @var{mask}, and returns the previous value of the file
+creation mask.
+@end defun
+
+@defun fileno port
+Returns the integer file descriptor associated with the port @var{port}.
+If an error is detected, @code{#f} is returned.
+@end defun
+
+@defun access pathname how
+Returns @code{#t} if the file named by @var{pathname} can be accessed in
+the way specified by the @var{how} argument.  The @var{how} argument can
+be the @code{logior} of the flags:
+
+@enumerate 0
+@item
+File-exists?
+@item
+File-is-executable?
+@item
+File-is-writable?
+@end enumerate
+@enumerate 4
+@item
+File-is-readable?
+@end enumerate
+
+Or the @var{how} argument can be a string of 0 to 3 of the following
+characters in any order.  The test performed is the @code{and} of the
+associated tests and @code{file-exists?}.
+
+@table @key
+@item x
+File-is-executable?
+@item w
+File-is-writable?
+@item r
+File-is-readable?
+@end table
+@end defun
+
+@defun execl command arg0 @dots{}
+@defunx execlp command arg0 @dots{}
+Transfers control to program @var{command} called with arguments
+@var{arg0} @dots{}.  For @code{execl}, @var{command} must be an exact
+pathname of an executable file.  @code{execlp} searches for
+@var{command} in the list of directories specified by the environment
+variable @var{PATH}.  The convention is that @var{arg0} is the same name
+as @var{command}.
+
+If successful, this procedure does not return.  Otherwise an error
+message is printed and the integer @code{errno} is returned.
+
+@defunx execv command arglist
+@defunx execvp command arglist
+Like @code{execl} and @code{execlp} except that the set of arguments to
+@var{command} is @var{arglist}.
+@end defun
+
+@defun putenv string
+adds or removes definitions from the @dfn{environment}. If the
+@var{string} is of the form @samp{NAME=VALUE}, the definition is added
+to the environment.  Otherwise, the @var{string} is interpreted as the
+name of an environment variable, and any definition for this variable in
+the environment is removed.
+
+Names of environment variables are case-sensitive and must not contain
+the character @code{=}.  System-defined environment variables are
+invariably uppercase.
+
+@code{Putenv} is used to set up the environment before calls to
+@code{execl}, @code{execlp}, @code{execv}, @code{execvp}, @code{system},
+or @code{open-pipe} (@pxref{I/O-Extensions, open-pipe}).
+
+To access environment variables, use @code{getenv} (@pxref{System
+Interface, getenv, , slib, SLIB}).
+@end defun
+
+@node Posix Extensions, Regular Expression Pattern Matching, I/O-Extensions, Packages
+@section Posix Extensions
+
+@noindent
+If @code{'posix} is provided (by linking in @file{posix.o}), the
+following functions are defined:
+
+@defun open-pipe string modes
+If the string @var{modes} contains an @key{r}, returns an input port
+capable of delivering characters from the standard output of the system
+command @var{string}.  Otherwise, returns an output port capable of
+receiving characters which become the standard input of the system
+command @var{string}.  If a pipe cannot be created @code{#f} is
+returned.
+@end defun
+
+@defun open-input-pipe string
+Returns an input port capable of delivering characters from the
+standard output of the system command @var{string}.  If a pipe cannot be
+created @code{#f} is returned.
+@end defun
+
+@defun open-output-pipe string
+Returns an output port capable of receiving characters which become
+the standard input of the system command @var{string}.  If a pipe cannot
+be created @code{#f} is returned.
+@end defun
+
+@defun close-port pipe
+Closes the @var{pipe}, rendering it incapable of delivering or accepting
+characters.  This routine has no effect if the pipe has already been
+closed.  The value returned is unspecified.
+@end defun
+
+@defun pipe
+Returns @code{(cons @var{rd} @var{wd})} where @var{rd} and @var{wd} are
+the read and write (port) ends of a @dfn{pipe} respectively.
+@end defun
+
+@defun fork
+Creates a copy of the process calling @code{fork}.  Both processes
+return from @code{fork}, but the calling (@dfn{parent}) process's
+@code{fork} returns the @dfn{child} process's ID whereas the child
+process's @code{fork} returns 0.
+@end defun
+
+@noindent
+For a discussion of @dfn{ID}s @xref{Process Persona, , , GNU C Library,
+libc}.
+
+@defun getppid
+Returns the process ID of the parent of the current process.
+For a process's own ID @xref{I/O-Extensions, getpid}.
+@end defun
+
+@defun getuid
+Returns the real user ID of this process.
+@end defun
+
+@defun getgid
+Returns the real group ID of this process.
+@end defun
+
+@defun getegid
+Returns the effective group ID of this process.
+@end defun
+
+@defun geteuid
+Returns the effective user ID of this process.
+@end defun
+
+@defun setuid id
+Sets the real user ID of this process to @var{id}.
+Returns @code{#t} if successful, @code{#f} if not.
+@end defun
+
+@defun setgid id
+Sets the real group ID of this process to @var{id}.
+Returns @code{#t} if successful, @code{#f} if not.
+@end defun
+
+@defun setegid id
+Sets the effective group ID of this process to @var{id}.
+Returns @code{#t} if successful, @code{#f} if not.
+@end defun
+
+@defun seteuid id
+Sets the effective user ID of this process to @var{id}.
+Returns @code{#t} if successful, @code{#f} if not.
+@end defun
+
+@defun kill pid sig
+The @code{kill} function sends the signal @var{signum} to the process or
+process group specified by @var{pid}.  Besides the signals listed in
+@ref{Standard Signals, , ,libc , GNU C Library}, @var{signum} can also
+have a value of zero to check the validity of the @var{pid}.
+
+The @var{pid} specifies the process or process group to receive the
+signal:
+
+@table @asis
+@item > 0
+The process whose identifier is @var{pid}.
+
+@item 0
+All processes in the same process group as the sender.  The
+sender itself does not receive the signal.
+
+@item -1
+If the process is privileged, send the signal to all
+processes except for some special system processes. 
+Otherwise, send the signal to all processes with the same
+effective user ID.
+
+@item < -1
+The process group whose identifier is @code{(abs @var{pid})}.
+@end table
+
+A process can send a signal to itself with @code{(kill (getpid)
+@var{signum})}.  If @code{kill} is used by a process to send a signal to
+itself, and the signal is not blocked, then @code{kill} delivers at
+least one signal (which might be some other pending unblocked signal
+instead of the signal @var{signum}) to that process before it returns.
+
+The return value from @code{kill} is zero if the signal can be sent
+successfully.  Otherwise, no signal is sent, and a value of @code{-1} is
+returned.  If @var{pid} specifies sending a signal to several processes,
+@code{kill} succeeds if it can send the signal to at least one of them.
+There's no way you can tell which of the processes got the signal or
+whether all of them did.
+@end defun
+
+@defun waitpid pid options
+
+The @code{waitpid} function suspends execution of the current process
+until a child as specified by the @var{pid} argument has exited, or until a
+signal is deliverd whose action is to terminate the current process or
+to call a signal handling function.  If a child as requested by @var{pid} has
+already exited by the time of the call (a so-called @dfn{zombie}
+process), the function returns immediately.  Any system resources used
+by the child are freed.
+
+The value of @var{pid} can be one of:
+
+@table @asis
+@item < -1
+which means to wait for any child process whose process group ID is
+equal to the absolute value of
+
+@item -1
+which means to wait for any child process whose process group ID is
+equal to the @code{(abs @var{pid})}.
+
+@item -1
+which means to wait for any child process; this is the same behaviour
+which wait exhibits.
+
+@item 0
+which means to wait for any child process whose process group ID is
+equal to that of the calling process.
+
+@item > 0
+which means to wait for the child whose process ID is equal to the value
+of @var{pid}.
+@end table
+
+The value of @var{options} is one of the following:
+
+@enumerate 0
+@item
+Nothing special.
+
+@item
+(@code{WNOHANG}) which means to return immediately if no child is there
+to be waited for.
+
+@item
+(@code{WUNTRACED}) which means to also return for children which are
+stopped, and whose status has not been reported.
+
+@item
+Which means both of the above.
+@end enumerate
+
+The return value is normally the process ID of the child process whose
+status is reported.  If the @code{WNOHANG} option was specified and no
+child process is waiting to be noticed, the value is zero.  A value of
+@code{#f} is returned in case of error and @code{errno} is set.  For
+information about the @code{errno} codes @xref{Process Completion, , ,
+GNU C Library, libc}.
+@end defun
+
+@defun uname
+You can use the @code{uname} procedure to find out some information
+about the type of computer your program is running on.
+
+Returns a vector of strings.  These strings are:
+
+@enumerate 0
+@item
+The name of the operating system in use.
+@item
+The network name of this particular computer.
+@item
+The current release level of the operating system implementation.
+@item
+The current version level within the release of the operating system.
+@item
+Description of the type of hardware that is in use.
+
+Some examples are @samp{"i386-ANYTHING"}, @samp{"m68k-hp"},
+@samp{"sparc-sun"}, @samp{"m68k-sun"}, @samp{"m68k-sony"} and @samp{"mips-dec"}.
+@end enumerate
+@end defun
+
+@defun getpw name
+@defunx getpw uid
+@defunx getpw
+Returns a vector of information for the entry for @code{NAME},
+@code{UID}, or the next entry if no argument is given.  The
+information is:
+
+@enumerate 0
+@item
+The user's login name.
+@item
+The encrypted password string.
+@item
+The user ID number.
+@item
+The user's default group ID number.
+@item
+A string typically containing the user's real name, and
+possibly other information such as a phone number.
+@item
+The user's home directory, initial working directory, or @code{#f}, in
+which case the interpretation is system-dependent.
+@item
+The user's default shell, the initial program run when the user logs in,
+or @code{#f}, indicating that the system default should be used.
+@end enumerate
+@end defun
+
+@defun setpwent #t
+Rewinds the pw entry table back to the begining.
+
+@defunx setpwent #f
+@defunx setpwent
+Closes the pw table.
+@end defun
+
+
+@defun getgr name
+@defunx getgr uid
+@defunx getgr
+Returns a vector of information for the entry for @code{NAME},
+@code{UID}, or the next entry if no argument is given.  The
+information is:
+
+@enumerate 0
+@item
+The name of the group.
+@item
+The encrypted password string.
+@item
+The group ID number.
+@item
+A list of (string) names of users in the group.
+@end enumerate
+@end defun
+
+@defun setgrent #t
+Rewinds the group entry table back to the begining.
+
+@defunx setgrent #f
+@defunx setgrent
+Closes the group table.
+@end defun
+
+@defun getgroups
+Returns a vector of all the supplementary group IDs of the process.
+@end defun
+
+
+@defun link oldname newname
+The @code{link} function makes a new link to the existing file named by
+@var{oldname}, under the new name @var{newname}.
+
+@code{link} returns a value of @code{#t} if it is successful and
+@code{#f} on failure.
+@end defun
+
+@defun chown filename owner group
+The @code{chown} function changes the owner of the file @var{filename}
+to @var{owner}, and its group owner to @var{group}.
+
+@code{chown} returns a value of @code{#t} if it is successful and
+@code{#f} on failure.
+@end defun
+
+@defun ttyname port
+If port @var{port} is associated with a terminal device, returns a
+string containing the file name of termainal device; otherwise
+@code{#f}.
+@end defun
+
+@section Unix Extensions
+
+@noindent
+If @code{'unix} is provided (by linking in @file{unix.o}), the following
+functions are defined:
+
+@noindent
+These @dfn{priveledged} and symbolic link functions are not in Posix:
+
+@defun symlink oldname newname
+The @code{symlink} function makes a symbolic link to @var{oldname} named
+@var{newname}.
+
+@code{symlink} returns a value of @code{#t} if it is successful and
+@code{#f} on failure.
+@end defun
+
+@defun readlink filename
+Returns the value of the symbolic link @var{filename} or @code{#f} for
+failure.
+@end defun
+
+@defun lstat filename
+The @code{lstat} function is like @code{stat}, except that it does not
+follow symbolic links.  If @var{filename} is the name of a symbolic
+link, @code{lstat} returns information about the link itself; otherwise,
+@code{lstat} works like @code{stat}.  @xref{I/O-Extensions}.
+@end defun
+
+@defun nice increment
+Increment the priority of the current process by @var{increment}.
+@code{chown} returns a value of @code{#t} if it is successful and
+@code{#f} on failure.
+@end defun
+
+@defun acct filename
+When called with the name of an exisitng file as argument, accounting is
+turned on, records for each terminating pro-cess are appended to
+@var{filename} as it terminates.  An argument of @code{#f} causes
+accounting to be turned off.
+
+@code{acct} returns a value of @code{#t} if it is successful and
+@code{#f} on failure.
+@end defun
+
+@defun mknod filename mode dev
+The @code{mknod} function makes a special file with name @var{filename}
+and modes @var{mode} for device number @var{dev}.
+
+@code{mknod} returns a value of @code{#t} if it is successful and
+@code{#f} on failure.
+@end defun
+
+@defun sync
+@code{sync} first commits inodes to buffers, and then buffers to disk.
+sync() only schedules the writes, so it may return before the actual
+writing is done.  The value returned is unspecified.
+@end defun
+
+@node Regular Expression Pattern Matching, Line Editing, Posix Extensions, Packages
+@section Regular Expression Pattern Matching
+
+These functions are defined in @file{rgx.c} using a POSIX or GNU
+@dfn{regex} library.  If your computer does not support regex, a package
+is available via ftp from
+@file{prep.ai.mit.edu:/pub/gnu/regex-0.12.tar.gz}.  For a description of
+regular expressions, @xref{syntax, , , regex, "regex" regular expression
+matching library}.
+
+@defun regcomp @var{pattern} [@var{flags}]
+Compile a @dfn{regular expression}.  Return a compiled regular
+expression, or an integer error code suitable as an argument to
+@code{regerror}.
+
+@var{flags} in @code{regcomp} is a string of option letters used to
+control the compilation of the regular expression. The letters may
+consist of:
+
+@table @samp
+@item n
+newlines won't be matched by @code{.} or hat lists; ( @code{[^...]} )
+@item i
+ignore case.
+@exdent only when compiled with @var{_GNU_SOURCE}:
+@item 0
+allows dot to match a null character.
+@item f
+enable GNU fastmaps.
+@end table
+@end defun
+
+@defun regerror @var{errno}
+Returns a string describing the integer @var{errno} returned when
+@code{regcomp} fails.
+@end defun
+
+@defun regexec @var{re} @var{string}
+Returns @code{#f} or a vector of integers.  These integers are in
+doublets.  The first of each doublet is the index of @var{string} of
+the start of the matching expression or sub-expression (delimited by
+parentheses in the pattern).  The last of each doublet is index of
+@var{string} of the end of that expression.  @code{#f} is returned if
+the string does not match.
+@end defun
+
+@defun regmatch? @var{re} @var{string}
+Returns @code{#t} if the @var{pattern} such that @var{regexp} = (regcomp
+@var{pattern}) matches @var{string} as a POSIX extended regular
+expressions.  Returns @code{#f} otherwise.
+@end defun
+
+@defun regsearch  @var{re} @var{string} [@var{start} [@var{len}]]
+@defunx regsearchv @var{re} @var{string} [@var{start} [@var{len}]]
+@defunx regmatch   @var{re} @var{string} [@var{start} [@var{len}]]
+@defunx regmatchv  @var{re} @var{string} [@var{start} [@var{len}]]
+@code{Regsearch} searches for the pattern within the string.
+
+@code{Regmatch} anchors the pattern and begins matching it against
+string.
+
+@code{Regsearch} returns the character position where @var{re} starts,
+or @code{#f} if not found.
+
+@code{Regmatch} returns the number of characters matched, @code{#f} if
+not matched.
+
+@code{Regsearchv} and @code{regmatchv} return the match vector is
+returned if @var{re} is found, @code{#f} otherwise.
+
+@table @var
+@item re
+may be either:
+@enumerate
+@item
+a compiled regular expression returned by @code{regcomp};
+@item
+a string representing a regular expression;
+@item
+a list of a string and a set of option letters.
+@end enumerate
+@item string
+The string to be operated upon.
+@item start
+The character position at which to begin the search or match. If absent,
+the default is zero.
+
+@exdent @emph{Compiled _GNU_SOURCE and using GNU libregex only:}
+
+When searching, if @var{start} is negative, the absolute value of
+@var{start} will be used as the start location and reverse searching
+will be performed.
+
+@item len
+The search is allowed to examine only the first @var{len} characters of
+@var{string}. If absent, the entire string may be examined.
+@end table
+@end defun
+
+@defun string-split  @var{re} @var{string}
+@defunx string-splitv @var{re} @var{string}
+@code{String-split} splits a string into substrings that are separated
+by @var{re}, returning a vector of substrings.
+
+@code{String-splitv} returns a vector of string positions that indicate
+where the substrings are located.
+@end defun
+
+@defun string-edit  @var{re} @var{edit-spec} @var{string} [@var{count}]
+Returns the edited string.
+
+@table @var
+@item edit-spec
+Is a string used to replace occurances of @var{re}.  Backquoted integers
+in the range of 1-9 may be used to insert subexpressions in @var{re}, as
+in @code{sed}.
+@item count
+The number of substitutions for @code{string-edit} to perform.  If
+@code{#t}, all occurances of @var{re} will be replaced.  The default is
+to perform one substitution.
+@end table
+@end defun
+
+@node Line Editing, Curses, Regular Expression Pattern Matching, Packages
+@section Line Editing
+
+@noindent
+These procedures provide input line editing and recall.
+
+@noindent
+These functions are defined in @file{edline.c} and @file{Iedline.scm}
+using the @dfn{editline} or GNU @dfn{readline} (@pxref{Top, , Overview
+,readline ,GNU Readline Library}) libraries available from:
+
+@itemize @bullet
+@item
+@ifset html
+<A HREF="ftp://ftp.sys.toronto.edu/pub/rc/editline.shar">
+@end ifset
+@code{ftp.sys.toronto.edu:/pub/rc/editline.shar}
+@ifset html
+</A>
+@end ifset
+@item
+@ifset html
+<A HREF="ftp://prep.ai.mit.edu/pub/gnu/readline-2.0.tar.gz">
+@end ifset
+@code{prep.ai.mit.edu:/pub/gnu/readline-2.0.tar.gz}
+@ifset html
+</A>
+@end ifset
+@end itemize
+
+@noindent
+When @file{Iedline.scm} is loaded, if the current input port is the
+default input port and the environment variable @var{EMACS} is not
+defined, line-editing mode will be entered.
+
+@defun default-input-port
+Returns the initial @code{current-input-port} SCM was invoked with
+(stdin).
+@end defun
+
+@defun default-output-port
+Returns the initial @code{current-output-port} SCM was invoked with
+(stdout).
+@end defun
+
+@defun make-edited-line-port
+Returns an input/output port that allows command line editing and
+retrieval of history.
+@end defun
+
+@defun line-editing
+Returns the current edited line port or @code{#f}.
+
+@defunx line-editing bool
+If @var{bool} is false, exits line-editing mode and returns the previous
+value of @code{(line-editing)}.  If @var{bool} is true, sets the current
+input and output ports to an edited line port and returns the previous
+value of @code{(line-editing)}.
+@end defun
+
+@node Curses, Sockets, Line Editing, Packages
+@section Curses
+
+@noindent
+These functions are defined in @file{crs.c} using the @dfn{curses}
+library.  Unless otherwise noted these routines return @code{#t} for
+successful completion and @code{#f} for failure.
+
+@defun initscr
+Returns a port for a full screen window.  This routine must be called to
+initialize curses.
+@end defun
+
+@defun endwin
+A program should call @code{endwin} before exiting or escaping from
+curses mode temporarily, to do a system call, for example.  This routine
+will restore termio modes, move the cursor to the lower left corner of
+the screen and reset the terminal into the proper non-visual mode.  To
+resume after a temporary escape, call @ref{Window Manipulation,
+refresh}.
+@end defun
+
+@menu
+* Output Options Setting::      
+* Terminal Mode Setting::       
+* Window Manipulation::         
+* Output::                      
+* Input::                       
+* Curses Miscellany::           
+@end menu
+
+@node Output Options Setting, Terminal Mode Setting, Curses, Curses
+@subsection Output Options Setting
+
+@noindent
+These routines set options within curses that deal with output.  All
+options are initially @code{#f}, unless otherwise stated.  It is not
+necessary to turn these options off before calling @code{endwin}.
+
+@defun clearok win bf
+If enabled (@var{bf} is @code{#t}), the next call to @code{force-output}
+or @code{refresh} with @var{win} will clear the screen completely and
+redraw the entire screen from scratch.  This is useful when the contents
+of the screen are uncertain, or in some cases for a more pleasing visual
+effect.
+@end defun
+
+@defun idlok win bf
+If enabled (@var{bf} is @code{#t}), curses will consider using the
+hardware ``insert/delete-line'' feature of terminals so equipped.  If
+disabled (@var{bf} is @code{#f}), curses will very seldom use this
+feature.  The ``insert/delete-character'' feature is always considered.
+This option should be enabled only if your application needs
+``insert/delete-line'', for example, for a screen editor.  It is
+disabled by default because
+
+``insert/delete-line'' tends to be visually annoying when used in
+applications where it is not really needed.  If ``insert/delete-line''
+cannot be used, curses will redraw the changed portions of all lines.
+@end defun
+
+@defun leaveok win bf
+Normally, the hardware cursor is left at the location of the window
+cursor being refreshed.  This option allows the cursor to be left
+wherever the update happens to leave it.  It is useful for
+applications where the cursor is not used, since it reduces the need
+for cursor motions.  If possible, the cursor is made invisible when
+this option is enabled.
+@end defun
+
+@defun scrollok win bf
+This option controls what happens when the cursor of window @var{win} is
+moved off the edge of the window or scrolling region, either from a
+newline on the bottom line, or typing the last character of the last
+line.  If disabled (@var{bf} is @code{#f}), the cursor is left on the
+bottom line at the location where the offending character was entered.
+If enabled (@var{bf} is @code{#t}), @code{force-output} is called on the
+window @var{win}, and then the physical terminal and window @var{win}
+are scrolled up one line.
+
+@emph{Note:} in order to get the physical scrolling effect on the
+terminal, it is also necessary to call @code{idlok}.
+@end defun
+
+@defun nodelay win bf
+This option causes wgetch to be a non-blocking call.  If no input is
+ready, wgetch will return an eof-object. If disabled, wgetch will hang
+until a key is pressed.
+@end defun
+
+@node Terminal Mode Setting, Window Manipulation, Output Options Setting, Curses
+@subsection Terminal Mode Setting
+
+@noindent
+These routines set options within curses that deal with input.  The
+options involve using ioctl(2) and therefore interact with curses
+routines.  It is not necessary to turn these options off before
+calling @code{endwin}.  The routines in this section all return an
+unspecified value.
+
+@defun cbreak
+@defunx nocbreak
+These two routines put the terminal into and out of @code{CBREAK} mode,
+respectively.  In @code{CBREAK} mode, characters typed by the user are
+immediately available to the program and erase/kill character
+processing is not performed.  When in @code{NOCBREAK} mode, the tty driver
+will buffer characters typed until a @key{LFD} or @key{RET} is typed.
+Interrupt and flowcontrol characters are unaffected by this mode.
+Initially the terminal may or may not be in @code{CBREAK} mode, as it is
+inherited, therefore, a program should call @code{cbreak} or @code{nocbreak}
+explicitly.  Most interactive programs using curses will set @code{CBREAK}
+mode.
+
+@emph{Note:} @code{cbreak} overrides @code{raw}.  For a discussion of
+how these routines interact with @code{echo} and @code{noecho}
+@xref{Input, read-char}.
+@end defun
+
+@defun raw
+@defunx noraw
+The terminal is placed into or out of @code{RAW} mode.  @code{RAW} mode
+is similar to @code{CBREAK} mode, in that characters typed are
+immediately passed through to the user program.  The differences are
+that in @code{RAW} mode, the interrupt, quit, suspend, and flow control
+characters are passed through uninterpreted, instead of generating a
+signal.  @code{RAW} mode also causes 8-bit input and output.  The
+behavior of the @code{BREAK} key depends on other bits in the terminal
+driver that are not set by curses.
+@end defun
+
+@defun echo
+@defunx noecho
+These routines control whether characters typed by the user are echoed
+by @code{read-char} as they are typed.  Echoing by the tty driver is
+always disabled, but initially @code{read-char} is in @code{ECHO} mode,
+so characters typed are echoed.  Authors of most interactive programs
+prefer to do their own echoing in a controlled area of the screen, or
+not to echo at all, so they disable echoing by calling @code{noecho}.
+For a discussion of how these routines interact with @code{echo} and
+@code{noecho} @xref{Input, read-char}.
+@end defun
+
+@defun nl
+@defunx nonl
+These routines control whether @key{LFD} is translated into @key{RET}
+and @code{LFD} on output, and whether @key{RET} is translated into
+@key{LFD} on input.  Initially, the translations do occur.  By disabling
+these translations using @code{nonl}, curses is able to make better use
+of the linefeed capability, resulting in faster cursor motion.
+@end defun
+
+@defun resetty
+@defunx savetty
+These routines save and restore the state of the terminal modes.
+@code{savetty} saves the current state of the terminal in a buffer and
+@code{resetty} restores the state to what it was at the last call to
+@code{savetty}.
+@end defun
+
+@node Window Manipulation, Output, Terminal Mode Setting, Curses
+@subsection Window Manipulation
+
+@defun newwin nlines ncols begy begx
+Create and return a new window with the given number of lines (or rows),
+@var{nlines}, and columns, @var{ncols}.  The upper left corner of the
+window is at line @var{begy}, column @var{begx}.  If either @var{nlines}
+or @var{ncols} is 0, they will be set to the value of
+@code{LINES}-@var{begy} and @code{COLS}-@var{begx}.  A new full-screen
+window is created by calling @code{newwin(0,0,0,0)}.
+@end defun
+
+@defun subwin orig nlines ncols begy begx
+Create and return a pointer to a new window with the given number of
+lines (or rows), @var{nlines}, and columns, @var{ncols}.  The window is
+at position (@var{begy}, @var{begx}) on the screen.  This position is
+relative to the screen, and not to the window @var{orig}.  The window is
+made in the middle of the window @var{orig}, so that changes made to one
+window will affect both windows.  When using this routine, often it will
+be necessary to call @code{touchwin} or @code{touchline} on @var{orig}
+before calling @code{force-output}.
+@end defun
+
+@defun close-port win
+Deletes the window @var{win}, freeing up all memory associated with it.
+In the case of sub-windows, they should be deleted before the main
+window @var{win}.
+@end defun
+
+@defun refresh
+@defunx force-output win
+These routines are called to write output to the terminal, as most other
+routines merely manipulate data structures.  @code{force-output} copies
+the window @var{win} to the physical terminal screen, taking into
+account what is already there in order to minimize the amount of
+information that's sent to the terminal (called optimization).  Unless
+@code{leaveok} has been enabled, the physical cursor of the terminal is
+left at the location of window @var{win}'s cursor.  With @code{refresh},
+the number of characters output to the terminal is returned.
+@end defun
+
+@defun mvwin win y x
+Move the window @var{win} so that the upper left corner will be at position
+(@var{y}, @var{x}).  If the move would cause the window @var{win} to be off the
+screen, it is an error and the window @var{win} is not moved.
+@end defun
+
+@defun overlay srcwin dstwin
+@defunx overwrite srcwin dstwin
+
+These routines overlay @var{srcwin} on top of @var{dstwin}; that is, all
+text in @var{srcwin} is copied into @var{dstwin}.  @var{srcwin} and
+@var{dstwin} need not be the same size; only text where the two windows
+overlap is copied.  The difference is that @code{overlay} is
+non-destructive (blanks are not copied), while @code{overwrite} is
+destructive.
+@end defun
+
+@defun touchwin win
+@defunx touchline win start count
+Throw away all optimization information about which parts of the window
+@var{win} have been touched, by pretending that the entire window
+@var{win} has been drawn on.  This is sometimes necessary when using
+overlapping windows, since a change to one window will affect the other
+window, but the records of which lines have been changed in the other
+window will not reflect the change.  @code{touchline} only pretends that
+@var{count} lines have been changed, beginning with line @var{start}.
+@end defun
+
+@defun wmove win y x
+The cursor associated with the window @var{win} is moved to line (row) @var{y},
+column @var{x}.  This does not move the physical cursor of the terminal
+until @code{refresh} (or @code{force-output}) is called.  The position
+specified is relative to the upper left corner of the window @var{win},
+which is (0, 0).
+@end defun
+
+@node Output, Input, Window Manipulation, Curses
+@subsection Output
+
+@noindent
+These routines are used to @dfn{draw} text on windows
+
+@defun display ch win
+@defunx display str win
+@defunx wadd win ch
+@defunx wadd win str
+The character @var{ch} or characters in @var{str} are put into the
+window @var{win} at the current cursor position of the window and the
+position of @var{win}'s cursor is advanced.  At the right margin, an
+automatic newline is performed.  At the bottom of the scrolling region,
+if scrollok is enabled, the scrolling region will be scrolled up one
+line.
+
+If @var{ch} is a @key{TAB}, @key{LFD}, or backspace, the cursor will be
+moved appropriately within the window @var{win}.  A @key{LFD} also does a
+@code{wclrtoeol} before moving.  @key{TAB} characters are considered to
+be at every eighth column.  If @var{ch} is another control character, it
+will be drawn in the @kbd{C-x} notation.  (Calling @code{winch} after
+adding a control character will not return the control character, but
+instead will return the representation of the control character.)
+
+Video attributes can be combined with a character by or-ing them into
+the parameter.  This will result in these attributes also being set.
+The intent here is that text, including attributes, can be copied from
+one place to another using inch and display.  See @code{standout},
+below.
+
+@emph{Note:} For @code{wadd} @var{ch} can be an integer and will insert
+the character of the corresponding value.
+@end defun
+
+@defun werase win
+This routine copies blanks to every position in the window @var{win}.
+@end defun
+
+@defun wclear win
+This routine is like @code{werase}, but it also calls @ref{Output
+Options Setting, clearok}, arranging that the screen will be cleared
+completely on the next call to @code{refresh} or @code{force-output} for
+window @var{win}, and repainted from scratch.
+@end defun
+
+@defun wclrtobot win
+All lines below the cursor in window @var{win} are erased.  Also, the
+current line to the right of the cursor, inclusive, is erased.
+@end defun
+
+@defun wclrtoeol win
+The current line to the right of the cursor, inclusive, is erased.
+@end defun
+
+@defun wdelch win
+The character under the cursor in the window @var{win} is deleted.  All
+characters to the right on the same line are moved to the left one
+position and the last character on the line is filled with a blank.  The
+cursor position does not change.  This does not imply use of the
+hardware ``delete-character'' feature.
+@end defun
+
+@defun wdeleteln win
+The line under the cursor in the window @var{win} is deleted.  All lines
+below the current line are moved up one line.  The bottom line @var{win}
+is cleared.  The cursor position does not change.  This does not imply
+use of the hardware ``deleteline'' feature.
+@end defun
+
+@defun winsch win ch
+The character @var{ch} is inserted before the character under the
+cursor.  All characters to the right are moved one @key{SPC} to the
+right, possibly losing the rightmost character of the line.  The cursor
+position does not change .  This does not imply use of the hardware
+``insertcharacter'' feature.
+@end defun
+
+@defun winsertln win
+A blank line is inserted above the current line and the bottom line is
+lost.  This does not imply use of the hardware ``insert-line'' feature.
+@end defun
+
+@defun scroll win
+The window @var{win} is scrolled up one line.  This involves moving the
+lines in @var{win}'s data structure.  As an optimization, if @var{win}
+is stdscr and the scrolling region is the entire window, the physical
+screen will be scrolled at the same time.
+@end defun
+
+@node Input, Curses Miscellany, Output, Curses
+@subsection Input
+
+@defun read-char win
+A character is read from the terminal associated with the window
+@var{win}.  Depending on the setting of @code{cbreak}, this will be
+after one character (@code{CBREAK} mode), or after the first newline
+(@code{NOCBREAK} mode).  Unless @code{noecho} has been set, the
+character will also be echoed into @var{win}.
+
+When using @code{read-char}, do not set both @code{NOCBREAK} mode
+(@code{nocbreak}) and @code{ECHO} mode (@code{echo}) at the same time.
+Depending on the state of the terminal driver when each character is
+typed, the program may produce undesirable results.
+@end defun
+
+@defun winch win
+The character, of type chtype, at the current position in window
+@var{win} is returned.  If any attributes are set for that position,
+their values will be OR'ed into the value returned.
+@end defun
+
+@defun getyx win
+A list of the y and x coordinates of the cursor position of the window
+@var{win} is returned
+@end defun
+
+@node Curses Miscellany,  , Input, Curses
+@subsection Curses Miscellany
+
+@defun wstandout win
+@defunx wstandend win
+
+These functions set the current attributes of the window @var{win}.  The
+current attributes of @var{win} are applied to all characters that are
+written into it.  Attributes are a property of the character, and move
+with the character through any scrolling and insert/delete
+line/character operations.  To the extent possible on the particular
+terminal, they will be displayed as the graphic rendition of characters
+put on the screen.
+
+@code{wstandout} sets the current attributes of the window @var{win} to
+be visibly different from other text.  @code{wstandend} turns off the
+attributes.
+@end defun
+
+@defun box win vertch horch
+A box is drawn around the edge of the window @var{win}.  @var{vertch}
+and @var{horch} are the characters the box is to be drawn with.  If
+@var{vertch} and @var{horch} are 0, then appropriate default characters,
+@code{ACS_VLINE} and @code{ACS_HLINE}, will be used.
+
+@emph{Note:} @var{vertch} and @var{horch} can be an integers and will
+insert the character (with attributes) of the corresponding values.
+@end defun
+
+@defun unctrl c
+This macro expands to a character string which is a printable
+representation of the character @var{c}.  Control characters are
+displayed in the @kbd{C-x} notation.  Printing characters are displayed
+as is.
+@end defun
+
+@node Sockets,  , Curses, Packages
+@section Sockets
+
+@noindent
+These procedures (defined in @file{socket.c}) provide a Scheme interface
+to most of the C @dfn{socket} library.  For more information on sockets,
+@xref{Sockets, , , libc, The GNU C Library Reference Manual}.
+
+@menu
+* Host Data::                   
+* Internet Addresses and Socket Names::          
+* Socket::                      
+@end menu
+
+@node Host Data, Internet Addresses and Socket Names, Sockets, Sockets
+@subsection Host Data, Network, Protocol, and Service Inquiries
+
+@defvr Constant af_inet
+@defvrx Constant af_unix
+Integer family codes for Internet and Unix sockets, respectively.
+@end defvr
+
+@defun gethost host-spec
+@defunx gethost
+Returns a vector of information for the entry for @code{HOST-SPEC} or the
+next entry if @code{HOST-SPEC} isn't given.  The information is:
+
+@enumerate 0
+@item
+host name string
+@item
+list of host aliases strings
+@item
+integer address type (@code{AF_INET})
+@item
+integer size of address entries (in bytes)
+@item
+list of integer addresses
+@end enumerate
+@end defun
+
+@defun sethostent stay-open
+@defunx sethostent
+Rewinds the host entry table back to the begining if given an argument.
+If the argument @var{stay-open} is @code{#f} queries will be be done
+using @code{UDP} datagrams.  Otherwise, a connected @code{TCP} socket
+will be used.  When called without an argument, the host table is
+closed.
+@end defun
+
+@defun getnet name-or-number
+@defunx getnet
+Returns a vector of information for the entry for @var{name-or-number} or
+the next entry if an argument isn't given.  The information is:
+
+@enumerate 0
+@item
+official network name string
+@item
+list of network aliases strings
+@item
+integer network address type (@code{AF_INET})
+@item
+integer network number
+@end enumerate
+@end defun
+
+@defun setnetent stay-open
+@defunx setnetent
+Rewinds the network entry table back to the begining if given an
+argument.  If the argument @var{stay-open} is @code{#f} the table will be closed
+between calls to getnet.  Otherwise, the table stays open.  When
+called without an argument, the network table is closed.
+@end defun
+
+@defun getproto name-or-number
+@defunx getproto
+Returns a vector of information for the entry for @var{name-or-number} or
+the next entry if an argument isn't given.  The information is:
+
+@enumerate
+@item
+official protocol name string
+@item
+list of protocol aliases strings
+@item
+integer protocol number
+@end enumerate
+@end defun
+
+@defun setprotoent stay-open
+@defunx setprotoent
+Rewinds the protocol entry table back to the begining if given an
+argument.  If the argument @var{stay-open} is @code{#f} the table will be closed
+between calls to getproto.  Otherwise, the table stays open.  When
+called without an argument, the protocol table is closed.
+@end defun
+
+@defun getserv name-or-port-number protocol
+@defunx getserv
+Returns a vector of information for the entry for @var{name-or-port-number}
+and @var{protocol} or the next entry if arguments aren't given.  The
+information is:
+
+@enumerate 0
+@item
+official service name string
+@item
+list of service aliases strings
+@item
+integer port number
+@item
+protocol
+@end enumerate
+@end defun
+
+@defun setservent stay-open
+@defunx setservent
+Rewinds the service entry table back to the begining if given an
+argument.  If the argument @var{stay-open} is @code{#f} the table will be closed
+between calls to getserv.  Otherwise, the table stays open.  When
+called without an argument, the service table is closed.
+@end defun
+
+@node Internet Addresses and Socket Names, Socket, Host Data, Sockets
+@subsection Internet Addresses and Socket Names
+
+@defun inet:string->address string
+Returns the host address number (integer) for host @var{string} or
+@code{#f} if not found.
+@end defun
+
+@defun inet:address->string address
+Converts an internet (integer) address to a string in numbers and dots
+notation.  This is an inverse function to inet:address.
+@end defun
+
+@defun inet:network address
+Returns the network number (integer) specified from @var{address} or
+@code{#f} if not found.
+@end defun
+
+@defun inet:local-network-address address
+Returns the integer for the address of @var{address} within its local
+network or @code{#f} if not found.
+@end defun
+
+@defun inet:make-address network local-address
+Returns the Internet address of @var{local-address} in @var{network}.
+@end defun
+
+@noindent
+The type @dfn{socket-name} is used for inquiries about open sockets in
+the following procedures:
+
+@defun getsockname socket
+Returns the socket-name of @var{socket}.  Returns @code{#f} if
+unsuccessful or @var{socket} is closed.
+@end defun
+
+@defun getpeername socket
+Returns the socket-name of the socket connected to @var{socket}.
+Returns @code{#f} if unsuccessful or @var{socket} is closed.
+@end defun
+
+@defun socket-name:family socket-name
+Returns the integer code for the family of @var{socket-name}.
+@end defun
+
+@defun socket-name:port-number socket-name
+Returns the integer port number of @var{socket-name}.
+@end defun
+
+@defun socket-name:address socket-name
+Returns the integer Internet address for @var{socket-name}.
+@end defun
+
+
+@node Socket,  , Internet Addresses and Socket Names, Sockets
+@subsection Socket
+
+@noindent
+When a port is returned from one of these calls it is unbuffered.
+This allows both reading and writing to the same port to work.  If you
+want buffered ports you can (assuming sock-port is a socket i/o port):
+@example
+(require 'i/o-extensions)
+(define i-port (duplicate-port sock-port "r"))
+(define o-port (duplicate-port sock-port "w"))
+@end example
+
+@defun make-stream-socket family
+@defunx make-stream-socket family protocol
+
+Returns a @code{SOCK_STREAM} socket of type @var{family} using
+@var{protocol}.  If @var{family} has the value @code{AF_INET},
+@code{SO_REUSEADDR} will be set.  The integer argument @var{protocol}
+corresponds to the integer protocol numbers returned (as vector
+elements) from @code{(getproto)}.  If the @var{protocol} argument is not
+supplied, the default (0) for the specified @var{family} is used.  SCM
+sockets look like ports opened for neither reading nor writing.
+@end defun
+
+@defun make-stream-socketpair family
+@defunx make-stream-socketpair family protocol
+
+Returns a pair (cons) of connected @code{SOCK_STREAM} (socket) ports of
+type @var{family} using @var{protocol}.  Many systems support only
+socketpairs of the @code{af-unix} @var{family}.  The integer argument
+@var{protocol} corresponds to the integer protocol numbers returned (as
+vector elements) from (getproto).  If the @var{protocol} argument is
+not supplied, the default (0) for the specified @var{family} is used.
+@end defun
+
+@defun socket:shutdown socket how
+Makes @var{socket} no longer respond to some or all operations depending on
+the integer argument @var{how}:
+
+@enumerate 0
+@item
+Further input is disallowed.
+@item
+Further output is disallowed.
+@item
+Further input or output is disallowed.
+@end enumerate
+
+@code{Socket:shutdown} returns @var{socket} if successful, @code{#f} if
+not.
+@end defun
+
+@defun socket:connect inet-socket host-number port-number
+@defunx socket:connect unix-socket pathname
+Returns @var{socket} (changed to a read/write port) connected to the
+Internet socket on host @var{host-number}, port @var{port-number} or
+the Unix socket specified by @var{pathname}.  Returns @code{#f} if not
+successful.
+@end defun
+
+@defun socket:bind inet-socket port-number
+@defunx socket:bind unix-socket pathname
+Returns @var{inet-socket} bound to the integer @var{port-number} or the
+@var{unix-socket} bound to new socket in the file system at location
+@var{pathname}.  Returns @code{#f} if not successful. Binding a
+@var{unix-socket} creates a socket in the file system that must be
+deleted by the caller when it is no longer needed (using
+@code{delete-file}).
+@end defun
+
+@defun socket:listen socket backlog
+The bound (@pxref{Socket, bind}) @var{socket} is readied to
+accept connections.  The positive integer @var{backlog} specifies how
+many pending connections will be allowed before further connection
+requests are refused.  Returns @var{socket} (changed to a read-only
+port) if successful, @code{#f} if not.
+@end defun
+
+@defun char-ready? listen-socket
+The input port returned by a successful call to @code{socket:listen} can
+be polled for connections by @code{char-ready?} (@pxref{Files and Ports,
+char-ready?}).  This avoids blocking on connections by
+@code{socket:accept}.
+@end defun
+
+@defun socket:accept socket
+Accepts a connection on a bound, listening @var{socket}.  Returns an
+input/output port for the connection.
+@end defun
+
+@noindent
+The following example is not too complicated, yet shows the use of
+sockets for multiple connections without input blocking.
+
+@example
+;;;; Scheme chat server
+
+;;; This program implements a simple `chat' server which accepts
+;;; connections from multiple clients, and sends to all clients any
+;;; characters received from any client.
+
+;;; To connect to chat `telnet localhost 8001'
+
+(require 'socket)
+(require 'i/o-extensions)
+
+(let ((listener-socket (socket:bind (make-stream-socket af_inet) 8001))
+      (connections '()))
+  (socket:listen listener-socket 5)
+  (do () (#f)
+    (cond ((char-ready? listener-socket)
+           (let ((con (socket:accept listener-socket)))
+             (display "accepting connection from ")
+             (display (getpeername con))
+             (newline)
+             (set! connections (cons con connections))
+             (display "connected" con)
+             (newline con))))
+    (set! connections
+          (let next ((con-list connections))
+            (cond ((null? con-list) '())
+                  (else
+                   (let ((con (car con-list)))
+                     (cond ((char-ready? con)
+                            (let ((c (read-char con)))
+                              (cond ((eof-object? c)
+                                     (display "closing connection from ")
+                                     (display (getpeername con))
+                                     (newline)
+                                     (close-port con)
+                                     (next (cdr con-list)))
+                                    (else
+                                     (for-each (lambda (con)
+                                                 (file-set-position con 0)
+                                                 (write-char c con)
+                                                 (file-set-position con 0))
+                                               connections)
+                                     (cons con (next (cdr con-list)))))))
+                           (else (cons con (next (cdr con-list))))))))))))
+@end example
+
+@noindent
+You can use @samp{telnet localhost 8001} to connect to the chat server,
+or you can use a client written in scheme:
+
+@example
+;;;; Scheme chat client
+
+;;; this program connects to socket 8001.  It then sends all
+;;; characters from current-input-port to the socket and sends all
+;;; characters from the socket to current-output-port.
+
+(require 'socket)
+(require 'i/o-extensions)
+
+(define con (make-stream-socket af_inet))
+(set! con (socket:connect con (inet:string->address "localhost") 8001))
+
+(do ((cs #f (and (char-ready? con) (read-char con)))
+     (ct #f (and (char-ready?) (read-char))))
+    ((or (eof-object? cs) (eof-object? ct))
+     (close-port con))
+  (cond (cs (display cs)))
+  (cond (ct (file-set-position con 0)
+            (display ct con)
+            (file-set-position con 0))))
+@end example
+
+
+@node The Implementation, Procedure and Macro Index, Packages, Top
+@chapter The Implementation
+
+@menu
+* Data Types::                  
+* Operations::                  
+* Improvements To Make::        
+* Finishing Dynamic Linking::   
+@end menu
+
+@node Data Types, Operations, The Implementation, The Implementation
+@section Data Types
+
+@noindent
+In the descriptions below it is assumed that @code{long int}s are 32
+bits in length.  Acutally, SCM is written to work with any @code{long
+int} size larger than 31 bits.  With some modification, SCM could work
+with word sizes as small as 24 bits.
+
+@noindent
+All SCM objects are represented by type @dfn{SCM}.  Type @code{SCM} come
+in 2 basic flavors, Immediates and Cells:
+
+@menu
+* Immediates::                  
+* Cells::                       Non-Immediate types
+* Header Cells::                Malloc objects
+* Subr Cells::                  Built-in and Compiled Procedures
+* Ptob Cells::                  I/O ports
+* Smob Cells::                  Miscellaneous datatypes
+* Data Type Representations::   How they all fit together
+@end menu
+
+@node Immediates, Cells, Data Types, Data Types
+@subsection Immediates
+
+@noindent
+An @dfn{immediate} is a data type contained in type @code{SCM}
+(@code{long int}).  The type codes distinguishing immediate types from
+each other vary in length, but reside in the low order bits.
+
+@defmac IMP x
+@defmacx NIMP x
+Return non-zero if the @code{SCM} object @var{x} is an immediate or
+non-immediate type, respectively.
+@end defmac
+
+@deftp Immediate inum
+immediate 30 bit signed integer.  An INUM is flagged by a @code{1} in
+the second to low order bit position.  The high order 30 bits are used
+for the integer's value.
+
+@defmac INUMP x
+@defmacx NINUMP x
+Return non-zero if the @code{SCM} @var{x} is an immediate integer or not
+an immediate integer, respectively.
+@end defmac
+
+@defmac INUM x
+Returns the C @code{long integer} corresponding to @code{SCM} @var{x}.
+@end defmac
+
+@defmac MAKINUM x
+Returns the @code{SCM} inum corresponding to C @code{long integer} x.
+@end defmac
+
+@defvr {Immediate Constant} INUM0
+is equivalent to @code{MAKINUM(0)}.
+@end defvr
+
+Computations on INUMs are performed by converting the arguments to C
+integers (by a shift), operating on the integers, and converting the
+result to an inum.  The result is checked for overflow by converting
+back to integer and checking the reverse operation.
+
+The shifts used for conversion need to be signed shifts.  If the C
+implementation does not support signed right shift this fact is detected
+in a #if statement in @file{scmfig.h} and a signed right shift,
+@code{SRS}, is constructed in terms of unsigned right shift.
+@end deftp
+
+@deftp Immediate ichr
+characters.
+
+@defmac ICHRP x
+Return non-zero if the @code{SCM} object @var{x} is a character.
+@end defmac
+
+@defmac ICHR x
+Returns corresponding @code{unsigned char}.
+@end defmac
+
+@defmac MAKICHR x
+Given @code{char} @var{x}, returns @code{SCM} character.
+@end defmac
+
+@end deftp
+
+@deftp Immediate iflags
+These are frequently used immediate constants.
+@deftypevr {Immediate Constant} SCM BOOL_T
+@code{#t}
+@end deftypevr
+@deftypevr {Immediate Constant} SCM BOOL_F
+@code{#f}
+@end deftypevr
+@deftypevr {Immediate Constant} SCM EOL
+@code{()}.  If @code{SICP} is @code{#define}d, @code{EOL} is
+@code{#define}d to be identical with @code{BOOL_F}.  In this case, both
+print as @code{#f}.
+@end deftypevr
+@deftypevr {Immediate Constant} SCM EOF_VAL
+end of file token, @code{#<eof>}.
+@end deftypevr
+@deftypevr {Immediate Constant} SCM UNDEFINED
+@code{#<undefined>} used for variables which have not been defined and
+absent optional arguments.
+@end deftypevr
+@deftypevr {Immediate Constant} SCM UNSPECIFIED
+@code{#<unspecified>} is returned for those procedures whose return
+values are not specified.
+@end deftypevr
+
+@end deftp
+
+@defmac IFLAGP n
+Returns non-zero if @var{n} is an ispcsym, isym or iflag.
+@end defmac
+
+@defmac ISYMP n
+Returns non-zero if @var{n} is an ispcsym or isym.
+@end defmac
+
+@defmac ISYMNUM n
+Given ispcsym, isym, or iflag @var{n}, returns its index in the C array
+@code{isymnames[]}.
+@end defmac
+
+@defmac ISYMCHARS n
+Given ispcsym, isym, or iflag @var{n}, returns its @code{char *}
+representation (from @code{isymnames[]}).
+@end defmac
+
+@defmac MAKSPCSYM n
+Returns @code{SCM} ispcsym @var{n}.
+@end defmac
+
+@defmac MAKISYM n
+Returns @code{SCM} iisym @var{n}.
+@end defmac
+
+@defmac MAKIFLAG n
+Returns @code{SCM} iflag @var{n}.
+@end defmac
+
+@defvar isymnames
+An array of strings containing the external representations of all the
+ispcsym, isym, and iflag immediates.  Defined in @file{repl.c}.
+@end defvar
+
+@defvr Constant NUM_ISPCSYM
+@defvrx Constant NUM_ISYMS
+The number of ispcsyms and ispcsyms+isyms, respectively.  Defined in
+@file{scm.h}.
+@end defvr
+
+@deftp Immediate isym
+@code{and}, @code{begin}, @code{case}, @code{cond}, @code{define},
+@code{do}, @code{if}, @code{lambda}, @code{let}, @code{let*},
+@code{letrec}, @code{or}, @code{quote}, @code{set!}, @code{#f},
+@code{#t}, @code{#<undefined>}, @code{#<eof>}, @code{()}, and
+@code{#<unspecified>}.
+
+@deftpx {CAR Immediate} ispcsym
+special symbols: syntax-checked versions of first 14 isyms
+@end deftp
+
+@deftp {CAR Immediate} iloc
+indexes to a variable's location in environment
+@end deftp
+
+@deftp {CAR Immediate} gloc
+pointer to a symbol's value cell
+@end deftp
+
+@deftp Immediate CELLPTR
+pointer to a cell (not really an immediate type, but here for
+completeness).  Since cells are always 8 byte aligned, a pointer to a
+cell has the low order 3 bits @code{0}.
+
+There is one exception to this rule, @emph{CAR Immediate}s, described
+next.
+@end deftp
+
+@noindent
+A @dfn{CAR Immediate} is an Immediate point which can only occur in the
+@code{CAR}s of evaluated code (as a result of @code{ceval}'s memoization
+process).
+
+@node Cells, Header Cells, Immediates, Data Types
+@subsection Cells
+
+@noindent
+@dfn{Cell}s represent all SCM objects other than immediates.  A cell has
+a @code{CAR} and a @code{CDR}.  Low-order bits in @code{CAR} identify
+the type of object.  The rest of @code{CAR} and @code{CDR} hold object
+data.  The number after @code{tc} specifies how many bits are in the
+type code.  For instance, @code{tc7} indicates that the type code is 7
+bits.
+
+@defmac NEWCELL x
+Allocates a new cell and stores a pointer to it in @code{SCM} local
+variable @var{x}.
+
+Care needs to be taken that stores into the new cell pointed to by
+@var{x} do not create an inconsistent object.  @xref{Signals}.
+@end defmac
+
+@noindent
+All of the C macros decribed in this section assume that their argument
+is of type @code{SCM} and points to a cell (@code{CELLPTR}).
+
+@defmac CAR x
+@defmacx CDR x
+Returns the @code{car} and @code{cdr} of cell @var{x}, respectively.
+@end defmac
+
+@defmac TYP3 x
+@defmacx TYP7 x
+@defmacx TYP16 x
+Returns the 3, 7, and 16 bit type code of a cell.
+@end defmac
+
+@deftp Cell tc3_cons
+scheme cons-cell returned by (cons arg1 arg2).
+
+@defmac CONSP x
+@defmacx NCONSP x
+Returns non-zero if @var{x} is a @code{tc3_cons} or isn't, respectively.
+@end defmac
+@end deftp
+
+@deftp Cell tc3_closure
+applicable object returned by (lambda (args) @dots{}).
+@code{tc3_closure}s have a pointer to other the body of the procedure in
+the @code{CAR} and a pointer to the environment in the @code{CDR}.
+
+@defmac CLOSUREP x
+Returns non-zero if @var{x} is a @code{tc3_closure}.
+@end defmac
+
+@defmac CODE x
+@defmacx ENV x
+Returns the code body or environment of closure @var{x}, respectively.
+@end defmac
+
+@end deftp
+
+@node Header Cells, Subr Cells, Cells, Data Types
+@subsection Header Cells
+
+@noindent
+@dfn{Header}s are Cells whose @code{CDR}s point elsewhere in memory,
+such as to memory allocated by @code{malloc}.
+
+@deftp Header spare
+spare @code{tc7} type code
+@end deftp
+
+@deftp Header tc7_vector
+scheme vector.
+
+@defmac VECTORP x
+@defmacx NVECTORP x
+Returns non-zero if @var{x} is a @code{tc7_vector} or if not, respectively.
+@end defmac
+
+@defmac VELTS x
+@defmacx LENGTH x
+Returns the C array of @code{SCM}s holding the elements of vector
+@var{x} or its length, respectively.
+@end defmac
+@end deftp
+
+@deftp Header tc7_ssymbol
+static scheme symbol (part of initial system)
+
+@deftpx Header tc7_msymbol
+@code{malloc}ed scheme symbol (can be GCed)
+
+@defmac SYMBOLP x
+Returns non-zero if @var{x} is a @code{tc7_ssymbol} or
+@code{tc7_msymbol}.
+@end defmac
+
+@defmac CHARS x
+@defmacx UCHARS x
+@defmacx LENGTH x
+Returns the C array of @code{char}s or as @code{unsigned char}s holding
+the elements of symbol @var{x} or its length, respectively.
+@end defmac
+@end deftp
+
+@deftp Header tc7_string
+scheme string
+
+@defmac STRINGP x
+@defmacx NSTRINGP x
+Returns non-zero if @var{x} is a @code{tc7_string} or isn't,
+respectively.
+@end defmac
+
+@defmac CHARS x
+@defmacx UCHARS x
+@defmacx LENGTH x
+Returns the C array of @code{char}s or as @code{unsigned char}s holding
+the elements of string @var{x} or its length, respectively.
+@end defmac
+@end deftp
+
+@deftp Header tc7_bvect
+uniform vector of booleans (bit-vector)
+@end deftp
+
+@deftp Header tc7_ivect
+uniform vector of integers
+@end deftp
+
+@deftp Header tc7_uvect
+uniform vector of non-negative integers
+@end deftp
+
+@deftp Header tc7_fvect
+uniform vector of short inexact real numbers
+@end deftp
+
+@deftp Header tc7_dvect
+uniform vector of double precision inexact real numbers
+@end deftp
+
+@deftp Header tc7_cvect
+uniform vector of double precision inexact complex numbers
+@end deftp
+
+@deftp Header tc7_contin
+applicable object produced by call-with-current-continuation
+@end deftp
+
+@deftp Header tc7_cclo
+Subr and environment for compiled closure
+
+A cclo is similar to a vector (and is GCed like one), but can be applied
+as a function:
+
+@enumerate
+@item
+the cclo itself is consed onto the head of the argument list
+@item
+the first element of the cclo is applied to that list.  Cclo invocation
+is currently not tail recursive when given 2 or more arguments.
+@end enumerate
+
+@defun makcclo proc len
+makes a closure from the @emph{subr} @var{proc} with @var{len}-1 extra
+locations for @code{SCM} data.  Elements of a @var{cclo} are referenced
+using @code{VELTS(cclo)[n]} just as for vectors.
+@end defun
+@end deftp
+
+@node Subr Cells, Ptob Cells, Header Cells, Data Types
+@subsection Subr Cells
+
+@noindent
+A @dfn{Subr} is a header whose @code{CDR} points to a C code procedure.
+Scheme primitive procedures are subrs.  Except for the arithmetic
+@code{tc7_cxr}s, the C code procedures will be passed arguments (and
+return results) of type @code{SCM}.
+
+@deftp Subr tc7_asubr
+associative C function of 2 arguments.  Examples are @code{+}, @code{-},
+@code{*}, @code{/}, @code{max}, and @code{min}.
+@end deftp
+
+@deftp Subr tc7_subr_0
+C function of no arguments.
+@end deftp
+
+@deftp Subr tc7_subr_1
+C function of one argument.
+@end deftp
+
+@deftp Subr tc7_cxr
+These subrs are handled specially.  If inexact numbers are enabled, the
+@code{CDR} should be a function which takes and returns type
+@code{double}.  Conversions are handled in the interpreter.
+
+@code{floor}, @code{ceiling}, @code{truncate}, @code{round},
+@code{$sqrt}, @code{$abs}, @code{$exp}, @code{$log}, @code{$sin},
+@code{$cos}, @code{$tan}, @code{$asin}, @code{$acos}, @code{$atan},
+@code{$sinh}, @code{$cosh}, @code{$tanh}, @code{$asinh}, @code{$acosh},
+@code{$atanh}, and @code{exact->inexact} are defined this way.
+
+If the @code{CDR} is @code{0} (@code{NULL}), the name string of the
+procedure is used to control traversal of its list structure argument.
+
+@code{car}, @code{cdr}, @code{caar}, @code{cadr}, @code{cdar},
+@code{cddr}, @code{caaar}, @code{caadr}, @code{cadar}, @code{caddr},
+@code{cdaar}, @code{cdadr}, @code{cddar}, @code{cdddr}, @code{caaaar},
+@code{caaadr}, @code{caadar}, @code{caaddr}, @code{cadaar},
+@code{cadadr}, @code{caddar}, @code{cadddr}, @code{cdaaar},
+@code{cdaadr}, @code{cdadar}, @code{cdaddr}, @code{cddaar},
+@code{cddadr}, @code{cdddar}, and @code{cddddr} are defined this way.
+@end deftp
+
+@deftp Subr tc7_subr_3
+C function of 3 arguments.
+@end deftp
+
+@deftp Subr tc7_subr_2
+C function of 2 arguments.
+@end deftp
+
+@deftp Subr tc7_rpsubr
+transitive relational predicate C function of 2 arguments.  The C
+function should return either @code{BOOL_T} or @code{BOOL_F}.
+@end deftp
+
+@deftp Subr tc7_subr_1o
+C function of one optional argument.  If the optional argument is not
+present, @code{UNDEFINED} is passed in its place.
+@end deftp
+
+@deftp Subr tc7_subr_2o
+C function of 1 required and 1 optional argument.  If the optional
+argument is not present, @code{UNDEFINED} is passed in its place.
+@end deftp
+
+@deftp Subr tc7_lsubr_2
+C function of 2 arguments and a list of (rest of) @code{SCM} arguments.
+@end deftp
+
+@deftp Subr tc7_lsubr
+C function of list of @code{SCM} arguments.
+@end deftp
+
+@node Ptob Cells, Smob Cells, Subr Cells, Data Types
+@subsection Ptob Cells
+
+@noindent
+A @dfn{ptob} is a port object, capable of delivering or accepting
+characters.  @xref{Ports, , , r4rs, Revised(4) Report on the Algorithmic
+Language Scheme}.  Unlike the types described so far, new varieties of
+ptobs can be defined dynamically (@pxref{Defining Ptobs}).  These are
+the initial ptobs:
+
+@deftp ptob tc16_inport
+input port.
+@end deftp
+
+@deftp ptob tc16_outport
+output port.
+@end deftp
+
+@deftp ptob tc16_ioport
+input-output port.
+@end deftp
+
+@deftp ptob tc16_inpipe
+input pipe created by @code{popen()}.
+@end deftp
+
+@deftp ptob tc16_outpipe
+output pipe created by @code{popen()}.
+@end deftp
+
+@deftp ptob tc16_strport
+String port created by @code{cwos()} or @code{cwis()}.
+@end deftp
+
+@deftp ptob tc16_sfport
+Software (virtual) port created by @code{mksfpt()} (@pxref{Soft Ports}).
+@end deftp
+
+@defmac PORTP x
+@defmacx OPPORTP x
+@defmacx OPINPORTP x
+@defmacx OPOUTPORTP x
+@defmacx INPORTP x
+@defmacx OUTPORTP x
+Returns non-zero if @var{x} is a port, open port, open input-port, open
+output-port, input-port, or output-port, respectively.
+@end defmac
+
+@defmac OPENP x
+@defmacx CLOSEDP x
+Returns non-zero if port @var{x} is open or closed, respectively.
+@end defmac
+
+@defmac STREAM x
+Returns the @code{FILE *} stream for port @var{x}.
+@end defmac
+
+@noindent
+Ports which are particularly well behaved are called @dfn{fport}s.
+Advanced operations like @code{file-position} and @code{reopen-file}
+only work for fports.
+
+@defmac FPORTP x
+@defmacx OPFPORTP x
+@defmacx OPINFPORTP x
+@defmacx OPOUTFPORTP x
+Returns non-zero if @var{x} is a port, open port, open input-port, or
+open output-port, respectively.
+@end defmac
+
+@node Smob Cells, Data Type Representations, Ptob Cells, Data Types
+@subsection Smob Cells
+
+@noindent
+A @dfn{smob} is a miscellaneous datatype.  The type code and GCMARK bit
+occupy the lower order 16 bits of the @code{CAR} half of the cell.  The
+rest of the @code{CAR} can be used for sub-type or other information.
+The @code{CDR} contains data of size long and is often a pointer to
+allocated memory.
+
+@noindent
+Like ptobs, new varieties of smobs can be defined dynamically
+(@pxref{Defining Smobs}).  These are the initial smobs:
+
+@deftp smob tc_free_cell
+unused cell on the freelist.
+@end deftp
+
+@deftp smob tc16_flo
+single-precision float.
+
+Inexact number data types are subtypes of type @code{tc16_flo}.  If the
+sub-type is:
+
+@enumerate 0
+@item
+a single precision float is contained in the @code{CDR}.
+@item
+@code{CDR} is a pointer to a @code{malloc}ed double.
+@end enumerate
+@enumerate 3
+@item
+@code{CDR} is a pointer to a @code{malloc}ed pair of doubles.
+@end enumerate
+
+@deftp smob tc_dblr
+double-precision float.
+@end deftp
+
+@deftp smob tc_dblc
+double-precision complex.
+@end deftp
+@end deftp
+
+@deftp smob tc16_bigpos
+@deftpx smob tc16_bigneg
+positive and negative bignums, respectively.
+
+Scm has large precision integers called bignums.  They are stored in
+sign-magnitude form with the sign occuring in the type code of the SMOBs
+bigpos and bigneg.  The magnitude is stored as a @code{malloc}ed array
+of type @code{BIGDIG} which must be an unsigned integral type with size
+smaller than @code{long}.  @code{BIGRAD} is the radix associated with
+@code{BIGDIG}.
+@end deftp
+
+@deftp smob tc16_promise
+made by DELAY.  @xref{Control features, , , r4rs, Revised(4) Scheme}.
+@end deftp
+
+@deftp smob tc16_arbiter
+synchronization object.  @xref{Process Synchronization}.
+@end deftp
+
+@deftp smob tc16_macro
+macro expanding function.  @xref{Low Level Syntactic Hooks}.
+@end deftp
+
+@deftp smob tc16_array
+multi-dimensional array.  @xref{Arrays}.
+
+This type implements both conventional arrays (those with arbitrary data
+as elements @pxref{Conventional Arrays}) and uniform arrays (those with
+elements of a uniform type @pxref{Uniform Array}).
+
+Conventional Arrays have a pointer to a vector for their @code{CDR}.
+Uniform Arrays have a pointer to a Uniform Vector type (string, bvect,
+ivect, uvect, fvect, dvect, or cvect) in their @code{CDR}.
+@end deftp
+
+
+@node Data Type Representations,  , Smob Cells, Data Types
+@subsection Data Type Representations
+
+@format
+@r{IMMEDIATE:      B,D,E,F=data bit, C=flag code, P=pointer address bit}
+@t{        ................................
+inum    BBBBBBBBBBBBBBBBBBBBBBBBBBBBBB10
+ichr    BBBBBBBBBBBBBBBBBBBBBBBB11110100
+iflag                   CCCCCCC101110100
+isym                    CCCCCCC001110100}
+@r{        IMCAR:  only in car of evaluated code, cdr has cell's GC bit}
+@t{ispcsym                 000CCCC00CCCC100
+iloc    0DDDDDDDDDDDDDDDEFFFFFFF11111100
+pointer PPPPPPPPPPPPPPPPPPPPPPPPPPPPP000
+gloc    PPPPPPPPPPPPPPPPPPPPPPPPPPPPP001}
+
+@r{   HEAP CELL:   G=gc_mark; 1 during mark, 0 other times.
+        1s and 0s here indicate type.     G missing means sys (not GC'd)
+        SIMPLE:}
+@t{cons    ..........SCM car..............0  ...........SCM cdr.............G
+closure ..........SCM code...........011  ...........SCM env.............G
+        HEADERs:
+ssymbol .........long length....G0000101  ..........char *chars...........
+msymbol .........long length....G0000111  ..........char *chars...........
+string  .........long length....G0001101  ..........char *chars...........
+vector  .........long length....G0001111  ...........SCM **elts...........
+bvect   .........long length....G0010101  ..........long *words...........
+ spare                          G0010111
+ivect   .........long length....G0011101  ..........long *words...........
+uvect   .........long length....G0011111  ......unsigned long *words......
+ spare                          G0100101
+ spare                          G0100111
+fvect   .........long length....G0101101  .........float *words...........
+dvect   .........long length....G0101111  ........double *words...........
+cvect   .........long length....G0110101  ........double *words...........
+
+contin  .........long length....G0111101  .............*regs..............
+cclo    .........long length....G0111111  ...........SCM **elts...........}
+@r{        SUBRs:}
+@t{ spare                          010001x1
+ spare                          010011x1
+subr_0  ..........int hpoff.....01010101  ...........SCM (*f)()...........
+subr_1  ..........int hpoff.....01010111  ...........SCM (*f)()...........
+cxr     ..........int hpoff.....01011101  .........double (*f)()..........
+subr_3  ..........int hpoff.....01011111  ...........SCM (*f)()...........
+subr_2  ..........int hpoff.....01100101  ...........SCM (*f)()...........
+asubr   ..........int hpoff.....01100111  ...........SCM (*f)()...........
+subr_1o ..........int hpoff.....01101101  ...........SCM (*f)()...........
+subr_2o ..........int hpoff.....01101111  ...........SCM (*f)()...........
+lsubr_2 ..........int hpoff.....01110101  ...........SCM (*f)()...........
+lsubr_2n..........int hpoff.....01110111  ...........SCM (*f)()...........
+rpsubr  ..........int hpoff.....01111101  ...........SCM (*f)()...........}
+@r{                        PTOBs:}
+@t{   port            0bwroxxxxxxxxG1110111  ..........FILE *stream..........
+ socket ttttttt    00001xxxxxxxxG1110111  ..........FILE *stream..........
+ inport uuuuuuuuuuU00011xxxxxxxxG1110111  ..........FILE *stream..........
+outport 0000000000000101xxxxxxxxG1110111  ..........FILE *stream..........
+ ioport uuuuuuuuuuU00111xxxxxxxxG1110111  ..........FILE *stream..........
+fport              00   00000000G1110111  ..........FILE *stream..........
+pipe               00   00000001G1110111  ..........FILE *stream..........
+strport            00   00000010G1110111  ..........FILE *stream..........
+sfport             00   00000011G1110111  ..........FILE *stream..........}
+@r{                        SMOBs:}
+@t{free_cell
+        000000000000000000000000G1111111  ...........*free_cell........000
+flo     000000000000000000000001G1111111  ...........float num............
+dblr    000000000000000100000001G1111111  ..........double *real..........
+dblc    000000000000001100000001G1111111  .........complex *cmpx..........
+bignum  ...int length...0000001 G1111111  .........short *digits..........
+bigpos  ...int length...00000010G1111111  .........short *digits..........
+bigneg  ...int length...00000011G1111111  .........short *digits..........
+                        xxxxxxxx = code assigned by newsmob();
+promise 000000000000000fxxxxxxxxG1111111  ...........SCM val..............
+arbiter 000000000000000lxxxxxxxxG1111111  ...........SCM name.............
+macro   000000000000000mxxxxxxxxG1111111  ...........SCM name.............
+array   ...short rank..cxxxxxxxxG1111111  ............*array..............}
+@end format
+
+@node Operations, Improvements To Make, Data Types, The Implementation
+@section Operations
+
+@menu
+* Garbage Collection::          Automatically reclaims unused storage
+* Signals::                     
+* C Macros::                    
+* Changing Scm::                
+* Defining Subrs::              
+* Defining Smobs::              
+* Defining Ptobs::              
+* Calling Scheme From C::       
+* Callbacks::                   
+* Type Conversions::            For use with C code.
+* Continuations::               For C and SCM
+* Evaluation::                  Why SCM is fast
+@end menu
+
+@node Garbage Collection, Signals, Operations, Operations
+@subsection Garbage Collection
+
+The garbage collector is in the latter half of @file{sys.c}.  The
+primary goal of @dfn{garbage collection} (or @dfn{GC}) is to recycle
+those cells no longer in use.  Immediates always appear as parts of
+other objects, so they are not subject to explicit garbage collection.
+
+All cells reside in the @dfn{heap} (composed of @dfn{heap segments}).
+Note that this is different from what Computer Science usually defines
+as a heap.
+
+@menu
+* Marking Cells::               
+* Sweeping the Heap::           
+@end menu
+
+@node Marking Cells, Sweeping the Heap, Garbage Collection, Garbage Collection
+@subsubsection Marking Cells
+
+The first step in garbage collection is to @dfn{mark} all heap objects
+in use.  Each heap cell has a bit reserved for this purpose.  For pairs
+(cons cells) the lowest order bit (0) of the CDR is used.  For other
+types, bit 8 of the CAR is used.  The GC bits are never set except
+during garbage collection.  Special C macros are defined in @file{scm.h}
+to allow easy manipulation when GC bits are possibly set.  @code{CAR},
+@code{TYP3}, and @code{TYP7} can be used on GC marked cells as they are.
+
+@defmac GCCDR x
+Returns the CDR of a cons cell, even if that cell has been GC marked.
+@end defmac
+@defmac GCTYP16 x
+Returns the 16 bit type code of a cell.
+@end defmac
+
+We need to (recursively) mark only a few objects in order to assure that
+all accessible objects are marked.  Those objects are
+@code{sys_protects[]} (for example, @code{dynwinds}), the current
+C-stack and the hash table for symbols, @dfn{symhash}.
+
+@deftypefun void gc_mark (SCM @var{obj})
+The function @code{gc_mark()} is used for marking SCM cells.  If
+@var{obj} is marked, @code{gc_mark()} returns.  If @var{obj} is
+unmarked, gc_mark sets the mark bit in @var{obj}, then calls
+@code{gc_mark()} on any SCM components of @var{obj}.  The last call to
+@code{gc_mark()} is tail-called (looped).
+@end deftypefun
+
+@deftypefun void mark_locations (STACKITEM @var{x[]}, sizet @var{len}))
+The function @code{mark_locations} is used for marking segments of
+C-stack or saved segments of C-stack (marked continuations).  The
+argument @var{len} is the size of the stack in units of size
+@code{(STACKITEM)}.
+
+Each longword in the stack is tried to see if it is a valid cell pointer
+into the heap.  If it is, the object itself and any objects it points to
+are marked using @code{gc_mark}.  If the stack is word rather than
+longword aligned @code{(#define WORD_ALIGN)}, both alignments are tried.
+This arrangement will occasionally mark an object which is no longer
+used.  This has not been a problem in practice and the advantage of
+using the c-stack far outweighs it.
+@end deftypefun
+
+@node Sweeping the Heap,  , Marking Cells, Garbage Collection
+@subsubsection Sweeping the Heap
+
+After all found objects have been marked, the heap is swept.
+
+The storage for strings, vectors, continuations, doubles, complexes, and
+bignums is managed by malloc.  There is only one pointer to each malloc
+object from its type-header cell in the heap.  This allows malloc
+objects to be freed when the associated heap object is garbage
+collected.
+
+@deftypefun static void gc_sweep ()
+The function @code{gc_sweep} scans through all heap segments.  The mark
+bit is cleared from marked cells.  Unmarked cells are spliced into
+@var{freelist}, where they can again be returned by invocations of
+@code{NEWCELL}.
+
+If a type-header cell pointing to malloc space is unmarked, the malloc
+object is freed.  If the type header of smob is collected, the smob's
+@code{free} procedure is called to free its storage.
+@end deftypefun
+
+@node Signals, C Macros, Garbage Collection, Operations
+@subsection Signals
+
+@defun init_signals
+(in @file{scm.c}) initializes handlers for @code{SIGINT} and
+@code{SIGALRM} if they are supported by the C implementation.  All of
+the signal handlers immediately reestablish themselves by a call to
+@code{signal()}.
+@end defun
+
+@defun int_signal sig
+@defunx alrm_signal sig
+The low level handlers for @code{SIGINT} and @code{SIGALRM}.
+@end defun
+
+If an interrupt handler is defined when the interrupt is received, the
+code is interpreted.  If the code returns, execution resumes from where
+the interrupt happened.  @code{Call-with-current-continuation} allows
+the stack to be saved and restored.
+
+SCM does not use any signal masking system calls.  These are not a
+portable feature.  However, code can run uninterrupted by use of the C
+macros @code{DEFER_INTS} and @code{ALLOW_INTS}.
+
+@defmac DEFER_INTS
+sets the global variable @code{ints_disabled} to 1.  If an interrupt
+occurs during a time when @code{ints_disabled} is 1 one of the global
+variables @code{sig_deferred} or @code{alrm_deferred} is set to 1 and
+the handler returns.
+
+@defmacx ALLOW_INTS
+Checks the deferred variables and if set the appropriate handler is
+called.
+
+Calls to @code{DEFER_INTS} can not be nested.  An @code{ALLOW_INTS} must
+happen before another @code{DEFER_INTS} can be done.  In order to check
+that this constraint is satisfied @code{#define CAREFUL_INTS} in
+@file{scmfig.h}.
+@end defmac
+
+@node C Macros, Changing Scm, Signals, Operations
+@subsection C Macros
+
+
+@defmac ASSERT cond arg pos subr
+signals an error if the expression (@var{cond}) is 0.  @var{arg} is the
+offending object, @var{subr} is the string naming the subr, and
+@var{pos} indicates the position or type of error.  @var{pos} can be one
+of
+
+@itemize @bullet
+@item @code{ARGn} @i{(> 5 or unknown ARG number)}
+@item @code{ARG1}
+@item @code{ARG2}
+@item @code{ARG3}
+@item @code{ARG4}
+@item @code{ARG5}
+@item @code{WNA} @i{(wrong number of args)}
+@item @code{OVFLOW}
+@item @code{OUTOFRANGE}
+@item @code{NALLOC}
+@item @code{EXIT}
+@item @code{HUP_SIGNAL}
+@item @code{INT_SIGNAL}
+@item @code{FPE_SIGNAL}
+@item @code{BUS_SIGNAL}
+@item @code{SEGV_SIGNAL}
+@item @code{ALRM_SIGNAL}
+@item a C string @code{(char *)}
+@end itemize
+
+Error checking is not done by @code{ASSERT} if the flag @code{RECKLESS}
+is defined.  An error condition can still be signaled in this case with
+a call to @code{wta(arg, pos, subr)}.
+@end defmac
+
+@defmac ASRTGO cond label
+@code{goto} @var{label} if the expression (@var{cond}) is 0.  Like
+@code{ASSERT}, @code{ASRTGO} does is not active if the flag
+@code{RECKLESS} is defined.
+@end defmac
+
+
+@node Changing Scm, Defining Subrs, C Macros, Operations
+@subsection Changing Scm
+
+@noindent
+When writing C-code for SCM, a precaution is recommended.  If your
+routine allocates a non-cons cell which will @emph{not} be incorporated
+into a @code{SCM} object which is returned, you need to make sure that a
+@code{SCM} variable in your routine points to that cell as long as part
+of it might be referenced by your code.
+
+@noindent
+In order to make sure this @code{SCM} variable does not get optimized
+out you can put this assignment after its last possible use:
+
+@example
+SCM_dummy1 = @i{foo};
+@end example
+
+@noindent
+or put this assignment somewhere in your routine:
+
+@example
+SCM_dummy1 = (SCM) &@i{foo};
+@end example
+
+@noindent
+@code{SCM_dummy} variables are not currently defined.  Passing the
+address of the local @code{SCM} variable to @emph{any} procedure also
+protects it.
+
+@noindent
+Also, if you maintain a static pointer to some (non-immediate)
+@code{SCM} object, you must either make your pointer be the value cell
+of a symbol (see @code{errobj} for an example) or make your pointer be
+one of the @code{sys_protects} (see @code{dynwinds} for an example).
+The former method is prefered since it does not require any changes to
+the SCM distribution.
+
+@noindent
+To add a C routine to scm:
+
+@enumerate
+@item
+choose the appropriate subr type from the type list.
+@item
+write the code and put into @file{scm.c}.
+@item
+add a @code{make_subr} or @code{make_gsubr} call to @code{init_scm}.  Or
+put an entry into the appropriate @code{iproc} structure.
+@end enumerate
+
+To add a package of new procedures to scm (see @file{crs.c} for
+example):
+
+@enumerate
+@item
+create a new C file (@file{@i{foo}.c}).
+@item
+at the front of @file{@i{foo}.c} put declarations for strings for your
+procedure names.
+
+@example
+static char s_twiddle_bits[]="twiddle-bits!";
+static char s_bitsp[]="bits?";
+@end example
+
+@item
+choose the appropriate subr types from the type list in @file{code.doc}.
+@item
+write the code for the procedures and put into @file{@i{foo}.c}
+@item
+create one @code{iproc} structure for each subr type used in @file{@i{foo}.c}
+
+@example
+static iproc subr3s[]= @{
+        @{s_twiddle-bits,twiddle-bits@},
+        @{s_bitsp,bitsp@},
+        @{0,0@} @};
+@end example
+
+@item
+create an @code{init_@i{<name of file>}} routine at the end of the file
+which calls @code{init_iprocs} with the correct type for each of the
+@code{iproc}s created in step 5.
+
+@example
+void init_@i{foo}()
+@{
+  init_iprocs(subr1s, tc7_subr_1);
+  init_iprocs(subr3s, tc7_subr_3);
+@}
+@end example
+
+If your package needs to have a @dfn{finalization} routine called to
+free up storage, close files, etc, then also have a line in
+@code{init_@i{foo}} like:
+
+@example
+add_final(final_@i{foo});
+@end example
+
+@code{final_@i{foo}} should be a (void) procedure of no arguments.  The
+finals will be called in opposite order from their definition.
+
+The line:
+
+@example
+add_feature("@i{foo}");
+@end example
+
+will append a symbol @code{'@i{foo}} to the (list) value of
+@code{*features*}.
+@item
+put any scheme code which needs to be run as part of your package into
+@file{I@i{foo}.scm}.
+@item
+put an @code{if} into @file{Init.scm} which loads @file{I@i{foo}.scm} if
+your package is included:
+
+@example
+(if (defined? twiddle-bits!)
+    (load (in-vicinity (implementation-vicinity)
+                       "I@i{foo}"
+                       (scheme-file-suffix))))
+@end example
+
+or use @code{(provided? '@i{foo})} instead of @code{(defined?
+twiddle-bits!)} if you have added the feature.
+@item
+put documentation of the new procedures into @file{@i{foo}.doc}
+@item
+add lines to your @file{Makefile} to compile and link SCM with your
+object file.  Add a @code{init_@i{foo}\(\)\;} to the @code{INITS=@dots{}}
+line at the beginning of the makefile.
+@end enumerate
+
+@noindent
+These steps should allow your package to be linked into SCM with a
+minimum of difficulty.  Your package should also work with dynamic
+linking if your SCM has this capability.
+
+Special forms (new syntax) can be added to scm.
+
+@enumerate
+@item
+define a new @code{MAKISYM} in @file{scm.h} and increment
+@code{NUM_ISYMS}.
+@item
+add a string with the new name in the corresponding place in
+@code{isymnames} in @file{repl.c}.
+@item
+add @code{case:} clause to @code{ceval()} near @code{i_quasiquote} (in
+@file{eval.c}).
+@end enumerate
+
+@noindent
+New syntax can now be added without recompiling SCM by the use of the
+@code{procedure->syntax}, @code{procedure->macro},
+@code{procedure->memoizing-macro}, and @code{defmacro}.  For details,
+@xref{Syntax Extensions}.
+
+@node Defining Subrs, Defining Smobs, Changing Scm, Operations
+@subsection Defining Subrs
+
+@noindent
+If @dfn{CCLO} is @code{#define}d when compiling, the compiled closure
+feature will be enabled.  It is automatically enabled if dynamic linking
+is enabled.
+
+@noindent
+The SCM interpreter directly recognizes subrs taking small numbers of
+arguments.  In order to create subrs taking larger numbers of arguments
+use:
+
+@defun make_gsubr name req opt rest fcn
+returns a cclo (compiled closure) object of name @code{char *}
+@var{name} which takes @code{int} @var{req} required arguments,
+@code{int} @var{opt} optional arguments, and a list of rest arguments if
+@code{int} @var{rest} is 1 (0 for not).
+
+@code{SCM (*fcn)()} is a pointer to a C function to do the work.
+
+The C function will always be called with @var{req} + @var{opt} +
+@var{rest} arguments, optional arguments not supplied will be passed
+@code{UNDEFINED}.  An error will be signaled if the subr is called with
+too many or too few arguments.  Currently a total of 10 arguments may be
+specified, but increasing this limit should not be difficult.
+
+@example
+/* A silly example, taking 2 required args,
+   1 optional, and a list of rest args */
+
+#include <scm.h>
+
+SCM gsubr_21l(req1,req2,opt,rst)
+     SCM req1,req2,opt,rst;
+@{
+  lputs("gsubr-2-1-l:\n req1: ", cur_outp);
+  display(req1,cur_outp);
+  lputs("\n req2: ", cur_outp);
+  display(req2,cur_outp);
+  lputs("\n opt: ", cur_outp);
+  display(opt,cur_outp);
+  lputs("\n rest: ", cur_outp);
+  display(rst,cur_outp);
+  newline(cur_outp);
+  return UNSPECIFIED;
+@}
+
+void init_gsubr211()
+@{
+  make_gsubr("gsubr-2-1-l", 2, 1, 1, gsubr_21l);
+@}
+@end example
+@end defun
+
+@node Defining Smobs, Defining Ptobs, Defining Subrs, Operations
+@subsection Defining Smobs
+
+@noindent
+Here is an example of how to add a new type named @code{@i{foo}} to SCM.
+The following lines need to be added to your code:
+
+@table @code
+@item long tc16_@i{foo};
+The type code which will be used to identify the new type.
+@item static smobfuns @i{foo}smob = @{mark@i{foo},free@i{foo},print@i{foo},equalp@i{foo}@};
+smobfuns is a structure composed of 4 functions:
+
+@example
+typedef struct @{
+  SCM   (*mark)P((SCM));
+  sizet (*free)P((CELLPTR));
+  int   (*print)P((SCM exp, SCM port, int writing));
+  SCM   (*equalp)P((SCM, SCM));
+@} smobfuns;
+@end example
+
+@table @code
+@item smob.mark
+is a function of one argument of type @code{SCM} (the cell to mark) and
+returns type @code{SCM} which will then be marked.  If no further
+objects need to be marked then return an immediate object such as
+@code{BOOL_F}.  2 functions are provided:
+
+@table @code
+@item markcdr(ptr)
+which marks the current cell and returns @code{CDR(ptr)}.
+@item mark0(ptr)
+which marks the current cell and returns @code{BOOL_F}.
+@end table
+
+@item smob.free
+is a function of one argument of type @code{CELLPTR} (the cell to
+collected) and returns type @code{sizet} which is the number of
+@code{malloc}ed bytes which were freed.  @code{Smob.free} should free
+any @code{malloc}ed storage associated with this object.  The function
+free0(ptr) is provided which does not free any storage and returns 0.
+@item smob.print
+is 0 or a function of 3 arguments.  The first, of type @code{SCM}, is
+the smob object.  The second, of type @code{SCM}, is the stream on which
+to write the result.  The third, of type int, is 1 if the object should
+be @code{write}n, 0 if it should be @code{display}ed.  This function
+should return non-zero if it printed, and zero otherwise (in which case
+a hexadecimal number will be printed).
+@item smob.equalp
+is 0 or a function of 2 @code{SCM} arguments.  Both of these arguments
+will be of type @code{tc16@i{foo}}.  This function should return
+@code{BOOL_T} if the smobs are equal, @code{BOOL_F} if they are not.  If
+@code{smob.equalp} is 0, @code{equal?} will return @code{BOOL_F} if they
+are not @code{eq?}.
+@end table
+
+@item tc16_@i{foo} = newsmob(&@i{foo}smob);
+Allocates the new type with the functions from @code{@i{foo}smob}.  This
+line goes in an @code{init_} routine.
+@end table
+
+@noindent
+Promises and macros in @file{eval.c} and arbiters in @file{repl.c}
+provide examples of SMOBs.  There are a maximum of 256 SMOBs.
+
+@node Defining Ptobs, Calling Scheme From C, Defining Smobs, Operations
+@subsection Defining Ptobs
+
+@noindent
+@dfn{ptob}s are similar to smobs but define new types of port to which
+SCM procedures can read or write.  The following functions are defined
+in the @code{ptobfuns}:
+
+@example
+typedef struct @{
+  SCM   (*mark)P((SCM ptr));
+  int   (*free)P((FILE *p));
+  int   (*print)P((SCM exp, SCM port, int writing));
+  SCM   (*equalp)P((SCM, SCM));
+  int   (*fputc)P((int c, FILE *p));
+  int   (*fputs)P((char *s, FILE *p));
+  sizet (*fwrite)P((char *s, sizet siz, sizet num, FILE *p));
+  int   (*fflush)P((FILE *stream));
+  int   (*fgetc)P((FILE *p));
+  int   (*fclose)P((FILE *p));
+@} ptobfuns;
+@end example
+
+@noindent
+The @code{.free} component to the structure takes a @code{FILE *} or
+other C construct as its argument, unlike @code{.free} in a smob, which
+takes the whole smob cell.  Often, @code{.free} and @code{.fclose} can be
+the same function.  See @code{fptob} and @code{pipob} in @file{sys.c}
+for examples of how to define ptobs.
+
+@node Calling Scheme From C, Callbacks, Defining Ptobs, Operations
+@subsection Calling Scheme From C
+
+@noindent
+To use SCM as a whole from another program call @code{init_scm} or
+@code{run_scm} as is done in @code{main()} in @file{scm.c}.
+
+@noindent
+In order to call indivdual Scheme procedures from C code more is
+required; SCM's storage system needs to be initialized.  The simplest
+way to do this for a statically linked single-thread program is to:
+
+@enumerate
+@item
+make a SCM procedure which calls your code's startup routine.
+@item
+use the @code{#define RTL} flag when compiling @file{scm.c} to elide
+SCM's @code{main()}.
+@item
+In your @code{main()}, call @code{run_scm} with arguments (@code{argc}
+and @code{argv}) to invoke your code's startup routine.
+@item
+link your code with SCM at compile time.
+@end enumerate
+
+@noindent
+For a dynamically linked single-thread program:
+
+@enumerate
+@item
+make an @code{init_} procedure for your code which will set up any Scheme
+definitions you need and then call your startup routine
+(@pxref{Changing Scm}).
+@item
+Start SCM with command line arguments to dynamically link your code.
+After your module is linked, the @code{init_} procedure will be called, and
+hence your startup routine.
+@end enumerate
+
+@noindent
+Now use @code{apply} (and perhaps @code{intern}) to call Scheme
+procedures from your C code.  For example:
+
+@example
+/* If this apply fails, SCM will catch the error */
+apply(CDR(intern("srv:startup",sizeof("srv:startup")-1)),
+      mksproc(srvproc),
+      listofnull);
+
+func = CDR(intern(rpcname,strlen(rpcname)));
+retval = apply(func, cons(mksproc(srvproc), args), EOL);
+@end example
+
+@node Callbacks, Type Conversions, Calling Scheme From C, Operations
+@subsection Callbacks
+
+@noindent
+SCM now has routines to make calling back to Scheme procedures easier.
+The source code for these routines are found in @file{rope.c}.
+
+@deftypefun int scm_ldfile (char *@var{file})
+Loads the Scheme source file @var{file}.  Returns 0 if successful, non-0
+if not.  This function is used to load SCM's initialization file
+@file{Init.scm}.
+@end deftypefun
+
+@deftypefun int scm_ldprog (char *@var{file})
+Loads the Scheme source file @code{(in-vicinity (program-vicinity)
+@var{file})}.  Returns 0 if successful, non-0 if not.
+
+This function is useful for compiled code init_ functions to load
+non-compiled Scheme (source) files.  @code{program-vicinity} is the
+directory from which the calling code was loaded (@pxref{Vicinity, , ,
+slib, SLIB}).
+@end deftypefun
+
+@deftypefun SCM scm_evstr (char *@var{str})
+Returns the result of reading an expression from @var{str} and
+evaluating it.
+@end deftypefun
+
+@deftypefun void scm_ldstr (char *@var{str})
+Reads and evaluates all the expressions from @var{str}.
+@end deftypefun
+
+@noindent
+If you wish to catch errors during execution of Scheme code, then you
+can use a wrapper like this for your Scheme procedures:
+
+@example
+(define (srv:protect proc)
+  (lambda args
+    (define result #f)                  ; put default value here
+    (call-with-current-continuation
+     (lambda (cont)
+       (dynamic-wind (lambda () #t)
+                     (lambda ()
+                       (set! result (apply proc args))
+                       (set! cont #f))
+                     (lambda ()
+                       (if cont (cont #f))))))
+    result))
+@end example
+
+@noindent
+Calls to procedures so wrapped will return even if an error occurs.
+
+@node Type Conversions, Continuations, Callbacks, Operations
+@subsection Type Conversions
+
+These type conversion functions are very useful for connecting SCM and C
+code.  Most are defined in @file{rope.c}.
+
+@deftypefun SCM long2num (long @var{n})
+@deftypefunx SCM ulong2num (unsigned long @var{n})
+Return an object of type @code{SCM} corresponding to the @code{long} or
+@code{unsigned long} argument @var{n}.  If @var{n} cannot be converted,
+@code{BOOL_F} is returned.  Which numbers can be converted depends on
+whether SCM was compiled with the @code{BIGDIG} or @code{FLOATS} flags.
+
+To convert integer numbers of smaller types (@code{short} or
+@code{char}), use the macro @code{MAKINUM(n)}.
+@end deftypefun
+
+@deftypefun long num2long (SCM @var{num}, char *@var{pos}, char *@var{s_caller})
+@deftypefunx unsigned long num2ulong (SCM @var{num}, char *@var{pos}, char *@var{s_caller})
+@deftypefunx unsigned short num2ushort (SCM @var{num}, char *@var{pos}, char *@var{s_caller})
+@deftypefunx unsigned char num2uchar (SCM @var{num}, char *@var{pos}, char *@var{s_caller})
+These functions are used to check and convert @code{SCM} arguments to
+the named C type.  The first argument @var{num} is checked to see it it
+is within the range of the destination type.  If so, the converted
+number is returned.  If not, the @code{ASSERT} macro calls @code{wta}
+with @var{num} and strings @var{pos} and @var{s_caller}.  For a listing
+of useful predefined @var{pos} macros, @xref{C Macros}.
+
+@emph{Note:} Inexact numbers are accepted only by @code{num2long} and
+@code{num2ulong} (for when @code{SCM} is compiled without bignums).  To
+convert inexact numbers to exact numbers, @xref{Numerical operations,
+inexact->exact, , r4rs, Revised(4) Scheme}.
+@end deftypefun
+
+@deftypefun unsigned long scm_addr (SCM @var{args}, char *@var{s_name})
+Returns a pointer (cast to an @code{unsigned long}) to the storage
+corresponding to the location accessed by
+@code{aref(CAR(args),CDR(args))}.  The string @var{s_name} is used in
+any messages from error calls by @code{scm_addr}.
+
+@code{scm_addr} is useful for performing C operations on strings or
+other uniform arrays (@pxref{Uniform Array}).
+
+@emph{Note:} While you use a pointer returned from @code{scm_addr} you
+must keep a pointer to the associated @code{SCM} object in a stack
+allocated variable or GC-protected location in order to assure that SCM
+does not reuse that storage before you are done with it.
+@end deftypefun
+
+@deftypefun SCM makfrom0str (char *@var{src})
+@deftypefunx SCM makfromstr (char *@var{src}, sizet @var{len})
+Return a newly allocated string @code{SCM} object copy of the
+null-terminated string @var{src} or the string @var{src} of length
+@var{len}, respectively.
+@end deftypefun
+
+@deftypefun SCM makfromstrs (int @var{argc}, char **@var{argv})
+Returns a newly allocated @code{SCM} list of strings corresponding to
+the @var{argc} length array of null-terminated strings @var{argv}.  If
+@var{argv} is less than @code{0}, @var{argv} is assumed to be
+@code{NULL} terminated.  @code{makfromstrs} is used by @code{run_scm} to
+convert the arguments SCM was called with to a @code{SCM} list which is
+the value of SCM procedure calls to @code{program-arguments}
+(@pxref{System Interface, program-arguments}).
+@end deftypefun
+
+@deftypefun char **makargvfrmstrs (SCM @var{args}, char *@var{s_name})
+Returns a @code{NULL} terminated list of null-terminated strings copied
+from the @code{SCM} list of strings @var{args}.  The string @var{s_name}
+is used in messages from error calls by @code{makargvfrmstrs}.
+
+@code{makargvfrmstrs} is useful for constructing argument lists suitable
+for passing to @code{main} functions.
+@end deftypefun
+
+@deftypefun void must_free_argv (char **@var{argv})
+Frees the storage allocated to create @var{argv} by a call to
+@code{makargvfrmstrs}.
+@end deftypefun
+
+@node Continuations, Evaluation, Type Conversions, Operations
+@subsection Continuations
+
+@noindent
+The source files @file{continue.h} and @file{continue.c} are designed to
+function as an independent resource for programs wishing to use
+continuations, but without all the rest of the SCM machinery.  The
+concept of continuations is explained in @ref{Control features,
+call-with-current-continuation, , r4rs, Revised(4) Scheme}.
+
+@deftp {Data type} CONTINUATION jmpbuf length stkbse other parent
+is a @code{typedef}ed structure holding all the information needed to
+represent a continuation.  The @var{other} slot can be used to hold any
+data the user wishes to put there by defining the macro
+@code{CONTINUATION_OTHER}.
+@end deftp
+
+@defmac SHORT_ALIGN
+If @code{SHORT_ALIGN} is @code{#define}d (in @file{scmfig.h}), then the
+it is assumed that pointers in the stack can be aligned on @code{short
+int} boundaries.
+@end defmac
+
+@deftp {Data type} STACKITEM
+is a pointer to objects of the size specified by @code{SHORT_ALIGN}
+being @code{#define}d or not.
+@end deftp
+
+@defmac CHEAP_CONTINUATIONS
+If @code{CHEAP_CONTINUATIONS} is @code{#define}d (in @file{scmfig.h})
+each @code{CONTINUATION} has size @code{sizeof CONTINUATION}.
+Otherwise, all but @dfn{root} @code{CONTINUATION}s have additional
+storage (immediately following) to contain a copy of part of the stack.
+
+@emph{Note:} On systems with nonlinear stack disciplines (multiple
+stacks or non-contiguous stack frames) copying the stack will not work
+properly.  These systems need to #define @code{CHEAP_CONTINUATIONS} in
+@file{scmfig.h}.
+@end defmac
+
+@defmac STACK_GROWS_UP
+Expresses which way the stack grows by its being @code{#define}d or not.
+@end defmac
+
+@deftypevar long thrown_value
+Gets set to the @var{value} passed to @code{throw_to_continuation}.
+@end deftypevar
+
+@deftypefun long stack_size (STACKITEM *@var{start})
+Returns the number of units of size @code{STACKITEM} which fit between
+@var{start} and the current top of stack.  No check is done in this
+routine to ensure that @var{start} is actually in the current stack
+segment.
+@end deftypefun
+
+@deftypefun CONTINUATION *make_root_continuation (STACKITEM *@var{stack_base})
+Allocates (@code{malloc}) storage for a @code{CONTINUATION} of the
+current extent of stack.  This newly allocated @code{CONTINUATION} is
+returned if successful, @code{0} if not.  After
+@code{make_root_continuation} returns, the calling routine still needs
+to @code{setjmp(@var{new_continuation}->jmpbuf)} in order to complete
+the capture of this continuation.
+@end deftypefun
+
+@deftypefun CONTINUATION *make_continuation (CONTINUATION *@var{parent_cont})
+Allocates storage for the current @code{CONTINUATION}, copying (or
+encapsulating) the stack state from @code{@var{parent_cont}->stkbse} to
+the current top of stack.  The newly allocated @code{CONTINUATION} is
+returned if successful, @code{0}q if not.  After
+@code{make_continuation} returns, the calling routine still needs to
+@code{setjmp(@var{new_continuation}->jmpbuf)} in order to complete the
+capture of this continuation.
+@end deftypefun
+
+@deftypefun void free_continuation (CONTINUATION *@var{cont})
+Frees the storage pointed to by @var{cont}.  Remember to free storage
+pointed to by @code{@var{cont}->other}.
+@end deftypefun
+
+@deftypefun void throw_to_continuation (CONTINUATION *@var{cont}, long @var{value}, CONTINUATION *@var{root_cont})
+Sets @code{thrown_value} to @var{value} and returns from the
+continuation @var{cont}.
+
+If @code{CHEAP_CONTINUATIONS} is @code{#define}d, then
+@code{throw_to_continuation} does @code{longjmp(@var{cont}->jmpbuf, val)}.
+
+If @code{CHEAP_CONTINUATIONS} is not @code{#define}d, the CONTINUATION
+@var{cont} contains a copy of a portion of the C stack (whose bound must
+be @code{CONT(@var{root_cont})->stkbse}).  Then:
+
+@itemize @bullet
+@item
+the stack is grown larger than the saved stack, if neccessary.
+@item
+the saved stack is copied back into it's original position.
+@item
+@code{longjmp(@var{cont}->jmpbuf, val)};
+@end itemize
+@end deftypefun
+
+@node Evaluation,  , Continuations, Operations
+@subsection Evaluation
+
+SCM uses its type representations to speed evaluation.  All of the
+@code{subr} types (@pxref{Subr Cells}) are @code{tc7} types.  Since the
+@code{tc7} field is in the low order bit position of the @code{CAR} it
+can be retrieved and dispatched on quickly by dereferencing the SCM
+pointer pointing to it and masking the result.
+
+All the SCM @dfn{Special Forms} get translated to immediate symbols
+(@code{isym}) the first time they are encountered by the interpreter
+(@code{ceval}).  The representation of these immediate symbols is
+engineered to occupy the same bits as @code{tc7}.  All the @code{isym}s
+occur only in the @code{CAR} of lists.
+
+If the @code{CAR} of a expression to evaluate is not immediate, then it
+may be a symbol.  If so, the first time it is encountered it will be
+converted to an immediate type @code{ILOC} or @code{GLOC}
+(@pxref{Immediates}).  The codes for @code{ILOC} and @code{GLOC} lower 7
+bits distinguish them from all the other types we have discussed.
+
+Once it has determined that the expression to evaluate is not immediate,
+@code{ceval} need only retrieve and dispatch on the low order 7 bits of
+the @code{CAR} of that cell, regardless of whether that cell is a
+closure, header, or subr, or a cons containing @code{ILOC} or
+@code{GLOC}.
+
+In order to be able to convert a SCM symbol pointer to an immediate @code{ILOC}
+or @code{GLOC}, the evaluator must be holding the pointer to the list in which
+that symbol pointer occurs.  Turning this requirement to an advantage,
+@code{ceval} does not recursively call itself to evaluate symbols in
+lists; It instead calls the macro @dfn{EVALCAR}.  @code{EVALCAR} does
+symbol lookup and memoization for symbols, retrieval of values for @code{ILOC}s
+and @code{GLOC}s, returns other immediates, and otherwise recursively calls
+itself with the @code{CAR} of the list.
+
+@code{ceval} inlines evaluation (using @code{EVALCAR}) of almost all
+procedure call arguments.  When @code{ceval} needs to evaluate a list of
+more than length 3, the procedure @code{eval_args} is called.  So
+@code{ceval} can be said to have one level lookahead.  The avoidance of
+recursive invocations of @code{ceval} for the most common cases (special
+forms and procedure calls) results in faster execution.  The speed of
+the interpreter is currently limited on most machines by interpreter
+size, probably having to do with its cache footprint.  In order to keep
+the size down, certain @code{EVALCAR} calls which don't need to be fast
+(because they rarely occur or because they are part of expensive
+operations) are instead calls to the C function @code{evalcar}.
+
+There was some discussion a year ago about a "Forth" style Scheme
+interpreter.  This is the only improvement I know of which would beat
+SCM in speed.
+
+@quotation
+Provided there is still type code space available in SCM, if we devote
+some of the IMCAR codes to "inlined" operations, we should get a
+significant performance boost.  What is eliminated is the having to look
+up a @code{GLOC} or @code{ILOC} and then dispatch on the subr type.  The
+IMCAR operation would be dispatched to directly.  Another way to view
+this is that we make available special form versions of @code{CAR},
+@code{CDR}, etc.  Since the actual operation code is localized in the
+interpreter, it is much easier than uncompilation and then recompilation
+to handle @code{(trace car)}; For instance a switch gets set which tells
+the interpreter to instead always look up the values of the associated
+symbols.
+@end quotation
+
+@defvar symhash
+Top level symbol values are stored in the @code{symhash} table.
+@code{symhash} is an array of lists of @code{ISYM}s and pairs of symbols
+and values.
+@end defvar
+
+@deftp Immediate ILOC
+Whenever a symbol's value is found in the local environment the pointer
+to the symbol in the code is replaced with an immediate object
+(@code{ILOC}) which specifies how many environment frames down and how
+far in to go for the value.  When this immediate object is subsequently
+encountered, the value can be retrieved quickly.
+@end deftp
+
+@deftp Immediate GLOC
+Pointers to symbols not defined in local environments are changed to one
+plus the value cell address in symhash.  This incremented pointer is
+called a @code{GLOC}.  The low order bit is normally reserved for
+GCmark; But, since references to variables in the code always occur in
+the @code{CAR} position and the GCmark is in the @code{CDR}, there is no
+conflict.
+@end deftp
+
+If the compile FLAG @code{CAUTIOUS} is #defined then the number of
+arguments is always checked for application of closures.  If the compile
+FLAG @code{RECKLESS} is #defined then they are not checked.  Otherwise,
+number of argument checks for closures are made only when the function
+position (whose value is the closure) of a combination is not an
+@code{ILOC} or @code{GLOC}.  When the function position of a combination
+is a symbol it will be checked only the first time it is evaluated
+because it will then be replaced with an @code{ILOC} or @code{GLOC}.
+
+@defmac EVAL expression env
+@defmacx SIDEVAL expression env
+@code{EVAL} Returns the result of evaluating @var{expression} in
+@var{env}.  @code{SIDEVAL} evaluates @var{expression} in @var{env} when
+the value of the expression is not used.
+
+Both of these macros alter the list structure of @var{expression} as it
+is memoized and hence should be used only when it is known that
+@var{expression} will not be referenced again.  The C function
+@code{eval} is safe from this problem.
+@end defmac
+
+@deftypefun SCM eval (SCM @var{expression})
+Returns the result of evaluating @var{expression} in the top-level
+environment.  @code{eval} copies @code{expression} so that memoization
+does not modify @code{expression}.
+@end deftypefun
+
+@node Improvements To Make, Finishing Dynamic Linking, Operations, The Implementation
+@section Improvements To Make
+
+@itemize @bullet
+@item
+Prefix and make more uniform all C function, variable, and constant
+names.  Provide a file full of #define's to provide backward
+compatability.
+@item
+@code{lgcd()} @emph{needs} to generate at most one bignum, but currently
+generates more.
+@item
+@code{divide()} could use shifts instead of multiply and divide when
+scaling.
+@item
+If an open fails because there are no unused file handles, GC should
+be done so that file handles which are no longer used can be
+collected.
+@item
+Currently, @code{dump}ing an executable does not preserve ports.  When
+loading a @code{dump}ed executable, disk files could be reopened to the
+same file and position as they had when the executable was dumped.
+@item
+Compaction could be done to @code{malloc}ed objects by freeing and
+reallocing all the malloc objects encountered in a scan of the heap.
+Whether compactions would actually occur is system depenedent.
+@item
+Copying all of the stack is wasteful of storage.  Any time a
+call-with-current-continuation is called the stack could be re-rooted
+with a frame which calls the contin just created.  This in combination
+with checking stack depth could also be used to allow stacks deeper
+than 64K on the IBM PC.
+@item
+lookupcar in @file{eval.c} should @emph{not} memoize (to @code{ILOC}s)
+when it retrieves environments deeper or longer than 4095.  The values
+can still be retrieved (albeit slowly), but an @code{ILOC} should not be
+made.  The @code{MEMOIZE_LOCALS} flag could then be flushed.
+@item
+The @code{must-} or @code{make-} routines need some sort of C macros or
+conditionalization so that they check:
+
+@itemize @bullet
+@item
+that the @code{LENGTH} field fits into a @code{size_t} (as is checked
+now) for platforms with @code{(sizeof(size_t) < sizeof(SCM))}.
+@item
+that the @code{LENGTH} field fits into 24 (or 56) bits on machines where
+@code{size_t} is 32 bits or more.
+@end itemize
+
+This is trickier than it first looks because the must_malloc() routine
+is also used for allocating heap segments, which do not have the
+@code{LENGTH} field restriction.  Putting the 24 bit test into
+@code{must_malloc()} should be tested for speed impact.
+@end itemize
+
+@node Finishing Dynamic Linking,  , Improvements To Make, The Implementation
+@section Finishing Dynamic Linking
+
+@noindent
+Scott Schwartz <schwartz@@galapagos.cse.psu.edu> suggests: One way to
+tidy up the dynamic loading stuff would be to grab the code from perl5.
+
+@subsubheading VMS
+
+@noindent
+George Carrette (gjc@@mitech.com) outlines how to dynamically link on
+VMS.  There is already some code in @file{dynl.c} to do this, but
+someone with a VMS system needs to finish and debug it.
+
+@enumerate
+@item
+Say you have this @file{main.c} program:
+
+@format
+@t{main()
+@{init_lisp();
+ lisp_repl();@}}
+@end format
+
+@item
+and you have your lisp in files @file{repl.c}, @file{gc.c},
+@code{eval.c} and there are some toplevel non-static variables in use
+called @code{the_heap}, @code{the_environment}, and some read-only
+toplevel structures, such as @code{the_subr_table}.
+
+@format
+@t{$ LINK/SHARE=LISPRTL.EXE/DEBUG REPL.OBJ,GC.OBJ,EVAL.OBJ,LISPRTL.OPT/OPT}
+@end format
+
+@item
+where @file{LISPRTL.OPT} must contain at least this:
+
+@format
+@t{SYS$LIBRARY:VAXCRTL/SHARE
+UNIVERSAL=init_lisp
+UNIVERSAL=lisp_repl
+PSECT_ATTR=the_subr_table,SHR,NOWRT,LCL
+PSECT_ATTR=the_heap,NOSHR,LCL
+PSECT_ATTR=the_environment,NOSHR,LCL}
+@end format
+
+@emph{Notice:} The @dfn{psect} (Program Section) attributes.
+@table @code
+@item LCL
+means to keep the name local to the shared library.  You almost always
+want to do that for a good clean library.
+@item SHR,NOWRT
+means shared-read-only.  Which is the default for code, and is also good
+for efficiency of some data structures.
+@item NOSHR,LCL
+is what you want for everything else.
+@end table
+
+Note: If you do not have a handy list of all these toplevel variables,
+do not dispair.  Just do your link with the /MAP=LISPRTL.MAP/FULL
+and then search the map file,
+
+@format
+@t{$SEARCH/OUT=LISPRTL.LOSERS LISPRTL.MAP  ",  SHR,NOEXE,  RD,  WRT"}
+@end format
+
+And use an emacs keyboard macro to muck the result into the proper form.
+Of course only the programmer can tell if things can be made read-only.
+I have a DCL command procedure to do this if you want it.
+
+@item
+@noindent
+Now MAIN.EXE would be linked thusly:
+
+@format
+@t{$ DEFINE LISPRTL USER$DISK:[JAFFER]LISPRTL.EXE
+
+$LINK MAIN.OBJ,SYS$INPUT:/OPT
+ SYS$LIBRARY:VAXCRTL/SHARE
+ LISPRTL/SHARE}
+@end format
+
+Note the definition of the @code{LISPRTL} logical name.  Without such a
+definition you will need to copy @file{LISPRTL.EXE} over to
+@file{SYS$SHARE:} (aka @file{SYS$LIBRARY:}) in order to invoke the main
+program once it is linked.
+
+@item
+Now say you have a file of optional subrs, @file{MYSUBRS.C}.  And there
+is a routine @code{INIT_MYSUBRS} that must be called before using it.
+
+@format
+@t{$ CC MYSUBRS.C
+$ LINK/SHARE=MYSUBRS.EXE MYSUBRS.OBJ,SYS$INPUT:/OPT
+  SYS$LIBRARY:VAXCRTL/SHARE
+  LISPRTL/SHARE
+  UNIVERSAL=INIT_MYSUBRS}
+@end format
+
+Ok.  Another hint is that you can avoid having to add the @code{PSECT}
+declaration of @code{NOSHR,LCL} by declaring variables @code{status} in
+the C language source.  That works great for most things.
+
+@item
+Then the dynamic loader would have to do this:
+
+@format
+@t{@{void (*init_fcn)();
+ long retval;
+ retval = lib$find_image_symbol("MYSUBRS","INIT_MYSUBRS",&init_fcn,
+                                "SYS$DISK:[].EXE");
+ if (retval != SS$_NORMAL) error(@dots{});
+ (*init_fcn)();@}}
+@end format
+
+But of course all string arguments must be @code{(struct dsc$descriptor
+*)} and the last argument is optional if @code{MYSUBRS} is defined as a
+logical name or if @file{MYSUBRS.EXE} has been copied over to
+@file{SYS$SHARE}.  The other consideration is that you will want to turn
+off @key{C-c} or other interrupt handling while you are inside most
+@code{lib$} calls.
+
+As far as the generation of all the @code{UNIVERSAL=@dots{}}
+declarations.  Well, you could do well to have that automatically
+generated from the public @file{LISPRTL.H} file, of course.
+
+VMS has a good manual called the @cite{Guide to Writing Modular
+Procedures} or something like that, which covers this whole area rather
+well, and also talks about advanced techniques, such as a way to declare
+a program section with a pointer to a procedure that will be
+automatically invoked whenever any shared image is dynamically
+activated.  Also, how to set up a handler for normal or abnormal program
+exit so that you can clean up side effects (such as opening a database).
+But for use with @code{LISPRTL} you probably don't need that hair.
+
+One fancier option that is useful under VMS for @file{LISPLIB.EXE} is to
+define all your exported procedures through an @dfn{call vector} instead
+of having them just be pointers into random places in the image, which
+is what you get by using @code{UNIVERSAL}.
+
+If you set up the call vector thing correctly it will allow you to
+modify and relink @file{LISPLIB.EXE} without having to relink programs
+that have been linked against it.
+@end enumerate
+
+@subsubheading Windows NT
+@noindent
+George Carrette (gjc@@mitech.com) outlines how to dynamically link on
+Windows NT:
+
+@itemize @bullet
+@item
+The Software Developers Kit has a sample called SIMPLDLL.
+Here is the gist of it, following along the lines of the VMS description
+above (contents of a makefile for the SDK NMAKE)
+
+@format
+@t{LISPLIB.exp:
+LISPLIB.lib: LISPLIB.def
+    $(implib) -machine:$(CPU) -def:LISPLIB.def -out:LISPLIB.lib
+
+LISPLIB.DLL : $(LISPLIB_OBJS) LISPLIB.EXP
+    $(link) $(linkdebug)              \
+    -dll                 \
+    -out:LISPLIB.DLL     \
+    LISPLIB.EXP $(LISPLIB_OBJS) $(conlibsdll)}
+@end format
+
+@item
+The @file{LISPDEF.DEF} file has this:
+
+@format
+@t{LIBRARY lisplib
+EXPORT
+ init_lisp
+ init_repl}
+@end format
+
+@item
+And @file{MAIN.EXE} using:
+
+@format
+@t{CLINK = $(link) $(ldebug) $(conflags) -out:$*.exe $** $(conlibsdll)
+
+MAIN.EXE : MAIN.OBJ LISPLIB.LIB
+ $(CLINK)}
+@end format
+
+@item
+And @file{MYSUBRS.DLL} is produced using:
+
+@format
+@t{mysubrs.exp:
+mysubrs.lib: mysubrs.def
+    $(implib) -machine:$(CPU) -def:MYSUBRS.def -out:MYSUBRS.lib
+
+mysubrs.dll : mysubrs.obj mysubrs.exp mysubrs.lib
+    $(link) $(linkdebug) \
+    -dll                 \
+    -out:mysubrs.dll     \
+    MYSUBRS.OBJ MYSUBRS.EXP LISPLIB.LIB $(conlibsdll)}
+@end format
+
+@item
+Where @file{MYSUBRS.DEF} has
+
+@format
+@t{LIBRARY mysubrs
+EXPORT
+ INIT_MYSUBRS}
+@end format
+
+@item
+And the dynamic loader looks something like this, calling the two
+procedures @code{LoadLibrary} and @code{GetProcAddress}.
+
+@format
+@t{LISP share_image_load(LISP fname)
+@{long iflag;
+ LISP retval,(*fcn)(void);
+ HANDLE hLib;
+ DWORD err;
+ char *libname,fcnname[64];
+ iflag = nointerrupt(1);
+ libname = c_string(fname);
+ _snprintf(fcnname,sizeof(fcnname),"INIT_%s",libname);
+ if (!(hLib = LoadLibrary(libname)))
+   @{err = GetLastError();
+    retval = list2(fname,LSPNUM(err));
+    serror1("library failed to load",retval);@}
+ if (!(fcn = (LISP (*)(void)) GetProcAddress(hLib,fcnname)))
+   @{err = GetLastError();
+    retval = list2(fname,LSPNUM(err));
+    serror1("could not find library init procedure",retval);@}
+ retval = (*fcn)();
+ nointerrupt(iflag);
+ return(retval);@}}
+@end format
+
+@item
+@emph{Note:} in VMS the linker and dynamic loader is case sensitive, but
+all the language compilers, including C, will by default upper-case
+external symbols for use by the linker, although the debugger gets its
+own symbols and case sensitivity is language mode dependant.  In Windows
+NT things are case sensitive generally except for file and device names,
+which are case canonicalizing like in the Symbolics filesystem.
+
+@item
+@emph{Also:} All this WINDOWS NT stuff will work in MS-DOS MS-Windows
+3.1 too, by a method of compiling and linking under Windows NT, and then
+copying various files over to MS-DOS/WINDOWS.
+@end itemize
+
+
+@node Procedure and Macro Index, Variable Index, The Implementation, Top
+@unnumbered Procedure and Macro Index
+
+This is an alphabetical list of all the procedures and macros in SCM.
+
+@printindex fn
+
+@node Variable Index, Type Index, Procedure and Macro Index, Top
+@unnumbered Variable Index
+
+This is an alphabetical list of all the global variables in SCM.
+
+@printindex vr
+
+@node Type Index,  , Variable Index, Top
+@unnumbered Type Index
+
+This is an alphabetical list of all the data types in SCM.
+
+@printindex tp
+
+@contents
+@bye
diff --git a/scm4e3.scmconfig.patch b/scm4e3.scmconfig.patch
new file mode 100644
index 0000000..ff7dc48
--- /dev/null
+++ b/scm4e3.scmconfig.patch
@@ -0,0 +1,60 @@
+diff -c temp/scm/findexec.c temp/nscm/findexec.c
+*** temp/scm/findexec.c	Sun Mar 17 23:16:26 1996
+--- temp/nscm/findexec.c	Thu Mar 21 08:51:27 1996
+***************
+*** 37,46 ****
+     filename.  A new copy of the complete path name of that file is
+     returned.  This new string may be disposed by free() later on.  */
+  
+  #include <sys/file.h>
+  #include <sys/param.h>
+! #include <strings.h>
+! #ifdef linux
+  # include <stdlib.h>
+  # include <sys/stat.h>
+  # include <unistd.h>     /* for X_OK define */
+--- 37,47 ----
+     filename.  A new copy of the complete path name of that file is
+     returned.  This new string may be disposed by free() later on.  */
+  
++ #include "scm.h"
++ 
+  #include <sys/file.h>
+  #include <sys/param.h>
+! #if defined(linux) || defined(__svr4__)
+  # include <stdlib.h>
+  # include <sys/stat.h>
+  # include <unistd.h>     /* for X_OK define */
+***************
+*** 116,122 ****
+      if (*p) p++;
+  
+      if (name[0] == '.' && name[1] == 0)
+!       getwd(name);
+  
+      else if (name[0]=='~' && name[1]==0 && getenv("HOME"))
+        strcpy(name, getenv("HOME"));
+--- 117,123 ----
+      if (*p) p++;
+  
+      if (name[0] == '.' && name[1] == 0)
+!       getcwd(name, MAXPATHLEN);
+  
+      else if (name[0]=='~' && name[1]==0 && getenv("HOME"))
+        strcpy(name, getenv("HOME"));
+diff -c temp/scm/scmfig.h temp/nscm/scmfig.h
+*** temp/scm/scmfig.h	Fri Sep 22 22:29:00 1995
+--- temp/nscm/scmfig.h	Wed Mar 20 23:47:15 1996
+***************
+*** 50,55 ****
+--- 50,59 ----
+  #  include <strings.h>
+  # endif
+  
++ # ifndef HAVE_GETCWD
++ #  define getcwd(S,L) getwd(S)
++ # endif
++ 
+  #else /* HAVE_CONFIG_H */
+  
+  # ifdef sequent
diff --git a/scmconfig.h.in b/scmconfig.h.in
new file mode 100644
index 0000000..5fb6d27
--- /dev/null
+++ b/scmconfig.h.in
@@ -0,0 +1,69 @@
+/* scmconfig.h.in.  Generated automatically from configure.in by autoheader.  */
+
+/* Define if on AIX 3.
+   System headers sometimes define this.
+   We just want to avoid a redefinition error message.  */
+#ifndef _ALL_SOURCE
+#undef _ALL_SOURCE
+#endif
+
+/* Define to empty if the keyword does not work.  */
+#undef const
+
+/* Define if on MINIX.  */
+#undef _MINIX
+
+/* Define if your C compiler doesn't accept -c and -o together.  */
+#undef NO_MINUS_C_MINUS_O
+
+/* Define if the system does not provide POSIX.1 features except
+   with this defined.  */
+#undef _POSIX_1_SOURCE
+
+/* Define if you need to in order for stat and other things to work.  */
+#undef _POSIX_SOURCE
+
+/* Define as the return type of signal handlers (int or void).  */
+#undef RETSIGTYPE
+
+/* Define if you have the ANSI C header files.  */
+#undef STDC_HEADERS
+
+/* Define if you can safely include both <sys/time.h> and <time.h>.  */
+#undef TIME_WITH_SYS_TIME
+
+/* Define if you have ftime.  */
+#undef HAVE_FTIME
+
+/* Define if you have getcwd.  */
+#undef HAVE_GETCWD
+
+/* Define if you have times.  */
+#undef HAVE_TIMES
+
+/* Define if you have the <limits.h> header file.  */
+#undef HAVE_LIMITS_H
+
+/* Define if you have the <memory.h> header file.  */
+#undef HAVE_MEMORY_H
+
+/* Define if you have the <string.h> header file.  */
+#undef HAVE_STRING_H
+
+/* Define if you have the <sys/time.h> header file.  */
+#undef HAVE_SYS_TIME_H
+
+/* Define if you have the <sys/timeb.h> header file.  */
+#undef HAVE_SYS_TIMEB_H
+
+/* Define if you have the <sys/times.h> header file.  */
+#undef HAVE_SYS_TIMES_H
+
+/* Define if you have the <sys/types.h> header file.  */
+#undef HAVE_SYS_TYPES_H
+
+/* Define if you have the <time.h> header file.  */
+#undef HAVE_TIME_H
+
+/* Define if you have the <unistd.h> header file.  */
+#undef HAVE_UNISTD_H
diff --git a/scmfig.h b/scmfig.h
new file mode 100644
index 0000000..ba95450
--- /dev/null
+++ b/scmfig.h
@@ -0,0 +1,671 @@
+/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  
+ */
+
+/* "scmfig.h" system-dependent configuration.
+   Author: Aubrey Jaffer */
+
+#ifdef HAVE_CONFIG_H
+# include "scmconfig.h"
+# ifdef HAVE_STRING_H
+#  include <string.h>
+# else
+#  include <strings.h>
+# endif
+
+# ifndef HAVE_GETCWD
+#  define getcwd(S,L) getwd(S)
+# endif
+
+#else /* HAVE_CONFIG_H */
+
+# ifdef sequent
+#  include <strings.h>
+#  define strchr index
+#  define strrchr rindex
+# else
+#  include <string.h>
+# endif
+
+# include "scmflags.h"		/* user specified, system independent flags */
+
+/* IMPLINIT is the full pathname (surrounded by double quotes) of
+   Init.scm, the Scheme initialization code.  This is best defined in
+   the makefile, if possible.  If available, scm uses the value of
+   environment variable SCM_INIT_PATH instead of IMPLINIT. */
+
+/* #define IMPLINIT "/usr/jaffer/scm/Init.scm" */
+
+/* INITS is calls to initialization routines for any compiled
+   libraries being linked into scm.  This is best done in the makefile.
+File:	INITS line:		functions defined:
+
+sc2.c	init_sc2();	substring-move-left!, substring-move-right!,
+			substring-fill!, append!, and last-pair
+rgx.c	init_rgx();	regcomp and regexec. */
+
+/* #define INITS init_sc2(); */
+
+/* #define SICP */
+
+/* setbuf(0) needs to be done for tty ports in order for CHAR-READY?
+   to work.  This can cause problems under MSDOS and other systems. */
+
+/* #define NOSETBUF */
+
+/* #define RECKLESS */
+
+/* #define CAUTIOUS */
+
+/* #define STACK_LIMIT (HEAP_SEG_SIZE/2) */
+
+/* #define BIGNUMS */
+
+/* #define ARRAYS */
+
+/* #define FLOATS */
+
+/* Define SINGLES if you want single precision floats and
+   (sizeof(float)==sizeof(long)) */
+
+# ifdef FLOATS
+#  define SINGLES
+# endif
+
+/* #define SINGLESONLY */
+
+/* Define CDR_DOUBLES if (sizeof(double)==sizeof(long)), i.e.
+   a `single' is really a double. */
+# ifdef FLOATS
+#  ifdef __alpha
+#   define CDR_DOUBLES
+#  endif
+
+#  ifdef _UNICOS          /* doubles are no better than singles on Cray. */
+#   define SINGLESONLY
+#  endif
+
+#  ifdef CDR_DOUBLES
+#   define SINGLES
+#   define SINGLESONLY
+#  endif
+# endif
+
+/* #define ENGNOT */
+
+/* Define SUN_DL to configure code in "dynl.c" so that dynamic linking
+   is done using the SUN dynamic linking library "dl". */
+
+/* #define SUN_DL */
+
+/* Define DLD to configure code in "dynl.c" so that dynamic linking is
+   done using the "dld" library.  DLD is ported to Linux, VAX
+   (Ultrix), Sun 3 (SunOS 3.4 and 4.0), SPARCstation (SunOS 4.0),
+   Sequent Symmetry (Dynix), and Atari ST.  See scm/README or
+   scm/ANNOUNCE for ftp sites offering dld. */
+
+/* #define DLD */
+
+/* Define HAVE_DYNL if dynamic linking is available */
+
+# ifdef DLD
+#  define HAVE_DYNL
+# endif
+# ifdef SUN_DL
+#  define HAVE_DYNL
+# endif
+# ifdef HP_SHL
+#  define HAVE_DYNL
+# endif
+
+# ifdef HAVE_DYNL
+#  define CCLO
+# endif
+
+/* Define GC_FREE_SEGMENTS if you want segments of unused heap to
+   be freed up after garbage collection.  Don't define it if you
+   never want the heap to shrink. */
+
+# ifndef DONT_GC_FREE_SEGMENTS
+#  define GC_FREE_SEGMENTS
+# endif
+
+/* MEMOIZE_LOCALS will speed up most local variable references.  You
+   will need to remove this and recompile eval.c if you use very large or
+   deep environments (more than 4095 bound variables in one procedure)*/
+
+# define MEMOIZE_LOCALS
+
+/* #define CHEAP_CONTINUATIONS */
+
+/* #define TICKS */
+
+/* PROT386 should be defined on the compilation command line if the
+   program is to be run on an intel 386 in protected mode.  `Huge'
+   pointers common on MSDOS compilers do not work in protected mode.
+   PROT386 is required if scm is to run as part of a Microsoft Windows
+   application.  Added by Stephen Adams 8 May 92 */
+
+/* #define PROT386 */
+
+/* #define NON_PREEMPTIVE and RTL if you are using an non-preemptive
+   operating system in which periodic polling for interrupts is
+   necessary.  Provide your own main procedure (e.g., WinMain, in
+   Windows).  Define and initialize unsigned int poll_count, and
+   provide a procedure named poll_routine(), which POLL calls each
+   time poll_count reaches zero.  poll_routine() must reinitialize
+   poll_count.  It may also check for external actions, such as
+   Windows messages.  The value assigned to poll_count can be quite
+   large, e.g., 1000, while still maintaining good response time. */
+
+/* #define CAREFUL_INTS */
+
+/* STDC_HEADERS indicates that the include file names are the same as
+   ANSI C.  For most modern systems this is the case. */
+
+/* added by Yasuaki Honda */
+# ifdef THINK_C
+#  define __STDC__
+# endif
+
+# ifdef __STDC__
+#  ifndef __HIGHC__		/* overly fussy compiler */
+#   define USE_ANSI_PROTOTYPES
+#  endif
+#  ifndef __GNUC__
+#   define STDC_HEADERS
+#  else
+#   ifdef sparc
+#    ifdef SVR4
+#     define STDC_HEADERS
+#    endif
+#   else
+#    ifndef tahoe
+#     ifndef sun
+#      define STDC_HEADERS
+#     endif
+#    endif
+#   endif
+#  endif
+# endif
+# ifdef MSDOS			/* Microsoft C 5.10 and 6.00A */
+#  ifndef GO32
+#   define SHORT_INT
+#  endif
+# endif
+# ifdef _QC
+#  define SHORT_INT
+# endif
+# ifdef __TURBOC__
+#  define SHORT_INT
+#  ifndef __TOS__
+#   define MSDOS
+#  endif
+# endif
+# ifdef _WIN32
+#  define MSDOS
+#  define LACK_TIMES
+# endif
+# ifdef _MSDOS
+#  define MSDOS
+# endif
+# ifdef MSDOS
+#  define STDC_HEADERS
+# endif
+# ifdef vms
+#  define STDC_HEADERS
+# endif
+# ifdef nosve
+#  define STDC_HEADERS
+# endif
+
+# ifdef linux
+#  define HAVE_SELECT
+#  define HAVE_SYS_TIME_H
+#  undef STDC_HEADERS
+# endif
+
+# ifdef _UNICOS
+#  define STDC_HEADERS
+# endif
+
+# ifdef _AIX
+#  define _POSIX_SOURCE
+#  define LACK_FTIME
+# endif
+
+# ifdef __sgi__
+#  define LACK_FTIME
+#  define STDC_HEADERS
+#  define USE_ANSI_PROTOTYPES
+#  define HAVE_SELECT
+#  define HAVE_SYS_TIME_H
+#  define __svr4__
+# endif
+
+# ifdef hpux
+#  define LACK_E_IDs
+# endif
+
+/* C-Set++ for OS/2 */
+# ifdef __IBMC__
+#  define STDC_HEADERS
+#  define LACK_TIMES
+# endif
+
+#endif /* HAVE_CONFIG_H */
+
+/* PROMPT is the prompt string printed at top level */
+
+#ifndef PROMPT
+# ifdef SICP
+#  define PROMPT "==> "
+# else
+#  define PROMPT "> "
+# endif
+#endif
+
+/* #define BRACKETS_AS_PARENS to have [ and ] be read as ( and ) in forms. */
+
+/* #define BRACKETS_AS_PARENS */
+
+/* LINE_INCREMENTORS are the characters which cause the line count to
+   be incremented for the purposes of error reporting.  This feature
+   is only used for scheme code loaded from files.
+
+   WHITE_SPACES are other characters which should be treated like spaces
+   in programs.  in both cases sparate characters with ":case " */
+
+#define LINE_INCREMENTORS  '\n'
+#ifdef MSDOS
+# define WHITE_SPACES  ' ':case '\t':case '\r':case '\f':case 26
+#else
+# define WHITE_SPACES  ' ':case '\t':case '\r':case '\f'
+#endif
+
+/* NUM_HASH_BUCKETS is the number of symbol hash table buckets.  */
+
+#define NUM_HASH_BUCKETS 137
+
+/* If fewer than MIN_GC_YIELD cells are recovered during a garbage
+   collection (GC) more space is allocated for the heap. */
+
+#define MIN_GC_YIELD (heap_size/4)
+
+/* Define BIGDIG to an integer type whose size is smaller than long if
+   you want bignums.  BIGRAD is one greater than the biggest BIGDIG. */
+/* Define DIGSTOOBIG if the digits equivalent to a long won't fit in a long. */
+#ifdef BIGNUMS
+# ifdef _UNICOS
+#  define DIGSTOOBIG
+#  if (1L << 31) <= USHRT_MAX
+#   define BIGDIG unsigned short
+#  else
+#   define BIGDIG unsigned int
+#  endif
+#  define BITSPERDIG 32
+# else
+#  define BIGDIG unsigned short
+#  define BITSPERDIG (sizeof(BIGDIG)*CHAR_BIT)
+# endif
+# define BIGRAD (1L << BITSPERDIG)
+# define DIGSPERLONG ((sizet)((sizeof(long)*CHAR_BIT+BITSPERDIG-1)/BITSPERDIG))
+# define BIGUP(x) ((unsigned long)(x) << BITSPERDIG)
+# define BIGDN(x) ((x) >> BITSPERDIG)
+# define BIGLO(x) ((x) & (BIGRAD-1))
+#endif
+
+#ifndef BIGDIG
+# ifndef FLOATS
+#  define INUMS_ONLY
+# endif
+#endif
+
+#ifdef NON_PREEMPTIVE
+# define DEFER_INTS /**/
+# ifdef TICKS
+#  define POLL {if (0==poll_count--) poll_routine(); \
+	      if (0==tick_count--) tick_signal();}
+# else
+#  define POLL {if (0==poll_count--) poll_routine();}
+# endif
+# define CHECK_INTS POLL
+# define ALLOW_INTS POLL
+#else
+# ifdef CAREFUL_INTS
+#  define DEFER_INTS {if (ints_disabled) \
+		      fputs("ints already disabled\n", stderr); \
+			ints_disabled = 1;}
+#  define ALLOW_INTS {if (!ints_disabled) \
+		      fputs("ints already enabled\n", stderr); \
+			ints_disabled = 0;CHECK_INTS}
+# else
+#  define DEFER_INTS {ints_disabled = 1;}
+#  define ALLOW_INTS {ints_disabled = 0;CHECK_INTS}
+# endif
+# ifdef TICKS
+#  define CHECK_INTS {if (sig_deferred) han_sig();if (alrm_deferred) han_alrm();\
+		    POLL;}
+#  define POLL {if (0==tick_count--) tick_signal();}
+# else
+#  define CHECK_INTS {if (sig_deferred) han_sig();if (alrm_deferred) han_alrm();}
+#  define POLL /**/
+# endif
+#endif
+
+#ifdef STACK_LIMIT
+# define CHECK_STACK {stack_check();}
+#else
+# define CHECK_STACK /**/
+#endif
+
+/* Cray machines have pointers that are incremented once for each word,
+   rather than each byte, the 3 most significant bits encode the byte
+   within the word.  The following macros deal with this by storing the
+   native Cray pointers like the ones that looks like scm expects.  This
+   is done for any pointers that might appear in the car of a cell, pointers
+   to vector elts, functions, &c are not munged.  */
+#ifdef _UNICOS
+# define SCM2PTR(x) ((int)(x) >> 3)
+# define PTR2SCM(x) (((SCM)(x)) << 3)
+# define POINTERS_MUNGED
+#else
+# define SCM2PTR(x) (x)
+# define PTR2SCM(x) ((SCM)(x))
+#endif
+
+/* FIXABLE is non-null if its long argument can be encoded in an INUM. */
+
+#define POSFIXABLE(n) ((n) <= MOST_POSITIVE_FIXNUM)
+#define NEGFIXABLE(n) ((n) >= MOST_NEGATIVE_FIXNUM)
+#define UNEGFIXABLE(n) ((n) <= -MOST_NEGATIVE_FIXNUM)
+#define FIXABLE(n) (POSFIXABLE(n) && NEGFIXABLE(n))
+
+/* The following 8 definitions are defined automatically by the C
+   pre-processor.  You will need to override these if you are
+   cross-compiling or if the C pre-processor has different properties
+   than the compiler. */
+
+#if (((-1)%2==-1) && ((-1)%(-2)==-1) && (1%2==1) && (1%(-2)==1))
+#else
+# define BADIVSGNS
+#endif
+
+/* SRS is signed right shift */
+/*--- Turbo C++ v1.0 has a bug with right shifts of signed longs!
+      It is believed to be fixed in Turbo C++ v1.01		---*/
+#if (-1==(((-1)<<2)+2)>>2) && (__TURBOC__ != 0x295)
+# define SRS(x, y) ((x)>>y)
+# ifdef __TURBOC__
+#  define INUM(x) (((x)>>1)>>1)
+# else
+#  define INUM(x) SRS(x, 2)
+# endif
+#else
+# define SRS(x, y) (((x)<0) ? ~((~(x))>>y) : (x)>>y)
+# define INUM(x) SRS(x, 2)
+#endif
+
+#ifdef __TURBOC__
+/* shifts of more than one are done by a library call, single shifts are
+   performed in registers */
+# define MAKINUM(x) ((((x)<<1)<<1)+2L)
+#else
+# define MAKINUM(x) (((x)<<2)+2L)
+#endif
+
+#ifdef _DCC
+# define ASCII
+#else
+# if (('\n'=='\025') && (' '=='\100') && ('a'=='\201') && ('A'=='\301'))
+#  define EBCDIC
+# endif
+# if (('\n'=='\012') && (' '=='\040') && ('a'=='\141') && ('A'=='\101'))
+#  define ASCII
+# endif
+#endif
+
+/* CHAR_CODE_LIMIT is the number of distinct characters represented by
+   the unsigned char datatype. */
+/* MOST_POSITIVE_FIXNUM is the INUM closest to positive infinity. */
+/* MOST_NEGATIVE_FIXNUM is the INUM closest to negative infinity. */
+
+#ifdef __STDC__
+# define HAVE_LIMITSH
+#endif
+#ifdef MWC
+# define HAVE_LIMITSH
+#endif
+
+#ifdef HAVE_LIMITSH
+# include <limits.h>
+# ifdef UCHAR_MAX
+#  define CHAR_CODE_LIMIT (UCHAR_MAX+1L)
+# else
+#  define CHAR_CODE_LIMIT 256L
+# endif
+# define MOST_POSITIVE_FIXNUM (LONG_MAX>>2)
+# ifdef _UNICOS			/* Stupid cray bug */
+#  define MOST_NEGATIVE_FIXNUM ((long)LONG_MIN/4)
+# else
+#  define MOST_NEGATIVE_FIXNUM SRS((long)LONG_MIN, 2)
+# endif				/* UNICOS */
+#else
+# define CHAR_CODE_LIMIT 256L
+# define MOST_POSITIVE_FIXNUM ((long)((unsigned long)~0L>>3))
+# if (0 != ~0)
+#  define MOST_NEGATIVE_FIXNUM (-MOST_POSITIVE_FIXNUM-1)
+# else
+#  define MOST_NEGATIVE_FIXNUM (-MOST_POSITIVE_FIXNUM)
+# endif
+#endif
+
+/* INTBUFLEN is the maximum number of characters neccessary for the
+   printed or string representation of an exact number. */
+
+#ifndef CHAR_BIT
+# define CHAR_BIT 8
+#endif
+#ifndef LONG_BIT
+# define LONG_BIT (CHAR_BIT*sizeof(long)/sizeof(char))
+#endif
+#define INTBUFLEN (5+LONG_BIT)
+
+/* FLOBUFLEN is the maximum number of characters neccessary for the
+   printed or string representation of an inexact number. */
+
+#ifdef FLOATS
+# define FLOBUFLEN (10+2*(sizeof(double)/sizeof(char)*CHAR_BIT*3+9)/10)
+#endif /* FLOATS */
+
+/* MAXEXP is the maximum double precision expontent */
+/* FLTMAX is less than or equal the largest single precision float */
+
+#ifdef FLOATS
+# ifdef STDC_HEADERS
+#  ifndef GO32
+#   include <float.h>
+#  endif
+# endif
+# ifdef DBL_MAX_10_EXP
+#  define MAXEXP DBL_MAX_10_EXP
+# else
+#  define MAXEXP 308   /* IEEE doubles */
+# endif
+# ifdef FLT_MAX
+#  define FLTMAX FLT_MAX
+# else
+#  define FLTMAX 1e+23
+# endif
+#endif
+
+/* Only some machines have pipes */
+#ifdef _IBMR2
+# define unix
+# define STDC_HEADERS
+#endif
+#ifdef unix
+  /* DJGPP (gcc for i386) defines unix! */
+# ifndef GO32
+#  define HAVE_PIPE
+# endif
+#endif
+
+/* IS_INF tests its floating point number for infiniteness */
+
+#ifndef IS_INF
+# define IS_INF(x) ((x)==(x)/2)
+#endif
+
+#ifndef THINK_C
+# ifdef __WINDOWS__		/* there should be a better flag for this. */
+#  define PROT386
+# endif
+#endif
+
+/* PTR_LT defines how to compare two CELLPTRs (which may not be in the
+   same array).  CELLPTR is a pointer to a cons cell which may be
+   compared or differenced.  SCMPTR is used for stack bounds. */
+
+#if defined(__TURBOC__) && !defined(__TOS__)
+# ifdef PROT386
+typedef cell *CELLPTR;
+typedef SCM *SCMPTR;
+#  define PTR_LT(x, y) (((long)(x)) < ((long)(y)))
+# else
+typedef cell huge *CELLPTR;
+typedef SCM  huge *SCMPTR;
+#  define PTR_LT(x, y) ((x) < (y))
+# endif
+#else /* not __TURBOC__ */
+typedef cell *CELLPTR;
+typedef SCM  *SCMPTR;
+# ifdef nosve
+#  define PTR_MASK 0xffffffffffff
+#  define PTR_LT(x, y) (((int)(x)&PTR_MASK) < ((int)(y)&PTR_MASK))
+# else
+#  define PTR_LT(x, y) ((x) < (y))
+# endif
+#endif
+
+#ifdef STDC_HEADERS
+# include <stdlib.h>
+# ifdef AMIGA
+#  include <stddef.h>
+# endif
+# define sizet size_t
+#else
+# ifdef _SIZE_T
+#  define sizet size_t
+# else
+#  define sizet unsigned int
+# endif
+#endif
+
+/* On VMS, GNU C's errno.h contains a special hack to get link attributes
+   for errno correct for linking to the C RTL. */
+
+#include <errno.h>
+
+/* SYSCALL retries system calls that have been interrupted (EINTR) */
+#ifdef vms
+# ifndef __GNUC__
+#  include <ssdef.h>
+#  define SYSCALL(line) do{errno = 0;line} \
+	while(EVMSERR==errno && (vaxc$errno>>3)==(SS$_CONTROLC>>3))
+# endif
+#endif
+
+#ifndef SYSCALL
+# ifdef EINTR
+#  if (EINTR > 0)
+#   define SYSCALL(line) do{errno = 0;line}while(EINTR==errno)
+#  endif
+# endif
+#endif
+
+#ifndef SYSCALL
+# define SYSCALL(line) {line}
+#endif
+
+#ifndef MSDOS
+# ifdef ARM_ULIB
+    extern volatile int errno;
+# else
+    extern int errno;
+# endif
+#endif
+#ifdef __TURBOC__
+# if (__TURBOC__==1)
+ /* Needed for TURBOC V1.0 */
+ extern int errno;
+# endif
+#endif
+
+/* EXIT_SUCCESS is the default code to return from SCM if no errors
+   were encountered.  EXIT_FAILURE is the default code to return from
+   SCM if errors were encountered.  The return code can be explicitly
+   specified in a SCM program with (quit <n>). */
+
+#ifndef EXIT_SUCCESS
+# ifdef vms
+#  define EXIT_SUCCESS 1
+# else
+#  define EXIT_SUCCESS 0
+# endif
+#endif
+#ifndef EXIT_FAILURE
+# ifdef vms
+#  define EXIT_FAILURE 2
+# else
+#  define EXIT_FAILURE 1
+# endif
+#endif
+
+/* Yasuaki Honda */
+/* Think C lacks isascii macro */
+#ifdef THINK_C
+# define isascii(c) ((unsigned)(c) <= 0x7f)
+#endif
+#ifdef _DCC
+# define isascii(c) ((unsigned)(c) <= 0x7f)
+#endif
+
+/* end of automatic C pre-processor definitions */
diff --git a/setjump.h b/setjump.h
new file mode 100644
index 0000000..eb7e90b
--- /dev/null
+++ b/setjump.h
@@ -0,0 +1,122 @@
+/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  
+ */
+
+/* "setjump.h" memory and stack parameters.
+   Author: Aubrey Jaffer */
+
+/* CELL_UP and CELL_DN are used by init_heap_seg to find cell aligned inner
+   bounds for allocated storage */
+
+#ifdef PROT386
+/*in 386 protected mode we must only adjust the offset */
+#define CELL_UP(p) MK_FP(FP_SEG(p), ~7&(FP_OFF(p)+7))
+#define CELL_DN(p) MK_FP(FP_SEG(p), ~7&FP_OFF(p))
+#else
+#ifdef _UNICOS
+#define CELL_UP(p) (CELLPTR)(~1L & ((long)(p)+1L))
+#define CELL_DN(p) (CELLPTR)(~1L & (long)(p))
+#else
+#define CELL_UP(p) (CELLPTR)(~(sizeof(cell)-1L) & ((long)(p)+sizeof(cell)-1L))
+#define CELL_DN(p) (CELLPTR)(~(sizeof(cell)-1L) & (long)(p))
+#endif				/* UNICOS */
+#endif				/* PROT386 */
+
+/* These are parameters for controlling memory allocation.  The heap
+   is the area out of which cons and object headers is allocated.
+   Each heap object is 8 bytes on a 32 bit machine and 16 bytes on a
+   64 bit machine.  The units of the _SIZE parameters are bytes.
+
+   INIT_HEAP_SIZE is the initial size of heap.  If this much heap is
+   allocated initially the heap will grow by half its current size
+   each subsequent time more heap is needed.
+
+   If INIT_HEAP_SIZE heap cannot be allocated initially, HEAP_SEG_SIZE
+   will be used, and the heap will grow by HEAP_SEG_SIZE when more
+   heap is needed.  HEAP_SEG_SIZE must fit into type sizet.  This code
+   is in init_storage() and alloc_some_heap() in sys.c
+
+   If INIT_HEAP_SIZE can be allocated initially, the heap will grow by
+   EXPHEAP(heap_size) when more heap is needed.
+
+   MIN_HEAP_SEG_SIZE is minimum size of heap to accept when more heap
+   is needed.
+
+   INIT_MALLOC_LIMIT is the initial amount of malloc usage which will
+   trigger a GC. */
+
+#define INIT_HEAP_SIZE (25000L*sizeof(cell))
+#define MIN_HEAP_SEG_SIZE (2000L*sizeof(cell))
+#ifdef _QC
+#define HEAP_SEG_SIZE 32400L
+#else
+#ifdef sequent
+#define HEAP_SEG_SIZE (7000L*sizeof(cell))
+#else
+#define HEAP_SEG_SIZE (8100L*sizeof(cell))
+#endif
+#endif
+#define EXPHEAP(heap_size) (heap_size*2)
+#define INIT_MALLOC_LIMIT 100000
+
+#ifdef IN_CONTINUE_C
+# include "scm.h"
+# define malloc(size) must_malloc((long)(size), s_cont)
+# define free(obj) must_free((char *)(obj))
+#endif
+
+/* other.dynenv and other.parent get GCed just by being there.  */
+struct scm_other {SCM dynenv;
+		  SCM parent;
+#ifdef CAUTIOUS
+		  SCM stack_trace;
+#endif
+		};
+#define CONTINUATION_OTHER struct scm_other
+#define CONT(x) ((CONTINUATION *)CDR(x))
+#define SETCONT SETCDR
+void dowinds P((SCM to, long delta));
+
+#include "continue.h"
+
+/* See scm.h for definition of P */
+void  mark_locations P((STACKITEM x [], sizet n ));
+void	scm_dynthrow P((CONTINUATION *cont, SCM val));
+#define s_cont (ISYMCHARS(IM_CONT)+20)
diff --git a/setjump.mar b/setjump.mar
new file mode 100644
index 0000000..2b49243
--- /dev/null
+++ b/setjump.mar
@@ -0,0 +1,38 @@
+        .title setjump and longjump
+;       The VAX C runtime library uses the $unwind utility for implementing
+;       longjmp.  That fails if your program do not follow normal
+;       stack decipline.  This is a dirty implementation of setjmp
+;       and longjmp that does not have that problem.
+;       the names longjmp and setjmp are avoided so that the code can be linked
+;       with the vax c runtime library without name clashes.
+
+;	This code was contributed by an anonymous reviewer from
+;	comp.sources.reviewed.
+
+        .entry  setjump,^M<IV>
+        movl    4(ap),r0
+        movq    r2,(r0)+
+        movq    r4,(r0)+
+        movq    r6,(r0)+
+        movq    r8,(r0)+
+        movq    r10,(r0)+
+        movl    fp,(r0)+
+        movo    4(fp),(r0)+
+        movq    20(fp),(r0)
+        clrl    r0
+        ret
+
+        .entry  longjump,^M<IV>
+        movl    4(ap),r0
+        movq    (r0)+,r2
+        movq    (r0)+,r4
+        movq    (r0)+,r6
+        movq    (r0)+,r8
+        movq    (r0)+,r10
+        movl    (r0)+,r1
+        movo    (r0)+,4(r1)
+        movq    (r0),20(r1)
+        movl    8(ap),r0
+        movl    r1,fp
+        ret
+        .end
diff --git a/setjump.s b/setjump.s
new file mode 100644
index 0000000..b96fb05
--- /dev/null
+++ b/setjump.s
@@ -0,0 +1,40 @@
+* setjmp on the Cray YMP does not save all registers.  Although this
+* conforms to the ANSI standard, it is not sufficient for SCM garbage
+* collection and continuations.
+*
+* This is a version of setjump for the Cray YMP that does save all non-
+* temporary registers.  It might work for the XMP. It definitely will
+* not work on the Cray 2.  I do not know if the setjmp on the Cray 2 will
+* work with SCM or not.
+*
+* This has been tested under Unicos 6.1.
+*
+* --Radey Shouman <rshouman@chpc.utexas.edu>
+*
+            IDENT           SETJUMP
+            ENTRY           setjump
+setjump     =               *
+            A1              1,A6
+            A2              56
+            A0              A1
+            ,A0             T00,A2
+            A0              A1+A2
+            ,A0             B00,A2
+            S1              0
+            J               B00
+*
+            ENTRY           longjump
+longjump    =               *
+            A1              1,A6
+            A0              A1
+            A2              56
+            T00,A2          ,A0
+            A0              A1+A2
+            B00,A2          ,A0
+            S1              2,A6
+            J               B00
+            END
+** Local Variables:
+** tab-stop-list: (12 28 45)
+** indent-tabs-mode: nil
+** End:
diff --git a/socket.c b/socket.c
new file mode 100644
index 0000000..4446253
--- /dev/null
+++ b/socket.c
@@ -0,0 +1,635 @@
+/* Copyright (C) 1994, 1995 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  
+ */
+
+/* "socket.c" internet stream socket support for client/server in SCM
+    Author: Aubrey Jaffer.
+    Thanks to Hallvard.Tretteberg@si.sintef.no
+    who credits NCSA httpd software by Rob McCool 3/21/93
+*/
+
+#include "scm.h"
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <sys/un.h>
+#include <netinet/in.h>
+#include <netdb.h>
+#include <arpa/inet.h>
+
+#ifndef STDC_HEADERS
+	int close P((int fd));
+#endif /* STDC_HEADERS */
+
+static char s_inetaddr[] = "inet:string->address";
+SCM l_inetaddr (host)
+     SCM host;
+{
+  struct in_addr soka;
+  ASSERT(NIMP(host) && STRINGP(host), host, ARG1, s_inetaddr);
+  soka.s_addr = inet_addr(CHARS(host));
+  if (-1==soka.s_addr) {
+    struct hostent *entry;
+    DEFER_INTS;
+    SYSCALL(entry = gethostbyname(CHARS(host)););
+    ALLOW_INTS;
+    if (!entry) return BOOL_F;
+    return ulong2num(ntohl(((struct in_addr *)entry->h_addr)->s_addr));
+  }
+  return ulong2num(ntohl(soka.s_addr));
+}
+
+static char s_inetstr[] = "inet:address->string";
+SCM l_inetstr (inetid)
+     SCM inetid;
+{
+  struct in_addr addr;
+  char *ans;
+  addr.s_addr = htonl(num2ulong(inetid, (char *)ARG1, s_inetstr));
+  SYSCALL(ans = inet_ntoa(addr););
+  return makfrom0str(ans);
+}
+
+static char s_network[] = "inet:network";
+SCM l_network (host)
+     SCM host;
+{
+  struct in_addr addr;
+  addr.s_addr = htonl(num2ulong(host, (char *)ARG1, s_network));
+  return ulong2num(0L+inet_netof(addr));
+}
+
+static char s_lna[] = "inet:local-network-address";
+SCM l_lna (host)
+     SCM host;
+{
+  struct in_addr addr;
+  addr.s_addr = htonl(num2ulong(host, (char *)ARG1, s_lna));
+  return ulong2num(0L+inet_lnaof(addr));
+}
+
+static char s_makaddr[] = "inet:make-address";
+SCM l_makaddr (net, lna)
+     SCM net, lna;
+{
+  struct in_addr addr;
+  unsigned long netnum = num2ulong(net, (char *)ARG1, s_makaddr);
+  unsigned long lnanum = num2ulong(lna, (char *)ARG2, s_makaddr);
+  addr = inet_makeaddr(netnum, lnanum);
+  return ulong2num(ntohl(addr.s_addr));
+}
+
+static char s_hostinfo[] = "gethost";
+SCM l_hostinfo(name)
+     SCM name;
+{
+  SCM ans = make_vector(MAKINUM(5), UNSPECIFIED);
+  SCM *ve = VELTS(ans);
+  SCM lst = EOL;
+  struct hostent *entry;
+  struct in_addr inad;
+  char **argv;
+  int i = 0;
+#ifndef linux
+  if UNBNDP(name) {
+    DEFER_INTS;
+    SYSCALL(entry = gethostent(););
+  }
+  else
+#endif
+    if (NIMP(name) && STRINGP(name)) {
+    DEFER_INTS;
+    SYSCALL(entry = gethostbyname(CHARS(name)););
+  }
+  else {
+    inad.s_addr = htonl(num2ulong(name, (char *)ARG1, s_hostinfo));
+    DEFER_INTS;
+    SYSCALL(entry = gethostbyaddr((char *)&inad , sizeof(inad), AF_INET););
+  }
+  ALLOW_INTS;
+  if (!entry) return BOOL_F;
+  ve[ 0] = makfrom0str(entry->h_name);
+  ve[ 1] = makfromstrs(-1, entry->h_aliases);
+  ve[ 2] = MAKINUM(entry->h_addrtype + 0L);
+  ve[ 3] = MAKINUM(entry->h_length + 0L);
+  if (sizeof(struct in_addr) != entry->h_length)
+    {ve[ 4] = BOOL_F; return ans;}
+  for(argv = entry->h_addr_list; argv[i]; i++);
+  while (i--) {
+    inad = *(struct in_addr *)argv[i];
+    lst = cons(ulong2num(ntohl(inad.s_addr)), lst);
+  }
+  ve[ 4] = lst;
+  return ans;
+}
+static char s_netinfo[] = "getnet";
+SCM l_netinfo(name)
+     SCM name;
+{
+  SCM ans = make_vector(MAKINUM(4), UNSPECIFIED);
+  SCM *ve = VELTS(ans);
+  struct netent *entry;
+  if UNBNDP(name) {
+    DEFER_INTS;
+    SYSCALL(entry = getnetent(););
+  }
+  else if (NIMP(name) && STRINGP(name)) {
+    DEFER_INTS;
+    SYSCALL(entry = getnetbyname(CHARS(name)););
+  }
+  else {
+    unsigned long netnum;
+    netnum = num2ulong(name, (char *)ARG1, s_netinfo);
+    DEFER_INTS;
+    SYSCALL(entry = getnetbyaddr(netnum, AF_INET););
+  }
+  ALLOW_INTS;
+  if (!entry) return BOOL_F;
+  ve[ 0] = makfrom0str(entry->n_name);
+  ve[ 1] = makfromstrs(-1, entry->n_aliases);
+  ve[ 2] = MAKINUM(entry->n_addrtype + 0L);
+  ve[ 3] = ulong2num(entry->n_net + 0L);
+  return ans;
+}
+static char s_protoinfo[] = "getproto";
+SCM l_protoinfo(name)
+     SCM name;
+{
+  SCM ans = make_vector(MAKINUM(3), UNSPECIFIED);
+  SCM *ve = VELTS(ans);
+  struct protoent *entry;
+  if UNBNDP(name) {
+    DEFER_INTS;
+    SYSCALL(entry = getprotoent(););
+  }
+  else if (NIMP(name) && STRINGP(name)) {
+    DEFER_INTS;
+    SYSCALL(entry = getprotobyname(CHARS(name)););
+  }
+  else {
+    unsigned long protonum;
+    protonum = num2ulong(name, (char *)ARG1, s_protoinfo);
+    DEFER_INTS;
+    SYSCALL(entry = getprotobynumber(protonum););
+  }
+  ALLOW_INTS;
+  if (!entry) return BOOL_F;
+  ve[ 0] = makfrom0str(entry->p_name);
+  ve[ 1] = makfromstrs(-1, entry->p_aliases);
+  ve[ 2] = MAKINUM(entry->p_proto + 0L);
+  return ans;
+}
+static char s_servinfo[] = "getserv";
+SCM l_servinfo(args)
+     SCM args;
+{
+  SCM ans = make_vector(MAKINUM(4), UNSPECIFIED);
+  SCM *ve = VELTS(ans);
+  SCM name, proto;
+  struct servent *entry;
+  if NULLP(args) {
+    DEFER_INTS;
+    SYSCALL(entry = getservent(););
+    goto comlab;
+  }
+  name = CAR(args);
+  proto = CDR(args);
+  ASSERT(NIMP(proto) && CONSP(proto), args, WNA, s_servinfo);
+  proto = CAR(proto);
+  ASSERT(NIMP(proto) && STRINGP(proto), args, ARG2, s_servinfo);
+  DEFER_INTS;
+  if (NIMP(name) && STRINGP(name))
+    SYSCALL(entry = getservbyname(CHARS(name), CHARS(proto)););
+  else {
+    ASSERT(INUMP(proto), proto, ARG1, s_servinfo);
+    SYSCALL(entry = getservbyport(INUM(proto), CHARS(proto)););
+  }
+ comlab:  ALLOW_INTS;
+  if (!entry) return BOOL_F;
+  ve[ 0] = makfrom0str(entry->s_name);
+  ve[ 1] = makfromstrs(-1, entry->s_aliases);
+  ve[ 2] = MAKINUM(ntohs(entry->s_port) + 0L);
+  ve[ 3] = makfrom0str(entry->s_proto);
+  return ans;
+}
+
+SCM l_sethost(arg)
+     SCM arg;
+{
+  if UNBNDP(arg) endhostent();
+  else sethostent(NFALSEP(arg));
+  return UNSPECIFIED;
+}
+SCM l_setnet(arg)
+     SCM arg;
+{
+  if UNBNDP(arg) endnetent();
+  else setnetent(NFALSEP(arg));
+  return UNSPECIFIED;
+}
+SCM l_setproto(arg)
+     SCM arg;
+{
+  if UNBNDP(arg) endprotoent();
+  else setprotoent(NFALSEP(arg));
+  return UNSPECIFIED;
+}
+SCM l_setserv(arg)
+     SCM arg;
+{
+  if UNBNDP(arg) endservent();
+  else setservent(NFALSEP(arg));
+  return UNSPECIFIED;
+}
+
+static char s_socket[] = "make-stream-socket";
+SCM l_socket(fam, proto)
+     SCM fam, proto;
+{
+  int sd, j, tp = INUM(fam);
+  FILE* f;
+  SCM port;
+  ASSERT(INUMP(fam), fam, ARG1, s_socket);
+  if UNBNDP(proto) proto = INUM0;
+  else ASSERT(INUMP(proto), proto, ARG2, s_socket);
+  NEWCELL(port);
+  DEFER_INTS;
+  SYSCALL(sd = socket(tp, SOCK_STREAM, INUM(proto)););
+  if (-1==sd) wta(UNDEFINED, (char *)NALLOC, s_socket);
+  SYSCALL(f = fdopen(sd, "r+"););
+  if (!f) {
+    close(sd);
+    wta(MAKINUM(sd), (char *)NALLOC, s_port_type);
+  }
+  CAR(port) = tc_socket | (tp<<24) | BUF0;
+  SETSTREAM(port, f);
+  i_setbuf0(port);
+  ALLOW_INTS;
+  if (AF_INET==tp) {
+    sd = setsockopt(sd, SOL_SOCKET, SO_REUSEADDR, &j, sizeof(j));
+    ASSERT(!sd, port, "could not set socket option", s_socket);
+  }
+  return port;
+}
+static char s_socketpair[] = "make-stream-socketpair";
+SCM l_socketpair(fam, proto)
+     SCM fam, proto;
+{
+  int sts, tp = INUM(fam);
+  int sv[2];
+  FILE* f[2];
+  SCM port[2];
+  ASSERT(INUMP(fam), fam, ARG1, s_socketpair);
+  if UNBNDP(proto) proto = INUM0;
+  else ASSERT(INUMP(proto), proto, ARG2, s_socketpair);
+  NEWCELL(port[0]); NEWCELL(port[1]);
+  DEFER_INTS;
+  SYSCALL(sts = socketpair(tp, SOCK_STREAM, INUM(proto), sv););
+  if (-1==sts) wta(UNDEFINED, (char *)NALLOC, s_socketpair);
+  SYSCALL(f[0] = fdopen(sv[0], "r+"););
+  if (!f[0]) {
+    close(sv[0]);
+    wta(MAKINUM(sv[0]), (char *)NALLOC, s_port_type);
+  }
+  SYSCALL(f[1] = fdopen(sv[1], "r+"););
+  if (!f[1]) {
+    fclose(f[0]);
+    close(sv[1]);
+    wta(MAKINUM(sv[1]), (char *)NALLOC, s_port_type);
+  }
+  CAR(port[0]) = CAR(port[1]) = tc16_fport | mode_bits("r+0");
+  SETSTREAM(port[0], f[0]); SETSTREAM(port[1], f[1]);
+  i_setbuf0(port[0]); i_setbuf0(port[1]);
+  ALLOW_INTS;
+  return cons(port[0], port[1]);
+}
+
+static char s_shutdown[] = "socket:shutdown";
+SCM l_shutdown(port, how)
+     SCM port, how;
+{
+  int sts;
+  ASSERT(NIMP(port) && OPPORTP(port), port, ARG1, s_shutdown);
+  ASSERT(INUMP(how) && 0 <= INUM(how) && 2 >= INUM(how),
+	 how, ARG2, s_shutdown);
+  SYSCALL(sts = shutdown(fileno(STREAM(port)), INUM(how)););
+  if (sts) return BOOL_F;
+  switch (INUM(how)) {
+  case 0: CAR(port) &= ~RDNG;
+    break;
+  case 1: CAR(port) &= ~WRTNG;
+    break;
+  case 2: CAR(port) &= ~(RDNG | WRTNG);
+  }
+  if SOCKP(port) close_port(port); /* can't read or write */
+  return port;
+}
+static char s_unkfam[] = "unknown-family";
+static char s_connect[] = "socket:connect";
+SCM l_connect (sockpt, address, arg)
+     SCM sockpt, address, arg;
+{
+  int sts;
+  ASSERT(NIMP(sockpt) && SOCKP(sockpt), sockpt, ARG1, s_connect);
+  switch SOCKTYP(sockpt) {
+  default:
+    ASSERT(0, sockpt, s_unkfam, s_connect);
+  case AF_INET:
+    ASSERT(NIMP(arg) && CONSP(arg) && NULLP(CDR(arg)), arg, WNA, s_connect);
+    arg = CAR(arg);
+    ASSERT(INUMP(arg), arg, ARG3, s_connect);
+    {
+      struct sockaddr_in soka;
+      soka.sin_addr.s_addr =
+	htonl(num2ulong(address, (char *)ARG2, s_connect));
+      soka.sin_family = AF_INET;
+      soka.sin_port = htons(INUM(arg));
+      SYSCALL(sts = connect(fileno(STREAM(sockpt)),
+			    (struct sockaddr*)&soka, sizeof(soka)););
+    }
+    break;
+  case AF_UNIX:
+    ASSERT(NULLP(arg), arg, WNA, s_connect);
+    ASSERT(NIMP(address) && STRINGP(address), address, ARG2, s_connect);
+    {
+      struct sockaddr_un soka;
+      soka.sun_family = AF_UNIX;
+      memcpy(&soka.sun_path, CHARS(address), 1+LENGTH(address));
+      SYSCALL(sts = connect(fileno(STREAM(sockpt)),
+			    (struct sockaddr*)&soka, sizeof(soka)););
+    }
+    break;
+  }
+  if (sts) return BOOL_F;
+  CAR(sockpt) = tc16_fport | mode_bits("r+0");
+  return sockpt;
+}
+
+static char s_bind[] = "socket:bind";
+SCM l_bind(sockpt, address)
+     SCM sockpt, address;
+{
+  int sts;
+  ASSERT(NIMP(sockpt) && SOCKP(sockpt), sockpt, ARG1, s_bind);
+  switch SOCKTYP(sockpt) {
+  default:
+    ASSERT(0, sockpt, s_unkfam, s_bind);
+  case AF_UNIX:
+    ASSERT(NIMP(address) && STRINGP(address), address, ARG2, s_bind);
+    {
+      struct sockaddr_un sa_server;
+      bzero((char *) &sa_server, sizeof(sa_server));
+      sa_server.sun_family = AF_UNIX;
+      memcpy(&sa_server.sun_path, CHARS(address), 1+LENGTH(address));
+      SYSCALL(sts = bind(fileno(STREAM(sockpt)),
+			 (struct sockaddr *)&sa_server, sizeof(sa_server)););
+    }
+    break;
+  case AF_INET:
+    ASSERT(INUMP(address), address, ARG2, s_bind);
+    {
+      struct sockaddr_in sa_server;
+      bzero((char *) &sa_server, sizeof(sa_server));
+      sa_server.sin_family = AF_INET;
+      sa_server.sin_addr.s_addr = htonl(INADDR_ANY);
+      sa_server.sin_port = htons(INUM(address));
+      SYSCALL(sts = bind(fileno(STREAM(sockpt)),
+			 (struct sockaddr *)&sa_server, sizeof(sa_server)););
+    }
+    break;
+  }
+  return sts ? BOOL_F : sockpt;
+}
+
+static char s_listen[] = "socket:listen";
+SCM l_listen(port, backlog)
+     SCM port, backlog;
+{
+  int sts;
+  ASSERT(NIMP(port) && SOCKP(port), port, ARG1, s_listen);
+  ASSERT(INUMP(backlog), backlog, ARG2, s_listen);
+  SYSCALL(sts = listen(fileno(STREAM(port)), INUM(backlog)););
+  if (sts) return BOOL_F;
+  CAR(port) = tc16_fport | mode_bits("r0");
+  return port;
+}
+
+static char s_accept[] = "socket:accept";
+SCM l_accept(sockpt)
+     SCM sockpt;
+{
+  int newsd, sadlen;
+  struct sockaddr sad;
+  FILE *newfd;
+  SCM newpt;
+  NEWCELL(newpt);
+  ASSERT(NIMP(sockpt) && OPINPORTP(sockpt), sockpt, ARG1, s_accept);
+  sadlen=sizeof(sad);
+  DEFER_INTS;
+  SYSCALL(newsd = accept(fileno(STREAM(sockpt)), &sad, &sadlen););
+  if (-1==newsd)
+    if (EWOULDBLOCK != errno) return BOOL_F;
+    else wta(sockpt, "couldn't", s_accept);
+  SYSCALL(newfd = fdopen(newsd, "r+"););
+  if (!newfd) {
+    close(newsd);
+    wta(MAKINUM(newsd), (char *)NALLOC, s_port_type);
+  }
+  CAR(newpt) = tc16_fport | mode_bits("r+0");
+  SETSTREAM(newpt, newfd);
+  i_setbuf0(newpt);
+  ALLOW_INTS;
+  return newpt;
+}
+
+int sknm_print(exp, port, writing)
+     SCM exp; SCM port; int writing;
+{
+  lputs("#<", port);
+  switch (((struct sockaddr *)CDR(exp))->sa_family) {
+  case AF_UNIX:
+    lputs("unix-addr ", port);
+    lputs(((struct sockaddr_un *)CDR(exp))->sun_path, port);
+    break;
+  case AF_INET:
+    lputs("inet-addr ", port);
+    lputs(inet_ntoa(((struct sockaddr_in *)CDR(exp))->sin_addr), port);
+    lputc(':', port);
+    intprint(0L + ntohs(((struct sockaddr_in *)CDR(exp))->sin_port), 10, port);
+    break;
+  default: lputs(s_unkfam, port);
+    lputc(' ', port);
+    intprint(0L+((struct sockaddr *)CDR(exp))->sa_family, 10, port);
+  }
+  lputc('>', port);
+  return !0;
+}
+sizet sknm_free(p)
+     CELLPTR p;
+{
+  must_free(CHARS((SCM)p));
+  return sizeof(struct sockaddr);
+}
+long tc16_sknm;
+static smobfuns sknm_smob = {mark0, sknm_free, sknm_print, 0};
+
+char s_sknm_family[] = "socket-name:family";
+SCM l_sknm_family(snm)
+     SCM snm;
+{
+  ASSERT(NIMP(snm) && TYP16(snm)==tc16_sknm, snm, ARG1, s_sknm_family);
+  return MAKINUM(((struct sockaddr *)CDR(snm))->sa_family + 0L);
+}
+char s_sknm_port_num[] = "socket-name:port-number";
+SCM l_sknm_port_num(snm)
+     SCM snm;
+{
+  ASRTGO(NIMP(snm) && TYP16(snm)==tc16_sknm, err1);
+  switch (((struct sockaddr *)CDR(snm))->sa_family) {
+  default:
+  err1:
+    wta(snm, (char *)ARG1, s_sknm_port_num);
+  case AF_INET:
+    return MAKINUM(ntohs(((struct sockaddr_in *)CDR(snm))->sin_port) + 0L);
+  }
+}
+char s_sknm_addr[] = "socket-name:address";
+SCM l_sknm_addr(snm)
+     SCM snm;
+{
+  ASRTGO(NIMP(snm) && TYP16(snm)==tc16_sknm, err1);
+  switch (((struct sockaddr *)CDR(snm))->sa_family) {
+  default:
+  err1:
+    wta(snm, (char *)ARG1, s_sknm_addr);
+  case AF_INET:
+    return ulong2num(ntohl(((struct sockaddr_in *)CDR(snm))->sin_addr.s_addr));
+  case AF_UNIX:			/* the manual says this won't work anyway */
+    return makfrom0str(((struct sockaddr_un *)CDR(snm))->sun_path);
+  }
+}
+
+SCM maksknm(sad)
+     struct sockaddr *sad;
+{
+  SCM sknm;
+  struct sockaddr *msknm;
+  NEWCELL(sknm);
+  DEFER_INTS;
+  msknm = (struct sockaddr *)must_malloc(0L+sizeof(struct sockaddr), "sknm");
+  *msknm = *sad;
+  CAR(sknm) = tc16_sknm;
+  SETCDR(sknm, msknm);
+  ALLOW_INTS;
+  return sknm;
+}
+
+static char s_getpeername[] = "getpeername";
+SCM l_getpeername(sockpt)
+     SCM sockpt;
+{
+  struct sockaddr_in sad;
+  int sts, sadlen = sizeof(sad);
+  bzero((char *) &sad, sizeof(sad));
+  ASSERT(NIMP(sockpt) && OPPORTP(sockpt), sockpt, ARG1, s_getpeername);
+  SYSCALL(sts = getpeername(fileno(STREAM(sockpt)),
+			    (struct sockaddr*)&sad, &sadlen););
+  if (sts || sizeof(sad) != sadlen) return BOOL_F;
+/*  ASSERT(sad.sin_family==AF_INET, sockpt, "non-internet", s_getpeername); */
+  return maksknm(&sad);
+}
+static char s_getsockname[] = "getsockname";
+SCM l_getsockname(sockpt)
+     SCM sockpt;
+{
+  struct sockaddr_in sad;
+  int sts, sadlen = sizeof(sad);
+  bzero((char *) &sad, sizeof(sad));
+  ASSERT(NIMP(sockpt) && OPPORTP(sockpt), sockpt, ARG1, s_getsockname);
+  SYSCALL(sts = getsockname(fileno(STREAM(sockpt)),
+			    (struct sockaddr*)&sad, &sadlen););
+  if (sts || sizeof(sad) != sadlen) return BOOL_F;
+  return maksknm(&sad);
+}
+static iproc subr1s[] = {
+	{s_inetaddr, l_inetaddr},
+	{s_inetstr, l_inetstr},
+	{s_network, l_network},
+	{s_lna, l_lna},
+	{s_makaddr, l_makaddr},
+
+	{s_accept, l_accept},
+	{s_sknm_family, l_sknm_family},
+	{s_sknm_port_num, l_sknm_port_num},
+	{s_sknm_addr, l_sknm_addr},
+	{s_getpeername, l_getpeername},
+	{s_getsockname, l_getsockname},
+	{0, 0}};
+
+static iproc subr1os[] = {
+	{s_hostinfo, l_hostinfo},
+	{s_netinfo, l_netinfo},
+	{s_protoinfo, l_protoinfo},
+	{"sethostent", l_sethost},
+	{"setnetent", l_setnet},
+	{"setprotoent", l_setproto},
+	{"setservent", l_setserv},
+	{0, 0}};
+
+static iproc subr2s[] = {
+	{s_shutdown, l_shutdown},
+	{s_bind, l_bind},
+	{s_listen, l_listen},
+	{s_makaddr, l_makaddr},
+	{0, 0}};
+
+void init_socket()
+{
+  sysintern("af_unix", MAKINUM(AF_UNIX));
+  sysintern("af_inet", MAKINUM(AF_INET));
+  init_iprocs(subr1s, tc7_subr_1);
+  init_iprocs(subr1os, tc7_subr_1o);
+  init_iprocs(subr2s, tc7_subr_2);
+  make_subr(s_servinfo, tc7_lsubr, l_servinfo);
+  make_subr(s_socket, tc7_subr_2o, l_socket);
+  make_subr(s_socketpair, tc7_subr_2o, l_socketpair);
+  make_subr(s_connect, tc7_lsubr_2, l_connect);
+  tc16_sknm = newsmob(&sknm_smob);
+  add_feature("socket");
+}
diff --git a/split.scm b/split.scm
new file mode 100644
index 0000000..1230946
--- /dev/null
+++ b/split.scm
@@ -0,0 +1,87 @@
+;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
+;; 
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; 
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; 
+;; You should have received a copy of the GNU General Public License
+;; along with this software; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;
+;; As a special exception, the Free Software Foundation gives permission
+;; for additional uses of the text contained in its release of GUILE.
+;;
+;; The exception is that, if you link the GUILE library with other files
+;; to produce an executable, this does not by itself cause the
+;; resulting executable to be covered by the GNU General Public License.
+;; Your use of that executable is in no way restricted on account of
+;; linking the GUILE library code into it.
+;;
+;; This exception does not however invalidate any other reasons why
+;; the executable file might be covered by the GNU General Public License.
+;;
+;; This exception applies only to the code released by the
+;; Free Software Foundation under the name GUILE.  If you copy
+;; code from other Free Software Foundation releases into a copy of
+;; GUILE, as the General Public License permits, the exception does
+;; not apply to the code that you add in this way.  To avoid misleading
+;; anyone as to the status of such modified files, you must delete
+;; this exception notice from them.
+;;
+;; If you write modifications of your own for GUILE, it is your choice
+;; whether to permit this exception to apply to your modifications.
+;; If you do not wish that, delete this exception notice.  
+
+;;;; "split.scm", split input, output, and error streams into windows.
+;;; Author: Aubrey Jaffer.
+
+(require 'curses)
+(define *stdscr* (initscr))
+(nocbreak)
+(echo)
+(nl)
+(define subwindow-height (max 2 (quotient (output-port-height) 5)))
+(define *output-window*
+  (newwin (- (output-port-height) (* 2 subwindow-height) 2)
+	  (output-port-width)
+	  0
+	  0))
+(define *input-window*
+  (newwin subwindow-height
+	  (output-port-width)
+	  (- (output-port-height) (* 2 subwindow-height) 1)
+	  0))
+(define *error-window*
+  (newwin subwindow-height
+	  (output-port-width)
+	  (- (output-port-height) subwindow-height)
+	  0))
+(wmove *stdscr* (- (output-port-height) subwindow-height 1) 0)
+(wstandout *stdscr*)
+(display (make-string (output-port-width) #\-) *stdscr*)
+(wmove *stdscr* (- (output-port-height) (* 2 subwindow-height) 2) 0)
+(display (make-string (output-port-width) #\-) *stdscr*)
+(wstandend *stdscr*)
+(touchwin *stdscr*)
+(force-output *stdscr*)
+(scrollok *output-window* #t)
+(scrollok *input-window* #t)
+(scrollok *error-window* #t)
+(define *default-output-port* (set-current-output-port *output-window*))
+(define *default-input-port* (set-current-input-port *input-window*))
+(define *default-error-port* (set-current-error-port *error-window*))
+(leaveok *output-window* #t)
+(leaveok *input-window* #f)
+(leaveok *error-window* #t)
+
+(define (unsplit)
+  (cond ((endwin)
+	 (set-current-output-port *default-output-port*)
+	 (set-current-input-port *default-input-port*)
+	 (set-current-error-port *default-error-port*))))
diff --git a/subr.c b/subr.c
new file mode 100644
index 0000000..4b75e13
--- /dev/null
+++ b/subr.c
@@ -0,0 +1,2009 @@
+/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  
+ */
+
+/* "subr.c" integer and other Scheme procedures
+   Author: Aubrey Jaffer */
+
+#include <ctype.h>
+#include "scm.h"
+
+#define	s_length (s_st_length+7)
+#define s_append (s_st_append+7)
+
+char	s_make_string[] = "make-string";
+char	s_list[] = "list";
+
+static char	s_setcar[] = "set-car!", s_setcdr[] = "set-cdr!",
+	s_reverse[] = "reverse", s_list_ref[] = "list-ref";
+static char	s_memq[] = "memq", s_member[] = "member",
+	s_assq[] = "assq", s_assoc[] = "assoc";
+static char	s_symbol2string[] = "symbol->string",
+	s_str2symbol[] = "string->symbol";
+extern char s_inexactp[];
+#define s_exactp (s_inexactp+2)
+static char	s_oddp[] = "odd?", s_evenp[] = "even?";
+static char	s_abs[] = "abs", s_quotient[] = "quotient",
+	s_remainder[] = "remainder", s_modulo[] = "modulo";
+static char	s_gcd[] = "gcd";
+
+static char s_ci_eq[] = "char-ci=?",
+	s_ch_lessp[] = "char<?", s_ch_leqp[] = "char<=?",
+	s_ci_lessp[] = "char-ci<?", s_ci_leqp[] = "char-ci<=?",
+	s_ch_grp[] = "char>?", s_ch_geqp[] = "char>=?",
+	s_ci_grp[] = "char-ci>?", s_ci_geqp[] = "char-ci>=?";
+static char	s_ch_alphap[] = "char-alphabetic?",
+	s_ch_nump[] = "char-numeric?",
+	s_ch_whitep[] = "char-whitespace?",
+	s_ch_upperp[] = "char-upper-case?",
+	s_ch_lowerp[] = "char-lower-case?";
+static char	s_char2int[] = "char->integer", s_int2char[] = "integer->char",
+	s_ch_upcase[] = "char-upcase", s_ch_downcase[] = "char-downcase";
+
+static char	s_st_length[] = "string-length",
+	s_st_ref[] = "string-ref", s_st_set[] = "string-set!";
+static char	s_st_equal[] = "string=?", s_stci_equal[] = "string-ci=?",
+	s_st_lessp[] = "string<?", s_stci_lessp[] = "string-ci<?";
+static char	s_substring[] = "substring", s_st_append[] = "string-append";
+
+static char	s_ve_length[] = "vector-length",
+	s_ve_ref[] = "vector-ref", s_ve_set[] = "vector-set!";
+
+SCM lnot(x)
+     SCM x;
+{
+	return FALSEP(x) ? BOOL_T : BOOL_F;
+}
+SCM booleanp(obj)
+     SCM obj;
+{
+	if (BOOL_F==obj) return BOOL_T;
+	if (BOOL_T==obj) return BOOL_T;
+	return BOOL_F;
+}
+SCM eq(x, y)
+     SCM x, y;
+{
+	if (x==y) return BOOL_T;
+	else return BOOL_F;
+}
+
+SCM consp(x)
+     SCM x;
+{
+	if IMP(x) return BOOL_F;
+	return CONSP(x) ? BOOL_T : BOOL_F;
+}
+SCM setcar(pair, value)
+     SCM pair, value;
+{
+	ASSERT(NIMP(pair) && CONSP(pair), pair, ARG1, s_setcar);
+	CAR(pair) = value;
+	return UNSPECIFIED;
+}
+SCM setcdr(pair, value)
+     SCM pair, value;
+{
+	ASSERT(NIMP(pair) && CONSP(pair), pair, ARG1, s_setcdr);
+	CDR(pair) = value;
+	return UNSPECIFIED;
+}
+SCM nullp(x)
+     SCM x;
+{
+	return NULLP(x) ? BOOL_T : BOOL_F;
+}
+long ilength(sx)
+     SCM sx;
+{
+	register long i = 0;
+	register SCM x = sx;
+	do {
+		if IMP(x) return NULLP(x) ? i : -1;
+		if NCONSP(x) return -2;
+		x = CDR(x);
+		i++;
+		if IMP(x) return NULLP(x) ? i : -1;
+		if NCONSP(x) return -2;
+		x = CDR(x);
+		i++;
+		sx = CDR(sx);
+	}
+	while (x != sx);
+	return -1;
+}
+SCM listp(x)
+     SCM x;
+{
+	if (ilength(x)<0) return BOOL_F;
+	else return BOOL_T;
+}
+SCM list(objs)
+     SCM objs;
+{
+	return objs;
+}
+SCM length(x)
+     SCM x;
+{
+	SCM i = MAKINUM(ilength(x));
+	ASSERT(i >= INUM0, x, ARG1, s_length);
+	return i;
+}
+SCM append(args)
+     SCM args;
+{
+	SCM res = EOL;
+	SCM *lloc = &res, arg;
+	if IMP(args) {
+		ASSERT(NULLP(args), args, ARGn, s_append);
+		return res;
+		}
+	ASSERT(CONSP(args), args, ARGn, s_append);
+	while (1) {
+		arg = CAR(args);
+		args = CDR(args);
+		if IMP(args) {
+			*lloc = arg;
+			ASSERT(NULLP(args), args, ARGn, s_append);
+			return res;
+		}
+		ASSERT(CONSP(args), args, ARGn, s_append);
+		for(;NIMP(arg);arg = CDR(arg)) {
+			ASSERT(CONSP(arg), arg, ARGn, s_append);
+			*lloc = cons(CAR(arg), EOL);
+			lloc = &CDR(*lloc);
+		}
+		ASSERT(NULLP(arg), arg, ARGn, s_append);
+	}
+}
+SCM reverse(lst)
+     SCM lst;
+{
+	SCM res = EOL;
+	SCM p = lst;
+	for(;NIMP(p);p = CDR(p)) {
+		ASSERT(CONSP(p), lst, ARG1, s_reverse);
+		res = cons(CAR(p), res);
+	}
+	ASSERT(NULLP(p), lst, ARG1, s_reverse);
+	return res;
+}
+SCM list_ref(lst, k)
+     SCM lst, k;
+{
+	register long i;
+	ASSERT(INUMP(k), k, ARG2, s_list_ref);
+	i = INUM(k);
+	ASSERT(i >= 0, k, ARG2, s_list_ref);
+	while (i-- > 0) {
+		ASRTGO(NIMP(lst) && CONSP(lst), erout);
+		lst = CDR(lst);
+	}
+erout:	ASSERT(NIMP(lst) && CONSP(lst),
+	       NULLP(lst)?k:lst, NULLP(lst)?OUTOFRANGE:ARG1, s_list_ref);
+	return CAR(lst);
+}
+SCM memq(x, lst)
+     SCM x, lst;
+{
+	for(;NIMP(lst);lst = CDR(lst)) {
+		ASSERT(CONSP(lst), lst, ARG2, s_memq);
+		if (CAR(lst)==x) return lst;
+	}
+	ASSERT(NULLP(lst), lst, ARG2, s_memq);
+	return BOOL_F;
+}
+SCM member(x, lst)
+     SCM x, lst;
+{
+	for(;NIMP(lst);lst = CDR(lst)) {
+		ASSERT(CONSP(lst), lst, ARG2, s_member);
+		if NFALSEP(equal(CAR(lst), x)) return lst;
+	}
+	ASSERT(NULLP(lst), lst, ARG2, s_member);
+	return BOOL_F;
+}
+SCM assq(x, alist)
+     SCM x, alist;
+{
+	SCM tmp;
+	for(;NIMP(alist);alist = CDR(alist)) {
+		ASSERT(CONSP(alist), alist, ARG2, s_assq);
+		tmp = CAR(alist);
+		ASSERT(NIMP(tmp) && CONSP(tmp), alist, ARG2, s_assq);
+		if (CAR(tmp)==x) return tmp;
+	}
+	ASSERT(NULLP(alist), alist, ARG2, s_assq);
+	return BOOL_F;
+}
+SCM assoc(x, alist)
+     SCM x, alist;
+{
+	SCM tmp;
+	for(;NIMP(alist);alist = CDR(alist)) {
+		ASSERT(CONSP(alist), alist, ARG2, s_assoc);
+		tmp = CAR(alist);
+		ASSERT(NIMP(tmp) && CONSP(tmp), alist, ARG2, s_assoc);
+		if NFALSEP(equal(CAR(tmp), x)) return tmp;
+	}
+	ASSERT(NULLP(alist), alist, ARG2, s_assoc);
+	return BOOL_F;
+}
+
+SCM symbolp(x)
+     SCM x;
+{
+	if IMP(x) return BOOL_F;
+	return SYMBOLP(x) ? BOOL_T : BOOL_F;
+}
+SCM symbol2string(s)
+     SCM s;
+{
+	ASSERT(NIMP(s) && SYMBOLP(s), s, ARG1, s_symbol2string);
+	return makfromstr(CHARS(s), (sizet)LENGTH(s));
+}
+SCM string2symbol(s)
+     SCM s;
+{
+	ASSERT(NIMP(s) && STRINGP(s), s, ARG1, s_str2symbol);
+	s = intern(CHARS(s), (sizet)LENGTH(s));
+	return CAR(s);
+}
+
+SCM exactp(x)
+     SCM x;
+{
+	if INUMP(x) return BOOL_T;
+#ifdef BIGDIG
+	if (NIMP(x) && BIGP(x)) return BOOL_T;
+#endif
+	return BOOL_F;
+}
+SCM oddp(n)
+     SCM n;
+{
+#ifdef BIGDIG
+	if NINUMP(n) {
+	  ASSERT(NIMP(n) && BIGP(n), n, ARG1, s_oddp);
+	  return (1 & BDIGITS(n)[0]) ? BOOL_T : BOOL_F;
+	}
+#else
+	ASSERT(INUMP(n), n, ARG1, s_oddp);
+#endif
+	return (4 & (int)n) ? BOOL_T : BOOL_F;
+}
+SCM evenp(n)
+     SCM n;
+{
+#ifdef BIGDIG
+	if NINUMP(n) {
+	  ASSERT(NIMP(n) && BIGP(n), n, ARG1, s_evenp);
+	  return (1 & BDIGITS(n)[0]) ? BOOL_F : BOOL_T;
+	}
+#else
+	ASSERT(INUMP(n), n, ARG1, s_evenp);
+#endif
+	return (4 & (int)n) ? BOOL_F : BOOL_T;
+}
+SCM absval(x)
+     SCM x;
+{
+#ifdef BIGDIG
+  if NINUMP(x) {
+    ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_abs);
+    if (TYP16(x)==tc16_bigpos) return x;
+    return copybig(x, 0);
+  }
+#else
+  ASSERT(INUMP(x), x, ARG1, s_abs);
+#endif
+  if (INUM(x) >= 0) return x;
+  x = -INUM(x);
+  if (!POSFIXABLE(x))
+#ifdef BIGDIG
+    return long2big(x);
+#else
+    wta(MAKINUM(-x), (char *)OVFLOW, s_abs);
+#endif
+  return MAKINUM(x);
+}
+SCM lquotient(x, y)
+     SCM x, y;
+{
+  register long z;
+#ifdef BIGDIG
+  if NINUMP(x) {
+    long w;
+    ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_quotient);
+    if NINUMP(y) {
+      ASRTGO(NIMP(y) && BIGP(y), bady);
+      return divbigbig(BDIGITS(x), NUMDIGS(x), BDIGITS(y), NUMDIGS(y),
+		       BIGSIGN(x) ^ BIGSIGN(y), 2);
+    }
+    z = INUM(y);
+    ASRTGO(z, ov);
+    if (1==z) return x;
+    if (z < 0) z = -z;
+    if (z < BIGRAD) {
+      w = copybig(x, BIGSIGN(x) ? (y>0) : (y<0));
+      divbigdig(BDIGITS(w), NUMDIGS(w), (BIGDIG)z);
+      return normbig(w);
+    }
+# ifndef DIGSTOOBIG
+    w = pseudolong(z);
+    return divbigbig(BDIGITS(x), NUMDIGS(x), (BIGDIG *)&w, DIGSPERLONG,
+		     BIGSIGN(x) ? (y>0) : (y<0), 2);
+# else
+    { BIGDIG zdigs[DIGSPERLONG];
+      longdigs(z, zdigs);
+      return divbigbig(BDIGITS(x), NUMDIGS(x), zdigs, DIGSPERLONG,
+		       BIGSIGN(x) ? (y>0) : (y<0), 2);
+    }
+# endif
+  }
+  if NINUMP(y) {
+# ifndef RECKLESS
+    if (!(NIMP(y) && BIGP(y)))
+    bady: wta(y, (char *)ARG2, s_quotient);
+# endif
+    return INUM0;
+  }
+#else
+  ASSERT(INUMP(x), x, ARG1, s_quotient);
+  ASSERT(INUMP(y), y, ARG2, s_quotient);
+#endif
+  if ((z = INUM(y))==0)
+  ov: wta(y, (char *)OVFLOW, s_quotient);
+  z = INUM(x)/z;
+#ifdef BADIVSGNS
+  {
+# if (__TURBOC__==1)
+    long t = ((y<0) ? -INUM(x) : INUM(x))%INUM(y);
+# else
+    long t = INUM(x)%INUM(y);
+# endif
+    if (t==0) ;
+    else if (t < 0)
+      if (x < 0) ;
+      else z--;
+    else if (x < 0) z++;
+  }
+#endif
+  if (!FIXABLE(z))
+#ifdef BIGDIG
+    return long2big(z);
+#else
+  wta(x, (char *)OVFLOW, s_quotient);
+#endif
+  return MAKINUM(z);
+}
+SCM lremainder(x, y)
+     SCM x, y;
+{
+  register long z;
+#ifdef BIGDIG
+  if NINUMP(x) {
+    ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_remainder);
+    if NINUMP(y) {
+      ASRTGO(NIMP(y) && BIGP(y), bady);
+      return divbigbig(BDIGITS(x), NUMDIGS(x), BDIGITS(y), NUMDIGS(y),
+		       BIGSIGN(x), 0);
+    }
+    if (!(z = INUM(y))) goto ov;
+    return divbigint(x, z, BIGSIGN(x), 0);
+  }
+  if NINUMP(y) {
+# ifndef RECKLESS
+    if (!(NIMP(y) && BIGP(y)))
+    bady: wta(y, (char *)ARG2, s_remainder);
+# endif
+    return x;
+  }
+#else
+  ASSERT(INUMP(x), x, ARG1, s_remainder);
+  ASSERT(INUMP(y), y, ARG2, s_remainder);
+#endif
+  if (!(z = INUM(y)))
+  ov: wta(y, (char *)OVFLOW, s_remainder);
+#if (__TURBOC__==1)
+  if (z < 0) z = -z;
+#endif
+  z = INUM(x)%z;
+#ifdef BADIVSGNS
+  if (!z) ;
+  else if (z < 0)
+	  if (x < 0) ;
+	  else z += INUM(y);
+  else if (x < 0) z -= INUM(y);
+#endif
+  return MAKINUM(z);
+}
+SCM modulo(x, y)
+     SCM x, y;
+{
+  register long yy, z;
+#ifdef BIGDIG
+  if NINUMP(x) {
+    ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_modulo);
+    if NINUMP(y) {
+      ASRTGO(NIMP(y) && BIGP(y), bady);
+      return divbigbig(BDIGITS(x), NUMDIGS(x), BDIGITS(y), NUMDIGS(y),
+		       BIGSIGN(y), (BIGSIGN(x) ^ BIGSIGN(y)) ? 1 : 0);
+    }
+    if (!(z = INUM(y))) goto ov;
+    return divbigint(x, z, y < 0, (BIGSIGN(x) ? (y > 0) : (y < 0)) ? 1 : 0);
+  }
+  if NINUMP(y) {
+# ifndef RECKLESS
+    if (!(NIMP(y) && BIGP(y)))
+    bady: wta(y, (char *)ARG2, s_modulo);
+# endif
+    return (BIGSIGN(y) ? (x>0) : (x<0)) ? sum(x, y) : x;
+  }
+#else
+  ASSERT(INUMP(x), x, ARG1, s_modulo);
+  ASSERT(INUMP(y), y, ARG2, s_modulo);
+#endif
+  if (!(yy = INUM(y)))
+  ov: wta(y, (char *)OVFLOW, s_modulo);
+#if (__TURBOC__==1)
+  z = INUM(x);
+  z = ((yy<0) ? -z : z)%yy;
+#else
+  z = INUM(x)%yy;
+#endif
+  return MAKINUM(((yy<0) ? (z>0) : (z<0)) ? z+yy : z);
+}
+
+SCM lgcd(x, y)
+     SCM x, y;
+{
+  register long u, v, k, t;
+ tailrec:
+  if UNBNDP(y) return UNBNDP(x) ? INUM0 : x;
+#ifdef BIGDIG
+  if NINUMP(x) {
+    big_gcd:
+    ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_gcd);
+    if BIGSIGN(x) x = copybig(x, 0);
+  newy:
+    if NINUMP(y) {
+      ASSERT(NIMP(y) && BIGP(y), y, ARG2, s_gcd);
+      if BIGSIGN(y) y = copybig(y, 0);
+      switch (bigcomp(x, y)) {
+      case -1:
+      swaprec: t = lremainder(x, y); x = y; y = t; goto tailrec;
+      case  0: return x;
+      case  1: y = lremainder(y, x); goto newy;
+      }
+      /* instead of the switch, we could just return lgcd(y, modulo(x, y)); */
+    }
+    if (INUM0==y) return x; goto swaprec;
+  }
+  if NINUMP(y) { t=x; x=y; y=t; goto big_gcd;}
+#else
+  ASSERT(INUMP(x), x, ARG1, s_gcd);
+  ASSERT(INUMP(y), y, ARG2, s_gcd);
+#endif
+  u = INUM(x);
+  if (u<0) u = -u;
+  v = INUM(y);
+  if (v<0) v = -v;
+  else if (0==v) goto getout;
+  if (0==u) {u = v; goto getout;}
+  for (k = 1;!(1 & ((int)u|(int)v));k <<= 1, u >>= 1, v >>= 1);
+  if (1 & (int)u) t = -v;
+  else {
+    t = u;
+b3:
+    t = SRS(t, 1);
+  }
+  if (!(1 & (int)t)) goto b3;
+  if (t>0) u = t;
+  else v = -t;
+  if ((t = u-v)) goto b3;
+  u = u*k;
+getout:
+  if (!POSFIXABLE(u))
+#ifdef BIGDIG
+    return long2big(u);
+#else
+    wta(x, (char *)OVFLOW, s_gcd);
+#endif
+  return MAKINUM(u);
+}
+SCM llcm(n1, n2)
+     SCM n1, n2;
+{
+  SCM d;
+  if UNBNDP(n2) {
+    n2 = MAKINUM(1L);
+    if UNBNDP(n1) return n2;
+  }
+  d = lgcd(n1, n2);
+  if (INUM0==d) return d;
+  return absval(product(n1, lquotient(n2, d)));
+}
+
+/* Emulating 2's complement bignums with sign magnitude arithmetic:
+
+   Logand:
+   X	Y	Result	Method:
+		 (len)
+   +	+	+ x	(map digit:logand X Y)
+   +	-	+ x	(map digit:logand X (lognot (+ -1 Y)))
+   -	+	+ y	(map digit:logand (lognot (+ -1 X)) Y)
+   -	-	-	(+ 1 (map digit:logior (+ -1 X) (+ -1 Y)))
+
+   Logior:
+   X	Y	Result	Method:
+
+   +	+	+	(map digit:logior X Y)
+   +	-	- y	(+ 1 (map digit:logand (lognot X) (+ -1 Y)))
+   -	+	- x	(+ 1 (map digit:logand (+ -1 X) (lognot Y)))
+   -	-	- x	(+ 1 (map digit:logand (+ -1 X) (+ -1 Y)))
+
+   Logxor:
+   X	Y	Result	Method:
+
+   +	+	+	(map digit:logxor X Y)
+   +	-	-	(+ 1 (map digit:logxor X (+ -1 Y)))
+   -	+	-	(+ 1 (map digit:logxor (+ -1 X) Y))
+   -	-	+	(map digit:logxor (+ -1 X) (+ -1 Y))
+
+   Logtest:
+   X	Y	Result
+
+   +	+	(any digit:logand X Y)
+   +	-	(any digit:logand X (lognot (+ -1 Y)))
+   -	+	(any digit:logand (lognot (+ -1 X)) Y)
+   -	-	#t
+
+*/
+
+#ifdef BIGDIG
+
+SCM	scm_big_ior P((BIGDIG *x, sizet nx, int xsgn, SCM bigy));
+SCM	scm_big_and P((BIGDIG *x, sizet nx, int xsgn, SCM bigy, int zsgn));
+SCM	scm_big_xor P((BIGDIG *x, sizet nx, int xsgn, SCM bigy));
+SCM	scm_big_test P((BIGDIG *x, sizet nx, int xsgn, SCM bigy));
+
+SCM scm_copy_big_dec(b, sign)
+     SCM b;
+     int sign;
+{
+  long num = -1;
+  sizet nx = NUMDIGS(b);
+  sizet i = 0;
+  SCM ans = mkbig(nx, sign);
+  BIGDIG *src = BDIGITS(b), *dst = BDIGITS(ans);
+  if BIGSIGN(b) do {
+    num += src[i];
+    if (num < 0) {dst[i] = num + BIGRAD; num = -1;}
+    else {dst[i] = BIGLO(num); num = 0;}
+  } while (++i < nx);
+  else
+    while (nx--) dst[nx] = src[nx];
+  return ans;
+}
+
+SCM scm_copy_smaller(x, nx, zsgn)
+     BIGDIG *x;
+     sizet nx;
+     int zsgn;
+{
+  long num = -1;
+  sizet i = 0;
+  SCM z = mkbig(nx, zsgn);
+  BIGDIG *zds = BDIGITS(z);
+  if (zsgn) do {
+    num += x[i];
+    if (num < 0) {zds[i] = num + BIGRAD; num = -1;}
+    else {zds[i] = BIGLO(num); num = 0;}
+  } while (++i < nx);
+  else do zds[i] = x[i]; while (++i < nx);
+  return z;
+}
+
+SCM scm_big_ior(x, nx, xsgn, bigy)
+     BIGDIG *x;
+     SCM bigy;
+     sizet nx;		/* Assumes nx <= NUMDIGS(bigy) */
+     int xsgn;		/* Assumes xsgn equals either 0 or 0x0100 */
+{
+  long num = -1;
+  sizet i = 0, ny = NUMDIGS(bigy);
+  SCM z = scm_copy_big_dec(bigy, xsgn & BIGSIGN(bigy));
+  BIGDIG *zds = BDIGITS(z);
+  if (xsgn) {
+    do {
+      num += x[i];
+      if (num < 0) {zds[i] |= num + BIGRAD; num = -1;}
+      else {zds[i] |= BIGLO(num); num = 0;}
+    } while (++i < nx);
+    /* =========  Need to increment zds now =========== */
+    i = 0; num = 1;
+    while (i < ny) {
+      num += zds[i];
+      zds[i++] = BIGLO(num);
+      num = BIGDN(num);
+      if (!num) return z;
+    }
+    adjbig(z, 1 + ny);		/* OOPS, overflowed into next digit. */
+    BDIGITS(z)[ny] = 1;
+    return z;
+  }
+  else do zds[i] = zds[i] | x[i]; while (++i < nx);
+  return z;
+}
+
+SCM scm_big_xor(x, nx, xsgn, bigy)
+     BIGDIG *x;
+     SCM bigy;
+     sizet nx;		/* Assumes nx <= NUMDIGS(bigy) */
+     int xsgn;		/* Assumes xsgn equals either 0 or 0x0100 */
+{
+  long num = -1;
+  sizet i = 0, ny = NUMDIGS(bigy);
+  SCM z = scm_copy_big_dec(bigy, xsgn ^ BIGSIGN(bigy));
+  BIGDIG *zds = BDIGITS(z);
+  if (xsgn) do {
+    num += x[i];
+    if (num < 0) {zds[i] ^= num + BIGRAD; num = -1;}
+    else {zds[i] ^= BIGLO(num); num = 0;}
+  } while (++i < nx);
+  else do {
+    zds[i] = zds[i] ^ x[i];
+  } while (++i < nx);
+
+  if (xsgn ^ BIGSIGN(bigy)) {
+    /* =========  Need to increment zds now =========== */
+    i = 0; num = 1;
+    while (i < ny) {
+      num += zds[i];
+      zds[i++] = BIGLO(num);
+      num = BIGDN(num);
+      if (!num) return normbig(z);
+    }
+  }
+  return normbig(z);
+}
+
+SCM scm_big_and(x, nx, xsgn, bigy, zsgn)
+     BIGDIG *x;
+     SCM bigy;
+     sizet nx;		/* Assumes nx <= NUMDIGS(bigy) */
+     int xsgn;		/* Assumes xsgn equals either 0 or 0x0100 */
+     int zsgn;		/* return sign equals either 0 or 0x0100 */
+{
+  long num = -1;
+  sizet i = 0;
+  SCM z;
+  BIGDIG *zds;
+  if (xsgn==zsgn) {
+    z = scm_copy_smaller(x, nx, zsgn);
+    x = BDIGITS(bigy);
+    xsgn = BIGSIGN(bigy);
+  }
+  else z = scm_copy_big_dec(bigy, zsgn);
+  zds = BDIGITS(z);
+
+  if (zsgn) {
+    if (xsgn) do {
+      num += x[i];
+      if (num < 0) {zds[i] &= num + BIGRAD; num = -1;}
+      else {zds[i] &= BIGLO(num); num = 0;}
+    } while (++i < nx);
+    else do zds[i] = zds[i] & ~x[i]; while (++i < nx);
+    /* =========  need to increment zds now =========== */
+    i = 0; num = 1;
+    while (i < nx) {
+      num += zds[i];
+      zds[i++] = BIGLO(num);
+      num = BIGDN(num);
+      if (!num) return normbig(z);
+    }
+  }
+  else if (xsgn) do {
+    num += x[i];
+    if (num < 0) {zds[i] &= num + BIGRAD; num = -1;}
+    else {zds[i] &= ~BIGLO(num); num = 0;}
+  } while (++i < nx);
+  else do zds[i] = zds[i] & x[i]; while (++i < nx);
+  return normbig(z);
+}
+
+SCM scm_big_test(x, nx, xsgn, bigy)
+     BIGDIG *x;
+     SCM bigy;
+     sizet nx;		/* Assumes nx <= NUMDIGS(bigy) */
+     int xsgn;		/* Assumes xsgn equals either 0 or 0x0100 */
+{
+  BIGDIG *y;
+  sizet i = 0;
+  long num = -1;
+  if (BIGSIGN(bigy) & xsgn) return BOOL_T;
+  if (NUMDIGS(bigy) != nx && xsgn) return BOOL_T;
+  y = BDIGITS(bigy);
+  if (xsgn)
+    do {
+      num += x[i];
+      if (num < 0) {
+	if (y[i] & ~(num + BIGRAD)) return BOOL_T;
+	num = -1;
+      }
+      else {
+	if (y[i] & ~BIGLO(num)) return BOOL_T;
+	num = 0;
+      }
+    } while (++i < nx);
+  else if BIGSIGN(bigy)
+    do {
+      num += y[i];
+      if (num < 0) {
+	if (x[i] & ~(num + BIGRAD)) return BOOL_T;
+	num = -1;
+      }
+      else {
+	if (x[i] & ~BIGLO(num)) return BOOL_T;
+	num = 0;
+      }
+    } while (++i < nx);
+  else
+    do if (x[i] & y[i]) return BOOL_T;
+    while (++i < nx);
+  return BOOL_F;
+}
+
+#endif
+
+static char s_logand[] = "logand", s_lognot[] = "lognot",
+	    s_logior[] = "logior", s_logxor[] = "logxor",
+	    s_logtest[] = "logtest", s_logbitp[] = "logbit?",
+	    s_ash[] = "ash", s_logcount[] = "logcount",
+	    s_intlength[] = "integer-length",
+	    s_intexpt[] = "integer-expt",
+	    s_bitextract[] = "bit-extract";
+
+SCM scm_logior(x, y)
+     SCM x, y;
+{
+  if UNBNDP(y) {
+    if UNBNDP(x) return INUM0;
+#ifndef RECKLESS
+    if (!(NUMBERP(x)))
+    badx: wta(x, (char *)ARG1, s_logior);
+#endif
+    return x;
+  }
+#ifdef BIGDIG
+  if NINUMP(x) {
+    SCM t;
+    ASRTGO(NIMP(x) && BIGP(x), badx);
+    if INUMP(y) {t = x; x = y; y = t; goto intbig;}
+    ASRTGO(NIMP(y) && BIGP(y), bady);
+    if (NUMDIGS(x) > NUMDIGS(y)) {t = x; x = y; y = t;}
+    if ((!BIGSIGN(x)) && !BIGSIGN(y))
+      return scm_big_ior(BDIGITS(x), NUMDIGS(x), BIGSIGN(x), y);
+    return scm_big_and(BDIGITS(x), NUMDIGS(x), BIGSIGN(x), y, 0x0100);
+  }
+  if NINUMP(y) {
+# ifndef RECKLESS
+    if (!(NIMP(y) && BIGP(y)))
+    bady: wta(y, (char *)ARG2, s_logior);
+# endif
+  intbig: {
+# ifndef DIGSTOOBIG
+    long z = pseudolong(INUM(x));
+    if ((!(x < 0)) && !BIGSIGN(y))
+      return scm_big_ior((BIGDIG *)&z, DIGSPERLONG, (x < 0) ? 0x0100 : 0, y);
+    return scm_big_and((BIGDIG *)&z, DIGSPERLONG, (x < 0) ? 0x0100 : 0, y,
+			  0x0100);
+# else
+    BIGDIG zdigs[DIGSPERLONG];
+    longdigs(INUM(x), zdigs);
+    if ((!(x < 0)) && !BIGSIGN(y))
+      return scm_big_ior(zdigs, DIGSPERLONG, (x < 0) ? 0x0100 : 0, y);
+    return scm_big_and(zdigs, DIGSPERLONG, (x < 0) ? 0x0100 : 0, y, 0x0100);
+# endif
+  }}
+#else
+  ASRTGO(INUMP(x), badx);
+  ASSERT(INUMP(y), y, ARG2, s_logior);
+#endif
+  return MAKINUM(INUM(x) | INUM(y));
+}
+
+SCM scm_logand(x, y)
+     SCM x, y;
+{
+  if UNBNDP(y) {
+    if UNBNDP(x) return MAKINUM(-1);
+#ifndef RECKLESS
+    if (!(NUMBERP(x)))
+    badx: wta(x, (char *)ARG1, s_logand);
+#endif
+    return x;
+  }
+#ifdef BIGDIG
+  if NINUMP(x) {
+    SCM t;
+    ASRTGO(NIMP(x) && BIGP(x), badx);
+    if INUMP(y) {t = x; x = y; y = t; goto intbig;}
+    ASRTGO(NIMP(y) && BIGP(y), bady);
+    if (NUMDIGS(x) > NUMDIGS(y)) {t = x; x = y; y = t;}
+    if ((BIGSIGN(x)) && BIGSIGN(y))
+      return scm_big_ior(BDIGITS(x), NUMDIGS(x), 0x0100, y);
+    return scm_big_and(BDIGITS(x), NUMDIGS(x), BIGSIGN(x), y, 0);
+  }
+  if NINUMP(y) {
+# ifndef RECKLESS
+    if (!(NIMP(y) && BIGP(y)))
+    bady: wta(y, (char *)ARG2, s_logand);
+# endif
+  intbig: {
+# ifndef DIGSTOOBIG
+    long z = pseudolong(INUM(x));
+    if ((x < 0) && BIGSIGN(y))
+      return scm_big_ior((BIGDIG *)&z, DIGSPERLONG, 0x0100, y);
+    return scm_big_and((BIGDIG *)&z, DIGSPERLONG, (x < 0) ? 0x0100 : 0, y,
+			  0);
+# else
+    BIGDIG zdigs[DIGSPERLONG];
+    longdigs(INUM(x), zdigs);
+    if ((x < 0) && BIGSIGN(y))
+      return scm_big_ior(zdigs, DIGSPERLONG, 0x0100, y);
+    return scm_big_and(zdigs, DIGSPERLONG, (x < 0) ? 0x0100 : 0, y, 0);
+# endif
+  }}
+#else
+  ASRTGO(INUMP(x), badx);
+  ASSERT(INUMP(y), y, ARG2, s_logand);
+#endif
+  return MAKINUM(INUM(x) & INUM(y));
+}
+
+SCM scm_logxor(x, y)
+     SCM x, y;
+{
+  if UNBNDP(y) {
+    if UNBNDP(x) return INUM0;
+#ifndef RECKLESS
+    if (!(NUMBERP(x)))
+    badx: wta(x, (char *)ARG1, s_logxor);
+#endif
+    return x;
+  }
+#ifdef BIGDIG
+  if NINUMP(x) {
+    SCM t;
+    ASRTGO(NIMP(x) && BIGP(x), badx);
+    if INUMP(y) {t = x; x = y; y = t; goto intbig;}
+    ASRTGO(NIMP(y) && BIGP(y), bady);
+    if (NUMDIGS(x) > NUMDIGS(y)) {t = x; x = y; y = t;}
+    return scm_big_xor(BDIGITS(x), NUMDIGS(x), BIGSIGN(x), y);
+  }
+  if NINUMP(y) {
+# ifndef RECKLESS
+    if (!(NIMP(y) && BIGP(y)))
+    bady: wta(y, (char *)ARG2, s_logxor);
+# endif
+  intbig: {
+# ifndef DIGSTOOBIG
+    long z = pseudolong(INUM(x));
+    return scm_big_xor((BIGDIG *)&z, DIGSPERLONG, (x < 0) ? 0x0100 : 0, y);
+# else
+    BIGDIG zdigs[DIGSPERLONG];
+    longdigs(INUM(x), zdigs);
+    return scm_big_xor(zdigs, DIGSPERLONG, (x < 0) ? 0x0100 : 0, y);
+# endif
+  }}
+#else
+  ASRTGO(INUMP(x), badx);
+  ASSERT(INUMP(y), y, ARG2, s_logxor);
+#endif
+  return (x ^ y) + INUM0;
+}
+
+SCM scm_logtest(x, y)
+     SCM x, y;
+{
+#ifndef RECKLESS
+    if (!(NUMBERP(x)))
+    badx: wta(x, (char *)ARG1, s_logtest);
+#endif
+#ifdef BIGDIG
+  if NINUMP(x) {
+    SCM t;
+    ASRTGO(NIMP(x) && BIGP(x), badx);
+    if INUMP(y) {t = x; x = y; y = t; goto intbig;}
+    ASRTGO(NIMP(y) && BIGP(y), bady);
+    if (NUMDIGS(x) > NUMDIGS(y)) {t = x; x = y; y = t;}
+    return scm_big_test(BDIGITS(x), NUMDIGS(x), BIGSIGN(x), y);
+  }
+  if NINUMP(y) {
+# ifndef RECKLESS
+    if (!(NIMP(y) && BIGP(y)))
+    bady: wta(y, (char *)ARG2, s_logtest);
+# endif
+  intbig: {
+# ifndef DIGSTOOBIG
+    long z = pseudolong(INUM(x));
+    return scm_big_test((BIGDIG *)&z, DIGSPERLONG, (x < 0) ? 0x0100 : 0, y);
+# else
+    BIGDIG zdigs[DIGSPERLONG];
+    longdigs(INUM(x), zdigs);
+    return scm_big_test(zdigs, DIGSPERLONG, (x < 0) ? 0x0100 : 0, y);
+# endif
+  }}
+#else
+  ASRTGO(INUMP(x), badx);
+  ASSERT(INUMP(y), y, ARG2, s_logtest);
+#endif
+  return (INUM(x) & INUM(y)) ? BOOL_T : BOOL_F;
+}
+
+SCM scm_logbitp(index, j1)
+     SCM index, j1;
+{
+  ASSERT(INUMP(index) && INUM(index) >= 0, index, ARG1, s_logbitp);
+#ifdef BIGDIG
+  if NINUMP(j1) {
+    ASSERT(NIMP(j1) && BIGP(j1), j1, (char *)ARG2, s_logbitp);
+    if (NUMDIGS(j1) * BITSPERDIG < INUM(index)) return BOOL_F;
+    else if BIGSIGN(j1) {
+      long num = -1;
+      sizet i = 0;
+      BIGDIG *x = BDIGITS(j1);
+      sizet nx = INUM(index)/BITSPERDIG;
+      while (!0) {
+	num += x[i];
+	if (nx==i++)
+	  return ((1L << (INUM(index)%BITSPERDIG)) & num) ? BOOL_F : BOOL_T;
+	if (num < 0) num = -1;
+	else num = 0;
+      }
+    }
+    else return (BDIGITS(j1)[INUM(index)/BITSPERDIG] &
+		 (1L << (INUM(index)%BITSPERDIG))) ? BOOL_T : BOOL_F;
+  }
+#else
+  ASSERT(INUMP(j1), j1, (char *)ARG2, s_logbitp);
+#endif
+  return ((1L << INUM(index)) & INUM(j1)) ? BOOL_T : BOOL_F;
+}
+
+SCM scm_lognot(n)
+     SCM n;
+{
+  return difference(MAKINUM(-1L), n);
+}
+
+SCM scm_intexpt(z1, z2)
+     SCM z1, z2;
+{
+  SCM acc = MAKINUM(1L);
+#ifdef BIGDIG
+  if (INUM0==z1 || acc==z1) return z1;
+  else if (MAKINUM(-1L)==z1) return BOOL_F==evenp(z2)?z1:acc;
+#endif
+  ASSERT(INUMP(z2), z2, ARG2, s_intexpt);
+  z2 = INUM(z2);
+  if (z2 < 0) {
+    z2 = -z2;
+    z1 = divide(z1, UNDEFINED);
+  }
+  while(1) {
+    if (0==z2) return acc;
+    if (1==z2) return product(acc, z1);
+    if (z2 & 1) acc = product(acc, z1);
+    z1 = product(z1, z1);
+    z2 >>= 1;
+  }
+}
+SCM scm_ash(n, cnt)
+     SCM n, cnt;
+{
+  SCM res = INUM(n);
+  ASSERT(INUMP(cnt), cnt, ARG2, s_ash);
+#ifdef BIGDIG
+  if(cnt < 0) {
+    res = scm_intexpt(MAKINUM(2), MAKINUM(-INUM(cnt)));
+    if NFALSEP(negativep(n))
+      return sum(MAKINUM(-1L), lquotient(sum(MAKINUM(1L), n), res));
+    else return lquotient(n, res);
+  }
+  else return product(n, scm_intexpt(MAKINUM(2), cnt));
+#else
+  ASSERT(INUMP(n), n, ARG1, s_ash);
+  cnt = INUM(cnt);
+  if (cnt < 0) return MAKINUM(SRS(res, -cnt));
+  res = MAKINUM(res<<cnt);
+  if (INUM(res)>>cnt != INUM(n)) wta(n, (char *)OVFLOW, s_ash);
+  return res;
+#endif
+}
+
+SCM scm_bitextract(n, start, end)
+     SCM n, start, end;
+{
+  ASSERT(INUMP(start), start, ARG2, s_bitextract);
+  ASSERT(INUMP(end), end, ARG3, s_bitextract);
+  start = INUM(start); end = INUM(end);
+  ASSERT(end >= start, MAKINUM(end), OUTOFRANGE, s_bitextract);
+#ifdef BIGDIG
+  if NINUMP(n)
+    return
+      scm_logand(difference(scm_intexpt(MAKINUM(2), MAKINUM(end - start)),
+			    MAKINUM(1L)),
+		 scm_ash(n, MAKINUM(-start)));
+#else
+  ASSERT(INUMP(n), n, ARG1, s_bitextract);
+#endif
+  return MAKINUM((INUM(n)>>start) & ((1L<<(end-start))-1));
+}
+
+char logtab[] = {0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4};
+SCM scm_logcount(n)
+     SCM n;
+{
+  register unsigned long c = 0;
+  register long nn;
+#ifdef BIGDIG
+  if NINUMP(n) {
+    sizet i; BIGDIG *ds, d;
+    ASSERT(NIMP(n) && BIGP(n), n, ARG1, s_logcount);
+    if BIGSIGN(n) return scm_logcount(difference(MAKINUM(-1L), n));
+    ds = BDIGITS(n);
+    for(i = NUMDIGS(n); i--; )
+      for(d = ds[i]; d; d >>= 4) c += logtab[15 & d];
+    return MAKINUM(c);
+  }
+#else
+  ASSERT(INUMP(n), n, ARG1, s_logcount);
+#endif
+  if ((nn = INUM(n)) < 0) nn = -1 - nn;
+  for(; nn; nn >>= 4) c += logtab[15 & nn];
+  return MAKINUM(c);
+}
+
+char ilentab[] = {0, 1, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4};
+SCM scm_intlength(n)
+     SCM n;
+{
+  register unsigned long c = 0;
+  register long nn;
+  unsigned int l = 4;
+#ifdef BIGDIG
+  if NINUMP(n) {
+    BIGDIG *ds, d;
+    ASSERT(NIMP(n) && BIGP(n), n, ARG1, s_intlength);
+    if BIGSIGN(n) return scm_intlength(difference(MAKINUM(-1L), n));
+    ds = BDIGITS(n);
+    d = ds[c = NUMDIGS(n)-1];
+    for(c *= BITSPERDIG; d; d >>= 4) {c += 4; l = ilentab[15 & d];}
+    return MAKINUM(c - 4 + l);
+  }
+#else
+  ASSERT(INUMP(n), n, ARG1, s_intlength);
+#endif
+  if ((nn = INUM(n)) < 0) nn = -1 - nn;
+  for(;nn; nn >>= 4) {c += 4; l = ilentab[15 & nn];}
+  return MAKINUM(c - 4 + l);
+}
+
+SCM charp(x)
+     SCM x;
+{
+	return ICHRP(x) ? BOOL_T : BOOL_F;
+}
+SCM char_lessp(x, y)
+     SCM x, y;
+{
+	ASSERT(ICHRP(x), x, ARG1, s_ch_lessp);
+	ASSERT(ICHRP(y), y, ARG2, s_ch_lessp);
+	return (ICHR(x) < ICHR(y)) ? BOOL_T : BOOL_F;
+}
+SCM char_leqp(x, y)
+     SCM x, y;
+{
+	ASSERT(ICHRP(x), x, ARG1, s_ch_leqp);
+	ASSERT(ICHRP(y), y, ARG2, s_ch_leqp);
+	return (ICHR(x) <= ICHR(y)) ? BOOL_T : BOOL_F;
+}
+SCM char_grp(x, y)
+     SCM x, y;
+{
+	ASSERT(ICHRP(x), x, ARG1, s_ch_grp);
+	ASSERT(ICHRP(y), y, ARG2, s_ch_grp);
+	return (ICHR(x) > ICHR(y)) ? BOOL_T : BOOL_F;
+}
+SCM char_geqp(x, y)
+     SCM x, y;
+{
+	ASSERT(ICHRP(x), x, ARG1, s_ch_geqp);
+	ASSERT(ICHRP(y), y, ARG2, s_ch_geqp);
+	return (ICHR(x) >= ICHR(y)) ? BOOL_T : BOOL_F;
+}
+SCM chci_eq(x, y)
+     SCM x, y;
+{
+	ASSERT(ICHRP(x), x, ARG1, s_ci_eq);
+	ASSERT(ICHRP(y), y, ARG2, s_ci_eq);
+	return (upcase[ICHR(x)]==upcase[ICHR(y)]) ? BOOL_T : BOOL_F;
+}
+SCM chci_lessp(x, y)
+     SCM x, y;
+{
+	ASSERT(ICHRP(x), x, ARG1, s_ci_lessp);
+	ASSERT(ICHRP(y), y, ARG2, s_ci_lessp);
+	return (upcase[ICHR(x)] < upcase[ICHR(y)]) ? BOOL_T : BOOL_F;
+}
+SCM chci_leqp(x, y)
+     SCM x, y;
+{
+	ASSERT(ICHRP(x), x, ARG1, s_ci_leqp);
+	ASSERT(ICHRP(y), y, ARG2, s_ci_leqp);
+	return (upcase[ICHR(x)] <= upcase[ICHR(y)]) ? BOOL_T : BOOL_F;
+}
+SCM chci_grp(x, y)
+     SCM x, y;
+{
+	ASSERT(ICHRP(x), x, ARG1, s_ci_grp);
+	ASSERT(ICHRP(y), y, ARG2, s_ci_grp);
+	return (upcase[ICHR(x)] > upcase[ICHR(y)]) ? BOOL_T : BOOL_F;
+}
+SCM chci_geqp(x, y)
+     SCM x, y;
+{
+	ASSERT(ICHRP(x), x, ARG1, s_ci_geqp);
+	ASSERT(ICHRP(y), y, ARG2, s_ci_geqp);
+	return (upcase[ICHR(x)] >= upcase[ICHR(y)]) ? BOOL_T : BOOL_F;
+}
+SCM char_alphap(chr)
+     SCM chr;
+{
+	ASSERT(ICHRP(chr), chr, ARG1, s_ch_alphap);
+	return (isascii(ICHR(chr)) && isalpha(ICHR(chr))) ? BOOL_T : BOOL_F;
+}
+SCM char_nump(chr)
+     SCM chr;
+{
+	ASSERT(ICHRP(chr), chr, ARG1, s_ch_nump);
+	return (isascii(ICHR(chr)) && isdigit(ICHR(chr))) ? BOOL_T : BOOL_F;
+}
+SCM char_whitep(chr)
+     SCM chr;
+{
+	ASSERT(ICHRP(chr), chr, ARG1, s_ch_whitep);
+	return (isascii(ICHR(chr)) && isspace(ICHR(chr))) ? BOOL_T : BOOL_F;
+}
+SCM char_upperp(chr)
+     SCM chr;
+{
+	ASSERT(ICHRP(chr), chr, ARG1, s_ch_upperp);
+	return (isascii(ICHR(chr)) && isupper(ICHR(chr))) ? BOOL_T : BOOL_F;
+}
+SCM char_lowerp(chr)
+     SCM chr;
+{
+	ASSERT(ICHRP(chr), chr, ARG1, s_ch_lowerp);
+	return (isascii(ICHR(chr)) && islower(ICHR(chr))) ? BOOL_T : BOOL_F;
+}
+SCM char2int(chr)
+     SCM chr;
+{
+	ASSERT(ICHRP(chr), chr, ARG1, s_char2int);
+	return MAKINUM(ICHR(chr));
+}
+SCM int2char(n)
+     SCM n;
+{
+  ASSERT(INUMP(n), n, ARG1, s_int2char);
+  ASSERT((n >= INUM0) && (n < MAKINUM(CHAR_CODE_LIMIT)),
+	 n, OUTOFRANGE, s_int2char);
+  return MAKICHR(INUM(n));
+}
+SCM char_upcase(chr)
+     SCM chr;
+{
+	ASSERT(ICHRP(chr), chr, ARG1, s_ch_upcase);
+	return MAKICHR(upcase[ICHR(chr)]);
+}
+SCM char_downcase(chr)
+     SCM chr;
+{
+	ASSERT(ICHRP(chr), chr, ARG1, s_ch_downcase);
+	return MAKICHR(downcase[ICHR(chr)]);
+}
+
+SCM stringp(x)
+     SCM x;
+{
+	if IMP(x) return BOOL_F;
+	return STRINGP(x) ? BOOL_T : BOOL_F;
+}
+SCM string(chrs)
+     SCM chrs;
+{
+	SCM res;
+	register char *data;
+	long i = ilength(chrs);
+	ASSERT(i >= 0, chrs, ARG1, s_string);
+	res = makstr(i);
+	data = CHARS(res);
+	for(;NNULLP(chrs);chrs = CDR(chrs)) {
+		ASSERT(ICHRP(CAR(chrs)), chrs, ARG1, s_string);
+		*data++ = ICHR(CAR(chrs));
+	}
+	return res;
+}
+SCM make_string(k, chr)
+     SCM k, chr;
+{
+	SCM res;
+	register char *dst;
+	register long i;
+	ASSERT(INUMP(k) && (k >= 0), k, ARG1, s_make_string);
+	i = INUM(k);
+	res = makstr(i);
+	dst = CHARS(res);
+	if (!UNBNDP(chr)) {
+	  ASSERT(ICHRP(chr), chr, ARG2, s_make_string);
+	  for(i--;i >= 0;i--) dst[i] = ICHR(chr);
+	}
+	return res;
+}
+SCM st_length(str)
+     SCM str;
+{
+	ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_st_length);
+	return MAKINUM(LENGTH(str));
+}
+SCM st_ref(str, k)
+     SCM str, k;
+{
+	ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_st_ref);
+	ASSERT(INUMP(k), k, ARG2, s_st_ref);
+	ASSERT(INUM(k) < LENGTH(str) && INUM(k) >= 0, k, OUTOFRANGE, s_st_ref);
+	return MAKICHR(CHARS(str)[INUM(k)]);
+}
+SCM st_set(str, k, chr)
+     SCM str, k, chr;
+{
+	ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_st_set);
+	ASSERT(INUMP(k), k, ARG2, s_st_set);
+	ASSERT(ICHRP(chr), chr, ARG3, s_st_set);
+	ASSERT(INUM(k) < LENGTH(str) && INUM(k) >= 0, k, OUTOFRANGE, s_st_set);
+	CHARS(str)[INUM(k)] = ICHR(chr);
+	return UNSPECIFIED;
+}
+SCM st_equal(s1, s2)
+     SCM s1, s2;
+{
+	register sizet i;
+	register char *c1, *c2;
+	ASSERT(NIMP(s1) && STRINGP(s1), s1, ARG1, s_st_equal);
+	ASSERT(NIMP(s2) && STRINGP(s2), s2, ARG2, s_st_equal);
+	i = LENGTH(s2);
+	if (LENGTH(s1) != i) return BOOL_F;
+	c1 = CHARS(s1);
+	c2 = CHARS(s2);
+	while(0 != i--) if(*c1++ != *c2++) return BOOL_F;
+	return BOOL_T;
+}
+SCM stci_equal(s1, s2)
+     SCM s1, s2;
+{
+	register sizet i;
+	register unsigned char *c1, *c2;
+	ASSERT(NIMP(s1) && STRINGP(s1), s1, ARG1, s_stci_equal);
+	ASSERT(NIMP(s2) && STRINGP(s2), s2, ARG2, s_stci_equal);
+	i = LENGTH(s2);
+	if (LENGTH(s1) != i) return BOOL_F;
+	c1 = UCHARS(s1);
+	c2 = UCHARS(s2);
+	while(0 != i--) if(upcase[*c1++] != upcase[*c2++]) return BOOL_F;
+	return BOOL_T;
+}
+SCM st_lessp(s1, s2)
+     SCM s1, s2;
+{
+	register sizet i, len;
+	register unsigned char *c1, *c2;
+	register int c;
+	ASSERT(NIMP(s1) && STRINGP(s1), s1, ARG1, s_st_lessp);
+	ASSERT(NIMP(s2) && STRINGP(s2), s2, ARG2, s_st_lessp);
+	len = LENGTH(s1);
+	i = LENGTH(s2);
+	if (len>i) i = len;
+	c1 = UCHARS(s1);
+	c2 = UCHARS(s2);
+	for(i = 0;i<len;i++) {
+		c = (*c1++ - *c2++);
+		if (c>0) return BOOL_F;
+		if (c<0) return BOOL_T;
+	}
+	return (LENGTH(s2) != len) ? BOOL_T : BOOL_F;
+}
+SCM st_leqp(s1, s2)
+     SCM s1, s2;
+{
+  return BOOL_NOT(st_lessp(s2, s1));
+}
+SCM st_grp(s1, s2)
+     SCM s1, s2;
+{
+  return st_lessp(s2, s1);
+}
+SCM st_geqp(s1, s2)
+     SCM s1, s2;
+{
+  return BOOL_NOT(st_lessp(s1, s2));
+}
+SCM stci_lessp(s1, s2)
+     SCM s1, s2;
+{
+	register sizet i, len;
+	register unsigned char *c1, *c2;
+	register int c;
+	ASSERT(NIMP(s1) && STRINGP(s1), s1, ARG1, s_stci_lessp);
+	ASSERT(NIMP(s2) && STRINGP(s2), s2, ARG2, s_stci_lessp);
+	len = LENGTH(s1);
+	i = LENGTH(s2);
+	if (len>i) i=len;
+	c1 = UCHARS(s1);
+	c2 = UCHARS(s2);
+	for(i = 0;i<len;i++) {
+		c = (upcase[*c1++] - upcase[*c2++]);
+		if (c>0) return BOOL_F;
+		if (c<0) return BOOL_T;
+	}
+	return (LENGTH(s2) != len) ? BOOL_T : BOOL_F;
+}
+SCM stci_leqp(s1, s2)
+     SCM s1, s2;
+{
+  return BOOL_NOT(stci_lessp(s2, s1));
+}
+SCM stci_grp(s1, s2)
+     SCM s1, s2;
+{
+  return stci_lessp(s2, s1);
+}
+SCM stci_geqp(s1, s2)
+     SCM s1, s2;
+{
+  return BOOL_NOT(stci_lessp(s1, s2));
+}
+SCM substring(str, start, end)
+     SCM str, start, end;
+{
+	long l;
+	ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_substring);
+	ASSERT(INUMP(start), start, ARG2, s_substring);
+	ASSERT(INUMP(end), end, ARG3, s_substring);
+	ASSERT(INUM(start) <= LENGTH(str), start, OUTOFRANGE, s_substring);
+	ASSERT(INUM(end) <= LENGTH(str), end, OUTOFRANGE, s_substring);
+	l = INUM(end)-INUM(start);
+	ASSERT(l >= 0, MAKINUM(l), OUTOFRANGE, s_substring);
+	return makfromstr(&CHARS(str)[INUM(start)], (sizet)l);
+}
+SCM st_append(args)
+     SCM args;
+{
+	SCM res;
+	register long i = 0;
+	register SCM l, s;
+	register char *data;
+	for(l = args;NIMP(l);) {
+		ASSERT(CONSP(l), l, ARGn, s_st_append);
+		s = CAR(l);
+		ASSERT(NIMP(s) && STRINGP(s), s, ARGn, s_st_append);
+		i += LENGTH(s);
+		l = CDR(l);
+	}
+	ASSERT(NULLP(l), args, ARGn, s_st_append);
+	res = makstr(i);
+	data = CHARS(res);
+	for(l = args;NIMP(l);l = CDR(l)) {
+		s = CAR(l);
+		for(i = 0;i<LENGTH(s);i++) *data++ = CHARS(s)[i];
+	}
+	return res;
+}
+
+SCM vectorp(x)
+     SCM x;
+{
+	if IMP(x) return BOOL_F;
+	return VECTORP(x) ? BOOL_T : BOOL_F;
+}
+SCM vector_length(v)
+     SCM v;
+{
+	ASSERT(NIMP(v) && VECTORP(v), v, ARG1, s_ve_length);
+	return MAKINUM(LENGTH(v));
+}
+SCM vector(l)
+     SCM l;
+{
+	SCM res;
+	register SCM *data;
+	long i = ilength(l);
+	ASSERT(i >= 0, l, ARG1, s_vector);
+	res = make_vector(MAKINUM(i), UNSPECIFIED);
+	data = VELTS(res);
+	for(;NIMP(l);l = CDR(l)) *data++ = CAR(l);
+	return res;
+}
+SCM vector_ref(v, k)
+     SCM v, k;
+{
+  ASSERT(NIMP(v) && VECTORP(v), v, ARG1, s_ve_ref);
+  ASSERT(INUMP(k), k, ARG2, s_ve_ref);
+  ASSERT((INUM(k) < LENGTH(v)) && (INUM(k) >= 0), k, OUTOFRANGE, s_ve_ref);
+  return VELTS(v)[((long) INUM(k))];
+}
+SCM vector_set(v, k, obj)
+     SCM v, k, obj;
+{
+  ASSERT(NIMP(v) && VECTORP(v), v, ARG1, s_ve_set);
+  ASSERT(INUMP(k), k, ARG2, s_ve_set);
+  ASSERT((INUM(k) < LENGTH(v)) && (INUM(k) >= 0), k, OUTOFRANGE, s_ve_set);
+  VELTS(v)[((long) INUM(k))] = obj;
+  return UNSPECIFIED;
+}
+char	s_make_vector[] = "make-vector";
+SCM make_vector(k, fill)
+     SCM k, fill;
+{
+	SCM v;
+	register long i;
+	register SCM *velts;
+	ASSERT(INUMP(k), k, ARG1, s_make_vector);
+	if UNBNDP(fill) fill = UNSPECIFIED;
+	i = INUM(k);
+	NEWCELL(v);
+	DEFER_INTS;
+	SETCHARS(v, must_malloc(i?(long)(i*sizeof(SCM)):1L, s_vector));
+	SETLENGTH(v, i, tc7_vector);
+	velts = VELTS(v);
+	while(--i >= 0) (velts)[i] = fill;
+	ALLOW_INTS;
+	return v;
+}
+#ifdef BIGDIG
+char s_bignum[] = "bignum";
+SCM mkbig(nlen, sign)
+     sizet nlen;
+     int sign;
+{
+	SCM v = nlen;
+	if (((v << 16) >> 16) != nlen)
+	  wta(MAKINUM(v), (char *)NALLOC, s_bignum);
+	NEWCELL(v);
+	DEFER_INTS;
+	SETCHARS(v, must_malloc((long)(nlen*sizeof(BIGDIG)), s_bignum));
+	SETNUMDIGS(v, nlen, sign?tc16_bigneg:tc16_bigpos);
+	ALLOW_INTS;
+	return v;
+}
+SCM big2inum(b, l)
+     SCM b;
+     sizet l;
+{
+  unsigned long num = 0;
+  BIGDIG *tmp = BDIGITS(b);
+  while (l--) num = BIGUP(num) + tmp[l];
+  if (TYP16(b)==tc16_bigpos) {
+    if POSFIXABLE(num) return MAKINUM(num);
+  }
+  else if UNEGFIXABLE(num) return MAKINUM(-num);
+  return b;
+}
+char s_adjbig[] = "adjbig";
+SCM adjbig(b, nlen)
+     SCM b;
+     sizet nlen;
+{
+  long nsiz = nlen;
+  if (((nsiz << 16) >> 16) != nlen) wta(MAKINUM(nsiz), (char *)NALLOC, s_adjbig);
+  DEFER_INTS;
+  SETCHARS(b, (BIGDIG *)must_realloc((char *)CHARS(b),
+				    (long)(NUMDIGS(b)*sizeof(BIGDIG)),
+				    (long)(nsiz*sizeof(BIGDIG)), s_adjbig));
+  SETNUMDIGS(b, nsiz, TYP16(b));
+  ALLOW_INTS;
+  return b;
+}
+SCM normbig(b)
+     SCM b;
+{
+# ifndef _UNICOS
+  sizet nlen = NUMDIGS(b);
+# else
+  int nlen = NUMDIGS(b);   /* unsigned nlen breaks on Cray when nlen => 0 */
+# endif
+  BIGDIG *zds = BDIGITS(b);
+  while (nlen-- && !zds[nlen]); nlen++;
+  if (nlen * BITSPERDIG/CHAR_BIT <= sizeof(SCM))
+    if INUMP(b = big2inum(b, (sizet)nlen)) return b;
+  if (NUMDIGS(b)==nlen) return b;
+  return adjbig(b, (sizet)nlen);
+}
+SCM copybig(b, sign)
+     SCM b;
+     int sign;
+{
+  sizet i = NUMDIGS(b);
+  SCM ans = mkbig(i, sign);
+  BIGDIG *src = BDIGITS(b), *dst = BDIGITS(ans);
+  while (i--) dst[i] = src[i];
+  return ans;
+}
+SCM long2big(n)
+     long n;
+{
+  sizet i = 0;
+  BIGDIG *digits;
+  SCM ans = mkbig(DIGSPERLONG, n<0);
+  digits = BDIGITS(ans);
+  if (n < 0) n = -n;
+  while (i < DIGSPERLONG) {
+    digits[i++] = BIGLO(n);
+    n = BIGDN((unsigned long)n);
+  }
+  return ans;
+}
+SCM ulong2big(n)
+     unsigned long n;
+{
+  sizet i = 0;
+  BIGDIG *digits;
+  SCM ans = mkbig(DIGSPERLONG, 0);
+  digits = BDIGITS(ans);
+  while (i < DIGSPERLONG) {
+    digits[i++] = BIGLO(n);
+    n = BIGDN(n);
+  }
+  return ans;
+}
+
+int bigcomp(x, y)
+     SCM x, y;
+{
+  int xsign = BIGSIGN(x);
+  int ysign = BIGSIGN(y);
+  sizet xlen, ylen;
+  if (ysign < xsign) return 1;
+  if (ysign > xsign) return -1;
+  if ((ylen = NUMDIGS(y)) > (xlen = NUMDIGS(x))) return (xsign) ? -1 : 1;
+  if (ylen < xlen) return (xsign) ? 1 : -1;
+  while(xlen-- && (BDIGITS(y)[xlen]==BDIGITS(x)[xlen]));
+  if (-1==xlen) return 0;
+  return (BDIGITS(y)[xlen] > BDIGITS(x)[xlen]) ?
+    (xsign ? -1 : 1) : (xsign ? 1 : -1);
+}
+
+# ifndef DIGSTOOBIG
+long pseudolong(x)
+    long x;
+{
+  union {
+    long l;
+    BIGDIG bd[DIGSPERLONG];
+  } p;
+  sizet i = 0;
+  if (x < 0) x = -x;
+  while (i < DIGSPERLONG) {p.bd[i++] = BIGLO(x); x = BIGDN(x);}
+/*  p.bd[0] = BIGLO(x); p.bd[1] = BIGDN(x); */
+  return p.l;
+}
+# else
+void longdigs(x, digs)
+     long x;
+     BIGDIG digs[DIGSPERLONG];
+{
+  sizet i = 0;
+  if (x < 0) x = -x;
+  while (i < DIGSPERLONG) {digs[i++] = BIGLO(x); x = BIGDN(x);}
+}
+# endif
+
+SCM addbig(x, nx, xsgn, bigy, sgny)
+     BIGDIG *x;
+     SCM bigy;
+     sizet nx;		/* Assumes nx <= NUMDIGS(bigy) */
+     int xsgn, sgny;	/* Assumes xsgn and sgny equal either 0 or 0x0100 */
+{
+  long num = 0;
+  sizet i = 0, ny = NUMDIGS(bigy);
+  SCM z = copybig(bigy, BIGSIGN(bigy) ^ sgny);
+  BIGDIG *zds = BDIGITS(z);
+  if (xsgn ^ BIGSIGN(z)) {
+    do {
+      num += (long) zds[i] - x[i];
+      if (num < 0) {zds[i] = num + BIGRAD; num = -1;}
+      else {zds[i] = BIGLO(num); num = 0;}
+    } while (++i < nx);
+    if (num && nx==ny) {
+      num = 1; i = 0;
+      CAR(z) ^= 0x0100;
+      do {
+	num += (BIGRAD-1) - zds[i];
+	zds[i++] = BIGLO(num);
+	num = BIGDN(num);
+      } while (i < ny);
+    }
+    else while (i < ny) {
+      num += zds[i];
+      if (num < 0) {zds[i++] = num + BIGRAD; num = -1;}
+      else {zds[i++] = BIGLO(num); num = 0;}
+    }
+  } else {
+    do {
+      num += (long) zds[i] + x[i];
+      zds[i++] = BIGLO(num);
+      num = BIGDN(num);
+    } while (i < nx);
+    if (!num) return z;
+    while (i < ny) {
+      num += zds[i];
+      zds[i++] = BIGLO(num);
+      num = BIGDN(num);
+      if (!num) return z;
+    }
+    if (num) {z = adjbig(z, ny+1); BDIGITS(z)[ny] = num; return z;}
+  }
+  return normbig(z);
+}
+
+SCM mulbig(x, nx, y, ny, sgn)
+     BIGDIG *x, *y;
+     sizet nx, ny;
+     int sgn;
+{
+  sizet i = 0, j = nx + ny;
+  unsigned long n = 0;
+  SCM z = mkbig(j, sgn);
+  BIGDIG *zds = BDIGITS(z);
+  while (j--) zds[j] = 0;
+  do {
+    j = 0;
+    if (x[i]) {
+      do {
+	n += zds[i + j] + ((unsigned long) x[i] * y[j]);
+	zds[i + j++] = BIGLO(n);
+	n = BIGDN(n);
+      } while (j < ny);
+      if (n) {zds[i + j] = n; n = 0;}
+    }
+  } while (++i < nx);
+  return normbig(z);
+}
+unsigned int divbigdig(ds, h, div)
+     BIGDIG *ds;
+     sizet h;
+     BIGDIG div;
+{
+  register unsigned long t2 = 0;
+  while(h--) {
+    t2 = BIGUP(t2) + ds[h];
+    ds[h] = t2 / div;
+    t2 %= div;
+  }
+  return t2;
+}
+SCM divbigint(x, z, sgn, mode)
+     SCM x;
+     long z;
+     int sgn, mode;
+{
+  if (z < 0) z = -z;
+  if (z < BIGRAD) {
+    register unsigned long t2 = 0;
+    register BIGDIG *ds = BDIGITS(x);
+    sizet nd = NUMDIGS(x);
+    while(nd--) t2 = (BIGUP(t2) + ds[nd]) % z;
+    if (mode && t2) t2 = z - t2;
+    return MAKINUM(sgn ? -t2 : t2);
+  }
+  {
+# ifndef DIGSTOOBIG
+    unsigned long t2 = pseudolong(z);
+    return divbigbig(BDIGITS(x), NUMDIGS(x), (BIGDIG *)&t2,
+		     DIGSPERLONG, sgn, mode);
+# else
+    BIGDIG t2[DIGSPERLONG];
+    longdigs(z, t2);
+    return divbigbig(BDIGITS(x), NUMDIGS(x), t2, DIGSPERLONG, sgn, mode);
+# endif
+  }
+}
+SCM divbigbig(x, nx, y, ny, sgn, modes)
+     BIGDIG *x, *y;
+     sizet nx, ny;
+     int sgn, modes;
+     /* modes description
+	0	remainder
+	1	modulo
+	2	quotient
+	3	quotient but returns 0 if division is not exact. */
+{
+  sizet i = 0, j = 0;
+  long num = 0;
+  unsigned long t2 = 0;
+  SCM z, newy;
+  BIGDIG  d = 0, qhat, *zds, *yds;
+  /* algorithm requires nx >= ny */
+  if (nx < ny)
+    switch (modes) {
+    case 0:			/* remainder -- just return x */
+      z = mkbig(nx, sgn); zds = BDIGITS(z);
+      do {zds[i] = x[i];} while (++i < nx);
+      return z;
+    case 1:			/* modulo -- return y-x */
+      z = mkbig(ny, sgn); zds = BDIGITS(z);
+      do {
+	num += (long) y[i] - x[i];
+	if (num < 0) {zds[i] = num + BIGRAD; num = -1;}
+	else {zds[i] = num; num = 0;}
+      } while (++i < nx);
+      while (i < ny) {
+	num += y[i];
+	if (num < 0) {zds[i++] = num + BIGRAD; num = -1;}
+	else {zds[i++] = num; num = 0;}
+      }
+      goto doadj;
+    case 2: return INUM0;	/* quotient is zero */
+    case 3: return 0;		/* the division is not exact */
+    }
+
+  z = mkbig(nx==ny ? nx+2 : nx+1, sgn); zds = BDIGITS(z);
+  if (nx==ny) zds[nx+1] = 0;
+  while(!y[ny-1]) ny--;		/* in case y came in as a psuedolong */
+  if (y[ny-1] < (BIGRAD>>1)) {  /* normalize operands */
+    d = BIGRAD/(y[ny-1]+1);
+    newy = mkbig(ny, 0); yds = BDIGITS(newy);
+    while(j < ny)
+      {t2 += (unsigned long) y[j]*d; yds[j++] = BIGLO(t2); t2 = BIGDN(t2);}
+    y = yds; j = 0; t2 = 0;
+    while(j < nx)
+      {t2 += (unsigned long) x[j]*d; zds[j++] = BIGLO(t2); t2 = BIGDN(t2);}
+    zds[j] = t2;
+  }
+  else {zds[j = nx] = 0; while (j--) zds[j] = x[j];}
+  j = nx==ny ? nx+1 : nx;	/* dividend needs more digits than divisor */
+  do {				/* loop over digits of quotient */
+    if (zds[j]==y[ny-1]) qhat = BIGRAD-1;
+    else qhat = (BIGUP(zds[j]) + zds[j-1])/y[ny-1];
+    if (!qhat) continue;
+    i = 0; num = 0; t2 = 0;
+    do {			/* multiply and subtract */
+      t2 += (unsigned long) y[i] * qhat;
+      num += zds[j - ny + i] - BIGLO(t2);
+      if (num < 0) {zds[j - ny + i] = num + BIGRAD; num = -1;}
+      else {zds[j - ny + i] = num; num = 0;}
+      t2 = BIGDN(t2);
+    } while (++i < ny);
+    num += zds[j - ny + i] - t2; /* borrow from high digit; don't update */
+    while (num) {		/* "add back" required */
+      i = 0; num = 0; qhat--;
+      do {
+	num += (long) zds[j - ny + i] + y[i];
+	zds[j - ny + i] = BIGLO(num);
+	num = BIGDN(num);
+      } while (++i < ny);
+      num--;
+    }
+    if (modes & 2) zds[j] = qhat;
+  } while (--j >= ny);
+  switch (modes) {
+  case 3:			/* check that remainder==0 */
+    for(j = ny;j && !zds[j-1];--j) ; if (j) return 0;
+  case 2:			/* move quotient down in z */
+    j = (nx==ny ? nx+2 : nx+1) - ny;
+    for (i = 0;i < j;i++) zds[i] = zds[i+ny];
+    ny = i;
+    break;
+  case 1:			/* subtract for modulo */
+    i = 0; num = 0; j = 0;
+    do {num += y[i] - zds[i];
+	j = j | zds[i];
+	if (num < 0) {zds[i] = num + BIGRAD; num = -1;}
+	else {zds[i] = num; num = 0;}
+      } while (++i < ny);
+    if (!j) return INUM0;
+  case 0:			/* just normalize remainder */
+    if (d) divbigdig(zds, ny, d);
+  }
+ doadj:
+  for(j = ny;j && !zds[j-1];--j) ;
+  if (j * BITSPERDIG <= sizeof(SCM)*CHAR_BIT)
+    if INUMP(z = big2inum(z, j)) return z;
+  return adjbig(z, j);
+}
+#endif
+
+static iproc cxrs[] = {
+	{"car", 0}, {"cdr", 0},
+	{"caar", 0}, {"cadr", 0}, {"cdar", 0}, {"cddr", 0},
+	{"caaar", 0}, {"caadr", 0}, {"cadar", 0}, {"caddr", 0},
+	{"cdaar", 0}, {"cdadr", 0}, {"cddar", 0}, {"cdddr", 0},
+	{"caaaar", 0}, {"caaadr", 0}, {"caadar", 0}, {"caaddr", 0},
+	{"cadaar", 0}, {"cadadr", 0}, {"caddar", 0}, {"cadddr", 0},
+	{"cdaaar", 0}, {"cdaadr", 0}, {"cdadar", 0}, {"cdaddr", 0},
+	{"cddaar", 0}, {"cddadr", 0}, {"cdddar", 0}, {"cddddr", 0},
+	{0, 0}};
+
+static iproc subr1s[] = {
+	{"not", lnot},
+	{"boolean?", booleanp},
+	{"pair?", consp},
+	{"null?", nullp},
+	{"list?", listp},
+	{s_length, length},
+	{s_reverse, reverse},
+	{"symbol?", symbolp},
+	{s_symbol2string, symbol2string},
+	{s_str2symbol, string2symbol},
+	{s_exactp, exactp},
+	{s_oddp, oddp},
+	{s_evenp, evenp},
+	{s_abs, absval},
+	{s_lognot, scm_lognot},
+	{s_logcount, scm_logcount},
+	{s_intlength, scm_intlength},
+	{"char?", charp},
+	{s_ch_alphap, char_alphap},
+	{s_ch_nump, char_nump},
+	{s_ch_whitep, char_whitep},
+	{s_ch_upperp, char_upperp},
+	{s_ch_lowerp, char_lowerp},
+	{s_char2int, char2int},
+	{s_int2char, int2char},
+	{s_ch_upcase, char_upcase},
+	{s_ch_downcase, char_downcase},
+	{"string?", stringp},
+	{s_st_length, st_length},
+	{"vector?", vectorp},
+	{s_ve_length, vector_length},
+	{"procedure?", procedurep},
+	{0, 0}};
+
+static char s_acons[] = "acons";
+static iproc subr2s[] = {
+	{&s_acons[1], cons},
+	{s_setcar, setcar},
+	{s_setcdr, setcdr},
+	{s_list_ref, list_ref},
+	{s_memq, memq},
+	{s_member, member},
+	{s_assq, assq},
+	{s_assoc, assoc},
+	{s_quotient, lquotient},
+	{s_remainder, lremainder},
+	{s_modulo, modulo},
+	{s_logtest, scm_logtest},
+	{s_logbitp, scm_logbitp},
+	{s_ash, scm_ash},
+	{s_intexpt, scm_intexpt},
+	{s_st_ref, st_ref},
+	{"string<=?", st_leqp},
+	{"string-ci<=?", stci_leqp},
+	{s_ve_ref, vector_ref},
+	{0, 0}};
+
+static iproc lsubrs[] = {
+	{s_list, list},
+	{s_append, append},
+	{s_string, string},
+	{s_st_append, st_append},
+	{s_vector, vector},
+	{0, 0}};
+
+static iproc subr2os[] = {
+	{s_make_string, make_string},
+	{s_make_vector, make_vector},
+	{0, 0}};
+
+static iproc asubrs[] = {
+	{s_gcd, lgcd},
+	{"lcm", llcm},
+	{s_logand, scm_logand},
+	{s_logior, scm_logior},
+	{s_logxor, scm_logxor},
+	{0, 0}};
+
+static iproc rpsubrs[] = {
+	{"eq?", eq},
+	{"equal?", equal},
+	{"char=?", eq},
+	{s_ch_lessp, char_lessp},
+	{s_ci_eq, chci_eq},
+	{s_ci_lessp, chci_lessp},
+	{s_ch_leqp, char_leqp},
+	{s_ci_leqp, chci_leqp},
+	{s_ch_grp, char_grp},
+	{s_ci_grp, chci_grp},
+	{s_ch_geqp, char_geqp},
+	{s_ci_geqp, chci_geqp},
+
+	{s_st_equal, st_equal},
+	{s_stci_equal, stci_equal},
+	{s_st_lessp, st_lessp},
+	{s_stci_lessp, stci_lessp},
+	{"string>?", st_grp},
+	{"string-ci>?", stci_grp},
+	{"string>=?", st_geqp},
+	{"string-ci>=?", stci_geqp},
+	{0, 0}};
+
+static iproc subr3s[] = {
+	{s_bitextract, scm_bitextract},
+	{s_substring, substring},
+	{s_acons, acons},
+	{s_st_set, st_set},
+	{s_ve_set, vector_set},
+	{0, 0}};
+
+void init_iprocs(subra, type)
+     iproc *subra;
+     int type;
+{
+  for(;subra->string; subra++)
+    make_subr(subra->string,
+	      type,
+	      subra->cproc);
+}
+
+void init_subrs()
+{
+  init_iprocs(cxrs, tc7_cxr);
+  init_iprocs(subr1s, tc7_subr_1);
+  init_iprocs(subr2s, tc7_subr_2);
+  init_iprocs(subr2os, tc7_subr_2o);
+  init_iprocs(rpsubrs, tc7_rpsubr);
+  init_iprocs(lsubrs, tc7_lsubr);
+  init_iprocs(asubrs, tc7_asubr);
+  init_iprocs(subr3s, tc7_subr_3);
+}
diff --git a/sys.c b/sys.c
new file mode 100644
index 0000000..0a9615b
--- /dev/null
+++ b/sys.c
@@ -0,0 +1,1758 @@
+/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  
+ */
+
+/* "sys.c" opening and closing files, storage, and GC. */
+
+#include <ctype.h>
+
+#include "scm.h"
+#include "setjump.h"
+void	igc P((char *what, STACKITEM *stackbase));
+
+/* ttyname() etc. should be defined in <unistd.h>.  But unistd.h is
+   missing on many systems. */
+
+#ifndef STDC_HEADERS
+	char *ttyname P((int fd));
+	char *tmpnam P((char *s));
+	sizet fwrite ();
+# ifdef sun
+#  ifndef __svr4__
+        int fputs P((char *s, FILE* stream));
+        int fputc P((char c, FILE* stream));
+        int fflush P((FILE* stream));
+#  endif
+# endif
+	int fgetc P((FILE* stream));
+	int fclose P((FILE* stream));
+	int pclose P((FILE* stream));
+	int unlink P((const char *pathname));
+	char *mktemp P((char *template));
+#endif
+
+static void gc_sweep P((void));
+
+char	s_nogrow[] = "could not grow", s_heap[] = "heap",
+	s_hplims[] = "hplims";
+static char	s_input_portp[] = "input-port?",
+		s_output_portp[] = "output-port?";
+static char	s_open_file[] = "open-file";
+char	s_close_port[] = "close-port";
+
+#ifdef __IBMC__
+# include <io.h>
+# include <direct.h>
+# define ttyname(x) "CON:"
+#else
+# ifndef MSDOS
+#  ifndef ultrix
+#   ifndef vms
+#    ifdef _DCC
+#     include <ioctl.h>
+#     define setbuf(stream, buf) setvbuf(stream, buf, _IONBF, 0)
+#    else
+#     ifdef MWC
+#      include <sys/io.h>
+#     else
+#      ifndef THINK_C
+#       ifndef ARM_ULIB
+#        include <sys/ioctl.h>
+#       endif
+#      endif
+#     endif
+#    endif
+#   endif
+#  endif
+# endif
+#endif /* __IBMC__ */
+SCM i_setbuf0(port)		/* should be called with DEFER_INTS active */
+     SCM port;
+{
+#ifndef NOSETBUF
+# ifndef MSDOS
+#  ifdef FIONREAD
+#   ifndef ultrix
+  SYSCALL(setbuf(STREAM(port), 0););
+#   endif
+#  endif
+# endif
+#endif
+  return UNSPECIFIED;
+}
+
+long mode_bits(modes)
+     char *modes;
+{
+  return OPN | (strchr(modes, 'r') || strchr(modes, '+') ? RDNG : 0)
+    | (strchr(modes, 'w') || strchr(modes, 'a') || strchr(modes, '+') ? WRTNG : 0)
+      | (strchr(modes, '0') ? BUF0 : 0);
+}
+
+SCM open_file(filename, modes)
+     SCM filename, modes;
+{
+  register SCM port;
+  FILE *f;
+  ASSERT(NIMP(filename) && STRINGP(filename), filename, ARG1, s_open_file);
+  ASSERT(NIMP(modes) && STRINGP(modes), modes, ARG2, s_open_file);
+  NEWCELL(port);
+  DEFER_INTS;
+  SYSCALL(f = fopen(CHARS(filename), CHARS(modes)););
+  if (!f) port = BOOL_F;
+  else {
+    SETSTREAM(port, f);
+    if (BUF0 & (CAR(port) = tc16_fport | mode_bits(CHARS(modes))))
+      i_setbuf0(port);
+    ALLOW_INTS;
+  }
+  return port;
+}
+
+SCM close_port(port)
+     SCM port;
+{
+	sizet i;
+	ASSERT(NIMP(port) && PORTP(port), port, ARG1, s_close_port);
+	if CLOSEDP(port) return UNSPECIFIED;
+	i = PTOBNUM(port);
+	DEFER_INTS;
+	if (ptobs[i].fclose) {
+	  SYSCALL((ptobs[i].fclose)(STREAM(port)););
+	}
+	CAR(port) &= ~OPN;
+	ALLOW_INTS;
+	return UNSPECIFIED;
+}
+SCM input_portp(x)
+     SCM x;
+{
+	if IMP(x) return BOOL_F;
+	return INPORTP(x) ? BOOL_T : BOOL_F;
+}
+SCM output_portp(x)
+     SCM x;
+{
+	if IMP(x) return BOOL_F;
+	return OUTPORTP(x) ? BOOL_T : BOOL_F;
+}
+
+#if (__TURBOC__==1)
+# undef L_tmpnam		/* Not supported in TURBOC V1.0 */
+#endif
+#ifdef GO32
+# undef L_tmpnam
+#endif
+#ifdef MWC
+# undef L_tmpnam
+#endif
+
+#ifdef L_tmpnam
+SCM ltmpnam()
+{
+  char name[L_tmpnam];
+  SYSCALL(tmpnam(name););
+  return makfrom0str(name);
+}
+#else
+/* TEMPTEMPLATE is used only if mktemp() is being used instead of
+   tmpnam(). */
+
+# ifdef AMIGA
+#  define TEMPTEMPLATE "T:SchemeaaaXXXXXX";
+# else
+#  ifdef vms
+#   define TEMPTEMPLATE "sys$scratch:aaaXXXXXX";
+#  else /* vms */
+#   ifdef __MSDOS__
+#    ifdef GO32
+#     define TEMPTEMPLATE "\\tmp\\TMPaaaXXXXXX";
+#    else
+#     define TEMPTEMPLATE "TMPaaaXXXXXX";
+#    endif
+#   else /* __MSDOS__ */
+#    define TEMPTEMPLATE "/tmp/aaaXXXXXX";
+#   endif /* __MSDOS__ */
+#  endif /* vms */
+# endif /* AMIGA */
+
+char template[] = TEMPTEMPLATE;
+# define TEMPLEN (sizeof template/sizeof(char) - 1)
+SCM ltmpnam()
+{
+  SCM name;
+  int temppos = TEMPLEN-9;
+  name = makfromstr(template, (sizet)TEMPLEN);
+  DEFER_INTS;
+inclp:
+  template[temppos]++;
+  if (!isalpha(template[temppos])) {
+    template[temppos++] = 'a';
+    goto inclp;
+  }
+# ifndef AMIGA
+#  ifndef __MSDOS__
+  SYSCALL(temppos = !*mktemp(CHARS(name)););
+  if (temppos) name = BOOL_F;
+#  endif
+# endif
+  ALLOW_INTS;
+  return name;
+}
+#endif /* L_tmpnam */
+
+#ifdef M_SYSV
+# define remove unlink
+#endif
+static char s_del_fil[] = "delete-file";
+SCM del_fil(str)
+     SCM str;
+{
+  int ans;
+  ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_del_fil);
+#ifdef STDC_HEADERS
+  SYSCALL(ans = remove(CHARS(str)););
+#else
+  SYSCALL(ans = unlink(CHARS(str)););
+#endif
+  return ans ? BOOL_F : BOOL_T;
+}
+
+void prinport(exp, port, type)
+     SCM exp; SCM port; char *type;
+{
+  lputs("#<", port);
+  if CLOSEDP(exp) lputs("closed-", port);
+  else {
+    if (RDNG & CAR(exp)) lputs("input-", port);
+    if (WRTNG & CAR(exp)) lputs("output-", port);
+  }
+  lputs(type, port);
+  lputc(' ', port);
+#ifndef MSDOS
+# ifndef __EMX__
+#  ifndef _DCC
+#   ifndef AMIGA
+#    ifndef THINK_C
+  if (OPENP(exp) && tc16_fport==TYP16(exp) && isatty(fileno(STREAM(exp))))
+    lputs(ttyname(fileno(STREAM(exp))), port);
+  else
+#    endif
+#   endif
+#  endif
+# endif
+#endif
+    if OPFPORTP(exp) intprint((long)fileno(STREAM(exp)), 10, port);
+    else intprint(CDR(exp), 16, port);
+  lputc('>', port);
+}
+static int prinfport(exp, port, writing)
+     SCM exp; SCM port; int writing;
+{
+  prinport(exp, port, s_port_type);
+  return !0;
+}
+static int prinstpt(exp, port, writing)
+     SCM exp; SCM port; int writing;
+{
+  prinport(exp, port, s_string);
+  return !0;
+}
+static int prinsfpt(exp, port, writing)
+     SCM exp; SCM port; int writing;
+{
+  prinport(exp, port, "soft");
+  return !0;
+}
+
+static int stputc(c, p)
+     int c; SCM p;
+{
+  sizet ind = INUM(CAR(p));
+  if (ind >= LENGTH(CDR(p))) resizuve(CDR(p), MAKINUM(ind + (ind>>1)));
+  CHARS(CDR(p))[ind] = c;
+  CAR(p) = MAKINUM(ind + 1);
+  return c;
+}
+sizet stwrite(str, siz, num, p)
+     sizet siz, num;
+     char *str; SCM p;
+{
+  sizet ind = INUM(CAR(p));
+  sizet len = siz * num;
+  char *dst;
+  if (ind + len >= LENGTH(CDR(p)))
+    resizuve(CDR(p), MAKINUM(ind + len + ((ind + len)>>1)));
+  dst = &(CHARS(CDR(p))[ind]);
+  while (len--) dst[len] = str[len];
+  CAR(p) = MAKINUM(ind + siz*num);
+  return num;
+}
+static int stputs(s, p)
+     char *s; SCM p;
+{
+  stwrite(s, 1, strlen(s), p);
+  return 0;
+}
+static int stgetc(p)
+     SCM p;
+{
+  sizet ind = INUM(CAR(p));
+  if (ind >= LENGTH(CDR(p))) return EOF;
+  CAR(p) = MAKINUM(ind + 1);
+  return CHARS(CDR(p))[ind];
+}
+int noop0(stream)
+     FILE *stream;
+{
+  return 0;
+}
+SCM mkstrport(pos, str, modes, caller)
+     SCM pos;
+     SCM str;
+     long modes;
+     char *caller;
+{
+  SCM z;
+  ASSERT(INUMP(pos) && INUM(pos) >= 0, pos, ARG1, caller);
+  ASSERT(NIMP(str) && (STRINGP(str) || SYMBOLP(str)), str, ARG1, caller);
+  str = cons(pos, str);
+  NEWCELL(z);
+  DEFER_INTS;
+  SETCHARS(z, str);
+  CAR(z) = tc16_strport | modes;
+  ALLOW_INTS;
+  return z;
+}
+static char s_cwos[] = "call-with-output-string";
+static char s_cwis[] = "call-with-input-string";
+SCM cwos(proc)
+     SCM proc;
+{
+  SCM p = mkstrport(INUM0, make_string(MAKINUM(30), UNDEFINED),
+		    OPN | WRTNG,
+		    s_cwos);
+  apply(proc, p, listofnull);
+  return resizuve(CDR(CDR(p)), CAR(CDR(p)));
+}
+SCM cwis(str, proc)
+     SCM str, proc;
+{
+  SCM p = mkstrport(INUM0, str, OPN | RDNG, s_cwis);
+  return apply(proc, p, listofnull);
+}
+#ifdef vms
+sizet pwrite(ptr, size, nitems, port)
+     char *ptr;
+     sizet size, nitems;
+     FILE* port;
+{
+  sizet len = size * nitems;
+  sizet i = 0;
+  for(;i < len;i++) putc(ptr[i], port);
+  return len;
+}
+# define ffwrite pwrite
+#else
+# define ffwrite fwrite
+#endif
+
+static ptobfuns fptob = {
+  mark0,
+  fclose,
+  prinfport,
+  0,
+  fputc,
+  fputs,
+  ffwrite,
+  fflush,
+  fgetc,
+  fclose};
+ptobfuns pipob = {
+  mark0,
+  0, 				/* replaced by pclose in init_ioext() */
+  0, 				/* replaced by prinpipe in init_ioext() */
+  0,
+  fputc,
+  fputs,
+  ffwrite,
+  fflush,
+  fgetc,
+  0};				/* replaced by pclose in init_ioext() */
+static ptobfuns stptob = {
+  markcdr,
+  noop0,
+  prinstpt,
+  0,
+  stputc,
+  stputs,
+  stwrite,
+  noop0,
+  stgetc,
+  0};
+
+				/* Soft ports */
+
+/* fputc, fwrite, fputs, and fclose are called within a
+   SYSCALL.  So we need to set errno to 0 before returning.  fflush
+   may be called within a SYSCALL.  So we need to set errno to 0
+   before returning. */
+
+static int sfputc(c, p)
+     int c; SCM p;
+{
+  apply(VELTS(p)[0], MAKICHR(c), listofnull);
+  errno = 0;
+  return c;
+}
+sizet sfwrite(str, siz, num, p)
+     sizet siz, num;
+     char *str; SCM p;
+{
+  SCM sstr;
+  sstr = makfromstr(str, siz * num);
+  apply(VELTS(p)[1], sstr, listofnull);
+  errno = 0;
+  return num;
+}
+static int sfputs(s, p)
+     char *s; SCM p;
+{
+  sfwrite(s, 1, strlen(s), p);
+  return 0;
+}
+int sfflush(stream)
+     SCM stream;
+{
+  SCM f = VELTS(stream)[2];
+  if (BOOL_F==f) return 0;
+  f = apply(f, EOL, EOL);
+  errno = 0;
+  return BOOL_F==f ? EOF : 0;
+}
+static int sfgetc(p)
+     SCM p;
+{
+  SCM ans;
+  ans = apply(VELTS(p)[3], EOL, EOL);
+  errno = 0;
+  if (FALSEP(ans) || EOF_VAL==ans) return EOF;
+  ASSERT(ICHRP(ans), ans, ARG1, "getc");
+  return ICHR(ans);
+}
+static int sfclose(p)
+     SCM p;
+{
+  SCM f = VELTS(p)[4];
+  if (BOOL_F==f) return 0;
+  f = apply(f, EOL, EOL);
+  errno = 0;
+  return BOOL_F==f ? EOF : 0;
+}
+static char s_mksfpt[] = "make-soft-port";
+SCM mksfpt(pv, modes)
+     SCM pv, modes;
+{
+  SCM z;
+  ASSERT(NIMP(pv) && VECTORP(pv) && 5==LENGTH(pv), pv, ARG1, s_mksfpt);
+  ASSERT(NIMP(modes) && STRINGP(modes), modes, ARG2, s_mksfpt);
+  NEWCELL(z);
+  DEFER_INTS;
+  CAR(z) = tc16_sfport | mode_bits(CHARS(modes));
+  SETSTREAM(z, pv);
+  ALLOW_INTS;
+  return z;
+}
+
+static ptobfuns sfptob = {
+  markcdr,
+  noop0,
+  prinsfpt,
+  0,
+  sfputc,
+  sfputs,
+  sfwrite,
+  sfflush,
+  sfgetc,
+  sfclose};
+
+static smobfuns freecell = {
+  mark0,
+  free0,
+  0,
+  0};
+static smobfuns flob = {
+  mark0,
+  /*flofree*/0,
+  floprint,
+  floequal};
+static smobfuns bigob = {
+  mark0,
+  /*bigfree*/0,
+  bigprint,
+  bigequal};
+void (**finals)() = 0;
+sizet num_finals = 0;
+static char s_final[] = "final";
+
+void init_types()
+{
+  numptob = 0;
+  ptobs = (ptobfuns *)malloc(4*sizeof(ptobfuns));
+  /* These newptob calls must be done in this order */
+  /* tc16_fport = */ newptob(&fptob);
+  /* tc16_pipe = */ newptob(&pipob);
+  /* tc16_strport = */ newptob(&stptob);
+  /* tc16_sfport = */ newptob(&sfptob);
+  numsmob = 0;
+  smobs = (smobfuns *)malloc(7*sizeof(smobfuns));
+  /* These newsmob calls must be done in this order */
+  newsmob(&freecell);
+  newsmob(&flob);
+  newsmob(&bigob);
+  newsmob(&bigob);
+  finals = (void(**)())malloc(2 * sizeof(finals[0]));
+  num_finals = 0;
+}
+
+void add_final(final)
+     void (* final)();
+{
+  DEFER_INTS;
+  finals = (void (**)()) must_realloc((char *)finals,
+				      1L*(num_finals)*sizeof(finals[0]),
+				      (1L+num_finals)*sizeof(finals[0]),
+				      s_final);
+  finals[num_finals++] = final;
+  ALLOW_INTS;
+  return;
+}
+
+char s_obunhash[] = "object-unhash";
+static iproc subr0s[] = {
+	{"gc", gc},
+	{"tmpnam", ltmpnam},
+	{0, 0}};
+
+static iproc subr1s[] = {
+	{s_input_portp, input_portp},
+	{s_output_portp, output_portp},
+	{s_close_port, close_port},
+	{"eof-object?", eof_objectp},
+	{s_cwos, cwos},
+	{"object-hash", obhash},
+	{s_obunhash, obunhash},
+	{s_del_fil, del_fil},
+	{0, 0}};
+
+static iproc subr2s[] = {
+	{s_open_file, open_file},
+	{s_cwis, cwis},
+	{s_mksfpt, mksfpt},
+	{0, 0}};
+
+SCM dynwind P((SCM thunk1, SCM thunk2, SCM thunk3));
+void init_io(){
+  make_subr("dynamic-wind", tc7_subr_3, dynwind);
+  init_iprocs(subr0s, tc7_subr_0);
+  init_iprocs(subr1s, tc7_subr_1);
+  init_iprocs(subr2s, tc7_subr_2);
+#ifndef CHEAP_CONTINUATIONS
+  add_feature("full-continuation");
+#endif
+}
+
+void grew_lim(nm)
+     long nm;
+{
+  ALLOW_INTS;
+  growth_mon(s_limit, nm, "bytes");
+  DEFER_INTS;
+}
+int expmem = 0;
+sizet hplim_ind = 0;
+long heap_size = 0;
+CELLPTR *hplims, heap_org;
+SCM freelist = EOL;
+long mtrigger;
+char *must_malloc(len, what)
+     long len;
+     char *what;
+{
+	char *ptr;
+	sizet size = len;
+	long nm = mallocated+size;
+	if (len != size)
+malerr:
+		wta(MAKINUM(len), (char *)NALLOC, what);
+	if ((nm <= mtrigger)) {
+	  SYSCALL(ptr = (char *)malloc(size););
+	  if (NULL != ptr) {mallocated = nm; return ptr;}
+	}
+	igc(what, CONT(rootcont)->stkbse);
+	nm = mallocated+size;
+	if (nm > mtrigger) grew_lim(nm+nm/2); /* must do before malloc */
+	SYSCALL(ptr = (char *)malloc(size););
+	if (NULL != ptr) {
+	  mallocated = nm;
+	  if (nm > mtrigger) mtrigger = nm + nm/2;
+	  return ptr;}
+	goto malerr;
+}
+char *must_realloc(where, olen, len, what)
+     char *where;
+     long olen, len;
+     char *what;
+{
+	char *ptr;
+	sizet size = len;
+	long nm = mallocated+size-olen;
+	if (len != size)
+ralerr:
+		wta(MAKINUM(len), (char *)NALLOC, what);
+	if ((nm <= mtrigger)) {
+	  SYSCALL(ptr = (char *)realloc(where, size););
+	  if (NULL != ptr) {mallocated = nm; return ptr;}
+	}
+	igc(what, CONT(rootcont)->stkbse);
+	nm = mallocated+size-olen;
+	if (nm > mtrigger) grew_lim(nm+nm/2); /* must do before realloc */
+	SYSCALL(ptr = (char *)realloc(where, size););
+	if (NULL != ptr) {
+	  mallocated = nm;
+	  if (nm > mtrigger) mtrigger = nm + nm/2;
+	  return ptr;}
+	goto ralerr;
+}
+void must_free(obj)
+     char *obj;
+{
+  if (obj) free(obj);
+  else wta(INUM0, "already free", "");
+}
+
+SCM symhash;			/* This used to be a sys_protect, but
+				   Radey Shouman <shouman@zianet.com>
+				   added GC for unuesd, UNDEFINED
+				   symbols.*/
+int symhash_dim = NUM_HASH_BUCKETS;
+/* sym2vcell looks up the symbol in the symhash table. */
+SCM sym2vcell(sym)
+     SCM sym;
+{
+  SCM lsym, z;
+  sizet hash = strhash(UCHARS(sym), (sizet)LENGTH(sym),
+		       (unsigned long)symhash_dim);
+  for(lsym = VELTS(symhash)[hash];NIMP(lsym);lsym = CDR(lsym)) {
+    z = CAR(lsym);
+    if (CAR(z)==sym) return z;
+  }
+  wta(sym, "uninterned symbol? ", "");
+}
+/* intern() and sysintern() return a pair;
+   CAR is the symbol, CDR is the value. */
+SCM intern(name, len)
+     char *name;
+     sizet len;
+{
+  SCM lsym, z;
+  register sizet i = len;
+  register unsigned char *tmp = (unsigned char *)name;
+  sizet hash = strhash(tmp, i, (unsigned long)symhash_dim);
+  for(lsym = VELTS(symhash)[hash];NIMP(lsym);lsym = CDR(lsym)) {
+    z = CAR(lsym);
+    z = CAR(z);
+    tmp = UCHARS(z);
+    if (LENGTH(z) != len) goto trynext;
+    for(i = len;i--;) if (((unsigned char *)name)[i] != tmp[i]) goto trynext;
+    return CAR(lsym);
+  trynext: ;
+  }
+  lsym = makfromstr(name, len);
+  DEFER_INTS;
+  SETLENGTH(lsym, (long)len, tc7_msymbol);
+  ALLOW_INTS;
+  z = acons(lsym, UNDEFINED, UNDEFINED);
+  DEFER_INTS;			/* Operations on symhash must be atomic. */
+  CDR(z) = VELTS(symhash)[hash];
+  VELTS(symhash)[hash] = z;
+  z = CAR(z);
+  ALLOW_INTS;
+  return z;
+}
+SCM sysintern(name, val)
+     char *name;
+     SCM val;
+{
+  SCM lsym, z;
+  sizet len = strlen(name);
+  register sizet i = len;
+  register unsigned char *tmp = (unsigned char *)name;
+  sizet hash = strhash(tmp, i, (unsigned long)symhash_dim);
+  for(lsym = VELTS(symhash)[hash];NIMP(lsym);lsym = CDR(lsym)) {
+    z = CAR(lsym);
+    z = CAR(z);
+    tmp = UCHARS(z);
+    if (LENGTH(z) != len) goto trynext;
+    for(i = len;i--;) if (((unsigned char *)name)[i] != tmp[i]) goto trynext;
+    lsym = CAR(lsym);
+    CDR(lsym) = val;
+    return lsym;
+  trynext: ;
+  }
+  NEWCELL(lsym);
+  SETLENGTH(lsym, (long)len, tc7_ssymbol);
+  SETCHARS(lsym, name);
+  lsym = cons(lsym, val);
+  z = cons(lsym, UNDEFINED);
+  CDR(z) = VELTS(symhash)[hash];
+  VELTS(symhash)[hash] = z;
+  return lsym;
+}
+SCM cons(x, y)
+     SCM x, y;
+{
+	register SCM z;
+	NEWCELL(z);
+	CAR(z) = x;
+	CDR(z) = y;
+	return z;
+}
+SCM cons2(w, x, y)
+     SCM w, x, y;
+{
+	register SCM z;
+	NEWCELL(z);
+	CAR(z) = x;
+	CDR(z) = y;
+	x = z;
+	NEWCELL(z);
+	CAR(z) = w;
+	CDR(z) = x;
+	return z;
+}
+SCM acons(w, x, y)
+     SCM w, x, y;
+{
+	register SCM z;
+	NEWCELL(z);
+	CAR(z) = w;
+	CDR(z) = x;
+	x = z;
+	NEWCELL(z);
+	CAR(z) = x;
+	CDR(z) = y;
+	return z;
+}
+
+SCM makstr(len)
+     long len;
+{
+	SCM s;
+	NEWCELL(s);
+	DEFER_INTS;
+	SETCHARS(s, must_malloc(len+1, s_string));
+	SETLENGTH(s, len, tc7_string);
+	ALLOW_INTS;
+	CHARS(s)[len] = 0;
+	return s;
+}
+
+SCM make_subr(name, type, fcn)
+     char *name;
+     int type;
+     SCM (*fcn)();
+{
+	SCM symcell = sysintern(name, UNDEFINED);
+	long tmp = ((((CELLPTR)(CAR(symcell)))-heap_org)<<8);
+	register SCM z;
+	if ((tmp>>8) != ((CELLPTR)(CAR(symcell))-heap_org))
+	  tmp = 0;
+	NEWCELL(z);
+	SUBRF(z) = fcn;
+	CAR(z) = tmp + type;
+	CDR(symcell) = z;
+	return z;
+}
+
+#ifdef CCLO
+SCM makcclo(proc, len)
+     SCM proc;
+     long len;
+{
+  SCM s;
+  NEWCELL(s);
+  DEFER_INTS;
+  SETCHARS(s, must_malloc(len*sizeof(SCM), "compiled-closure"));
+  SETLENGTH(s, len, tc7_cclo);
+  while (--len) VELTS(s)[len] = UNSPECIFIED;
+  CCLO_SUBR(s) = proc;
+  ALLOW_INTS;
+  return s;
+}
+#endif
+
+#ifdef STACK_LIMIT
+void stack_check()
+{
+  STACKITEM *start = CONT(rootcont)->stkbse;
+  STACKITEM stack;
+# ifdef STACK_GROWS_UP
+  if (&stack - start > STACK_LIMIT/sizeof(STACKITEM))
+# else
+  if (start - &stack > STACK_LIMIT/sizeof(STACKITEM))
+# endif /* def STACK_GROWS_UP */
+    wta(UNDEFINED, (char *)SEGV_SIGNAL, "stack");
+}
+#endif
+void stack_report()
+{
+  STACKITEM stack;
+  intprint(stack_size(CONT(rootcont)->stkbse)*sizeof(STACKITEM), 16, cur_errp);
+  lputs(" of stack: 0x", cur_errp);
+  intprint((long)CONT(rootcont)->stkbse, 16, cur_errp);
+  lputs(" - 0x", cur_errp);
+  intprint((long)&stack, 16, cur_errp);
+  lputs("\n", cur_errp);
+}
+
+SCM dynwind(thunk1, thunk2, thunk3)
+     SCM thunk1, thunk2, thunk3;
+{
+  SCM ans;
+  apply(thunk1, EOL, EOL);
+  dynwinds = acons(thunk1, thunk3, dynwinds);
+  ans = apply(thunk2, EOL, EOL);
+  dynwinds = CDR(dynwinds);
+  apply(thunk3, EOL, EOL);
+  return ans;
+}
+void dowinds(to, delta)
+     SCM to;
+     long delta;
+{
+ tail:
+  if (dynwinds==to);
+  else if (0 > delta) {
+    dowinds(CDR(to), 1+delta);
+    apply(CAR(CAR(to)), EOL, EOL);
+    dynwinds = to;
+  }
+  else {
+    SCM from = CDR(CAR(dynwinds));
+    dynwinds = CDR(dynwinds);
+    apply(from, EOL, EOL);
+    delta--; goto tail;		/* dowinds(to, delta-1); */
+  }
+}
+
+/* Remember that setjmp needs to be called after scm_make_cont */
+
+SCM scm_make_cont()
+{
+  SCM cont;
+  CONTINUATION *ncont;
+  NEWCELL(cont);
+  DEFER_INTS;
+  ncont = make_continuation(CONT(rootcont));
+  if (!ncont) wta(MAKINUM(-1), (char *)NALLOC, s_cont);
+  ncont->other.parent = rootcont;
+  SETCONT(cont, ncont);
+  SETLENGTH(cont, ncont->length, tc7_contin);
+  ncont->other.dynenv = dynwinds;
+#ifdef CAUTIOUS
+  CONT(cont)->other.stack_trace = stacktrace;
+#endif
+  ALLOW_INTS;
+  return cont;
+}
+static char s_sstale[] = "strangely stale";
+void scm_dynthrow(cont, val)
+     CONTINUATION *cont;
+     SCM val;
+{
+  if (cont->stkbse != CONT(rootcont)->stkbse)
+    wta(cont->other.dynenv, &s_sstale[10], s_cont);
+  dowinds(cont->other.dynenv,
+	  ilength(dynwinds)-ilength(cont->other.dynenv));
+#ifdef CAUTIOUS
+  stacktrace = cont->other.stack_trace;
+#endif
+  throw_to_continuation(cont, val, CONT(rootcont));
+  wta(cont->other.dynenv, s_sstale, s_cont);
+}
+
+SCM obhash(obj)
+     SCM obj;
+{
+
+#ifdef BIGDIG
+  long n = SRS(obj, 1);
+  if (!FIXABLE(n)) return long2big(n);
+#endif
+  return (obj<<1)+2L;
+}
+
+SCM obunhash(obj)
+     SCM obj;
+{
+#ifdef BIGDIG
+  if (NIMP(obj) && BIGP(obj)) {
+    sizet i = NUMDIGS(obj);
+    BIGDIG *ds = BDIGITS(obj);
+    if (TYP16(obj)==tc16_bigpos) {
+      obj = 0;
+      while (i--) obj = BIGUP(obj) + ds[i];
+    }
+    else {
+      obj = 0;
+      while (i--) obj = BIGUP(obj) - ds[i];
+    }
+    obj <<= 1;
+    goto comm;
+  }
+#endif
+  ASSERT(INUMP(obj), obj, ARG1, s_obunhash);
+  obj = SRS(obj, 1) & ~1L;
+ comm:
+  if IMP(obj) return obj;
+  if NCELLP(obj) return BOOL_F;
+  {				/* code is adapted from mark_locations */
+    register CELLPTR ptr = (CELLPTR)SCM2PTR(obj);
+    register sizet i = 0, j = hplim_ind;
+    do {
+      if PTR_GT(hplims[i++], ptr) break;
+      if PTR_LE(hplims[--j], ptr) break;
+      if ((i != j)
+	  && PTR_LE(hplims[i++], ptr)
+	  && PTR_GT(hplims[--j], ptr)) continue;
+      if NFREEP(obj) return obj;
+      break;
+    } while(i<j);
+  }
+  return BOOL_F;
+}
+
+unsigned long strhash(str, len, n)
+     unsigned char *str;
+     sizet len;
+     unsigned long n;
+{
+  if (len>5)
+    {
+      sizet i = 5;
+      unsigned long h = 264 % n;
+      while (i--) h = ((h<<8) + ((unsigned)(downcase[str[h % len]]))) % n;
+      return h;
+    }
+  else {
+    sizet i = len;
+    unsigned long h = 0;
+    while (i) h = ((h<<8) + ((unsigned)(downcase[str[--i]]))) % n;
+    return h;
+  }
+}
+
+static void fixconfig(s1, s2, s)
+     char *s1, *s2;
+     int s;
+{
+  fputs(s1, stderr);
+  fputs(s2, stderr);
+  fputs("\nin ", stderr);
+  fputs(s ? "setjump" : "scmfig", stderr);
+  fputs(".h and recompile scm\n", stderr);
+  quit(MAKINUM(1L));
+}
+
+sizet init_heap_seg(seg_org, size)
+     CELLPTR seg_org;
+     sizet size;
+{
+  register CELLPTR ptr = seg_org;
+#ifdef POINTERS_MUNGED
+  register SCM scmptr;
+#else
+# define scmptr ptr
+#endif
+  CELLPTR seg_end = CELL_DN((char *)ptr + size);
+  sizet i = hplim_ind, ni = 0;
+  if (ptr==NULL) return 0;
+  while((ni < hplim_ind) && PTR_LE(hplims[ni], seg_org)) ni++;
+  while(i-- > ni) hplims[i+2] = hplims[i];
+  hplim_ind += 2;
+  hplims[ni++] = ptr;		/* same as seg_org here */
+  hplims[ni++] = seg_end;
+  ptr = CELL_UP(ptr);
+  ni = seg_end - ptr;
+  for (i = ni;i--;ptr++) {
+#ifdef POINTERS_MUNGED
+    scmptr = PTR2SCM(ptr);
+#endif
+    CAR(scmptr) = (SCM)tc_free_cell;
+    CDR(scmptr) = PTR2SCM(ptr+1);
+  }
+/*  CDR(scmptr) = freelist; */
+  CDR(PTR2SCM(--ptr)) = freelist;
+  freelist = PTR2SCM(CELL_UP(seg_org));
+  heap_size += ni;
+  return size;
+#ifdef scmptr
+# undef scmptr
+#endif
+}
+static void alloc_some_heap()
+{
+  CELLPTR ptr, *tmplims;
+  sizet len = (2+hplim_ind)*sizeof(CELLPTR);
+  ASRTGO(len==(2+hplim_ind)*sizeof(CELLPTR), badhplims);
+  if (errjmp_bad) wta(UNDEFINED, "need larger initial", s_heap);
+  SYSCALL(tmplims = (CELLPTR *)realloc((char *)hplims, len););
+  if (!tmplims)
+badhplims:
+    wta(UNDEFINED, s_nogrow, s_hplims);
+  else hplims = tmplims;
+  /* hplim_ind gets incremented in init_heap_seg() */
+  if (expmem) {
+    len = (sizet)(EXPHEAP(heap_size)*sizeof(cell));
+    if ((sizet)(EXPHEAP(heap_size)*sizeof(cell)) != len) len = 0;
+  }
+  else len = HEAP_SEG_SIZE;
+  while (len >= MIN_HEAP_SEG_SIZE) {
+    SYSCALL(ptr = (CELLPTR) malloc(len););
+    if (ptr) {
+      init_heap_seg(ptr, len);
+      return;
+    }
+    len /= 2;
+  }
+  wta(UNDEFINED, s_nogrow, s_heap);
+}
+
+smobfuns *smobs;
+sizet numsmob;
+long newsmob(smob)
+     smobfuns *smob;
+{
+  char *tmp;
+  if (255 <= numsmob) goto smoberr;
+  DEFER_INTS;
+  SYSCALL(tmp = (char *)realloc((char *)smobs, (1+numsmob)*sizeof(smobfuns)););
+  if (tmp) {
+    smobs = (smobfuns *)tmp;
+    smobs[numsmob].mark = smob->mark;
+    smobs[numsmob].free = smob->free;
+    smobs[numsmob].print = smob->print;
+    smobs[numsmob].equalp = smob->equalp;
+    numsmob++;
+  }
+  ALLOW_INTS;
+  if (!tmp) smoberr: wta(MAKINUM((long)numsmob), (char *)NALLOC, "newsmob");
+  return tc7_smob + (numsmob-1)*256;
+}
+ptobfuns *ptobs;
+sizet numptob;
+long newptob(ptob)
+     ptobfuns *ptob;
+{
+  char *tmp;
+  if (255 <= numptob) goto ptoberr;
+  DEFER_INTS;
+  SYSCALL(tmp = (char *)realloc((char *)ptobs, (1+numptob)*sizeof(ptobfuns)););
+  if (tmp) {
+    ptobs = (ptobfuns *)tmp;
+    ptobs[numptob].mark = ptob->mark;
+    ptobs[numptob].free = ptob->free;
+    ptobs[numptob].print = ptob->print;
+    ptobs[numptob].equalp = ptob->equalp;
+    ptobs[numptob].fputc = ptob->fputc;
+    ptobs[numptob].fputs = ptob->fputs;
+    ptobs[numptob].fwrite = ptob->fwrite;
+    ptobs[numptob].fflush = ptob->fflush;
+    ptobs[numptob].fgetc = ptob->fgetc;
+    ptobs[numptob].fclose = ptob->fclose;
+    numptob++;
+  }
+  ALLOW_INTS;
+  if (!tmp) ptoberr: wta(MAKINUM((long)numptob), (char *)NALLOC, "newptob");
+  return tc7_port + (numptob-1)*256;
+}
+SCM markcdr(ptr)
+     SCM ptr;
+{
+  if GC8MARKP(ptr) return BOOL_F;
+  SETGC8MARK(ptr);
+  return CDR(ptr);
+}
+SCM mark0(ptr)
+     SCM ptr;
+{
+  SETGC8MARK(ptr);
+  return BOOL_F;
+}
+sizet free0(ptr)
+     CELLPTR ptr;
+{
+  return 0;
+}
+SCM equal0(ptr1, ptr2)
+     SCM ptr1, ptr2;
+{
+  return (CDR(ptr1)==CDR(ptr2)) ? BOOL_T : BOOL_F;
+}
+
+/* statically allocated port for diagnostic messages */
+cell tmp_errp = {(SCM)((0L<<8)|tc16_fport|OPN|WRTNG), 0};
+
+static char remsg[] = "remove\n#define ", addmsg[] = "add\n#define ";
+extern sizet num_protects;	/* sys_protects now in scl.c */
+void init_storage(stack_start_ptr, init_heap_size)
+     STACKITEM *stack_start_ptr;
+     long init_heap_size;
+{
+	sizet j = num_protects;
+	/* Because not all protects may get initialized */
+	while(j) sys_protects[--j] = BOOL_F;
+	tmp_errp.cdr = (SCM)stderr;
+	cur_errp = PTR2SCM(&tmp_errp);
+	freelist = EOL;
+	expmem = 0;
+
+#ifdef SHORT_INT
+	if (sizeof(int) >= sizeof(long))
+	  fixconfig(remsg, "SHORT_INT", 1);
+#else
+	if (sizeof(int) < sizeof(long))
+	  fixconfig(addmsg, "SHORT_INT", 1);
+#endif
+#ifdef CDR_DOUBLES
+	if (sizeof(double) != sizeof(long))
+	  fixconfig(remsg, "CDR_DOUBLES", 0);
+#else
+# ifdef SINGLES
+	if (sizeof(float) != sizeof(long))
+	  if (sizeof(double) == sizeof(long))
+	    fixconfig(addmsg, "CDR_DOUBLES", 0);
+	  else
+	    fixconfig(remsg, "SINGLES", 0);
+# endif
+#endif
+#ifdef BIGDIG
+	if (2*BITSPERDIG/CHAR_BIT > sizeof(long))
+	  fixconfig(remsg, "BIGDIG", 0);
+# ifndef DIGSTOOBIG
+	if (DIGSPERLONG*sizeof(BIGDIG) > sizeof(long))
+	  fixconfig(addmsg, "DIGSTOOBIG", 0);
+# endif
+#endif
+#ifdef STACK_GROWS_UP
+	if (((STACKITEM *)&j - stack_start_ptr) < 0)
+	  fixconfig(remsg, "STACK_GROWS_UP", 1);
+#else
+	if ((stack_start_ptr - (STACKITEM *)&j) < 0)
+	  fixconfig(addmsg, "STACK_GROWS_UP", 1);
+#endif
+	j = HEAP_SEG_SIZE;
+	if (HEAP_SEG_SIZE != j)
+	  fixconfig("reduce", "size of HEAP_SEG_SIZE", 0);
+
+	mtrigger = INIT_MALLOC_LIMIT;
+	hplims = (CELLPTR *) must_malloc(2L*sizeof(CELLPTR), s_hplims);
+	if (0L==init_heap_size) init_heap_size = INIT_HEAP_SIZE;
+	j = init_heap_size;
+	if ((init_heap_size != j) || !init_heap_seg((CELLPTR) malloc(j), j)) {
+	  j = HEAP_SEG_SIZE;
+	  if (!init_heap_seg((CELLPTR) malloc(j), j))
+	    wta(MAKINUM(j), (char *)NALLOC, s_heap);
+	}
+	else expmem = 1;
+	heap_org = CELL_UP(hplims[0]);
+		/* hplims[0] can change. do not remove heap_org */
+
+	NEWCELL(def_inp);
+	CAR(def_inp) = (tc16_fport|OPN|RDNG);
+	SETSTREAM(def_inp, stdin);
+	NEWCELL(def_outp);
+	CAR(def_outp) = (tc16_fport|OPN|WRTNG);
+	SETSTREAM(def_outp, stdout);
+	NEWCELL(def_errp);
+	CAR(def_errp) = (tc16_fport|OPN|WRTNG);
+	SETSTREAM(def_errp, stderr);
+	cur_inp = def_inp;
+	cur_outp = def_outp;
+	cur_errp = def_errp;
+	dynwinds = EOL;
+	NEWCELL(rootcont);
+	SETCONT(rootcont, make_root_continuation(stack_start_ptr));
+	CAR(rootcont) = tc7_contin;
+	CONT(rootcont)->other.dynenv = EOL;
+	CONT(rootcont)->other.parent = BOOL_F;
+	stacktrace = EOL;
+#ifdef CAUTIOUS
+	CONT(rootcont)->other.stack_trace = EOL;
+#endif
+	listofnull = cons(EOL, EOL);
+	undefineds = cons(UNDEFINED, EOL);
+	CDR(undefineds) = undefineds;
+	nullstr = makstr(0L);
+	nullvect = make_vector(INUM0, UNDEFINED);
+	/* NEWCELL(nullvect);
+	   CAR(nullvect) = tc7_vector;
+	   SETCHARS(nullvect, NULL); */
+	symhash = make_vector((SCM)MAKINUM(symhash_dim), EOL);
+	sysintern("most-positive-fixnum", (SCM)MAKINUM(MOST_POSITIVE_FIXNUM));
+	sysintern("most-negative-fixnum", (SCM)MAKINUM(MOST_NEGATIVE_FIXNUM));
+#ifdef BIGDIG
+	sysintern("bignum-radix", MAKINUM(BIGRAD));
+#endif
+	/* flo0 is now setup in scl.c */
+}
+
+/* The way of garbage collecting which allows use of the cstack is due to */
+/* Scheme In One Defun, but in C this time.
+
+ *			  COPYRIGHT (c) 1989 BY				    *
+ *	  PARADIGM ASSOCIATES INCORPORATED, CAMBRIDGE, MASSACHUSETTS.	    *
+ *			   ALL RIGHTS RESERVED				    *
+
+Permission to use, copy, modify, distribute and sell this software
+and its documentation for any purpose and without fee is hereby
+granted, 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 Paradigm Associates
+Inc not be used in advertising or publicity pertaining to distribution
+of the software without specific, written prior permission.
+
+PARADIGM DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL
+PARADIGM 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.
+
+gjc@paradigm.com
+
+Paradigm Associates Inc		 Phone: 617-492-6079
+29 Putnam Ave, Suite 6
+Cambridge, MA 02138
+*/
+char s_cells[] = "cells";
+SCM gc_for_newcell()
+{
+	SCM fl;
+	DEFER_INTS;
+	igc(s_cells, CONT(rootcont)->stkbse);
+	ALLOW_INTS;
+	if ((gc_cells_collected < MIN_GC_YIELD) || IMP(freelist)) {
+	  DEFER_INTS;
+	  alloc_some_heap();
+	  ALLOW_INTS;
+	  growth_mon("number of heaps", (long)(hplim_ind/2), "segments");
+	  growth_mon(s_heap, heap_size, s_cells);
+	}
+	++cells_allocated;
+	fl = freelist;
+	freelist = CDR(fl);
+	return fl;
+}
+
+static char	s_bad_type[] = "unknown type in ";
+jmp_buf save_regs_gc_mark;
+void mark_locations P((STACKITEM x[], sizet n));
+static void mark_syms P((SCM v));
+static void mark_sym_values P((SCM v));
+static void sweep_symhash P((SCM v));
+
+SCM gc()
+{
+  DEFER_INTS;
+  igc("call", CONT(rootcont)->stkbse);
+  ALLOW_INTS;
+  return UNSPECIFIED;
+}
+void igc(what, stackbase)
+     char *what;
+     STACKITEM *stackbase;
+{
+  int j = num_protects;
+  long oheap_size = heap_size;
+  gc_start(what);
+  ++errjmp_bad;
+  /* By marking symhash first, we provide the best immunity from
+     accidental references.  In order to accidentally protect a
+     symbol, a pointer will have to point directly at the symbol (as
+     opposed to the vector or bucket lists).  */
+  mark_syms(symhash);
+  /* mark_sym_values() can be called anytime after mark_syms.  */
+#ifdef NO_SYM_GC
+  gc_mark(symhash);
+#else
+  mark_sym_values(symhash);
+#endif
+  if (stackbase) {
+    FLUSH_REGISTER_WINDOWS;
+    /* This assumes that all registers are saved into the jmp_buf */
+    setjmp(save_regs_gc_mark);
+    mark_locations((STACKITEM *) save_regs_gc_mark,
+		   (sizet) (sizeof(STACKITEM) - 1 + sizeof save_regs_gc_mark) /
+		   sizeof(STACKITEM));
+    {
+      /* stack_len is long rather than sizet in order to guarantee that
+	 &stack_len is long aligned */
+#ifdef STACK_GROWS_UP
+# ifdef nosve
+      long stack_len = (STACKITEM *)(&stack_len) - stackbase;
+# else
+      long stack_len = stack_size(stackbase);
+# endif
+      mark_locations(stackbase, (sizet)stack_len);
+#else
+# ifdef nosve
+      long stack_len = stackbase - (STACKITEM *)(&stack_len);
+# else
+      long stack_len = stack_size(stackbase);
+# endif
+      mark_locations((stackbase - stack_len), (sizet)stack_len);
+#endif
+    }
+  }
+  while(j--) gc_mark(sys_protects[j]);
+  sweep_symhash(symhash);
+  gc_sweep();
+  --errjmp_bad;
+  gc_end();
+  if (oheap_size != heap_size) {
+    ALLOW_INTS;
+    growth_mon(s_heap, heap_size, s_cells);
+    DEFER_INTS;
+  }
+}
+
+static char s_not_free[] = "not freed";
+void free_storage()
+{
+  DEFER_INTS;
+  gc_start("free");
+  ++errjmp_bad;
+  cur_inp = BOOL_F; cur_outp = BOOL_F; cur_errp = PTR2SCM(&tmp_errp);
+  gc_mark(def_inp);		/* don't want to close stdin */
+  gc_mark(def_outp);		/* don't want to close stdout */
+  gc_mark(def_errp);		/* don't want to close stderr */
+  gc_sweep();
+  rootcont = BOOL_F;
+  while (hplim_ind) {		/* free heap segments */
+    hplim_ind -= 2;
+    {
+      CELLPTR ptr = CELL_UP(hplims[hplim_ind]);
+      sizet seg_size = CELL_DN(hplims[hplim_ind+1]) - ptr;
+      heap_size -= seg_size;
+      must_free((char *)hplims[hplim_ind]);
+      hplims[hplim_ind] = 0;
+      growth_mon(s_heap, heap_size, s_cells);
+    }}
+  if (heap_size) wta(MAKINUM(heap_size), s_not_free, s_heap);
+  if (hplim_ind) wta((SCM)MAKINUM(hplim_ind), s_not_free, s_hplims);
+  /* Not all cells get freed (see gc_mark() calls above). */
+  /* if (cells_allocated) wta(MAKINUM(cells_allocated), s_not_free, "cells"); */
+  /* either there is a small memory leak or I am counting wrong. */
+  /* if (mallocated) wta(MAKINUM(mallocated), s_not_free, "malloc"); */
+  must_free((char *)hplims);
+  hplims = 0;
+  must_free((char *)smobs);
+  smobs = 0;
+  gc_end();
+  ALLOW_INTS; /* A really bad idea, but printing does it anyway. */
+  exit_report();
+  must_free((char *)ptobs);
+  ptobs = 0;
+  lmallocated = mallocated = 0;
+  /* Can't do gc_end() here because it uses ptobs which have been freed */
+}
+
+void gc_mark(p)
+     SCM p;
+{
+  register long i;
+  register SCM ptr = p;
+ gc_mark_loop:
+  if IMP(ptr) return;
+ gc_mark_nimp:
+  if (NCELLP(ptr)
+      /* #ifndef RECKLESS
+	 || PTR_GT(hplims[0], (CELLPTR)ptr)
+	 || PTR_GE((CELLPTR)ptr, hplims[hplim_ind-1])
+#endif */
+      ) wta(ptr, "rogue pointer in ", s_heap);
+  switch TYP7(ptr) {
+  case tcs_cons_nimcar:
+    if GCMARKP(ptr) break;
+    SETGCMARK(ptr);
+    if IMP(CDR(ptr)) {		/* IMP works even with a GC mark */
+      ptr = CAR(ptr);
+      goto gc_mark_nimp;
+    }
+    gc_mark(CAR(ptr));
+    ptr = GCCDR(ptr);
+    goto gc_mark_nimp;
+  case tcs_cons_imcar:
+  case tcs_cons_gloc:
+    if GCMARKP(ptr) break;
+    SETGCMARK(ptr);
+    ptr = GCCDR(ptr);
+    goto gc_mark_loop;
+  case tcs_closures:
+    if GCMARKP(ptr) break;
+    SETGCMARK(ptr);
+    if IMP(CDR(ptr)) {
+      ptr = CODE(ptr);
+      goto gc_mark_nimp;
+    }
+    gc_mark(CODE(ptr));
+    ptr = GCCDR(ptr);
+    goto gc_mark_nimp;
+  case tc7_vector:
+#ifdef CCLO
+  case tc7_cclo:
+#endif
+    if GC8MARKP(ptr) break;
+    SETGC8MARK(ptr);
+    i = LENGTH(ptr);
+    if (i==0) break;
+    while(--i>0) if NIMP(VELTS(ptr)[i]) gc_mark(VELTS(ptr)[i]);
+    ptr = VELTS(ptr)[0];
+    goto gc_mark_loop;
+  case tc7_contin:
+    if GC8MARKP(ptr) break;
+    SETGC8MARK(ptr);
+    mark_locations((STACKITEM *)VELTS(ptr),
+		   (sizet)(LENGTH(ptr) +
+			   (sizeof(STACKITEM) - 1 + sizeof(CONTINUATION)) /
+			   sizeof(STACKITEM)));
+    break;
+  case tc7_bvect:
+  case tc7_ivect:
+  case tc7_uvect:
+  case tc7_fvect:
+  case tc7_dvect:
+  case tc7_cvect:
+  case tc7_string:
+  case tc7_msymbol:
+  case tc7_ssymbol:
+    SETGC8MARK(ptr);
+  case tcs_subrs:
+    break;
+  case tc7_port:
+    i = PTOBNUM(ptr);
+    if (!(i < numptob)) goto def;
+    ptr = (ptobs[i].mark)(ptr);
+    goto gc_mark_loop;
+  case tc7_smob:
+    if GC8MARKP(ptr) break;
+    switch TYP16(ptr) {		/* should be faster than going through smobs */
+    case tc_free_cell:
+      /* printf("found free_cell %X ", ptr); fflush(stdout); */
+      SETGC8MARK(ptr);
+      CDR(ptr) = EOL;
+      break;
+    case tcs_bignums:
+    case tc16_flo:
+      SETGC8MARK(ptr);
+      break;
+    default:
+      i = SMOBNUM(ptr);
+      if (!(i < numsmob)) goto def;
+      ptr = (smobs[i].mark)(ptr);
+      goto gc_mark_loop;
+    }
+    break;
+  default: def: wta(ptr, s_bad_type, "gc_mark");
+  }
+}
+
+void mark_locations(x, n)
+     STACKITEM x[];
+     sizet n;
+{
+	register long m = n;
+	register int i, j;
+	register CELLPTR ptr;
+	while(0 <= --m) if CELLP(*(SCM **)&x[m]) {
+		ptr = (CELLPTR)SCM2PTR((*(SCM **)&x[m]));
+		i = 0;
+		j = hplim_ind;
+		do {
+			if PTR_GT(hplims[i++], ptr) break;
+			if PTR_LE(hplims[--j], ptr) break;
+			if ((i != j)
+			    && PTR_LE(hplims[i++], ptr)
+			    && PTR_GT(hplims[--j], ptr)) continue;
+			/* if NFREEP(*(SCM **)&x[m]) */ gc_mark(*(SCM *)&x[m]);
+			break;
+		} while(i<j);
+	}
+}
+
+#define HUGE_LENGTH(x) (LENGTH_MAX==LENGTH(x) ? *((long *)VELTS(x)) : LENGTH(x))
+
+static void gc_sweep()
+{
+  register CELLPTR ptr;
+#ifdef POINTERS_MUNGED
+  register SCM scmptr;
+#else
+#define scmptr (SCM)ptr
+#endif
+  register SCM nfreelist = EOL;
+  register long n = 0, m = 0;
+  register sizet j;
+  sizet i = 0;
+  sizet seg_size;
+  while (i<hplim_ind) {
+    ptr = CELL_UP(hplims[i++]);
+    seg_size = CELL_DN(hplims[i++]) - ptr;
+    for(j = seg_size;j--;++ptr) {
+#ifdef POINTERS_MUNGED
+      scmptr = PTR2SCM(ptr);
+#endif
+      switch TYP7(scmptr) {
+      case tcs_cons_imcar:
+      case tcs_cons_nimcar:
+      case tcs_cons_gloc:
+      case tcs_closures:
+	if GCMARKP(scmptr) goto cmrkcontinue;
+	break;
+      case tc7_vector:
+#ifdef CCLO
+      case tc7_cclo:
+#endif
+	if GC8MARKP(scmptr) goto c8mrkcontinue;
+	m += (LENGTH(scmptr)*sizeof(SCM));
+      freechars:
+	must_free(CHARS(scmptr));
+/*	SETCHARS(scmptr, 0);*/
+	break;
+      case tc7_bvect:
+	if GC8MARKP(scmptr) goto c8mrkcontinue;
+	m += sizeof(long)*((HUGE_LENGTH(scmptr)+LONG_BIT-1)/LONG_BIT);
+	goto freechars;
+      case tc7_ivect:
+      case tc7_uvect:
+	if GC8MARKP(scmptr) goto c8mrkcontinue;
+	m += HUGE_LENGTH(scmptr)*sizeof(long);
+	goto freechars;
+      case tc7_fvect:
+	if GC8MARKP(scmptr) goto c8mrkcontinue;
+	m += HUGE_LENGTH(scmptr)*sizeof(float);
+	goto freechars;
+      case tc7_dvect:
+	if GC8MARKP(scmptr) goto c8mrkcontinue;
+	m += HUGE_LENGTH(scmptr)*sizeof(double);
+	goto freechars;
+      case tc7_cvect:
+	if GC8MARKP(scmptr) goto c8mrkcontinue;
+	m += HUGE_LENGTH(scmptr)*2*sizeof(double);
+	goto freechars;
+      case tc7_string:
+	if GC8MARKP(scmptr) goto c8mrkcontinue;
+	m += HUGE_LENGTH(scmptr)+1;
+	goto freechars;
+      case tc7_msymbol:
+	if GC8MARKP(scmptr) goto c8mrkcontinue;
+	m += LENGTH(scmptr)+1;
+	goto freechars;
+      case tc7_contin:
+	if GC8MARKP(scmptr) goto c8mrkcontinue;
+	m += LENGTH(scmptr)*sizeof(STACKITEM) + sizeof(CONTINUATION);
+/*	free_continuation(CONT(scmptr)); */
+	goto freechars;
+      case tc7_ssymbol:
+	if GC8MARKP(scmptr) goto c8mrkcontinue;
+	/* Do not free storage because tc7_ssymbol means scmptr's
+           storage was not created by a call to malloc(). */
+	break;
+      case tcs_subrs:
+	continue;
+      case tc7_port:
+	if GC8MARKP(scmptr) goto c8mrkcontinue;
+	if OPENP(scmptr) {
+	  int k = PTOBNUM(scmptr);
+	  if (!(k < numptob)) goto sweeperr;
+				/* Yes, I really do mean ptobs[k].free */
+				/* rather than ftobs[k].close.  .close */
+				/* is for explicit CLOSE-PORT by user */
+	  (ptobs[k].free)(STREAM(scmptr));
+	  gc_ports_collected++;
+	  SETSTREAM(scmptr, 0);
+	  CAR(scmptr) &= ~OPN;
+	}
+	break;
+      case tc7_smob:
+	switch GCTYP16(scmptr) {
+	case tc_free_cell:
+	  if GC8MARKP(scmptr) goto c8mrkcontinue;
+	  break;
+#ifdef BIGDIG
+	case tcs_bignums:
+	  if GC8MARKP(scmptr) goto c8mrkcontinue;
+	  m += (NUMDIGS(scmptr)*BITSPERDIG/CHAR_BIT);
+	  goto freechars;
+#endif /* def BIGDIG */
+	case tc16_flo:
+	  if GC8MARKP(scmptr) goto c8mrkcontinue;
+	  switch ((int)(CAR(scmptr)>>16)) {
+	  case (IMAG_PART | REAL_PART)>>16:
+	    m += sizeof(double);
+	  case REAL_PART>>16:
+	  case IMAG_PART>>16:
+	    m += sizeof(double);
+	    goto freechars;
+	  case 0:
+	    break;
+	  default:
+	    goto sweeperr;
+	  }
+	  break;
+	default:
+	  if GC8MARKP(scmptr) goto c8mrkcontinue;
+	  {
+	    int k = SMOBNUM(scmptr);
+	    if (!(k < numsmob)) goto sweeperr;
+	    m += (smobs[k].free)((CELLPTR)scmptr);
+	  }
+	}
+	break;
+      default: sweeperr: wta(scmptr, s_bad_type, "gc_sweep");
+      }
+      ++n;
+      CAR(scmptr) = (SCM)tc_free_cell;
+      CDR(scmptr) = nfreelist;
+      nfreelist = scmptr;
+      continue;
+    c8mrkcontinue:
+      CLRGC8MARK(scmptr);
+      continue;
+    cmrkcontinue:
+      CLRGCMARK(scmptr);
+    }
+#ifdef GC_FREE_SEGMENTS
+    if (n==seg_size) {
+      heap_size -= seg_size;
+      must_free((char *)hplims[i-2]);
+      hplims[i-2] = 0;
+      for(j = i;j < hplim_ind;j++) hplims[j-2] = hplims[j];
+      hplim_ind -= 2;
+      i -= 2;			/* need to scan segment just moved. */
+      nfreelist = freelist;
+    }
+    else
+#endif /* ifdef GC_FREE_SEGMENTS */
+	freelist = nfreelist;
+    gc_cells_collected += n;
+    n = 0;
+  }
+  lcells_allocated += (heap_size - gc_cells_collected - cells_allocated);
+  cells_allocated = (heap_size - gc_cells_collected);
+  lmallocated -= m;
+  mallocated -= m;
+  gc_malloc_collected = m;
+}
+
+/* mark_syms marks those symbols of hash table V which have
+   non-UNDEFINED values.  */
+static char s_gc_sym[] = "mark_syms";
+static void mark_syms(v)
+     SCM v;
+{
+  SCM x, al;
+  int k = LENGTH(v);
+  while (k--)
+    for (al = VELTS(v)[k]; NIMP(al); al = GCCDR(al)) {
+      /* If this bucket has already been marked, then something is wrong.  */
+      ASSERT(!GCMARKP(al), al, s_bad_type, s_gc_sym);
+      x = CAR(al);
+      SETGCMARK(al);
+      ASSERT(!GCMARKP(x), x, s_bad_type, s_gc_sym);
+      if (UNDEFINED==CDR(x) && tc7_msymbol==TYP7(CAR(x)))
+	goto used;		/* Don't mark symbol.  */
+      SETGC8MARK(CAR(x));
+    used:
+      SETGCMARK(x);		/* Do mark value cell.  */
+    }
+  SETGC8MARK(v);		/* Mark bucket list.  */
+}
+
+/* mark_symhash marks the values of hash table V.  */
+static void mark_sym_values(v)
+     SCM v;
+{
+  SCM x, al;
+  int k = LENGTH(v);
+  SETGC8MARK(v);
+  while (k--)
+    for (al = VELTS(v)[k]; NIMP(al); al = GCCDR(al)) {
+      x = GCCDR(CAR(al));
+      if IMP(x) continue;
+      gc_mark(x);
+    }
+}
+
+/* Splice any unused valueless symbols out of the hash buckets. */
+static void sweep_symhash(v)
+     SCM v;
+{
+  SCM al, x, *lloc;
+  int k = LENGTH(v);
+  while (k--) {
+    lloc = &(VELTS(v)[k]);
+    while NIMP(al = (*lloc & ~1L)) {
+      x = CAR(al);
+      if GC8MARKP(CAR(x))
+	lloc = &(CDR(al));
+      else {
+	*lloc = CDR(al);
+	CLRGCMARK(al);		/* bucket pair to be collected by gc_sweep */
+	CLRGCMARK(x);		/* value cell to be collected by gc_sweep */
+	gc_syms_collected++;
+      }
+    }
+    VELTS(v)[k] &= ~1L;		/* We may have deleted the first cell */
+  }
+}
diff --git a/time.c b/time.c
new file mode 100644
index 0000000..871082f
--- /dev/null
+++ b/time.c
@@ -0,0 +1,389 @@
+/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  
+ */
+
+/* "time.c" functions dealing with time.
+   Author: Aubrey Jaffer */
+
+#include "scm.h"
+
+#ifdef HAVE_CONFIG_H
+
+# ifndef HAVE_FTIME
+#  define LACK_FTIME
+# endif
+# ifndef HAVE_TIMES
+#  define LACK_TIMES
+# endif
+# ifdef HAVE_SYS_TYPES_H
+#  include <sys/types.h>
+# endif
+# ifdef TIME_WITH_SYS_TIME
+#  include <sys/time.h>
+#  include <time.h>
+# else
+#  ifdef HAVE_SYS_TIME_H
+#   include <sys/time.h>
+#  else
+#   ifdef HAVE_TIME_H
+#    include <time.h>
+#   endif
+#  endif
+# endif
+# ifdef HAVE_SYS_TIMES_H
+#  include <sys/times.h>
+# else
+#  ifdef HAVE_SYS_TIMEB_H
+#   include <sys/timeb.h>
+#  endif
+# endif
+# ifdef HAVE_FTIME
+#  ifdef unix
+#   ifndef GO32
+#    include <sys/timeb.h>
+#   endif
+#  endif
+# endif
+
+#else
+
+# ifdef STDC_HEADERS
+#  include <time.h>
+#  ifdef M_SYSV
+#   include <sys/types.h>
+#   include <sys/times.h>
+#  endif
+#  ifdef sun
+#   include <sys/types.h>
+#   include <sys/times.h>
+#  endif
+#  ifdef ultrix
+#   include <sys/types.h>
+#   include <sys/times.h>
+#  endif
+#  ifdef nosve
+#   include <sys/types.h>
+#   include <sys/times.h>
+#  endif
+#  ifdef _UNICOS
+#   include <sys/types.h>
+#   include <sys/times.h>
+#  endif
+#  ifdef __IBMC__
+#   include <sys/timeb.h>
+#  endif
+# else
+#  ifdef SVR2
+#   include <time.h>
+#  else
+#   ifndef ARM_ULIB
+#    include <sys/time.h>
+#   else
+#    include <time.h>
+#   endif
+#  endif
+#  include <sys/types.h>
+
+#  ifndef ARM_ULIB
+#   include <sys/times.h>
+#  else
+#   include <time.h>
+#  endif
+
+# endif
+
+/* Define this if your system lacks ftime(). */
+/* #define LACK_FTIME */
+/* Define this if your system lacks times(). */
+/* #define LACK_TIMES */
+
+# ifdef __TURBOC__
+#  define LACK_TIMES
+# endif
+# if (__TURBOC__==1) /* Needed for TURBOC V1.0 */
+#  define LACK_FTIME
+#  undef MSDOS
+# endif
+# ifdef __HIGHC__
+#  define LACK_TIMES
+# endif
+# ifdef THINK_C
+#  define LACK_FTIME
+#  define LACK_TIMES
+#  define CLK_TCK 60
+# endif
+# ifdef SVR2
+#  define LACK_FTIME
+# endif
+# ifdef SVR4
+#  define LACK_FTIME
+# endif
+# ifdef __svr4__
+#  define LACK_FTIME
+# endif
+# ifdef nosve
+#  define LACK_FTIME
+# endif
+# ifdef GO32
+#  define LACK_FTIME
+#  define LACK_TIMES
+# endif
+# ifdef atarist
+#  define LACK_FTIME
+#  define LACK_TIMES
+# endif
+# ifdef ARM_ULIB
+#  define LACK_FTIME
+#  define LACK_TIMES
+# endif
+# ifdef _DCC
+#  define LACK_FTIME
+# endif
+# ifdef MSDOS
+#  ifndef GO32
+#   include <sys/types.h>
+#   include <sys/timeb.h>
+#  endif
+# endif
+# ifdef _UNICOS
+#  define LACK_FTIME
+# endif
+
+# ifndef LACK_FTIME
+#  ifdef unix
+#   ifndef GO32
+#    include <sys/timeb.h>
+#   endif
+#  endif
+# endif
+
+# ifdef __EMX__
+#  define LACK_TIMES
+#  include <sys/types.h>
+#  include <sys/timeb.h>
+# endif
+
+# ifdef MWC
+#  include <time.h>
+#  include <sys/timeb.h>
+# endif
+
+# ifdef ARM_ULIB
+#  include <sys/types.h>
+#  include <time.h>
+# endif
+
+#endif /* HAVE_CONFIG_H */
+
+#ifdef vms
+# define LACK_TIMES
+# define LACK_FTIME
+#endif
+
+#ifdef CLK_TCK
+# define CLKTCK CLK_TCK
+# ifdef CLOCKS_PER_SEC
+#  ifdef unix
+#   ifndef ARM_ULIB
+#    include <sys/times.h>
+#   endif
+#   define LACK_CLOCK
+    /* This is because clock() might be POSIX rather than ANSI.
+       This occurs on HP-UX machines */
+#  endif
+# endif
+#else
+# ifdef CLOCKS_PER_SEC
+#  define CLKTCK CLOCKS_PER_SEC
+# else
+#  define LACK_CLOCK
+#  ifdef AMIGA
+#   include <stddef.h>
+#   define LACK_TIMES
+#   define LACK_FTIME
+#   define CLKTCK 1000
+#  else
+#   define CLKTCK 60
+#  endif
+# endif
+#endif
+
+#ifdef __STDC__
+# define timet time_t
+#else
+# define timet long
+#endif
+
+#ifdef LACK_TIMES
+# ifdef LACK_CLOCK
+#  ifdef AMIGA
+/* From: "Fred Bayer" <bayerf@lan.informatik.tu-muenchen.de> */
+#   ifdef AZTEC_C		/* AZTEC_C */
+#    include <devices/timer.h>
+static long mytime()
+{
+	long sec, mic, mili = 0;
+	struct timerequest *timermsg;
+	struct MsgPort *timerport;
+	if(!(timerport = (struct MsgPort *)CreatePort(0, 0))){
+	lputs("No mem for port.\n", cur_errp);
+		return mili;
+	}
+	if(!(timermsg = (struct timerequest *)
+		 CreateExtIO(timerport, sizeof(struct timerequest)))){
+		lputs("No mem for timerequest.\n", cur_errp);
+		DeletePort(timermsg->tr_node.io_Message.mn_ReplyPort);
+	return mili;
+	}
+	if(!(OpenDevice(TIMERNAME, UNIT_MICROHZ, timermsg, 0))){
+		timermsg->tr_node.io_Command = TR_GETSYSTIME;
+		timermsg->tr_node.io_Flags = 0;
+		DoIO(timermsg);
+		sec = timermsg->tr_time.tv_secs;
+		mic = timermsg->tr_time.tv_micro;
+		mili = sec*1000+mic/1000;
+		CloseDevice(timermsg);
+	}
+	else lputs("No Timer available.\n", cur_errp);
+	DeletePort(timermsg->tr_node.io_Message.mn_ReplyPort);
+	DeleteExtIO(timermsg);
+	return mili ;
+}
+#   else			/* this is for SAS/C */
+static long mytime()
+{
+   unsigned int cl[2];
+   timer(cl);
+   return(cl[0]*1000+cl[1]/1000);
+}
+#   endif /* AZTEC_C */
+#  else /* AMIGA */
+#   define mytime() ((time((timet*)0) - your_base) * CLKTCK)
+#  endif /* AMIGA */
+# else /* LACK_CLOCK */
+#  define mytime clock
+# endif /* LACK_CLOCK */
+#else /* LACK_TIMES */
+static long mytime()
+{
+  struct tms time_buffer;
+  times(&time_buffer);
+  return time_buffer.tms_utime + time_buffer.tms_stime;
+}
+#endif /* LACK_TIMES */
+
+#ifdef LACK_FTIME
+# ifdef AMIGA
+SCM your_time()
+{
+  return MAKINUM(mytime());
+}
+# else
+timet your_base = 0;
+SCM your_time()
+{
+	return MAKINUM((time((timet*)0) - your_base) * (int)CLKTCK);
+}
+# endif /* AMIGA */
+#else /* LACK_FTIME */
+struct timeb your_base = {0};
+SCM your_time()
+{
+	struct timeb time_buffer;
+	long tmp;
+	ftime(&time_buffer);
+	time_buffer.time -= your_base.time;
+	tmp = time_buffer.millitm - your_base.millitm;
+	tmp = time_buffer.time*1000L + tmp;
+	tmp *= CLKTCK;
+	tmp /= 1000;
+	return MAKINUM(tmp);
+}
+#endif /* LACK_FTIME */
+
+long my_base = 0;
+SCM my_time()
+{
+  return MAKINUM(mytime()-my_base);
+}
+
+SCM curtime()
+{
+  timet timv = time((timet*)0);
+  SCM ans;
+#ifndef _DCC
+# ifdef STDC_HEADERS
+#  if (__TURBOC__ > 0x201)
+  timv = mktime(gmtime(&timv));
+#  endif
+# endif
+#endif
+  ans = ulong2num(timv);
+  return BOOL_F==ans ? MAKINUM(timv) : ans;
+}
+
+long time_in_msec(x)
+     long x;
+{
+  if (CLKTCK==60) return (x*50)/3;
+  else
+    return (CLKTCK < 1000 ? x*(1000L/(long)CLKTCK) : (x*1000L)/(long)CLKTCK);
+}
+
+static iproc subr0s[] = {
+	{"get-internal-run-time", my_time},
+	{"get-internal-real-time", your_time},
+	{"current-time", curtime},
+	{0, 0}};
+
+void init_time()
+{
+	sysintern("internal-time-units-per-second",
+		  MAKINUM((long)CLKTCK));
+#ifdef LACK_FTIME
+# ifndef AMIGA
+	if (!your_base) time(&your_base);
+# endif
+#else
+	if (!your_base.time) ftime(&your_base);
+#endif
+	if (!my_base) my_base = mytime();
+	init_iprocs(subr0s, tc7_subr_0);
+}
diff --git a/unexec.c b/unexec.c
new file mode 100644
index 0000000..f7ff9ca
--- /dev/null
+++ b/unexec.c
@@ -0,0 +1,1238 @@
+/* Copyright (C) 1985,86,87,88,92,93,94 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, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, 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.
+
+* 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!  */
+
+#ifdef COFF_ENCAPSULATE
+int need_coff_header = 1;
+#include <coff-encap/a.out.encap.h> /* The location might be a poor assumption */
+#else
+#ifdef MSDOS
+#if __DJGPP__ > 1
+#include <fcntl.h>  /* for O_RDONLY, O_RDWR */
+#include <crt0.h>   /* for _crt0_startup_flags and its bits */
+static int save_djgpp_startup_flags;
+#endif
+#include <coff.h>
+#define filehdr external_filehdr
+#define scnhdr external_scnhdr
+#define syment external_syment
+#define auxent external_auxent
+#define n_numaux e_numaux
+#define n_type e_type
+struct aouthdr
+{
+  unsigned short	magic;	/* type of file				*/
+  unsigned short	vstamp;	/* version stamp			*/
+  unsigned long		tsize;	/* text size in bytes, padded to FW bdry*/
+  unsigned long		dsize;	/* initialized data "  "		*/
+  unsigned long		bsize;	/* uninitialized data "   "		*/
+  unsigned long		entry;	/* entry pt.				*/
+  unsigned long	 	text_start;/* base of text used for this file */
+  unsigned long	 	data_start;/* base of data used for this file */
+};
+
+
+#else /* not MSDOS */
+#include <a.out.h>
+#endif /* not MSDOS */
+#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>
+
+#include <sys/file.h>	/* Must be after sys/types.h for USG and BSD4_1*/
+
+#ifdef USG5
+#include <fcntl.h>
+#endif
+
+#ifndef O_RDONLY
+#define O_RDONLY 0
+#endif
+#ifndef O_RDWR
+#define O_RDWR 2
+#endif
+
+
+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
+
+#include "lisp.h"
+
+static
+report_error (file, fd)
+     char *file;
+     int fd;
+{
+  if (fd)
+    close (fd);
+  report_file_error ("Cannot unexec", Fcons (build_string (file), Qnil));
+}
+#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, O_RDONLY)) < 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 */
+      lseek (a_out, sizeof (f_hdr) + f_hdr.f_opthdr, 0);
+      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.
+   */
+
+  /* This used to use sizeof (f_ohdr) instead of .f_opthdr.
+     .f_opthdr is said to be right when there is no optional header.  */
+  lseek (a_out, sizeof (f_hdr) + f_hdr.f_opthdr, 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
+#ifdef MSDOS	/* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
+      bzero ((void *)&hdr, sizeof hdr);
+#else
+      bzero (&hdr, sizeof hdr);
+#endif
+#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);
+    }
+
+#if 0 /* This #ifndef caused a bug on Linux when using QMAGIC.  */
+  /* This adjustment was done above only #ifndef NO_REMAP,
+     so only undo it now #ifndef NO_REMAP.  */
+  /* #ifndef NO_REMAP  */
+#endif
+#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 */
+
+#ifdef MSDOS
+#if __DJGPP__ >= 2
+  /* Dump the original table of exception handlers, not the one
+     where our exception hooks are registered.  */
+  __djgpp_exception_toggle ();
+
+  /* Switch off startup flags that might have been set at runtime
+     and which might change the way that dumped Emacs works.  */
+  save_djgpp_startup_flags = _crt0_startup_flags;
+  _crt0_startup_flags &= ~(_CRT0_FLAG_NO_LFN | _CRT0_FLAG_NEARPTR);
+#endif
+#endif
+
+  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);
+
+#ifdef MSDOS
+#if __DJGPP__ >= 2
+  /* Restore our exception hooks.  */
+  __djgpp_exception_toggle ();
+
+  /* Restore the startup flags.  */
+  _crt0_startup_flags = save_djgpp_startup_flags;
+#endif
+#endif
+
+#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 */
+
+#ifdef RISCiX
+
+  /* Acorn's RISC-iX has a wacky way of initialising the position of the heap.
+   * There is a little table in crt0.o that is filled at link time with
+   * the min and current brk positions, among other things.  When start
+   * runs, it copies the table to where these parameters live during
+   * execution.  This data is in text space, so it cannot be modified here
+   * before saving the executable, so the data is written manually.  In
+   * addition, the table does not have a label, and the nearest accessible
+   * label (mcount) is not prefixed with a '_', thus making it inaccessible
+   * from within C programs.  To overcome this, emacs's executable is passed
+   * through the command 'nm %s | fgrep mcount' into a pipe, and the
+   * resultant output is then used to find the address of 'mcount'.  As far as
+   * is possible to determine, in RISC-iX releases prior to 1.2, the negative
+   * offset of the table from mcount is 0x2c, whereas from 1.2 onwards it is
+   * 0x30.  bss_end has been rounded up to page boundary.  This solution is
+   * based on suggestions made by Kevin Welton and Steve Hunt of Acorn, and
+   * avoids the need for a custom version of crt0.o for emacs which has its
+   * table in data space.
+   */
+
+  {
+    char command[1024];
+    char errbuf[1024];
+    char address_text[32];
+    int  proforma[4];
+    FILE *pfile;
+    char *temp_ptr;
+    char c;
+    int mcount_address, mcount_offset, count;
+    extern char *_execname;
+   
+
+    /* The use of _execname is incompatible with RISCiX 1.1 */
+    sprintf (command, "nm %s | fgrep mcount", _execname);
+
+    if ( (pfile = popen(command, "r")) == NULL)
+    {
+      sprintf (errbuf, "Could not open pipe");
+      PERROR (errbuf);
+    }
+
+    count=0;
+    while ( ((c=getc(pfile)) != EOF) && (c != ' ') && (count < 31))
+      address_text[count++]=c;
+    address_text[count]=0;
+
+    if ((count == 0) || pclose(pfile) != NULL)
+    {
+      sprintf (errbuf, "Failed to execute the command '%s'\n", command);
+      PERROR (errbuf);
+    }  
+
+    sscanf(address_text, "%x", &mcount_address);
+    ptr = (char *) unexec_text_start;
+    mcount_offset = (char *)mcount_address - ptr;
+
+#ifdef RISCiX_1_1
+#define EDATA_OFFSET 0x2c
+#else
+#define EDATA_OFFSET 0x30
+#endif
+
+    end = ptr + mcount_offset - EDATA_OFFSET;
+
+    write_segment (new, ptr, end);
+
+    proforma[0] = bss_end;	/* becomes _edata */
+    proforma[1] = bss_end;	/* becomes _end */
+    proforma[2] = bss_end;	/* becomes _minbrk */
+    proforma[3] = bss_end;	/* becomes _curbrk */
+
+    write (new, proforma, 16);
+
+    temp_ptr = ptr;
+    ptr = end + 16;
+    end = temp_ptr + hdr.a_text;
+
+    write_segment (new, ptr, end);
+  }
+
+#else /* !RISCiX */
+  ptr = (char *) unexec_text_start;
+  end = ptr + hdr.a_text;
+  write_segment (new, ptr, end);
+#endif /* RISCiX */
+
+  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;
+  /* This is the normal amount to write at once.
+     It is the size of block that NFS uses.  */
+  int writesize = 1 << 13;
+  int pagesize = getpagesize ();
+  char zeros[1 << 13];
+
+  bzero (zeros, sizeof (zeros));
+
+  for (i = 0; ptr < end;)
+    {
+      /* Distance to next multiple of writesize.  */
+      nwrite = (((int) ptr + writesize) & -writesize) - (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
+#ifdef EFAULT
+	  && errno == EFAULT
+#endif
+	  )
+	{
+	  /* Write only a page of zeros at once,
+	     so that we we don't overshoot the start
+	     of the valid memory in the old data segment.  */
+	  if (nwrite > pagesize)
+	    nwrite = pagesize;
+	  write (new, zeros, nwrite);
+	}
+#if 0 /* Now that we have can ask `write' to write more than a page,
+	 it is legit for write do less than the whole amount specified.  */
+      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);
+	}
+#endif
+      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;
+
+#ifdef MSDOS
+  if ((new = writedesc) < 0)
+#else
+  if ((new = open (new_name, O_RDWR)) < 0)
+#endif
+    {
+      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);
+	    }
+	}
+    }
+#ifndef MSDOS
+  close (new);
+#endif
+  return 0;
+}
+
+#endif /* COFF_BSD_SYMBOLS */
+
+#endif /* COFF */
+
+#endif /* not CANNOT_DUMP */
diff --git a/unexelf.c b/unexelf.c
new file mode 100644
index 0000000..60e82cc
--- /dev/null
+++ b/unexelf.c
@@ -0,0 +1,908 @@
+/* Copyright (C) 1985, 1986, 1987, 1988, 1990, 1992
+   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, 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!  */
+
+
+/*
+ * 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
+#include <config.h>
+extern void fatal (char *, ...);
+#endif
+
+#ifndef ELF_BSS_SECTION_NAME
+#define ELF_BSS_SECTION_NAME ".bss"
+#endif
+
+/* Get the address of a particular section or program header entry,
+ * accounting for the size of the entries.
+ */
+/* 
+   On PPC Reference Platform running Solaris 2.5.1
+   the plt section is also of type NOBI like the bss section.
+   (not really stored) and therefore sections after the bss
+   section start at the plt offset. The plt section is always
+   the one just before the bss section.
+   Thus, we modify the test from
+      if (NEW_SECTION_H (nn).sh_offset >= new_data2_offset)
+   to
+      if (NEW_SECTION_H (nn).sh_offset >= 
+               OLD_SECTION_H (old_bss_index-1).sh_offset)
+   This is just a hack. We should put the new data section
+   before the .plt section.
+   And we should not have this routine at all but use
+   the libelf library to read the old file and create the new
+   file.
+   The changed code is minimal and depends on prep set in m/prep.h
+   Erik Deumens
+   Quantum Theory Project
+   University of Florida
+   deumens@qtp.ufl.edu
+   Apr 23, 1996
+   */
+
+#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;
+{
+  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,
+		   ELF_BSS_SECTION_NAME))
+	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)
+  new_bss_addr = (Elf32_Addr) sbrk (0);
+#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);
+
+#ifdef UNEXEC_USE_MAP_PRIVATE
+  new_base = mmap (0, new_file_size, PROT_READ | PROT_WRITE, MAP_PRIVATE,
+		   new_file, 0);
+#else
+  new_base = mmap (0, new_file_size, PROT_READ | PROT_WRITE, MAP_SHARED,
+		   new_file, 0);
+#endif
+
+  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;
+	}
+      else
+	{
+	  /* Any section that was original placed AFTER the bss
+	     section should now be off by NEW_DATA2_SIZE. */
+#ifdef SOLARIS_POWERPC
+	  /* On PPC Reference Platform running Solaris 2.5.1
+	     the plt section is also of type NOBI like the bss section.
+	     (not really stored) and therefore sections after the bss
+	     section start at the plt offset. The plt section is always
+	     the one just before the bss section.
+	     It would be better to put the new data section before
+	     the .plt section, or use libelf instead.
+	     Erik Deumens, deumens@qtp.ufl.edu.  */
+	  if (NEW_SECTION_H (nn).sh_offset
+	      >= OLD_SECTION_H (old_bss_index-1).sh_offset)
+	    NEW_SECTION_H (nn).sh_offset += new_data2_size;
+#else
+	  if (round_up (NEW_SECTION_H (nn).sh_offset,
+			OLD_SECTION_H (old_bss_index).sh_addralign)
+	      >= new_data2_offset)
+	    NEW_SECTION_H (nn).sh_offset += new_data2_size;
+#endif
+	  /* Any section that was originally placed after the section
+	     header table should now be off by the size of one section
+	     header table entry.  */
+	  if (NEW_SECTION_H (nn).sh_offset > new_file_h->e_shoff)
+	    NEW_SECTION_H (nn).sh_offset += new_file_h->e_shentsize;
+	}
+
+      /* 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);
+
+      /* 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);
+	    }
+	}
+    }
+
+  /* Update the symbol values of _edata and _end.  */
+  for (n = new_file_h->e_shnum - 1; n; n--)
+    {
+      byte *symnames;
+      Elf32_Sym *symp, *symendp;
+
+      if (NEW_SECTION_H (n).sh_type != SHT_DYNSYM
+	  && NEW_SECTION_H (n).sh_type != SHT_SYMTAB)
+	continue;
+
+      symnames = ((byte *) new_base
+		  + NEW_SECTION_H (NEW_SECTION_H (n).sh_link).sh_offset);
+      symp = (Elf32_Sym *) (NEW_SECTION_H (n).sh_offset + new_base);
+      symendp = (Elf32_Sym *) ((byte *)symp + NEW_SECTION_H (n).sh_size);
+
+      for (; symp < symendp; symp ++)
+	if (strcmp ((char *) (symnames + symp->st_name), "_end") == 0
+	    || strcmp ((char *) (symnames + symp->st_name), "_edata") == 0)
+	  memcpy (&symp->st_value, &new_bss_addr, sizeof (new_bss_addr));
+    }
+
+  /* This loop seeks out relocation sections for the data section, so
+     that it can undo relocations performed by the runtime linker.  */
+  for (n = new_file_h->e_shnum - 1; n; n--)
+    {
+      Elf32_Shdr section = NEW_SECTION_H (n);
+      switch (section.sh_type) {
+      default:
+	break;
+      case SHT_REL:
+      case SHT_RELA:
+	/* This code handles two different size structs, but there should
+	   be no harm in that provided that r_offset is always the first
+	   member.  */
+	nn = section.sh_info;
+	if (!strcmp (old_section_names + NEW_SECTION_H (nn).sh_name, ".data")
+	    || !strcmp ((old_section_names + NEW_SECTION_H (nn).sh_name),
+			".data1"))
+	  {
+	    Elf32_Addr offset = NEW_SECTION_H (nn).sh_addr -
+	      NEW_SECTION_H (nn).sh_offset;
+	    caddr_t reloc = old_base + section.sh_offset, end;
+	    for (end = reloc + section.sh_size; reloc < end;
+		 reloc += section.sh_entsize)
+	      {
+		Elf32_Addr addr = ((Elf32_Rel *) reloc)->r_offset - offset;
+		memcpy (new_base + addr, old_base + addr, 4);
+	      }
+	  }
+	break;
+      }
+    }
+
+#ifdef UNEXEC_USE_MAP_PRIVATE
+  if (lseek (new_file, 0, SEEK_SET) == -1)
+    fatal ("Can't rewind (%s): errno %d\n", new_name, errno);
+
+  if (write (new_file, new_base, new_file_size) != new_file_size)
+    fatal ("Can't write (%s): errno %d\n", new_name, errno);
+#endif
+
+  /* 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/unif.c b/unif.c
new file mode 100644
index 0000000..4bc2ecf
--- /dev/null
+++ b/unif.c
@@ -0,0 +1,2000 @@
+/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  
+ */
+
+/* "unif.c" Uniform vectors and arrays
+   Authors: Aubrey Jaffer & Radey Shouman.
+
+The set of uniform vector types is:
+ Vector of:		 Called:
+char			string
+boolean			bvect
+signed int		ivect
+unsigned int		uvect
+float			fvect
+double			dvect
+complex double		cvect
+*/
+
+#include "scm.h"
+
+#ifndef STDC_HEADERS
+	int ungetc P((int c, FILE *stream));
+	sizet fwrite ();
+#endif
+
+long tc16_array = 0;
+
+char s_resizuve[] = "vector-set-length!";
+SCM resizuve(vect, len)
+     SCM vect, len;
+{
+  long l = INUM(len);
+  sizet siz, sz;
+  ASRTGO(NIMP(vect), badarg1);
+  switch TYP7(vect) {
+  default: badarg1: wta(vect, (char *)ARG1, s_resizuve);
+  case tc7_string:
+    ASRTGO(vect != nullstr, badarg1);
+    sz = sizeof(char);
+    l++;
+    break;
+  case tc7_vector:
+    ASRTGO(vect != nullvect, badarg1);
+    sz = sizeof(SCM);
+    break;
+#ifdef ARRAYS
+  case tc7_bvect:
+    l = (l+LONG_BIT-1)/LONG_BIT;
+  case tc7_uvect:
+  case tc7_ivect:
+    sz = sizeof(long);
+    break;
+# ifdef FLOATS
+#  ifdef SINGLES
+  case tc7_fvect:
+    sz = sizeof(float);
+    break;
+#  endif
+  case tc7_dvect:
+    sz = sizeof(double);
+    break;
+  case tc7_cvect:
+    sz = 2*sizeof(double);
+    break;
+# endif
+#endif
+  }
+  ASSERT(INUMP(len), len, ARG2, s_resizuve);
+  if (!l) l = 1L;
+  siz = l * sz;
+  if (siz != l * sz) wta(MAKINUM(l * sz), (char *) NALLOC, s_resizuve);
+  DEFER_INTS;
+  SETCHARS(vect, (char *)must_realloc((char *)CHARS(vect),
+				     (long)LENGTH(vect)*sz,
+				     (long)siz, s_resizuve));
+  if VECTORP(vect) {
+    sz = LENGTH(vect);
+    while(l > sz) VELTS(vect)[--l] = UNSPECIFIED;
+  }
+  else if STRINGP(vect) CHARS(vect)[l-1] = 0;
+  SETLENGTH(vect, INUM(len), TYP7(vect));
+  ALLOW_INTS;
+  return vect;
+}
+
+#ifdef ARRAYS
+
+# ifdef FLOATS
+#  ifdef SINGLES
+SCM makflo (x)
+     float x;
+{
+  SCM z;
+  if (x==0.0) return flo0;
+  NEWCELL(z);
+  DEFER_INTS;
+  CAR(z) = tc_flo;
+  FLO(z) = x;
+  ALLOW_INTS;
+  return z;
+}
+#  endif
+# endif
+
+SCM make_uve(k, prot)
+     long k;
+     SCM prot;
+{
+  SCM v;
+  long i, type;
+  if (BOOL_T==prot) {
+    i = sizeof(long)*((k+LONG_BIT-1)/LONG_BIT);
+    type = tc7_bvect;
+  }
+  else if ICHRP(prot) {
+    i = sizeof(char)*k;
+    type = tc7_string;
+  }
+  else if INUMP(prot) {
+    i = sizeof(long)*k;
+    if (INUM(prot)>0) type = tc7_uvect;
+    else type = tc7_ivect;
+  }
+  else
+# ifdef FLOATS
+     if (IMP(prot) || !INEXP(prot))
+# endif
+				/* Huge non-unif vectors are NOT supported. */
+       return make_vector(MAKINUM(k), UNDEFINED); /* no special vector */
+# ifdef FLOATS
+#  ifdef SINGLES
+  else if SINGP(prot) {
+#   ifdef CDR_DOUBLES
+    double x = FLO(prot);
+    float fx = x;
+    if (x != fx) {
+      i = sizeof(double)*k;
+      type = tc7_dvect;
+    }
+    else
+#   endif
+    {
+      i = sizeof(float)*k;
+      type = tc7_fvect;
+    }
+  }
+#  endif
+  else if (CPLXP(prot)) {
+    i = 2*sizeof(double)*k;
+    type = tc7_cvect;
+  }
+  else {
+    i = sizeof(double)*k;
+    type = tc7_dvect;
+  }
+# endif
+
+  NEWCELL(v);
+  DEFER_INTS;
+  SETCHARS(v, must_malloc((i ? i : 1L), s_vector));
+  SETLENGTH(v, (k<LENGTH_MAX ? k : LENGTH_MAX), type);
+  ALLOW_INTS;
+  return v;
+}
+
+static char s_uve_len[] = "uniform-vector-length";
+SCM uve_len(v)
+     SCM v;
+{
+  ASRTGO(NIMP(v), badarg1);
+  switch TYP7(v) {
+  default: badarg1: wta(v, (char *)ARG1, s_uve_len);
+  case tc7_bvect:
+  case tc7_string:
+  case tc7_uvect:
+  case tc7_ivect:
+  case tc7_fvect:
+  case tc7_dvect:
+  case tc7_cvect:
+  case tc7_vector:
+    return MAKINUM(LENGTH(v));
+  }
+}
+
+SCM arrayp(v, prot)
+     SCM v, prot;
+{
+  int nprot = UNBNDP(prot), enclosed = 0;
+  if IMP(v) return BOOL_F;
+ loop:
+  switch TYP7(v) {
+  case tc7_smob: if (!ARRAYP(v)) return BOOL_F;
+    if (nprot) return BOOL_T;
+    if (enclosed++) return BOOL_F;
+    v = ARRAY_V(v);
+    goto loop;
+  case tc7_bvect: return nprot || BOOL_T==prot ? BOOL_T : BOOL_F;
+  case tc7_string: return nprot || ICHRP(prot) ? BOOL_T : BOOL_F;
+  case tc7_uvect:
+    return nprot || (INUMP(prot) && INUM(prot)>0) ? BOOL_T : BOOL_F;
+  case tc7_ivect:
+    return nprot || (INUMP(prot) && INUM(prot)<=0) ? BOOL_T : BOOL_F;
+# ifdef FLOATS
+#  ifdef SINGLES
+  case tc7_fvect: return nprot || (NIMP(prot) && SINGP(prot)) ? BOOL_T : BOOL_F;
+#  endif
+  case tc7_dvect: return nprot || (NIMP(prot) && REALP(prot)) ? BOOL_T : BOOL_F;
+  case tc7_cvect: return nprot || (NIMP(prot) && CPLXP(prot)) ? BOOL_T : BOOL_F;
+# endif
+  case tc7_vector: return nprot || NULLP(prot) ? BOOL_T : BOOL_F;
+  default:;
+  }
+  return BOOL_F;
+}
+SCM array_rank(ra)
+     SCM ra;
+{
+  if IMP(ra) return INUM0;
+  switch (TYP7(ra)) {
+  default: return INUM0;
+  case tc7_string: case tc7_vector: case tc7_bvect:
+  case tc7_uvect: case tc7_ivect: case tc7_fvect:
+  case tc7_cvect: case tc7_dvect:
+    return MAKINUM(1L);
+  case tc7_smob:
+    if ARRAYP(ra) return MAKINUM(ARRAY_NDIM(ra));
+    return INUM0;
+  }
+}
+static char s_array_dims[] = "array-dimensions";
+SCM array_dims(ra)
+     SCM ra;
+{
+  SCM res=EOL;
+  sizet k;
+  array_dim *s;
+  if IMP(ra) return BOOL_F;
+  switch (TYP7(ra)) {
+  default: return BOOL_F;
+  case tc7_string: case tc7_vector: case tc7_bvect:
+  case tc7_uvect: case tc7_ivect: case tc7_fvect:
+  case tc7_cvect: case tc7_dvect:
+    return cons(MAKINUM(LENGTH(ra)), EOL);
+  case tc7_smob:
+    if (!ARRAYP(ra)) return BOOL_F;
+    k = ARRAY_NDIM(ra);
+    s = ARRAY_DIMS(ra);
+    while (k--)
+      res = cons(s[k].lbnd ? cons2(MAKINUM(s[k].lbnd), MAKINUM(s[k].ubnd), EOL) :
+		 MAKINUM(1+(s[k].ubnd))
+		 , res);
+    return res;
+  }
+}
+static char s_bad_ind[] = "Bad array index";
+long aind(ra, args, what)
+     SCM ra, args;
+     char *what;
+{
+  SCM ind;
+  register long j;
+  register sizet pos = ARRAY_BASE(ra);
+  register sizet k = ARRAY_NDIM(ra);
+  array_dim *s = ARRAY_DIMS(ra);
+  if INUMP(args) {
+    ASSERT(1==k, UNDEFINED, WNA, what);
+    j = INUM(args);
+    ASSERT(j >= (s->lbnd) && j <= (s->ubnd), args, OUTOFRANGE, what);
+    return pos + (j - s->lbnd)*(s->inc);
+  }
+  ASSERT((IMP(args) ? NULLP(args) : CONSP(args)), args, s_bad_ind, what);
+  while (k && NIMP(args)) {
+    ind = CAR(args);
+    args = CDR(args);
+    ASSERT(INUMP(ind), ind, s_bad_ind, what);
+    j = INUM(ind);
+    ASSERT(j >= (s->lbnd) && j <= (s->ubnd), ind, OUTOFRANGE, what);
+    pos += (j - s->lbnd)*(s->inc);
+    k--;
+    s++;
+  }
+  ASSERT(0==k && NULLP(args), UNDEFINED, WNA, what);
+  return pos;
+}
+
+SCM make_ra(ndim)
+     int ndim;
+{
+  SCM ra;
+  NEWCELL(ra);
+  DEFER_INTS;
+  SETCDR(ra, must_malloc((long)(sizeof(array)+ndim*sizeof(array_dim)),
+			 "array"));
+  CAR(ra) = ((long)ndim << 17) + tc16_array;
+  ARRAY_V(ra) = nullvect;
+  ALLOW_INTS;
+  return ra;
+}
+
+static char s_bad_spec[] = "Bad array dimension";
+/* Increments will still need to be set. */
+SCM shap2ra(args, what)
+     SCM args;
+     char *what;
+{
+  array_dim *s;
+  SCM ra, spec, sp;
+  int ndim = ilength(args);
+  ASSERT(0 <= ndim, args, s_bad_spec, what);
+  ra = make_ra(ndim);
+  ARRAY_BASE(ra) = 0;
+  s = ARRAY_DIMS(ra);
+  for (; NIMP(args); s++, args = CDR(args)) {
+    spec = CAR(args);
+    if IMP(spec) {
+      ASSERT(INUMP(spec)&&INUM(spec)>=0, spec, s_bad_spec, what);
+      s->lbnd = 0;
+      s->ubnd = INUM(spec) - 1;
+      s->inc = 1;
+    }
+    else {
+      ASSERT(CONSP(spec) && INUMP(CAR(spec)), spec, s_bad_spec, what);
+      s->lbnd = INUM(CAR(spec));
+      sp = CDR(spec);
+      ASSERT(INUMP(CAR(sp)) && NULLP(CDR(sp)),
+	     spec, s_bad_spec, what);
+      s->ubnd = INUM(CAR(sp));
+      s->inc = 1;
+    }
+  }
+  return ra;
+}
+
+static char s_uve_fill[] = "uniform-vector-fill!";
+int rafill(ra, fill, ignore)
+     SCM ra, fill, ignore;
+{
+  sizet i, n;
+  long inc = 1;
+  sizet base = 0;
+  if ARRAYP(ra) {
+    n = ARRAY_DIMS(ra)->ubnd - ARRAY_DIMS(ra)->lbnd + 1;
+    inc = ARRAY_DIMS(ra)->inc;
+    base = ARRAY_BASE(ra);
+    ra = ARRAY_V(ra);
+  }
+  else
+    n = LENGTH(ra);
+  switch TYP7(ra) {
+  badarg2: wta(fill, (char *)ARG2, s_uve_fill);
+  default: ASSERT(NFALSEP(arrayp(ra, UNDEFINED)), ra, ARG1, s_uve_fill);
+    for (i = base; n--; i += inc)
+      aset(ra, fill, MAKINUM(i));
+    break;
+  case tc7_vector: {
+    SCM *ve = VELTS(ra);
+    for (i = base; n--; i += inc)
+      ve[i] = fill;
+    break;
+  }
+  case tc7_string: {
+    char *ve = CHARS(ra);
+    SCM f = ICHR(fill);
+    ASRTGO(ICHRP(fill), badarg2);
+    for (i = base; n--; i += inc)
+      ve[i] = f;
+    break;
+  }
+  case tc7_bvect: {
+    long *ve = (long *)VELTS(ra);
+    if (1==inc && (n >= LONG_BIT || n==LENGTH(ra))) {
+      i = base/LONG_BIT;
+      if (BOOL_F==fill) {
+	if (base % LONG_BIT)	/* leading partial word */
+	  ve[i++] &= ~(~0L << (base % LONG_BIT));
+	for (; i < (base + n)/LONG_BIT; i++)
+	  ve[i] = 0L;
+	if ((base + n) % LONG_BIT) /* trailing partial word */
+	  ve[i] &= (~0L << ((base + n) % LONG_BIT));
+      }
+      else if (BOOL_T==fill) {
+	if (base % LONG_BIT)
+	  ve[i++] |= ~0L << (base % LONG_BIT);
+	for (; i < (base + n)/LONG_BIT; i++)
+	  ve[i] = ~0L;
+	if ((base + n) % LONG_BIT)
+	  ve[i] |= ~(~0L << ((base + n) % LONG_BIT));
+      }
+      else goto badarg2;
+    }
+    else {
+      if (BOOL_F==fill)
+	for (i = base; n--; i += inc)
+	  ve[i/LONG_BIT] &= ~(1L<<(i%LONG_BIT));
+      else if (BOOL_T==fill)
+	for (i = base; n--; i += inc)
+	  ve[i/LONG_BIT] |= (1L<<(i%LONG_BIT));
+      else goto badarg2;
+    }
+    break;
+  }
+  case tc7_uvect:
+  case tc7_ivect:
+    {
+      long *ve = VELTS(ra);
+      long f = (tc7_uvect==TYP7(ra) ?
+		num2ulong(fill, (char *)ARG2, s_uve_fill) :
+		num2long(fill, (char *)ARG2, s_uve_fill));
+      for (i = base; n--; i += inc)
+	ve[i] = f;
+      break;
+    }
+# ifdef FLOATS
+#  ifdef SINGLES
+  case tc7_fvect: {
+    float *ve = (float *)VELTS(ra);
+    float f = num2dbl(fill, (char *)ARG2, s_uve_fill);
+    for (i = base; n--; i += inc)
+      ve[i] = f;
+    break;
+  }
+#  endif /* SINGLES */
+  case tc7_dvect: {
+    double *ve = (double *)VELTS(ra);
+    double f = num2dbl(fill, (char *)ARG2, s_uve_fill);
+    for (i = base; n--; i += inc)
+      ve[i] = f;
+    break;
+  }
+  case tc7_cvect: {
+    double fr, fi=0.0;
+    double (*ve)[2] = (double (*)[2])VELTS(ra);
+    if (NIMP(fill) && CPLXP(fill)) {
+      fr = REAL(fill);
+      fi = IMAG(fill);
+    }
+    else
+      fr = num2dbl(fill, (char *)ARG2, s_uve_fill);
+    for (i = base; n--; i += inc) {
+      ve[i][0] = fr;
+      ve[i][1] = fi;
+    }
+    break;
+  }
+# endif /* FLOATS */
+  }
+  return 1;
+}
+SCM uve_fill(uve, fill)
+     SCM uve, fill;
+{
+
+  ASSERT(NIMP(uve) && (!ARRAYP(uve) || 1==ARRAY_NDIM(uve)),
+	 uve, ARG1, s_uve_fill);
+  rafill(uve, fill, EOL);
+  return UNSPECIFIED;
+}
+
+static char s_dims2ura[] = "dimensions->uniform-array";
+SCM dims2ura(dims, prot, fill)
+     SCM dims, prot, fill;
+{
+  sizet k, vlen = 1;
+  long rlen = 1;
+  array_dim *s;
+  SCM ra;
+  if INUMP(dims)
+    if (INUM(dims) < LENGTH_MAX) {
+      ra = make_uve(INUM(dims), prot);
+      if NNULLP(fill)
+	rafill(ra, CAR(fill), EOL);
+      return ra;
+    }
+    else
+      dims = cons(dims, EOL);
+  ASSERT(NULLP(dims) || (NIMP(dims) && CONSP(dims)), dims, ARG1, s_dims2ura);
+  ra = shap2ra(dims, s_dims2ura);
+  CAR(ra) |= ARRAY_CONTIGUOUS;
+  s = ARRAY_DIMS(ra);
+  k = ARRAY_NDIM(ra);
+  while (k--) {
+    s[k].inc = (rlen > 0 ? rlen : 0);
+    rlen = (s[k].ubnd - s[k].lbnd + 1)*s[k].inc;
+    vlen *= (s[k].ubnd - s[k].lbnd + 1);
+  }
+  if (rlen < LENGTH_MAX)
+    ARRAY_V(ra) = make_uve((rlen > 0 ? rlen : 0L), prot);
+  else {
+    sizet bit;
+    switch TYP7(make_uve(0L, prot)) {
+    default: bit = LONG_BIT; break;
+    case tc7_vector: wta(dims, (char *)OUTOFRANGE, s_dims2ura);
+    case tc7_bvect: bit = 1; break;
+    case tc7_string: bit = CHAR_BIT; break;
+    case tc7_fvect: bit = sizeof(float)*CHAR_BIT/sizeof(char); break;
+    case tc7_dvect: bit = sizeof(double)*CHAR_BIT/sizeof(char); break;
+    case tc7_cvect: bit = 2*sizeof(double)*CHAR_BIT/sizeof(char); break;
+    }
+    ARRAY_BASE(ra) = (LONG_BIT + bit - 1)/bit;
+    rlen += ARRAY_BASE(ra);
+    ARRAY_V(ra) = make_uve(rlen, prot);
+    *((long *)VELTS(ARRAY_V(ra))) = rlen;
+  }
+  if NNULLP(fill) {
+    ASSERT(1==ilength(fill), UNDEFINED, WNA, s_dims2ura);
+    rafill(ARRAY_V(ra), CAR(fill), EOL);
+  }
+  if (1==ARRAY_NDIM(ra) && 0==ARRAY_BASE(ra))
+    if (s->ubnd < s->lbnd || (0==s->lbnd && 1==s->inc)) return ARRAY_V(ra);
+  return ra;
+}
+
+void ra_set_contp(ra)
+     SCM ra;
+{
+  sizet k =  ARRAY_NDIM(ra);
+  long inc;
+  if (k) inc = ARRAY_DIMS(ra)[k-1].inc;
+  while (k--) {
+    if (inc != ARRAY_DIMS(ra)[k].inc) {
+      CAR(ra) &= ~ARRAY_CONTIGUOUS;
+      return;
+    }
+    inc *= (ARRAY_DIMS(ra)[k].ubnd - ARRAY_DIMS(ra)[k].lbnd + 1);
+  }
+  CAR(ra) |= ARRAY_CONTIGUOUS;
+}
+char s_make_sh_array[] = "make-shared-array";
+SCM make_sh_array(oldra, mapfunc, dims)
+     SCM oldra;
+     SCM mapfunc;
+     SCM dims;
+{
+  SCM ra;
+  SCM inds, indptr;
+  SCM imap;
+  sizet i, k;
+  long old_min, new_min, old_max, new_max;
+  array_dim *s;
+  ASSERT(BOOL_T==procedurep(mapfunc), mapfunc, ARG2, s_make_sh_array);
+  ASSERT(NIMP(oldra) && arrayp(oldra, UNDEFINED), oldra, ARG1, s_make_sh_array);
+  ra = shap2ra(dims, s_make_sh_array);
+  if (ARRAYP(oldra)) {
+    ARRAY_V(ra) = ARRAY_V(oldra);
+    old_min = old_max = ARRAY_BASE(oldra);
+    s=ARRAY_DIMS(oldra);
+    k = ARRAY_NDIM(oldra);
+    while (k--) {
+      if (s[k].inc > 0)
+	old_max += (s[k].ubnd - s[k].lbnd)*s[k].inc;
+      else
+	old_min += (s[k].ubnd - s[k].lbnd)*s[k].inc;
+    }
+  }
+  else {
+    ARRAY_V(ra) = oldra;
+    old_min = 0;
+    old_max = (long)LENGTH(oldra) - 1;
+  }
+  inds = EOL;
+  s = ARRAY_DIMS(ra);
+  for (k = 0; k < ARRAY_NDIM(ra); k++) {
+    inds = cons(MAKINUM(s[k].lbnd), inds);
+    if (s[k].ubnd < s[k].lbnd) {
+      if (1==ARRAY_NDIM(ra))
+	ra = make_uve(0L, array_prot(ra));
+      else
+	ARRAY_V(ra) = make_uve(0L, array_prot(ra));
+      return ra;
+    }
+  }
+  imap = apply(mapfunc, reverse(inds), EOL);
+  if ARRAYP(oldra)
+    i = (sizet)aind(oldra, imap, s_make_sh_array);
+  else {
+    if NINUMP(imap) {
+      ASSERT(1==ilength(imap) && INUMP(CAR(imap)),
+	     imap, s_bad_ind, s_make_sh_array);
+      imap = CAR(imap);
+    }
+    i = INUM(imap);
+  }
+  ARRAY_BASE(ra) = new_min = new_max = i;
+  indptr = inds;
+  k = ARRAY_NDIM(ra);
+  while (k--) {
+    if (s[k].ubnd > s[k].lbnd) {
+      CAR(indptr) = MAKINUM(INUM(CAR(indptr))+1);
+      imap = apply(mapfunc, reverse(inds), EOL);
+      if ARRAYP(oldra)
+	s[k].inc = aind(oldra, imap, s_make_sh_array) - i;
+      else {
+	if NINUMP(imap) {
+	  ASSERT(1==ilength(imap) && INUMP(CAR(imap)),
+		 imap, s_bad_ind, s_make_sh_array);
+	  imap = CAR(imap);
+	}
+	s[k].inc = (long)INUM(imap) - i;
+      }
+      i += s[k].inc;
+      if (s[k].inc > 0)
+	new_max += (s[k].ubnd - s[k].lbnd)*s[k].inc;
+      else
+	new_min += (s[k].ubnd - s[k].lbnd)*s[k].inc;
+    }
+    else
+      s[k].inc = new_max - new_min + 1; /* contiguous by default */
+    indptr = CDR(indptr);
+  }
+  ASSERT(old_min <= new_min && old_max >= new_max, UNDEFINED,
+	 "mapping out of range", s_make_sh_array);
+  if (1==ARRAY_NDIM(ra) && 0==ARRAY_BASE(ra)) {
+    if (1==s->inc && 0==s->lbnd
+	&& LENGTH(ARRAY_V(ra))==1+s->ubnd) return ARRAY_V(ra);
+    if (s->ubnd < s->lbnd) return make_uve(0L, array_prot(ra));
+  }
+  ra_set_contp(ra);
+  return ra;
+}
+
+/* args are RA . DIMS */
+static char s_trans_array[] = "transpose-array";
+SCM trans_array(args)
+     SCM args;
+{
+  SCM ra, res, vargs, *ve = &vargs;
+  array_dim *s, *r;
+  int ndim, i, k;
+  ASSERT(NIMP(args), UNDEFINED, WNA, s_trans_array);
+  ra = CAR(args);
+  args = CDR(args);
+  switch TYP7(ra) {
+  default: badarg: wta(ra, (char *)ARG1, s_trans_array);
+  case tc7_bvect: case tc7_string: case tc7_uvect: case tc7_ivect:
+  case tc7_fvect: case tc7_dvect: case tc7_cvect: case tc7_vector:
+    ASSERT(NIMP(args) && NULLP(CDR(args)), UNDEFINED, WNA, s_trans_array);
+    ASSERT(INUM0==CAR(args), CAR(args), ARG1, s_trans_array);
+    return ra;
+  case tc7_smob: ASRTGO(ARRAYP(ra), badarg);
+    vargs = vector(args);
+    ASSERT(LENGTH(vargs)==ARRAY_NDIM(ra), UNDEFINED, WNA, s_trans_array);
+    ve = VELTS(vargs);
+    ndim = 0;
+    for (k = 0; k < ARRAY_NDIM(ra); k++) {
+      i = INUM(ve[k]);
+      ASSERT(INUMP(ve[k]) && i >=0 && i < ARRAY_NDIM(ra),
+	     ve[k], ARG2, s_trans_array);
+      if (ndim < i) ndim = i;
+    }
+    ndim++;
+    res = make_ra(ndim);
+    ARRAY_V(res) = ARRAY_V(ra);
+    ARRAY_BASE(res) = ARRAY_BASE(ra);
+    for (k = ndim; k--;) {
+      ARRAY_DIMS(res)[k].lbnd = 0;
+      ARRAY_DIMS(res)[k].ubnd = -1;
+    }
+    for (k = ARRAY_NDIM(ra); k--;) {
+      i = INUM(ve[k]);
+      s = &(ARRAY_DIMS(ra)[k]);
+      r = &(ARRAY_DIMS(res)[i]);
+      if (r->ubnd < r->lbnd) {
+	r->lbnd = s->lbnd;
+	r->ubnd = s->ubnd;
+	r->inc = s->inc;
+	ndim--;
+      }
+      else {
+	if (r->ubnd > s->ubnd)
+	  r->ubnd = s->ubnd;
+	if (r->lbnd < s->lbnd) {
+	  ARRAY_BASE(res) += (s->lbnd - r->lbnd)*r->inc;
+	  r->lbnd = s->lbnd;
+	}
+	r->inc += s->inc;
+      }
+    }
+    ASSERT(ndim <= 0, args, "bad argument list", s_trans_array);
+    ra_set_contp(res);
+    return res;
+  }
+}
+
+/* args are RA . AXES */
+static char s_encl_array[] = "enclose-array";
+SCM encl_array(axes)
+     SCM axes;
+{
+  SCM axv, ra, res, ra_inr;
+  array_dim vdim, *s = &vdim;
+  int ndim, j, k, ninr, noutr;
+  ASSERT(NIMP(axes), UNDEFINED, WNA, s_encl_array);
+  ra = CAR(axes);
+  axes = CDR(axes);
+  if NULLP(axes)
+    axes =  cons((ARRAYP(ra) ? MAKINUM(ARRAY_NDIM(ra) - 1) : INUM0), EOL);
+  ninr = ilength(axes);
+  ra_inr = make_ra(ninr);
+  ASRTGO(NIMP(ra), badarg1);
+  switch TYP7(ra) {
+  default: badarg1: wta(ra, (char *)ARG1, s_encl_array);
+  case tc7_string: case tc7_bvect: case tc7_uvect: case tc7_ivect:
+  case tc7_fvect: case tc7_dvect: case tc7_cvect: case tc7_vector:
+    s->lbnd = 0;
+    s->ubnd = LENGTH(ra) - 1;
+    s->inc = 1;
+    ARRAY_V(ra_inr) = ra;
+    ARRAY_BASE(ra_inr) = 0;
+    ndim = 1;
+    break;
+  case tc7_smob: ASRTGO(ARRAYP(ra), badarg1);
+    s = ARRAY_DIMS(ra);
+    ARRAY_V(ra_inr) = ARRAY_V(ra);
+    ARRAY_BASE(ra_inr) = ARRAY_BASE(ra);
+    ndim = ARRAY_NDIM(ra);
+    break;
+  }
+  noutr = ndim - ninr;
+  axv = make_string(MAKINUM(ndim), MAKICHR(0));
+  ASSERT(0 <= noutr && 0 <= ninr, UNDEFINED, WNA, s_encl_array);
+  res = make_ra(noutr);
+  ARRAY_BASE(res) = ARRAY_BASE(ra_inr);
+  ARRAY_V(res) = ra_inr;
+  for (k = 0; k < ninr; k++, axes = CDR(axes)) {
+    j = INUM(CAR(axes));
+    ASSERT(INUMP(CAR(axes)) && j<ndim, CAR(axes), "bad axis", s_encl_array);
+    ARRAY_DIMS(ra_inr)[k].lbnd = s[j].lbnd;
+    ARRAY_DIMS(ra_inr)[k].ubnd = s[j].ubnd;
+    ARRAY_DIMS(ra_inr)[k].inc = s[j].inc;
+    CHARS(axv)[j] = 1;
+  }
+  for (j = 0, k = 0; k < noutr; k++, j++) {
+    while (CHARS(axv)[j]) j++;
+    ARRAY_DIMS(res)[k].lbnd = s[j].lbnd;
+    ARRAY_DIMS(res)[k].ubnd = s[j].ubnd;
+    ARRAY_DIMS(res)[k].inc = s[j].inc;
+  }
+  ra_set_contp(ra_inr);
+  ra_set_contp(res);
+  return res;
+}
+
+static char s_array_inbp[] = "array-in-bounds?";
+SCM array_inbp(args)
+  SCM args;
+{
+  SCM v, ind = EOL;
+  register long j;
+  ASRTGO(NIMP(args), wna);
+  v = CAR(args);
+  args = CDR(args);
+  if IMP(v) goto scalar;
+  switch TYP7(v) {
+  default:
+  scalar: if NULLP(args) return BOOL_T;
+  badarg1: wta(v, (char *)ARG1, s_array_inbp);
+  wna: wta(UNDEFINED, (char *)WNA, s_array_inbp);
+  case tc7_smob:
+    if (ARRAYP(v)) {
+      SCM ret = BOOL_T;
+      register sizet k = ARRAY_NDIM(v);
+      array_dim *s = ARRAY_DIMS(v);
+      while (k && NIMP(args)) {
+	ind = CAR(args);
+	args = CDR(args);
+	ASSERT(INUMP(ind), ind, s_bad_ind, s_array_inbp);
+	j = INUM(ind);
+	if (j < (s->lbnd) || j > (s->ubnd)) ret = BOOL_F;
+	k--;
+	s++;
+      }
+      ASRTGO(0==k && NULLP(args), wna);
+      return ret;
+    }
+    else goto scalar;
+  case tc7_bvect: case tc7_string: case tc7_uvect: case tc7_ivect:
+  case tc7_fvect: case tc7_dvect: case tc7_cvect: case tc7_vector:
+    ASRTGO(NIMP(args) && NULLP(CDR(args)), wna);
+    ind = CAR(args);
+    ASSERT(INUMP(ind), ind, s_bad_ind, s_array_inbp);
+    j = INUM(ind);
+    return j >= 0 && j < LENGTH(v) ? BOOL_T : BOOL_F;
+  }
+}
+static char s_aref[] = "array-ref";
+SCM aref(v, args)
+     SCM v, args;
+{
+  long pos;
+  if IMP(v) {
+    ASRTGO(NULLP(args), badarg);
+    return v;
+  }
+  else if ARRAYP(v) {
+    pos = aind(v, args, s_aref);
+    v = ARRAY_V(v);
+  }
+  else {
+    if NIMP(args) {
+      ASSERT(CONSP(args) && INUMP(CAR(args)), args, ARG2, s_aref);
+      pos = INUM(CAR(args));
+      ASRTGO(NULLP(CDR(args)), wna);
+    }
+    else {
+      ASSERT(INUMP(args), args, ARG2, s_aref);
+      pos = INUM(args);
+    }
+    ASRTGO(pos >= 0 && pos < LENGTH(v), outrng);
+  }
+  switch TYP7(v) {
+  default: if NULLP(args) return v;
+  badarg: wta(v, (char *)ARG1, s_aref);
+  outrng: wta(MAKINUM(pos), (char *)OUTOFRANGE, s_aref);
+  wna: wta(UNDEFINED, (char *)WNA, s_aref);
+  case tc7_smob: {		/* enclosed */
+    int k = ARRAY_NDIM(v);
+    SCM res = make_ra(k);
+    if (!ARRAYP(v)) {
+      ASRTGO(NULLP(args),badarg);
+      return v;
+    }
+    ARRAY_V(res) = ARRAY_V(v);
+    ARRAY_BASE(res) = pos;
+    while (k--) {
+      ARRAY_DIMS(res)[k].lbnd = ARRAY_DIMS(v)[k].lbnd;
+      ARRAY_DIMS(res)[k].ubnd = ARRAY_DIMS(v)[k].ubnd;
+      ARRAY_DIMS(res)[k].inc = ARRAY_DIMS(v)[k].inc;
+    }
+    return res;
+  }
+  case tc7_bvect:
+    if (VELTS(v)[pos/LONG_BIT]&(1L<<(pos%LONG_BIT)))
+      return BOOL_T;
+    else return BOOL_F;
+  case tc7_string:
+    return MAKICHR(CHARS(v)[pos]);
+# ifdef INUMS_ONLY
+  case tc7_uvect:
+  case tc7_ivect:
+    return MAKINUM(VELTS(v)[pos]);
+# else
+  case tc7_uvect:
+    return ulong2num(VELTS(v)[pos]);
+  case tc7_ivect:
+    return long2num(VELTS(v)[pos]);
+# endif
+# ifdef FLOATS
+#  ifdef SINGLES
+  case tc7_fvect:
+    return makflo(((float *)CDR(v))[pos]);
+#  endif
+  case tc7_dvect:
+    return makdbl(((double *)CDR(v))[pos], 0.0);
+  case tc7_cvect:
+    return makdbl(((double *)CDR(v))[2*pos],
+		  ((double *)CDR(v))[2*pos+1]);
+# endif
+  case tc7_vector:
+    return VELTS(v)[pos];
+  }
+}
+SCM scm_array_ref(args)
+     SCM args;
+{
+  ASSERT(NIMP(args), UNDEFINED, WNA, s_aref);
+  return aref(CAR(args), CDR(args));
+}
+
+/* Internal version of aref for uves that does no error checking and
+   tries to recycle conses.  (Make *sure* you want them recycled.) */
+SCM cvref(v, pos, last)
+     SCM v;
+     sizet pos;
+     SCM last;
+{
+  switch TYP7(v) {
+  default: wta(v, (char *)ARG1, "PROGRAMMING ERROR: cvref");
+  case tc7_bvect:
+    if (VELTS(v)[pos/LONG_BIT]&(1L<<(pos%LONG_BIT)))
+      return BOOL_T;
+    else return BOOL_F;
+  case tc7_string:
+    return MAKICHR(CHARS(v)[pos]);
+# ifdef INUMS_ONLY
+  case tc7_uvect:
+  case tc7_ivect:
+    return MAKINUM(VELTS(v)[pos]);
+# else
+  case tc7_uvect:
+    return ulong2num(VELTS(v)[pos]);
+  case tc7_ivect:
+    return long2num(VELTS(v)[pos]);
+# endif
+# ifdef FLOATS
+#  ifdef SINGLES
+  case tc7_fvect:
+    if (NIMP(last) && (last != flo0) && (tc_flo==CAR(last))) {
+      FLO(last) = ((float *)CDR(v))[pos];
+      return last;
+    }
+    return makflo(((float *)CDR(v))[pos]);
+#  endif
+  case tc7_cvect:
+    if (0.0!=((double *)CDR(v))[2*pos+1]) {
+      if (NIMP(last) && tc_dblc==CAR(last)) {
+	REAL(last) = ((double *)CDR(v))[2*pos];
+	IMAG(last) = ((double *)CDR(v))[2*pos+1];
+	return last;
+      }
+      return makdbl(((double *)CDR(v))[2*pos],
+		    ((double *)CDR(v))[2*pos+1]);
+    }
+    else pos *= 2;
+    /* Fall through */
+  case tc7_dvect:
+#  ifdef CDR_DOUBLES
+    if (NIMP(last) && (last != flo0) && (tc_flo==CAR(last))) {
+      FLO(last) = ((double *)CDR(v))[pos];
+      return last;
+    }
+#  else
+#   ifdef SINGLES
+    if (NIMP(last) && tc_dblr==CAR(last))
+#   else
+    if (NIMP(last) && (last != flo0) && (tc_dblr==CAR(last)))
+#   endif
+      {
+	REAL(last) = ((double *)CDR(v))[pos];
+	return last;
+      }
+#  endif /* ndef CDR_DOUBLES */
+    return makdbl(((double *)CDR(v))[pos], 0.0);
+# endif /* def FLOATS */
+  case tc7_vector:
+    return VELTS(v)[pos];
+  case tc7_smob: {		/* enclosed array */
+    int k = ARRAY_NDIM(v);
+    if (IMP(last) || (!ARRAYP(last))) {
+      last = make_ra(k);
+      ARRAY_V(last) = ARRAY_V(v);
+      while (k--) {
+	ARRAY_DIMS(last)[k].ubnd = ARRAY_DIMS(v)[k].ubnd;
+	ARRAY_DIMS(last)[k].lbnd = ARRAY_DIMS(v)[k].lbnd;
+	ARRAY_DIMS(last)[k].inc = ARRAY_DIMS(v)[k].inc;
+      }
+    }
+    ARRAY_BASE(last) = pos;
+    return last;
+  }
+  }
+}
+
+static char s_aset[] = "array-set!";
+SCM aset(v, obj, args)
+     SCM v, obj, args;
+{
+  long pos;
+  ASRTGO(NIMP(v), badarg1);
+  if ARRAYP(v) {
+    pos = aind(v, args, s_aset);
+    v = ARRAY_V(v);
+  }
+  else {
+    if NIMP(args) {
+      ASSERT(CONSP(args) && INUMP(CAR(args)), args, ARG2, s_aset);
+      pos = INUM(CAR(args));
+      ASRTGO(NULLP(CDR(args)), wna);
+    }
+    else {
+      ASSERT(INUMP(args), args, ARG2, s_aset);
+      pos = INUM(args);
+    }
+    ASRTGO(pos >= 0 && pos < LENGTH(v), outrng);
+  }
+  switch TYP7(v) {
+  default: badarg1: wta(v, (char *)ARG1, s_aset);
+  outrng: wta(MAKINUM(pos), (char *)OUTOFRANGE, s_aset);
+  wna: wta(UNDEFINED, (char *)WNA, s_aset);
+  case tc7_smob:		/* enclosed */
+    goto badarg1;
+  case tc7_bvect:
+    if (BOOL_F==obj)
+      VELTS(v)[pos/LONG_BIT] &= ~(1L<<(pos%LONG_BIT));
+    else if (BOOL_T==obj)
+      VELTS(v)[pos/LONG_BIT] |= (1L<<(pos%LONG_BIT));
+    else badarg2: wta(obj, (char *)ARG2, s_aset);
+    break;
+  case tc7_string:
+    ASRTGO(ICHRP(obj), badarg2);
+    CHARS(v)[pos] = ICHR(obj); break;
+# ifdef INUMS_ONLY
+  case tc7_uvect:
+    ASRTGO(INUM(obj) >= 0, badarg2);
+  case tc7_ivect:
+    ASRTGO(INUMP(obj), badarg2); VELTS(v)[pos] = INUM(obj); break;
+# else
+  case tc7_uvect:
+    VELTS(v)[pos] = num2ulong(obj, (char *)ARG2, s_aset); break;
+  case tc7_ivect:
+    VELTS(v)[pos] = num2long(obj, (char *)ARG2, s_aset); break;
+# endif
+# ifdef FLOATS
+#  ifdef SINGLES
+  case tc7_fvect:
+    ((float*)VELTS(v))[pos] = (float)num2dbl(obj, (char *)ARG2, s_aset); break;
+#  endif
+  case tc7_dvect:
+    ((double*)VELTS(v))[pos] = num2dbl(obj, (char *)ARG2, s_aset); break;
+  case tc7_cvect:
+    if (NIMP(obj) && CPLXP(obj)) {
+      ((double *)CDR(v))[2*pos] = REALPART(obj);
+      ((double *)CDR(v))[2*pos+1] = IMAG(obj);
+    }
+    else {
+      ((double *)CDR(v))[2*pos] = num2dbl(obj, (char *)ARG2, s_aset);
+      ((double *)CDR(v))[2*pos+1] = 0.0;
+    }
+    break;
+# endif
+  case tc7_vector:
+    VELTS(v)[pos] = obj; break;
+  }
+  return UNSPECIFIED;
+}
+
+static char s_array_contents[] = "array-contents";
+SCM array_contents(ra, strict)
+     SCM ra, strict;
+{
+  SCM sra;
+  if IMP(ra) return BOOL_F;
+  switch TYP7(ra) {
+  default:
+    return BOOL_F;
+  case tc7_vector: case tc7_string: case tc7_bvect: case tc7_uvect:
+  case tc7_ivect: case tc7_fvect: case tc7_dvect: case tc7_cvect:
+    return ra;
+  case tc7_smob: {
+    sizet k, ndim = ARRAY_NDIM(ra), len = 1;
+    if (!ARRAYP(ra) || !ARRAY_CONTP(ra)) return BOOL_F;
+    for (k = 0; k < ndim; k++)
+      len *= ARRAY_DIMS(ra)[k].ubnd - ARRAY_DIMS(ra)[k].lbnd + 1;
+    if (!UNBNDP(strict)) {
+      if (ndim && (1 != ARRAY_DIMS(ra)[ndim-1].inc)) return BOOL_F;
+      if (tc7_bvect==TYP7(ARRAY_V(ra))) {
+	if (ARRAY_BASE(ra)%LONG_BIT) return BOOL_F;
+	if (len != LENGTH(ARRAY_V(ra)) && len%LONG_BIT) return BOOL_F;
+      }
+    }
+    if ((len==LENGTH(ARRAY_V(ra))) && 0==ARRAY_BASE(ra) && ARRAY_DIMS(ra)->inc)
+      return ARRAY_V(ra);
+    sra = make_ra(1);
+    ARRAY_DIMS(sra)->lbnd = 0;
+    ARRAY_DIMS(sra)->ubnd = len - 1;
+    ARRAY_V(sra) = ARRAY_V(ra);
+    ARRAY_BASE(sra) = ARRAY_BASE(ra);
+    ARRAY_DIMS(sra)->inc = (ndim ? ARRAY_DIMS(ra)[ndim - 1].inc : 1);
+    return sra;
+  }
+  }
+}
+
+static char s_uve_rd[] = "uniform-vector-read!";
+SCM uve_read(v, port)
+     SCM v, port;
+{
+  long sz, len, ans;
+  long start=0;
+  if UNBNDP(port) port = cur_inp;
+  else ASSERT(NIMP(port) && OPINFPORTP(port), port, ARG2, s_uve_rd);
+  ASRTGO(NIMP(v), badarg1);
+  len = LENGTH(v);
+ loop:
+  switch TYP7(v) {
+  default: badarg1: wta(v, (char *)ARG1, s_uve_rd);
+  case tc7_smob:
+    v = array_contents(v, BOOL_T);
+    ASRTGO(NIMP(v), badarg1);
+    if ARRAYP(v) {
+      array_dim *d = ARRAY_DIMS(v);
+      start = ARRAY_BASE(v);
+      len = d->inc * (d->ubnd - d->lbnd + 1);
+      v = ARRAY_V(v);
+    }
+    else
+      len = LENGTH(v);
+    goto loop;
+  case tc7_string:
+    sz = sizeof(char);
+    break;
+  case tc7_bvect:
+    len = (len+LONG_BIT-1)/LONG_BIT;
+    start /= LONG_BIT;
+  case tc7_uvect:
+  case tc7_ivect:
+    sz = sizeof(long);
+    break;
+# ifdef FLOATS
+#  ifdef SINGLES
+  case tc7_fvect:
+    sz = sizeof(float);
+    break;
+#  endif
+  case tc7_dvect:
+    sz = sizeof(double);
+    break;
+  case tc7_cvect:
+    sz = 2*sizeof(double);
+    break;
+# endif
+  }
+  /* An ungetc before an fread will not work on some systems if setbuf(0).
+     do #define NOSETBUF in scmfig.h to fix this. */
+  if CRDYP(port) {	/* UGGH!!! */
+    ungetc(CGETUN(port), STREAM(port));
+    CLRDY(port);		/* Clear ungetted char */
+  }
+  SYSCALL(ans = fread(CHARS(v)+start*sz, (sizet)sz, (sizet)len, STREAM(port)););
+  if (TYP7(v)==tc7_bvect) ans *= LONG_BIT;
+  return MAKINUM(ans);
+}
+
+static char s_uve_wr[] = "uniform-vector-write";
+SCM uve_write(v, port)
+     SCM v, port;
+{
+  long sz, len, ans;
+  long start=0;
+  if UNBNDP(port) port = cur_outp;
+  else ASSERT(NIMP(port) && OPOUTFPORTP(port), port, ARG2, s_uve_wr);
+  ASRTGO(NIMP(v), badarg1);
+  len = LENGTH(v);
+ loop:
+  switch TYP7(v) {
+  default: badarg1: wta(v, (char *)ARG1, s_uve_wr);
+  case tc7_smob:
+    v = array_contents(v, BOOL_T);
+    ASRTGO(NIMP(v), badarg1);
+    if ARRAYP(v) {
+      array_dim *d = ARRAY_DIMS(v);
+      start = ARRAY_BASE(v);
+      len = d->inc * (d->ubnd - d->lbnd + 1);
+      v = ARRAY_V(v);
+    }
+    else
+      len = LENGTH(v);
+    goto loop;
+  case tc7_string:
+    sz = sizeof(char);
+    break;
+  case tc7_bvect:
+    len = (len+LONG_BIT-1)/LONG_BIT;
+    start /= LONG_BIT;
+  case tc7_uvect:
+  case tc7_ivect:
+    sz = sizeof(long);
+    break;
+# ifdef FLOATS
+#  ifdef SINGLES
+  case tc7_fvect:
+    sz = sizeof(float);
+    break;
+#  endif
+  case tc7_dvect:
+    sz = sizeof(double);
+    break;
+  case tc7_cvect:
+    sz = 2*sizeof(double);
+    break;
+# endif
+  }
+  SYSCALL(ans = fwrite(CHARS(v)+start*sz, (sizet)sz, (sizet)len, STREAM(port)););
+  if (TYP7(v)==tc7_bvect) ans *= LONG_BIT;
+  return MAKINUM(ans);
+}
+
+static char cnt_tab[16] = {0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4};
+static char s_count[] = "bit-count";
+SCM lcount(item, seq)
+     SCM item, seq;
+{
+  long i, imin, ubnd, lbnd = 0;
+  int enclosed = 0;
+  register unsigned long cnt = 0, w;
+  ASSERT(NIMP(seq), seq, ARG2, s_count);
+  ubnd = LENGTH(seq) - 1;
+ tail:
+  switch TYP7(seq) {
+  default: badarg2: wta(seq, (char *)ARG2, s_count);
+  case tc7_bvect:
+    if (lbnd>ubnd) return INUM0;
+    i = ubnd/LONG_BIT;
+    imin = lbnd/LONG_BIT;
+    w = VELTS(seq)[i];
+    if FALSEP(item) w = ~w;
+    w <<= LONG_BIT-1-(ubnd%LONG_BIT);
+    w >>= LONG_BIT-1-(ubnd%LONG_BIT);   /* There may be only a partial word. */
+    while (imin < i--) {
+      for(;w;w >>= 4) cnt += cnt_tab[w & 0x0f];
+      w = VELTS(seq)[i];
+      if FALSEP(item) w = ~w;
+    }
+    w >>= (lbnd%LONG_BIT);
+    for(;w;w >>= 4) cnt += cnt_tab[w & 0x0f];
+    return MAKINUM(cnt);
+  case tc7_smob:
+    ASRTGO(ARRAYP(seq) && 1==ARRAY_NDIM(seq) && 0==enclosed++, badarg2);
+    {
+      long n, inc = ARRAY_DIMS(seq)->inc;
+      switch (inc) {
+      default:
+	i = ARRAY_BASE(seq);
+	n = ARRAY_DIMS(seq)->ubnd - ARRAY_DIMS(seq)->lbnd + 1;
+	if (n<=0) return INUM0;
+	seq = ARRAY_V(seq);
+	if FALSEP(item)
+	  for (;n--; i+=inc)
+	    if (!((VELTS(seq)[i/LONG_BIT]) & (1L<<(i%LONG_BIT)))) cnt++;
+	else
+	  for (;n--; i+=inc)
+	    if ((VELTS(seq)[i/LONG_BIT]) & (1L<<(i%LONG_BIT))) cnt++;
+	return MAKINUM(cnt);
+      case 1:
+	lbnd = ARRAY_BASE(seq);
+	ubnd = lbnd + (ARRAY_DIMS(seq)->ubnd - ARRAY_DIMS(seq)->lbnd)*inc;
+	seq = ARRAY_V(seq);
+	goto tail;
+      case -1:
+	ubnd = ARRAY_BASE(seq);
+	lbnd = ubnd + (ARRAY_DIMS(seq)->ubnd - ARRAY_DIMS(seq)->lbnd)*inc;
+	seq = ARRAY_V(seq);
+	goto tail;
+      }
+    }
+  }
+}
+static char s_uve_pos[] = "bit-position";
+SCM position(item, v, k)
+     SCM item, v, k;
+{
+  long i, len, lenw, xbits, pos = INUM(k), offset = 0;
+  int enclosed = 0;
+  register unsigned long w;
+  ASSERT(NIMP(v), v, ARG2, s_uve_pos);
+  ASSERT(INUMP(k), k, ARG3, s_uve_pos);
+  len = LENGTH(v);
+ tail:
+  switch TYP7(v) {
+  default: badarg2: wta(v, (char *)ARG2, s_uve_pos);
+  case tc7_bvect:
+    ASSERT((pos <= len) && (pos >= 0), k, OUTOFRANGE, s_uve_pos);
+    if (pos==len) return BOOL_F;
+    if (0==len) return MAKINUM(-1L);
+    lenw = (len-1)/LONG_BIT; /* watch for part words */
+    i = pos/LONG_BIT;
+    w = VELTS(v)[i];
+    if FALSEP(item) w = ~w;
+    xbits = (pos%LONG_BIT);
+    pos -= xbits;
+    w = ((w >> xbits) << xbits);
+    xbits = LONG_BIT-1-(len-1)%LONG_BIT;
+    while (!0) {
+      if (w && (i==lenw))
+	w = ((w << xbits) >> xbits);
+      if (w) while (w) switch (w & 0x0f)
+	{
+	default: return MAKINUM(pos-offset);
+	case 2: case 6: case 10: case 14: return MAKINUM(pos+1-offset);
+	case 4: case 12: return MAKINUM(pos+2-offset);
+	case 8: return MAKINUM(pos+3-offset);
+	case 0: pos += 4; w >>= 4;
+	}
+      if (++i > lenw) break;
+      pos += LONG_BIT;
+      w = VELTS(v)[i];
+      if FALSEP(item) w = ~w;
+    }
+    return BOOL_F;
+  case tc7_smob: ASRTGO(ARRAYP(v) && 1==ARRAY_NDIM(v) && !enclosed++, badarg2);
+    ASSERT(pos >= ARRAY_DIMS(v)->lbnd, k, OUTOFRANGE, s_uve_pos);
+    if (1==ARRAY_DIMS(v)->inc) {
+      len = ARRAY_DIMS(v)->ubnd - ARRAY_DIMS(v)->lbnd + ARRAY_BASE(v) + 1;
+      offset = ARRAY_BASE(v) - ARRAY_DIMS(v)->lbnd;
+      pos += offset;
+      v = ARRAY_V(v);
+      goto tail;
+    }
+    else {
+      long inc = ARRAY_DIMS(v)->inc;
+      long ubnd = ARRAY_DIMS(v)->ubnd;
+      if (ubnd < ARRAY_DIMS(v)->lbnd) 
+	return MAKINUM(ARRAY_DIMS(v)->lbnd - 1);
+      i = ARRAY_BASE(v) + (pos - ARRAY_DIMS(v)->lbnd)*inc;
+      v = ARRAY_V(v);
+      for (; pos <= ubnd; pos++) {
+	if (item ==
+	    ((VELTS(v)[i/LONG_BIT])&(1L<<(i%LONG_BIT)) ? BOOL_T : BOOL_F))
+	  return MAKINUM(pos);
+	i += inc;
+      }
+    return BOOL_F;
+    }
+  }
+}
+
+static char s_bit_set[] = "bit-set*!";
+SCM bit_set(v, kv, obj)
+     SCM v, kv, obj;
+{
+  register long i, k, vlen;
+  ASRTGO(NIMP(v), badarg1);
+  ASRTGO(NIMP(kv), badarg2);
+  switch TYP7(kv) {
+    default: badarg2: wta(kv, (char *)ARG2, s_bit_set);
+    case tc7_uvect:
+      switch TYP7(v) {
+	default: badarg1: wta(v, (char *)ARG1, s_bit_set);
+	case tc7_bvect:
+	  vlen = LENGTH(v);
+	  if (BOOL_F==obj) for (i = LENGTH(kv);i;) {
+	    k = VELTS(kv)[--i];
+	    ASSERT((k < vlen), MAKINUM(k), OUTOFRANGE, s_bit_set);
+	    VELTS(v)[k/LONG_BIT] &= ~(1L<<(k%LONG_BIT));
+	  }
+	  else if (BOOL_T==obj) for (i = LENGTH(kv); i;) {
+	    k = VELTS(kv)[--i];
+	    ASSERT((k < vlen), MAKINUM(k), OUTOFRANGE, s_bit_set);
+	    VELTS(v)[k/LONG_BIT] |= (1L<<(k%LONG_BIT));
+	  }
+	  else
+	  badarg3: wta(obj, (char *)ARG3, s_bit_set);
+	}
+      break;
+    case tc7_bvect:
+      ASRTGO(TYP7(v)==tc7_bvect && LENGTH(v)==LENGTH(kv), badarg1);
+      if (BOOL_F==obj)
+	for (k = (LENGTH(v)+LONG_BIT-1)/LONG_BIT;k--;)
+	  VELTS(v)[k] &= ~(VELTS(kv)[k]);
+      else if (BOOL_T==obj)
+	for (k = (LENGTH(v)+LONG_BIT-1)/LONG_BIT;k--;)
+	  VELTS(v)[k] |= VELTS(kv)[k];
+      else goto badarg3;
+      break;
+    }
+  return UNSPECIFIED;
+}
+
+static char s_bit_count[] = "bit-count*";
+SCM bit_count(v, kv, obj)
+     SCM v, kv, obj;
+{
+  register long i, vlen, count = 0;
+  register unsigned long k;
+  ASRTGO(NIMP(v), badarg1);
+  ASRTGO(NIMP(kv), badarg2);
+  switch TYP7(kv) {
+    default: badarg2: wta(kv, (char *)ARG2, s_bit_count);
+    case tc7_uvect:
+      switch TYP7(v) {
+	default: badarg1: wta(v, (char *)ARG1, s_bit_count);
+	case tc7_bvect:
+	  vlen = LENGTH(v);
+	  if (BOOL_F==obj) for (i = LENGTH(kv);i;) {
+	    k = VELTS(kv)[--i];
+	    ASSERT((k < vlen), MAKINUM(k), OUTOFRANGE, s_bit_count);
+	    if (!(VELTS(v)[k/LONG_BIT] & (1L<<(k%LONG_BIT)))) count++;
+	  }
+	  else if (BOOL_T==obj) for (i = LENGTH(kv); i;) {
+	    k = VELTS(kv)[--i];
+	    ASSERT((k < vlen), MAKINUM(k), OUTOFRANGE, s_bit_count);
+	    if (VELTS(v)[k/LONG_BIT] & (1L<<(k%LONG_BIT))) count++;
+	  }
+	  else
+	  badarg3: wta(obj, (char *)ARG3, s_bit_count);
+	}
+      break;
+    case tc7_bvect:
+      ASRTGO(TYP7(v)==tc7_bvect && LENGTH(v)==LENGTH(kv), badarg1);
+      if (0==LENGTH(v)) return INUM0;
+      ASRTGO(BOOL_T==obj || BOOL_F==obj, badarg3);
+      obj = (BOOL_T==obj);
+      i = (LENGTH(v)-1)/LONG_BIT;
+      k = VELTS(kv)[i] & (obj ? VELTS(v)[i] : ~VELTS(v)[i]);
+      k <<= LONG_BIT-1-((LENGTH(v)-1)%LONG_BIT);
+      while (!0) {
+	for(;k;k >>= 4) count += cnt_tab[k & 0x0f];
+	if (0==i--) return MAKINUM(count);
+	k = VELTS(kv)[i] & (obj ? VELTS(v)[i] : ~VELTS(v)[i]);
+      }
+    }
+  return MAKINUM(count);
+}
+
+static char s_bit_inv[] = "bit-invert!";
+SCM bit_inv(v)
+     SCM v;
+{
+  register long k;
+  ASRTGO(NIMP(v), badarg1);
+  k = LENGTH(v);
+  switch TYP7(v) {
+  case tc7_bvect:
+    for (k = (k+LONG_BIT-1)/LONG_BIT;k--;)
+      VELTS(v)[k] = ~VELTS(v)[k];
+    break;
+  default: badarg1: wta(v, (char *)ARG1, s_bit_inv);
+  }
+  return UNSPECIFIED;
+}
+
+static char s_strup[] = "string-upcase!";
+SCM strup(v)
+     SCM v;
+{
+  register long k;
+  register unsigned char *cs;
+  ASRTGO(NIMP(v), badarg1);
+  k = LENGTH(v);
+  switch TYP7(v) {
+  case tc7_string:
+    cs = UCHARS(v);
+    while (k--) cs[k] = upcase[cs[k]];
+    break;
+  default: badarg1: wta(v, (char *)ARG1, s_strup);
+  }
+  return v;
+}
+
+static char s_strdown[] = "string-downcase!";
+SCM strdown(v)
+     SCM v;
+{
+  register long k;
+  register unsigned char *cs;
+  ASRTGO(NIMP(v), badarg1);
+  k = LENGTH(v);
+  switch TYP7(v) {
+  case tc7_string:
+    cs = UCHARS(v);
+    while (k--) cs[k] = downcase[cs[k]];
+    break;
+  default: badarg1: wta(v, (char *)ARG1, s_strdown);
+  }
+  return v;
+}
+
+# include <ctype.h>
+static char s_strcap[] = "string-capitalize!";
+SCM strcap(v)
+     SCM v;
+{
+  long i = 0, len;
+  register unsigned char *str;
+  register int non_first_alpha = 0;
+  ASRTGO(NIMP(v), badarg1);
+  len = LENGTH(v);
+  switch TYP7(v) {
+  case tc7_string:
+    for (str = UCHARS(v);i < len; i++) {
+      int c = str[i];
+      if (isascii(c) && isalpha(c))
+	if (non_first_alpha) str[i] = downcase[c];
+	else {
+	  non_first_alpha = !0;
+	  str[i] = upcase[c];
+	}
+      else non_first_alpha = 0;
+    }
+    break;
+  default: badarg1: wta(v, (char *)ARG1, s_strcap);
+  }
+  return v;
+}
+
+SCM istr2bve(str, len)
+     char *str;
+     long len;
+{
+  SCM v = make_uve(len, BOOL_T);
+  long *data = (long *)VELTS(v);
+  register unsigned long mask;
+  register long k;
+  register long j;
+  for (k = 0; k < (len+LONG_BIT-1)/LONG_BIT; k++) {
+    data[k] = 0L;
+    j = len - k*LONG_BIT;
+    if (j > LONG_BIT) j = LONG_BIT;
+    for (mask = 1L; j--; mask <<= 1)
+      switch (*str++) {
+      case '0': break;
+      case '1': data[k] |= mask; break;
+      default:  return BOOL_F;
+      }
+  }
+  return v;
+}
+
+static SCM ra2l(ra, base, k)
+     SCM ra;
+     sizet base;
+     sizet k;
+{
+  register SCM res = EOL;
+  register long inc = ARRAY_DIMS(ra)[k].inc;
+  register sizet i;
+  if (ARRAY_DIMS(ra)[k].ubnd < ARRAY_DIMS(ra)[k].lbnd) return EOL;
+  i = base + (1 + ARRAY_DIMS(ra)[k].ubnd - ARRAY_DIMS(ra)[k].lbnd)*inc;
+  if (k < ARRAY_NDIM(ra) - 1) {
+    do {
+      i -= inc;
+      res = cons(ra2l(ra, i, k+1), res);
+    } while (i != base);
+  }
+  else
+    do {
+      i -= inc;
+      res = cons(cvref(ARRAY_V(ra), i, UNDEFINED), res);
+    } while (i != base);
+  return res;
+}
+
+static char s_array2list[] = "array->list";
+SCM array2list(v)
+     SCM v;
+{
+  SCM res = EOL;
+  register long k;
+  ASRTGO(NIMP(v), badarg1);
+  switch TYP7(v) {
+  default: badarg1: wta(v, (char *)ARG1, s_array2list);
+  case tc7_smob: ASRTGO(ARRAYP(v), badarg1);
+    return ra2l(v, ARRAY_BASE(v), 0);
+  case tc7_vector: return vector2list(v);
+  case tc7_string: return string2list(v);
+  case tc7_bvect: {
+    long *data = (long *)VELTS(v);
+    register unsigned long mask;
+    for (k = (LENGTH(v)-1)/LONG_BIT; k > 0; k--)
+      for (mask = 1L<<(LONG_BIT-1); mask; mask >>=1)
+	res = cons(((long *)data)[k] & mask ? BOOL_T : BOOL_F, res);
+    for (mask = 1L<<((LENGTH(v)%LONG_BIT)-1); mask; mask >>=1)
+      res = cons(((long *)data)[k] & mask ? BOOL_T : BOOL_F, res);
+    return res;
+  }
+# ifdef INUMS_ONLY
+  case tc7_uvect:
+  case tc7_ivect: {
+    long *data = (long *)VELTS(v);
+    for (k = LENGTH(v) - 1; k >= 0; k--)
+      res = cons(MAKINUM(data[k]), res);
+    return res;
+  }
+# else
+  case tc7_uvect: {
+    long *data = (long *)VELTS(v);
+    for (k = LENGTH(v) - 1; k >= 0; k--)
+      res = cons(ulong2num(data[k]), res);
+    return res;
+  }
+  case tc7_ivect: {
+    long *data = (long *)VELTS(v);
+    for (k = LENGTH(v) - 1; k >= 0; k--)
+      res = cons(long2num(data[k]), res);
+    return res;
+  }
+# endif
+# ifdef FLOATS
+#  ifdef SINGLES
+  case tc7_fvect: {
+    float *data = (float *)VELTS(v);
+    for (k = LENGTH(v) - 1; k >= 0; k--)
+      res = cons(makflo(data[k]), res);
+    return res;
+  }
+#  endif /*SINGLES*/
+  case tc7_dvect: {
+    double *data = (double *)VELTS(v);
+    for (k = LENGTH(v) - 1; k >= 0; k--)
+      res = cons(makdbl(data[k], 0.0), res);
+    return res;
+  }
+  case tc7_cvect: {
+    double (*data)[2] = (double (*)[2])VELTS(v);
+    for (k = LENGTH(v) - 1; k >= 0; k--)
+      res = cons(makdbl(data[k][0], data[k][1]), res);
+    return res;
+  }
+# endif /*FLOATS*/
+  }
+}
+
+static int l2ra P((SCM lst, SCM ra, sizet base, sizet k));
+static char s_bad_ralst[] = "Bad array contents list";
+static char s_list2ura[] = "list->uniform-array";
+SCM list2ura(ndim, prot, lst)
+     SCM ndim;
+     SCM prot;
+     SCM lst;
+{
+  SCM shp=EOL;
+  SCM row=lst;
+  SCM ra;
+  sizet k;
+  long n;
+  ASSERT(INUMP(ndim), ndim, ARG1, s_list2ura);
+  k = INUM(ndim);
+  for (; k--; NIMP(row) && (row = CAR(row))) {
+    n = ilength(row);
+    ASSERT(n>=0, lst, ARG2, s_list2ura);
+    shp = cons(MAKINUM(n), shp);
+  }
+  ra = dims2ura(reverse(shp), prot, EOL);
+  if NULLP(shp) {
+    ASRTGO(1==ilength(lst), badlst);
+    aset(ra, CAR(lst), EOL);
+    return ra;
+  }
+  if (!ARRAYP(ra)) {
+    for (k = 0; k < LENGTH(ra); k++, lst = CDR(lst))
+      aset(ra, CAR(lst), MAKINUM(k));
+    return ra;
+  }
+  if (l2ra(lst, ra, ARRAY_BASE(ra), 0))
+    return ra;
+  else
+  badlst: wta(lst, s_bad_ralst, s_list2ura);
+  return BOOL_F;
+}
+
+static int l2ra(lst, ra, base, k)
+     SCM lst;
+     SCM ra;
+     sizet base;
+     sizet k;
+{
+  register long inc = ARRAY_DIMS(ra)[k].inc;
+  register long n = (1 + ARRAY_DIMS(ra)[k].ubnd - ARRAY_DIMS(ra)[k].lbnd);
+  int ok = 1;
+  if (n <= 0) return (EOL==lst);
+  if (k < ARRAY_NDIM(ra) - 1) {
+    while (n--) {
+      if (IMP(lst) || NCONSP(lst)) return 0;
+      ok = ok && l2ra(CAR(lst), ra, base, k+1);
+      base += inc;
+      lst = CDR(lst);
+    }
+    if NNULLP(lst) return 0;
+  }
+  else {
+    while (n--) {
+      if (IMP(lst) || NCONSP(lst)) return 0;
+      ok = ok && aset(ARRAY_V(ra), CAR(lst), MAKINUM(base));
+      base += inc;
+      lst = CDR(lst);
+    }
+    if NNULLP(lst) return 0;
+  }
+  return ok;
+}
+
+static void rapr1(ra, j, k, port, writing)
+     SCM ra;
+     sizet j;
+     sizet k;
+     SCM port;
+     int writing;
+{
+  long inc = 1;
+  long n = LENGTH(ra);
+  int enclosed = 0;
+ tail:
+   switch TYP7(ra) {
+   case tc7_smob:
+     if (enclosed++) {
+       ARRAY_BASE(ra) = j;
+       if (n-- > 0) iprin1(ra, port, writing);
+       for (j += inc; n-- > 0; j += inc) {
+	 lputc(' ', port);
+	 ARRAY_BASE(ra) = j;
+	 iprin1(ra, port, writing);
+       }
+       break;
+     }
+     if (k+1 < ARRAY_NDIM(ra)) {
+       long i;
+       inc = ARRAY_DIMS(ra)[k].inc;
+       for (i = ARRAY_DIMS(ra)[k].lbnd; i < ARRAY_DIMS(ra)[k].ubnd; i++) {
+	 lputc('(', port);
+	 rapr1(ra, j, k+1, port, writing);
+	 lputs(") ", port);
+	 j += inc;
+       }
+       if (i==ARRAY_DIMS(ra)[k].ubnd) { /* could be zero size. */
+	 lputc('(', port);
+	 rapr1(ra, j, k+1, port, writing);
+	 lputc(')', port);
+       }
+       break;
+     }
+     if ARRAY_NDIM(ra) {	/* Could be zero-dimensional */
+       inc = ARRAY_DIMS(ra)[k].inc;
+       n = (ARRAY_DIMS(ra)[k].ubnd - ARRAY_DIMS(ra)[k].lbnd + 1);
+     }
+     else
+       n = 1;
+     ra = ARRAY_V(ra);
+     goto tail;
+   default:
+     if (n-- > 0) iprin1(cvref(ra, j, UNDEFINED), port, writing);
+     for (j += inc; n-- > 0; j += inc) {
+       lputc(' ', port);
+       iprin1(cvref(ra, j, UNDEFINED), port, writing);
+     }
+     break;
+   case tc7_string:
+     if (n-- > 0) iprin1(MAKICHR(CHARS(ra)[j]), port, writing);
+     if (writing)
+       for (j += inc; n-- > 0; j += inc) {
+	 lputc(' ', port);
+	 iprin1(MAKICHR(CHARS(ra)[j]), port, writing);
+       }
+     else
+       for (j += inc; n-- > 0; j += inc)
+	 lputc(CHARS(ra)[j], port);
+     break;
+   case tc7_uvect:
+     if (n-- > 0) iprin1(ulong2num(VELTS(ra)[j]), port, writing);
+     for (j += inc; n-- > 0; j += inc) {
+       lputc(' ', port);
+       iprin1(ulong2num(VELTS(ra)[j]), port, writing);
+     }
+     break;
+   case tc7_ivect:
+     if (n-- > 0) intprint(VELTS(ra)[j], 10, port);
+     for (j += inc; n-- > 0; j += inc) {
+       lputc(' ', port);
+       intprint(VELTS(ra)[j], 10, port);
+     }
+     break;
+# ifdef FLOATS
+#  ifdef SINGLES
+   case tc7_fvect:
+#  endif /*SINGLES*/
+   case tc7_dvect:
+   case tc7_cvect:
+     if (n-- > 0) {
+       SCM z = cvref(ra, j, UNDEFINED);
+       floprint(z, port, writing);
+       for (j += inc; n-- > 0; j += inc) {
+	 lputc(' ', port);
+	 z = cvref(ra, j, z);
+	 floprint(z, port, writing);
+       }
+     }
+     break;
+# endif /*FLOATS*/
+   }
+}
+int raprin1(exp, port, writing)
+     SCM exp;
+     SCM port;
+     int writing;
+{
+  SCM v = exp;
+  sizet base = 0;
+  lputc('#', port);
+ tail:
+  switch TYP7(v) {
+  case tc7_smob: {
+    long ndim = ARRAY_NDIM(v);
+    base = ARRAY_BASE(v);
+    v = ARRAY_V(v);
+    if ARRAYP(v) {
+      lputs("<enclosed-array ", port);
+      rapr1(exp, base, 0, port, writing);
+      lputc('>', port);
+      return 1;
+    }
+    else {
+      intprint(ndim, 10, port);
+      goto tail;
+    }
+  }
+  case tc7_bvect:
+    if (exp==v) {		/* a uve, not an array */
+      register long i, j, w;
+      lputc('*', port);
+      for(i = 0;i<(LENGTH(exp))/LONG_BIT;i++) {
+	w = VELTS(exp)[i];
+	for(j = LONG_BIT;j;j--) {
+	  lputc(w&1?'1':'0', port);
+	  w >>= 1;
+	}
+      }
+      j = LENGTH(exp)%LONG_BIT;
+      if (j) {
+	w = VELTS(exp)[LENGTH(exp)/LONG_BIT];
+	for(;j;j--) {
+	  lputc(w&1?'1':'0', port);
+	  w >>= 1;
+	}
+      }
+      return 1;
+    }
+    else
+      lputc('b', port); break;
+  case tc7_string:
+    lputc('a', port); break;
+  case tc7_uvect:
+    lputc('u', port); break;
+  case tc7_ivect:
+    lputc('e', port); break;
+# ifdef FLOATS
+#  ifdef SINGLES
+  case tc7_fvect:
+    lputc('s', port); break;
+#  endif /*SINGLES*/
+  case tc7_dvect:
+    lputc('i', port); break;
+  case tc7_cvect:
+    lputc('c', port); break;
+# endif /*FLOATS*/
+  }
+  lputc('(', port);
+  rapr1(exp, base, 0, port, writing);
+  lputc(')', port);
+  return 1;
+}
+
+static char s_array_prot[] = "array-prototype";
+SCM array_prot(ra)
+     SCM ra;
+{
+  int enclosed = 0;
+  ASRTGO(NIMP(ra), badarg);
+ loop:
+  switch TYP7(ra) {
+  default: badarg: wta(ra, (char *)ARG1, s_array_prot);
+  case tc7_smob: ASRTGO(ARRAYP(ra), badarg);
+    if (enclosed++) return UNSPECIFIED;
+    ra = ARRAY_V(ra);
+    goto loop;
+  case tc7_vector: return EOL;
+  case tc7_bvect: return BOOL_T;
+  case tc7_string: return MAKICHR('a');
+  case tc7_uvect: return MAKINUM(1L);
+  case tc7_ivect: return MAKINUM(-1L);
+# ifdef FLOATS
+#  ifdef SINGLES
+  case tc7_fvect: return makflo(1.0);
+#  endif
+  case tc7_dvect: return makdbl(1.0/3.0, 0.0);
+  case tc7_cvect: return makdbl(0.0, 1.0);
+# endif
+  }
+}
+
+static iproc subr3s[] = {
+	{"uniform-vector-set1!", aset},
+	{s_uve_pos, position},
+	{s_bit_set, bit_set},
+	{s_bit_count, bit_count},
+	{s_list2ura, list2ura},
+	{0, 0}};
+
+static iproc subr2s[] = {
+	{"uniform-vector-ref", aref},
+	{s_resizuve, resizuve},
+	{s_count, lcount},
+	{s_uve_fill, uve_fill},
+	{0, 0}};
+
+static iproc subr1s[] = {
+	{"array-rank", array_rank},
+	{s_array_dims, array_dims},
+	{s_array2list, array2list},
+	{s_uve_len, uve_len},
+	{s_bit_inv, bit_inv},
+	{s_strdown, strdown},
+	{s_strcap, strcap},
+	{s_strup, strup},
+	{s_array_prot, array_prot},
+	{0, 0}};
+
+static iproc lsubrs[] = {
+  {s_aref, scm_array_ref},
+  {s_trans_array, trans_array},
+  {s_encl_array, encl_array},
+  {s_array_inbp, array_inbp},
+  {0, 0}};
+
+static iproc lsubr2s[] = {
+  {s_make_sh_array, make_sh_array},
+  {s_dims2ura, dims2ura},
+  {s_aset, aset},
+  {0, 0}};
+
+static iproc subr2os[] = {
+  {"array?", arrayp},
+  {s_array_contents, array_contents},
+  {s_uve_rd, uve_read},
+  {s_uve_wr, uve_write},
+  {0, 0}};
+
+static SCM markra(ptr)
+     SCM ptr;
+{
+  if GC8MARKP(ptr) return BOOL_F;
+  SETGC8MARK(ptr);
+  return ARRAY_V(ptr);
+}
+static sizet freera(ptr)
+     CELLPTR ptr;
+{
+  must_free(CHARS(ptr));
+  return sizeof(array) + ARRAY_NDIM(ptr)*sizeof(array_dim);
+}
+static smobfuns rasmob = {markra, freera, raprin1, 0};
+				/* 0 replaced by raequal in init_ramap() */
+
+/* This must be done after init_scl() */
+void init_unif()
+{
+  init_iprocs(subr3s, tc7_subr_3);
+  init_iprocs(subr2s, tc7_subr_2);
+  init_iprocs(subr1s, tc7_subr_1);
+  init_iprocs(lsubrs, tc7_lsubr);
+  init_iprocs(lsubr2s, tc7_lsubr_2);
+  init_iprocs(subr2os, tc7_subr_2o);
+  tc16_array = newsmob(&rasmob);
+  add_feature(s_array);
+  add_feature("string-case");
+}
+
+#else /* ARRAYS */
+
+int raprin1(exp, port, writing)
+     SCM exp;
+     SCM port;
+     int writing;
+{
+  return 0;
+}
+
+SCM istr2bve(str, len)
+     char *str;
+     long len;
+{
+  return BOOL_F;
+}
+
+SCM array_equal(ra0, ra1)
+     SCM ra0, ra1;
+{
+  return BOOL_F;
+}
+
+void init_unif()
+{
+  make_subr(s_resizuve, tc7_subr_2, resizuve);
+}
+
+#endif /* ARRAYS */
diff --git a/unix.c b/unix.c
new file mode 100644
index 0000000..4437189
--- /dev/null
+++ b/unix.c
@@ -0,0 +1,151 @@
+/* Copyright (C) 1994, 1995 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  
+ */
+
+/* "unix.c" functions only in Unix (unix).
+   Author: Aubrey Jaffer */
+
+#include "scm.h"
+
+#include <pwd.h>
+#include <sys/types.h>
+/* #include <sys/wait.h> */
+#include <sys/stat.h>
+
+SCM	stat2scm P((struct stat *stat_temp));
+
+#ifndef STDC_HEADERS
+	void sync P((void));
+	int symlink P((const char *oldpath, const char *newpath));
+	int readlink P((const char *path, char *buf, sizet bufsiz));
+	int acct P((const char *filename));
+	int nice P((int inc));
+#endif /* STDC_HEADERS */
+
+   /* Only the superuser can successfully execute mknod and acct */
+/* int mknod P((const char *path, mode_t mode, dev_t dev));
+   should be in stat.h */
+static char s_mknod[] = "mknod";
+SCM l_mknod(path, mode, dev)
+     SCM path, mode, dev;
+{
+  int val;
+  ASSERT(NIMP(path) && STRINGP(path), path, ARG1, s_mknod);
+  ASSERT(INUMP(mode), mode, ARG2, s_mknod);
+  ASSERT(INUMP(dev), dev, ARG3, s_mknod);
+  SYSCALL(val = mknod(CHARS(path), INUM(mode), INUM(dev)););
+  return val ? BOOL_F : BOOL_T;
+}
+static char s_acct[] = "acct";
+SCM l_acct(path)
+     SCM path;
+{
+  int val;
+  if FALSEP(path) {
+    SYSCALL(val = acct(0););
+    return val ? BOOL_F : BOOL_T;
+  }
+  ASSERT(NIMP(path) && STRINGP(path), path, ARG1, s_acct);
+  SYSCALL(val = acct(CHARS(path)););
+  return val ? BOOL_F : BOOL_T;
+}
+
+static char s_nice[] = "nice";
+SCM l_nice(incr)
+     SCM incr;
+{
+  ASSERT(INUMP(incr), incr, ARG1, s_nice);
+  return nice(INUM(incr)) ? BOOL_F : BOOL_T;
+}
+
+SCM l_sync()
+{
+  sync();
+  return UNSPECIFIED;
+}
+
+static char s_symlink[] = "symlink";
+SCM l_symlink(oldpath, newpath)
+     SCM oldpath, newpath;
+{
+  int val;
+  ASSERT(NIMP(oldpath) && STRINGP(oldpath), oldpath, ARG1, s_symlink);
+  ASSERT(NIMP(newpath) && STRINGP(newpath), newpath, ARG2, s_symlink);
+  SYSCALL(val = symlink(CHARS(oldpath), CHARS(newpath)););
+  return val ? BOOL_F : BOOL_T;
+}
+static char s_readlink[] = "readlink";
+SCM l_readlink(path)
+  SCM path;
+{
+  int i;
+  char buf[1024];
+  ASSERT(NIMP(path) && STRINGP(path), path, ARG1, s_readlink);
+  SYSCALL(i = readlink(CHARS(path), buf, (sizet)sizeof(buf)););
+  if (-1==i) return BOOL_F;
+  return makfromstr(buf, (sizet)i);
+}
+static char s_lstat[] = "lstat";
+SCM l_lstat(str)
+  SCM str;
+{
+  int i;
+  struct stat stat_temp;
+  ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_lstat);
+  SYSCALL(i = lstat(CHARS(str), &stat_temp););
+  if (i) return BOOL_F;
+  return stat2scm(&stat_temp);
+}
+
+static iproc subr1s[] = {
+	{s_nice, l_nice},
+	{s_acct, l_acct},
+	{s_lstat, l_lstat},
+	{s_readlink, l_readlink},
+	{0, 0}};
+
+void init_unix()
+{
+	make_subr("sync", tc7_subr_0, l_sync);
+	init_iprocs(subr1s, tc7_subr_1);
+	make_subr(s_symlink, tc7_subr_2, l_symlink);
+	make_subr(s_mknod, tc7_subr_3, l_mknod);
+	add_feature("unix");
+}