maintainer changed: was lord, now jimb; first import

135 files changed, 45331 insertions, 0 deletions

diff --git a/libguile/COPYING b/libguile/COPYING
new file mode 100644
index 000000000..9648fb9ea
--- /dev/null
+++ b/libguile/COPYING
@@ -0,0 +1,339 @@
+		    GNU GENERAL PUBLIC LICENSE
+		       Version 2, June 1991
+
+ Copyright (C) 1989, 1991, 1992, 1993 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/libguile/ChangeLog b/libguile/ChangeLog
new file mode 100644
index 000000000..1726e3cb5
--- /dev/null
+++ b/libguile/ChangeLog
@@ -0,0 +1,521 @@
+Wed Jun 12 00:28:31 1996  Tom Lord  <lord@beehive>
+
+	* struct.c (scm_init_struct): new file.
+
+Fri Jun  7 14:02:00 1996  Tom Lord  <lord@beehive>
+
+	* list.c (scm_list_tail): list-cdr-ref is the same as list-tail.
+	(scm_list_head): added list-head for rapidly chopping argument
+	lists off of longer lists (and similar).
+
+Tue Jun  4 09:40:33 1996  Tom Lord  <lord@beehive>
+
+	* objprop.c (scm_object_property): assq the cdr of the whash
+	handle for obj, not the handle itself.
+
+Mon Jun  3 17:19:30 1996  Tom Lord  <lord@beehive>
+
+	* gc.c (scm_mark_weak_vector_spines): Mark the spines (alists) of
+	weak hash tables last of all marking to avoid an obscure gc bug.
+	WARNING: circular lists stored in a weak hash table will hose us.
+
+Fri May 24 09:53:39 1996  Tom Lord  <lord@beehive>
+
+	* vectors.c (scm_vector_move_left_x, scm_vector_move_right_x):
+	new functions similar to scm_substring_move_left_x and
+	scm_substring_move_right_x.
+
+Wed May 22 20:07:01 1996  Tom Lord  <lord@beehive>
+
+	* init.c (scm_boot_guile): prevent gc with scm_block_gc not
+	scm_gc_heap_lock!
+
+Wed May 15 16:13:29 1996  Tom Lord  <lord@beehive>
+
+	* ports.c (scm_unread_char): scm_gen_ungetc as a scheme procedure.
+
+Thu May  9 09:33:17 1996  Tom Lord  <lord@beehive>
+
+	* strports.c (scm_strprint_obj): convenience function.  C for
+	(lambda (obj) (call-with-output-string (lambda (p) (write obj p))))
+
+	* guile-{tcl,tk}.[ch], events.[ch], keysyms.[ch], tcl-channels.[ch]
+		removed to a separate library
+
+	* init.c (scm_boot_guile): copied from guile-tcl.c.
+	Initialization specific to tcl interpreters removed.
+
+Wed May  8 15:07:37 1996  Tom Lord  <lord@beehive>
+
+	* ports.c (scm_ports_prehistory): size malloced here doesn't
+	matter so long as it is non-0 (got rid of "* 4").
+
+Tue May  7 11:43:37 1996  Tom Lord  <lord@beehive>
+
+	* gscm.h: gscm_mkarray eliminated (presumably was not being used
+	since its definition was bogus).
+
+Mon May  6 13:02:56 1996  Tom Lord  <lord@beehive>
+
+	* mallocs.[ch]: back again (for rx at least).
+
+Wed Apr 17 08:54:20 1996  Tom Lord  <lord@beehive>
+
+	* ports.c: removed functions relating to the mapping between ports
+        and descriptors.   (That stuff is unix-specific and should be collected
+	in a separate library).
+
+	* ramap.c (scm_array_copy): return #<unspecified> not #<undefined>.
+	(Tom Mckay@avanticorp.com)
+
+Mon Apr 15 14:16:55 1996  Tom Lord  <lord@beehive>
+
+	* gc.c (scm_gc_sweep): Immediates in weak vectors were not
+	handled correctly (SCM_FREEP was applied to them) -- test for
+	NIMP.  Keys in weak hash tables were spuriously (though harmlessly)
+	being overwritten with #f.   (brown@grettir.bibliotech.com)
+
+Tue Apr  2 22:25:00 1996  Tom Lord  <lord@beehive>
+
+	* gc.c (scm_unhash_name): new procedure, unhash-name, flushes glocs
+	for a specific symbol or for all symbols.
+
+Mon Apr  1 10:34:55 1996  Tom Lord  <lord@beehive>
+
+	* gc.c (scm_gc_mark): mark weak hash tables correctly (was getting weak
+	keys and weak values confused).
+
+Thu Mar 14 22:20:20 1996  Tom Lord  <lord@beehive>
+
+	* list.c (scm_last_pair): map '()=>'()
+
+Wed Mar 13 16:43:34 1996  Tom Lord  <lord@beehive>
+
+	* pairs.c, hashtab.c, list.c, alist.c append.c, sequences.c:
+	Generalized assoc and hash-table functions.
+	Factored pairs.c into multiple files.
+
+Fri Mar  8 14:44:39 1996  Tom Lord  <lord@beehive>
+
+	* gscm.c (gscm_run_scm): got rid of objprop.
+
+Fri Mar  1 10:39:52 1996  Tom Lord  <lord@beehive>
+
+	* genio.c (scm_getc): 
+	NOTE: fgetc may not be interruptable.
+
+	* procprop.c (scm_stand_in_scm_proc): 
+	NOTE: don't use a alist here.
+	(scm_set_procedure_properties_x): fix type checking throughout this file.
+
+	* gc.c (scm_gc_sweep): free heap segments with free, not must_free.
+
+	* ports.c (scm_remove_from_port_table): adjust scm_mallocated
+	after freeing part of the port table.
+
+Thu Feb 29 16:21:17 1996  Tom Lord  <lord@beehive>
+
+	* strports.c (scm_mkstrport): 
+	* vports.c (scm_make_soft_port): allocate a port table entry 
+	(possibly triggering gc) before setting the tag of the corresponding
+	ports handle.
+
+	* pairs.c (scm_delq_x): never throw an error.
+
+	* vectors.c (scm_make_vector): made the default vector fill argument
+	into '() (much more useful than the previous value, "#unspecified")
+
+Mon Feb 26 17:19:09 1996  Tom Lord  <lord@beehive>
+
+	* ports.c (scm_add_to_port_table): Added fields
+	to port table entries: file_name, line_num, col.
+	Update these in open_file, gen_getc and gen_ungetc.
+	Added procedures to access those fields.
+
+Sun Feb 25 00:10:36 1996  Tom Lord  <lord@beehive>
+
+	* procs.c (scm_make_subr_opt): new entry point for making
+	anonymous subrs.
+
+Sat Feb 24 17:11:31 1996  Tom Lord  <lord@beehive>
+
+	* gc.h: SCM_STACK_GROWS_UP is now set by autoconf.
+
+Fri Feb 23 10:26:29 1996  Tom Lord  <lord@beehive>
+
+	* numbers.c (scm_exact_p): This function no longer
+	implements "integer?".
+
+Thu Feb 22 20:56:16 1996  Tom Lord  <lord@beehive>
+
+	* gc.c (scm_gc_end): simulate a signal at the end of each GC.
+	(scm_gc_stats): return an assoc of useful data.  Replaces "room"
+	and the stats reporting formerlly built into repl.
+
+	* repl.[ch]: removed.  
+	GC statistics keeping moved to gc.c.
+	Other statistics keeping can be done from Scheme.
+	REPLS are now written in Scheme.
+
+Wed Feb 21 10:28:53 1996  Tom Lord  <lord@beehive>
+
+	* cnsvobj.c (gscm_is_gscm_obj): new file for old functions (icky
+	conservatively marked objects).
+
+	* throw.c (scm_ithrow): Unwind up to the right catch during a throw!
+
+	* error.c (scm_init_error): init system_error_sym here, not in repl.c.
+
+	* feature.c (scm_compiled_library_path): moved here from repl.c.
+	This file is for stuff relating specifically to Scheme libraries
+	like slib.
+
+	* eval.c (scm_m_define): don't give warning about redefinition, don't
+	check verbosity.  
+
+	NOTE: this should throw a resumable exception with parameters --
+	the name, the top-level env, the variable, the definition, #t/#f: redefining builtin?
+
+	* repl.c (scm_gc_begin/end): don't print a message, don't check verbosity.
+
+	* error.c: scm_warn eliminated.
+
+	* read.c (scm_lreadr): extra right paren gets an error, not a warning.
+
+	* repl.c, marksweep.c, gc.c (various): 
+	lose exit_report, growth_mon.
+
+	* gscm.c: got rid of verbosity functions.
+
+Tue Feb 20 00:19:10 1996  Tom Lord  <lord@beehive>
+
+	* throw.c (scm_ithrow): guard against the bad-throw hook changing
+	between the call to procedurep and use.
+
+	* error.c (scm_everr): 
+	* gc.c (fixconfig): 
+	* gsubr.c (scm_make_gsubr): use exit, not scm_quit.  still wrong, 
+	but less so.
+
+	* strports.c: don't reveal the port's string to the caller
+	because it changes size.
+
+	(stputc stwrite): check/change the strings length with interrupts
+	blocked.
+
+	* objprop.c (scm_set_object_property_x &c): use the generic
+	hashing functions and be threadsafe.
+
+	* eval.c (scm_unmemocar): do this operation in a thread-safe way.
+	(per suggestion jaffer@gnu.ai.mit.edu).
+
+	* mbstrings.c (scm_multi_byte_string): guard against argument list
+	changing length.
+
+	* strings.c (scm_make_string): loop cleanup
+
+	* unif.c (scm_vector_set_length_x): scm_vector_set_length_x no longer
+	a scheme function.
+
+	* weaks.c (scm_weak_vector): guard against argument list 
+	changing length.
+
+	* variable.c (scm_builtin_variable): check for/make a built-in
+	variable automicly.
+
+	* vectors.c (scm_vector): while filling the new array,
+	guard against a list of fill elements that grows after
+	the vector is allocated.
+
+	* hashtab.c -- new file: general hash table
+	functions.  hash, hashq, hashv, hashx.
+
+	* tags.h: made wvect an option bit of vector.
+
+Mon Feb 19 09:38:05 1996  Tom Lord  <lord@beehive>
+
+	* symbols.c: made the basic symbol table operations atomic.
+
+	* root.c &c.: collected stack-specific global state.
+	linum/colnum etc *should* be port-specific state.
+
+	* struct.c (scm_init_struct): init the first struct type during
+	initialization to fix a race condition.
+
+	* continuations.c (scm_dynthrow): pass throwval in the 'regs'
+	object, not in a global.
+	(suggested by green@cygnus, jaffer@gnu.ai.mit.edu)
+
+	* throw.c (_scm_throw): Pass throwval on the stack, not in a global
+	(suggested by green@cygnus, jaffer@gnu.ai.mit.edu)
+
+	* *.[ch]: namespace cleanup.  Changed all (nearly) exported CPP
+	and C symbols to begin with SCM_ or scm_.
+
+Sun Feb 18 15:55:38 1996  Tom Lord  <lord@beehive>
+
+	* gsubr.c (scm_gsubr_apply): statically allocate the
+	array of arguments (bothner@cygnus.com).
+
+Sat Feb 17 20:20:40 1996  Tom Lord  <lord@beehive>
+
+	* scmsigs.c: Simplified to use async rountines.
+
+	* async.c: New support for interrupt handlers.
+
+Thu Feb 15 11:39:09 1996  Tom Lord  <lord@beehive>
+
+	* symbols.c (scm_string_to_symbol et al.): number of tweaky changes to 
+	set the multi_byte flag correctly in symbols.  This is wrong.
+	intern_obbary_soft and msymbolize should take an extra parameter.
+	Also, weird multibyte symbols don't print correctly.
+	The weird symbol syntax is also a bit bogus (emacs doesn't quite
+	cope).
+
+Tue Feb 13 11:39:37 1996  Tom Lord  <lord@beehive>
+
+	* symbols.c (scm_string_to_obarray_symbol): obarray == #f means
+	use the system symhash.   == #t means create an uninterned symbol.
+
+Wed Feb  7 09:28:02 1996  Tom Lord  <lord@beehive>
+
+	* strings.c (scm_make_shared_substring): build'em.
+	It might better to keep a table of these and use one
+	less cons-pair per shared-substring.
+
+Tue Feb  6 17:45:21 1996  Tom Lord  <lord@beehive>
+
+	* strings.c (scm_string_shared_substring): create shared 
+	substrings.  (Doesn't handle mb strings yet).
+
+	* mbstrings.c (scm_print_mb_string): handle RO strings.
+
+	* print.c (scm_iprin1): print substrings as their non-substring
+        counterparts (dubious).
+
+	* marksweep.c (scm_gc_mark scm_gc_sweep): handle RO and MB
+        strings.
+
+	* hash.c (scm_hasher): hash RO and MB strings as bytestrings.
+
+	* eval.c (SCM_CEVAL): self-evaluate RO and MB strings.
+
+	* eq.c (scm_equal_p): handle RO and MB strings.
+
+	* symbols.c (scm_string_to_symbol): 
+	(scm_string_to_obarray_symbol): 
+	* strop.c (scm_i_index): 
+	(scm_i_rindex): 
+	(scm_string_null_p): 
+	(scm_string_to_list): 
+	* strings.c (scm_string_length): 
+	(scm_string_ref): 
+	(scm_substring): 
+	(scm_string_append): 
+	* simpos.c (scm_system): 
+	(scm_getenv): 
+	* fports.c (scm_open_file): 
+	* strorder.c (scm_string_equal_p): 
+	(scm_string_ci_equal_p): 
+	(scm_string_less_p): 
+	(scm_string_ci_less_p): 
+	* pairs.c (scm_obj_length): 
+	* mbstrings.c (scm_multi_byte_string_length): 
+
+	Use RO string macros for RO strings.
+
+Tue Jan 30 09:19:08 1996  Tom Lord  <lord@beehive>
+
+	* Makefile.in (CFLAGS ALL_CFLAGS): be more standard.
+
+	* strop.c (scm_i_rindex, scm_i_index): Don't use the BSD functions
+	index/rindex.   Do handle embedded \000 characters.
+
+Sun Jan 28 13:16:18 1996  Tom Lord  <lord@beehive>
+
+	* error.c (def_err_response): (int)scm_err_pos => (long)scm_err_pos
+	Eliminate a (presumed) warning on some systems.
+
+	* gscm.c (gscm_run_scm): SCM_INIT_PATH => GUILE_INIT_PATH
+	(Mikael Djurfeldt <mdj@nada.kth.se>)
+
+Sat Jan 27 12:36:55 1996  Tom Lord  <lord@beehive>
+
+	* eval.c (scm_map): added argument type checking.
+	(kawai@sail.t.u-tokyo.ac.jp)
+
+	* gscm.c (gscm_set_procedure_properties_x): parameter "new" => "new_val"
+	for C++. (Seth Alves <alves@gryphon.com>)
+
+	(gscm_cstr):  uses an uninitialized local variable causing
+	segv. (kawai@sail.t.u-tokyo.ac.jp)
+
+
+	* lvectors.c (scm_get_lvector_hook): 
+	In guile-ii, the lvector code was broken.  It was fixed in guile-iii.
+	It seems to me like if it is broken again in guile-iv...Here is a patch.
+	"!       || (LENGTH (keyvec) == 0))"
+	(From: Mikael Djurfeldt <mdj@nada.kth.se>)
+
+
+	* gscm.c (gscm_sys_default_verbosity): 
+	incorrectly declared for non-__STDC__
+	(Tom_Mckay@avanticorp.com)
+
+	* ports.c (scm_setfileno): Tweak the macro a bit
+	to make it easier to port to systems that use
+	more than a single structure field to hold a descriptor.
+
+	* debug.c (change_mode): Avoid GNUCism "int foo[n];"
+	Give a warning, not an error, for unrecognized modes.
+
+	* eval.c (SCM_CEVAL): 
+		static char scm_s_for_each[]; 
+		static char scm_s_map[];
+	not needed.
+
+	* strings.c (scm_string_p): 
+               static char s_string[];  
+       (see next entry)
+
+	* struct.c (scm_sys_struct_set_x): 
+               static char s_sys_make_struct[];
+               static char s_sys_struct_ref[];
+               static char s_sys_struct_set_x[];
+	Rearrange code to eliminate those forward decls for the sake of
+	broken compilers.
+
+	* variable.c (make_vcell_variable): static char s_make_variable[];
+	isn't needed.
+
+	* fports.c (scm_port_mode): 
+               chars modes[3] = "";
+        to
+               chars modes[3];
+               modes[0] = '\0';
+	(Tom_Mckay@avanticorp.com)
+
+
+	* pairs.c (scm_set_cdr_x): non-__STDC__ declaration of
+        scm_cons2(), scm_acons(), and scm_set_cdr_x() missing semicolon
+	(Tom_Mckay@avanticorp.com)
+
+	* numbers.c (scm_num_eq_p): Non-__STDC__ declaration of 
+	scm_num_eq_p() was scm_equal_p().
+	(Tom_Mckay@avanticorp.com)
+
+	* symbols.c (msymbolize): "CHARS(X) = " => "SETCHARS..."
+	(Tom_Mckay@avanticorp.com)
+
+Fri Jan 26 14:03:01 1996  Tom Lord  <lord@beehive>
+
+	* weaks.c (scm_make_weak_vector): "VELTS(X) =" => "SETVELTS..."
+	(Tom_Mckay@avanticorp.com)
+
+	* strop.c (scm_substring_fill_x): 
+        Non-__STDC__ declaration of scm_substring_fill_x() missing semicolon
+	(Tom_Mckay@avanticorp.com)
+
+	* eval.c (SCM_APPLY): variables "debug_info" -> dbg_info.
+	Works around a compiler bug on some machines. (Tom_Mckay@avanticorp.com)
+
+	* _scm.h (CxR functions): #define CxR SCM_CxR => #define CxR(X) SCM_CxR(X)
+	Works around a compiler bug on some machines. (Tom_Mckay@avanticorp.com)
+
+	* lvectors.c (scm_lvector_set_x): avoid VELTS (VELTS (...)[..]) which
+	can turn into an obscure gc bug.
+
+	* chars.c (scm_char_p): fixed PROC call.
+
+	* gscm.h (gscm_vset): use scm_vector_set_x not (the missing)
+	scm_vector_set.
+
+Tue Jan 23 13:29:40 1996  Tom Lord  <lord@beehive>
+
+	* elisp.c (new file): dynamic scoping and other bits for
+	elisp.   Don't use this yet unless you specificly want to 
+	hack on elisp emulation.
+
+	* dynwind.c (scm_dowinds): When entering or leaving a dynamic
+	scope created by scm_with_dynamic_bindings_operation_x, swap
+	the bindings of that scope with the corresponding globals. 
+
+	* continuations.c (scm_make_cont): when a continuation is captured,
+	relocate the continuation stack chunks registered on the wind chain
+	to the heap.
+
+Sun Jan 21 19:31:17 1996  Tom Lord  <lord@beehive>
+
+	* eval.c (SCM_CEVAL): if the function position evaluates
+	to a macro, process it accordingly.  (Previously, macros were
+	handled only if the function position was a symbol naming a 
+	variable bound to a macro).
+
+Sat Jan 20 23:21:37 1996  Tom Lord  <lord@beehive>
+
+	* eval.c (scm_m_set): allow multi-variable set! like
+	(set! x 1 y 2 z 3).
+
+Wed Dec  6 02:40:49 1995  Tom Lord  <lord@beehive>
+
+	* ports.h fports.c vports.c marksweep.c gc.c strports.c: moved the STREAM
+	of ports into the port table and replaced it with a port-table
+	index.
+
+	* repl.c (iprin1): added tc7_mb_string -- same as tc7_string.
+
+	* marksweep.c (scm_gc_mark): added tc7_mb_string -- same as tc7_string.
+
+	* mbstrings.c (new file): functions on multi-byte strings.
+
+	* tags.h (scm_typ7_string, scm_typ7_mb_string): added a tag
+	for multi-byte strings. Moved the string tag.
+
+	* chars.h chars.c repl.c (many functions): made scm_upcase and scm_downcase
+	functions that are safe for extended character sets.  
+
+	Changed the range of integer->char.
+
+	Changed the tyep of SCM_ICHR.
+
+
+
+Tue May 16 17:49:58 1995  Mikael Djurfeldt  <mdj@sanscalc.nada.kth.se>
+  
+	* guile.c: Changed init file name from "SCM_INIT_PATH" to
+ 	  "GUILE_INIT_PATH"
+ 
+Sun Aug  6 15:14:46 1995  Andrew McCallum  <mccallum@vein.cs.rochester.edu>
+
+	* guile.c (gscm_is_gscm_type): New function.  (Without this how will we
+	know that it's safe to pass an object to gscm_get_type?)
+	(gscm_get_type): Fix tyop in error message.
+
+	* variable.c (scm_variable_ref): fixed assertion test.
+	(Robert STRANDH <strandh@labri.u-bordeaux.fr>)
+
+	* gscm.h: fixed several prototypes, notably gscm_vref.
+	Add gscm_is_eq and temporarily commented out gscm_eq (see
+	the note in gscm.h near gscm_eq if this change effects your
+	code). 
+	(Reported by Mark Galassi <rosalia@sstcx1.lanl.gov>)
+
+	* pairs.c (scm_obj_length): see next entry.
+
+	* gscm.h (gscm_obj_length): A way to get an integer
+	length for lists, strings, symbols (treated as strings),
+	and vectors.  Returns -1 on error.
+
+	* eq.c (scm_equal_p): fixed smob case.
+	(William Gribble <grib@arlut.utexas.edu>)
+
+	* Makefile.in (X_CFLAGS): defined.
+	(William Gribble <grib@arlut.utexas.edu>)
+
+	* gscm.h (gscm_2_double): provided now 
+	(reported by Mark Galassi <rosalia@sstcx1.lanl.gov>)
+
+Tue Jun 13 01:04:09 1995  gnu
+	* Vrooom!
+
+
diff --git a/libguile/Makefile.in b/libguile/Makefile.in
new file mode 100644
index 000000000..d1ed25c4f
--- /dev/null
+++ b/libguile/Makefile.in
@@ -0,0 +1,984 @@
+# @configure_input@
+
+#	Copyright (C) 1995 Free Software Foundation, Inc.
+# 
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+# 
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with this software; see the file COPYING.  If not, write to
+# the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+#
+
+
+#
+# Makefile for libguile
+#
+
+VPATH = @srcdir@
+srcdir = @srcdir@
+SHELL = /bin/sh
+
+VERSION=@GUILE_VERSION@
+
+# Common prefix for machine-independent installed files.
+prefix = @prefix@
+
+# Common prefix for machine-dependent installed files.
+exec_prefix = @exec_prefix@
+
+# Directory in which to install init files &c
+libdir = $(exec_prefix)/lib
+
+# Directory to search by default for included makefiles.
+includedir = $(prefix)/include
+
+# Directory to install `guile' in.
+bindir = $(exec_prefix)/bin
+
+
+INSTALL = $(srcdir)/../install-sh -c
+INSTALL_DATA = $(INSTALL) -m 644
+
+# Programs to make tags files.
+ETAGS = etags
+CTAGS = ctags -tw
+
+# where the init files are found
+IMPLPATH=$(libdir)/gls/guile
+
+# where the Tcl and Tk sources are found
+TCL_SRC_DIR = @TCL_SRC_DIR@
+TK_SRC_DIR = @TK_SRC_DIR@
+
+# CC
+X11_INCLUDES =		@XINCLUDES@
+XFLAGS = @X_CFLAGS@
+CFLAGS = @CFLAGS@ 
+INCLUDE_CFLAGS = -I. -I$(srcdir) -I$(TCL_SRC_DIR)/generic -I$(TK_SRC_DIR)/generic 
+ALL_CFLAGS = $(CFLAGS) $(X_CFLAGS) $(INCLUDE_CFLAGS) $(X11_INCLUDES) -DLIBRARY_PATH=\"$(libdir)/\" @DEFS@
+CC = @CC@ $(ALL_CFLAGS) -Wall
+
+# CC used as a front end for ld
+LDFLAGS = @LDFLAGS@
+CCLD= $(CC) $(LDFLAGS)
+
+# AR
+AR = ar
+AR_FLAGS = rc
+RANLIB = @RANLIB@
+
+# Any extra object files your system needs.
+extras = @LIBOBJS@
+
+libobjs=	alist.o \
+		append.o \
+		appinit.o \
+		arbiters.o \
+		async.o \
+		boolean.o \
+		chars.o \
+		continuations.o \
+		dynwind.o \
+		eq.o \
+		error.o \
+		eval.o \
+		extchrs.o \
+		fdsocket.o \
+		feature.o \
+		files.o \
+		filesys.o \
+		fports.o \
+		gc.o \
+		genio.o \
+		gsubr.o \
+		hash.o \
+		hashtab.o \
+		init.o \
+		ioext.o \
+		kw.o \
+		list.o \
+		load.o \
+		mallocs.o \
+		markers.o \
+		markers.o \
+		marksweep.o \
+		mbstrings.o \
+		numbers.o \
+		objprop.o \
+		pairs.o \
+		ports.o \
+		posix.o \
+		print.o \
+		procprop.o \
+		procs.o \
+		ramap.o \
+		read.o \
+		root.o \
+		scmsigs.o \
+		sequences.o \
+		simpos.o \
+		smob.o \
+		socket.o \
+		stackchk.o \
+		stime.o \
+		strings.o \
+		strop.o \
+		strorder.o \
+		strports.o \
+		struct.o \
+		symbols.o \
+		tag.o \
+		throw.o \
+		unif.o \
+		variable.o \
+		vectors.o \
+		vports.o \
+		weaks.o \
+		$(extras)
+
+
+uninstalled_h_files= _scm.h __scm.hd
+
+installed_h_files= __scm.h \
+		alist.h \
+		append.h \
+		arbiters.h \
+		async.h \
+		boolean.h \
+		chars.h \
+		continuations.h \
+		dynwind.h \
+		eq.h \
+		error.h \
+		eval.h \
+		extchrs.h \
+		fdsocket.h \
+		feature.h \
+		fports.h \
+		files.h \
+		filesys.h \
+		gc.h \
+		genio.h \
+		gsubr.h \
+		hash.h \
+		hashtab.h \
+		init.h \
+		ioext.h \
+		kw.h \
+		list.h \
+		load.h \
+		libguile.h \
+		mallocs.h \
+		markers.h \
+		marksweep.h \
+		markers.h \
+		mbstrings.h \
+		numbers.h \
+		objprop.h \
+		pairs.h \
+		ports.h \
+		posix.h \
+		params.h \
+		print.h \
+		procs.h \
+		procprop.h \
+		ramap.h \
+		read.h \
+		root.h \
+		scmsigs.h \
+		sequences.h \
+		simpos.h \
+		smob.h \
+		socket.h \
+		stackchk.h \
+		strports.h \
+		struct.h \
+		symbols.h \
+		tag.h \
+		stime.h \
+		tags.h \
+		variable.h \
+		vectors.h \
+		vports.h \
+		weaks.h \
+		unif.h \
+		scmhob.h \
+		strings.h \
+		strop.h \
+		strorder.h \
+		throw.h \
+		unif.h
+
+h_files=$(uninstalled_h_files) $(installed_h_files)
+
+c_files=	alist.c \
+		append.c \
+		appinit.c \
+		arbiters.c \
+		async.c \
+		boolean.c \
+		chars.c \
+		continuations.c \
+		dynwind.c \
+		eq.c \
+		error.c \
+		eval.c \
+		extchrs.c \
+		fdsocket.c \
+		feature.c \
+		files.c \
+		filesys.c \
+		fports.c \
+		gc.c \
+		genio.c \
+		gsubr.c \
+		hash.c \
+		hashtab.c \
+		inet_aton.c \
+		init.c \
+		ioext.c \
+		kw.c \
+		list.c \
+		load.c \
+		mallocs.c \
+		markers.c \
+		markers.c \
+		marksweep.c \
+		mbstrings.c \
+		numbers.c \
+		objprop.c \
+		pairs.c \
+		ports.c \
+		posix.c \
+		print.c \
+		procprop.c \
+		procs.c \
+		ramap.c \
+		read.c \
+		root.c \
+		scmsigs.c \
+		sequences.c \
+		simpos.c \
+		smob.c \
+		socket.c \
+		stackchk.c \
+		stime.c \
+		strings.c \
+		strop.c \
+		strorder.c \
+		strports.c \
+		struct.c \
+		symbols.c \
+		tag.c \
+		throw.c \
+		unif.c \
+		variable.c \
+		vectors.c \
+		vports.c \
+		weaks.c
+
+gen_c_files=	alist.x \
+		append.x \
+		arbiters.x \
+		async.x \
+		boolean.x \
+		chars.x \
+		continuations.x \
+		dynwind.x \
+		eq.x \
+		error.x \
+		eval.x \
+		extchrs.x \
+		fdsocket.x \
+		feature.x \
+		files.x \
+		filesys.x \
+		fports.x \
+		gc.x \
+		genio.x \
+		gsubr.x \
+		hash.x \
+		hashtab.x \
+		init.x \
+		ioext.x \
+		kw.x \
+		list.x \
+		load.x \
+		mallocs.x \
+		markers.x \
+		marksweep.x \
+		mbstrings.x \
+		numbers.x \
+		objprop.x \
+		pairs.x \
+		ports.x \
+		posix.x \
+		print.x \
+		procprop.x \
+		procs.x \
+		ramap.x \
+		read.x \
+		root.x \
+		scmsigs.x \
+		sequences.x \
+		simpos.x \
+		smob.x \
+		socket.x \
+		stackchk.x \
+		stime.x \
+		strings.x \
+		strop.x \
+		strorder.x \
+		strports.x \
+		struct.x \
+		symbols.x \
+		tag.x \
+		throw.x \
+		unif.x \
+		variable.x \
+		vectors.x \
+		vports.x \
+		weaks.x
+
+
+
+ancillery =	gscm.c \
+		gscm.h \
+		COPYING \
+		ChangeLog \
+		ChangeLog.scm \
+		Makefile.in \
+		PLUGIN \
+		acconfig-1.5.h \
+		configure \
+		configure.in \
+		def.sed \
+		scmconfig.h.in \
+		fd.h.in \
+		../doc/guile.texi \
+		../doc/guile.ps \
+		../doc/guile.info \
+		../doc/guile.info-1 \
+		../doc/guile.info-2 \
+		../doc/guile.info-3 \
+		../doc/guile.info-4 \
+		../doc/guile.info-5 \
+		../doc/in.texi \
+		../doc/in.info \
+		../doc/in.ps \
+		../doc/agenda \
+		../doc/texinfo.tex
+
+
+c_sources = $(c_files) $(h_files)
+manifest = $(ancillery) $(c_sources)
+
+
+.SUFFIXES:
+.SUFFIXES: .o .c .h .ps .dvi .info .texinfo .scm .cd .x .hd
+
+.cd.c:
+	(   echo "/* DO NOT EDIT  --- AUTO-GENERATED --- DO NOT EDIT */" > $@ \
+	 && echo -n "#line 1" \" \
+	 && echo $<\" | sed -e "s,^.*/,," >> $@ \
+	 && sed -f $(srcdir)/def.sed $< >> $@) \
+        || rm -f $@
+
+.hd.h:
+	(   echo "/* DO NOT EDIT  --- AUTO-GENERATED --- DO NOT EDIT */" > $@ \
+	 && echo -n "#line 1" \" >> $@ \
+	 && echo $<\" | sed -e "s,^.*/,," >> $@ \
+	 && sed -f $(srcdir)/def.sed $< >> $@) \
+        || rm -f $@
+
+.c.x:
+	if test ! -escmconfig.h ; then \
+	  touch scmconfig.h; \
+	  fake_scmconfig=1; \
+	else \
+	  fake_scmconfig=0; \
+	fi; \
+	$(CC) $(ALL_CFLAGS) -I. -DSCM_MAGIC_SNARFER -E $< | grep "^%%%" | sed -e "s/^%%%//" > $@ ; \
+	if test $$fake_scmconfig -eq 1 ; then \
+	  rm scmconfig.h; \
+	fi
+
+.PHONY: all
+all: libguile.a
+
+SUBDIR=.
+manifest:
+	for file in $(manifest) ; \
+	  do echo $(SUBDIR)/$$file ; \
+	done
+
+libguile.a: $(libobjs)
+	rm -f libguile.a
+	$(AR) $(AR_FLAGS) libguile.a $(libobjs)
+	$(RANLIB) libguile.a
+
+install: all
+	test -d $(prefix) || mkdir $(prefix)
+	test -d $(libdir) || mkdir $(libdir)
+	test -d $(includedir) || mkdir $(includedir)
+	test -d $(includedir)/guile$(VERSION) || mkdir $(includedir)/guile$(VERSION)
+	$(INSTALL_DATA) libguile.a $(libdir)/libguile$(VERSION).a
+	$(RANLIB) $(libdir)/libguile$(VERSION).a
+	$(INSTALL_DATA) scmconfig.h $(includedir)/guile$(VERSION)
+	for h in $(h_files); do \
+	  $(INSTALL_DATA) $(srcdir)/$$h $(includedir)/guile$(VERSION); \
+	done
+
+uninstall:
+	-for h in $(h_files); do \
+	  rm -f $(includedir)/guile$(VERSION)/$$h; \
+	done
+	rm -f $(includedir)/guile$(VERSION)/scmconfig.h
+	-rmdir $(includedir)/guile$(VERSION)
+	-rm $(libdir)/libguile$(VERSION).a
+
+
+TAGS:
+	etags $(c_sources)
+
+
+info:
+
+clean:
+	-rm -f libguile.a
+	-rm -f $(libobjs)
+	-rm -f $(gen_c_files)
+
+distclean: clean
+	-rm -f config.cache
+	-rm -f config.log
+	-rm -f config.status
+	-rm -f Makefile
+	-rm -f scmconfig.h
+
+
+realclean: distclean
+	-rm -f $(gen_c_files)
+	-rm -f scmconfig.h
+
+xfiles: $(gen_c_files)
+
+DEPENDS_CFLAGS=
+
+depends:
+	touch scmconfig.h
+	touch $(gen_c_files)
+	gcc -MM -I. $(DEPENDS_CFLAGS) $(c_files)
+	rm $(gen_c_files)
+	rm scmconfig.h
+
+$(srcdir)/__scm.h: __scm.hd
+
+###
+alist.o : alist.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
+  arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
+  pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
+  marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
+  load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
+  procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
+  stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
+  variable.h vectors.h vports.h weaks.h alist.x 
+append.o : append.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
+  append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
+  error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
+  gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
+  list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
+  procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
+  stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
+  unif.h variable.h vectors.h vports.h weaks.h append.x 
+appinit.o : appinit.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
+  append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
+  error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
+  gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
+  list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
+  procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
+  stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
+  unif.h variable.h vectors.h vports.h weaks.h 
+arbiters.o : arbiters.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
+  append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
+  error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
+  gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
+  list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
+  procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
+  stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
+  unif.h variable.h vectors.h vports.h weaks.h arbiters.x 
+async.o : async.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
+  arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
+  pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
+  marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
+  load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
+  procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
+  stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
+  variable.h vectors.h vports.h weaks.h async.x 
+boolean.o : boolean.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
+  append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
+  error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
+  gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
+  list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
+  procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
+  stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
+  unif.h variable.h vectors.h vports.h weaks.h boolean.x 
+chars.o : chars.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
+  arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
+  pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
+  marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
+  load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
+  procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
+  stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
+  variable.h vectors.h vports.h weaks.h chars.x 
+continuations.o : continuations.c _scm.h libguile.h __scm.h tags.h smob.h params.h \
+  alist.h append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h \
+  eq.h error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h \
+  fports.h gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h \
+  kw.h list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h \
+  print.h procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h \
+  socket.h stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h \
+  tag.h throw.h unif.h variable.h vectors.h vports.h weaks.h continuations.x 
+dynwind.o : dynwind.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
+  append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
+  error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
+  gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
+  list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
+  procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
+  stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
+  unif.h variable.h vectors.h vports.h weaks.h dynwind.x 
+eq.o : eq.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
+  arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
+  pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
+  marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
+  load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
+  procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
+  stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
+  variable.h vectors.h vports.h weaks.h eq.x 
+error.o : error.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
+  arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
+  pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
+  marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
+  load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
+  procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
+  stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
+  variable.h vectors.h vports.h weaks.h error.x 
+eval.o : eval.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
+  arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
+  pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
+  marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
+  load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
+  procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
+  stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
+  variable.h vectors.h vports.h weaks.h eval.x 
+extchrs.o : extchrs.c extchrs.h 
+fdsocket.o : fdsocket.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
+  append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
+  error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
+  gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
+  list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
+  procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
+  stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
+  unif.h variable.h vectors.h vports.h weaks.h fdsocket.x 
+feature.o : feature.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
+  append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
+  error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
+  gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
+  list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
+  procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
+  stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
+  unif.h variable.h vectors.h vports.h weaks.h feature.x 
+files.o : files.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
+  arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
+  pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
+  marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
+  load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
+  procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
+  stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
+  variable.h vectors.h vports.h weaks.h files.x 
+filesys.o : filesys.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
+  append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
+  error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
+  gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
+  list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
+  procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
+  stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
+  unif.h variable.h vectors.h vports.h weaks.h filesys.x 
+fports.o : fports.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
+  append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
+  error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
+  gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
+  list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
+  procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
+  stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
+  unif.h variable.h vectors.h vports.h weaks.h fports.x 
+gc.o : gc.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
+  arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
+  pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
+  marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
+  load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
+  procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
+  stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
+  variable.h vectors.h vports.h weaks.h gc.x 
+genio.o : genio.c extchrs.h _scm.h libguile.h __scm.h tags.h smob.h params.h \
+  alist.h append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h \
+  eq.h error.h pairs.h eval.h fdsocket.h feature.h files.h filesys.h fports.h \
+  gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
+  list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
+  procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
+  stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
+  unif.h variable.h vectors.h vports.h weaks.h 
+gsubr.o : gsubr.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
+  arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
+  pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
+  marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
+  load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
+  procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
+  stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
+  variable.h vectors.h vports.h weaks.h 
+hash.o : hash.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
+  arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
+  pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
+  marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
+  load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
+  procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
+  stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
+  variable.h vectors.h vports.h weaks.h hash.x 
+hashtab.o : hashtab.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
+  append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
+  error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
+  gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
+  list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
+  procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
+  stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
+  unif.h variable.h vectors.h vports.h weaks.h hashtab.x 
+inet_aton.o : inet_aton.c 
+init.o : init.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
+  arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
+  pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
+  marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
+  load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
+  procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
+  stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
+  variable.h vectors.h vports.h weaks.h 
+ioext.o : ioext.c ioext.x 
+kw.o : kw.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
+  arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
+  pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
+  marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
+  load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
+  procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
+  stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
+  variable.h vectors.h vports.h weaks.h kw.x 
+list.o : list.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
+  arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
+  pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
+  marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
+  load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
+  procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
+  stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
+  variable.h vectors.h vports.h weaks.h list.x 
+load.o : load.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
+  arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
+  pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
+  marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
+  load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
+  procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
+  stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
+  variable.h vectors.h vports.h weaks.h load.x 
+mallocs.o : mallocs.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
+  append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
+  error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
+  gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
+  list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
+  procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
+  stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
+  unif.h variable.h vectors.h vports.h weaks.h 
+markers.o : markers.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
+  append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
+  error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
+  gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
+  list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
+  procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
+  stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
+  unif.h variable.h vectors.h vports.h weaks.h 
+markers.o : markers.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
+  append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
+  error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
+  gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
+  list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
+  procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
+  stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
+  unif.h variable.h vectors.h vports.h weaks.h 
+marksweep.o : marksweep.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
+  append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
+  error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
+  gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
+  list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
+  procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
+  stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
+  unif.h variable.h vectors.h vports.h weaks.h 
+mbstrings.o : mbstrings.c extchrs.h _scm.h libguile.h __scm.h tags.h smob.h \
+  params.h alist.h append.h arbiters.h async.h boolean.h chars.h continuations.h \
+  dynwind.h eq.h error.h pairs.h eval.h fdsocket.h feature.h files.h filesys.h \
+  fports.h gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h \
+  kw.h list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h \
+  print.h procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h \
+  socket.h stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h \
+  tag.h throw.h unif.h variable.h vectors.h vports.h weaks.h mbstrings.x 
+numbers.o : numbers.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
+  append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
+  error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
+  gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
+  list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
+  procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
+  stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
+  unif.h variable.h vectors.h vports.h weaks.h numbers.x 
+objprop.o : objprop.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
+  append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
+  error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
+  gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
+  list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
+  procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
+  stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
+  unif.h variable.h vectors.h vports.h weaks.h objprop.x 
+pairs.o : pairs.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
+  arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
+  pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
+  marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
+  load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
+  procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
+  stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
+  variable.h vectors.h vports.h weaks.h pairs.x 
+ports.o : ports.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
+  arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
+  pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
+  marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
+  load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
+  procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
+  stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
+  variable.h vectors.h vports.h weaks.h ports.x 
+posix.o : posix.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
+  arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
+  pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
+  marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
+  load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
+  procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
+  stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
+  variable.h vectors.h vports.h weaks.h posix.x 
+print.o : print.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
+  arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
+  pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
+  marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
+  load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
+  procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
+  stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
+  variable.h vectors.h vports.h weaks.h print.x 
+procprop.o : procprop.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
+  append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
+  error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
+  gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
+  list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
+  procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
+  stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
+  unif.h variable.h vectors.h vports.h weaks.h procprop.x 
+procs.o : procs.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
+  arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
+  pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
+  marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
+  load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
+  procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
+  stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
+  variable.h vectors.h vports.h weaks.h procs.x 
+ramap.o : ramap.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
+  arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
+  pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
+  marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
+  load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
+  procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
+  stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
+  variable.h vectors.h vports.h weaks.h ramap.x 
+read.o : read.c extchrs.h _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
+  append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
+  error.h pairs.h eval.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
+  marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
+  load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
+  procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
+  stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
+  variable.h vectors.h vports.h weaks.h read.x 
+root.o : root.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
+  arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
+  pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
+  marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
+  load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
+  procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
+  stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
+  variable.h vectors.h vports.h weaks.h 
+scmsigs.o : scmsigs.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
+  append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
+  error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
+  gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
+  list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
+  procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
+  stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
+  unif.h variable.h vectors.h vports.h weaks.h scmsigs.x 
+sequences.o : sequences.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
+  append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
+  error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
+  gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
+  list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
+  procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
+  stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
+  unif.h variable.h vectors.h vports.h weaks.h sequences.x 
+simpos.o : simpos.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
+  append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
+  error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
+  gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
+  list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
+  procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
+  stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
+  unif.h variable.h vectors.h vports.h weaks.h simpos.x 
+smob.o : smob.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
+  arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
+  pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
+  marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
+  load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
+  procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
+  stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
+  variable.h vectors.h vports.h weaks.h 
+socket.o : socket.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
+  append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
+  error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
+  gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
+  list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
+  procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
+  stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
+  unif.h variable.h vectors.h vports.h weaks.h socket.x 
+stackchk.o : stackchk.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
+  append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
+  error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
+  gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
+  list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
+  procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
+  stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
+  unif.h variable.h vectors.h vports.h weaks.h stackchk.x 
+stime.o : stime.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
+  arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
+  pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
+  marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
+  load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
+  procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
+  stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
+  variable.h vectors.h vports.h weaks.h stime.x 
+strings.o : strings.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
+  append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
+  error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
+  gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
+  list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
+  procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
+  stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
+  unif.h variable.h vectors.h vports.h weaks.h strings.x 
+strop.o : strop.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
+  arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
+  pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
+  marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
+  load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
+  procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
+  stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
+  variable.h vectors.h vports.h weaks.h strop.x 
+strorder.o : strorder.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
+  append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
+  error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
+  gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
+  list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
+  procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
+  stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
+  unif.h variable.h vectors.h vports.h weaks.h strorder.x 
+strports.o : strports.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
+  append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
+  error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
+  gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
+  list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
+  procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
+  stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
+  unif.h variable.h vectors.h vports.h weaks.h strports.x 
+struct.o : struct.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
+  append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
+  error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
+  gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
+  list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
+  procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
+  stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
+  unif.h variable.h vectors.h vports.h weaks.h struct.x 
+symbols.o : symbols.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
+  append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
+  error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
+  gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
+  list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
+  procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
+  stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
+  unif.h variable.h vectors.h vports.h weaks.h symbols.x 
+tag.o : tag.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
+  arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
+  pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
+  marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
+  load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
+  procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
+  stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
+  variable.h vectors.h vports.h weaks.h tag.x 
+throw.o : throw.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
+  arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
+  pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
+  marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
+  load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
+  procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
+  stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
+  variable.h vectors.h vports.h weaks.h throw.x 
+unif.o : unif.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
+  arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
+  pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
+  marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
+  load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
+  procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
+  stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
+  variable.h vectors.h vports.h weaks.h unif.x 
+variable.o : variable.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
+  append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
+  error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
+  gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
+  list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
+  procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
+  stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
+  unif.h variable.h vectors.h vports.h weaks.h variable.x 
+vectors.o : vectors.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
+  append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
+  error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
+  gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
+  list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
+  procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
+  stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
+  unif.h variable.h vectors.h vports.h weaks.h vectors.x 
+vports.o : vports.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
+  append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
+  error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
+  gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
+  list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
+  procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
+  stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
+  unif.h variable.h vectors.h vports.h weaks.h vports.x 
+weaks.o : weaks.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
+  arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
+  pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
+  marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
+  load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
+  procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
+  stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
+  variable.h vectors.h vports.h weaks.h weaks.x 
diff --git a/libguile/__scm.h b/libguile/__scm.h
new file mode 100644
index 000000000..e3c5772ca
--- /dev/null
+++ b/libguile/__scm.h
@@ -0,0 +1,375 @@
+/* DO NOT EDIT  --- AUTO-GENERATED --- DO NOT EDIT */
+#line 1 "__scm.hd"
+/* classes: h_files */
+
+#ifndef __SCMH
+#define __SCMH
+/*	Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+/* {Supported Options}
+ *
+ * These may be defined or undefined.
+ */
+
+/* If the compile FLAG `CAUTIOUS' is #defined then the number of
+ * arguments is always checked for application of closures.  If the
+ * compile FLAG `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 ILOC or 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 ILOC or GLOC.
+ */
+#undef RECKLESS
+#define CAUTIOUS
+
+/* After looking up a local for the first time, rewrite the
+ * code graph, caching its position.
+ */
+#define MEMOIZE_LOCALS
+
+/* All the number support there is.
+ */
+#define SCM_FLOATS
+#define BIGNUMS
+
+/* GC should relinquish empty cons-pair arenas. 
+ */
+#define GC_FREE_SEGMENTS
+
+/* Provide a scheme-accessible count-down timer that
+ * generates a pseudo-interrupt.
+ */
+#define TICKS
+
+
+/* Use engineering notation when converting numbers strings?
+ */
+#undef ENGNOT
+
+/* Include support for uniform arrays?
+ *
+ * Possibly some of the initialization code depends on this
+ * being defined, but that is a bug and should be fixed.
+ */
+#define ARRAYS
+
+#undef SCM_CAREFUL_INTS
+
+/* {Unsupported Options}
+ *
+ * These must be defined.
+ */
+
+
+#define CCLO
+#define SICP
+
+
+
+/* Random options (net yet supported or in final form). */
+
+#undef DEBUG_EXTENSIONS
+#undef READER_EXTENSIONS
+#undef SCM_STACK_LIMIT 20000
+#undef NO_CEVAL_STACK_CHECK
+#undef LONGLONGS
+
+/* Some auto-generated .h files contain unused prototypes
+ * that need these typedefs.
+ */
+typedef long long_long;
+typedef unsigned long ulong_long;
+
+
+
+
+/* Define
+ *
+ * SCM_CHAR_SCM_CODE_LIMIT		== UCHAR_MAX + 1
+ * SCM_MOST_POSITIVE_FIXNUM 	(LONG_MAX>>2)
+ * SCM_MOST_NEGATIVE_FIXNUM 	== SCM_SRS((long)LONG_MIN, 2)
+ */
+
+#ifdef HAVE_LIMITSH
+# include <limits.h>
+# ifdef UCHAR_MAX
+#  define SCM_CHAR_SCM_CODE_LIMIT (UCHAR_MAX+1L)
+# else
+#  define SCM_CHAR_SCM_CODE_LIMIT 256L
+# endif /* def UCHAR_MAX */
+# define SCM_MOST_POSITIVE_FIXNUM (LONG_MAX>>2)
+# ifdef _UNICOS			/* Stupid cray bug */
+#  define SCM_MOST_NEGATIVE_FIXNUM ((long)LONG_MIN/4)
+# else
+#  define SCM_MOST_NEGATIVE_FIXNUM SCM_SRS((long)LONG_MIN, 2)
+# endif				/* UNICOS */
+#else
+# define SCM_CHAR_SCM_CODE_LIMIT 256L
+# define SCM_MOST_POSITIVE_FIXNUM ((long)((unsigned long)~0L>>3))
+# if (0 != ~0)
+#  define SCM_MOST_NEGATIVE_FIXNUM (-SCM_MOST_POSITIVE_FIXNUM-1)
+# else
+#  define SCM_MOST_NEGATIVE_FIXNUM (-SCM_MOST_POSITIVE_FIXNUM)
+# endif /*  (0 != ~0) */
+#endif /* def HAVE_LIMITSH */
+
+
+#include <scmconfig.h>
+#include "tags.h"
+
+
+#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 */
+
+
+/* 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 SCM_FLUSH_REGISTER_WINDOWS asm("ta 3")
+#else
+# define SCM_FLUSH_REGISTER_WINDOWS /* empty */
+#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 SCM_STACKITEM;
+#else
+typedef long SCM_STACKITEM;
+#endif
+
+
+extern unsigned int scm_async_clock;
+#define SCM_ASYNC_TICK		if (0 == --scm_async_clock) scm_async_click ()
+
+#ifdef SCM_CAREFUL_INTS
+#define SCM_CHECK_NOT_DISABLED \
+  if (scm_ints_disabled) \
+    fputs("ints already disabled\n", stderr); \
+
+#define SCM_CHECK_NOT_ENABLED \
+  if (!scm_ints_disabled) \
+    fputs("ints already enabled\n", stderr); \
+
+#else
+#define SCM_CHECK_NOT_DISABLED
+#define SCM_CHECK_NOT_ENABLED
+#endif
+
+
+#define SCM_DEFER_INTS \
+{ \
+  SCM_CHECK_NOT_DISABLED; \
+  scm_ints_disabled = 1; \
+} \
+
+
+#define SCM_ALLOW_INTS_ONLY \
+{ \
+  scm_ints_disabled = 0; \
+} \
+
+
+#define SCM_ALLOW_INTS \
+{ \
+  SCM_CHECK_NOT_ENABLED; \
+  scm_ints_disabled = 0; \
+  SCM_ASYNC_TICK; \
+} \
+
+
+#define SCM_REDEFER_INTS  \
+{ \
+  ++scm_ints_disabled; \
+} \
+
+
+#define SCM_REALLOW_INTS \
+{ \
+  --scm_ints_disabled; \
+  if (!scm_ints_disabled) \
+    SCM_ASYNC_TICK; \
+} \
+
+
+
+
+
+/** SCM_ASSERT
+ ** 
+ **/
+
+
+#ifdef SCM_RECKLESS
+#define SCM_ASSERT(_cond, _arg, _pos, _subr)
+#define SCM_ASRTGO(_cond, _label)
+#else
+#define SCM_ASSERT(_cond, _arg, _pos, _subr) \
+	if (!(_cond)) \
+          scm_wta(_arg, (char *)(_pos), _subr)
+#define SCM_ASRTGO(_cond, _label) \
+        if (!(_cond)) \
+          goto _label
+#endif
+
+
+#define SCM_ARGn 		0
+#define SCM_ARG1 		1
+#define SCM_ARG2 		2
+#define SCM_ARG3 		3
+#define SCM_ARG4 		4
+#define SCM_ARG5 		5
+#define SCM_ARG6 		6
+#define SCM_ARG7 		7
+#define SCM_ARGERR(X) 		((X) < SCM_WNA \
+				 ? (char *)(X) \
+				 : "wrong type argument")
+
+/* Following must match entry indexes in scm_errmsgs[].
+ * Also, SCM_WNA must follow the last SCM_ARGn in sequence.
+ */
+#define SCM_WNA 		8
+#define SCM_OVSCM_FLOW 		9
+#define SCM_OUTOFRANGE 		10
+#define SCM_NALLOC 		11
+#define SCM_STACK_SCM_OVSCM_FLOW	12
+#define SCM_EXIT 		13
+
+
+/* (...still matching scm_errmsgs)  These
+ * are signals.  Signals may become errors
+ * but are distinguished because they first
+ * try to invoke a handler that can resume
+ * the interrupted routine.
+ */
+#define SCM_HUP_SIGNAL 		14
+#define SCM_INT_SIGNAL 		15
+#define SCM_FPE_SIGNAL 		16
+#define SCM_BUS_SIGNAL 		17
+#define SCM_SEGV_SIGNAL 	18
+#define SCM_ALRM_SIGNAL 	19
+#define SCM_GC_SIGNAL		20
+#define SCM_TICK_SIGNAL		21
+
+#define SCM_SIG_ORD(X)		((X) - SCM_HUP_SIGNAL)
+#define SCM_ORD_SIG(X)		((X) + SCM_HUP_SIGNAL)
+#define SCM_NUM_SIGS		(SCM_SIG_ORD (SCM_TICK_SIGNAL) + 1)
+
+struct errdesc
+{
+  char *msg;
+  char *s_response;
+  short parent_err;
+};
+
+
+extern struct errdesc scm_errmsgs[];
+
+
+
+/* SCM_EXIT_SUCCESS is the default code to return from SCM if no errors
+ * were encountered.  SCM_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 (scm_quit <n>).
+ */
+
+#ifndef SCM_EXIT_SUCCESS
+#ifdef vms
+#define SCM_EXIT_SUCCESS 1
+#else
+#define SCM_EXIT_SUCCESS 0
+#endif /* def vms */
+#endif /* ndef SCM_EXIT_SUCCESS */
+#ifndef SCM_EXIT_FAILURE
+#ifdef vms
+#define SCM_EXIT_FAILURE 2
+#else
+#define SCM_EXIT_FAILURE 1
+#endif /* def vms */
+#endif /* ndef SCM_EXIT_FAILURE */
+
+
+
+
+#ifdef __STDC__
+
+#else /* STDC */
+
+#endif /* STDC */
+
+
+#endif  /* __SCMH */
diff --git a/libguile/__scm.hd b/libguile/__scm.hd
new file mode 100644
index 000000000..e69de29bb
--- /dev/null
+++ b/libguile/__scm.hd
diff --git a/libguile/_scm.h b/libguile/_scm.h
new file mode 100644
index 000000000..1c7e74ebc
--- /dev/null
+++ b/libguile/_scm.h
@@ -0,0 +1,130 @@
+/* classes: h_files */
+
+#ifndef _SCMH
+#define _SCMH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "libguile.h"
+
+/* 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>
+
+/* SCM_SYSCALL retries system calls that have been interrupted (EINTR) */
+#ifdef vms
+# ifndef __GNUC__
+#  include <ssdef.h>
+#  define SCM_SYSCALL(line) do{errno = 0;line;} \
+	while(EVMSERR==errno && (vaxc$errno>>3)==(SS$_CONTROLC>>3))
+# endif /* ndef __GNUC__ */
+#endif /* def vms */
+
+#ifndef SCM_SYSCALL
+# ifdef EINTR
+#  if (EINTR > 0)
+#   define SCM_SYSCALL(line) do{errno = 0;line;}while(EINTR==errno)
+#  endif /*  (EINTR > 0) */
+# endif /* def EINTR */
+#endif /* ndef SCM_SYSCALL */
+
+#ifndef SCM_SYSCALL
+# define SCM_SYSCALL(line) {line;}
+#endif /* ndef SCM_SYSCALL */
+
+#ifndef MSDOS
+# ifdef ARM_ULIB
+    extern volatile int errno;
+# else
+    extern int errno;
+# endif /* def ARM_ULIB */
+#endif /* ndef MSDOS */
+#ifdef __TURBOC__
+# if (__TURBOC__==1)
+ /* Needed for TURBOC V1.0 */
+ extern int errno;
+# endif /*  (__TURBOC__==1) */
+#endif /* def __TURBOC__ */
+
+
+
+#ifndef SCM_MAGIC_SNARFER
+#define SCM_PROC(RANAME, STR, REQ, OPT, VAR, CFN)  \
+	static char RANAME[]=STR;
+#define SCM_PROC1(RANAME, STR, TYPE, CFN)  \
+	static char RANAME[]=STR;
+#else
+#define SCM_PROC(RANAME, STR, REQ, OPT, VAR, CFN)  \
+%%%	scm_make_gsubr (RANAME, REQ, OPT, VAR, CFN)
+#define SCM_PROC1(RANAME, STR, TYPE, CFN)  \
+%%%	scm_make_subr(RANAME, TYPE, CFN)
+#endif
+
+#ifndef SCM_MAGIC_SNARFER
+#define SCM_SYMBOL(c_name, scheme_name) \
+	static SCM c_name = SCM_BOOL_F
+#else
+#define SCM_SYMBOL(C_NAME, SCHEME_NAME) \
+%%%	C_NAME = scm_permanent_object (SCM_CAR (scm_intern0 (SCHEME_NAME)))
+#endif
+
+
+#ifndef SCM_MAGIC_SNARFER
+#define SCM_GLOBAL(c_name, scheme_name) \
+	static SCM c_name = SCM_BOOL_F
+#else
+#define SCM_GLOBAL(C_NAME, SCHEME_NAME) \
+%%%	C_NAME = scm_permanent_object (scm_intern0 (SCHEME_NAME)); SCM_SETCDR (C_NAME, SCM_BOOL_F)
+#endif
+
+
+#ifndef SCM_MAGIC_SNARFER
+#define SCM_CONST_LONG(C_NAME, SCHEME_NAME,VALUE) \
+	static SCM C_NAME = SCM_BOOL_F
+#else
+#define SCM_CONST_LONG(C_NAME, SCHEME_NAME,VALUE) \
+%%%	C_NAME = scm_permanent_object (scm_intern0 (SCHEME_NAME)); SCM_SETCDR (C_NAME, scm_long2num (VALUE))
+#endif
+
+#endif  /* _SCMH */
+
diff --git a/libguile/alist.c b/libguile/alist.c
new file mode 100644
index 000000000..85c4395af
--- /dev/null
+++ b/libguile/alist.c
@@ -0,0 +1,455 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+
+SCM_PROC(s_acons, "acons", 3, 0, 0, scm_acons);
+#ifdef __STDC__
+SCM 
+scm_acons (SCM w, SCM x, SCM y)
+#else
+SCM 
+scm_acons (w, x, y)
+     SCM w;
+     SCM x;
+     SCM y;
+#endif
+{
+  register SCM z;
+  SCM_NEWCELL (z);
+  SCM_CAR (z) = w;
+  SCM_CDR (z) = x;
+  x = z;
+  SCM_NEWCELL (z);
+  SCM_CAR (z) = x;
+  SCM_CDR (z) = y;
+  return z;
+}
+
+
+
+SCM_PROC (s_sloppy_assq, "sloppy-assq", 2, 0, 0, scm_sloppy_assq);
+#ifdef __STDC__
+SCM
+scm_sloppy_assq(SCM x, SCM alist)
+#else
+SCM
+scm_sloppy_assq(x, alist)
+     SCM x;
+     SCM alist;
+#endif
+{
+  SCM tmp;
+  for(;SCM_NIMP(alist);alist = SCM_CDR(alist))
+    {
+      if (SCM_CONSP(alist))
+	{
+	  tmp = SCM_CAR(alist);
+	  if (SCM_NIMP (tmp) && SCM_CONSP (tmp) && (SCM_CAR (tmp)==x))
+	    return tmp;
+	}
+    }
+  return SCM_BOOL_F;
+}
+
+
+
+SCM_PROC (s_sloppy_assv, "sloppy-assv", 2, 0, 0, scm_sloppy_assv);
+#ifdef __STDC__
+SCM
+scm_sloppy_assv(SCM x, SCM alist)
+#else
+SCM
+scm_sloppy_assv(x, alist)
+     SCM x;
+     SCM alist;
+#endif
+{
+  SCM tmp;
+  for(;SCM_NIMP(alist);alist = SCM_CDR(alist))
+    {
+      if (SCM_CONSP(alist))
+	{
+	  tmp = SCM_CAR(alist);
+	  if (   SCM_NIMP (tmp)
+	      && SCM_CONSP (tmp)
+	      && SCM_NFALSEP (scm_eqv_p (SCM_CAR (tmp), x)))
+	    return tmp;
+	}
+    }
+  return SCM_BOOL_F;
+}
+
+
+SCM_PROC (s_sloppy_assoc, "sloppy-assoc", 2, 0, 0, scm_sloppy_assoc);
+#ifdef __STDC__
+SCM
+scm_sloppy_assoc(SCM x, SCM alist)
+#else
+SCM
+scm_sloppy_assoc(x, alist)
+     SCM x;
+     SCM alist;
+#endif
+{
+  SCM tmp;
+  for(;SCM_NIMP(alist);alist = SCM_CDR(alist))
+    {
+      if (SCM_CONSP(alist))
+	{
+	  tmp = SCM_CAR(alist);
+	  if (   SCM_NIMP (tmp)
+	      && SCM_CONSP (tmp)
+	      && SCM_NFALSEP (scm_equal_p (SCM_CAR (tmp), x)))
+	    return tmp;
+	}
+    }
+  return SCM_BOOL_F;
+}
+
+
+
+
+SCM_PROC(s_assq, "assq", 2, 0, 0, scm_assq);
+#ifdef __STDC__
+SCM
+scm_assq(SCM x, SCM alist)
+#else
+SCM
+scm_assq(x, alist)
+     SCM x;
+     SCM alist;
+#endif
+{
+	SCM tmp;
+	for(;SCM_NIMP(alist);alist = SCM_CDR(alist)) {
+		SCM_ASSERT(SCM_CONSP(alist), alist, SCM_ARG2, s_assq);
+		tmp = SCM_CAR(alist);
+		SCM_ASSERT(SCM_NIMP(tmp) && SCM_CONSP(tmp), alist, SCM_ARG2, s_assq);
+		if (SCM_CAR(tmp)==x) return tmp;
+	}
+	SCM_ASSERT(SCM_NULLP(alist), alist, SCM_ARG2, s_assq);
+	return SCM_BOOL_F;
+}
+
+
+SCM_PROC(s_assv, "assv", 2, 0, 0, scm_assv);
+#ifdef __STDC__
+SCM
+scm_assv(SCM x, SCM alist)
+#else
+SCM
+scm_assv(x, alist)
+     SCM x;
+     SCM alist;
+#endif
+{
+  SCM tmp;
+  for(;SCM_NIMP(alist);alist = SCM_CDR(alist)) {
+    SCM_ASRTGO(SCM_CONSP(alist), badlst);
+    tmp = SCM_CAR(alist);
+    SCM_ASRTGO(SCM_NIMP(tmp) && SCM_CONSP(tmp), badlst);
+    if SCM_NFALSEP(scm_eqv_p(SCM_CAR(tmp), x)) return tmp;
+  }
+# ifndef RECKLESS
+  if (!(SCM_NULLP(alist)))
+    badlst: scm_wta(alist, (char *)SCM_ARG2, s_assv);
+# endif
+  return SCM_BOOL_F;
+}
+
+
+SCM_PROC(s_assoc, "assoc", 2, 0, 0, scm_assoc);
+#ifdef __STDC__
+SCM
+scm_assoc(SCM x, SCM alist)
+#else
+SCM
+scm_assoc(x, alist)
+     SCM x;
+     SCM alist;
+#endif
+{
+	SCM tmp;
+	for(;SCM_NIMP(alist);alist = SCM_CDR(alist)) {
+		SCM_ASSERT(SCM_CONSP(alist), alist, SCM_ARG2, s_assoc);
+		tmp = SCM_CAR(alist);
+		SCM_ASSERT(SCM_NIMP(tmp) && SCM_CONSP(tmp), alist, SCM_ARG2, s_assoc);
+		if SCM_NFALSEP(scm_equal_p(SCM_CAR(tmp), x)) return tmp;
+	}
+	SCM_ASSERT(SCM_NULLP(alist), alist, SCM_ARG2, s_assoc);
+	return SCM_BOOL_F;
+}
+
+
+
+
+SCM_PROC (s_assq_ref, "assq-ref", 2, 0, 0, scm_assq_ref);
+#ifdef __STDC__
+SCM
+scm_assq_ref (SCM alist, SCM key)
+#else
+SCM
+scm_assq_ref (alist, key)
+     SCM alist;
+     SCM key;
+#endif
+{
+  SCM handle;
+
+  handle = scm_sloppy_assq (key, alist);
+  if (SCM_NIMP (handle) && SCM_CONSP (handle))
+    {
+      return SCM_CDR (handle);
+    }
+  return SCM_BOOL_F;
+}
+
+
+SCM_PROC (s_assv_ref, "assv-ref", 2, 0, 0, scm_assv_ref);
+#ifdef __STDC__
+SCM
+scm_assv_ref (SCM alist, SCM key)
+#else
+SCM
+scm_assv_ref (alist, key)
+     SCM alist;
+     SCM key;
+#endif
+{
+  SCM handle;
+
+  handle = scm_sloppy_assv (key, alist);
+  if (SCM_NIMP (handle) && SCM_CONSP (handle))
+    {
+      return SCM_CDR (handle);
+    }
+  return SCM_BOOL_F;
+}
+
+
+SCM_PROC (s_assoc_ref, "assoc-ref", 2, 0, 0, scm_assoc_ref);
+#ifdef __STDC__
+SCM
+scm_assoc_ref (SCM alist, SCM key)
+#else
+SCM
+scm_assoc_ref (alist, key)
+     SCM alist;
+     SCM key;
+#endif
+{
+  SCM handle;
+
+  handle = scm_sloppy_assoc (key, alist);
+  if (SCM_NIMP (handle) && SCM_CONSP (handle))
+    {
+      return SCM_CDR (handle);
+    }
+  return SCM_BOOL_F;
+}
+
+
+
+
+
+
+SCM_PROC (s_assq_set_x, "assq-set!", 3, 0, 0, scm_assq_set_x);
+#ifdef __STDC__
+SCM
+scm_assq_set_x (SCM alist, SCM key, SCM val)
+#else
+SCM
+scm_assq_set_x (alist, key, val)
+     SCM alist;
+     SCM key;
+     SCM val;
+#endif
+{
+  SCM handle;
+
+  handle = scm_sloppy_assq (key, alist);
+  if (SCM_NIMP (handle) && SCM_CONSP (handle))
+    {
+      SCM_SETCDR (handle, val);
+      return alist;
+    }
+  else
+    return scm_acons (key, val, alist);
+}
+
+SCM_PROC (s_assv_set_x, "assv-set!", 3, 0, 0, scm_assv_set_x);
+#ifdef __STDC__
+SCM
+scm_assv_set_x (SCM alist, SCM key, SCM val)
+#else
+SCM
+scm_assv_set_x (alist, key, val)
+     SCM alist;
+     SCM key;
+     SCM val;
+#endif
+{
+  SCM handle;
+
+  handle = scm_sloppy_assv (key, alist);
+  if (SCM_NIMP (handle) && SCM_CONSP (handle))
+    {
+      SCM_SETCDR (handle, val);
+      return alist;
+    }
+  else
+    return scm_acons (key, val, alist);
+}
+
+SCM_PROC (s_assoc_set_x, "assoc-set!", 3, 0, 0, scm_assoc_set_x);
+#ifdef __STDC__
+SCM
+scm_assoc_set_x (SCM alist, SCM key, SCM val)
+#else
+SCM
+scm_assoc_set_x (alist, key, val)
+     SCM alist;
+     SCM key;
+     SCM val;
+#endif
+{
+  SCM handle;
+
+  handle = scm_sloppy_assoc (key, alist);
+  if (SCM_NIMP (handle) && SCM_CONSP (handle))
+    {
+      SCM_SETCDR (handle, val);
+      return alist;
+    }
+  else
+    return scm_acons (key, val, alist);
+}
+
+
+
+
+SCM_PROC (s_assq_remove_x, "assq-remove!", 2, 0, 0, scm_assq_remove_x);
+#ifdef __STDC__
+SCM
+scm_assq_remove_x (SCM alist, SCM key)
+#else
+SCM
+scm_assq_remove_x (alist, key)
+     SCM alist;
+     SCM key;
+#endif
+{
+  SCM handle;
+
+  handle = scm_sloppy_assq (key, alist);
+  if (SCM_NIMP (handle) && SCM_CONSP (handle))
+    {
+      return scm_delq_x (handle, alist);
+    }
+  else
+    return alist;
+}
+
+
+SCM_PROC (s_assv_remove_x, "assv-remove!", 2, 0, 0, scm_assv_remove_x);
+#ifdef __STDC__
+SCM
+scm_assv_remove_x (SCM alist, SCM key)
+#else
+SCM
+scm_assv_remove_x (alist, key)
+     SCM alist;
+     SCM key;
+#endif
+{
+  SCM handle;
+
+  handle = scm_sloppy_assv (key, alist);
+  if (SCM_NIMP (handle) && SCM_CONSP (handle))
+    {
+      return scm_delv_x (handle, alist);
+    }
+  else
+    return alist;
+}
+
+
+SCM_PROC (s_assoc_remove_x, "assoc-remove!", 2, 0, 0, scm_assoc_remove_x);
+#ifdef __STDC__
+SCM
+scm_assoc_remove_x (SCM alist, SCM key)
+#else
+SCM
+scm_assoc_remove_x (alist, key)
+     SCM alist;
+     SCM key;
+#endif
+{
+  SCM handle;
+
+  handle = scm_sloppy_assoc (key, alist);
+  if (SCM_NIMP (handle) && SCM_CONSP (handle))
+    {
+      return scm_delete_x (handle, alist);
+    }
+  else
+    return alist;
+}
+
+
+
+
+
+#ifdef __STDC__
+void
+scm_init_alist (void)
+#else
+void
+scm_init_alist ()
+#endif
+{
+#include "alist.x"
+}
+
diff --git a/libguile/alist.h b/libguile/alist.h
new file mode 100644
index 000000000..f0f90a4df
--- /dev/null
+++ b/libguile/alist.h
@@ -0,0 +1,97 @@
+/* classes: h_files */
+
+#ifndef ALISTH
+#define ALISTH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+
+
+
+
+
+
+#ifdef __STDC__
+extern SCM scm_acons (SCM w, SCM x, SCM y);
+extern SCM scm_sloppy_assq(SCM x, SCM alist);
+extern SCM scm_sloppy_assv(SCM x, SCM alist);
+extern SCM scm_sloppy_assoc(SCM x, SCM alist);
+extern SCM scm_assq(SCM x, SCM alist);
+extern SCM scm_assv(SCM x, SCM alist);
+extern SCM scm_assoc(SCM x, SCM alist);
+extern SCM scm_assq_ref (SCM alist, SCM key);
+extern SCM scm_assv_ref (SCM alist, SCM key);
+extern SCM scm_assoc_ref (SCM alist, SCM key);
+extern SCM scm_assq_set_x (SCM alist, SCM key, SCM val);
+extern SCM scm_assv_set_x (SCM alist, SCM key, SCM val);
+extern SCM scm_assoc_set_x (SCM alist, SCM key, SCM val);
+extern SCM scm_assq_remove_x (SCM alist, SCM key);
+extern SCM scm_assv_remove_x (SCM alist, SCM key);
+extern SCM scm_assoc_remove_x (SCM alist, SCM key);
+extern void scm_init_alist (void);
+
+#else /* STDC */
+extern SCM scm_acons ();
+extern SCM scm_sloppy_assq();
+extern SCM scm_sloppy_assv();
+extern SCM scm_sloppy_assoc();
+extern SCM scm_assq();
+extern SCM scm_assv();
+extern SCM scm_assoc();
+extern SCM scm_assq_ref ();
+extern SCM scm_assv_ref ();
+extern SCM scm_assoc_ref ();
+extern SCM scm_assq_set_x ();
+extern SCM scm_assv_set_x ();
+extern SCM scm_assoc_set_x ();
+extern SCM scm_assq_remove_x ();
+extern SCM scm_assv_remove_x ();
+extern SCM scm_assoc_remove_x ();
+extern void scm_init_alist ();
+
+#endif /* STDC */
+
+
+
+
+#endif  /* ALISTH */
diff --git a/libguile/append.c b/libguile/append.c
new file mode 100644
index 000000000..4f09a1dcf
--- /dev/null
+++ b/libguile/append.c
@@ -0,0 +1,88 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+
+SCM_PROC (s_append, "append", 0, 0, 1, scm_append);
+#ifdef __STDC__
+SCM
+scm_append (SCM objs)
+#else
+SCM
+scm_append (objs)
+     SCM objs;
+#endif
+{
+  return scm_list_append (objs);
+}
+
+
+SCM_PROC (s_append_x, "append!", 0, 0, 1, scm_append_x);
+#ifdef __STDC__
+SCM
+scm_append_x (SCM objs)
+#else
+SCM
+scm_append_x (objs)
+     SCM objs;
+#endif
+{
+  return scm_list_append_x (objs);
+}
+
+
+
+
+#ifdef __STDC__
+void
+scm_init_append (void)
+#else
+void
+scm_init_append ()
+#endif
+{
+#include "append.x"
+}
+
diff --git a/libguile/append.h b/libguile/append.h
new file mode 100644
index 000000000..33197f976
--- /dev/null
+++ b/libguile/append.h
@@ -0,0 +1,68 @@
+/* classes: h_files */
+
+#ifndef APPENDH
+#define APPENDH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+
+
+
+
+
+
+#ifdef __STDC__
+extern SCM scm_append (SCM objs);
+extern SCM scm_append_x (SCM objs);
+extern void scm_init_append (void);
+
+#else /* STDC */
+extern SCM scm_append ();
+extern SCM scm_append_x ();
+extern void scm_init_append ();
+
+#endif /* STDC */
+
+
+
+#endif  /* APPENDH */
diff --git a/libguile/appinit.c b/libguile/appinit.c
new file mode 100644
index 000000000..3af008123
--- /dev/null
+++ b/libguile/appinit.c
@@ -0,0 +1,57 @@
+/*	Copyright (C) 1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+
+#ifdef __STDC__
+void
+scm_appinit (void)
+#else
+void
+scm_appinit ()
+#endif
+{
+}
+
diff --git a/libguile/arbiters.c b/libguile/arbiters.c
new file mode 100644
index 000000000..d5e374b42
--- /dev/null
+++ b/libguile/arbiters.c
@@ -0,0 +1,150 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+/* {Arbiters}
+ *
+ * These procedures implement synchronization primitives.  Processors
+ * with an atomic test-and-set instruction can use it here (and not
+ * SCM_DEFER_INTS). 
+ */
+
+static long scm_tc16_arbiter;
+
+#ifdef __STDC__
+static int 
+prinarb (SCM exp, SCM port, int writing)
+#else
+static int 
+prinarb (exp, port, writing)
+     SCM exp;
+     SCM port;
+     int writing;
+#endif
+{
+  scm_gen_puts (scm_regular_string, "#<arbiter ", port);
+  if (SCM_CAR (exp) & (1L << 16))
+    scm_gen_puts (scm_regular_string, "locked ", port);
+  scm_iprin1 (SCM_CDR (exp), port, writing);
+  scm_gen_putc ('>', port);
+  return !0;
+}
+
+static scm_smobfuns arbsmob =
+{
+  scm_markcdr, scm_free0, prinarb, 0
+};
+
+SCM_PROC(s_make_arbiter, "make-arbiter", 1, 0, 0, scm_make_arbiter);
+#ifdef __STDC__
+SCM 
+scm_make_arbiter (SCM name)
+#else
+SCM 
+scm_make_arbiter (name)
+     SCM name;
+#endif
+{
+  register SCM z;
+  SCM_NEWCELL (z);
+  SCM_CDR (z) = name;
+  SCM_CAR (z) = scm_tc16_arbiter;
+  return z;
+}
+
+SCM_PROC(s_try_arbiter, "try-arbiter", 1, 0, 0, scm_try_arbiter);
+#ifdef __STDC__
+SCM 
+scm_try_arbiter (SCM arb)
+#else
+SCM 
+scm_try_arbiter (arb)
+     SCM arb;
+#endif
+{
+  SCM_ASSERT ((SCM_TYP16 (arb) == scm_tc16_arbiter), arb, SCM_ARG1, s_try_arbiter);
+  SCM_DEFER_INTS;
+  if (SCM_CAR (arb) & (1L << 16))
+    arb = SCM_BOOL_F;
+  else
+    {
+      SCM_CAR (arb) = scm_tc16_arbiter | (1L << 16);
+      arb = SCM_BOOL_T;
+    }
+  SCM_ALLOW_INTS;
+  return arb;
+}
+
+
+SCM_PROC(s_release_arbiter, "release-arbiter", 1, 0, 0, scm_release_arbiter);
+#ifdef __STDC__
+SCM 
+scm_release_arbiter (SCM arb)
+#else
+SCM 
+scm_release_arbiter (arb)
+     SCM arb;
+#endif
+{
+  SCM_ASSERT ((SCM_TYP16 (arb) == scm_tc16_arbiter), arb, SCM_ARG1, s_release_arbiter);
+  if (!(SCM_CAR (arb) & (1L << 16)))
+    return SCM_BOOL_F;
+  SCM_CAR (arb) = scm_tc16_arbiter;
+  return SCM_BOOL_T;
+}
+
+
+#ifdef __STDC__
+void
+scm_init_arbiters (void)
+#else
+void
+scm_init_arbiters ()
+#endif
+{
+  scm_tc16_arbiter = scm_newsmob (&arbsmob);
+#include "arbiters.x"
+}
+
diff --git a/libguile/arbiters.h b/libguile/arbiters.h
new file mode 100644
index 000000000..2a88a6ebc
--- /dev/null
+++ b/libguile/arbiters.h
@@ -0,0 +1,68 @@
+/* classes: h_files */
+
+#ifndef ARBITERSH
+#define ARBITERSH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+
+
+#ifdef __STDC__
+extern SCM scm_make_arbiter (SCM name);
+extern SCM scm_try_arbiter (SCM arb);
+extern SCM scm_release_arbiter (SCM arb);
+extern void scm_init_arbiters (void);
+
+#else /* STDC */
+extern SCM scm_make_arbiter ();
+extern SCM scm_try_arbiter ();
+extern SCM scm_release_arbiter ();
+extern void scm_init_arbiters ();
+
+#endif /* STDC */
+
+
+
+
+
+#endif  /* ARBITERSH */
diff --git a/libguile/async.c b/libguile/async.c
new file mode 100644
index 000000000..7a942270e
--- /dev/null
+++ b/libguile/async.c
@@ -0,0 +1,737 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include <signal.h>
+#include "_scm.h"
+
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+
+
+
+/* {Asynchronous Events}
+ *
+ *
+ * Async == thunk + mark.
+ *
+ * Setting the mark guarantees future execution of the thunk.  More
+ * than one set may be satisfied by a single execution.
+ * 
+ * scm_tick_clock decremented once per SCM_ALLOW_INTS.
+ * Async execution triggered by SCM_ALLOW_INTS when scm_tick_clock drops to 0.
+ * Async execution prevented by scm_mask_ints != 0.
+ *
+ * If the clock reaches 0 when scm_mask_ints != 0, then reset the clock
+ * to 1.
+ *
+ * If the clock reaches 0 any other time, run marked asyncs.
+ *
+ * From a unix signal handler, mark a corresponding async and set the clock
+ * to 1.   Do SCM_REDEFER_INTS;/SCM_REALLOW_INTS so that if the signal handler is not
+ * called in the dynamic scope of a critical section, it is excecuted immediately.
+ *
+ * Overall, closely timed signals of a particular sort may be combined.  Pending signals
+ * are delivered in a fixed priority order, regardless of arrival order.
+ *
+ */
+
+
+#define min(A,B) ((A) < (B) ? (A) : (B))
+
+
+unsigned int scm_async_clock = 20;
+static unsigned int scm_async_rate = 20;
+unsigned int scm_mask_ints = 1;
+
+static unsigned int scm_tick_clock = 0;
+static unsigned int scm_tick_rate = 0;
+static unsigned int scm_desired_tick_rate = 0;
+static unsigned int scm_switch_clock = 0;
+static unsigned int scm_switch_rate = 0;
+static unsigned int scm_desired_switch_rate = 0;
+
+static SCM system_signal_asyncs[SCM_NUM_SIGS];
+static SCM handler_var;
+static SCM symbol_signal;
+
+
+struct scm_async
+{
+  int got_it;			/* needs to be delivered? */
+  SCM thunk;			/* the handler. */
+};
+
+
+static long scm_tc16_async;
+
+#define SCM_ASYNCP(X) 	(scm_tc16_async == SCM_GCTYP16 (X))
+#define SCM_ASYNC(X) 	((struct scm_async *)SCM_CDR (X))
+
+
+
+
+
+
+#ifdef __STDC__
+static int
+asyncs_pending (void)
+#else
+static int
+asyncs_pending ()
+#endif
+{
+  SCM pos;
+  pos = scm_asyncs;
+  while (pos != SCM_EOL)
+    {
+      SCM a;
+      struct scm_async * it;
+      a = SCM_CAR (pos);
+      it = SCM_ASYNC (a);
+      if (it->got_it)
+	return 1;
+      pos = SCM_CDR (pos);
+    }
+  return 0;
+}
+
+
+#ifdef __STDC__
+void
+scm_async_click (void)
+#else
+void
+scm_async_click ()
+#endif
+{
+  int owe_switch;
+  int owe_tick;
+
+  if (!scm_switch_rate)
+    {
+      owe_switch = 0;
+      scm_switch_clock = scm_switch_rate = scm_desired_switch_rate;
+      scm_desired_switch_rate = 0;
+    }
+  else
+    {
+      owe_switch = (scm_async_rate >= scm_switch_clock);
+      if (owe_switch)
+	{
+	  if (scm_desired_switch_rate)
+	    {
+	      scm_switch_clock = scm_switch_rate = scm_desired_switch_rate;
+	      scm_desired_switch_rate = 0;
+	    }
+	  else
+	    scm_switch_clock = scm_switch_rate;
+	}
+      else
+	{
+	  if (scm_desired_switch_rate)
+	    {
+	      scm_switch_clock = scm_switch_rate = scm_desired_switch_rate;
+	      scm_desired_switch_rate = 0;
+	    }
+	  else
+	    scm_switch_clock -= scm_async_rate;
+	}
+    }
+
+  if (scm_mask_ints)
+    {
+      if (owe_switch)
+	scm_switch ();
+      scm_async_clock = 1;
+      return;;
+    }
+  
+  if (!scm_tick_rate)
+    {
+      unsigned int r;
+      owe_tick = 0;
+      r = scm_desired_tick_rate;
+      if (r)
+	{
+	  scm_desired_tick_rate = 0;
+	  scm_tick_rate = r;
+	  scm_tick_clock = r;
+	}
+    }
+  else
+    {
+      owe_tick = (scm_async_rate >= scm_tick_clock);
+      if (owe_tick)
+	{
+	  scm_tick_clock = scm_tick_rate = scm_desired_tick_rate;
+	  scm_desired_tick_rate = 0;
+	}
+      else
+	{
+	  if (scm_desired_tick_rate)
+	    {
+	      scm_tick_clock = scm_tick_rate = scm_desired_tick_rate;
+	      scm_desired_tick_rate = 0;
+	    }
+	  else
+	    scm_tick_clock -= scm_async_rate;
+	}
+    }
+
+  if (owe_tick)
+    scm_async_mark (system_signal_asyncs[SCM_SIG_ORD(SCM_TICK_SIGNAL)]);
+
+  SCM_DEFER_INTS;
+  if (scm_tick_rate && scm_switch_rate)
+    {
+      scm_async_rate = min (scm_tick_clock,  scm_switch_clock);
+      scm_async_clock = scm_async_rate;
+    }
+  else if (scm_tick_rate)
+    {
+      scm_async_clock = scm_async_rate = scm_tick_clock;
+    }
+  else if (scm_switch_rate)
+    {
+      scm_async_clock = scm_async_rate = scm_switch_clock;
+    }
+  else
+    scm_async_clock = scm_async_rate = 1 << 16;
+  SCM_ALLOW_INTS_ONLY;
+
+ tail:
+  scm_run_asyncs (scm_asyncs);
+
+  SCM_DEFER_INTS;
+  if (asyncs_pending ())
+    {
+      SCM_ALLOW_INTS_ONLY;
+      goto tail;
+    }
+  SCM_ALLOW_INTS;
+
+  if (owe_switch)
+    scm_switch ();
+}
+
+
+
+
+#ifdef __STDC__
+void
+scm_switch (void)
+#else
+void
+scm_switch ()
+#endif
+{}
+
+
+#ifdef __STDC__
+static void
+scm_deliver_signal (int num)
+#else
+static void
+scm_deliver_signal (num)
+     int num;
+#endif
+{
+  SCM handler;
+  handler = SCM_CDR (handler_var);
+  if (handler != SCM_BOOL_F)
+    scm_apply (handler, SCM_MAKINUM (num), scm_listofnull);
+  else
+    {
+      scm_mask_ints = 0;
+      scm_throw (symbol_signal,
+			   scm_listify (SCM_MAKINUM (num), SCM_UNDEFINED));
+    }
+}
+
+
+
+
+#ifdef __STDC__
+static int
+print_async (SCM exp, SCM port, int writing)
+#else
+static int
+print_async (exp, port, writing)
+     SCM exp;
+     SCM port;
+     int writing;
+#endif
+{
+  scm_gen_puts (scm_regular_string, "#<async ", port);
+  scm_intprint(exp, 16, port);
+  scm_gen_putc('>', port);
+  return 1;
+}
+
+#ifdef __STDC__
+static SCM
+mark_async (SCM obj)
+#else
+static SCM
+mark_async (obj)
+     SCM obj;
+#endif
+{
+  struct scm_async * it;
+  if (SCM_GC8MARKP (obj))
+    return SCM_BOOL_F;
+  SCM_SETGC8MARK (obj);
+  it = SCM_ASYNC (obj);
+  return it->thunk;
+}
+
+#ifdef __STDC__
+static scm_sizet
+free_async (SCM obj)
+#else
+static scm_sizet
+free_async (SCM obj)
+     SCM obj;
+#endif
+{
+  struct scm_async * it;
+  it = SCM_ASYNC (obj);
+  scm_must_free ((char *)it);
+  return (sizeof (*it));
+}
+
+
+static scm_smobfuns  async_smob =
+{
+  mark_async,
+  free_async,
+  print_async,
+  0
+};
+
+
+
+
+SCM_PROC(s_async, "async", 1, 0, 0, scm_async);
+#ifdef __STDC__
+SCM
+scm_async (SCM thunk)
+#else
+SCM
+scm_async (thunk)
+     SCM thunk;
+#endif
+{
+  SCM it;
+  struct scm_async * async;
+
+  SCM_NEWCELL (it);
+  SCM_DEFER_INTS;
+  SCM_SETCDR (it, SCM_EOL);
+  async = (struct scm_async *)scm_must_malloc (sizeof (*async), s_async);
+  async->got_it = 0;
+  async->thunk = thunk;
+  SCM_SETCDR (it, (SCM)async);
+  SCM_SETCAR (it, (SCM)scm_tc16_async);
+  SCM_ALLOW_INTS;
+  return it;
+}
+
+SCM_PROC(s_system_async, "system-async", 1, 0, 0, scm_system_async);
+#ifdef __STDC__
+SCM 
+scm_system_async (SCM thunk)
+#else
+SCM 
+scm_system_async (thunk)
+     SCM thunk;
+#endif
+{
+  SCM it;
+  SCM list;
+
+  it = scm_async (thunk);
+  SCM_NEWCELL (list);
+  SCM_DEFER_INTS;
+  SCM_SETCAR (list, it);
+  SCM_SETCDR (list, scm_asyncs);
+  scm_asyncs = list;
+  SCM_ALLOW_INTS;
+  return it;
+}
+
+SCM_PROC(s_async_mark, "async-mark", 1, 0, 0, scm_async_mark);
+#ifdef __STDC__
+SCM
+scm_async_mark (SCM a)
+#else
+SCM
+scm_async_mark (a)
+     SCM a;
+#endif
+{
+  struct scm_async * it;
+  SCM_ASSERT (SCM_NIMP (a) &&  SCM_ASYNCP (a), a, SCM_ARG1, s_async_mark);
+  it = SCM_ASYNC (a);
+  it->got_it = 1;
+  return SCM_UNSPECIFIED;
+}
+
+
+SCM_PROC(s_system_async_mark, "system-async-mark", 1, 0, 0, scm_system_async_mark);
+#ifdef __STDC__
+SCM
+scm_system_async_mark (SCM a)
+#else
+SCM
+scm_system_async_mark (a)
+     SCM a;
+#endif
+{
+  struct scm_async * it;
+  SCM_ASSERT (SCM_NIMP (a) &&  SCM_ASYNCP (a), a, SCM_ARG1, s_async_mark);
+  it = SCM_ASYNC (a);
+  SCM_REDEFER_INTS;
+  it->got_it = 1;
+  scm_async_rate = 1 + scm_async_rate - scm_async_clock;
+  scm_async_clock = 1;
+  SCM_REALLOW_INTS;
+  return SCM_UNSPECIFIED;
+}
+
+
+SCM_PROC(s_run_asyncs, "run-asyncs", 1, 0, 0, scm_run_asyncs);
+#ifdef __STDC__
+SCM
+scm_run_asyncs (SCM list_of_a)
+#else
+SCM
+scm_run_asyncs (list_of_a)
+     SCM list_of_a;
+#endif
+{
+  SCM pos;
+
+  if (scm_mask_ints)
+    return SCM_BOOL_F;
+  pos = list_of_a;
+  while (pos != SCM_EOL)
+    {
+      SCM a;
+      struct scm_async * it;
+      SCM_ASSERT (SCM_NIMP (pos) && SCM_CONSP (pos), pos, SCM_ARG1, s_run_asyncs);
+      a = SCM_CAR (pos);
+      SCM_ASSERT (SCM_NIMP (a) &&  SCM_ASYNCP (a), a, SCM_ARG1, s_run_asyncs);
+      it = SCM_ASYNC (a);
+      scm_mask_ints = 1;
+      if (it->got_it)
+	{
+	  it->got_it = 0;
+	  scm_apply (it->thunk, SCM_EOL, SCM_EOL);
+	}
+      scm_mask_ints = 0;
+      pos = SCM_CDR (pos);
+    }
+  return SCM_BOOL_T;
+}
+
+
+
+
+SCM_PROC(s_noop, "noop", 0, 0, 1, scm_noop);
+#ifdef __STDC__
+SCM
+scm_noop (SCM args)
+#else
+SCM
+scm_noop (args)
+     SCM args;
+#endif
+{
+  return (SCM_NULLP (args)
+	  ? SCM_BOOL_F
+	  : SCM_CAR (args));
+}
+
+
+
+
+SCM_PROC(s_set_tick_rate, "set-tick-rate", 1, 0, 0, scm_set_tick_rate);
+#ifdef __STDC__
+SCM
+scm_set_tick_rate (SCM n)
+#else
+SCM
+scm_set_tick_rate (n)
+     SCM n;
+#endif
+{
+  unsigned int old_n;
+  SCM_ASSERT (SCM_INUMP (n), n, SCM_ARG1, s_set_tick_rate);
+  old_n = scm_tick_rate;
+  scm_desired_tick_rate = SCM_INUM (n);
+  scm_async_rate = 1 + scm_async_rate - scm_async_clock;
+  scm_async_clock = 1;
+  return SCM_MAKINUM (old_n);
+}
+
+
+
+
+SCM_PROC(s_set_switch_rate, "set-switch-rate", 1, 0, 0, scm_set_switch_rate);
+#ifdef __STDC__
+SCM
+scm_set_switch_rate (SCM n)
+#else
+SCM
+scm_set_switch_rate (n)
+     SCM n;
+#endif
+{
+  unsigned int old_n;
+  SCM_ASSERT (SCM_INUMP (n), n, SCM_ARG1, s_set_switch_rate);
+  old_n = scm_switch_rate;
+  scm_desired_switch_rate = SCM_INUM (n);
+  scm_async_rate = 1 + scm_async_rate - scm_async_clock;
+  scm_async_clock = 1;
+  return SCM_MAKINUM (old_n);
+}
+
+
+
+#ifdef __STDC__
+static SCM
+scm_sys_hup_async_thunk (void)
+#else
+static SCM
+scm_sys_hup_async_thunk ()
+#endif
+{
+  scm_deliver_signal (SCM_HUP_SIGNAL);
+  return SCM_BOOL_F;
+}
+
+#ifdef __STDC__
+static SCM
+scm_sys_int_async_thunk (void)
+#else
+static SCM
+scm_sys_int_async_thunk ()
+#endif
+{
+  scm_deliver_signal (SCM_INT_SIGNAL);
+  return SCM_BOOL_F;
+}
+
+#ifdef __STDC__
+static SCM
+scm_sys_fpe_async_thunk (void)
+#else
+static SCM
+scm_sys_fpe_async_thunk ()
+#endif
+{
+  scm_deliver_signal (SCM_FPE_SIGNAL);
+  return SCM_BOOL_F;
+}
+
+#ifdef __STDC__
+static SCM
+scm_sys_bus_async_thunk (void)
+#else
+static SCM
+scm_sys_bus_async_thunk ()
+#endif
+{
+  scm_deliver_signal (SCM_BUS_SIGNAL);
+  return SCM_BOOL_F;
+}
+
+#ifdef __STDC__
+static SCM
+scm_sys_segv_async_thunk (void)
+#else
+static SCM
+scm_sys_segv_async_thunk ()
+#endif
+{
+  scm_deliver_signal (SCM_SEGV_SIGNAL);
+  return SCM_BOOL_F;
+}
+
+#ifdef __STDC__
+static SCM
+scm_sys_alrm_async_thunk (void)
+#else
+static SCM
+scm_sys_alrm_async_thunk ()
+#endif
+{
+  scm_deliver_signal (SCM_ALRM_SIGNAL);
+  return SCM_BOOL_F;
+}
+
+#ifdef __STDC__
+static SCM
+scm_sys_gc_async_thunk (void)
+#else
+static SCM
+scm_sys_gc_async_thunk ()
+#endif
+{
+  scm_deliver_signal (SCM_GC_SIGNAL);
+  return SCM_BOOL_F;
+}
+
+#ifdef __STDC__
+static SCM
+scm_sys_tick_async_thunk (void)
+#else
+static SCM
+scm_sys_tick_async_thunk ()
+#endif
+{
+  scm_deliver_signal (SCM_TICK_SIGNAL);
+  return SCM_BOOL_F;
+}
+
+
+
+
+
+#ifdef __STDC__
+SCM
+scm_take_signal (int n)
+#else
+SCM
+scm_take_signal (n)
+     int n;
+#endif
+{
+  SCM ignored;
+  if (!scm_ints_disabled)
+    {
+      SCM_NEWCELL (ignored);		/* In case we interrupted SCM_NEWCELL,
+					 * throw out the possibly already allocated
+					 * free cell.
+					 */
+    }
+  scm_system_async_mark (system_signal_asyncs[SCM_SIG_ORD(n)]);
+  return SCM_BOOL_F;
+}
+
+
+
+SCM_PROC(s_unmask_signals, "unmask-signals", 0, 0, 0, scm_unmask_signals);
+#ifdef __STDC__
+SCM
+scm_unmask_signals (void)
+#else
+SCM
+scm_unmask_signals ()
+#endif
+{
+  scm_mask_ints = 0;
+  return SCM_UNSPECIFIED;
+}
+
+
+SCM_PROC(s_mask_signals, "mask-signals", 0, 0, 0, scm_mask_signals);
+#ifdef __STDC__
+SCM
+scm_mask_signals (void)
+#else
+SCM
+scm_mask_signals ()
+#endif
+{
+  scm_mask_ints = 1;
+  return SCM_UNSPECIFIED;
+}
+
+
+
+#ifdef __STDC__
+void
+scm_init_async (void)
+#else
+void
+scm_init_async ()
+#endif
+{
+  SCM a_thunk;
+  scm_tc16_async = scm_newsmob (&async_smob);
+  symbol_signal = SCM_CAR (scm_sysintern ("signal", strlen ("signal")));
+  scm_permanent_object (symbol_signal);
+
+  /* These are in the opposite order of delivery priortity. 
+   *
+   * Error conditions are given low priority:
+   */
+  a_thunk = scm_make_gsubr ("%hup-thunk", 0, 0, 0, scm_sys_hup_async_thunk);
+  system_signal_asyncs[SCM_SIG_ORD(SCM_HUP_SIGNAL)] = scm_system_async (a_thunk);
+  a_thunk = scm_make_gsubr ("%int-thunk", 0, 0, 0, scm_sys_int_async_thunk);
+  system_signal_asyncs[SCM_SIG_ORD(SCM_INT_SIGNAL)] = scm_system_async (a_thunk);
+  a_thunk = scm_make_gsubr ("%fpe-thunk", 0, 0, 0, scm_sys_fpe_async_thunk);
+  system_signal_asyncs[SCM_SIG_ORD(SCM_FPE_SIGNAL)] = scm_system_async (a_thunk);
+  a_thunk = scm_make_gsubr ("%bus-thunk", 0, 0, 0, scm_sys_bus_async_thunk);
+  system_signal_asyncs[SCM_SIG_ORD(SCM_BUS_SIGNAL)] = scm_system_async (a_thunk);
+  a_thunk = scm_make_gsubr ("%segv-thunk", 0, 0, 0, scm_sys_segv_async_thunk);
+  system_signal_asyncs[SCM_SIG_ORD(SCM_SEGV_SIGNAL)] = scm_system_async (a_thunk);
+
+
+  a_thunk = scm_make_gsubr ("%gc-thunk", 0, 0, 0, scm_sys_gc_async_thunk);
+  system_signal_asyncs[SCM_SIG_ORD(SCM_GC_SIGNAL)] = scm_system_async (a_thunk);
+
+  /* Clock and PC driven conditions are given highest priority. */
+  a_thunk = scm_make_gsubr ("%tick-thunk", 0, 0, 0, scm_sys_tick_async_thunk);
+  system_signal_asyncs[SCM_SIG_ORD(SCM_TICK_SIGNAL)] = scm_system_async (a_thunk);
+  a_thunk = scm_make_gsubr ("%alrm-thunk", 0, 0, 0, scm_sys_alrm_async_thunk);
+  system_signal_asyncs[SCM_SIG_ORD(SCM_ALRM_SIGNAL)] = scm_system_async (a_thunk);
+
+  handler_var = scm_sysintern ("signal-handler", strlen ("signal"));
+  SCM_SETCDR (handler_var, SCM_BOOL_F);
+  scm_permanent_object (handler_var);
+#include "async.x"
+}
diff --git a/libguile/async.h b/libguile/async.h
new file mode 100644
index 000000000..2e99025ac
--- /dev/null
+++ b/libguile/async.h
@@ -0,0 +1,91 @@
+/* classes: h_files */
+
+#ifndef ASYNCH
+#define ASYNCH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+
+
+
+
+extern unsigned int scm_async_clock;
+extern unsigned int scm_mask_ints;
+
+
+#ifdef __STDC__
+extern void scm_async_click (void);
+extern void scm_switch (void);
+extern SCM scm_async (SCM thunk);
+extern SCM scm_system_async (SCM thunk);
+extern SCM scm_async_mark (SCM a);
+extern SCM scm_system_async_mark (SCM a);
+extern SCM scm_run_asyncs (SCM list_of_a);
+extern SCM scm_noop (SCM args);
+extern SCM scm_set_tick_rate (SCM n);
+extern SCM scm_set_switch_rate (SCM n);
+extern SCM scm_take_signal (int n);
+extern SCM scm_unmask_signals (void);
+extern SCM scm_mask_signals (void);
+extern void scm_init_async (void);
+
+#else /* STDC */
+extern void scm_async_click ();
+extern void scm_switch ();
+extern SCM scm_async ();
+extern SCM scm_system_async ();
+extern SCM scm_async_mark ();
+extern SCM scm_system_async_mark ();
+extern SCM scm_run_asyncs ();
+extern SCM scm_noop ();
+extern SCM scm_set_tick_rate ();
+extern SCM scm_set_switch_rate ();
+extern SCM scm_take_signal ();
+extern SCM scm_unmask_signals ();
+extern SCM scm_mask_signals ();
+extern void scm_init_async ();
+
+#endif /* STDC */
+
+
+#endif  /* ASYNCH */
diff --git a/libguile/boolean.c b/libguile/boolean.c
new file mode 100644
index 000000000..cc8c63382
--- /dev/null
+++ b/libguile/boolean.c
@@ -0,0 +1,88 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+
+SCM_PROC(s_not, "not", 1, 0, 0, scm_not);
+#ifdef __STDC__
+SCM
+scm_not(SCM x)
+#else
+SCM
+scm_not(x)
+     SCM x;
+#endif
+{
+	return SCM_FALSEP(x) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+
+SCM_PROC(s_boolean_p, "boolean?", 1, 0, 0, scm_boolean_p);
+#ifdef __STDC__
+SCM
+scm_boolean_p(SCM obj)
+#else
+SCM
+scm_boolean_p(obj)
+     SCM obj;
+#endif
+{
+	if (SCM_BOOL_F==obj) return SCM_BOOL_T;
+	if (SCM_BOOL_T==obj) return SCM_BOOL_T;
+	return SCM_BOOL_F;
+}
+
+
+#ifdef __STDC__
+void
+scm_init_boolean (void)
+#else
+void
+scm_init_boolean ()
+#endif
+{
+#include "boolean.x"
+}
+
diff --git a/libguile/boolean.h b/libguile/boolean.h
new file mode 100644
index 000000000..8c9b6a7e7
--- /dev/null
+++ b/libguile/boolean.h
@@ -0,0 +1,76 @@
+/* classes: h_files */
+
+#ifndef BOOLEANH
+#define BOOLEANH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+#include "__scm.h"
+
+
+
+/* Boolean Values 
+ *
+ */ 
+#define SCM_FALSEP(x) 		(SCM_BOOL_F == (x))
+#define SCM_NFALSEP(x) 		(SCM_BOOL_F != (x))
+
+/* SCM_BOOL_NOT returns the other boolean.  
+ * The order of ^s here is important for Borland C++ (!?!?!)
+ */
+#define SCM_BOOL_NOT(x)  ((x) ^ (SCM_BOOL_T ^ SCM_BOOL_F))
+
+
+
+#ifdef __STDC__
+extern SCM scm_not(SCM x);
+extern SCM scm_boolean_p(SCM obj);
+extern void scm_init_boolean (void);
+
+#else /* STDC */
+extern SCM scm_not();
+extern SCM scm_boolean_p();
+extern void scm_init_boolean ();
+
+#endif /* STDC */
+
+
+#endif  /* BOOLEANH */
diff --git a/libguile/chars.c b/libguile/chars.c
new file mode 100644
index 000000000..70ec0ab82
--- /dev/null
+++ b/libguile/chars.c
@@ -0,0 +1,507 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include <ctype.h>
+#include "_scm.h"
+
+
+
+
+
+SCM_PROC(s_char_p, "char?", 1, 0, 0, scm_char_p);
+#ifdef __STDC__
+SCM
+scm_char_p(SCM x)
+#else
+SCM
+scm_char_p(x)
+     SCM x;
+#endif
+{
+  return SCM_ICHRP(x) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+SCM_PROC1 (s_char_eq_p, "char=?", scm_tc7_rpsubr, scm_char_eq_p);
+#ifdef __STDC__
+SCM
+scm_char_eq_p(SCM x, SCM y)
+#else
+SCM
+scm_char_eq_p(x, y)
+     SCM x;
+     SCM y;
+#endif
+{
+  SCM_ASSERT(SCM_ICHRP(x), x, SCM_ARG1, s_char_eq_p);
+  SCM_ASSERT(SCM_ICHRP(y), y, SCM_ARG2, s_char_eq_p);
+  return (SCM_ICHR(x) == SCM_ICHR(y)) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+
+SCM_PROC1 (s_char_less_p, "char<?", scm_tc7_rpsubr, scm_char_less_p);
+#ifdef __STDC__
+SCM
+scm_char_less_p(SCM x, SCM y)
+#else
+SCM
+scm_char_less_p(x, y)
+     SCM x;
+     SCM y;
+#endif
+{
+  SCM_ASSERT(SCM_ICHRP(x), x, SCM_ARG1, s_char_less_p);
+  SCM_ASSERT(SCM_ICHRP(y), y, SCM_ARG2, s_char_less_p);
+  return (SCM_ICHR(x) < SCM_ICHR(y)) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+SCM_PROC1 (s_char_leq_p, "char<=?", scm_tc7_rpsubr, scm_char_leq_p);
+#ifdef __STDC__
+SCM
+scm_char_leq_p(SCM x, SCM y)
+#else
+SCM
+scm_char_leq_p(x, y)
+     SCM x;
+     SCM y;
+#endif
+{
+  SCM_ASSERT(SCM_ICHRP(x), x, SCM_ARG1, s_char_leq_p);
+  SCM_ASSERT(SCM_ICHRP(y), y, SCM_ARG2, s_char_leq_p);
+  return (SCM_ICHR(x) <= SCM_ICHR(y)) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+SCM_PROC1 (s_char_gr_p, "char>?", scm_tc7_rpsubr, scm_char_gr_p);
+#ifdef __STDC__
+SCM
+scm_char_gr_p(SCM x, SCM y)
+#else
+SCM
+scm_char_gr_p(x, y)
+     SCM x;
+     SCM y;
+#endif
+{
+  SCM_ASSERT(SCM_ICHRP(x), x, SCM_ARG1, s_char_gr_p);
+  SCM_ASSERT(SCM_ICHRP(y), y, SCM_ARG2, s_char_gr_p);
+  return (SCM_ICHR(x) > SCM_ICHR(y)) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+SCM_PROC1 (s_char_geq_p, "char>=?", scm_tc7_rpsubr, scm_char_geq_p);
+#ifdef __STDC__
+SCM
+scm_char_geq_p(SCM x, SCM y)
+#else
+SCM
+scm_char_geq_p(x, y)
+     SCM x;
+     SCM y;
+#endif
+{
+  SCM_ASSERT(SCM_ICHRP(x), x, SCM_ARG1, s_char_geq_p);
+  SCM_ASSERT(SCM_ICHRP(y), y, SCM_ARG2, s_char_geq_p);
+  return (SCM_ICHR(x) >= SCM_ICHR(y)) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+SCM_PROC1 (s_char_ci_eq_p, "char-ci=?", scm_tc7_rpsubr, scm_char_ci_eq_p);
+#ifdef __STDC__
+SCM
+scm_char_ci_eq_p(SCM x, SCM y)
+#else
+SCM
+scm_char_ci_eq_p(x, y)
+     SCM x;
+     SCM y;
+#endif
+{
+  SCM_ASSERT(SCM_ICHRP(x), x, SCM_ARG1, s_char_ci_eq_p);
+  SCM_ASSERT(SCM_ICHRP(y), y, SCM_ARG2, s_char_ci_eq_p);
+  return (scm_upcase(SCM_ICHR(x))==scm_upcase(SCM_ICHR(y))) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+SCM_PROC1 (s_char_ci_less_p, "char-ci<?", scm_tc7_rpsubr, scm_char_ci_less_p);
+#ifdef __STDC__
+SCM
+scm_char_ci_less_p(SCM x, SCM y)
+#else
+SCM
+scm_char_ci_less_p(x, y)
+     SCM x;
+     SCM y;
+#endif
+{
+  SCM_ASSERT(SCM_ICHRP(x), x, SCM_ARG1, s_char_ci_less_p);
+  SCM_ASSERT(SCM_ICHRP(y), y, SCM_ARG2, s_char_ci_less_p);
+  return (scm_upcase(SCM_ICHR(x)) < scm_upcase(SCM_ICHR(y))) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+SCM_PROC1 (s_char_ci_leq_p, "char-ci<=?", scm_tc7_rpsubr, scm_char_ci_leq_p);
+#ifdef __STDC__
+SCM
+scm_char_ci_leq_p(SCM x, SCM y)
+#else
+SCM
+scm_char_ci_leq_p(x, y)
+     SCM x;
+     SCM y;
+#endif
+{
+  SCM_ASSERT(SCM_ICHRP(x), x, SCM_ARG1, s_char_ci_leq_p);
+  SCM_ASSERT(SCM_ICHRP(y), y, SCM_ARG2, s_char_ci_leq_p);
+  return (scm_upcase(SCM_ICHR(x)) <= scm_upcase(SCM_ICHR(y))) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+SCM_PROC1 (s_char_ci_gr_p, "char-ci>?", scm_tc7_rpsubr, scm_char_ci_gr_p);
+#ifdef __STDC__
+SCM
+scm_char_ci_gr_p(SCM x, SCM y)
+#else
+SCM
+scm_char_ci_gr_p(x, y)
+     SCM x;
+     SCM y;
+#endif
+{
+  SCM_ASSERT(SCM_ICHRP(x), x, SCM_ARG1, s_char_ci_gr_p);
+  SCM_ASSERT(SCM_ICHRP(y), y, SCM_ARG2, s_char_ci_gr_p);
+  return (scm_upcase(SCM_ICHR(x)) > scm_upcase(SCM_ICHR(y))) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+SCM_PROC1 (s_char_ci_geq_p, "char-ci>=?", scm_tc7_rpsubr, scm_char_ci_geq_p);
+#ifdef __STDC__
+SCM
+scm_char_ci_geq_p(SCM x, SCM y)
+#else
+SCM
+scm_char_ci_geq_p(x, y)
+     SCM x;
+     SCM y;
+#endif
+{
+  SCM_ASSERT(SCM_ICHRP(x), x, SCM_ARG1, s_char_ci_geq_p);
+  SCM_ASSERT(SCM_ICHRP(y), y, SCM_ARG2, s_char_ci_geq_p);
+  return (scm_upcase(SCM_ICHR(x)) >= scm_upcase(SCM_ICHR(y))) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+
+SCM_PROC(s_char_alphabetic_p, "char-alphabetic?", 1, 0, 0, scm_char_alphabetic_p);
+#ifdef __STDC__
+SCM
+scm_char_alphabetic_p(SCM chr)
+#else
+SCM
+scm_char_alphabetic_p(chr)
+     SCM chr;
+#endif
+{
+  SCM_ASSERT(SCM_ICHRP(chr), chr, SCM_ARG1, s_char_alphabetic_p);
+  return (isascii(SCM_ICHR(chr)) && isalpha(SCM_ICHR(chr))) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+SCM_PROC(s_char_numeric_p, "char-numeric?", 1, 0, 0, scm_char_numeric_p);
+#ifdef __STDC__
+SCM
+scm_char_numeric_p(SCM chr)
+#else
+SCM
+scm_char_numeric_p(chr)
+     SCM chr;
+#endif
+{
+  SCM_ASSERT(SCM_ICHRP(chr), chr, SCM_ARG1, s_char_numeric_p);
+  return (isascii(SCM_ICHR(chr)) && isdigit(SCM_ICHR(chr))) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+SCM_PROC(s_char_whitespace_p, "char-whitespace?", 1, 0, 0, scm_char_whitespace_p);
+#ifdef __STDC__
+SCM
+scm_char_whitespace_p(SCM chr)
+#else
+SCM
+scm_char_whitespace_p(chr)
+     SCM chr;
+#endif
+{
+  SCM_ASSERT(SCM_ICHRP(chr), chr, SCM_ARG1, s_char_whitespace_p);
+  return (isascii(SCM_ICHR(chr)) && isspace(SCM_ICHR(chr))) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+
+
+SCM_PROC(s_char_upper_case_p, "char-upper-case?", 1, 0, 0, scm_char_upper_case_p);
+#ifdef __STDC__
+SCM
+scm_char_upper_case_p(SCM chr)
+#else
+SCM
+scm_char_upper_case_p(chr)
+     SCM chr;
+#endif
+{
+  SCM_ASSERT(SCM_ICHRP(chr), chr, SCM_ARG1, s_char_upper_case_p);
+  return (isascii(SCM_ICHR(chr)) && isupper(SCM_ICHR(chr))) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+
+SCM_PROC(s_char_lower_case_p, "char-lower-case?", 1, 0, 0, scm_char_lower_case_p);
+#ifdef __STDC__
+SCM
+scm_char_lower_case_p(SCM chr)
+#else
+SCM
+scm_char_lower_case_p(chr)
+     SCM chr;
+#endif
+{
+  SCM_ASSERT(SCM_ICHRP(chr), chr, SCM_ARG1, s_char_lower_case_p);
+  return (isascii(SCM_ICHR(chr)) && islower(SCM_ICHR(chr))) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+
+
+SCM_PROC (s_char_is_both_p, "char-is-both?", 1, 0, 0, scm_char_is_both_p);
+#ifdef __STDC__
+SCM
+scm_char_is_both_p (SCM chr)
+#else
+SCM
+scm_char_is_both_p (chr)
+     SCM chr;
+#endif
+{
+  SCM_ASSERT(SCM_ICHRP(chr), chr, SCM_ARG1, s_char_upper_case_p);
+  return ((isascii(SCM_ICHR(chr)) && (isupper(SCM_ICHR(chr)) || islower(SCM_ICHR(chr))))
+	  ? SCM_BOOL_T
+	  : SCM_BOOL_F);
+}
+
+
+
+
+SCM_PROC(s_char_to_integer, "char->integer", 1, 0, 0, scm_char_to_integer);
+#ifdef __STDC__
+SCM
+scm_char_to_integer(SCM chr)
+#else
+SCM
+scm_char_to_integer(chr)
+     SCM chr;
+#endif
+{
+  SCM_ASSERT(SCM_ICHRP(chr), chr, SCM_ARG1, s_char_to_integer);
+  return scm_ulong2num((unsigned long)SCM_ICHR(chr));
+}
+
+
+
+SCM_PROC(s_integer_to_char, "integer->char", 1, 0, 0, scm_integer_to_char);
+#ifdef __STDC__
+SCM
+scm_integer_to_char(SCM n)
+#else
+SCM
+scm_integer_to_char(n)
+     SCM n;
+#endif
+{
+  unsigned long ni;
+
+  ni = 0xffff & scm_num2ulong (n, (char *)SCM_ARG1, s_integer_to_char);
+  return SCM_MAKICHR(SCM_INUM(n));
+}
+
+
+SCM_PROC(s_char_upcase, "char-upcase", 1, 0, 0, scm_char_upcase);
+#ifdef __STDC__
+SCM
+scm_char_upcase(SCM chr)
+#else
+SCM
+scm_char_upcase(chr)
+     SCM chr;
+#endif
+{
+  SCM_ASSERT(SCM_ICHRP(chr), chr, SCM_ARG1, s_char_upcase);
+  return SCM_MAKICHR(scm_upcase(SCM_ICHR(chr)));
+}
+
+
+SCM_PROC(s_char_downcase, "char-downcase", 1, 0, 0, scm_char_downcase);
+#ifdef __STDC__
+SCM
+scm_char_downcase(SCM chr)
+#else
+SCM
+scm_char_downcase(chr)
+     SCM chr;
+#endif
+{
+  SCM_ASSERT(SCM_ICHRP(chr), chr, SCM_ARG1, s_char_downcase);
+  return SCM_MAKICHR(scm_downcase(SCM_ICHR(chr)));
+}
+
+
+
+
+
+static unsigned char scm_upcase_table[SCM_CHAR_SCM_CODE_LIMIT];
+static unsigned char scm_downcase_table[SCM_CHAR_SCM_CODE_LIMIT];
+static unsigned char scm_lowers[] = "abcdefghijklmnopqrstuvwxyz";
+static unsigned char scm_uppers[] = "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
+
+#ifdef __STDC__
+void 
+scm_tables_prehistory (void)
+#else
+void 
+scm_tables_prehistory ()
+#endif
+{
+  int i;
+  for (i = 0; i < SCM_CHAR_SCM_CODE_LIMIT; i++)
+    scm_upcase_table[i] = scm_downcase_table[i] = i;
+  for (i = 0; i < sizeof scm_lowers / sizeof (char); i++)
+    {
+      scm_upcase_table[scm_lowers[i]] = scm_uppers[i];
+      scm_downcase_table[scm_uppers[i]] = scm_lowers[i];
+    }
+}
+
+#ifdef __STDC__
+int
+scm_upcase (unsigned int c)
+#else
+int
+scm_upcase (c)
+     unsigned int c;
+#endif
+{
+  if (c < sizeof (scm_upcase_table))
+    return scm_upcase_table[c];
+  else
+    return c;
+}
+
+#ifdef __STDC__
+int
+scm_downcase (unsigned int c)
+#else
+int
+scm_downcase (c)
+     unsigned int c;
+#endif
+{
+  if (c < sizeof (scm_downcase_table))
+    return scm_downcase_table[c];
+  else
+    return c;
+}
+
+
+#ifdef _DCC
+# define ASCII
+#else
+# if (('\n'=='\025') && (' '=='\100') && ('a'=='\201') && ('A'=='\301'))
+#  define EBCDIC
+# endif /*  (('\n'=='\025') && (' '=='\100') && ('a'=='\201') && ('A'=='\301')) */
+# if (('\n'=='\012') && (' '=='\040') && ('a'=='\141') && ('A'=='\101'))
+#  define ASCII
+# endif /*  (('\n'=='\012') && (' '=='\040') && ('a'=='\141') && ('A'=='\101')) */
+#endif /* def _DCC */
+
+
+#ifdef EBCDIC
+char *scm_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", scm_s_newline, "tab", "backspace", "return", "page", "null"};
+
+char scm_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 *scm_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", "newline", "tab", "backspace", "return", "page", "null", "del"};
+char scm_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 */
+
+int scm_n_charnames = sizeof (scm_charnames) / sizeof (char *);
+
+
+
+
+#ifdef __STDC__
+void
+scm_init_chars (void)
+#else
+void
+scm_init_chars ()
+#endif
+{
+#include "chars.x"
+}
+
diff --git a/libguile/chars.h b/libguile/chars.h
new file mode 100644
index 000000000..83afcfa7e
--- /dev/null
+++ b/libguile/chars.h
@@ -0,0 +1,126 @@
+/* classes: h_files */
+
+#ifndef SCM_CHARSH
+#define SCM_CHARSH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+
+
+/* Immediate Characters
+ */
+#define SCM_ICHRP(x)	(SCM_ITAG8(x) == scm_tc8_char)
+#define SCM_ICHR(x)	((unsigned int)SCM_ITAG8_DATA(x))
+#define SCM_MAKICHR(x)	SCM_MAKE_ITAG8(x, scm_tc8_char)
+
+
+
+extern char *scm_charnames[];
+extern int scm_n_charnames;
+extern char scm_charnums[];
+
+
+#ifdef __STDC__
+extern SCM scm_char_p(SCM x);
+extern SCM scm_char_eq_p(SCM x, SCM y);
+extern SCM scm_char_less_p(SCM x, SCM y);
+extern SCM scm_char_leq_p(SCM x, SCM y);
+extern SCM scm_char_gr_p(SCM x, SCM y);
+extern SCM scm_char_geq_p(SCM x, SCM y);
+extern SCM scm_char_ci_eq_p(SCM x, SCM y);
+extern SCM scm_char_ci_less_p(SCM x, SCM y);
+extern SCM scm_char_ci_leq_p(SCM x, SCM y);
+extern SCM scm_char_ci_gr_p(SCM x, SCM y);
+extern SCM scm_char_ci_geq_p(SCM x, SCM y);
+extern SCM scm_char_alphabetic_p(SCM chr);
+extern SCM scm_char_numeric_p(SCM chr);
+extern SCM scm_char_whitespace_p(SCM chr);
+extern SCM scm_char_upper_case_p(SCM chr);
+extern SCM scm_char_lower_case_p(SCM chr);
+extern SCM scm_char_is_both_p (SCM chr);
+extern SCM scm_char_to_integer(SCM chr);
+extern SCM scm_integer_to_char(SCM n);
+extern SCM scm_char_upcase(SCM chr);
+extern SCM scm_char_downcase(SCM chr);
+extern void scm_tables_prehistory (void);
+extern int scm_upcase (unsigned int c);
+extern int scm_downcase (unsigned int c);
+extern void scm_init_chars (void);
+
+#else /* STDC */
+extern SCM scm_char_p();
+extern SCM scm_char_eq_p();
+extern SCM scm_char_less_p();
+extern SCM scm_char_leq_p();
+extern SCM scm_char_gr_p();
+extern SCM scm_char_geq_p();
+extern SCM scm_char_ci_eq_p();
+extern SCM scm_char_ci_less_p();
+extern SCM scm_char_ci_leq_p();
+extern SCM scm_char_ci_gr_p();
+extern SCM scm_char_ci_geq_p();
+extern SCM scm_char_alphabetic_p();
+extern SCM scm_char_numeric_p();
+extern SCM scm_char_whitespace_p();
+extern SCM scm_char_upper_case_p();
+extern SCM scm_char_lower_case_p();
+extern SCM scm_char_is_both_p ();
+extern SCM scm_char_to_integer();
+extern SCM scm_integer_to_char();
+extern SCM scm_char_upcase();
+extern SCM scm_char_downcase();
+extern void scm_tables_prehistory ();
+extern int scm_upcase ();
+extern int scm_downcase ();
+extern void scm_init_chars ();
+
+#endif /* STDC */
+
+
+
+
+
+
+
+
+#endif  /* SCM_CHARSH */
diff --git a/libguile/configure b/libguile/configure
new file mode 100755
index 000000000..83e29e67b
--- /dev/null
+++ b/libguile/configure
@@ -0,0 +1,1994 @@
+#! /bin/sh
+
+# Guess values for system-dependent variables and create Makefiles.
+# Generated automatically using autoconf version 2.9 
+# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
+#
+# This configure script is free software; the Free Software Foundation
+# gives unlimited permission to copy, distribute and modify it.
+
+# Defaults:
+ac_help=
+ac_default_prefix=/usr/local
+# Any additions from configure.in:
+
+# Initialize some variables set by options.
+# The variables have the same names as the options, with
+# dashes changed to underlines.
+build=NONE
+cache_file=./config.cache
+exec_prefix=NONE
+host=NONE
+no_create=
+nonopt=NONE
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+srcdir=
+target=NONE
+verbose=
+x_includes=NONE
+x_libraries=NONE
+bindir='${exec_prefix}/bin'
+sbindir='${exec_prefix}/sbin'
+libexecdir='${exec_prefix}/libexec'
+datadir='${prefix}/share'
+sysconfdir='${prefix}/etc'
+sharedstatedir='${prefix}/com'
+localstatedir='${prefix}/var'
+libdir='${exec_prefix}/lib'
+includedir='${prefix}/include'
+oldincludedir='/usr/include'
+infodir='${prefix}/info'
+mandir='${prefix}/man'
+
+# Initialize some other variables.
+subdirs=
+MFLAGS= MAKEFLAGS=
+
+ac_prev=
+for ac_option
+do
+
+  # If the previous option needs an argument, assign it.
+  if test -n "$ac_prev"; then
+    eval "$ac_prev=\$ac_option"
+    ac_prev=
+    continue
+  fi
+
+  case "$ac_option" in
+  -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
+  *) ac_optarg= ;;
+  esac
+
+  # Accept the important Cygnus configure options, so we can diagnose typos.
+
+  case "$ac_option" in
+
+  -bindir | --bindir | --bindi | --bind | --bin | --bi)
+    ac_prev=bindir ;;
+  -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
+    bindir="$ac_optarg" ;;
+
+  -build | --build | --buil | --bui | --bu)
+    ac_prev=build ;;
+  -build=* | --build=* | --buil=* | --bui=* | --bu=*)
+    build="$ac_optarg" ;;
+
+  -cache-file | --cache-file | --cache-fil | --cache-fi \
+  | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+    ac_prev=cache_file ;;
+  -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+  | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+    cache_file="$ac_optarg" ;;
+
+  -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
+    ac_prev=datadir ;;
+  -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
+  | --da=*)
+    datadir="$ac_optarg" ;;
+
+  -disable-* | --disable-*)
+    ac_feature=`echo $ac_option|sed -e 's/-*disable-//'`
+    # Reject names that are not valid shell variable names.
+    if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then
+      { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+    fi
+    ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+    eval "enable_${ac_feature}=no" ;;
+
+  -enable-* | --enable-*)
+    ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'`
+    # Reject names that are not valid shell variable names.
+    if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then
+      { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+    fi
+    ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+    case "$ac_option" in
+      *=*) ;;
+      *) ac_optarg=yes ;;
+    esac
+    eval "enable_${ac_feature}='$ac_optarg'" ;;
+
+  -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
+  | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
+  | --exec | --exe | --ex)
+    ac_prev=exec_prefix ;;
+  -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
+  | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
+  | --exec=* | --exe=* | --ex=*)
+    exec_prefix="$ac_optarg" ;;
+
+  -gas | --gas | --ga | --g)
+    # Obsolete; use --with-gas.
+    with_gas=yes ;;
+
+  -help | --help | --hel | --he)
+    # Omit some internal or obsolete options to make the list less imposing.
+    # This message is too long to be a string in the A/UX 3.1 sh.
+    cat << EOF
+Usage: configure [options] [host]
+Options: [defaults in brackets after descriptions]
+Configuration:
+  --cache-file=FILE       cache test results in FILE
+  --help                  print this message
+  --no-create             do not create output files
+  --quiet, --silent       do not print \`checking...' messages
+  --version               print the version of autoconf that created configure
+Directory and file names:
+  --prefix=PREFIX         install architecture-independent files in PREFIX
+                          [$ac_default_prefix]
+  --exec-prefix=EPREFIX   install architecture-dependent files in EPREFIX
+                          [same as prefix]
+  --bindir=DIR            user executables in DIR [EPREFIX/bin]
+  --sbindir=DIR           system admin executables in DIR [EPREFIX/sbin]
+  --libexecdir=DIR        program executables in DIR [EPREFIX/libexec]
+  --datadir=DIR           read-only architecture-independent data in DIR
+                          [PREFIX/share]
+  --sysconfdir=DIR        read-only single-machine data in DIR [PREFIX/etc]
+  --sharedstatedir=DIR    modifiable architecture-independent data in DIR
+                          [PREFIX/com]
+  --localstatedir=DIR     modifiable single-machine data in DIR [PREFIX/var]
+  --libdir=DIR            object code libraries in DIR [EPREFIX/lib]
+  --includedir=DIR        C header files in DIR [PREFIX/include]
+  --oldincludedir=DIR     C header files for non-gcc in DIR [/usr/include]
+  --infodir=DIR           info documentation in DIR [PREFIX/info]
+  --mandir=DIR            man documentation in DIR [PREFIX/man]
+  --srcdir=DIR            find the sources in DIR [configure dir or ..]
+  --program-prefix=PREFIX prepend PREFIX to installed program names
+  --program-suffix=SUFFIX append SUFFIX to installed program names
+  --program-transform-name=PROGRAM
+                          run sed PROGRAM on installed program names
+EOF
+    cat << EOF
+Host type:
+  --build=BUILD           configure for building on BUILD [BUILD=HOST]
+  --host=HOST             configure for HOST [guessed]
+  --target=TARGET         configure for TARGET [TARGET=HOST]
+Features and packages:
+  --disable-FEATURE       do not include FEATURE (same as --enable-FEATURE=no)
+  --enable-FEATURE[=ARG]  include FEATURE [ARG=yes]
+  --with-PACKAGE[=ARG]    use PACKAGE [ARG=yes]
+  --without-PACKAGE       do not use PACKAGE (same as --with-PACKAGE=no)
+  --x-includes=DIR        X include files are in DIR
+  --x-libraries=DIR       X library files are in DIR
+EOF
+    if test -n "$ac_help"; then
+      echo "--enable and --with options recognized:$ac_help"
+    fi
+    exit 0 ;;
+
+  -host | --host | --hos | --ho)
+    ac_prev=host ;;
+  -host=* | --host=* | --hos=* | --ho=*)
+    host="$ac_optarg" ;;
+
+  -includedir | --includedir | --includedi | --included | --include \
+  | --includ | --inclu | --incl | --inc)
+    ac_prev=includedir ;;
+  -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
+  | --includ=* | --inclu=* | --incl=* | --inc=*)
+    includedir="$ac_optarg" ;;
+
+  -infodir | --infodir | --infodi | --infod | --info | --inf)
+    ac_prev=infodir ;;
+  -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
+    infodir="$ac_optarg" ;;
+
+  -libdir | --libdir | --libdi | --libd)
+    ac_prev=libdir ;;
+  -libdir=* | --libdir=* | --libdi=* | --libd=*)
+    libdir="$ac_optarg" ;;
+
+  -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
+  | --libexe | --libex | --libe)
+    ac_prev=libexecdir ;;
+  -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
+  | --libexe=* | --libex=* | --libe=*)
+    libexecdir="$ac_optarg" ;;
+
+  -localstatedir | --localstatedir | --localstatedi | --localstated \
+  | --localstate | --localstat | --localsta | --localst \
+  | --locals | --local | --loca | --loc | --lo)
+    ac_prev=localstatedir ;;
+  -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
+  | --localstate=* | --localstat=* | --localsta=* | --localst=* \
+  | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
+    localstatedir="$ac_optarg" ;;
+
+  -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
+    ac_prev=mandir ;;
+  -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
+    mandir="$ac_optarg" ;;
+
+  -nfp | --nfp | --nf)
+    # Obsolete; use --without-fp.
+    with_fp=no ;;
+
+  -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+  | --no-cr | --no-c)
+    no_create=yes ;;
+
+  -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+  | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
+    no_recursion=yes ;;
+
+  -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
+  | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
+  | --oldin | --oldi | --old | --ol | --o)
+    ac_prev=oldincludedir ;;
+  -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
+  | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
+  | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
+    oldincludedir="$ac_optarg" ;;
+
+  -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+    ac_prev=prefix ;;
+  -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+    prefix="$ac_optarg" ;;
+
+  -program-prefix | --program-prefix | --program-prefi | --program-pref \
+  | --program-pre | --program-pr | --program-p)
+    ac_prev=program_prefix ;;
+  -program-prefix=* | --program-prefix=* | --program-prefi=* \
+  | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
+    program_prefix="$ac_optarg" ;;
+
+  -program-suffix | --program-suffix | --program-suffi | --program-suff \
+  | --program-suf | --program-su | --program-s)
+    ac_prev=program_suffix ;;
+  -program-suffix=* | --program-suffix=* | --program-suffi=* \
+  | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
+    program_suffix="$ac_optarg" ;;
+
+  -program-transform-name | --program-transform-name \
+  | --program-transform-nam | --program-transform-na \
+  | --program-transform-n | --program-transform- \
+  | --program-transform | --program-transfor \
+  | --program-transfo | --program-transf \
+  | --program-trans | --program-tran \
+  | --progr-tra | --program-tr | --program-t)
+    ac_prev=program_transform_name ;;
+  -program-transform-name=* | --program-transform-name=* \
+  | --program-transform-nam=* | --program-transform-na=* \
+  | --program-transform-n=* | --program-transform-=* \
+  | --program-transform=* | --program-transfor=* \
+  | --program-transfo=* | --program-transf=* \
+  | --program-trans=* | --program-tran=* \
+  | --progr-tra=* | --program-tr=* | --program-t=*)
+    program_transform_name="$ac_optarg" ;;
+
+  -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+  | -silent | --silent | --silen | --sile | --sil)
+    silent=yes ;;
+
+  -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
+    ac_prev=sbindir ;;
+  -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
+  | --sbi=* | --sb=*)
+    sbindir="$ac_optarg" ;;
+
+  -sharedstatedir | --sharedstatedir | --sharedstatedi \
+  | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
+  | --sharedst | --shareds | --shared | --share | --shar \
+  | --sha | --sh)
+    ac_prev=sharedstatedir ;;
+  -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
+  | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
+  | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
+  | --sha=* | --sh=*)
+    sharedstatedir="$ac_optarg" ;;
+
+  -site | --site | --sit)
+    ac_prev=site ;;
+  -site=* | --site=* | --sit=*)
+    site="$ac_optarg" ;;
+
+  -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+    ac_prev=srcdir ;;
+  -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+    srcdir="$ac_optarg" ;;
+
+  -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
+  | --syscon | --sysco | --sysc | --sys | --sy)
+    ac_prev=sysconfdir ;;
+  -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
+  | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
+    sysconfdir="$ac_optarg" ;;
+
+  -target | --target | --targe | --targ | --tar | --ta | --t)
+    ac_prev=target ;;
+  -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+    target="$ac_optarg" ;;
+
+  -v | -verbose | --verbose | --verbos | --verbo | --verb)
+    verbose=yes ;;
+
+  -version | --version | --versio | --versi | --vers)
+    echo "configure generated by autoconf version 2.9"
+    exit 0 ;;
+
+  -with-* | --with-*)
+    ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'`
+    # Reject names that are not valid shell variable names.
+    if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then
+      { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+    fi
+    ac_package=`echo $ac_package| sed 's/-/_/g'`
+    case "$ac_option" in
+      *=*) ;;
+      *) ac_optarg=yes ;;
+    esac
+    eval "with_${ac_package}='$ac_optarg'" ;;
+
+  -without-* | --without-*)
+    ac_package=`echo $ac_option|sed -e 's/-*without-//'`
+    # Reject names that are not valid shell variable names.
+    if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then
+      { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+    fi
+    ac_package=`echo $ac_package| sed 's/-/_/g'`
+    eval "with_${ac_package}=no" ;;
+
+  --x)
+    # Obsolete; use --with-x.
+    with_x=yes ;;
+
+  -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
+  | --x-incl | --x-inc | --x-in | --x-i)
+    ac_prev=x_includes ;;
+  -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
+  | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
+    x_includes="$ac_optarg" ;;
+
+  -x-libraries | --x-libraries | --x-librarie | --x-librari \
+  | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
+    ac_prev=x_libraries ;;
+  -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
+  | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
+    x_libraries="$ac_optarg" ;;
+
+  -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; }
+    ;;
+
+  *)
+    if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then
+      echo "configure: warning: $ac_option: invalid host type" 1>&2
+    fi
+    if test "x$nonopt" != xNONE; then
+      { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; }
+    fi
+    nonopt="$ac_option"
+    ;;
+
+  esac
+done
+
+if test -n "$ac_prev"; then
+  { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; }
+fi
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+# File descriptor usage:
+# 0 standard input
+# 1 file creation
+# 2 errors and warnings
+# 3 some systems may open it to /dev/tty
+# 4 used on the Kubota Titan
+# 6 checking for... messages and results
+# 5 compiler messages saved in config.log
+if test "$silent" = yes; then
+  exec 6>/dev/null
+else
+  exec 6>&1
+fi
+exec 5>./config.log
+
+echo "\
+This file contains any messages produced by compilers while
+running configure, to aid debugging if configure makes a mistake.
+" 1>&5
+
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Also quote any args containing shell metacharacters.
+ac_configure_args=
+for ac_arg
+do
+  case "$ac_arg" in
+  -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+  | --no-cr | --no-c) ;;
+  -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+  | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;;
+  *" "*|*"	"*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*)
+  ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+  *) ac_configure_args="$ac_configure_args $ac_arg" ;;
+  esac
+done
+
+# NLS nuisances.
+# Only set LANG and LC_ALL to C if already set.
+# These must not be set unconditionally because not all systems understand
+# e.g. LANG=C (notably SCO).
+if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi
+if test "${LANG+set}"   = set; then LANG=C;   export LANG;   fi
+
+# confdefs.h avoids OS command line length limits that DEFS can exceed.
+rm -rf conftest* confdefs.h
+# AIX cpp loses on an empty file, so make sure it contains at least a newline.
+echo > confdefs.h
+
+# A filename unique to this package, relative to the directory that
+# configure is in, which we can look for to find out if srcdir is correct.
+ac_unique_file=eval.c
+
+# Find the source files, if location was not specified.
+if test -z "$srcdir"; then
+  ac_srcdir_defaulted=yes
+  # Try the directory containing this script, then its parent.
+  ac_prog=$0
+  ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'`
+  test "x$ac_confdir" = "x$ac_prog" && ac_confdir=.
+  srcdir=$ac_confdir
+  if test ! -r $srcdir/$ac_unique_file; then
+    srcdir=..
+  fi
+else
+  ac_srcdir_defaulted=no
+fi
+if test ! -r $srcdir/$ac_unique_file; then
+  if test "$ac_srcdir_defaulted" = yes; then
+    { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; }
+  else
+    { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; }
+  fi
+fi
+srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
+
+# Prefer explicitly selected file to automatically selected ones.
+if test -z "$CONFIG_SITE"; then
+  if test "x$prefix" != xNONE; then
+    CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+  else
+    CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+  fi
+fi
+for ac_site_file in $CONFIG_SITE; do
+  if test -r "$ac_site_file"; then
+    echo "loading site script $ac_site_file"
+    . "$ac_site_file"
+  fi
+done
+
+if test -r "$cache_file"; then
+  echo "loading cache $cache_file"
+  . $cache_file
+else
+  echo "creating cache $cache_file"
+  > $cache_file
+fi
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+
+if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
+  # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu.
+  if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
+    ac_n= ac_c='
+' ac_t='	'
+  else
+    ac_n=-n ac_c= ac_t=
+  fi
+else
+  ac_n= ac_c='\c' ac_t=
+fi
+
+
+
+
+. $srcdir/../GUILE-VERSION
+
+test -z "$CFLAGS" && CFLAGS=-g
+test -z "$LDFLAGS" && LDFLAGS=-g
+
+# Extract the first word of "gcc", so it can be a program name with args.
+set dummy gcc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS="${IFS}:"
+  for ac_dir in $PATH; do
+    test -z "$ac_dir" && ac_dir=.
+    if test -f $ac_dir/$ac_word; then
+      ac_cv_prog_CC="gcc"
+      break
+    fi
+  done
+  IFS="$ac_save_ifs"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+  echo "$ac_t""$CC" 1>&6
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+if test -z "$CC"; then
+  # Extract the first word of "cc", so it can be a program name with args.
+set dummy cc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS="${IFS}:"
+  ac_prog_rejected=no
+  for ac_dir in $PATH; do
+    test -z "$ac_dir" && ac_dir=.
+    if test -f $ac_dir/$ac_word; then
+      if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then
+        ac_prog_rejected=yes
+	continue
+      fi
+      ac_cv_prog_CC="cc"
+      break
+    fi
+  done
+  IFS="$ac_save_ifs"
+if test $ac_prog_rejected = yes; then
+  # We found a bogon in the path, so make sure we never use it.
+  set dummy $ac_cv_prog_CC
+  shift
+  if test $# -gt 0; then
+    # We chose a different compiler from the bogus one.
+    # However, it has the same basename, so the bogon will be chosen
+    # first if we set CC to just the basename; use the full file name.
+    shift
+    set dummy "$ac_dir/$ac_word" "$@"
+    shift
+    ac_cv_prog_CC="$@"
+  fi
+fi
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+  echo "$ac_t""$CC" 1>&6
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+  test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; }
+fi
+
+echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6
+if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.c <<EOF
+#ifdef __GNUC__
+  yes;
+#endif
+EOF
+if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:609: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
+  ac_cv_prog_gcc=yes
+else
+  ac_cv_prog_gcc=no
+fi
+fi
+
+echo "$ac_t""$ac_cv_prog_gcc" 1>&6
+if test $ac_cv_prog_gcc = yes; then
+  GCC=yes
+  if test "${CFLAGS+set}" != set; then
+    echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6
+if eval "test \"`echo '$''{'ac_cv_prog_gcc_g'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  echo 'void f(){}' > conftest.c
+if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then
+  ac_cv_prog_gcc_g=yes
+else
+  ac_cv_prog_gcc_g=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_prog_gcc_g" 1>&6
+    if test $ac_cv_prog_gcc_g = yes; then
+      CFLAGS="-g -O"
+    else
+      CFLAGS="-O"
+    fi
+  fi
+else
+  GCC=
+  test "${CFLAGS+set}" = set || CFLAGS="-g"
+fi
+
+echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6
+# On Suns, sometimes $CPP names a directory.
+if test -n "$CPP" && test -d "$CPP"; then
+  CPP=
+fi
+if test -z "$CPP"; then
+if eval "test \"`echo '$''{'ac_cv_prog_CPP'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+    # This must be in double quotes, not single quotes, because CPP may get
+  # substituted into the Makefile and "${CC-cc}" will confuse make.
+  CPP="${CC-cc} -E"
+  # On the NeXT, cc -E runs the code through the compiler's parser,
+  # not just through cpp.
+  cat > conftest.$ac_ext <<EOF
+#line 661 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:667: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+if test -z "$ac_err"; then
+  :
+else
+  echo "$ac_err" >&5
+  rm -rf conftest*
+  CPP="${CC-cc} -E -traditional-cpp"
+  cat > conftest.$ac_ext <<EOF
+#line 676 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:682: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+if test -z "$ac_err"; then
+  :
+else
+  echo "$ac_err" >&5
+  rm -rf conftest*
+  CPP=/lib/cpp
+fi
+rm -f conftest*
+fi
+rm -f conftest*
+  ac_cv_prog_CPP="$CPP"
+fi
+  CPP="$ac_cv_prog_CPP"
+else
+  ac_cv_prog_CPP="$CPP"
+fi
+echo "$ac_t""$CPP" 1>&6
+
+# Extract the first word of "ranlib", so it can be a program name with args.
+set dummy ranlib; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  if test -n "$RANLIB"; then
+  ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
+else
+  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS="${IFS}:"
+  for ac_dir in $PATH; do
+    test -z "$ac_dir" && ac_dir=.
+    if test -f $ac_dir/$ac_word; then
+      ac_cv_prog_RANLIB="ranlib"
+      break
+    fi
+  done
+  IFS="$ac_save_ifs"
+  test -z "$ac_cv_prog_RANLIB" && ac_cv_prog_RANLIB=":"
+fi
+fi
+RANLIB="$ac_cv_prog_RANLIB"
+if test -n "$RANLIB"; then
+  echo "$ac_t""$RANLIB" 1>&6
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+
+echo $ac_n "checking for AIX""... $ac_c" 1>&6
+cat > conftest.$ac_ext <<EOF
+#line 733 "configure"
+#include "confdefs.h"
+#ifdef _AIX
+  yes
+#endif
+
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  egrep "yes" >/dev/null 2>&1; then
+  rm -rf conftest*
+  echo "$ac_t""yes" 1>&6; cat >> confdefs.h <<\EOF
+#define _ALL_SOURCE 1
+EOF
+
+else
+  rm -rf conftest*
+  echo "$ac_t""no" 1>&6
+fi
+rm -f conftest*
+
+
+echo $ac_n "checking for POSIXized ISC""... $ac_c" 1>&6
+if test -d /etc/conf/kconfig.d &&
+  grep _POSIX_VERSION /usr/include/sys/unistd.h >/dev/null 2>&1
+then
+  echo "$ac_t""yes" 1>&6
+  ISC=yes # If later tests want to check for ISC.
+  cat >> confdefs.h <<\EOF
+#define _POSIX_SOURCE 1
+EOF
+
+  if test "$GCC" = yes; then
+    CC="$CC -posix"
+  else
+    CC="$CC -Xp"
+  fi
+else
+  echo "$ac_t""no" 1>&6
+  ISC=
+fi
+
+ac_safe=`echo "minix/config.h" | tr './\055' '___'`
+echo $ac_n "checking for minix/config.h""... $ac_c" 1>&6
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 780 "configure"
+#include "confdefs.h"
+#include <minix/config.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:785: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+if test -z "$ac_err"; then
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=yes"
+else
+  echo "$ac_err" >&5
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  MINIX=yes
+else
+  echo "$ac_t""no" 1>&6
+MINIX=
+fi
+
+if test "$MINIX" = yes; then
+  cat >> confdefs.h <<\EOF
+#define _POSIX_SOURCE 1
+EOF
+
+  cat >> confdefs.h <<\EOF
+#define _POSIX_1_SOURCE 2
+EOF
+
+  cat >> confdefs.h <<\EOF
+#define _MINIX 1
+EOF
+
+fi
+
+
+echo $ac_n "checking for working const""... $ac_c" 1>&6
+if eval "test \"`echo '$''{'ac_cv_c_const'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 826 "configure"
+#include "confdefs.h"
+
+int main() { return 0; }
+int t() {
+
+/* Ultrix mips cc rejects this.  */
+typedef int charset[2]; const charset x;
+/* SunOS 4.1.1 cc rejects this.  */
+char const *const *ccp;
+char **p;
+/* NEC SVR4.0.2 mips cc rejects this.  */
+struct point {int x, y;};
+static struct point const zero = {0,0};
+/* AIX XL C 1.02.0.0 rejects this.
+   It does not let you subtract one const X* pointer from another in an arm
+   of an if-expression whose if-part is not a constant expression */
+const char *g = "string";
+ccp = &g + (g ? g-g : 0);
+/* HPUX 7.0 cc rejects these. */
+++ccp;
+p = (char**) ccp;
+ccp = (char const *const *) p;
+{ /* SCO 3.2v4 cc rejects this.  */
+  char *t;
+  char const *s = 0 ? (char *) 0 : (char const *) 0;
+
+  *t++ = 0;
+}
+{ /* Someone thinks the Sun supposedly-ANSI compiler will reject this.  */
+  int x[] = {25, 17};
+  const int *foo = &x[0];
+  ++foo;
+}
+{ /* Sun SC1.0 ANSI compiler rejects this -- but not the above. */
+  typedef const int *iptr;
+  iptr p = 0;
+  ++p;
+}
+{ /* AIX XL C 1.02.0.0 rejects this saying
+     "k.c", line 2.27: 1506-025 (S) Operand must be a modifiable lvalue. */
+  struct s { int j; const int *ap[3]; };
+  struct s *b; b->j = 5;
+}
+{ /* ULTRIX-32 V3.1 (Rev 9) vcc rejects this */
+  const int foo = 10;
+}
+
+; return 0; }
+EOF
+if { (eval echo configure:876: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  ac_cv_c_const=yes
+else
+  rm -rf conftest*
+  ac_cv_c_const=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_c_const" 1>&6
+if test $ac_cv_c_const = no; then
+  cat >> confdefs.h <<\EOF
+#define const 
+EOF
+
+fi
+
+
+# If we cannot run a trivial program, we must be cross compiling.
+echo $ac_n "checking whether cross-compiling""... $ac_c" 1>&6
+if eval "test \"`echo '$''{'ac_cv_c_cross'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  if test "$cross_compiling" = yes; then
+  ac_cv_c_cross=yes
+else
+cat > conftest.$ac_ext <<EOF
+#line 905 "configure"
+#include "confdefs.h"
+main(){return(0);}
+EOF
+{ (eval echo configure:909: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }
+if test -s conftest && (./conftest; exit) 2>/dev/null; then
+  ac_cv_c_cross=no
+else
+  ac_cv_c_cross=yes
+fi
+fi
+rm -fr conftest*
+fi
+
+echo "$ac_t""$ac_cv_c_cross" 1>&6
+cross_compiling=$ac_cv_c_cross
+
+echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6
+if eval "test \"`echo '$''{'ac_cv_header_stdc'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 927 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+#include <stdarg.h>
+#include <string.h>
+#include <float.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:935: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+if test -z "$ac_err"; then
+  rm -rf conftest*
+  ac_cv_header_stdc=yes
+else
+  echo "$ac_err" >&5
+  rm -rf conftest*
+  ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+if test $ac_cv_header_stdc = yes; then
+  # SunOS 4.x string.h does not declare mem*, contrary to ANSI.
+cat > conftest.$ac_ext <<EOF
+#line 950 "configure"
+#include "confdefs.h"
+#include <string.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  egrep "memchr" >/dev/null 2>&1; then
+  :
+else
+  rm -rf conftest*
+  ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+if test $ac_cv_header_stdc = yes; then
+  # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.
+cat > conftest.$ac_ext <<EOF
+#line 968 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  egrep "free" >/dev/null 2>&1; then
+  :
+else
+  rm -rf conftest*
+  ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+if test $ac_cv_header_stdc = yes; then
+  # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.
+if test "$cross_compiling" = yes; then
+  :
+else
+cat > conftest.$ac_ext <<EOF
+#line 989 "configure"
+#include "confdefs.h"
+#include <ctype.h>
+#define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
+#define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
+#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))
+int main () { int i; for (i = 0; i < 256; i++)
+if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) exit(2);
+exit (0); }
+
+EOF
+{ (eval echo configure:1000: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }
+if test -s conftest && (./conftest; exit) 2>/dev/null; then
+  :
+else
+  ac_cv_header_stdc=no
+fi
+fi
+rm -fr conftest*
+fi
+fi
+
+echo "$ac_t""$ac_cv_header_stdc" 1>&6
+if test $ac_cv_header_stdc = yes; then
+  cat >> confdefs.h <<\EOF
+#define STDC_HEADERS 1
+EOF
+
+fi
+
+ac_header_dirent=no
+for ac_hdr in dirent.h sys/ndir.h sys/dir.h ndir.h
+do
+ac_safe=`echo "$ac_hdr" | tr './\055' '___'`
+echo $ac_n "checking for $ac_hdr that defines DIR""... $ac_c" 1>&6
+if eval "test \"`echo '$''{'ac_cv_header_dirent_$ac_safe'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1028 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <$ac_hdr>
+int main() { return 0; }
+int t() {
+DIR *dirp = 0;
+; return 0; }
+EOF
+if { (eval echo configure:1037: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  eval "ac_cv_header_dirent_$ac_safe=yes"
+else
+  rm -rf conftest*
+  eval "ac_cv_header_dirent_$ac_safe=no"
+fi
+rm -f conftest*
+
+fi
+if eval "test \"`echo '$ac_cv_header_dirent_'$ac_safe`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+    ac_tr_hdr=HAVE_`echo $ac_hdr | tr 'abcdedfghijklmnopqrstuvwxyz./\055' 'ABCDEDFGHIJKLMNOPQRSTUVWXYZ___'`
+  cat >> confdefs.h <<EOF
+#define $ac_tr_hdr 1
+EOF
+ ac_header_dirent=$ac_hdr; break
+else
+  echo "$ac_t""no" 1>&6
+fi
+done
+# Two versions of opendir et al. are in -ldir and -lx on SCO Xenix.
+if test $ac_header_dirent = dirent.h; then
+echo $ac_n "checking for -ldir""... $ac_c" 1>&6
+ac_lib_var=`echo dir_opendir | tr '.-/+' '___p'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  ac_save_LIBS="$LIBS"
+LIBS="-ldir  $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1068 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error.  */
+char opendir();
+
+int main() { return 0; }
+int t() {
+opendir()
+; return 0; }
+EOF
+if { (eval echo configure:1078: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then
+  rm -rf conftest*
+  eval "ac_cv_lib_$ac_lib_var=yes"
+else
+  rm -rf conftest*
+  eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  LIBS="$LIBS -ldir"
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+else
+echo $ac_n "checking for -lx""... $ac_c" 1>&6
+ac_lib_var=`echo x_opendir | tr '.-/+' '___p'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  ac_save_LIBS="$LIBS"
+LIBS="-lx  $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1105 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error.  */
+char opendir();
+
+int main() { return 0; }
+int t() {
+opendir()
+; return 0; }
+EOF
+if { (eval echo configure:1115: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then
+  rm -rf conftest*
+  eval "ac_cv_lib_$ac_lib_var=yes"
+else
+  rm -rf conftest*
+  eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  LIBS="$LIBS -lx"
+else
+  echo "$ac_t""no" 1>&6
+fi
+
+fi
+
+echo $ac_n "checking whether time.h and sys/time.h may both be included""... $ac_c" 1>&6
+if eval "test \"`echo '$''{'ac_cv_header_time'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1140 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <sys/time.h>
+#include <time.h>
+int main() { return 0; }
+int t() {
+struct tm *tp;
+; return 0; }
+EOF
+if { (eval echo configure:1150: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  ac_cv_header_time=yes
+else
+  rm -rf conftest*
+  ac_cv_header_time=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_header_time" 1>&6
+if test $ac_cv_header_time = yes; then
+  cat >> confdefs.h <<\EOF
+#define TIME_WITH_SYS_TIME 1
+EOF
+
+fi
+
+echo $ac_n "checking for sys/wait.h that is POSIX.1 compatible""... $ac_c" 1>&6
+if eval "test \"`echo '$''{'ac_cv_header_sys_wait_h'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1174 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <sys/wait.h>
+#ifndef WEXITSTATUS
+#define WEXITSTATUS(stat_val) ((unsigned)(stat_val) >> 8)
+#endif
+#ifndef WIFEXITED
+#define WIFEXITED(stat_val) (((stat_val) & 255) == 0)
+#endif
+int main() { return 0; }
+int t() {
+int s;
+wait (&s);
+s = WIFEXITED (s) ? WEXITSTATUS (s) : 1;
+; return 0; }
+EOF
+if { (eval echo configure:1191: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  ac_cv_header_sys_wait_h=yes
+else
+  rm -rf conftest*
+  ac_cv_header_sys_wait_h=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_header_sys_wait_h" 1>&6
+if test $ac_cv_header_sys_wait_h = yes; then
+  cat >> confdefs.h <<\EOF
+#define HAVE_SYS_WAIT_H 1
+EOF
+
+fi
+
+for ac_hdr in unistd.h string.h malloc.h memory.h limits.h time.h sys/types.h sys/select.h sys/time.h sys/timeb.h sys/times.h
+do
+ac_safe=`echo "$ac_hdr" | tr './\055' '___'`
+echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1218 "configure"
+#include "confdefs.h"
+#include <$ac_hdr>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1223: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out`
+if test -z "$ac_err"; then
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=yes"
+else
+  echo "$ac_err" >&5
+  rm -rf conftest*
+  eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+    ac_tr_hdr=HAVE_`echo $ac_hdr | tr 'abcdefghijklmnopqrstuvwxyz./\055' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ___'`
+  cat >> confdefs.h <<EOF
+#define $ac_tr_hdr 1
+EOF
+ 
+else
+  echo "$ac_t""no" 1>&6
+fi
+done
+
+
+echo $ac_n "checking for uid_t in sys/types.h""... $ac_c" 1>&6
+if eval "test \"`echo '$''{'ac_cv_type_uid_t'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1253 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  egrep "uid_t" >/dev/null 2>&1; then
+  rm -rf conftest*
+  ac_cv_type_uid_t=yes
+else
+  rm -rf conftest*
+  ac_cv_type_uid_t=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_type_uid_t" 1>&6
+if test $ac_cv_type_uid_t = no; then
+  cat >> confdefs.h <<\EOF
+#define uid_t int
+EOF
+
+  cat >> confdefs.h <<\EOF
+#define gid_t int
+EOF
+
+fi
+
+echo $ac_n "checking type of array argument to getgroups""... $ac_c" 1>&6
+if eval "test \"`echo '$''{'ac_cv_type_getgroups'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  if test "$cross_compiling" = yes; then
+  ac_cv_type_getgroups=cross
+else
+cat > conftest.$ac_ext <<EOF
+#line 1289 "configure"
+#include "confdefs.h"
+
+/* Thanks to Mike Rendell for this test.  */
+#include <sys/types.h>
+#define NGID 256
+#undef MAX
+#define MAX(x, y) ((x) > (y) ? (x) : (y))
+main()
+{
+  gid_t gidset[NGID];
+  int i, n;
+  union { gid_t gval; long lval; }  val;
+
+  val.lval = -1;
+  for (i = 0; i < NGID; i++)
+    gidset[i] = val.gval;
+  n = getgroups (sizeof (gidset) / MAX (sizeof (int), sizeof (gid_t)) - 1,
+                 gidset);
+  /* Exit non-zero if getgroups seems to require an array of ints.  This
+     happens when gid_t is short but getgroups modifies an array of ints.  */
+  exit ((n > 0 && gidset[n] != val.gval) ? 1 : 0);
+}
+
+EOF
+{ (eval echo configure:1314: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }
+if test -s conftest && (./conftest; exit) 2>/dev/null; then
+    ac_cv_type_getgroups=gid_t
+else
+  ac_cv_type_getgroups=int
+fi
+fi
+rm -fr conftest*
+if test $ac_cv_type_getgroups = cross; then
+        cat > conftest.$ac_ext <<EOF
+#line 1324 "configure"
+#include "confdefs.h"
+#include <unistd.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  egrep "getgroups.*int.*gid_t" >/dev/null 2>&1; then
+  rm -rf conftest*
+  ac_cv_type_getgroups=gid_t
+else
+  rm -rf conftest*
+  ac_cv_type_getgroups=int
+fi
+rm -f conftest*
+
+fi
+fi
+
+echo "$ac_t""$ac_cv_type_getgroups" 1>&6
+cat >> confdefs.h <<EOF
+#define GETGROUPS_T $ac_cv_type_getgroups
+EOF
+
+
+echo $ac_n "checking return type of signal handlers""... $ac_c" 1>&6
+if eval "test \"`echo '$''{'ac_cv_type_signal'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1352 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <signal.h>
+#ifdef signal
+#undef signal
+#endif
+#ifdef __cplusplus
+extern "C" void (*signal (int, void (*)(int)))(int);
+#else
+void (*signal ()) ();
+#endif
+
+int main() { return 0; }
+int t() {
+int i;
+; return 0; }
+EOF
+if { (eval echo configure:1370: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  ac_cv_type_signal=void
+else
+  rm -rf conftest*
+  ac_cv_type_signal=int
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_type_signal" 1>&6
+cat >> confdefs.h <<EOF
+#define RETSIGTYPE $ac_cv_type_signal
+EOF
+
+
+
+for ac_func in ftime times geteuid select uname mkdir rmdir getcwd rename putenv setlocale strftime strptime mknod nice lstat readlink symlink sync
+do
+echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
+if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1395 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char $ac_func(); below.  */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error.  */
+char $ac_func();
+
+int main() { return 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_$ac_func) || defined (__stub___$ac_func)
+choke me
+#else
+$ac_func();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:1417: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then
+  rm -rf conftest*
+  eval "ac_cv_func_$ac_func=yes"
+else
+  rm -rf conftest*
+  eval "ac_cv_func_$ac_func=no"
+fi
+rm -f conftest*
+
+fi
+if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+    ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'`
+  cat >> confdefs.h <<EOF
+#define $ac_tr_func 1
+EOF
+ 
+else
+  echo "$ac_t""no" 1>&6
+fi
+done
+
+
+for ac_func in inet_aton
+do
+echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
+if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1447 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char $ac_func(); below.  */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error.  */
+char $ac_func();
+
+int main() { return 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_$ac_func) || defined (__stub___$ac_func)
+choke me
+#else
+$ac_func();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:1469: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then
+  rm -rf conftest*
+  eval "ac_cv_func_$ac_func=yes"
+else
+  rm -rf conftest*
+  eval "ac_cv_func_$ac_func=no"
+fi
+rm -f conftest*
+
+fi
+if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+  :
+else
+  echo "$ac_t""no" 1>&6
+LIBOBJS="$LIBOBJS ${ac_func}.o"
+fi
+
+done
+
+
+echo $ac_n "checking for st_rdev in struct stat""... $ac_c" 1>&6
+if eval "test \"`echo '$''{'ac_cv_struct_st_rdev'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1495 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <sys/stat.h>
+int main() { return 0; }
+int t() {
+struct stat s; s.st_rdev;
+; return 0; }
+EOF
+if { (eval echo configure:1504: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  ac_cv_struct_st_rdev=yes
+else
+  rm -rf conftest*
+  ac_cv_struct_st_rdev=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_struct_st_rdev" 1>&6
+if test $ac_cv_struct_st_rdev = yes; then
+  cat >> confdefs.h <<\EOF
+#define HAVE_ST_RDEV 1
+EOF
+
+fi
+
+echo $ac_n "checking for st_blksize in struct stat""... $ac_c" 1>&6
+if eval "test \"`echo '$''{'ac_cv_struct_st_blksize'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1528 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <sys/stat.h>
+int main() { return 0; }
+int t() {
+struct stat s; s.st_blksize;
+; return 0; }
+EOF
+if { (eval echo configure:1537: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  ac_cv_struct_st_blksize=yes
+else
+  rm -rf conftest*
+  ac_cv_struct_st_blksize=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_struct_st_blksize" 1>&6
+if test $ac_cv_struct_st_blksize = yes; then
+  cat >> confdefs.h <<\EOF
+#define HAVE_ST_BLKSIZE 1
+EOF
+
+fi
+
+echo $ac_n "checking for st_blocks in struct stat""... $ac_c" 1>&6
+if eval "test \"`echo '$''{'ac_cv_struct_st_blocks'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 1561 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <sys/stat.h>
+int main() { return 0; }
+int t() {
+struct stat s; s.st_blocks;
+; return 0; }
+EOF
+if { (eval echo configure:1570: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  ac_cv_struct_st_blocks=yes
+else
+  rm -rf conftest*
+  ac_cv_struct_st_blocks=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_struct_st_blocks" 1>&6
+if test $ac_cv_struct_st_blocks = yes; then
+  cat >> confdefs.h <<\EOF
+#define HAVE_ST_BLOCKS 1
+EOF
+
+else
+  LIBOBJS="$LIBOBJS fileblocks.o"
+fi
+
+
+#--------------------------------------------------------------------
+#
+# Which way does the stack grow?
+#
+#--------------------------------------------------------------------
+
+if test "$cross_compiling" = yes; then
+  echo "configure: warning: Guessing that stack grows down -- see scmconfig.h.in" 1>&2
+else
+cat > conftest.$ac_ext <<EOF
+#line 1602 "configure"
+#include "confdefs.h"
+aux (l) unsigned long l;
+	     { int x; exit (l >= ((unsigned long)&x)); }
+	   main () { int q; aux((unsigned long)&q); }
+EOF
+{ (eval echo configure:1608: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }
+if test -s conftest && (./conftest; exit) 2>/dev/null; then
+  cat >> confdefs.h <<\EOF
+#define SCM_STACK_GROWS_UP 1
+EOF
+
+fi
+fi
+rm -fr conftest*
+
+
+if test "$cross_compiling" = yes; then
+  cat >> confdefs.h <<\EOF
+#define SCM_SINGLES 1
+EOF
+
+	   echo "configure: warning: Guessing that sizeof(long) == sizeof(float) -- see scmconfig.h.in" 1>&2
+else
+cat > conftest.$ac_ext <<EOF
+#line 1627 "configure"
+#include "confdefs.h"
+main () { exit (sizeof(float) != sizeof(long)); }
+EOF
+{ (eval echo configure:1631: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }
+if test -s conftest && (./conftest; exit) 2>/dev/null; then
+  cat >> confdefs.h <<\EOF
+#define SCM_SINGLES 1
+EOF
+
+fi
+fi
+rm -fr conftest*
+
+
+
+
+#--------------------------------------------------------------------
+#
+# How can you violate a stdio abstraction by setting a stream's fd?
+#
+#--------------------------------------------------------------------
+
+FD_SETTER=""
+
+if test "x$FD_SETTER" = x; then
+  cat > conftest.$ac_ext <<EOF
+#line 1654 "configure"
+#include "confdefs.h"
+#include <stdio.h>
+
+int main() { return 0; }
+int t() {
+stdout->_file = 1
+; return 0; }
+EOF
+if { (eval echo configure:1663: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  FD_SETTER="((F)->_file = (D))"
+fi
+rm -f conftest*
+
+fi
+
+if test "x$FD_SETTER" = x; then
+ cat > conftest.$ac_ext <<EOF
+#line 1673 "configure"
+#include "confdefs.h"
+#include <stdio.h>
+
+int main() { return 0; }
+int t() {
+stdout->_fileno
+; return 0; }
+EOF
+if { (eval echo configure:1682: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+  rm -rf conftest*
+  FD_SETTER="((F)->_fileno = (D))"
+fi
+rm -f conftest*
+
+fi
+
+
+test "x$FD_SETTER" != x && cat >> confdefs.h <<\EOF
+#define HAVE_FD_SETTER 1
+EOF
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+trap '' 1 2 15
+cat > confcache <<\EOF
+# This file is a shell script that caches the results of configure
+# tests run on this system so they can be shared between configure
+# scripts and configure runs.  It is not useful on other systems.
+# If it contains results you don't want to keep, you may remove or edit it.
+#
+# By default, configure uses ./config.cache as the cache file,
+# creating it if it does not exist already.  You can give configure
+# the --cache-file=FILE option to use a different cache file; that is
+# what configure does when it calls configure scripts in
+# subdirectories, so they share the cache.
+# Giving --cache-file=/dev/null disables caching, for debugging configure.
+# config.status only pays attention to the cache file if you give it the
+# --recheck option to rerun configure.
+#
+EOF
+# Ultrix sh set writes to stderr and can't be redirected directly,
+# and sets the high bit in the cache file unless we assign to the vars.
+(set) 2>&1 |
+  sed -n "s/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=\${\1='\2'}/p" \
+  >> confcache
+if cmp -s $cache_file confcache; then
+  :
+else
+  if test -w $cache_file; then
+    echo "updating cache $cache_file"
+    cat confcache > $cache_file
+  else
+    echo "not updating unwritable cache $cache_file"
+  fi
+fi
+rm -f confcache
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+test "x$prefix" = xNONE && prefix=$ac_default_prefix
+# Let make expand exec_prefix.
+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+
+# Any assignment to VPATH causes Sun make to only execute
+# the first set of double-colon rules, so remove it if not needed.
+# If there is a colon in the path, we need to keep it.
+if test "x$srcdir" = x.; then
+  ac_vpsub='/^[ 	]*VPATH[ 	]*=[^:]*$/d'
+fi
+
+trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15
+
+DEFS=-DHAVE_CONFIG_H
+
+# Without the "./", some shells look in PATH for config.status.
+: ${CONFIG_STATUS=./config.status}
+
+echo creating $CONFIG_STATUS
+rm -f $CONFIG_STATUS
+cat > $CONFIG_STATUS <<EOF
+#! /bin/sh
+# Generated automatically by configure.
+# Run this file to recreate the current configuration.
+# This directory was configured as follows,
+# on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
+#
+# $0 $ac_configure_args
+#
+# Compiler output produced by configure, useful for debugging
+# configure, is in ./config.log if it exists.
+
+ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]"
+for ac_option
+do
+  case "\$ac_option" in
+  -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+    echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion"
+    exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;;
+  -version | --version | --versio | --versi | --vers | --ver | --ve | --v)
+    echo "$CONFIG_STATUS generated by autoconf version 2.9"
+    exit 0 ;;
+  -help | --help | --hel | --he | --h)
+    echo "\$ac_cs_usage"; exit 0 ;;
+  *) echo "\$ac_cs_usage"; exit 1 ;;
+  esac
+done
+
+ac_given_srcdir=$srcdir
+
+trap 'rm -fr `echo "Makefile fd.h scmconfig.h" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+# Protect against being on the right side of a sed subst in config.status.
+sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g;
+ s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > conftest.subs <<\\CEOF
+$ac_vpsub
+$extrasub
+s%@CFLAGS@%$CFLAGS%g
+s%@CPPFLAGS@%$CPPFLAGS%g
+s%@CXXFLAGS@%$CXXFLAGS%g
+s%@DEFS@%$DEFS%g
+s%@LDFLAGS@%$LDFLAGS%g
+s%@LIBS@%$LIBS%g
+s%@exec_prefix@%$exec_prefix%g
+s%@prefix@%$prefix%g
+s%@program_transform_name@%$program_transform_name%g
+s%@bindir@%$bindir%g
+s%@sbindir@%$sbindir%g
+s%@libexecdir@%$libexecdir%g
+s%@datadir@%$datadir%g
+s%@sysconfdir@%$sysconfdir%g
+s%@sharedstatedir@%$sharedstatedir%g
+s%@localstatedir@%$localstatedir%g
+s%@libdir@%$libdir%g
+s%@includedir@%$includedir%g
+s%@oldincludedir@%$oldincludedir%g
+s%@infodir@%$infodir%g
+s%@mandir@%$mandir%g
+s%@CC@%$CC%g
+s%@CPP@%$CPP%g
+s%@RANLIB@%$RANLIB%g
+s%@LIBOBJS@%$LIBOBJS%g
+s%@FD_SETTER@%$FD_SETTER%g
+s%@TCL_SRC_DIR@%$TCL_SRC_DIR%g
+s%@TK_SRC_DIR@%$TK_SRC_DIR%g
+s%@XINCLUDES@%$XINCLUDES%g
+s%@GUILE_MAJOR_VERSION@%$GUILE_MAJOR_VERSION%g
+s%@GUILE_MINOR_VERSION@%$GUILE_MINOR_VERSION%g
+s%@GUILE_VERSION@%$GUILE_VERSION%g
+
+CEOF
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+CONFIG_FILES=\${CONFIG_FILES-"Makefile fd.h"}
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
+  # Support "outfile[:infile]", defaulting infile="outfile.in".
+  case "$ac_file" in
+  *:*) ac_file_in=`echo "$ac_file"|sed 's%.*:%%'`
+       ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
+  *) ac_file_in="${ac_file}.in" ;;
+  esac
+
+  # Adjust relative srcdir, etc. for subdirectories.
+
+  # Remove last slash and all that follows it.  Not all systems have dirname.
+  ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
+  if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
+    # The file is in a subdirectory.
+    test ! -d "$ac_dir" && mkdir "$ac_dir"
+    ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`"
+    # A "../" for each directory in $ac_dir_suffix.
+    ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'`
+  else
+    ac_dir_suffix= ac_dots=
+  fi
+
+  case "$ac_given_srcdir" in
+  .)  srcdir=.
+      if test -z "$ac_dots"; then top_srcdir=.
+      else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;;
+  /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;;
+  *) # Relative path.
+    srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix"
+    top_srcdir="$ac_dots$ac_given_srcdir" ;;
+  esac
+
+  echo creating "$ac_file"
+  rm -f "$ac_file"
+  configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure."
+  case "$ac_file" in
+  *Makefile*) ac_comsub="1i\\
+# $configure_input" ;;
+  *) ac_comsub= ;;
+  esac
+  sed -e "$ac_comsub
+s%@configure_input@%$configure_input%g
+s%@srcdir@%$srcdir%g
+s%@top_srcdir@%$top_srcdir%g
+" -f conftest.subs $ac_given_srcdir/$ac_file_in > $ac_file
+fi; done
+rm -f conftest.subs
+
+# These sed commands are passed to sed as "A NAME B NAME C VALUE D", where
+# NAME is the cpp macro being defined and VALUE is the value it is being given.
+#
+# ac_d sets the value in "#define NAME VALUE" lines.
+ac_dA='s%^\([ 	]*\)#\([ 	]*define[ 	][ 	]*\)'
+ac_dB='\([ 	][ 	]*\)[^ 	]*%\1#\2'
+ac_dC='\3'
+ac_dD='%g'
+# ac_u turns "#undef NAME" with trailing blanks into "#define NAME VALUE".
+ac_uA='s%^\([ 	]*\)#\([ 	]*\)undef\([ 	][ 	]*\)'
+ac_uB='\([ 	]\)%\1#\2define\3'
+ac_uC=' '
+ac_uD='\4%g'
+# ac_e turns "#undef NAME" without trailing blanks into "#define NAME VALUE".
+ac_eA='s%^\([ 	]*\)#\([ 	]*\)undef\([ 	][ 	]*\)'
+ac_eB='$%\1#\2define\3'
+ac_eC=' '
+ac_eD='%g'
+
+CONFIG_HEADERS=${CONFIG_HEADERS-"scmconfig.h"}
+for ac_file in .. $CONFIG_HEADERS; do if test "x$ac_file" != x..; then
+  # Support "outfile[:infile]", defaulting infile="outfile.in".
+  case "$ac_file" in
+  *:*) ac_file_in=`echo "$ac_file"|sed 's%.*:%%'`
+       ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
+  *) ac_file_in="${ac_file}.in" ;;
+  esac
+
+  echo creating $ac_file
+
+  rm -f conftest.frag conftest.in conftest.out
+  cp $ac_given_srcdir/$ac_file_in conftest.in
+
+EOF
+
+# Transform confdefs.h into a sed script conftest.vals that substitutes
+# the proper values into config.h.in to produce config.h.  And first:
+# Protect against being on the right side of a sed subst in config.status.
+# Protect against being in an unquoted here document in config.status.
+rm -f conftest.vals
+cat > conftest.hdr <<\EOF
+s/[\\&%]/\\&/g
+s%[\\$`]%\\&%g
+s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%${ac_dA}\1${ac_dB}\1${ac_dC}\2${ac_dD}%gp
+s%ac_d%ac_u%gp
+s%ac_u%ac_e%gp
+EOF
+sed -n -f conftest.hdr confdefs.h > conftest.vals
+rm -f conftest.hdr
+
+# This sed command replaces #undef with comments.  This is necessary, for
+# example, in the case of _POSIX_SOURCE, which is predefined and required
+# on some systems where configure will not decide to define it.
+cat >> conftest.vals <<\EOF
+s%^[ 	]*#[ 	]*undef[ 	][ 	]*[a-zA-Z_][a-zA-Z_0-9]*%/* & */%
+EOF
+
+# Break up conftest.vals because some shells have a limit on
+# the size of here documents, and old seds have small limits too.
+# Maximum number of lines to put in a single here document.
+ac_max_here_lines=12
+
+rm -f conftest.tail
+while :
+do
+  ac_lines=`grep -c . conftest.vals`
+  # grep -c gives empty output for an empty file on some AIX systems.
+  if test -z "$ac_lines" || test "$ac_lines" -eq 0; then break; fi
+  # Write a limited-size here document to conftest.frag.
+  echo '  cat > conftest.frag <<CEOF' >> $CONFIG_STATUS
+  sed ${ac_max_here_lines}q conftest.vals >> $CONFIG_STATUS
+  echo 'CEOF
+  sed -f conftest.frag conftest.in > conftest.out
+  rm -f conftest.in
+  mv conftest.out conftest.in
+' >> $CONFIG_STATUS
+  sed 1,${ac_max_here_lines}d conftest.vals > conftest.tail
+  rm -f conftest.vals
+  mv conftest.tail conftest.vals
+done
+rm -f conftest.vals
+
+cat >> $CONFIG_STATUS <<\EOF
+  rm -f conftest.frag conftest.h
+  echo "/* $ac_file.  Generated automatically by configure.  */" > conftest.h
+  cat conftest.in >> conftest.h
+  rm -f conftest.in
+  if cmp -s $ac_file conftest.h 2>/dev/null; then
+    echo "$ac_file is unchanged"
+    rm -f conftest.h
+  else
+    rm -f $ac_file
+    mv conftest.h $ac_file
+  fi
+fi; done
+
+
+
+exit 0
+EOF
+chmod +x $CONFIG_STATUS
+rm -fr confdefs* $ac_clean_files
+test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1
+
+
diff --git a/libguile/configure.in b/libguile/configure.in
new file mode 100644
index 000000000..ae71726d5
--- /dev/null
+++ b/libguile/configure.in
@@ -0,0 +1,107 @@
+AC_INIT(eval.c)
+AC_CONFIG_HEADER(scmconfig.h)
+
+. $srcdir/../GUILE-VERSION
+
+test -z "$CFLAGS" && CFLAGS=-g
+test -z "$LDFLAGS" && LDFLAGS=-g
+
+AC_PROG_CC
+AC_PROG_CPP
+AC_PROG_RANLIB
+
+AC_AIX
+AC_ISC_POSIX
+AC_MINIX
+
+AC_C_CONST
+
+AC_HEADER_STDC
+AC_HEADER_DIRENT
+AC_HEADER_TIME
+AC_HEADER_SYS_WAIT
+AC_CHECK_HEADERS(unistd.h string.h malloc.h memory.h limits.h time.h sys/types.h sys/select.h sys/time.h sys/timeb.h sys/times.h)
+
+AC_TYPE_GETGROUPS
+AC_TYPE_SIGNAL
+
+AC_CHECK_FUNCS(ftime times geteuid seteuid setegid select uname mkdir rmdir getcwd rename putenv setlocale strftime strptime mknod nice lstat readlink symlink sync)
+
+AC_REPLACE_FUNCS(inet_aton)
+
+AC_STRUCT_ST_RDEV
+AC_STRUCT_ST_BLKSIZE
+AC_STRUCT_ST_BLOCKS
+
+#--------------------------------------------------------------------
+#
+# Which way does the stack grow?
+#
+#--------------------------------------------------------------------
+
+AC_TRY_RUN(aux (l) unsigned long l;
+	     { int x; exit (l >= ((unsigned long)&x)); }
+	   main () { int q; aux((unsigned long)&q); }, 
+	   AC_DEFINE(SCM_STACK_GROWS_UP),,AC_MSG_WARN(Guessing that stack grows down -- see scmconfig.h.in))
+
+
+AC_TRY_RUN(main () { exit (sizeof(float) != sizeof(long)); },
+	   AC_DEFINE(SCM_SINGLES),,AC_DEFINE(SCM_SINGLES)
+	   AC_MSG_WARN(Guessing that sizeof(long) == sizeof(float) -- see scmconfig.h.in))
+
+
+
+
+#--------------------------------------------------------------------
+#
+# How can you violate a stdio abstraction by setting a stream's fd?
+#
+#--------------------------------------------------------------------
+
+FD_SETTER=""
+
+if test "x$FD_SETTER" = x; then
+  AC_TRY_COMPILE(#include <stdio.h>
+,		stdout->_file = 1,
+		FD_SETTER="((F)->_file = (D))")
+fi
+
+if test "x$FD_SETTER" = x; then
+ AC_TRY_COMPILE(#include <stdio.h>
+,		stdout->_fileno,
+		FD_SETTER="((F)->_fileno = (D))")
+fi
+
+dnl
+dnl  Add FD_SETTER tests for other systems here.  Your test should
+dnl  try a particular style of assigning to the descriptor
+dnl  field(s) of a FILE* and define FD_SETTER accordingly.
+dnl
+dnl  The value of FD_SETTER is used as a macro body, as in:
+dnl  
+dnl  #define SET_FILE_FD_FIELD(F,D)   @FD_SETTER@
+dnl
+dnl  F is a FILE* and D a descriptor (int).
+dnl
+
+test "x$FD_SETTER" != x && AC_DEFINE(HAVE_FD_SETTER)
+
+
+
+AC_SUBST(CFLAGS)
+AC_SUBST(LDFLAGS)
+AC_SUBST(LIBOBJS)
+AC_SUBST(FD_SETTER)
+AC_SUBST(TCL_SRC_DIR)
+AC_SUBST(TK_SRC_DIR)
+AC_SUBST(XINCLUDES)
+AC_SUBST(GUILE_MAJOR_VERSION)
+AC_SUBST(GUILE_MINOR_VERSION)
+AC_SUBST(GUILE_VERSION)
+AC_OUTPUT(Makefile fd.h)
+
+dnl Local Variables:
+dnl comment-start: "dnl "
+dnl comment-end: ""
+dnl comment-start-skip: "\\bdnl\\b\\s *"
+dnl End:
diff --git a/libguile/continuations.c b/libguile/continuations.c
new file mode 100644
index 000000000..054ed8e56
--- /dev/null
+++ b/libguile/continuations.c
@@ -0,0 +1,227 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+
+/* {Continuations}
+ */
+
+static char s_cont[] = "continuation";
+
+#ifdef __STDC__
+SCM 
+scm_make_cont (SCM * answer)
+#else
+SCM 
+scm_make_cont (answer)
+     SCM * answer;
+#endif
+{
+  long j;
+  SCM cont;
+
+#ifdef CHEAP_CONTINUATIONS
+  SCM_NEWCELL (cont);
+  *answer = cont;
+  SCM_DEFER_INTS;
+  SCM_SETJMPBUF (cont, scm_must_malloc ((long) sizeof (regs), s_cont));
+  SCM_CAR (cont) = scm_tc7_contin;
+  SCM_DYNENV (cont) = dynwinds;
+  SCM_THROW_VALUE = SCM_EOL;
+  SCM_BASE (cont) = SCM_BASE (rootcont);
+  SCM_SEQ (cont) = SCM_SEQ (rootcont);
+  SCM_ALLOW_INTS;
+#else
+  register SCM_STACKITEM *src, *dst;
+
+  {
+    SCM winds;
+
+    for (winds = scm_dynwinds; winds != SCM_EOL; winds = SCM_CDR (winds))
+      {
+#if 0
+	if (SCM_INUMP (SCM_CAR (winds)))
+	  {
+	    scm_relocate_chunk_to_heap (SCM_CAR (winds));
+	  }
+#endif
+      }
+  }
+
+  SCM_NEWCELL (cont);
+  *answer = cont;
+  SCM_DEFER_INTS;
+  SCM_FLUSH_REGISTER_WINDOWS;
+  j = scm_stack_size (SCM_BASE (scm_rootcont));
+  SCM_SETJMPBUF (cont,
+	     scm_must_malloc ((long) (sizeof (regs) + j * sizeof (SCM_STACKITEM)),
+			      s_cont));
+  SCM_SETLENGTH (cont, j, scm_tc7_contin);
+  SCM_DYNENV (cont) = scm_dynwinds;
+  SCM_THROW_VALUE (cont) = SCM_EOL;
+  src = SCM_BASE (cont) = SCM_BASE (scm_rootcont);
+  SCM_SEQ (cont) = SCM_SEQ (scm_rootcont);
+  SCM_ALLOW_INTS;
+#ifndef SCM_STACK_GROWS_UP
+  src -= SCM_LENGTH (cont);
+#endif /* ndef SCM_STACK_GROWS_UP */
+  dst = (SCM_STACKITEM *) (SCM_CHARS (cont) + sizeof (regs));
+  for (j = SCM_LENGTH (cont); 0 <= --j;)
+    *dst++ = *src++;
+#endif /* def CHEAP_CONTINUATIONS */
+#ifdef DEBUG_EXTENSIONS
+  SCM_DFRAME (cont) = last_debug_info_frame;
+#endif
+  return cont;
+}
+
+
+void scm_dynthrow SCM_P ((SCM *a));
+
+/* Grow the stack so that there is room */
+/* to copy in the continuation.  Then */
+#ifndef CHEAP_CONTINUATIONS
+#ifdef __STDC__
+static void 
+grow_throw (SCM *a)
+#else
+static void 
+grow_throw (a)
+     SCM *a;
+#endif
+{				/* retry the throw. */
+  SCM growth[100];
+  growth[0] = a[0];
+  growth[1] = a[1];
+  growth[2] = a[2] + 1;
+  growth[3] = (SCM) a;
+  scm_dynthrow (growth);
+}
+#endif /* ndef CHEAP_CONTINUATIONS */
+
+#ifdef __STDC__
+void 
+scm_dynthrow (SCM *a)
+#else
+void 
+scm_dynthrow (a)
+     SCM *a;
+#endif
+{
+  SCM cont = a[0], val = a[1];
+#ifndef CHEAP_CONTINUATIONS
+  register long j;
+  register SCM_STACKITEM *src, *dst = SCM_BASE (scm_rootcont);
+#ifdef SCM_STACK_GROWS_UP
+  if (a[2] && (a - ((SCM *) a[3]) < 100))
+#else
+  if (a[2] && (((SCM *) a[3]) - a < 100))
+#endif
+    fputs ("grow_throw: check if SCM growth[100]; being optimized out\n",
+	   stderr);
+  /* if (a[2]) fprintf(stderr, " ct = %ld, dist = %ld\n",
+			  a[2], (((SCM *)a[3]) - a)); */
+#ifdef SCM_STACK_GROWS_UP
+  if (SCM_PTR_GE (dst + SCM_LENGTH (cont), (SCM_STACKITEM *) & a))
+    grow_throw (a);
+#else
+  dst -= SCM_LENGTH (cont);
+  if (SCM_PTR_LE (dst, (SCM_STACKITEM *) & a))
+    grow_throw (a);
+#endif /* def SCM_STACK_GROWS_UP */
+  SCM_FLUSH_REGISTER_WINDOWS;
+  src = (SCM_STACKITEM *) (SCM_CHARS (cont) + sizeof (regs));
+  for (j = SCM_LENGTH (cont); 0 <= --j;)
+    *dst++ = *src++;
+#ifdef sparc			/* clear out stack up to this stackframe */
+  /* maybe this would help, maybe not */
+/*	bzero((void *)&a, sizeof(SCM_STACKITEM) * (((SCM_STACKITEM *)&a) -
+					       (dst - SCM_LENGTH(cont)))) */
+#endif
+#endif /* ndef CHEAP_CONTINUATIONS */
+#ifdef DEBUG_EXTENSIONS
+  last_debug_info_frame = SCM_DFRAME (cont);
+#endif
+  SCM_THROW_VALUE(cont) = val;
+  longjmp (SCM_JMPBUF (cont), 1);
+}
+
+#ifdef __STDC__
+SCM
+scm_call_continuation (SCM cont, SCM val)
+#else
+SCM
+scm_call_continuation (cont, val)
+     SCM cont;
+     SCM val;
+#endif
+{
+  SCM a[3];
+  a[0] = cont;
+  a[1] = val;
+  a[2] = 0;
+  if (   (SCM_SEQ (cont) != SCM_SEQ (scm_rootcont))
+      || (SCM_BASE (cont) != SCM_BASE (scm_rootcont)))  /* base compare not needed */
+    scm_wta (cont, "continuation from wrong top level", s_cont);
+  
+  scm_dowinds (SCM_DYNENV (cont),
+	       scm_ilength (scm_dynwinds) - scm_ilength (SCM_DYNENV (cont)));
+  
+  scm_dynthrow (a);
+  return SCM_UNSPECIFIED; /* not reached */
+}
+
+
+#ifdef __STDC__
+void
+scm_init_continuations (void)
+#else
+void
+scm_init_continuations ()
+#endif
+{
+#include "continuations.x"
+}
+
diff --git a/libguile/continuations.h b/libguile/continuations.h
new file mode 100644
index 000000000..176d423fc
--- /dev/null
+++ b/libguile/continuations.h
@@ -0,0 +1,86 @@
+/* classes: h_files */
+
+#ifndef CONTINUATIONSH
+#define CONTINUATIONSH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+#include "__scm.h"
+
+
+
+typedef struct 
+{
+  SCM throw_value;
+  jmp_buf jmpbuf;
+  SCM dynenv;
+  SCM_STACKITEM *base;
+  unsigned long seq;
+
+#ifdef DEBUG_EXTENSIONS
+  struct scm_debug_frame *dframe;
+#endif
+} regs;
+
+#define SCM_JMPBUF(x) (((regs *)SCM_CHARS(x))->jmpbuf)
+#define SCM_SETJMPBUF SCM_SETCDR
+#define SCM_DYNENV(x) (((regs *)SCM_CHARS(x))->dynenv)
+#define SCM_THROW_VALUE(x) (((regs *)SCM_CHARS(x))->throw_value)
+#define SCM_BASE(x) (((regs *)SCM_CHARS(x))->base)
+#define SCM_SEQ(x) (((regs *)SCM_CHARS(x))->seq)
+#define SCM_DFRAME(x) (((regs *)SCM_CHARS(x))->dframe)
+
+
+
+#ifdef __STDC__
+extern SCM scm_make_cont (SCM * answer);
+extern void scm_dynthrow (SCM *a);
+extern SCM scm_call_continuation (SCM cont, SCM val);
+extern void scm_init_continuations (void);
+
+#else /* STDC */
+extern SCM scm_make_cont ();
+extern void scm_dynthrow ();
+extern SCM scm_call_continuation ();
+extern void scm_init_continuations ();
+
+#endif /* STDC */
+#endif  /* CONTINUATIONSH */
diff --git a/libguile/def.sed b/libguile/def.sed
new file mode 100644
index 000000000..e69de29bb
--- /dev/null
+++ b/libguile/def.sed
diff --git a/libguile/dynwind.c b/libguile/dynwind.c
new file mode 100644
index 000000000..b80a00c76
--- /dev/null
+++ b/libguile/dynwind.c
@@ -0,0 +1,148 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+
+/* {Dynamic wind}
+ */
+
+
+
+SCM_PROC(s_dynamic_wind, "dynamic-wind", 3, 0, 0, scm_dynamic_wind);
+#ifdef __STDC__
+SCM 
+scm_dynamic_wind (SCM thunk1, SCM thunk2, SCM thunk3)
+#else
+SCM 
+scm_dynamic_wind (thunk1, thunk2, thunk3)
+     SCM thunk1;
+     SCM thunk2;
+     SCM thunk3;
+#endif
+{
+  SCM ans;
+  scm_apply (thunk1, SCM_EOL, SCM_EOL);
+  scm_dynwinds = scm_acons (thunk1, thunk3, scm_dynwinds);
+  ans = scm_apply (thunk2, SCM_EOL, SCM_EOL);
+  scm_dynwinds = SCM_CDR (scm_dynwinds);
+  scm_apply (thunk3, SCM_EOL, SCM_EOL);
+  return ans;
+}
+
+#ifdef __STDC__
+void 
+scm_dowinds (SCM to, long delta)
+#else
+void 
+scm_dowinds (to, delta)
+     SCM to;
+     long delta;
+#endif
+{
+ tail:
+  if (scm_dynwinds == to);
+  else if (0 > delta)
+    {
+      SCM wind_elt;
+      SCM wind_key;
+
+      scm_dowinds (SCM_CDR (to), 1 + delta);
+      wind_elt = SCM_CAR (to);
+#if 0
+      if (SCM_INUMP (wind_elt))
+	{
+	  scm_cross_dynwind_binding_scope (wind_elt, 0);
+	}
+      else
+#endif
+	{
+	  wind_key = SCM_CAR (wind_elt);
+	  if (   !(SCM_NIMP (wind_key) && SCM_SYMBOLP (wind_key))
+	      && (wind_key != SCM_BOOL_F)
+	      && (wind_key != SCM_BOOL_T))
+	    scm_apply (wind_key, SCM_EOL, SCM_EOL);
+	}
+      scm_dynwinds = to;
+    }
+  else
+    {
+      SCM from;
+      SCM wind_elt;
+      SCM wind_key;
+
+      from = SCM_CDR (SCM_CAR (scm_dynwinds));
+      wind_elt = SCM_CAR (scm_dynwinds);
+      scm_dynwinds = SCM_CDR (scm_dynwinds);
+#if 0
+      if (SCM_INUMP (wind_elt))
+	{
+	  scm_cross_dynwind_binding_scope (wind_elt, 0);
+	}
+      else
+#endif
+	{
+	  wind_key = SCM_CAR (wind_elt);
+	  if (   !(SCM_NIMP (wind_key) && SCM_SYMBOLP (wind_key))
+	      && (wind_key != SCM_BOOL_F)
+	      && (wind_key != SCM_BOOL_T))
+	    scm_apply (from, SCM_EOL, SCM_EOL);
+	}
+      delta--;
+      goto tail;		/* scm_dowinds(to, delta-1); */
+    }
+}
+
+
+#ifdef __STDC__
+void
+scm_init_dynwind (void)
+#else
+void
+scm_init_dynwind ()
+#endif
+{
+#include "dynwind.x"
+}
+
diff --git a/libguile/dynwind.h b/libguile/dynwind.h
new file mode 100644
index 000000000..42f1515d2
--- /dev/null
+++ b/libguile/dynwind.h
@@ -0,0 +1,66 @@
+/* classes: h_files */
+
+#ifndef DYNWINDH
+#define DYNWINDH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+#include "__scm.h"
+
+
+#ifdef __STDC__
+extern SCM scm_dynamic_wind (SCM thunk1, SCM thunk2, SCM thunk3);
+extern void scm_dowinds (SCM to, long delta);
+extern void scm_init_dynwind (void);
+
+#else /* STDC */
+extern SCM scm_dynamic_wind ();
+extern void scm_dowinds ();
+extern void scm_init_dynwind ();
+
+#endif /* STDC */
+
+
+
+
+
+
+#endif  /* DYNWINDH */
diff --git a/libguile/eq.c b/libguile/eq.c
new file mode 100644
index 000000000..ed6dc4e12
--- /dev/null
+++ b/libguile/eq.c
@@ -0,0 +1,162 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+SCM_PROC1 (s_eq_p, "eq?", scm_tc7_rpsubr, scm_eq_p);
+#ifdef __STDC__
+SCM
+scm_eq_p (SCM x, SCM y)
+#else
+SCM
+scm_eq_p (x, y)
+     SCM x;
+     SCM y;
+#endif
+{
+  return ((x==y)
+	  ? SCM_BOOL_T
+	  : SCM_BOOL_F);
+}
+
+
+SCM_PROC1 (s_eqv_p, "eqv?", scm_tc7_rpsubr, scm_eqv_p);
+#ifdef __STDC__
+SCM
+scm_eqv_p (SCM x, SCM y)
+#else
+SCM
+scm_eqv_p (x, y)
+     SCM x;
+     SCM y;
+#endif
+{
+  if (x==y) return SCM_BOOL_T;
+  if SCM_IMP(x) return SCM_BOOL_F;
+  if SCM_IMP(y) return SCM_BOOL_F;
+  /* this ensures that types and scm_length are the same. */
+  if (SCM_CAR(x) != SCM_CAR(y)) return SCM_BOOL_F;
+  if SCM_NUMP(x) {
+# ifdef SCM_BIGDIG
+    if SCM_BIGP(x) return (0==scm_bigcomp(x, y)) ? SCM_BOOL_T : SCM_BOOL_F;
+# endif
+#ifdef SCM_FLOATS
+    if (SCM_REALPART(x) != SCM_REALPART(y)) return SCM_BOOL_F;
+    if (SCM_CPLXP(x) && (SCM_IMAG(x) != SCM_IMAG(y))) return SCM_BOOL_F;
+#endif
+    return SCM_BOOL_T;
+  }
+  return SCM_BOOL_F;
+}
+
+
+SCM_PROC1 (s_equal_p, "equal?", scm_tc7_rpsubr, scm_equal_p);
+#ifdef __STDC__
+SCM
+scm_equal_p (SCM x, SCM y)
+#else
+SCM
+scm_equal_p (x, y)
+     SCM x;
+     SCM y;
+#endif
+{
+  SCM_CHECK_STACK;
+ tailrecurse: SCM_ASYNC_TICK;
+	if (x==y) return SCM_BOOL_T;
+	if (SCM_IMP(x)) return SCM_BOOL_F;
+	if (SCM_IMP(y)) return SCM_BOOL_F;
+	if (SCM_CONSP(x) && SCM_CONSP(y)) {
+		if SCM_FALSEP(scm_equal_p(SCM_CAR(x), SCM_CAR(y))) return SCM_BOOL_F;
+		x = SCM_CDR(x);
+		y = SCM_CDR(y);
+		goto tailrecurse;
+	}
+	/* this ensures that types and scm_length are the same. */
+	if (SCM_CAR(x) != SCM_CAR(y)) return SCM_BOOL_F;
+	switch (SCM_TYP7(x)) {
+        default: return SCM_BOOL_F;
+	case scm_tc7_substring:
+	case scm_tc7_mb_substring:
+	case scm_tc7_mb_string:
+	case scm_tc7_string: return scm_string_equal_p(x, y);
+	case scm_tc7_vector:
+	case scm_tc7_wvect:
+	  return scm_vector_equal_p(x, y);
+	case scm_tc7_smob: {
+	        int i = SCM_SMOBNUM(x);
+	        if (!(i < scm_numsmob)) return SCM_BOOL_F;
+	        if (scm_smobs[i].equalp)
+		  return (scm_smobs[i].equalp)(x, y);
+		else
+		  return SCM_BOOL_F;
+	      }
+	case scm_tc7_bvect: case scm_tc7_uvect: case scm_tc7_ivect:
+	case scm_tc7_fvect:	case scm_tc7_cvect: case scm_tc7_dvect:
+	case scm_tc7_svect:
+#ifdef LONGLONGS
+	case scm_tc7_llvect:
+#endif
+	case scm_tc7_byvect:
+	  if (   scm_tc16_array
+	      && scm_smobs[0x0ff & (scm_tc16_array >> 8)].equalp)
+	    return scm_array_equal_p(x, y);
+	}
+	return SCM_BOOL_F;
+}
+
+
+
+
+
+#ifdef __STDC__
+void
+scm_init_eq (void)
+#else
+void
+scm_init_eq ()
+#endif
+{
+#include "eq.x"
+}
+
diff --git a/libguile/eq.h b/libguile/eq.h
new file mode 100644
index 000000000..db164ec0d
--- /dev/null
+++ b/libguile/eq.h
@@ -0,0 +1,63 @@
+/* classes: h_files */
+
+#ifndef EQH
+#define EQH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+
+
+#ifdef __STDC__
+extern SCM scm_eq_p (SCM x, SCM y);
+extern SCM scm_eqv_p (SCM x, SCM y);
+extern SCM scm_equal_p (SCM x, SCM y);
+extern void scm_init_eq (void);
+
+#else /* STDC */
+extern SCM scm_eq_p ();
+extern SCM scm_eqv_p ();
+extern SCM scm_equal_p ();
+extern void scm_init_eq ();
+
+#endif /* STDC */
+
+#endif  /* EQH */
diff --git a/libguile/error.c b/libguile/error.c
new file mode 100644
index 000000000..c16612513
--- /dev/null
+++ b/libguile/error.c
@@ -0,0 +1,205 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+
+
+/* {Errors and Exceptional Conditions}
+ */
+
+SCM system_error_sym;
+
+/* True between SCM_DEFER_INTS and SCM_ALLOW_INTS, and
+ * when the interpreter is not running at all.
+ */
+int scm_ints_disabled = 1;
+
+
+extern int errno;
+#ifdef __STDC__
+static void 
+err_head (char *str)
+#else
+static void 
+err_head (str)
+     char *str;
+#endif
+{
+  int oerrno = errno;
+  if (SCM_NIMP (scm_cur_outp))
+    scm_fflush (scm_cur_outp);
+  scm_gen_putc ('\n', scm_cur_errp);
+#if 0
+  if (SCM_BOOL_F != *scm_loc_loadpath)
+    {
+      scm_iprin1 (*scm_loc_loadpath, scm_cur_errp, 1);
+      scm_gen_puts (scm_regular_string, ", line ", scm_cur_errp);
+      scm_intprint ((long) scm_linum, 10, scm_cur_errp);
+      scm_gen_puts (scm_regular_string, ": ", scm_cur_errp);
+    }
+#endif
+  scm_fflush (scm_cur_errp);
+  errno = oerrno;
+  if (scm_cur_errp == scm_def_errp)
+    {
+      if (errno > 0)
+	perror (str);
+      fflush (stderr);
+      return;
+    }
+}
+
+
+SCM_PROC(s_errno, "errno", 0, 1, 0, scm_errno);
+#ifdef __STDC__
+SCM 
+scm_errno (SCM arg)
+#else
+SCM 
+scm_errno (arg)
+     SCM arg;
+#endif
+{
+  int old = errno;
+  if (!SCM_UNBNDP (arg))
+    {
+      if (SCM_FALSEP (arg))
+	errno = 0;
+      else
+	errno = SCM_INUM (arg);
+    }
+  return SCM_MAKINUM (old);
+}
+
+SCM_PROC(s_perror, "perror", 1, 0, 0, scm_perror);
+#ifdef __STDC__
+SCM 
+scm_perror (SCM arg)
+#else
+SCM 
+scm_perror (arg)
+     SCM arg;
+#endif
+{
+  SCM_ASSERT (SCM_NIMP (arg) && SCM_STRINGP (arg), arg, SCM_ARG1, s_perror);
+  err_head (SCM_CHARS (arg));
+  return SCM_UNSPECIFIED;
+}
+
+
+#ifdef __STDC__
+void 
+scm_everr (SCM exp, SCM env, SCM arg, char *pos, char *s_subr)
+#else
+void 
+scm_everr (exp, env, arg, pos, s_subr)
+     SCM exp;
+     SCM env;
+     SCM arg; 
+     char *pos;
+     char *s_subr;
+#endif
+{
+  SCM desc;
+  SCM args;
+  
+  if ((~0x1fL) & (long) pos)
+    desc = scm_makfrom0str (pos);
+  else
+    desc = SCM_MAKINUM ((long)pos);
+  
+  {
+    SCM sym;
+    if (!s_subr || !*s_subr)
+      sym = SCM_BOOL_F;
+    else
+      sym = SCM_CAR (scm_intern0 (s_subr));
+    args = scm_listify (desc, sym, arg, SCM_UNDEFINED);
+  }
+  
+  /* (throw (quote %%system-error) <desc> <proc-name> arg)
+   *
+   * <desc> is a string or an integer (see %%system-errors).
+   * <proc-name> is a symbol or #f in some annoying cases (e.g. cddr).
+   */
+  
+  scm_ithrow (system_error_sym, args, 1);
+  
+  /* No return, but just in case: */
+
+  write (2, "unhandled system error", sizeof ("unhandled system error"));
+  exit (1);
+}
+
+#ifdef __STDC__
+SCM
+scm_wta (SCM arg, char *pos, char *s_subr)
+#else
+SCM
+scm_wta (arg, pos, s_subr)
+     SCM arg;
+     char *pos;
+     char *s_subr;
+#endif
+{
+  scm_everr (SCM_UNDEFINED, SCM_EOL, arg, pos, s_subr);
+  return SCM_UNSPECIFIED;
+}
+
+
+
+#ifdef __STDC__
+void
+scm_init_error (void)
+#else
+void
+scm_init_error ()
+#endif
+{
+  system_error_sym = SCM_CAR (scm_intern0 ("%%system-error"));
+  scm_permanent_object (system_error_sym);
+#include "error.x"
+}
+
diff --git a/libguile/error.h b/libguile/error.h
new file mode 100644
index 000000000..c635c5d13
--- /dev/null
+++ b/libguile/error.h
@@ -0,0 +1,79 @@
+/* classes: h_files */
+
+#ifndef ERRORH
+#define ERRORH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+#include "__scm.h"
+#include "pairs.h"
+
+
+
+extern int scm_ints_disabled;
+extern SCM system_error_sym;
+
+
+
+
+#ifdef __STDC__
+extern int scm_handle_it (int i);
+extern void scm_warn (char *str1, char *str2);
+extern SCM scm_errno (SCM arg);
+extern SCM scm_perror (SCM arg);
+extern void scm_def_err_response (void);
+extern void scm_everr (SCM exp, SCM env, SCM arg, char *pos, char *s_subr);
+extern SCM scm_wta (SCM arg, char *pos, char *s_subr);
+extern void scm_init_error (void);
+
+#else /* STDC */
+extern int scm_handle_it ();
+extern void scm_warn ();
+extern SCM scm_errno ();
+extern SCM scm_perror ();
+extern void scm_def_err_response ();
+extern void scm_everr ();
+extern SCM scm_wta ();
+extern void scm_init_error ();
+
+#endif /* STDC */
+
+#endif  /* ERRORH */
diff --git a/libguile/eval.c b/libguile/eval.c
new file mode 100644
index 000000000..7b2f3600e
--- /dev/null
+++ b/libguile/eval.c
@@ -0,0 +1,2513 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+/* This file is read twice in order to produce a second debugging
+ * version of scm_ceval called scm_deval.  scm_deval is produced when
+ * we define the preprocessor macro DEVAL.
+ */
+
+#ifndef DEVAL
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+
+#define EVALCELLCAR(x, env) (SCM_SYMBOLP (SCM_CAR(x)) \
+			     ? *scm_lookupcar(x, env) \
+			     : SCM_CEVAL(SCM_CAR(x), env))
+
+#ifdef MEMOIZE_LOCALS
+#define EVALIMP(x, env) (SCM_ILOCP(x)?*scm_ilookup((x), env):x)
+#else
+#define EVALIMP(x, env) x
+#endif
+#define EVALCAR(x, env) (SCM_NCELLP(SCM_CAR(x))\
+			? (SCM_IMP(SCM_CAR(x)) \
+			   ? EVALIMP(SCM_CAR(x), env) \
+			   : SCM_GLOC_VAL(SCM_CAR(x))) \
+			: EVALCELLCAR(x, env))
+#ifdef DEBUG_EXTENSIONS
+#define XEVALCAR(x, env) (SCM_NCELLP(SCM_CAR(x)) \
+			  ? (SCM_IMP(SCM_CAR(x)) \
+			     ? EVALIMP(SCM_CAR(x), env) \
+			     : SCM_GLOC_VAL(SCM_CAR(x))) \
+			  : (SCM_SYMBOLP(SCM_CAR(x)) \
+			     ? *scm_lookupcar(x, env) \
+			     : (*scm_ceval_ptr) (SCM_CAR(x), env)))
+#else
+#define XEVALCAR(x, env) EVALCAR(x, env)
+#endif
+
+#define EXTEND_SCM_ENV SCM_EXTEND_SCM_ENV
+
+#ifdef MEMOIZE_LOCALS
+#ifdef __STDC__
+SCM *
+scm_ilookup (SCM iloc, SCM env)
+#else
+SCM *
+scm_ilookup (iloc, env)
+     SCM iloc;
+     SCM env;
+#endif
+{
+  register int ir = SCM_IFRAME (iloc);
+  register SCM er = env;
+  for (; 0 != ir; --ir)
+    er = SCM_CDR (er);
+  er = SCM_CAR (er);
+  for (ir = SCM_IDIST (iloc); 0 != ir; --ir)
+    er = SCM_CDR (er);
+  if (SCM_ICDRP (iloc))
+    return &SCM_CDR (er);
+  return &SCM_CAR (SCM_CDR (er));
+}
+#endif
+
+#ifdef __STDC__
+SCM *
+scm_lookupcar (SCM vloc, SCM genv)
+#else
+SCM *
+scm_lookupcar (vloc, genv)
+     SCM vloc;
+     SCM genv;
+#endif
+{
+  SCM env = genv;
+  register SCM *al, fl, var = SCM_CAR (vloc);
+#ifdef MEMOIZE_LOCALS
+  register SCM iloc = SCM_ILOC00;
+#endif
+  for (; SCM_NIMP (env); env = SCM_CDR (env))
+    {
+      if (SCM_BOOL_T == scm_procedure_p (SCM_CAR (env)))
+	break;
+      al = &SCM_CAR (env);
+      for (fl = SCM_CAR (*al); SCM_NIMP (fl); fl = SCM_CDR (fl))
+	{
+	  if (SCM_NCONSP (fl))
+	      if (fl == var)
+	      {
+#ifdef MEMOIZE_LOCALS
+		SCM_CAR (vloc) = iloc + SCM_ICDR;
+#endif
+		return &SCM_CDR (*al);
+	      }
+	    else
+	      break;
+	  al = &SCM_CDR (*al);
+	  if (SCM_CAR (fl) == var)
+	    {
+#ifdef MEMOIZE_LOCALS
+#ifndef RECKLESS		/* letrec inits to SCM_UNDEFINED */
+	      if (SCM_UNBNDP (SCM_CAR (*al)))
+		{
+		  env = SCM_EOL;
+		  goto errout;
+		}
+#endif
+	      SCM_CAR (vloc) = iloc;
+#endif
+	      return &SCM_CAR (*al);
+	    }
+#ifdef MEMOIZE_LOCALS
+	  iloc += SCM_IDINC;
+#endif
+	}
+#ifdef MEMOIZE_LOCALS
+      iloc = (~SCM_IDSTMSK) & (iloc + SCM_IFRINC);
+#endif
+    }
+  {
+    SCM top_thunk, vcell;
+    if (SCM_NIMP(env))
+      {
+	top_thunk = SCM_CAR(env);	/* env now refers to a top level env thunk */
+	env = SCM_CDR (env);
+      }
+    else
+      top_thunk = SCM_BOOL_F;
+    vcell = scm_sym2vcell (var, top_thunk, SCM_BOOL_F);
+    if (vcell == SCM_BOOL_F)
+      goto errout;
+    else
+      var = vcell;
+  }
+#ifndef RECKLESS
+  if (SCM_NNULLP (env) || SCM_UNBNDP (SCM_CDR (var)))
+    {
+      var = SCM_CAR (var);
+    errout:
+      scm_everr (vloc, genv, var,
+		 (SCM_NULLP (env)
+		  ? "unbound variable: "
+		  : "damaged environment"),
+		 "");
+    }
+#endif
+  SCM_CAR (vloc) = var + 1;
+  /* Except wait...what if the var is not a vcell,
+   * but syntax or something....
+   */
+  return &SCM_CDR (var);
+}
+
+#define unmemocar scm_unmemocar
+#ifdef __STDC__
+SCM 
+scm_unmemocar (SCM form, SCM env)
+#else
+SCM 
+scm_unmemocar (form, env)
+     SCM form;
+     SCM env;
+#endif
+{
+  register int ir;
+  SCM c;
+
+  if (SCM_IMP (form))
+    return form;
+  c = SCM_CAR (form);
+  if (1 == (c & 7))
+    SCM_CAR (form) = SCM_CAR (c - 1);
+#ifdef MEMOIZE_LOCALS
+  else if (SCM_ILOCP (c))
+    {
+      for (ir = SCM_IFRAME (c); ir != 0; --ir)
+	env = SCM_CDR (env);
+      env = SCM_CAR (SCM_CAR (env));
+      for (ir = SCM_IDIST (c); ir != 0; --ir)
+	env = SCM_CDR (env);
+      SCM_CAR (form) = SCM_ICDRP (c) ? env : SCM_CAR (env);
+    }
+#endif
+  return form;
+}
+
+#ifdef __STDC__
+SCM
+scm_eval_car (SCM pair, SCM env)
+#else
+SCM
+scm_eval_car (pair, env)
+     SCM pair;
+     SCM env;
+#endif
+{
+  return EVALCAR (pair, env);
+}
+
+
+/* 
+ * 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))scm_wta(_arg, (char *)_pos, _subr);
+
+SCM scm_i_dot, scm_i_quote, scm_i_quasiquote, scm_i_lambda, scm_i_let,
+  scm_i_arrow, scm_i_else, scm_i_unquote, scm_i_uq_splicing, scm_i_apply;
+SCM scm_i_name;
+#ifdef DEBUG_EXTENSIONS
+static SCM enter_frame_sym, exit_frame_sym;
+#endif
+static char s_quasiquote[] = "quasiquote";
+static char s_delay[] = "delay";
+
+#define ASRTSYNTAX(cond_, msg_) if(!(cond_))scm_wta(xorig, (msg_), what);
+
+
+#ifdef __STDC__
+static void 
+bodycheck (SCM xorig, SCM *bodyloc, char *what)
+#else
+static void 
+bodycheck (xorig, bodyloc, what)
+     SCM xorig;
+     SCM *bodyloc;
+     char *what;
+#endif
+{
+  ASRTSYNTAX (scm_ilength (*bodyloc) >= 1, s_expression);
+}
+
+
+#ifdef __STDC__
+SCM 
+scm_m_quote (SCM xorig, SCM env)
+#else
+SCM 
+scm_m_quote (xorig, env)
+     SCM xorig;
+     SCM env;
+#endif
+{
+  ASSYNT (scm_ilength (SCM_CDR (xorig)) == 1, xorig, s_expression, "quote");
+  return scm_cons (SCM_IM_QUOTE, SCM_CDR (xorig));
+}
+
+
+#ifdef __STDC__
+SCM 
+scm_m_begin (SCM xorig, SCM env)
+#else
+SCM 
+scm_m_begin (xorig, env)
+     SCM xorig;
+     SCM env;
+#endif
+{
+  ASSYNT (scm_ilength (SCM_CDR (xorig)) >= 1, xorig, s_expression, "begin");
+  return scm_cons (SCM_IM_BEGIN, SCM_CDR (xorig));
+}
+
+
+#ifdef __STDC__
+SCM 
+scm_m_if (SCM xorig, SCM env)
+#else
+SCM 
+scm_m_if (xorig, env)
+     SCM xorig;
+     SCM env;
+#endif
+{
+  int len = scm_ilength (SCM_CDR (xorig));
+  ASSYNT (len >= 2 && len <= 3, xorig, s_expression, "if");
+  return scm_cons (SCM_IM_IF, SCM_CDR (xorig));
+}
+
+
+#ifdef __STDC__
+SCM 
+scm_m_set (SCM xorig, SCM env)
+#else
+SCM 
+scm_m_set (xorig, env)
+     SCM xorig;
+     SCM env;
+#endif
+{
+  SCM x;
+  int len;
+
+  x = SCM_CDR (xorig);
+  len = scm_ilength (x);
+  ASSYNT ((len > 0) && !(len & 1), xorig, s_expression, "set!");
+
+  {
+    SCM y;
+    y = x;
+    while (len)
+      {
+	ASSYNT (SCM_NIMP (SCM_CAR (y)) && SCM_SYMBOLP (SCM_CAR (y)),
+		xorig, s_variable, "set!");
+	y = SCM_CDR (SCM_CDR (x));
+	len -= 2;
+      }
+  }
+  return scm_cons (SCM_IM_SET, x);
+}
+
+
+#if 0
+#ifdef __STDC__
+SCM 
+scm_m_vref (SCM xorig, SCM env)
+#else
+SCM 
+scm_m_vref (xorig, env)
+     SCM xorig;
+     SCM env;
+#endif
+{
+  SCM x = SCM_CDR (xorig);
+  ASSYNT (1 == scm_ilength (x), xorig, s_expression, s_vref);
+  if (SCM_NIMP(x) && UDSCM_VARIABLEP (SCM_CAR (x)))
+    {
+      scm_everr (SCM_UNDEFINED, env, SCM_CAR(SCM_CDR(x)), s_variable,
+		 "global variable reference");
+    }
+  ASSYNT (SCM_NIMP(x) && DEFSCM_VARIABLEP (SCM_CAR (x)),
+	  xorig, s_variable, s_vref);
+  return 
+  return scm_cons (IM_VREF, x);
+}
+
+
+#ifdef __STDC__
+SCM 
+scm_m_vset (SCM xorig, SCM env)
+#else
+SCM 
+scm_m_vset (xorig, env)
+     SCM xorig;
+     SCM env;
+#endif
+{
+  SCM x = SCM_CDR (xorig);
+  ASSYNT (3 == scm_ilength (x), xorig, s_expression, s_vset);
+  ASSYNT ((   DEFSCM_VARIABLEP (SCM_CAR (x))
+	   || UDSCM_VARIABLEP (SCM_CAR (x))),
+	  xorig, s_variable, s_vset);
+  return scm_cons (IM_VSET, x);
+}
+#endif 
+
+
+#ifdef __STDC__
+SCM 
+scm_m_and (SCM xorig, SCM env)
+#else
+SCM 
+scm_m_and (xorig, env)
+     SCM xorig;
+     SCM env;
+#endif
+{
+  int len = scm_ilength (SCM_CDR (xorig));
+  ASSYNT (len >= 0, xorig, s_test, "and");
+  if (len >= 1)
+    return scm_cons (SCM_IM_AND, SCM_CDR (xorig));
+  else
+    return SCM_BOOL_T;
+}
+
+
+#ifdef __STDC__
+SCM 
+scm_m_or (SCM xorig, SCM env)
+#else
+SCM 
+scm_m_or (xorig, env)
+     SCM xorig;
+     SCM env;
+#endif
+{
+  int len = scm_ilength (SCM_CDR (xorig));
+  ASSYNT (len >= 0, xorig, s_test, "or");
+  if (len >= 1)
+    return scm_cons (SCM_IM_OR, SCM_CDR (xorig));
+  else
+    return SCM_BOOL_F;
+}
+
+
+#ifdef __STDC__
+SCM 
+scm_m_case (SCM xorig, SCM env)
+#else
+SCM 
+scm_m_case (xorig, env)
+     SCM xorig;
+     SCM env;
+#endif
+{
+  SCM proc, x = SCM_CDR (xorig);
+  ASSYNT (scm_ilength (x) >= 2, xorig, s_clauses, "case");
+  while (SCM_NIMP (x = SCM_CDR (x)))
+    {
+      proc = SCM_CAR (x);
+      ASSYNT (scm_ilength (proc) >= 2, xorig, s_clauses, "case");
+      ASSYNT (scm_ilength (SCM_CAR (proc)) >= 0 || scm_i_else == SCM_CAR (proc),
+	      xorig, s_clauses, "case");
+    }
+  return scm_cons (SCM_IM_CASE, SCM_CDR (xorig));
+}
+
+
+#ifdef __STDC__
+SCM 
+scm_m_cond (SCM xorig, SCM env)
+#else
+SCM 
+scm_m_cond (xorig, env)
+     SCM xorig;
+     SCM env;
+#endif
+{
+  SCM arg1, x = SCM_CDR (xorig);
+  int len = scm_ilength (x);
+  ASSYNT (len >= 1, xorig, s_clauses, "cond");
+  while (SCM_NIMP (x))
+    {
+      arg1 = SCM_CAR (x);
+      len = scm_ilength (arg1);
+      ASSYNT (len >= 1, xorig, s_clauses, "cond");
+      if (scm_i_else == SCM_CAR (arg1))
+	{
+	  ASSYNT (SCM_NULLP (SCM_CDR (x)) && len >= 2, xorig, "bad ELSE clause", "cond");
+	  SCM_CAR (arg1) = SCM_BOOL_T;
+	}
+      if (len >= 2 && scm_i_arrow == SCM_CAR (SCM_CDR (arg1)))
+	ASSYNT (3 == len && SCM_NIMP (SCM_CAR (SCM_CDR (SCM_CDR (arg1)))),
+		xorig, "bad recipient", "cond");
+      x = SCM_CDR (x);
+    }
+  return scm_cons (SCM_IM_COND, SCM_CDR (xorig));
+}
+
+
+#ifdef __STDC__
+SCM 
+scm_m_lambda (SCM xorig, SCM env)
+#else
+SCM 
+scm_m_lambda (xorig, env)
+     SCM xorig;
+     SCM env;
+#endif
+{
+  SCM proc, x = SCM_CDR (xorig);
+  if (scm_ilength (x) < 2)
+    goto badforms;
+  proc = SCM_CAR (x);
+  if SCM_NULLP
+    (proc) goto memlambda;
+  if SCM_IMP
+    (proc) goto badforms;
+  if SCM_SYMBOLP
+    (proc) goto memlambda;
+  if SCM_NCONSP
+    (proc) goto badforms;
+  while SCM_NIMP
+    (proc)
+    {
+      if SCM_NCONSP
+	(proc)
+	  if (!SCM_SYMBOLP (proc))
+	  goto badforms;
+	else
+	  goto memlambda;
+      if (!(SCM_NIMP (SCM_CAR (proc)) && SCM_SYMBOLP (SCM_CAR (proc))))
+	goto badforms;
+      proc = SCM_CDR (proc);
+    }
+  if SCM_NNULLP
+    (proc)
+  badforms:scm_wta (xorig, s_formals, "lambda");
+memlambda:
+  bodycheck (xorig, &SCM_CDR (x), "lambda");
+  return scm_cons (SCM_IM_LAMBDA, SCM_CDR (xorig));
+}
+
+
+#ifdef __STDC__
+SCM 
+scm_m_letstar (SCM xorig, SCM env)
+#else
+SCM 
+scm_m_letstar (xorig, env)
+     SCM xorig;
+     SCM env;
+#endif
+{
+  SCM x = SCM_CDR (xorig), arg1, proc, vars = SCM_EOL, *varloc = &vars;
+  int len = scm_ilength (x);
+  ASSYNT (len >= 2, xorig, s_body, "let*");
+  proc = SCM_CAR (x);
+  ASSYNT (scm_ilength (proc) >= 0, xorig, s_bindings, "let*");
+  while SCM_NIMP
+    (proc)
+    {
+      arg1 = SCM_CAR (proc);
+      ASSYNT (2 == scm_ilength (arg1), xorig, s_bindings, "let*");
+      ASSYNT (SCM_NIMP (SCM_CAR (arg1)) && SCM_SYMBOLP (SCM_CAR (arg1)), xorig, s_variable, "let*");
+      *varloc = scm_cons2 (SCM_CAR (arg1), SCM_CAR (SCM_CDR (arg1)), SCM_EOL);
+      varloc = &SCM_CDR (SCM_CDR (*varloc));
+      proc = SCM_CDR (proc);
+    }
+  x = scm_cons (vars, SCM_CDR (x));
+  bodycheck (xorig, &SCM_CDR (x), "let*");
+  return scm_cons (SCM_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
+   */
+
+
+#ifdef __STDC__
+SCM 
+scm_m_do (SCM xorig, SCM env)
+#else
+SCM 
+scm_m_do (xorig, env)
+     SCM xorig;
+     SCM env;
+#endif
+{
+  SCM x = SCM_CDR (xorig), arg1, proc;
+  SCM vars = SCM_EOL, inits = SCM_EOL, steps = SCM_EOL;
+  SCM *initloc = &inits, *steploc = &steps;
+  int len = scm_ilength (x);
+  ASSYNT (len >= 2, xorig, s_test, "do");
+  proc = SCM_CAR (x);
+  ASSYNT (scm_ilength (proc) >= 0, xorig, s_bindings, "do");
+  while SCM_NIMP
+    (proc)
+    {
+      arg1 = SCM_CAR (proc);
+      len = scm_ilength (arg1);
+      ASSYNT (2 == len || 3 == len, xorig, s_bindings, "do");
+      ASSYNT (SCM_NIMP (SCM_CAR (arg1)) && SCM_SYMBOLP (SCM_CAR (arg1)), xorig, s_variable, "do");
+      /* vars reversed here, inits and steps reversed at evaluation */
+      vars = scm_cons (SCM_CAR (arg1), vars);	/* variable */
+      arg1 = SCM_CDR (arg1);
+      *initloc = scm_cons (SCM_CAR (arg1), SCM_EOL);	/* init */
+      initloc = &SCM_CDR (*initloc);
+      arg1 = SCM_CDR (arg1);
+      *steploc = scm_cons (SCM_IMP (arg1) ? SCM_CAR (vars) : SCM_CAR (arg1), SCM_EOL);	/* step */
+      steploc = &SCM_CDR (*steploc);
+      proc = SCM_CDR (proc);
+    }
+  x = SCM_CDR (x);
+  ASSYNT (scm_ilength (SCM_CAR (x)) >= 1, xorig, s_test, "do");
+  x = scm_cons2 (SCM_CAR (x), SCM_CDR (x), steps);
+  x = scm_cons2 (vars, inits, x);
+  bodycheck (xorig, &SCM_CAR (SCM_CDR (SCM_CDR (x))), "do");
+  return scm_cons (SCM_IM_DO, x);
+}
+
+/* evalcar is small version of inline EVALCAR when we don't care about speed */
+#ifdef __STDC__
+static SCM 
+evalcar (SCM x, SCM env)
+#else
+static SCM 
+evalcar (x, env)
+     SCM x;
+     SCM env;
+#endif
+{
+  return XEVALCAR (x, env);
+}
+
+#ifdef __STDC__
+static SCM 
+iqq (SCM form, SCM env, int depth)
+#else
+static SCM 
+iqq (form, env, depth)
+     SCM form;
+     SCM env;
+     int depth;
+#endif
+{
+  SCM tmp;
+  int edepth = depth;
+  if SCM_IMP
+    (form) return form;
+  if (SCM_VECTORP (form))
+    {
+      long i = SCM_LENGTH (form);
+      SCM *data = SCM_VELTS (form);
+      tmp = SCM_EOL;
+      for (; --i >= 0;)
+	tmp = scm_cons (data[i], tmp);
+      return scm_vector (iqq (tmp, env, depth));
+    }
+  if SCM_NCONSP
+    (form) return form;
+  tmp = SCM_CAR (form);
+  if (scm_i_quasiquote == tmp)
+    {
+      depth++;
+      goto label;
+    }
+  if (scm_i_unquote == tmp)
+    {
+      --depth;
+    label:
+      form = SCM_CDR (form);
+      /* !!! might need a check here to be sure that form isn't a struct. */
+      SCM_ASSERT (SCM_NIMP (form) && SCM_ECONSP (form) && SCM_NULLP (SCM_CDR (form)),
+	      form, SCM_ARG1, s_quasiquote);
+      if (0 == depth)
+	return evalcar (form, env);
+      return scm_cons2 (tmp, iqq (SCM_CAR (form), env, depth), SCM_EOL);
+    }
+  if (SCM_NIMP (tmp) && (scm_i_uq_splicing == SCM_CAR (tmp)))
+    {
+      tmp = SCM_CDR (tmp);
+      if (0 == --edepth)
+	return scm_append (scm_cons2 (evalcar (tmp, env), iqq (SCM_CDR (form), env, depth), SCM_EOL));
+    }
+  return scm_cons (iqq (SCM_CAR (form), env, edepth), iqq (SCM_CDR (form), env, depth));
+}
+
+/* Here are acros which return values rather than code. */
+
+#ifdef __STDC__
+SCM 
+scm_m_quasiquote (SCM xorig, SCM env)
+#else
+SCM 
+scm_m_quasiquote (xorig, env)
+     SCM xorig;
+     SCM env;
+#endif
+{
+  SCM x = SCM_CDR (xorig);
+  ASSYNT (scm_ilength (x) == 1, xorig, s_expression, s_quasiquote);
+  return iqq (SCM_CAR (x), env, 1);
+}
+
+#ifdef __STDC__
+SCM 
+scm_m_delay (SCM xorig, SCM env)
+#else
+SCM 
+scm_m_delay (xorig, env)
+     SCM xorig;
+     SCM env;
+#endif
+{
+  ASSYNT (scm_ilength (xorig) == 2, xorig, s_expression, s_delay);
+  xorig = SCM_CDR (xorig);
+  return scm_makprom (scm_closure (scm_cons2 (SCM_EOL, SCM_CAR (xorig), SCM_CDR (xorig)),
+				   env));
+}
+
+#ifdef __STDC__
+static SCM
+env_top_level (SCM env)
+#else
+static SCM
+env_top_level (env)
+     SCM env;
+#endif
+{
+  while (SCM_NIMP(env))
+    {
+      if (SCM_BOOL_T == scm_procedure_p (SCM_CAR(env)))
+	return SCM_CAR(env);
+      env = SCM_CDR (env);
+    }
+  return SCM_BOOL_F;
+}
+
+#ifdef __STDC__
+SCM 
+scm_m_define (SCM x, SCM env)
+#else
+SCM 
+scm_m_define (x, env)
+     SCM x;
+     SCM env;
+#endif
+{
+  SCM proc, arg1 = x;
+  x = SCM_CDR (x);
+  /*  ASSYNT(SCM_NULLP(env), x, "bad placement", s_define);*/
+  ASSYNT (scm_ilength (x) >= 2, arg1, s_expression, "define");
+  proc = SCM_CAR (x);
+  x = SCM_CDR (x);
+  while (SCM_NIMP (proc) && SCM_CONSP (proc))
+    {				/* nested define syntax */
+      x = scm_cons (scm_cons2 (scm_i_lambda, SCM_CDR (proc), x), SCM_EOL);
+      proc = SCM_CAR (proc);
+    }
+  ASSYNT (SCM_NIMP (proc) && SCM_SYMBOLP (proc), arg1, s_variable, "define");
+  ASSYNT (1 == scm_ilength (x), arg1, s_expression, "define");
+  if (SCM_TOP_LEVEL (env))
+    {
+      x = evalcar (x, env);
+      arg1 = scm_sym2vcell (proc, env_top_level (env), SCM_BOOL_T);
+#if 0
+#ifndef RECKLESS
+      if (SCM_NIMP (SCM_CDR (arg1)) && ((SCM) SCM_SNAME (SCM_CDR (arg1)) == proc)
+	  && (SCM_CDR (arg1) != x))
+	scm_warn ("redefining built-in ", SCM_CHARS (proc));
+      else
+#endif
+      if (5 <= scm_verbose && SCM_UNDEFINED != SCM_CDR (arg1))
+	scm_warn ("redefining ", SCM_CHARS (proc));
+#endif
+#ifdef DEBUG_EXTENSIONS
+      if (RECORD_PROCNAMES && SCM_NIMP (x) && SCM_CLOSUREP (x))
+	scm_set_procedure_property_x (x, scm_i_name, proc);
+#endif
+      SCM_CDR (arg1) = x;
+#ifdef SICP
+      return scm_cons2 (scm_i_quote, SCM_CAR (arg1), SCM_EOL);
+#else
+      return SCM_UNSPECIFIED;
+#endif
+    }
+  return scm_cons2 (SCM_IM_DEFINE, proc, x);
+}
+/* end of acros */
+
+#ifdef __STDC__
+SCM 
+scm_m_letrec (SCM xorig, SCM env)
+#else
+SCM 
+scm_m_letrec (xorig, env)
+     SCM xorig;
+     SCM env;
+#endif
+{
+  SCM cdrx = SCM_CDR (xorig);	/* locally mutable version of form */
+  char *what = SCM_CHARS (SCM_CAR (xorig));
+  SCM x = cdrx, proc, arg1;	/* structure traversers */
+  SCM vars = SCM_EOL, inits = SCM_EOL, *initloc = &inits;
+
+  ASRTSYNTAX (scm_ilength (x) >= 2, s_body);
+  proc = SCM_CAR (x);
+  if SCM_NULLP
+    (proc) return scm_m_letstar (xorig, env);	/* null binding, let* faster */
+  ASRTSYNTAX (scm_ilength (proc) >= 1, s_bindings);
+  do
+    {
+      /* vars scm_list reversed here, inits reversed at evaluation */
+      arg1 = SCM_CAR (proc);
+      ASRTSYNTAX (2 == scm_ilength (arg1), s_bindings);
+      ASRTSYNTAX (SCM_NIMP (SCM_CAR (arg1)) && SCM_SYMBOLP (SCM_CAR (arg1)), s_variable);
+      vars = scm_cons (SCM_CAR (arg1), vars);
+      *initloc = scm_cons (SCM_CAR (SCM_CDR (arg1)), SCM_EOL);
+      initloc = &SCM_CDR (*initloc);
+    }
+  while SCM_NIMP
+  (proc = SCM_CDR (proc));
+  cdrx = scm_cons2 (vars, inits, SCM_CDR (x));
+  bodycheck (xorig, &SCM_CDR (SCM_CDR (cdrx)), what);
+  return scm_cons (SCM_IM_LETREC, cdrx);
+}
+
+#ifdef __STDC__
+SCM 
+scm_m_let (SCM xorig, SCM env)
+#else
+SCM 
+scm_m_let (xorig, env)
+     SCM xorig;
+     SCM env;
+#endif
+{
+  SCM cdrx = SCM_CDR (xorig);	/* locally mutable version of form */
+  SCM x = cdrx, proc, arg1, name;	/* structure traversers */
+  SCM vars = SCM_EOL, inits = SCM_EOL, *varloc = &vars, *initloc = &inits;
+
+  ASSYNT (scm_ilength (x) >= 2, xorig, s_body, "let");
+  proc = SCM_CAR (x);
+  if (SCM_NULLP (proc)
+      || (SCM_NIMP (proc) && SCM_CONSP (proc)
+	  && SCM_NIMP (SCM_CAR (proc)) && SCM_CONSP (SCM_CAR (proc)) && SCM_NULLP (SCM_CDR (proc))))
+    return scm_m_letstar (xorig, env);	/* null or single binding, let* is faster */
+  ASSYNT (SCM_NIMP (proc), xorig, s_bindings, "let");
+  if (SCM_CONSP (proc))			/* plain let, proc is <bindings> */
+      return scm_cons (SCM_IM_LET, SCM_CDR (scm_m_letrec (xorig, env)));
+  if (!SCM_SYMBOLP (proc))
+    scm_wta (xorig, s_bindings, "let");	/* bad let */
+  name = proc;			/* named let, build equiv letrec */
+  x = SCM_CDR (x);
+  ASSYNT (scm_ilength (x) >= 2, xorig, s_body, "let");
+  proc = SCM_CAR (x);		/* bindings scm_list */
+  ASSYNT (scm_ilength (proc) >= 0, xorig, s_bindings, "let");
+  while SCM_NIMP
+    (proc)
+    {				/* vars and inits both in order */
+      arg1 = SCM_CAR (proc);
+      ASSYNT (2 == scm_ilength (arg1), xorig, s_bindings, "let");
+      ASSYNT (SCM_NIMP (SCM_CAR (arg1)) && SCM_SYMBOLP (SCM_CAR (arg1)), xorig, s_variable, "let");
+      *varloc = scm_cons (SCM_CAR (arg1), SCM_EOL);
+      varloc = &SCM_CDR (*varloc);
+      *initloc = scm_cons (SCM_CAR (SCM_CDR (arg1)), SCM_EOL);
+      initloc = &SCM_CDR (*initloc);
+      proc = SCM_CDR (proc);
+    }
+  return
+    scm_m_letrec (scm_cons2 (scm_i_let,
+			     scm_cons (scm_cons2 (name, scm_cons2 (scm_i_lambda, vars, SCM_CDR (x)), SCM_EOL), SCM_EOL),
+			     scm_acons (name, inits, SCM_EOL)), 	/* body */
+		  env);
+}
+
+
+#ifdef __STDC__
+SCM 
+scm_m_apply (SCM xorig, SCM env)
+#else
+SCM 
+scm_m_apply (xorig, env)
+     SCM xorig;
+     SCM env;
+#endif
+{
+  ASSYNT (scm_ilength (SCM_CDR (xorig)) == 2, xorig, s_expression, "@apply");
+  return scm_cons (SCM_IM_APPLY, SCM_CDR (xorig));
+}
+
+#define s_atcall_cc (SCM_ISYMSCM_CHARS(SCM_IM_CONT)+1)
+
+#ifdef __STDC__
+SCM 
+scm_m_cont (SCM xorig, SCM env)
+#else
+SCM 
+scm_m_cont (xorig, env)
+     SCM xorig;
+     SCM env;
+#endif
+{
+  ASSYNT (scm_ilength (SCM_CDR (xorig)) == 1, xorig, s_expression, "@call-with-current-continuation");
+  return scm_cons (SCM_IM_CONT, SCM_CDR (xorig));
+}
+
+#ifndef RECKLESS
+#ifdef __STDC__
+int 
+scm_badargsp (SCM formals, SCM args)
+#else
+int 
+scm_badargsp (formals, args)
+     SCM formals;
+     SCM args;
+#endif
+{
+  while SCM_NIMP
+    (formals)
+    {
+      if SCM_NCONSP
+	(formals) return 0;
+      if SCM_IMP
+	(args) return 1;
+      formals = SCM_CDR (formals);
+      args = SCM_CDR (args);
+    }
+  return SCM_NNULLP (args) ? 1 : 0;
+}
+#endif
+
+
+
+long scm_tc16_macro;
+
+#endif /* !DEVAL */
+
+#ifdef DEVAL
+#undef SCM_EVAL_ARGS
+#define SCM_EVAL_ARGS scm_deval_args
+#undef SCM_CEVAL
+#define SCM_CEVAL scm_deval	/* Substitute all uses of scm_ceval */
+#undef SCM_APPLY
+#define SCM_APPLY scm_dapply
+#undef RETURN
+#define RETURN(e) {proc = (e); goto exit;}
+#else
+#define SCM_EVAL_ARGS scm_eval_args
+#define RETURN(x) return x;
+#endif
+
+SCM 
+SCM_EVAL_ARGS (l, env)
+     SCM l, env;
+{
+  SCM res = SCM_EOL, *lloc = &res;
+  while (SCM_NIMP (l))
+    {
+      *lloc = scm_cons (EVALCAR (l, env), SCM_EOL);
+      lloc = &SCM_CDR (*lloc);
+      l = SCM_CDR (l);
+    }
+  return res;
+}
+
+#if 0
+#ifdef __STDC__
+SCM 
+scm_ceval (SCM x, SCM env)
+#else
+SCM 
+scm_ceval (x, env)
+     SCM x;
+     SCM env;
+#endif
+{}
+#endif
+#if 0
+#ifdef __STDC__
+SCM 
+scm_deval (SCM x, SCM env)
+#else
+SCM 
+scm_deval (x, env)
+     SCM x;
+     SCM env;
+#endif
+{}
+#endif
+
+#ifdef SCM_FLOATS
+#define CHECK_EQVISH(A,B) 	(((A) == (B)) || (SCM_NFALSEP (scm_eqv_p ((A), (B)))))
+#else
+#define CHECK_EQVISH(A,B) 	((A) == (B))
+#endif
+
+
+SCM
+SCM_CEVAL (x, env)
+     SCM x;
+     SCM env;
+{
+  union
+    {
+      SCM *lloc;
+      SCM arg1;
+    } t;
+  SCM proc;
+  SCM arg2;
+
+  SCM_CHECK_STACK;
+
+ loop:
+  SCM_ASYNC_TICK;
+
+  switch (SCM_TYP7 (x))
+    {
+    case scm_tcs_symbols:
+      /* Only happens when called at top level.
+       */
+      x = scm_cons (x, SCM_UNDEFINED);
+      goto retval;
+
+    case (127 & SCM_IM_AND):
+      x = SCM_CDR (x);
+      t.arg1 = x;
+      while (SCM_NNULLP (t.arg1 = SCM_CDR (t.arg1)))
+	if (SCM_FALSEP (EVALCAR (x, env)))
+	  {
+	    RETURN (SCM_BOOL_F);
+	  }
+	else
+	  x = t.arg1;
+      goto carloop;
+
+    case (127 & SCM_IM_BEGIN):
+
+    cdrxbegin:
+      x = SCM_CDR (x);
+
+    begin:
+      t.arg1 = x;
+      while (SCM_NNULLP (t.arg1 = SCM_CDR (t.arg1)))
+	{
+	  SIDEVAL (SCM_CAR (x), env);
+	  x = t.arg1;
+	}
+
+    carloop:			/* scm_eval car of last form in list */
+      if (SCM_NCELLP (SCM_CAR (x)))
+	{
+	  x = SCM_CAR (x);
+	  RETURN (SCM_IMP (x) ? EVALIMP (x, env) : SCM_GLOC_VAL (x));
+	}
+
+      if (SCM_SYMBOLP (SCM_CAR (x)))
+	{
+	retval:
+	  RETURN (*scm_lookupcar (x, env));
+	}
+
+      x = SCM_CAR (x);
+      goto loop;		/* tail recurse */
+
+
+    case (127 & SCM_IM_CASE):
+      x = SCM_CDR (x);
+      t.arg1 = EVALCAR (x, env);
+      while (SCM_NIMP (x = SCM_CDR (x)))
+	{
+	  proc = SCM_CAR (x);
+	  if (scm_i_else == SCM_CAR (proc))
+	    {
+	      x = SCM_CDR (proc);
+	      goto begin;
+	    }
+	  proc = SCM_CAR (proc);
+	  while (SCM_NIMP (proc))
+	    {
+	      if (CHECK_EQVISH (SCM_CAR (proc), t.arg1))
+		{
+		  x = SCM_CDR (SCM_CAR (x));
+		  goto begin;
+		}
+	      proc = SCM_CDR (proc);
+	    }
+	}
+      RETURN (SCM_UNSPECIFIED);
+
+
+    case (127 & SCM_IM_COND):
+      while (SCM_NIMP (x = SCM_CDR (x)))
+	{
+	  proc = SCM_CAR (x);
+	  t.arg1 = EVALCAR (proc, env);
+	  if (SCM_NFALSEP (t.arg1))
+	    {
+	      x = SCM_CDR (proc);
+	      if (SCM_NULLP (x))
+		{
+		  RETURN (t.arg1);
+		}
+	      if (scm_i_arrow != SCM_CAR (x))
+		goto begin;
+	      proc = SCM_CDR (x);
+	      proc = EVALCAR (proc, env);
+	      SCM_ASRTGO (SCM_NIMP (proc), badfun);
+	      goto evap1;
+	    }
+	}
+      RETURN (SCM_UNSPECIFIED);
+
+
+    case (127 & SCM_IM_DO):
+      x = SCM_CDR (x);
+      proc = SCM_CAR (SCM_CDR (x)); /* inits */
+      t.arg1 = SCM_EOL;		/* values */
+      while (SCM_NIMP (proc))
+	{
+	  t.arg1 = scm_cons (EVALCAR (proc, env), t.arg1);
+	  proc = SCM_CDR (proc);
+	}
+      env = EXTEND_SCM_ENV (SCM_CAR (x), t.arg1, env);
+      x = SCM_CDR (SCM_CDR (x));
+      while (proc = SCM_CAR (x), SCM_FALSEP (EVALCAR (proc, env)))
+	{
+	  for (proc = SCM_CAR (SCM_CDR (x)); SCM_NIMP (proc); proc = SCM_CDR (proc))
+	    {
+	      t.arg1 = SCM_CAR (proc); /* body */
+	      SIDEVAL (t.arg1, env);
+	    }
+	  for (t.arg1 = SCM_EOL, proc = SCM_CDR (SCM_CDR (x)); SCM_NIMP (proc); proc = SCM_CDR (proc))
+	    t.arg1 = scm_cons (EVALCAR (proc, env), t.arg1); /* steps */
+	  env = EXTEND_SCM_ENV (SCM_CAR (SCM_CAR (env)), t.arg1, SCM_CDR (env));
+	}
+      x = SCM_CDR (proc);
+      if (SCM_NULLP (x))
+	{
+	  RETURN (SCM_UNSPECIFIED);
+	}
+      goto begin;
+
+
+    case (127 & SCM_IM_IF):
+      x = SCM_CDR (x);
+      if (SCM_NFALSEP (EVALCAR (x, env)))
+	x = SCM_CDR (x);
+      else if (SCM_IMP (x = SCM_CDR (SCM_CDR (x))))
+	{
+	  RETURN (SCM_UNSPECIFIED);
+	}
+      goto carloop;
+
+
+    case (127 & SCM_IM_LET):
+      x = SCM_CDR (x);
+      proc = SCM_CAR (SCM_CDR (x));
+      t.arg1 = SCM_EOL;
+      do
+	{
+	  t.arg1 = scm_cons (EVALCAR (proc, env), t.arg1);
+	}
+      while (SCM_NIMP (proc = SCM_CDR (proc)));
+      env = EXTEND_SCM_ENV (SCM_CAR (x), t.arg1, env);
+      x = SCM_CDR (x);
+      goto cdrxbegin;
+
+
+    case (127 & SCM_IM_LETREC):
+      x = SCM_CDR (x);
+      env = EXTEND_SCM_ENV (SCM_CAR (x), scm_undefineds, env);
+      x = SCM_CDR (x);
+      proc = SCM_CAR (x);
+      t.arg1 = SCM_EOL;
+      do
+	{
+	  t.arg1 = scm_cons (EVALCAR (proc, env), t.arg1);
+	}
+      while (SCM_NIMP (proc = SCM_CDR (proc)));
+      SCM_CDR (SCM_CAR (env)) = t.arg1;
+      goto cdrxbegin;
+
+
+    case (127 & SCM_IM_LETSTAR):
+      x = SCM_CDR (x);
+      proc = SCM_CAR (x);
+      if (SCM_IMP (proc))
+	{
+	  env = EXTEND_SCM_ENV (SCM_EOL, SCM_EOL, env);
+	  goto cdrxbegin;
+	}
+      do
+	{
+	  t.arg1 = SCM_CAR (proc);
+	  proc = SCM_CDR (proc);
+	  env = EXTEND_SCM_ENV (t.arg1, EVALCAR (proc, env), env);
+	}
+      while (SCM_NIMP (proc = SCM_CDR (proc)));
+      goto cdrxbegin;
+
+    case (127 & SCM_IM_OR):
+      x = SCM_CDR (x);
+      t.arg1 = x;
+      while (SCM_NNULLP (t.arg1 = SCM_CDR (t.arg1)))
+	{
+	  x = EVALCAR (x, env);
+	  if (SCM_NFALSEP (x))
+	    {
+	      RETURN (x);
+	    }
+	  x = t.arg1;
+	}
+      goto carloop;
+
+
+    case (127 & SCM_IM_LAMBDA):
+      RETURN (scm_closure (SCM_CDR (x), env));
+
+
+    case (127 & SCM_IM_QUOTE):
+      RETURN (SCM_CAR (SCM_CDR (x)));
+
+
+    case (127 & SCM_IM_SET):
+    set_some_more:
+      x = SCM_CDR (x);
+      proc = SCM_CAR (x);
+      switch (7 & (int)proc)
+	{
+	case 0:
+	  t.lloc = scm_lookupcar (x, env);
+	  break;
+	case 1:
+	  t.lloc = &SCM_GLOC_VAL (proc);
+	  break;
+#ifdef MEMOIZE_LOCALS
+	case 4:
+	  t.lloc = scm_ilookup (proc, env);
+	  break;
+#endif
+	}
+      x = SCM_CDR (x);
+      *t.lloc = EVALCAR (x, env);
+      if (!SCM_NULLP (SCM_CDR(x)))
+	goto set_some_more;
+#ifdef SICP
+      RETURN (*t.lloc);
+#else
+      RETURN (SCM_UNSPECIFIED);
+#endif
+
+
+    case (127 & SCM_IM_DEFINE):	/* only for internal defines */
+      x = SCM_CDR (x);
+      proc = SCM_CAR (x);
+      x = SCM_CDR (x);
+      x = evalcar (x, env);
+      env = SCM_CAR (env);
+      SCM_DEFER_INTS;
+      SCM_CAR (env) = scm_cons (proc, SCM_CAR (env));
+      SCM_CDR (env) = scm_cons (x, SCM_CDR (env));
+      SCM_ALLOW_INTS;
+      RETURN (SCM_UNSPECIFIED);
+
+
+
+      /* new syntactic forms go here. */
+    case (127 & SCM_MAKISYM (0)):
+      proc = SCM_CAR (x);
+      SCM_ASRTGO (SCM_ISYMP (proc), badfun);
+      switch SCM_ISYMNUM (proc)
+	{
+#if 0
+	case (SCM_ISYMNUM (IM_VREF)):
+	  {
+	    SCM var;
+	    var = SCM_CAR (SCM_CDR (x));
+	    RETURN (SCM_CDR(var));
+	  }
+	case (SCM_ISYMNUM (IM_VSET)):
+	  SCM_CDR (SCM_CAR ( SCM_CDR (x))) = EVALCAR( SCM_CDR ( SCM_CDR (x)), env);
+	  SCM_CAR (SCM_CAR ( SCM_CDR (x))) = scm_tc16_variable;
+	  RETURN (SCM_UNSPECIFIED);
+#endif
+
+	case (SCM_ISYMNUM (SCM_IM_APPLY)):
+	  proc = SCM_CDR (x);
+	  proc = EVALCAR (proc, env);
+	  SCM_ASRTGO (SCM_NIMP (proc), badfun);
+	  if (SCM_CLOSUREP (proc))
+	    {
+	      t.arg1 = SCM_CDR (SCM_CDR (x));
+	      t.arg1 = EVALCAR (t.arg1, env);
+#ifndef RECKLESS
+	      if (scm_badargsp (SCM_CAR (SCM_CODE (proc)), t.arg1))
+		goto wrongnumargs;
+#endif
+	      env = EXTEND_SCM_ENV (SCM_CAR (SCM_CODE (proc)), t.arg1, SCM_ENV (proc));
+	      x = SCM_CODE (proc);
+	      goto cdrxbegin;
+	    }
+	  proc = scm_i_apply;
+	  goto evapply;
+
+	case (SCM_ISYMNUM (SCM_IM_CONT)):
+	  scm_make_cont (&t.arg1);
+	  if (setjmp (SCM_JMPBUF (t.arg1)))
+	    {
+	      SCM val;
+	      val = SCM_THROW_VALUE (t.arg1);
+	      RETURN (val);;
+	    }
+	  proc = SCM_CDR (x);
+	  proc = evalcar (proc, env);
+	  SCM_ASRTGO (SCM_NIMP (proc), badfun);
+	  goto evap1;
+
+	default:
+	  goto badfun;
+	}
+
+    default:
+      proc = x;
+    badfun:
+      scm_everr (x, env, proc, "Wrong type to apply: ", "");
+
+    case scm_tc7_vector:
+    case scm_tc7_wvect:
+    case scm_tc7_bvect:
+    case scm_tc7_byvect:
+    case scm_tc7_svect:
+    case scm_tc7_ivect:
+    case scm_tc7_uvect:
+    case scm_tc7_fvect:
+    case scm_tc7_dvect:
+    case scm_tc7_cvect:
+#ifdef LONGLONGS
+    case scm_tc7_llvect:
+#endif
+    case scm_tc7_string:
+    case scm_tc7_mb_string:
+    case scm_tc7_substring:
+    case scm_tc7_mb_substring:
+    case scm_tc7_smob:
+    case scm_tcs_closures:
+    case scm_tcs_subrs:
+      RETURN (x);
+
+#ifdef MEMOIZE_LOCALS
+    case (127 & SCM_ILOC00):
+      proc = *scm_ilookup (SCM_CAR (x), env);
+      SCM_ASRTGO (SCM_NIMP (proc), badfun);
+#ifndef RECKLESS
+#ifdef CAUTIOUS
+      goto checkargs;
+#endif
+#endif
+      break;
+#endif /* ifdef MEMOIZE_LOCALS */
+
+
+    case scm_tcs_cons_gloc:
+      proc = SCM_GLOC_VAL (SCM_CAR (x));
+      SCM_ASRTGO (SCM_NIMP (proc), badfun);
+#ifndef RECKLESS
+#ifdef CAUTIOUS
+      goto checkargs;
+#endif
+#endif
+      break;
+
+
+    case scm_tcs_cons_nimcar:
+      if (SCM_SYMBOLP (SCM_CAR (x)))
+	{
+	  proc = *scm_lookupcar (x, env);
+	  if (SCM_IMP (proc))
+	    {
+	      unmemocar (x, env);
+	      goto badfun;
+	    }
+	  if (scm_tc16_macro == SCM_TYP16 (proc))
+	    {
+	      unmemocar (x, env);
+
+	    handle_a_macro:
+	      t.arg1 = SCM_APPLY (SCM_CDR (proc), x, scm_cons (env, scm_listofnull));
+	      switch ((int) (SCM_CAR (proc) >> 16))
+		{
+		case 2:
+		  if (scm_ilength (t.arg1) <= 0)
+		    t.arg1 = scm_cons2 (SCM_IM_BEGIN, t.arg1, SCM_EOL);
+		  SCM_DEFER_INTS;
+		  SCM_CAR (x) = SCM_CAR (t.arg1);
+		  SCM_CDR (x) = SCM_CDR (t.arg1);
+		  SCM_ALLOW_INTS;
+		  goto loop;
+		case 1:
+		  if (SCM_NIMP (x = t.arg1))
+		    goto loop;
+		case 0:
+		  RETURN (t.arg1);
+		}
+	    }
+	}
+      else
+	proc = SCM_CEVAL (SCM_CAR (x), env);
+      SCM_ASRTGO (SCM_NIMP (proc), badfun);
+#ifndef RECKLESS
+#ifdef CAUTIOUS
+    checkargs:
+#endif
+      if (SCM_CLOSUREP (proc))
+	{
+	  arg2 = SCM_CAR (SCM_CODE (proc));
+	  t.arg1 = SCM_CDR (x);
+	  while (SCM_NIMP (arg2))
+	    {
+	      if (SCM_NCONSP (arg2))
+		goto evapply;
+	      if (SCM_IMP (t.arg1))
+		goto umwrongnumargs;
+	      arg2 = SCM_CDR (arg2);
+	      t.arg1 = SCM_CDR (t.arg1);
+	    }
+	  if (SCM_NNULLP (t.arg1))
+	    goto umwrongnumargs;
+	}
+      else if (scm_tc16_macro == SCM_TYP16 (proc))
+	goto handle_a_macro;
+#endif
+    }
+
+
+ evapply:
+  if (SCM_NULLP (SCM_CDR (x)))
+    switch (SCM_TYP7 (proc))
+      {				/* no arguments given */
+      case scm_tc7_subr_0:
+	RETURN (SCM_SUBRF (proc) ());
+      case scm_tc7_subr_1o:
+	RETURN (SCM_SUBRF (proc) (SCM_UNDEFINED));
+      case scm_tc7_lsubr:
+	RETURN (SCM_SUBRF (proc) (SCM_EOL));
+      case scm_tc7_rpsubr:
+	RETURN (SCM_BOOL_T);
+      case scm_tc7_asubr:
+	RETURN (SCM_SUBRF (proc) (SCM_UNDEFINED, SCM_UNDEFINED));
+      case scm_tc7_cclo:
+	t.arg1 = proc;
+	proc = SCM_CCLO_SUBR (proc);
+	goto evap1;
+      case scm_tcs_closures:
+	x = SCM_CODE (proc);
+	env = EXTEND_SCM_ENV (SCM_CAR (x), SCM_EOL, SCM_ENV (proc));
+	goto cdrxbegin;
+      case scm_tc7_contin:
+      case scm_tc7_subr_1:
+      case scm_tc7_subr_2:
+      case scm_tc7_subr_2o:
+      case scm_tc7_cxr:
+      case scm_tc7_subr_3:
+      case scm_tc7_lsubr_2:
+      umwrongnumargs:
+	unmemocar (x, env);
+      wrongnumargs:
+	scm_everr (x, env, proc, (char *) SCM_WNA, "");
+      default:
+	/* handle macros here */
+	goto badfun;
+      }
+
+
+  /* must handle macros by here */
+  x = SCM_CDR (x);
+#ifdef CAUTIOUS
+  if (SCM_IMP (x))
+    goto wrongnumargs;
+#endif
+  t.arg1 = EVALCAR (x, env);
+  x = SCM_CDR (x);
+  if (SCM_NULLP (x))
+    {
+    evap1:
+      switch (SCM_TYP7 (proc))
+	{			/* have one argument in t.arg1 */
+	case scm_tc7_subr_2o:
+	  RETURN (SCM_SUBRF (proc) (t.arg1, SCM_UNDEFINED));
+	case scm_tc7_subr_1:
+	case scm_tc7_subr_1o:
+	  RETURN (SCM_SUBRF (proc) (t.arg1));
+	case scm_tc7_cxr:
+#ifdef SCM_FLOATS
+	  if (SCM_SUBRF (proc))
+	    {
+	      if (SCM_INUMP (t.arg1))
+		{
+		  RETURN (scm_makdbl (SCM_DSUBRF (proc) ((double) SCM_INUM (t.arg1)),
+				      0.0));
+		}
+	      SCM_ASRTGO (SCM_NIMP (t.arg1), floerr);
+	      if (SCM_REALP (t.arg1))
+		{
+		  RETURN (scm_makdbl (SCM_DSUBRF (proc) (SCM_REALPART (t.arg1)), 0.0));
+		}
+#ifdef SCM_BIGDIG
+	      if (SCM_BIGP (t.arg1))
+		{
+		  RETURN (scm_makdbl (SCM_DSUBRF (proc) (scm_big2dbl (t.arg1)), 0.0));
+		}
+#endif
+	    floerr:
+	      scm_wta (t.arg1, (char *) SCM_ARG1, SCM_CHARS (SCM_SNAME (proc)));
+	    }
+#endif
+	  proc = (SCM) SCM_SNAME (proc);
+	  {
+	    char *chrs = SCM_CHARS (proc) + SCM_LENGTH (proc) - 1;
+	    while ('c' != *--chrs)
+	      {
+		SCM_ASSERT (SCM_NIMP (t.arg1) && SCM_CONSP (t.arg1),
+			    t.arg1, SCM_ARG1, SCM_CHARS (proc));
+		t.arg1 = ('a' == *chrs) ? SCM_CAR (t.arg1) : SCM_CDR (t.arg1);
+	      }
+	    RETURN (t.arg1);
+	  }
+	case scm_tc7_rpsubr:
+	  RETURN (SCM_BOOL_T);
+	case scm_tc7_asubr:
+	  RETURN (SCM_SUBRF (proc) (t.arg1, SCM_UNDEFINED));
+	case scm_tc7_lsubr:
+#ifdef DEVAL
+	  RETURN (SCM_SUBRF (proc) (dbg_info.args));
+#else
+	  RETURN (SCM_SUBRF (proc) (scm_cons (t.arg1, SCM_EOL)));
+#endif
+	case scm_tc7_cclo:
+	  arg2 = t.arg1;
+	  t.arg1 = proc;
+	  proc = SCM_CCLO_SUBR (proc);
+	  goto evap2;
+	case scm_tcs_closures:
+	  x = SCM_CODE (proc);
+#ifdef DEVAL
+	  env = EXTEND_SCM_ENV (SCM_CAR (x), dbg_info.args, SCM_ENV (proc));
+#else
+	  env = EXTEND_SCM_ENV (SCM_CAR (x), scm_cons (t.arg1, SCM_EOL), SCM_ENV (proc));
+#endif
+	  goto cdrxbegin;
+	case scm_tc7_contin:
+	  scm_call_continuation (proc, t.arg1);
+	case scm_tc7_subr_2:
+	case scm_tc7_subr_0:
+	case scm_tc7_subr_3:
+	case scm_tc7_lsubr_2:
+	  goto wrongnumargs;
+	default:
+	  goto badfun;
+	}
+    }
+#ifdef CAUTIOUS
+  if (SCM_IMP (x))
+    goto wrongnumargs;
+#endif
+  {				/* have two or more arguments */
+    arg2 = EVALCAR (x, env);
+    x = SCM_CDR (x);
+    if (SCM_NULLP (x)) {
+#ifdef CCLO
+    evap2:
+#endif
+#ifdef DEVAL
+      dbg_info.args = scm_cons2 (t.arg1, arg2, SCM_EOL);
+#endif
+      switch SCM_TYP7
+	(proc)
+	  {			/* have two arguments */
+	  case scm_tc7_subr_2:
+	  case scm_tc7_subr_2o:
+	    RETURN (SCM_SUBRF (proc) (t.arg1, arg2));
+	  case scm_tc7_lsubr:
+#ifdef DEVAL
+	    RETURN (SCM_SUBRF (proc) (dbg_info.args));
+#else
+	    RETURN (SCM_SUBRF (proc) (scm_cons2 (t.arg1, arg2, SCM_EOL)));
+#endif
+	  case scm_tc7_lsubr_2:
+	    RETURN (SCM_SUBRF (proc) (t.arg1, arg2, SCM_EOL));
+	  case scm_tc7_rpsubr:
+	  case scm_tc7_asubr:
+	    RETURN (SCM_SUBRF (proc) (t.arg1, arg2));
+#ifdef CCLO
+	  cclon: case scm_tc7_cclo:
+	    RETURN (SCM_APPLY (SCM_CCLO_SUBR (proc), proc,
+			       scm_cons2 (t.arg1, arg2, scm_cons (SCM_EVAL_ARGS (x, env), SCM_EOL))));
+	    /*    case scm_tc7_cclo:
+		  x = scm_cons(arg2, scm_eval_args(x, env));
+		  arg2 = t.arg1;
+		  t.arg1 = proc;
+		  proc = SCM_CCLO_SUBR(proc);
+		  goto evap3; */
+#endif
+	  case scm_tc7_subr_0:
+	  case scm_tc7_cxr:
+	  case scm_tc7_subr_1o:
+	  case scm_tc7_subr_1:
+	  case scm_tc7_subr_3:
+	  case scm_tc7_contin:
+	    goto wrongnumargs;
+	  default:
+	    goto badfun;
+	  case scm_tcs_closures:
+#ifdef DEVAL
+	    env = EXTEND_SCM_ENV (SCM_CAR (SCM_CODE (proc)), dbg_info.args, SCM_ENV (proc));
+#else
+	    env = EXTEND_SCM_ENV (SCM_CAR (SCM_CODE (proc)), scm_cons2 (t.arg1, arg2, SCM_EOL), SCM_ENV (proc));
+#endif
+	    x = SCM_CODE (proc);
+	    goto cdrxbegin;
+	  }
+    }
+#ifdef DEVAL
+    dbg_info.args = scm_cons2 (t.arg1, arg2, scm_deval_args (x, env));
+#endif
+    switch SCM_TYP7
+      (proc)
+	{			/* have 3 or more arguments */
+#ifdef DEVAL
+	case scm_tc7_subr_3:
+	  SCM_ASRTGO (SCM_NULLP (SCM_CDR (x)), wrongnumargs);
+	  RETURN (SCM_SUBRF (proc) (t.arg1, arg2, SCM_CAR (SCM_CDR (SCM_CDR (dbg_info.args)))));
+	case scm_tc7_asubr:
+	  /*      t.arg1 = SCM_SUBRF(proc)(t.arg1, arg2);
+		  while SCM_NIMP(x) {
+		  t.arg1 = SCM_SUBRF(proc)(t.arg1, EVALCAR(x, env));
+		  x = SCM_CDR(x);
+		  }
+		  RETURN (t.arg1) */
+	case scm_tc7_rpsubr:
+	  RETURN (SCM_APPLY (proc, t.arg1, scm_acons (arg2, SCM_CDR (SCM_CDR (dbg_info.args)), SCM_EOL)));
+	case scm_tc7_lsubr_2:
+	  RETURN (SCM_SUBRF (proc) (t.arg1, arg2, SCM_CDR (SCM_CDR (dbg_info.args))));
+	case scm_tc7_lsubr:
+	  RETURN (SCM_SUBRF (proc) (dbg_info.args));
+#ifdef CCLO
+	case scm_tc7_cclo:
+	  goto cclon;
+#endif
+	case scm_tcs_closures:
+	  env = EXTEND_SCM_ENV (SCM_CAR (SCM_CODE (proc)),
+				dbg_info.args,
+				SCM_ENV (proc));
+	  x = SCM_CODE (proc);
+	  goto cdrxbegin;
+#else
+	case scm_tc7_subr_3:
+	  SCM_ASRTGO (SCM_NULLP (SCM_CDR (x)), wrongnumargs);
+	  RETURN (SCM_SUBRF (proc) (t.arg1, arg2, EVALCAR (x, env)));
+	case scm_tc7_asubr:
+	  /*      t.arg1 = SCM_SUBRF(proc)(t.arg1, arg2);
+		  while SCM_NIMP(x) {
+		  t.arg1 = SCM_SUBRF(proc)(t.arg1, EVALCAR(x, env));
+		  x = SCM_CDR(x);
+		  }
+		  RETURN (t.arg1) */
+	case scm_tc7_rpsubr:
+	  RETURN (SCM_APPLY (proc, t.arg1, scm_acons (arg2, scm_eval_args (x, env), SCM_EOL)));
+	case scm_tc7_lsubr_2:
+	  RETURN (SCM_SUBRF (proc) (t.arg1, arg2, scm_eval_args (x, env)));
+	case scm_tc7_lsubr:
+	  RETURN (SCM_SUBRF (proc) (scm_cons2 (t.arg1, arg2, scm_eval_args (x, env))));
+#ifdef CCLO
+	case scm_tc7_cclo:
+	  goto cclon;
+#endif
+	case scm_tcs_closures:
+	  env = EXTEND_SCM_ENV (SCM_CAR (SCM_CODE (proc)),
+				scm_cons2 (t.arg1, arg2, scm_eval_args (x, env)),
+				SCM_ENV (proc));
+	  x = SCM_CODE (proc);
+	  goto cdrxbegin;
+#endif /* DEVAL */
+	case scm_tc7_subr_2:
+	case scm_tc7_subr_1o:
+	case scm_tc7_subr_2o:
+	case scm_tc7_subr_0:
+	case scm_tc7_cxr:
+	case scm_tc7_subr_1:
+	case scm_tc7_contin:
+	  goto wrongnumargs;
+	default:
+	  goto badfun;
+	}
+  }
+#ifdef DEVAL
+ exit:
+  if (CHECK_SCM_EXIT)
+    {
+      /* if (SINGLE_STEP) ... but this is always fulfilled. */
+      SINGLE_STEP = 0;
+      scm_make_cont (&t.arg1);
+      if (setjmp (SCM_JMPBUF (t.arg1)))
+	{
+	  proc = SCM_THROW_VALUE(t.arg1);
+	  goto ret;
+	}
+      scm_ithrow (exit_frame_sym, proc, 0);
+    }
+ ret:
+  last_debug_info_frame = dbg_info.prev;
+  return proc;
+#endif
+}
+
+#ifndef DEVAL
+
+SCM_PROC(s_procedure_documentation, "procedure-documentation", 1, 0, 0, scm_procedure_documentation);
+#ifdef __STDC__
+SCM 
+scm_procedure_documentation (SCM proc)
+#else
+SCM 
+scm_procedure_documentation (proc)
+     SCM proc;
+#endif
+{
+  SCM code;
+  SCM_ASSERT (SCM_BOOL_T == scm_procedure_p (proc) && SCM_NIMP (proc) && SCM_TYP7 (proc) != scm_tc7_contin,
+	  proc, SCM_ARG1, s_procedure_documentation);
+  switch (SCM_TYP7 (proc))
+    {
+    case scm_tcs_closures:
+      code = SCM_CDR (SCM_CODE (proc));
+      if (SCM_IMP (SCM_CDR (code)))
+	return SCM_BOOL_F;
+      code = SCM_CAR (code);
+      if (SCM_IMP (code))
+	return SCM_BOOL_F;
+      if (SCM_STRINGP (code))
+	return code;
+    default:
+      return SCM_BOOL_F;
+/*
+  case scm_tcs_subrs:
+#ifdef CCLO
+  case scm_tc7_cclo:
+#endif
+*/
+    }
+}
+
+/* This code is for scm_apply. it is destructive on multiple args.
+ * This will only screw you if you do (scm_apply scm_apply '( ... )) 
+ */
+SCM_PROC(s_nconc2last, "apply:nconc2last", 1, 0, 0, scm_nconc2last);
+#ifdef __STDC__
+SCM 
+scm_nconc2last (SCM lst)
+#else
+SCM 
+scm_nconc2last (lst)
+     SCM lst;
+#endif
+{
+  SCM *lloc;
+  if (SCM_EOL == lst)
+    return lst;
+  SCM_ASSERT (SCM_NIMP (lst) && SCM_CONSP (lst), lst, SCM_ARG1, s_nconc2last);
+  lloc = &lst;
+  while (SCM_NNULLP (SCM_CDR (*lloc)))
+    {
+      lloc = &SCM_CDR (*lloc);
+      SCM_ASSERT (SCM_NIMP (*lloc) && SCM_CONSP (*lloc), lst, SCM_ARG1, s_nconc2last);
+    }
+  *lloc = SCM_CAR (*lloc);
+  return lst;
+}
+
+#endif /* !DEVAL */
+
+#if 0
+#ifdef __STDC__
+SCM 
+scm_apply (SCM proc, SCM arg1, SCM args)
+#else
+SCM 
+scm_apply (proc, arg1, args)
+     SCM proc;
+     SCM arg1;
+     SCM args;
+#endif
+{}
+#endif
+
+#if 0
+#ifdef __STDC__
+SCM 
+scm_dapply (SCM proc, SCM arg1, SCM args)
+#else
+SCM 
+scm_dapply (proc, arg1, args)
+     SCM proc;
+     SCM arg1;
+     SCM args;
+#endif
+{}
+#endif
+
+
+
+#ifdef __STDC__
+SCM 
+SCM_APPLY (SCM proc, SCM arg1, SCM args)
+#else
+SCM 
+SCM_APPLY (proc, arg1, args)
+     SCM proc;
+     SCM arg1;
+     SCM args;
+#endif
+{
+#ifdef DEBUG_EXTENSIONS
+#ifdef DEVAL
+  debug_info dbg_info;
+  dbg_info.prev = last_debug_info_frame;
+  dbg_info.exp = SCM_UNDEFINED;
+  dbg_info.proc = proc;
+  dbg_info.args = SCM_UNDEFINED;
+  last_debug_info_frame = &dbg_info;
+#else
+  if (DEBUGGINGP)
+    return scm_dapply (proc, arg1, args);
+#endif
+#endif
+
+  SCM_ASRTGO (SCM_NIMP (proc), badproc);
+  if (SCM_NULLP (args))
+    {
+      if (SCM_NULLP (arg1))
+	arg1 = SCM_UNDEFINED;
+      else
+	{
+	  args = SCM_CDR (arg1);
+	  arg1 = SCM_CAR (arg1);
+	}
+    }
+  else
+    {
+      /*		SCM_ASRTGO(SCM_NIMP(args) && SCM_CONSP(args), wrongnumargs); */
+      args = scm_nconc2last (args);
+    }
+#ifdef CCLO
+ tail:
+#endif
+#ifdef DEVAL
+  dbg_info.args = scm_cons (arg1, args);
+#endif
+  switch (SCM_TYP7 (proc))
+    {
+    case scm_tc7_subr_2o:
+      args = SCM_NULLP (args) ? SCM_UNDEFINED : SCM_CAR (args);
+      RETURN (SCM_SUBRF (proc) (arg1, args))
+    case scm_tc7_subr_2:
+      SCM_ASRTGO (SCM_NULLP (SCM_CDR (args)), wrongnumargs);
+      args = SCM_CAR (args);
+      RETURN (SCM_SUBRF (proc) (arg1, args))
+    case scm_tc7_subr_0:
+      SCM_ASRTGO (SCM_UNBNDP (arg1), wrongnumargs);
+      RETURN (SCM_SUBRF (proc) ())
+    case scm_tc7_subr_1:
+    case scm_tc7_subr_1o:
+      SCM_ASRTGO (SCM_NULLP (args), wrongnumargs);
+      RETURN (SCM_SUBRF (proc) (arg1))
+    case scm_tc7_cxr:
+      SCM_ASRTGO (SCM_NULLP (args), wrongnumargs);
+#ifdef SCM_FLOATS
+      if (SCM_SUBRF (proc))
+	{
+	  if SCM_INUMP
+	    (arg1)
+	      RETURN (scm_makdbl (SCM_DSUBRF (proc) ((double) SCM_INUM (arg1)), 0.0))
+	  SCM_ASRTGO (SCM_NIMP (arg1), floerr);
+	  if SCM_REALP
+	    (arg1)
+	      RETURN (scm_makdbl (SCM_DSUBRF (proc) (SCM_REALPART (arg1)), 0.0))
+#ifdef SCM_BIGDIG
+	  if SCM_BIGP
+	    (arg1)
+	      RETURN (scm_makdbl (SCM_DSUBRF (proc) (scm_big2dbl (arg1)), 0.0))
+#endif
+	floerr:
+	  scm_wta (arg1, (char *) SCM_ARG1, SCM_CHARS (SCM_SNAME (proc)));
+	}
+#endif
+      proc = (SCM) SCM_SNAME (proc);
+      {
+	char *chrs = SCM_CHARS (proc) + SCM_LENGTH (proc) - 1;
+	while ('c' != *--chrs)
+	  {
+	    SCM_ASSERT (SCM_NIMP (arg1) && SCM_CONSP (arg1),
+		    arg1, SCM_ARG1, SCM_CHARS (proc));
+	    arg1 = ('a' == *chrs) ? SCM_CAR (arg1) : SCM_CDR (arg1);
+	  }
+	RETURN (arg1)
+      }
+    case scm_tc7_subr_3:
+      RETURN (SCM_SUBRF (proc) (arg1, SCM_CAR (args), SCM_CAR (SCM_CDR (args))))
+    case scm_tc7_lsubr:
+#ifdef DEVAL
+      RETURN (SCM_SUBRF (proc) (SCM_UNBNDP (arg1) ? SCM_EOL : dbg_info.args))
+#else
+      RETURN (SCM_SUBRF (proc) (SCM_UNBNDP (arg1) ? SCM_EOL : scm_cons (arg1, args)))
+#endif
+    case scm_tc7_lsubr_2:
+      SCM_ASRTGO (SCM_NIMP (args) && SCM_CONSP (args), wrongnumargs);
+      RETURN (SCM_SUBRF (proc) (arg1, SCM_CAR (args), SCM_CDR (args)))
+    case scm_tc7_asubr:
+      if (SCM_NULLP (args))
+	RETURN (SCM_SUBRF (proc) (arg1, SCM_UNDEFINED))
+      while (SCM_NIMP (args))
+	{
+	  SCM_ASSERT (SCM_CONSP (args), args, SCM_ARG2, "apply");
+	  arg1 = SCM_SUBRF (proc) (arg1, SCM_CAR (args));
+	  args = SCM_CDR (args);
+	}
+      RETURN (arg1);
+    case scm_tc7_rpsubr:
+      if (SCM_NULLP (args))
+	RETURN (SCM_BOOL_T);
+      while (SCM_NIMP (args))
+	{
+	  SCM_ASSERT (SCM_CONSP (args), args, SCM_ARG2, "apply");
+	  if (SCM_FALSEP (SCM_SUBRF (proc) (arg1, SCM_CAR (args))))
+	    RETURN (SCM_BOOL_F);
+	  arg1 = SCM_CAR (args);
+	  args = SCM_CDR (args);
+	}
+      RETURN (SCM_BOOL_T);
+    case scm_tcs_closures:
+#ifdef DEVAL
+      arg1 = (SCM_UNBNDP (arg1) ? SCM_EOL : dbg_info.args);
+#else
+      arg1 = (SCM_UNBNDP (arg1) ? SCM_EOL : scm_cons (arg1, args));
+#endif
+#ifndef RECKLESS
+      if (scm_badargsp (SCM_CAR (SCM_CODE (proc)), arg1))
+	goto wrongnumargs;
+#endif
+      args = EXTEND_SCM_ENV (SCM_CAR (SCM_CODE (proc)), arg1, SCM_ENV (proc));
+      proc = SCM_CODE (proc);
+      while (SCM_NNULLP (proc = SCM_CDR (proc)))
+	arg1 = EVALCAR (proc, args);
+      RETURN (arg1);
+    case scm_tc7_contin:
+      SCM_ASRTGO (SCM_NULLP (args), wrongnumargs);
+      scm_call_continuation (proc, arg1);
+#ifdef CCLO
+    case scm_tc7_cclo:
+#ifdef DEVAL
+      args = (SCM_UNBNDP(arg1) ? SCM_EOL : dbg_info.args);
+#else
+      args = (SCM_UNBNDP(arg1) ? SCM_EOL : scm_cons (arg1, args));
+#endif
+      arg1 = proc;
+      proc = SCM_CCLO_SUBR (proc);
+      goto tail;
+#endif
+    wrongnumargs:
+      scm_wta (proc, (char *) SCM_WNA, "apply");
+    default:
+    badproc:
+      scm_wta (proc, (char *) SCM_ARG1, "apply");
+      RETURN (arg1);
+    }
+#ifdef DEVAL
+ exit:
+  if (CHECK_SCM_EXIT)
+    {
+      /* if (SINGLE_STEP) ... but this is always fulfilled. */
+      SINGLE_STEP = 0;
+      scm_make_cont (&arg1);
+      if (setjmp (SCM_JMPBUF (arg1)))
+	{
+	  proc = SCM_THROW_VALUE(arg1);
+	  goto ret;
+	}
+      scm_ithrow (exit_frame_sym, proc, 0);
+    }
+ ret:
+  last_debug_info_frame = dbg_info.prev;
+  return proc;
+#endif
+}
+
+#ifndef DEVAL
+
+SCM_PROC(s_map, "map", 2, 0, 1, scm_map);
+#ifdef __STDC__
+SCM 
+scm_map (SCM proc, SCM arg1, SCM args)
+#else
+SCM 
+scm_map (proc, arg1, args)
+     SCM proc;
+     SCM arg1;
+     SCM args;
+#endif
+{
+  long i;
+  SCM res = SCM_EOL;
+  SCM *pres = &res;
+  SCM *ve = &args;		/* Keep args from being optimized away. */
+
+  if (SCM_NULLP (arg1))
+    return res;
+  SCM_ASSERT (SCM_NIMP (arg1), arg1, SCM_ARG2, s_map);
+  if (SCM_NULLP (args))
+    {
+      while (SCM_NIMP (arg1))
+	{
+	  SCM_ASSERT (SCM_CONSP (arg1), arg1, SCM_ARG2, s_map);
+	  *pres = scm_cons (scm_apply (proc, SCM_CAR (arg1), scm_listofnull), SCM_EOL);
+	  pres = &SCM_CDR (*pres);
+	  arg1 = SCM_CDR (arg1);
+	}
+      return res;
+    }
+  args = scm_vector (scm_cons (arg1, args));
+  ve = SCM_VELTS (args);
+#ifndef RECKLESS
+  for (i = SCM_LENGTH (args) - 1; i >= 0; i--)
+    SCM_ASSERT (SCM_NIMP (ve[i]) && SCM_CONSP (ve[i]), args, SCM_ARG2, s_map);
+#endif
+  while (1)
+    {
+      arg1 = SCM_EOL;
+      for (i = SCM_LENGTH (args) - 1; i >= 0; i--)
+	{
+	  if SCM_IMP
+	    (ve[i]) return res;
+	  arg1 = scm_cons (SCM_CAR (ve[i]), arg1);
+	  ve[i] = SCM_CDR (ve[i]);
+	}
+      *pres = scm_cons (scm_apply (proc, arg1, SCM_EOL), SCM_EOL);
+      pres = &SCM_CDR (*pres);
+    }
+}
+
+
+SCM_PROC(s_for_each, "for-each", 2, 0, 1, scm_for_each);
+#ifdef __STDC__
+SCM 
+scm_for_each (SCM proc, SCM arg1, SCM args)
+#else
+SCM 
+scm_for_each (proc, arg1, args)
+     SCM proc;
+     SCM arg1;
+     SCM args;
+#endif
+{
+  SCM *ve = &args;		/* Keep args from being optimized away. */
+  long i;
+  if SCM_NULLP (arg1)
+    return SCM_UNSPECIFIED;
+  SCM_ASSERT (SCM_NIMP (arg1), arg1, SCM_ARG2, s_for_each);
+  if SCM_NULLP (args)
+    {
+      while SCM_NIMP (arg1)
+	{
+	  SCM_ASSERT (SCM_CONSP (arg1), arg1, SCM_ARG2, s_for_each);
+	  scm_apply (proc, SCM_CAR (arg1), scm_listofnull);
+	  arg1 = SCM_CDR (arg1);
+	}
+      return SCM_UNSPECIFIED;
+    }
+  args = scm_vector (scm_cons (arg1, args));
+  ve = SCM_VELTS (args);
+#ifndef RECKLESS
+  for (i = SCM_LENGTH (args) - 1; i >= 0; i--)
+    SCM_ASSERT (SCM_NIMP (ve[i]) && SCM_CONSP (ve[i]), args, SCM_ARG2, s_for_each);
+#endif
+  while (1)
+    {
+      arg1 = SCM_EOL;
+      for (i = SCM_LENGTH (args) - 1; i >= 0; i--)
+	{
+	  if SCM_IMP
+	    (ve[i]) return SCM_UNSPECIFIED;
+	  arg1 = scm_cons (SCM_CAR (ve[i]), arg1);
+	  ve[i] = SCM_CDR (ve[i]);
+	}
+      scm_apply (proc, arg1, SCM_EOL);
+    }
+}
+
+
+#ifdef __STDC__
+SCM 
+scm_closure (SCM code, SCM env)
+#else
+SCM 
+scm_closure (code, env)
+     SCM code;
+     SCM env;
+#endif
+{
+  register SCM z;
+  SCM_NEWCELL (z);
+  SCM_SETCODE (z, code);
+  SCM_ENV (z) = env;
+  return z;
+}
+
+
+long scm_tc16_promise;
+#ifdef __STDC__
+SCM 
+scm_makprom (SCM code)
+#else
+SCM 
+scm_makprom (code)
+     SCM code;
+#endif
+{
+  register SCM z;
+  SCM_NEWCELL (z);
+  SCM_CDR (z) = code;
+  SCM_CAR (z) = scm_tc16_promise;
+  return z;
+}
+
+
+#ifdef __STDC__
+static int 
+prinprom (SCM exp, SCM port, int writing)
+#else
+static int 
+prinprom (exp, port, writing)
+     SCM exp;
+     SCM port;
+     int writing;
+#endif
+{
+  scm_gen_puts (scm_regular_string, "#<promise ", port);
+  scm_iprin1 (SCM_CDR (exp), port, writing);
+  scm_gen_putc ('>', port);
+  return !0;
+}
+
+
+SCM_PROC(s_makacro, "procedure->syntax", 1, 0, 0, scm_makacro);
+#ifdef __STDC__
+SCM 
+scm_makacro (SCM code)
+#else
+SCM 
+scm_makacro (code)
+     SCM code;
+#endif
+{
+  register SCM z;
+  SCM_NEWCELL (z);
+  SCM_CDR (z) = code;
+  SCM_CAR (z) = scm_tc16_macro;
+  return z;
+}
+
+
+SCM_PROC(s_makmacro, "procedure->macro", 1, 0, 0, scm_makmacro);
+#ifdef __STDC__
+SCM 
+scm_makmacro (SCM code)
+#else
+SCM 
+scm_makmacro (code)
+     SCM code;
+#endif
+{
+  register SCM z;
+  SCM_NEWCELL (z);
+  SCM_CDR (z) = code;
+  SCM_CAR (z) = scm_tc16_macro | (1L << 16);
+  return z;
+}
+
+
+SCM_PROC(s_makmmacro, "procedure->memoizing-macro", 1, 0, 0, scm_makmmacro);
+#ifdef __STDC__
+SCM 
+scm_makmmacro (SCM code)
+#else
+SCM 
+scm_makmmacro (code)
+     SCM code;
+#endif
+{
+  register SCM z;
+  SCM_NEWCELL (z);
+  SCM_CDR (z) = code;
+  SCM_CAR (z) = scm_tc16_macro | (2L << 16);
+  return z;
+}
+
+
+#ifdef __STDC__
+static int 
+prinmacro (SCM exp, SCM port, int writing)
+#else
+static int 
+prinmacro (exp, port, writing)
+     SCM exp;
+     SCM port;
+     int writing;
+#endif
+{
+  if (SCM_CAR (exp) & (3L << 16))
+    scm_gen_puts (scm_regular_string, "#<macro", port);
+  else
+    scm_gen_puts (scm_regular_string, "#<syntax", port);
+  if (SCM_CAR (exp) & (2L << 16))
+    scm_gen_putc ('!', port);
+  scm_gen_putc (' ', port);
+  scm_iprin1 (SCM_CDR (exp), port, writing);
+  scm_gen_putc ('>', port);
+  return !0;
+}
+
+SCM_PROC(s_force, "force", 1, 0, 0, scm_force);
+#ifdef __STDC__
+SCM 
+scm_force (SCM x)
+#else
+SCM 
+scm_force (x)
+     SCM x;
+#endif
+{
+  SCM_ASSERT ((SCM_TYP16 (x) == scm_tc16_promise), x, SCM_ARG1, s_force);
+  if (!((1L << 16) & SCM_CAR (x)))
+    {
+      SCM ans = scm_apply (SCM_CDR (x), SCM_EOL, SCM_EOL);
+      if (!((1L << 16) & SCM_CAR (x)))
+	{
+	  SCM_DEFER_INTS;
+	  SCM_CDR (x) = ans;
+	  SCM_CAR (x) |= (1L << 16);
+	  SCM_ALLOW_INTS;
+	}
+    }
+  return SCM_CDR (x);
+}
+
+SCM_PROC (s_promise_p, "promise?", 1, 0, 0, scm_promise_p);
+#ifdef __STDC__
+SCM
+scm_promise_p (SCM x)
+#else
+SCM
+scm_promise_p (x)
+     SCM x;
+#endif
+{
+  return ((SCM_NIMP (x) && (SCM_TYP16 (x) == scm_tc16_promise))
+	   ? SCM_BOOL_T
+	   : SCM_BOOL_F);
+}
+
+SCM_PROC(s_copy_tree, "copy-tree", 1, 0, 0, scm_copy_tree);
+#ifdef __STDC__
+SCM 
+scm_copy_tree (SCM obj)
+#else
+SCM 
+scm_copy_tree (obj)
+     SCM obj;
+#endif
+{
+  SCM ans, tl;
+  if SCM_IMP
+    (obj) return obj;
+  if (SCM_VECTORP (obj))
+    {
+      scm_sizet i = SCM_LENGTH (obj);
+      ans = scm_make_vector (SCM_MAKINUM (i), SCM_UNSPECIFIED, SCM_UNDEFINED);
+      while (i--)
+	SCM_VELTS (ans)[i] = scm_copy_tree (SCM_VELTS (obj)[i]);
+      return ans;
+    }
+  if SCM_NCONSP (obj)
+    return obj;
+/*  return scm_cons(scm_copy_tree(SCM_CAR(obj)), scm_copy_tree(SCM_CDR(obj))); */
+  ans = tl = scm_cons (scm_copy_tree (SCM_CAR (obj)), SCM_UNSPECIFIED);
+  while (SCM_NIMP (obj = SCM_CDR (obj)) && SCM_CONSP (obj))
+    tl = (SCM_CDR (tl) = scm_cons (scm_copy_tree (SCM_CAR (obj)), SCM_UNSPECIFIED));
+  SCM_CDR (tl) = obj;
+  return ans;
+}
+
+#ifdef __STDC__
+SCM 
+scm_eval_3 (SCM obj, int copyp, SCM env)
+#else
+SCM 
+scm_eval_3 (obj, copyp, env)
+     SCM obj;
+     int copyp;
+     SCM env;
+#endif
+{
+  if (SCM_NIMP (SCM_CDR (scm_system_transformer)))
+    obj = scm_apply (SCM_CDR (scm_system_transformer), obj, scm_listofnull);
+  else if (copyp)
+    obj = scm_copy_tree (obj);
+  return EVAL (obj, env);
+}
+
+#ifdef __STDC__
+SCM
+scm_top_level_env (SCM thunk)
+#else
+SCM
+scm_top_level_env (thunk)
+     SCM thunk;
+#endif
+{
+  if (SCM_IMP(thunk))
+    return SCM_EOL;
+  else
+    return scm_cons(thunk, (SCM)SCM_EOL);
+}
+
+SCM_PROC(s_eval2, "eval2", 2, 0, 0, scm_eval2);
+#ifdef __STDC__
+SCM
+scm_eval2 (SCM obj, SCM env_thunk)
+#else
+SCM
+scm_eval2 (obj, env_thunk)
+     SCM obj;
+     SCM env_thunk;
+#endif
+{
+  return scm_eval_3 (obj, 1, scm_top_level_env(env_thunk));
+}
+
+SCM_PROC(s_eval, "eval", 1, 0, 0, scm_eval);
+#ifdef __STDC__
+SCM
+scm_eval (SCM obj)
+#else
+SCM
+scm_eval (obj)
+     SCM obj;
+#endif
+{
+  return
+    scm_eval_3(obj, 1, scm_top_level_env(SCM_CDR(scm_top_level_lookup_thunk_var)));
+}
+
+SCM_PROC(s_eval_x, "eval!", 1, 0, 0, scm_eval_x);
+#ifdef __STDC__
+SCM
+scm_eval_x (SCM obj)
+#else
+SCM
+scm_eval_x (obj)
+     SCM obj;
+#endif
+{
+  return
+    scm_eval_3(obj,
+	       0,
+	       scm_top_level_env (SCM_CDR (scm_top_level_lookup_thunk_var)));
+}
+
+SCM_PROC (s_macro_eval_x, "macro-eval!", 2, 0, 0, scm_macro_eval_x);
+#ifdef __STDC__
+SCM
+scm_macro_eval_x (SCM exp, SCM env)
+#else
+SCM
+scm_macro_eval_x (exp, env)
+     SCM exp;
+     SCM env;
+#endif
+{
+  return scm_eval_3 (exp, 0, env);
+}
+
+#ifdef __STDC__
+SCM 
+scm_definedp (SCM x, SCM env)
+#else
+SCM 
+scm_definedp (x, env)
+     SCM x;
+     SCM env;
+#endif
+{
+  SCM proc = SCM_CAR (x = SCM_CDR (x));
+  if (SCM_ISYMP (proc))
+    return SCM_BOOL_T;
+  else if(SCM_IMP(proc) || !SCM_SYMBOLP(proc))
+    return SCM_BOOL_F;
+  else
+    {
+      SCM vcell = scm_sym2vcell(proc, env_top_level(env), SCM_BOOL_F);
+      return (vcell == SCM_BOOL_F || SCM_UNBNDP(SCM_CDR(vcell))) ? SCM_BOOL_F : SCM_BOOL_T;
+    }
+}
+
+static scm_smobfuns promsmob =
+{scm_markcdr, scm_free0, prinprom};
+
+static scm_smobfuns macrosmob =
+{scm_markcdr, scm_free0, prinmacro};
+
+#ifdef __STDC__
+SCM 
+scm_make_synt (char *name, SCM (*macroizer) (), SCM (*fcn) ())
+#else
+SCM 
+scm_make_synt (name, macroizer, fcn)
+     char *name;
+     SCM (*macroizer) ();
+     SCM (*fcn) ();
+#endif
+{
+  SCM symcell = scm_sysintern (name, SCM_UNDEFINED);
+  long tmp = ((((SCM_CELLPTR) (SCM_CAR (symcell))) - scm_heap_org) << 8);
+  register SCM z;
+  if ((tmp >> 8) != ((SCM_CELLPTR) (SCM_CAR (symcell)) - scm_heap_org))
+    tmp = 0;
+  SCM_NEWCELL (z);
+  SCM_SUBRF (z) = fcn;
+  SCM_CAR (z) = tmp + scm_tc7_subr_2;
+  SCM_CDR (symcell) = macroizer (z);
+  return SCM_CAR (symcell);
+}
+
+#ifdef DEBUG_EXTENSIONS
+# ifndef DEVAL
+#  define DEVAL
+#  include "eval.c"
+# endif
+#endif
+
+
+#ifdef __STDC__
+void 
+scm_init_eval (void)
+#else
+void 
+scm_init_eval ()
+#endif
+{
+#ifdef DEBUG_EXTENSIONS
+  enter_frame_sym = SCM_CAR (scm_sysintern ("enter-frame", SCM_UNDEFINED));
+  exit_frame_sym = SCM_CAR (scm_sysintern ("exit-frame", SCM_UNDEFINED));
+#endif
+  scm_tc16_promise = scm_newsmob (&promsmob);
+  scm_tc16_macro = scm_newsmob (&macrosmob);
+  scm_i_apply = scm_make_subr ("apply", scm_tc7_lsubr_2, scm_apply);
+  scm_system_transformer = scm_sysintern ("scm:eval-transformer", SCM_UNDEFINED);
+  scm_i_dot = SCM_CAR (scm_sysintern (".", SCM_UNDEFINED));
+  scm_i_arrow = SCM_CAR (scm_sysintern ("=>", SCM_UNDEFINED));
+  scm_i_else = SCM_CAR (scm_sysintern ("else", SCM_UNDEFINED));
+  scm_i_unquote = SCM_CAR (scm_sysintern ("unquote", SCM_UNDEFINED));
+  scm_i_uq_splicing = SCM_CAR (scm_sysintern ("unquote-splicing", SCM_UNDEFINED));
+
+  /* acros */
+  scm_i_quasiquote = scm_make_synt (s_quasiquote, scm_makacro, scm_m_quasiquote);
+  scm_make_synt ("define", scm_makmmacro, scm_m_define);
+  scm_make_synt (s_delay, scm_makacro, scm_m_delay);
+  /* end of acros */
+
+  scm_top_level_lookup_thunk_var =
+    scm_sysintern("*top-level-lookup-thunk*", SCM_BOOL_F);
+
+  scm_make_synt ("and", scm_makmmacro, scm_m_and);
+  scm_make_synt ("begin", scm_makmmacro, scm_m_begin);
+  scm_make_synt ("case", scm_makmmacro, scm_m_case);
+  scm_make_synt ("cond", scm_makmmacro, scm_m_cond);
+  scm_make_synt ("do", scm_makmmacro, scm_m_do);
+  scm_make_synt ("if", scm_makmmacro, scm_m_if);
+  scm_i_lambda = scm_make_synt ("lambda", scm_makmmacro, scm_m_lambda);
+  scm_i_let = scm_make_synt ("let", scm_makmmacro, scm_m_let);
+  scm_make_synt ("letrec", scm_makmmacro, scm_m_letrec);
+  scm_make_synt ("let*", scm_makmmacro, scm_m_letstar);
+  scm_make_synt ("or", scm_makmmacro, scm_m_or);
+  scm_i_quote = scm_make_synt ("quote", scm_makmmacro, scm_m_quote);
+  scm_make_synt ("set!", scm_makmmacro, scm_m_set);
+  scm_make_synt ("@apply", scm_makmmacro, scm_m_apply);
+  scm_make_synt ("@call-with-current-continuation", scm_makmmacro, scm_m_cont);
+  scm_make_synt ("defined?", scm_makmmacro, scm_definedp);
+  scm_i_name = SCM_CAR (scm_sysintern ("name", SCM_UNDEFINED));
+  scm_permanent_object (scm_i_name);
+#include "eval.x"
+}
+#endif /* !DEVAL */
+
diff --git a/libguile/eval.h b/libguile/eval.h
new file mode 100644
index 000000000..fb8c0c9ec
--- /dev/null
+++ b/libguile/eval.h
@@ -0,0 +1,218 @@
+/* classes: h_files */
+
+#ifndef EVALH
+#define EVALH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+
+
+
+/* {Ilocs}
+ *
+ * Ilocs are relative pointers into local environment structures.
+ * 
+ */
+#define SCM_ILOCP(n)		(SCM_ITAG8(n)==scm_tc8_iloc)
+#define SCM_ILOC00		SCM_MAKE_ITAG8(0L, scm_tc8_iloc)
+#define SCM_IDINC		(0x00100000L)
+#define SCM_ICDR		(0x00080000L)
+#define SCM_IFRINC		(0x00000100L)
+#define SCM_IDSTMSK		(-SCM_IDINC)
+#define SCM_IFRAME(n) 		((int)((SCM_ICDR-SCM_IFRINC)>>8) & ((int)(n)>>8))
+#define SCM_IDIST(n) 		(((unsigned long)(n))>>20)
+#define SCM_ICDRP(n) 		(SCM_ICDR & (n))
+
+
+
+
+/* Evaluator */
+#ifdef DEBUG_EXTENSIONS
+#define EVAL(x, env) (SCM_IMP(x) \
+		      ? (x) \
+		      : (*scm_ceval_ptr) ((x), (env)))
+#else
+#define EVAL(x, env) (SCM_IMP(x)?(x):scm_ceval((x), (env)))
+#endif /* DEBUG_EXTENSIONS */
+
+#define SCM_CEVAL scm_ceval
+#define SCM_APPLY scm_apply
+#define SIDEVAL(x, env) if SCM_NIMP(x) SCM_CEVAL((x), (env))
+
+
+
+#define SCM_EXTEND_SCM_ENV scm_acons
+
+
+extern SCM scm_i_dot;
+extern SCM scm_i_quote;
+extern SCM scm_i_quasiquote;
+extern SCM scm_i_lambda;
+extern SCM scm_i_let;
+extern SCM scm_i_arrow;
+extern SCM scm_i_else;
+extern SCM scm_i_unquote;
+extern SCM scm_i_uq_splicing;
+extern SCM scm_i_apply;
+extern SCM scm_top_level_lookup_thunk_var;
+extern SCM scm_i_name;
+
+
+/* A resolved global variable reference in the CAR position
+ * of a list is stored (in code only) as a pointer to a pair with a 
+ * tag of 1.  This is called a "gloc".
+ */
+
+#define SCM_GLOC_SYM(x) (SCM_CAR((x)-1L))
+#define SCM_GLOC_VAL(x) (SCM_CDR((x)-1L))
+
+
+#ifdef __STDC__
+extern SCM * scm_ilookup (SCM iloc, SCM env);
+extern SCM * scm_lookupcar (SCM vloc, SCM genv);
+extern SCM scm_unmemocar (SCM form, SCM env);
+extern SCM scm_eval_car (SCM pair, SCM env);
+extern SCM scm_m_quote (SCM xorig, SCM env);
+extern SCM scm_m_begin (SCM xorig, SCM env);
+extern SCM scm_m_if (SCM xorig, SCM env);
+extern SCM scm_m_set (SCM xorig, SCM env);
+extern SCM scm_m_vref (SCM xorig, SCM env);
+extern SCM scm_m_vset (SCM xorig, SCM env);
+extern SCM scm_m_and (SCM xorig, SCM env);
+extern SCM scm_m_or (SCM xorig, SCM env);
+extern SCM scm_m_case (SCM xorig, SCM env);
+extern SCM scm_m_cond (SCM xorig, SCM env);
+extern SCM scm_m_lambda (SCM xorig, SCM env);
+extern SCM scm_m_letstar (SCM xorig, SCM env);
+extern SCM scm_m_do (SCM xorig, SCM env);
+extern SCM scm_m_quasiquote (SCM xorig, SCM env);
+extern SCM scm_m_delay (SCM xorig, SCM env);
+extern SCM scm_m_define (SCM x, SCM env);
+extern SCM scm_m_letrec (SCM xorig, SCM env);
+extern SCM scm_m_let (SCM xorig, SCM env);
+extern SCM scm_m_apply (SCM xorig, SCM env);
+extern SCM scm_m_cont (SCM xorig, SCM env);
+extern int scm_badargsp (SCM formals, SCM args);
+extern SCM scm_ceval (SCM x, SCM env);
+extern SCM scm_deval (SCM x, SCM env);
+extern SCM scm_procedure_documentation (SCM proc);
+extern SCM scm_nconc2last (SCM lst);
+extern SCM scm_apply (SCM proc, SCM arg1, SCM args);
+extern SCM scm_dapply (SCM proc, SCM arg1, SCM args);
+extern SCM SCM_APPLY (SCM proc, SCM arg1, SCM args);
+extern SCM scm_map (SCM proc, SCM arg1, SCM args);
+extern SCM scm_for_each (SCM proc, SCM arg1, SCM args);
+extern SCM scm_closure (SCM code, SCM env);
+extern SCM scm_makprom (SCM code);
+extern SCM scm_makacro (SCM code);
+extern SCM scm_makmacro (SCM code);
+extern SCM scm_makmmacro (SCM code);
+extern SCM scm_force (SCM x);
+extern SCM scm_promise_p (SCM x);
+extern SCM scm_copy_tree (SCM obj);
+extern SCM scm_eval_3 (SCM obj, int copyp, SCM env);
+extern SCM scm_top_level_env (SCM thunk);
+extern SCM scm_eval2 (SCM obj, SCM env_thunk);
+extern SCM scm_eval (SCM obj);
+extern SCM scm_eval_x (SCM obj);
+extern SCM scm_macro_eval_x (SCM exp, SCM env);
+extern SCM scm_definedp (SCM x, SCM env);
+extern SCM scm_make_synt (char *name, SCM (*macroizer) (), SCM (*fcn) ());
+extern void scm_init_eval (void);
+
+#else /* STDC */
+extern SCM * scm_ilookup ();
+extern SCM * scm_lookupcar ();
+extern SCM scm_unmemocar ();
+extern SCM scm_eval_car ();
+extern SCM scm_m_quote ();
+extern SCM scm_m_begin ();
+extern SCM scm_m_if ();
+extern SCM scm_m_set ();
+extern SCM scm_m_vref ();
+extern SCM scm_m_vset ();
+extern SCM scm_m_and ();
+extern SCM scm_m_or ();
+extern SCM scm_m_case ();
+extern SCM scm_m_cond ();
+extern SCM scm_m_lambda ();
+extern SCM scm_m_letstar ();
+extern SCM scm_m_do ();
+extern SCM scm_m_quasiquote ();
+extern SCM scm_m_delay ();
+extern SCM scm_m_define ();
+extern SCM scm_m_letrec ();
+extern SCM scm_m_let ();
+extern SCM scm_m_apply ();
+extern SCM scm_m_cont ();
+extern int scm_badargsp ();
+extern SCM scm_ceval ();
+extern SCM scm_deval ();
+extern SCM scm_procedure_documentation ();
+extern SCM scm_nconc2last ();
+extern SCM scm_apply ();
+extern SCM scm_dapply ();
+extern SCM SCM_APPLY ();
+extern SCM scm_map ();
+extern SCM scm_for_each ();
+extern SCM scm_closure ();
+extern SCM scm_makprom ();
+extern SCM scm_makacro ();
+extern SCM scm_makmacro ();
+extern SCM scm_makmmacro ();
+extern SCM scm_force ();
+extern SCM scm_promise_p ();
+extern SCM scm_copy_tree ();
+extern SCM scm_eval_3 ();
+extern SCM scm_top_level_env ();
+extern SCM scm_eval2 ();
+extern SCM scm_eval ();
+extern SCM scm_eval_x ();
+extern SCM scm_macro_eval_x ();
+extern SCM scm_definedp ();
+extern SCM scm_make_synt ();
+extern void scm_init_eval ();
+
+#endif /* STDC */
+
+#endif  /* EVALH */
diff --git a/libguile/extchrs.c b/libguile/extchrs.c
new file mode 100644
index 000000000..44d9a14a1
--- /dev/null
+++ b/libguile/extchrs.c
@@ -0,0 +1,146 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "extchrs.h"
+
+
+
+#ifdef FAKE_EXT_SCM_CHARS
+
+#ifdef __STDC__
+int
+xmblen (const char * str, size_t size)
+#else
+int
+xmblen (str, size)
+     const char * str;
+     size_t size;
+#endif
+{
+  if (!str)
+    return 0;
+
+  if (*(unsigned char *)str > 127)
+    return ((size < 4)
+	    ? -1
+	    : 4);
+  else if (!*str)
+    return 0;
+  else
+    return 1;
+}
+
+#ifdef __STDC__
+int
+xwctomb (char * _str, int c)
+#else
+int
+xwctomb (_str, c)
+     char * _str;
+     int c;
+#endif
+{
+  unsigned char * str;
+  str = (unsigned char *)_str;
+  if (!str)
+    return 0;
+
+  if (!c)
+    {
+      *str = 0;
+      return 0;
+    }
+
+
+  if (c < 127)
+    {
+      *str = c;
+      return 1;
+    }
+
+  str[0] = 255;
+  str[1] = 0x80 | ((c >> 10) & 0x3f);
+  str[2] = 0x80 | ((c >> 4) & 0x3f);
+  str[3] = 0x80 | (c & 0xf);
+  return 4;
+}
+
+#ifdef __STDC__
+int
+xmbtowc (xwchar_t * result, const unsigned char * _str, size_t size)
+#else
+int
+xmbtowc (result, str, size)
+     xwchar_t * result;
+     const unsigned char * _str;
+     size_t size;
+#endif
+{
+  const unsigned char * str;
+  str = (const unsigned char *)_str;
+  if (!str)
+    return 0;
+
+  if ((size == 0) || !*str)
+    {
+      *result = 0;
+      return 0;
+    }
+
+  if (*str < 128)
+    {
+      *result = *str;
+      return 1;
+    }
+
+  if (   (*str != 255)
+      || (size < 4))
+    return -1;
+
+  *result = (  ((str[1] & 0x3f) << 10)
+	     | ((str[2] & 0x3f) << 4)
+	     | (str[3] & 0xf));
+  return 4;
+}
+
+#endif /* FAKE_EXT_SCM_CHARS */
+
diff --git a/libguile/extchrs.h b/libguile/extchrs.h
new file mode 100644
index 000000000..8d17c4681
--- /dev/null
+++ b/libguile/extchrs.h
@@ -0,0 +1,83 @@
+/* classes: h_files */
+
+#ifndef EXTCHRSH
+#define EXTCHRSH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdlib.h>
+
+#define FAKE_EXT_SCM_CHARS 1
+
+#if !defined(FAKE_EXT_SCM_CHARS)
+
+#define xmblen mblen
+#define xwctomb wctomb
+#define xmbtowc mbtowc
+#define XMB_CUR_MAX MB_CUR_MAX
+typedef wchar_t xwchar_t;
+
+#else
+
+typedef unsigned short xwchar_t;
+#define XMB_CUR_MAX 4
+
+#endif
+
+
+
+#ifdef __STDC__
+extern int xmblen (const char * str, size_t size);
+extern int xwctomb (char * _str, int c);
+extern int xmbtowc (xwchar_t * result, const unsigned char * _str, size_t size);
+
+#else /* STDC */
+extern int xmblen ();
+extern int xwctomb ();
+extern int xmbtowc ();
+
+#endif /* STDC */
+
+
+
+
+#endif  /* EXTCHRSH */
diff --git a/libguile/feature.c b/libguile/feature.c
new file mode 100644
index 000000000..b4622b7e9
--- /dev/null
+++ b/libguile/feature.c
@@ -0,0 +1,135 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+
+SCM *scm_loc_features;
+
+#ifdef __STDC__
+void
+scm_add_feature(char* str)
+#else
+void
+scm_add_feature(str)
+     char* str;
+#endif
+{
+  *scm_loc_features = scm_cons(SCM_CAR(scm_intern(str, strlen(str))), *scm_loc_features);
+}
+
+
+
+/* {Help finding slib}
+ */
+
+
+SCM_PROC(s_compiled_library_path, "compiled-library-path", 0, 0, 0, scm_compiled_library_path);
+#ifdef __STDC__
+SCM
+scm_compiled_library_path (void)
+#else
+SCM
+scm_compiled_library_path ()
+#endif
+{
+#ifndef LIBRARY_PATH
+  return SCM_BOOL_F;
+#else
+  return scm_makfrom0str (LIBRARY_PATH);
+#endif
+}
+
+
+
+
+SCM_PROC(s_program_arguments, "program-arguments", 0, 0, 0, scm_program_arguments);
+#ifdef __STDC__
+SCM 
+scm_program_arguments (void)
+#else
+SCM 
+scm_program_arguments ()
+#endif
+{
+  return scm_progargs;
+}
+
+
+
+
+
+
+#ifdef __STDC__
+void
+scm_init_feature(void)
+#else
+void
+scm_init_feature()
+#endif
+{
+  scm_loc_features = &SCM_CDR(scm_sysintern("*features*", SCM_EOL));
+#ifdef RECKLESS
+  scm_add_feature("reckless");
+#endif
+#ifndef _Windows
+  scm_add_feature("system");
+#endif
+#ifdef vms
+  scm_add_feature(s_ed);
+#endif
+#ifdef SICP
+  scm_add_feature("sicp");
+#endif
+#ifndef GO32
+  scm_add_feature("char-ready?");
+#endif
+#ifndef CHEAP_CONTINUATIONS
+  scm_add_feature ("full-continuation");
+#endif
+
+
+  scm_sysintern ("char-code-limit", SCM_MAKINUM (SCM_CHAR_SCM_CODE_LIMIT));
+#include "feature.x"
+}
diff --git a/libguile/feature.h b/libguile/feature.h
new file mode 100644
index 000000000..c1f7b1cb8
--- /dev/null
+++ b/libguile/feature.h
@@ -0,0 +1,69 @@
+/* classes: h_files */
+
+#ifndef FEATUREH
+#define FEATUREH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+
+
+
+extern SCM *scm_loc_features;
+
+
+#ifdef __STDC__
+extern void scm_add_feature(char* str);
+extern SCM scm_compiled_library_path (void);
+extern SCM scm_program_arguments (void);
+extern void scm_init_feature(void);
+
+#else /* STDC */
+extern void scm_add_feature();
+extern SCM scm_compiled_library_path ();
+extern SCM scm_program_arguments ();
+extern void scm_init_feature();
+
+#endif /* STDC */
+
+
+#endif  /* FEATUREH */
diff --git a/libguile/filesys.c b/libguile/filesys.c
new file mode 100644
index 000000000..5ca9b309c
--- /dev/null
+++ b/libguile/filesys.c
@@ -0,0 +1,1278 @@
+/*	Copyright (C) 1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+#include "_scm.h"
+
+
+#ifdef TIME_WITH_SYS_TIME
+# include <sys/time.h>
+# include <time.h>
+#else
+# if HAVE_SYS_TIME_H
+#  include <sys/time.h>
+# else
+#  include <time.h>
+# endif
+#endif
+
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+
+#ifdef HAVE_SYS_SELECT_H
+#include <sys/select.h>
+#endif
+
+#include <sys/stat.h>
+#include <fcntl.h>
+
+#include <pwd.h>
+
+
+#ifdef FD_SET
+
+#define SELECT_TYPE fd_set
+#define SELECT_SET_SIZE FD_SETSIZE
+
+#else /* no FD_SET */
+
+/* Define the macros to access a single-int bitmap of descriptors.  */
+#define SELECT_SET_SIZE 32
+#define SELECT_TYPE int
+#define FD_SET(n, p) (*(p) |= (1 << (n)))
+#define FD_CLR(n, p) (*(p) &= ~(1 << (n)))
+#define FD_ISSET(n, p) (*(p) & (1 << (n)))
+#define FD_ZERO(p) (*(p) = 0)
+
+#endif /* no FD_SET */
+
+#if HAVE_DIRENT_H
+# include <dirent.h>
+# define NAMLEN(dirent) strlen((dirent)->d_name)
+#else
+# define dirent direct
+# define NAMLEN(dirent) (dirent)->d_namlen
+# if HAVE_SYS_NDIR_H
+#  include <sys/ndir.h>
+# endif
+# if HAVE_SYS_DIR_H
+#  include <sys/dir.h>
+# endif
+# if HAVE_NDIR_H
+#  include <ndir.h>
+# endif
+#endif
+
+
+
+#ifdef O_CREAT
+SCM_CONST_LONG (scm_O_CREAT, "O_CREAT", O_CREAT);
+#endif 
+
+#ifdef O_EXCL
+SCM_CONST_LONG (scm_O_EXCL, "O_EXCL", O_EXCL);
+#endif 
+
+#ifdef O_NOCTTY
+SCM_CONST_LONG (scm_O_NOCTTY, "O_NOCTTY", O_NOCTTY);
+#endif 
+
+#ifdef O_TRUNC
+SCM_CONST_LONG (scm_O_TRUNC, "O_TRUNC", O_TRUNC);
+#endif 
+
+#ifdef O_APPEND
+SCM_CONST_LONG (scm_O_APPEND, "O_APPEND", O_APPEND);
+#endif 
+
+#ifdef O_NONBLOCK
+SCM_CONST_LONG (scm_O_NONBLOCK, "O_NONBLOCK", O_NONBLOCK);
+#endif 
+
+#ifdef O_NDELAY
+SCM_CONST_LONG (scm_O_NDELAY, "O_NDELAY", O_NDELAY);
+#endif 
+
+#ifdef O_SYNC
+SCM_CONST_LONG (scm_O_SYNC, "O_SYNC", O_SYNC);
+#endif 
+
+
+
+
+
+/* {Permissions}
+ */
+
+SCM_PROC (s_sys_chown, "%chown", 3, 0, 0, scm_sys_chown);
+#ifdef __STDC__
+SCM 
+scm_sys_chown (SCM path, SCM owner, SCM group)
+#else
+SCM 
+scm_sys_chown (path, owner, group)
+     SCM path;
+     SCM owner;
+     SCM group;
+#endif
+{
+  int val;
+  SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1, s_sys_chown);
+  if (SCM_SUBSTRP (path))
+    path = scm_makfromstr (SCM_ROCHARS (path), SCM_ROLENGTH (path), 0);
+  SCM_ASSERT (SCM_INUMP (owner), owner, SCM_ARG2, s_sys_chown);
+  SCM_ASSERT (SCM_INUMP (group), group, SCM_ARG3, s_sys_chown);
+  SCM_SYSCALL (val = chown (SCM_ROCHARS (path), SCM_INUM (owner), SCM_INUM (group)));
+  return val ? SCM_MAKINUM (errno) : SCM_BOOL_T;
+}
+
+
+SCM_PROC (s_sys_chmod, "%chmod", 2, 0, 0, scm_sys_chmod);
+#ifdef __STDC__
+SCM 
+scm_sys_chmod (SCM port_or_path, SCM mode)
+#else
+SCM 
+scm_sys_chmod (port_or_path, mode)
+     SCM port_or_path;
+     SCM mode;
+#endif
+{
+  int rv;
+  SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG2, s_sys_chmod);
+  SCM_ASSERT (SCM_NIMP (port_or_path), port_or_path, SCM_ARG1, s_sys_chmod);
+  if (SCM_STRINGP (port_or_path))
+    SCM_SYSCALL (rv = chmod (SCM_CHARS (port_or_path), SCM_INUM (mode)));
+  else
+    {
+      SCM_ASSERT (SCM_OPFPORTP (port_or_path), port_or_path, SCM_ARG1, s_sys_chmod);
+      rv = fileno ((FILE *)SCM_STREAM (port_or_path));
+      if (rv != -1)
+	SCM_SYSCALL (rv = fchmod (rv, SCM_INUM (mode)));
+    }
+  return rv ? SCM_MAKINUM (errno) : SCM_BOOL_T;
+}
+
+SCM_PROC (s_umask, "umask", 0, 1, 0, scm_umask);
+#ifdef __STDC__
+SCM 
+scm_umask (SCM mode)
+#else
+SCM 
+scm_umask (mode)
+     SCM mode;
+#endif
+{
+  mode_t mask;
+  if (SCM_UNBNDP (mode))
+    {
+      mask = umask (0);
+      umask (mask);
+    }
+  else
+    {
+      SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG1, s_umask);
+      mask = umask (SCM_INUM (mode));
+    }
+  return SCM_MAKINUM (mask);
+}
+
+
+/* {File Descriptors} 
+ */
+long scm_tc16_fd;
+
+#ifdef __STDC__
+static int 
+scm_fd_print (SCM sexp, SCM port, int writing)
+#else
+static int 
+scm_fd_print (sexp, port, writing)
+     SCM sexp;
+     SCM port;
+     int writing;
+#endif
+{
+  scm_gen_puts (scm_regular_string, "#<fd ", port);
+  scm_intprint (SCM_CDR (sexp), 10, port);
+  scm_gen_puts (scm_regular_string, ">", port);
+  return 1;
+}
+
+#ifdef __STDC__
+static scm_sizet 
+scm_fd_free (SCM p)
+#else
+static scm_sizet 
+scm_fd_free (p)
+     SCM p;
+#endif
+{
+  SCM flags;
+
+  flags = SCM_FD_FLAGS (p);
+  if ((scm_close_fd_on_gc & flags) && (scm_fd_is_open & flags))
+    {
+      SCM_SYSCALL( close (SCM_FD (p)) );
+    }
+  return 0;
+}
+
+static scm_smobfuns fd_smob = {scm_mark0, scm_fd_free, scm_fd_print, 0};
+
+#ifdef __STDC__
+SCM
+scm_intern_fd (int fd, int flags)
+#else
+SCM
+scm_intern_fd (fd, flags)
+     int fd;
+     int flags;
+#endif
+{
+  SCM it;
+  SCM_NEWCELL (it);
+  SCM_REDEFER_INTS;
+  SCM_SETCAR (it, (scm_tc16_fd | (flags << 16)));
+  SCM_SETCDR (it, (SCM)fd);
+  SCM_REALLOW_INTS;
+  return it;
+}
+
+
+
+SCM_PROC (s_sys_open, "%open", 3, 0, 0, scm_sys_open);
+#ifdef __STDC__
+SCM
+scm_sys_open (SCM path, SCM flags, SCM mode)
+#else
+SCM
+scm_sys_open (path, flags, mode)
+     SCM path;
+     SCM flags;
+     SCM mode;
+#endif
+{
+  int fd;
+  SCM sfd;
+
+  SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1, s_sys_open);
+  SCM_ASSERT (SCM_INUMP (flags), flags, SCM_ARG2, s_sys_open);
+  SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG3, s_sys_open);
+
+  if (SCM_SUBSTRP (path))
+    path = scm_makfromstr (SCM_ROCHARS (path), SCM_ROLENGTH (path), 0);
+
+  SCM_DEFER_INTS;
+  SCM_SYSCALL ( fd = open (SCM_ROCHARS (path), SCM_INUM (flags), SCM_INUM (mode)) );
+  if (fd == -1)
+    sfd = SCM_MAKINUM (errno);
+  else
+    sfd = scm_intern_fd (fd, scm_fd_is_open | scm_close_fd_on_gc);
+  SCM_ALLOW_INTS;
+
+  return scm_return_first (sfd, path);
+}
+
+
+SCM_PROC (s_sys_create, "%create", 2, 0, 0, scm_sys_create);
+#ifdef __STDC__
+SCM
+scm_sys_create (SCM path, SCM mode)
+#else
+SCM
+scm_sys_create (path, mode)
+     SCM path;
+     SCM mode;
+#endif
+{
+  int fd;
+  SCM sfd;
+
+  SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1, s_sys_create);
+  SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG2, s_sys_create);
+
+  if (SCM_SUBSTRP (path))
+    path = scm_makfromstr (SCM_ROCHARS (path), SCM_ROLENGTH (path), 0);
+
+  SCM_DEFER_INTS;
+  SCM_SYSCALL ( fd = creat (SCM_ROCHARS (path), SCM_INUM (mode)) );
+  if (fd == -1)
+    sfd = SCM_MAKINUM (errno);
+  else
+    sfd = scm_intern_fd (fd, scm_fd_is_open | scm_close_fd_on_gc);
+  SCM_ALLOW_INTS;
+
+  return scm_return_first (sfd, path);
+}
+
+
+SCM_PROC (s_sys_close, "%close", 1, 0, 0, scm_sys_close);
+#ifdef __STDC__
+SCM
+scm_sys_close (SCM sfd)
+#else
+SCM
+scm_sys_close (sfd)
+     SCM sfd;
+#endif
+{
+  int fd;
+  int got;
+  SCM_ASSERT (SCM_NIMP (sfd) && SCM_FD_P (sfd), sfd, SCM_ARG1,  s_sys_close);
+  fd = SCM_FD (sfd);
+
+  SCM_DEFER_INTS;
+  got = close (fd);
+  SCM_SETCAR (sfd, scm_tc16_fd);
+  SCM_ALLOW_INTS;
+  return (got == -1 ? SCM_MAKINUM (errno) : SCM_BOOL_T);
+}
+
+
+SCM_PROC (s_sys_write_fd, "%write-fd", 2, 0, 0, scm_sys_write_fd);
+#ifdef __STDC__
+SCM
+scm_sys_write_fd (SCM sfd, SCM buf)
+#else
+SCM
+scm_sys_write_fd (sfd, buf)
+     SCM sfd;
+     SCM buf;
+#endif
+{
+  SCM answer;
+  int fd;
+  size_t written;
+  SCM_ASSERT (SCM_NIMP (sfd) && SCM_FD_P (sfd), sfd, SCM_ARG1,  s_sys_write_fd);
+  SCM_ASSERT (SCM_NIMP (buf) && SCM_ROSTRINGP (buf), buf, SCM_ARG2,  s_sys_write_fd);
+  fd = SCM_FD (sfd);
+  SCM_DEFER_INTS;
+  written = write (fd, SCM_ROCHARS (buf), SCM_ROLENGTH (buf));
+  if (written == -1)
+    answer = scm_cons (SCM_MAKINUM (errno), SCM_EOL);
+  else
+    answer = scm_long2num (written);
+  SCM_ALLOW_INTS;
+  return scm_return_first (answer, buf);
+}
+
+
+SCM_PROC (s_sys_read_fd, "%read-fd", 2, 2, 0, scm_sys_read_fd);
+#ifdef __STDC__
+SCM
+scm_sys_read_fd (SCM sfd, SCM buf, SCM offset, SCM length)
+#else
+SCM
+scm_sys_read_fd (sfd, buf, offset, length)
+     SCM sfd;
+     SCM buf;
+     SCM offset;
+     SCM length;
+#endif
+{
+  SCM answer;
+  int fd;
+  char * bytes;
+  int off;
+  int len;
+  size_t got;
+
+  SCM_ASSERT (SCM_NIMP (sfd) && SCM_FD_P (sfd), sfd, SCM_ARG1,  s_sys_read_fd);
+  fd = SCM_FD (sfd);
+
+  SCM_ASSERT (SCM_NIMP (buf) && SCM_STRINGP (buf), buf, SCM_ARG2,  s_sys_read_fd);
+  bytes = SCM_CHARS (buf);
+
+  if (SCM_UNBNDP (offset))
+    off = 0;
+  else
+    {
+      SCM_ASSERT (SCM_INUMP (offset), offset, SCM_ARG3, s_sys_read_fd);
+      off = SCM_INUM (offset);
+    }
+
+  if (SCM_UNBNDP (length))
+    len = SCM_LENGTH (buf);
+  else
+    {
+      SCM_ASSERT (SCM_INUMP (length), length, SCM_ARG3, s_sys_read_fd);
+      len = SCM_INUM (length);
+    }
+
+  SCM_DEFER_INTS;
+  got = read (fd, bytes + off, len);
+  if (got == -1)
+    answer = scm_cons (SCM_MAKINUM (errno), SCM_EOL);
+  else
+    answer = scm_long2num (got);
+  SCM_ALLOW_INTS;
+  return scm_return_first (answer, buf);
+}
+
+SCM_PROC (s_sys_lseek, "%lseek", 2, 1, 0, scm_sys_lseek);
+#ifdef __STDC__
+SCM
+scm_sys_lseek (SCM sfd, SCM offset, SCM whence)
+#else
+SCM
+scm_sys_lseek (sfd, offset, whence)
+     SCM sfd;
+     SCM offset;
+     SCM whence;
+#endif
+{
+  SCM answer;
+  int fd;
+  long off;
+  int wh;
+  long got;
+
+  SCM_ASSERT (SCM_NIMP (sfd) && SCM_FD_P (sfd), sfd, SCM_ARG1,  s_sys_lseek);
+  fd = SCM_FD (sfd);
+
+  off = scm_num2long (offset, (char *)SCM_ARG2, s_sys_lseek);
+  if (SCM_UNBNDP (whence))
+    wh = SEEK_SET;
+  else
+    {
+      SCM_ASSERT (SCM_INUMP (whence), whence, SCM_ARG3, s_sys_lseek);
+      wh = SCM_INUM (whence);
+    }
+
+  SCM_DEFER_INTS;
+  SCM_SYSCALL (got = lseek (fd, off, wh));
+  if (got == -1)
+    answer = SCM_MAKINUM (errno);
+  else
+    answer = scm_long2num (got);
+  SCM_ALLOW_INTS;
+  return answer;
+}
+
+
+SCM_PROC (s_sys_dup, "%dup", 1, 1, 0, scm_sys_dup);
+#ifdef __STDC__
+SCM
+scm_sys_dup (SCM oldfd, SCM newfd)
+#else
+SCM
+scm_sys_dup (oldfd, newfd)
+     SCM oldfd;
+     SCM newfd;
+#endif
+{
+  SCM answer;
+  int fd;
+  int nfd;
+  int (*fn)();
+
+  SCM_ASSERT (SCM_NIMP (oldfd) && SCM_FD_P (oldfd), oldfd, SCM_ARG1,  s_sys_dup);
+  SCM_ASSERT (SCM_UNBNDP (newfd) || SCM_INUMP (newfd), newfd, SCM_ARG2,  s_sys_dup);
+  fd = SCM_FD (oldfd);
+  nfd = (SCM_INUMP (newfd) ? SCM_INUM (newfd) : -1);
+
+  SCM_DEFER_INTS;
+  fn = ((nfd == -1) ? (int (*)())dup : (int (*)())dup2);
+  nfd = fn (fd, nfd);
+  answer = (nfd == -1
+	    ? scm_cons (SCM_MAKINUM (errno), SCM_EOL)
+	    : SCM_MAKINUM (nfd));
+  SCM_ALLOW_INTS;
+  return answer;
+}
+
+
+
+/* {Files}
+ */
+#ifdef __STDC__
+static SCM 
+scm_stat2scm (struct stat *stat_temp)
+#else
+static SCM 
+scm_stat2scm (stat_temp)
+     struct stat *stat_temp;
+#endif
+{
+  SCM ans = scm_make_vector (SCM_MAKINUM (13), SCM_UNSPECIFIED, SCM_BOOL_F);
+  SCM *ve = SCM_VELTS (ans);
+  ve[0] = scm_ulong2num ((unsigned long) stat_temp->st_dev);
+  ve[1] = scm_ulong2num ((unsigned long) stat_temp->st_ino);
+  ve[2] = scm_ulong2num ((unsigned long) stat_temp->st_mode);
+  ve[3] = scm_ulong2num ((unsigned long) stat_temp->st_nlink);
+  ve[4] = scm_ulong2num ((unsigned long) stat_temp->st_uid);
+  ve[5] = scm_ulong2num ((unsigned long) stat_temp->st_gid);
+#ifdef HAVE_ST_RDEV
+  ve[6] = scm_ulong2num ((unsigned long) stat_temp->st_rdev);
+#else
+  ve[6] = SCM_BOOL_F;
+#endif
+  ve[7] = scm_ulong2num ((unsigned long) stat_temp->st_size);
+  ve[8] = scm_ulong2num ((unsigned long) stat_temp->st_atime);
+  ve[9] = scm_ulong2num ((unsigned long) stat_temp->st_mtime);
+  ve[10] = scm_ulong2num ((unsigned long) stat_temp->st_ctime);
+#ifdef HAVE_ST_BLKSIZE
+  ve[11] = scm_ulong2num ((unsigned long) stat_temp->st_blksize);
+#else
+  ve[11] = scm_ulong2num (4096L);
+#endif
+#ifdef HAVE_ST_BLOCKS
+  ve[12] = scm_ulong2num ((unsigned long) stat_temp->st_blocks);
+#else
+  ve[12] = SCM_BOOL_F;
+#endif
+
+  return ans;
+}
+
+SCM_PROC (s_sys_stat, "%stat", 1, 0, 0, scm_sys_stat);
+#ifdef __STDC__
+SCM 
+scm_sys_stat (SCM fd_or_path)
+#else
+SCM 
+scm_sys_stat (fd_or_path)
+     SCM fd_or_path;
+#endif
+{
+  int rv;
+  struct stat stat_temp;
+
+  if (SCM_INUMP (fd_or_path))
+    {
+      SCM_ASSERT (SCM_OPFPORTP (fd_or_path), fd_or_path, SCM_ARG1, s_sys_stat);
+      rv = SCM_INUM (fd_or_path);
+      SCM_SYSCALL (rv = fstat (rv, &stat_temp));
+    }
+  else if (SCM_NIMP (fd_or_path) && SCM_FD_P (fd_or_path))
+    {
+      rv = SCM_FD (fd_or_path);
+      SCM_SYSCALL (rv = fstat (rv, &stat_temp));
+    }
+  else
+    {
+      SCM_ASSERT (SCM_NIMP (fd_or_path), fd_or_path, SCM_ARG1, s_sys_stat);
+      SCM_ASSERT (SCM_ROSTRINGP (fd_or_path), fd_or_path, SCM_ARG1, s_sys_stat);
+      if (SCM_ROSTRINGP (fd_or_path))
+	{
+	  if (SCM_SUBSTRP (fd_or_path))
+	    fd_or_path = scm_makfromstr (SCM_ROCHARS (fd_or_path), SCM_ROLENGTH (fd_or_path), 0);
+	  SCM_SYSCALL (rv = stat (SCM_CHARS (fd_or_path), &stat_temp));
+	}
+
+    }
+  return rv ? SCM_MAKINUM (errno) : scm_stat2scm (&stat_temp);
+}
+
+
+
+/* {Modifying Directories}
+ */
+
+SCM_PROC (s_sys_link, "%link", 2, 0, 0, scm_sys_link);
+#ifdef __STDC__
+SCM 
+scm_sys_link (SCM oldpath, SCM newpath)
+#else
+SCM 
+scm_sys_link (oldpath, newpath)
+     SCM oldpath;
+     SCM newpath;
+#endif
+{
+  int val;
+  SCM_ASSERT (SCM_NIMP (oldpath) && SCM_ROSTRINGP (oldpath), oldpath, SCM_ARG1, s_sys_link);
+  if (SCM_SUBSTRP (oldpath))
+    oldpath = scm_makfromstr (SCM_ROCHARS (oldpath), SCM_ROLENGTH (oldpath), 0);
+  SCM_ASSERT (SCM_NIMP (newpath) && SCM_ROSTRINGP (newpath), newpath, SCM_ARG2, s_sys_link);
+  if (SCM_SUBSTRP (newpath))
+    newpath = scm_makfromstr (SCM_ROCHARS (newpath), SCM_ROLENGTH (newpath), 0);
+  SCM_SYSCALL (val = link (SCM_ROCHARS (oldpath), SCM_ROCHARS (newpath)));
+  return val ? SCM_MAKINUM (errno) : SCM_BOOL_T;
+}
+
+
+
+SCM_PROC (s_sys_rename, "%rename-file", 2, 0, 0, scm_sys_rename);
+#ifdef __STDC__
+SCM 
+scm_sys_rename (SCM oldname, SCM newname)
+#else
+SCM 
+scm_sys_rename (oldname, newname)
+     SCM oldname;
+     SCM newname;
+#endif
+{
+  int rv;
+  SCM_ASSERT (SCM_NIMP (oldname) && SCM_STRINGP (oldname), oldname, SCM_ARG1, s_sys_rename);
+  SCM_ASSERT (SCM_NIMP (newname) && SCM_STRINGP (newname), newname, SCM_ARG2, s_sys_rename);
+#ifdef HAVE_RENAME
+  SCM_SYSCALL (rv = rename (SCM_CHARS (oldname), SCM_CHARS (newname)));
+  return rv ? SCM_MAKINUM (errno) : SCM_BOOL_T;
+#else
+  SCM_DEFER_INTS;
+  SCM_SYSCALL (rv = link (SCM_CHARS (oldname), SCM_CHARS (newname)));
+  if (!rv)
+    {
+      SCM_SYSCALL (rv = unlink (SCM_CHARS (oldname)));;
+      if (rv)
+	/* unlink failed.  remove new name */
+	SCM_SYSCALL (unlink (SCM_CHARS (newname))); 
+    }
+  SCM_ALLOW_INTS;
+  return rv ? SCM_MAKINUM (errno) : SCM_BOOL_T;
+#endif
+}
+
+
+
+SCM_PROC (s_sys_mkdir, "%mkdir", 1, 1, 0, scm_sys_mkdir);
+#ifdef __STDC__
+SCM 
+scm_sys_mkdir (SCM path, SCM mode)
+#else
+SCM 
+scm_sys_mkdir (path, mode)
+     SCM path;
+     SCM mode;
+#endif
+{
+#ifdef HAVE_MKDIR
+  int rv;
+  mode_t mask;
+  SCM_ASSERT (SCM_NIMP (path) && SCM_STRINGP (path), path, SCM_ARG1, s_sys_mkdir);
+  if (SCM_UNBNDP (mode))
+    {
+      mask = umask (0);
+      umask (mask);
+      SCM_SYSCALL (rv = mkdir (SCM_CHARS (path), 0777 ^ mask));
+    }
+  else
+    {
+      SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG2, s_sys_mkdir);
+      SCM_SYSCALL (rv = mkdir (SCM_CHARS (path), SCM_INUM (mode)));
+    }
+  return rv ? SCM_MAKINUM (errno) : SCM_BOOL_T;
+#else
+  return SCM_MAKINUM (ENOSYS);
+#endif
+}
+
+
+SCM_PROC (s_sys_rmdir, "%rmdir", 1, 0, 0, scm_sys_rmdir);
+#ifdef __STDC__
+SCM 
+scm_sys_rmdir (SCM path)
+#else
+SCM 
+scm_sys_rmdir (path)
+     SCM path;
+#endif
+{
+#ifdef HAVE_RMDIR
+  int val;
+  SCM_ASSERT (SCM_NIMP (path) && SCM_STRINGP (path), path, SCM_ARG1, s_sys_rmdir);
+  SCM_SYSCALL (val = rmdir (SCM_CHARS (path)));
+  return val ? SCM_MAKINUM (errno) : SCM_BOOL_T;
+#else
+  return SCM_MAKINUM (ENOSYS);
+#endif
+}
+
+
+/* {Examining Directories}
+ */
+
+long scm_tc16_dir;
+
+SCM_PROC (s_sys_opendir, "%opendir", 1, 0, 0, scm_sys_opendir);
+#ifdef __STDC__
+SCM 
+scm_sys_opendir (SCM dirname)
+#else
+SCM 
+scm_sys_opendir (dirname)
+     SCM dirname;
+#endif
+{
+  DIR *ds;
+  SCM dir;
+  SCM_ASSERT (SCM_NIMP (dirname) && SCM_STRINGP (dirname), dirname, SCM_ARG1, s_sys_opendir);
+  SCM_NEWCELL (dir);
+  SCM_DEFER_INTS;
+  SCM_SYSCALL (ds = opendir (SCM_CHARS (dirname)));
+  if (!ds)
+    {
+      SCM_ALLOW_INTS;
+      return SCM_MAKINUM (errno);
+    }
+  SCM_CAR (dir) = scm_tc16_dir | SCM_OPN;
+  SCM_SETCDR (dir, ds);
+  SCM_ALLOW_INTS;
+  return dir;
+}
+
+
+SCM_PROC (s_sys_readdir, "%readdir", 1, 0, 0, scm_sys_readdir);
+#ifdef __STDC__
+SCM 
+scm_sys_readdir (SCM port)
+#else
+SCM 
+scm_sys_readdir (port)
+     SCM port;
+#endif
+{
+  struct dirent *rdent;
+  SCM_DEFER_INTS;
+  SCM_ASSERT (SCM_NIMP (port) && SCM_OPDIRP (port), port, SCM_ARG1, s_sys_readdir);
+  errno = 0;
+  SCM_SYSCALL (rdent = readdir ((DIR *) SCM_CDR (port)));
+  SCM_ALLOW_INTS;
+  return (rdent
+	  ? scm_makfromstr (rdent->d_name, NAMLEN (rdent), 0)
+	  : (errno ? SCM_MAKINUM (errno) : SCM_EOF_VAL));
+}
+
+
+
+SCM_PROC (s_rewinddir, "rewinddir", 1, 0, 0, scm_rewinddir);
+#ifdef __STDC__
+SCM 
+scm_rewinddir (SCM port)
+#else
+SCM 
+scm_rewinddir (port)
+     SCM port;
+#endif
+{
+  SCM_ASSERT (SCM_NIMP (port) && SCM_OPDIRP (port), port, SCM_ARG1, s_rewinddir);
+  rewinddir ((DIR *) SCM_CDR (port));
+  return SCM_UNSPECIFIED;
+}
+
+
+
+SCM_PROC (s_sys_closedir, "%closedir", 1, 0, 0, scm_sys_closedir);
+#ifdef __STDC__
+SCM 
+scm_sys_closedir (SCM port)
+#else
+SCM 
+scm_sys_closedir (port)
+     SCM port;
+#endif
+{
+  int sts;
+  SCM_ASSERT (SCM_NIMP (port) && SCM_DIRP (port), port, SCM_ARG1, s_sys_closedir);
+  SCM_DEFER_INTS;
+  if (SCM_CLOSEDP (port))
+    {
+      SCM_ALLOW_INTS;
+      return SCM_MAKINUM (errno);
+    }
+  SCM_SYSCALL (sts = closedir ((DIR *) SCM_CDR (port)));
+  if (sts)
+    {
+      SCM_ALLOW_INTS;
+      return SCM_MAKINUM (errno);
+    }
+  SCM_CAR (port) = scm_tc16_dir;
+  SCM_ALLOW_INTS;
+  return SCM_BOOL_T;
+}
+
+
+
+#ifdef __STDC__
+static int 
+scm_dir_print (SCM sexp, SCM port, int writing)
+#else
+static int 
+scm_dir_print (sexp, port, writing)
+     SCM sexp;
+     SCM port;
+     int writing;
+#endif
+{
+  scm_prinport (sexp, port, "directory");
+  return 1;
+}
+
+#ifdef __STDC__
+static scm_sizet 
+scm_dir_free (SCM p)
+#else
+static scm_sizet 
+scm_dir_free (p)
+     SCM p;
+#endif
+{
+  if (SCM_OPENP (p))
+    closedir ((DIR *) SCM_CDR (p));
+  return 0;
+}
+
+static scm_smobfuns dir_smob = {scm_mark0, scm_dir_free, scm_dir_print, 0};
+
+
+/* {Navigating Directories}
+ */
+
+
+SCM_PROC (s_sys_chdir, "%chdir", 1, 0, 0, scm_sys_chdir);
+#ifdef __STDC__
+SCM 
+scm_sys_chdir (SCM str)
+#else
+SCM 
+scm_sys_chdir (str)
+     SCM str;
+#endif
+{
+  int ans;
+  SCM_ASSERT (SCM_NIMP (str) && SCM_STRINGP (str), str, SCM_ARG1, s_sys_chdir);
+  SCM_SYSCALL (ans = chdir (SCM_CHARS (str)));
+  return ans ? SCM_MAKINUM (errno) : SCM_BOOL_T;
+}
+
+
+
+SCM_PROC (s_sys_getcwd, "%getcwd", 0, 0, 0, scm_sys_getcwd);
+#ifdef __STDC__
+SCM 
+scm_sys_getcwd (void)
+#else
+SCM 
+scm_sys_getcwd ()
+#endif
+{
+#ifdef HAVE_GETCWD
+  char *rv;
+
+  scm_sizet size = 100;
+  char *wd;
+  SCM result;
+
+  SCM_DEFER_INTS;
+  wd = scm_must_malloc (size, s_sys_getcwd);
+  while ((rv = getcwd (wd, size)) == 0 && errno == ERANGE)
+    {
+      scm_must_free (wd);
+      size *= 2;
+      wd = scm_must_malloc (size, s_sys_getcwd);
+    }
+  if (rv != 0)
+    result = scm_makfromstr (wd, strlen (wd), 0);
+  else
+    result = SCM_MAKINUM (errno);
+  scm_must_free (wd);
+  SCM_ALLOW_INTS;
+  return result;
+#else
+  return SCM_MAKINUM (ENOSYS);
+#endif
+}
+
+
+
+#ifdef __STDC__
+static void
+fill_select_type (SELECT_TYPE * set, SCM list)
+#else
+static void
+fill_select_type (set, list)
+     SELECT_TYPE * set;
+     SCM list;
+#endif
+{
+  while (list != SCM_EOL)
+    {
+      if (   SCM_NIMP (SCM_CAR (list))
+	  && (scm_tc16_fport == SCM_TYP16 (SCM_CAR (list)))
+	  && SCM_OPPORTP (SCM_CAR (list)))
+	FD_SET (fileno ((FILE *)SCM_STREAM (SCM_CAR (list))), set);
+      else if (SCM_INUMP (SCM_CAR (list)))
+	FD_SET (SCM_INUM (SCM_CAR (list)), set);
+      else if (SCM_NIMP (SCM_CAR (list)) && SCM_FD_P (SCM_CAR (list)))
+	FD_SET (SCM_FD (SCM_CAR (list)), set);
+      list = SCM_CDR (list);
+    }
+}
+
+#ifdef __STDC__
+static SCM 
+retrieve_select_type (SELECT_TYPE * set, SCM list)
+#else
+static SCM 
+retrieve_select_type (set, list)
+     SELECT_TYPE * set;
+     SCM list;
+#endif
+{
+  SCM answer;
+  answer = SCM_EOL;
+  while (list != SCM_EOL)
+    {
+      if (   SCM_NIMP (SCM_CAR (list))
+	  && (scm_tc16_fport == SCM_TYP16 (SCM_CAR (list)))
+	  && SCM_OPPORTP (SCM_CAR (list)))
+	{
+	  if (FD_ISSET (fileno ((FILE *)SCM_STREAM (SCM_CAR (list))), set))
+	    answer = scm_cons (SCM_CAR (list), answer);
+	}
+      else if (SCM_INUMP (SCM_CAR (list)))
+	{
+	  if (FD_ISSET (SCM_INUM (SCM_CAR (list)), set))
+	    answer = scm_cons (SCM_CAR (list), answer);
+	}
+      else if (SCM_NIMP (SCM_CAR (list)) && SCM_FD_P (SCM_CAR (list)))
+	{
+	  if (FD_ISSET (SCM_FD (SCM_CAR (list)), set))
+	    answer = scm_cons (SCM_CAR (list), answer);
+	}
+      list = SCM_CDR (list);
+    }
+  return answer;
+}
+
+
+SCM_PROC (s_sys_select, "%select", 3, 2, 0, scm_sys_select);
+#ifdef __STDC__
+SCM
+scm_sys_select (SCM reads, SCM writes, SCM excepts, SCM secs, SCM msecs)
+#else
+SCM
+scm_sys_select (reads, writes, excepts, secs, msecs)
+     SCM reads;
+     SCM writes;
+     SCM excepts;
+     SCM secs;
+     SCM msecs;
+#endif
+{
+#ifdef HAVE_SELECT
+  struct timeval timeout;
+  struct timeval * time_p;
+  SELECT_TYPE read_set;
+  SELECT_TYPE write_set;
+  SELECT_TYPE except_set;
+  int sreturn;
+
+  SCM_ASSERT (-1 < scm_ilength (reads), reads, SCM_ARG1, s_sys_select);
+  SCM_ASSERT (-1 < scm_ilength (writes), reads, SCM_ARG1, s_sys_select);
+  SCM_ASSERT (-1 < scm_ilength (excepts), reads, SCM_ARG1, s_sys_select);
+
+  FD_ZERO (&read_set);
+  FD_ZERO (&write_set);
+  FD_ZERO (&except_set);
+
+  fill_select_type (&read_set, reads);
+  fill_select_type (&write_set, writes);
+  fill_select_type (&except_set, excepts);
+
+  if (SCM_UNBNDP (secs))
+    time_p = 0;
+  else
+    {
+      SCM_ASSERT (SCM_INUMP (secs), secs, SCM_ARG4, s_sys_select);
+      if (SCM_UNBNDP (msecs))
+	msecs = SCM_INUM0;
+      else
+	SCM_ASSERT (SCM_INUMP (msecs), msecs, SCM_ARG5, s_sys_select);
+
+      timeout.tv_sec = SCM_INUM (secs);
+      timeout.tv_usec = 1000 * SCM_INUM (msecs);
+      time_p = &timeout;
+    }
+
+  SCM_DEFER_INTS;
+  sreturn = select (SELECT_SET_SIZE,
+		    &read_set, &write_set, &except_set, time_p);
+  SCM_ALLOW_INTS;
+  if (sreturn < 0)
+    return SCM_MAKINUM (errno);
+  else
+    return scm_listify (retrieve_select_type (&read_set, reads),
+			retrieve_select_type (&write_set, writes),
+			retrieve_select_type (&except_set, excepts),
+			SCM_UNDEFINED);
+#else
+  return SCM_MAKINUM (ENOSYS);
+#endif
+}
+
+
+/* {Symbolic Links} 
+ */
+
+SCM_PROC (s_sys_symlink, "%symlink", 2, 0, 0, scm_sys_symlink);
+#ifdef __STDC__
+SCM
+scm_sys_symlink(SCM oldpath, SCM newpath)
+#else
+SCM
+scm_sys_symlink(oldpath, newpath)
+     SCM oldpath;
+     SCM newpath;
+#endif
+{
+#ifdef HAVE_SYMLINK
+  int val;
+  SCM_ASSERT(SCM_NIMP(oldpath) && SCM_STRINGP(oldpath), oldpath, SCM_ARG1, s_sys_symlink);
+  SCM_ASSERT(SCM_NIMP(newpath) && SCM_STRINGP(newpath), newpath, SCM_ARG2, s_sys_symlink);
+  SCM_SYSCALL(val = symlink(SCM_CHARS(oldpath), SCM_CHARS(newpath)));
+  return val ? SCM_MAKINUM (errno) : SCM_BOOL_T;
+#else
+  return SCM_MAKINUM (ENOSYS);
+#endif
+}
+
+
+SCM_PROC (s_sys_readlink, "%readlink", 1, 0, 0, scm_sys_readlink);
+#ifdef __STDC__
+SCM
+scm_sys_readlink(SCM path)
+#else
+SCM
+scm_sys_readlink(path)
+  SCM path;
+#endif
+{
+#ifdef HAVE_READLINK
+  scm_sizet rv;
+  scm_sizet size = 100;
+  char *buf;
+  SCM result;
+  SCM_ASSERT (SCM_NIMP (path) && SCM_STRINGP (path),  path, (char *) SCM_ARG1, s_sys_readlink);
+  SCM_DEFER_INTS;
+  buf = scm_must_malloc (size, s_sys_readlink);
+  while ((rv = readlink (SCM_CHARS (path), buf, (scm_sizet) size)) == size)
+    {
+      scm_must_free (buf);
+      size *= 2;
+      buf = scm_must_malloc (size, s_sys_readlink);
+    }
+  if (rv != -1)
+    result = scm_makfromstr (buf, rv, 0);
+  else
+    result = SCM_MAKINUM (errno);
+  scm_must_free (buf);
+  SCM_ALLOW_INTS;
+  return result;
+#else
+  return SCM_MAKINUM (ENOSYS);
+#endif
+}
+
+
+SCM_PROC (s_sys_lstat, "%lstat", 1, 0, 0, scm_sys_lstat);
+#ifdef __STDC__
+SCM
+scm_sys_lstat(SCM str)
+#else
+SCM
+scm_sys_lstat(str)
+  SCM str;
+#endif
+{
+#ifdef HAVE_LSTATE
+  int i;
+  struct stat stat_temp;
+  SCM_ASSERT(SCM_NIMP(str) && SCM_STRINGP(str), str, (char *)SCM_ARG1, s_sys_lstat);
+  SCM_SYSCALL(i = lstat(SCM_CHARS(str), &stat_temp));
+  return i ? SCM_MAKINUM (errno) :  scm_stat2scm(&stat_temp);
+#else 
+  return SCM_MAKINUM (ENOSYS);
+#endif
+}
+
+
+SCM_PROC (s_sys_copy_file, "%copy-file", 2, 0, 0, scm_sys_copy_file);
+#ifdef __STDC__
+SCM
+scm_sys_copy_file (SCM oldfile, SCM newfile)
+#else
+SCM
+scm_sys_copy_file (oldfile, newfile)
+     SCM oldfile;
+     SCM newfile;
+#endif
+{
+  int oldfd, newfd;
+  int n;
+  char buf[BUFSIZ];		/* this space could be shared.  */
+  struct stat oldstat;
+
+  SCM_ASSERT (SCM_NIMP (oldfile) && SCM_ROSTRINGP (oldfile), oldfile, SCM_ARG1, s_sys_copy_file);
+  if (SCM_SUBSTRP (oldfile))
+    oldfile = scm_makfromstr (SCM_ROCHARS (oldfile), SCM_ROLENGTH (oldfile), 0);
+  SCM_ASSERT (SCM_NIMP (newfile) && SCM_ROSTRINGP (newfile), newfile, SCM_ARG2, s_sys_copy_file);
+  if (SCM_SUBSTRP (newfile))
+    newfile = scm_makfromstr (SCM_ROCHARS (newfile), SCM_ROLENGTH (newfile), 0);
+  if (stat (SCM_ROCHARS (oldfile), &oldstat) == -1)
+    return SCM_BOOL_F;
+  SCM_DEFER_INTS;
+  oldfd = open (SCM_ROCHARS (oldfile), O_RDONLY);
+  if (oldfd == -1)
+    {
+      SCM_ALLOW_INTS;
+      return SCM_BOOL_F;
+    }
+  /* should probably use the POSIX flags instead of 07777.  */
+  newfd = open (SCM_ROCHARS (newfile), O_WRONLY | O_CREAT | O_TRUNC,
+		oldstat.st_mode & 07777);
+  if (newfd == -1)
+    {
+      close (oldfd);
+      SCM_ALLOW_INTS;
+      return SCM_BOOL_F;
+    }
+  while ((n = read (oldfd, buf, sizeof buf)) > 0)
+    if (write (newfd, buf, n) != n)
+      {
+	close (oldfd);
+	close (newfd);
+	SCM_ALLOW_INTS;
+	return SCM_BOOL_F;
+      }
+  close (oldfd);
+  if (close (newfd) == -1)
+    {
+      SCM_ALLOW_INTS;
+      return SCM_BOOL_F;
+    }
+  SCM_ALLOW_INTS;
+  return SCM_BOOL_T;
+}
+
+
+#ifdef __STDC__
+void
+scm_init_filesys (void)
+#else
+void
+scm_init_filesys ()
+#endif
+{
+  /* File type/permission bits.  */
+#ifdef S_IRUSR
+  scm_sysintern ("S_IRUSR", SCM_MAKINUM (S_IRUSR));
+#endif
+#ifdef S_IWUSR
+  scm_sysintern ("S_IWUSR", SCM_MAKINUM (S_IWUSR));
+#endif
+#ifdef S_IXUSR
+  scm_sysintern ("S_IXUSR", SCM_MAKINUM (S_IXUSR));
+#endif
+#ifdef S_IRWXU
+  scm_sysintern ("S_IRWXU", SCM_MAKINUM (S_IRWXU));
+#endif
+
+#ifdef S_IRGRP
+  scm_sysintern ("S_IRGRP", SCM_MAKINUM (S_IRGRP));
+#endif
+#ifdef S_IWGRP
+  scm_sysintern ("S_IWGRP", SCM_MAKINUM (S_IWGRP));
+#endif
+#ifdef S_IXGRP
+  scm_sysintern ("S_IXGRP", SCM_MAKINUM (S_IXGRP));
+#endif
+#ifdef S_IRWXG
+  scm_sysintern ("S_IRWXG", SCM_MAKINUM (S_IRWXG));
+#endif
+
+#ifdef S_IROTH
+  scm_sysintern ("S_IROTH", SCM_MAKINUM (S_IROTH));
+#endif
+#ifdef S_IWOTH
+  scm_sysintern ("S_IWOTH", SCM_MAKINUM (S_IWOTH));
+#endif
+#ifdef S_IXOTH
+  scm_sysintern ("S_IXOTH", SCM_MAKINUM (S_IXOTH));
+#endif
+#ifdef S_IRWXO
+  scm_sysintern ("S_IRWXO", SCM_MAKINUM (S_IRWXO));
+#endif
+
+#ifdef S_ISUID
+  scm_sysintern ("S_ISUID", SCM_MAKINUM (S_ISUID));
+#endif
+#ifdef S_ISGID
+  scm_sysintern ("S_ISGID", SCM_MAKINUM (S_ISGID));
+#endif
+#ifdef S_ISVTX
+  scm_sysintern ("S_ISVTX", SCM_MAKINUM (S_ISVTX));
+#endif
+
+#ifdef S_IFMT
+  scm_sysintern ("S_IFMT", SCM_MAKINUM (S_IFMT));
+#endif
+#ifdef S_IFDIR
+  scm_sysintern ("S_IFDIR", SCM_MAKINUM (S_IFDIR));
+#endif
+#ifdef S_IFCHR
+  scm_sysintern ("S_IFCHR", SCM_MAKINUM (S_IFCHR));
+#endif
+#ifdef S_IFBLK
+  scm_sysintern ("S_IFBLK", SCM_MAKINUM (S_IFBLK));
+#endif
+#ifdef S_IFREG
+  scm_sysintern ("S_IFREG", SCM_MAKINUM (S_IFREG));
+#endif
+#ifdef S_IFLNK
+  scm_sysintern ("S_IFLNK", SCM_MAKINUM (S_IFLNK));
+#endif
+#ifdef S_IFSOCK
+  scm_sysintern ("S_IFSOCK", SCM_MAKINUM (S_IFSOCK));
+#endif
+#ifdef S_IFIFO
+  scm_sysintern ("S_IFIFO", SCM_MAKINUM (S_IFIFO));
+#endif
+
+
+  scm_tc16_fd = scm_newsmob (&fd_smob);
+  scm_tc16_dir = scm_newsmob (&dir_smob);
+
+#include "filesys.x"
+}
diff --git a/libguile/filesys.h b/libguile/filesys.h
new file mode 100644
index 000000000..9949d383b
--- /dev/null
+++ b/libguile/filesys.h
@@ -0,0 +1,135 @@
+/* classes: h_files */
+
+#ifndef FILESYSH
+#define FILESYSH
+/*	Copyright (C) 1995 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+
+extern long scm_tc16_fd;
+
+#define SCM_FD_P(x) (SCM_TYP16(x)==(scm_tc16_fd))
+#define SCM_FD_FLAGS(x)			(SCM_CAR(x) >> 16)
+#define SCM_FD(x)			((int)SCM_CDR (x))
+
+enum scm_fd_flags
+{
+  scm_fd_is_open = 1,
+  scm_close_fd_on_gc = 2
+};
+
+
+
+
+extern long scm_tc16_dir;
+#define SCM_DIRP(x) (SCM_TYP16(x)==(scm_tc16_dir))
+#define SCM_OPDIRP(x) (SCM_CAR(x)==(scm_tc16_dir | SCM_OPN))
+
+
+
+#ifdef __STDC__
+extern SCM scm_sys_chown (SCM path, SCM owner, SCM group);
+extern SCM scm_sys_chmod (SCM port_or_path, SCM mode);
+extern SCM scm_umask (SCM mode);
+extern SCM scm_intern_fd (int fd, int flags);
+extern SCM scm_sys_open (SCM path, SCM flags, SCM mode);
+extern SCM scm_sys_create (SCM path, SCM mode);
+extern SCM scm_sys_close (SCM sfd);
+extern SCM scm_sys_write_fd (SCM sfd, SCM buf);
+extern SCM scm_sys_read_fd (SCM sfd, SCM buf, SCM offset, SCM length);
+extern SCM scm_sys_lseek (SCM sfd, SCM offset, SCM whence);
+extern SCM scm_sys_dup (SCM oldfd, SCM newfd);
+extern SCM scm_sys_stat (SCM fd_or_path);
+extern SCM scm_sys_link (SCM oldpath, SCM newpath);
+extern SCM scm_sys_rename (SCM oldname, SCM newname);
+extern SCM scm_sys_mkdir (SCM path, SCM mode);
+extern SCM scm_sys_rmdir (SCM path);
+extern SCM scm_sys_opendir (SCM dirname);
+extern SCM scm_sys_readdir (SCM port);
+extern SCM scm_rewinddir (SCM port);
+extern SCM scm_sys_closedir (SCM port);
+extern SCM scm_sys_chdir (SCM str);
+extern SCM scm_sys_getcwd (void);
+extern SCM scm_sys_select (SCM reads, SCM writes, SCM excepts, SCM secs, SCM msecs);
+extern SCM scm_sys_symlink(SCM oldpath, SCM newpath);
+extern SCM scm_sys_readlink(SCM path);
+extern SCM scm_sys_lstat(SCM str);
+extern SCM scm_sys_copy_file (SCM oldfile, SCM newfile);
+extern void scm_init_filesys (void);
+
+#else /* STDC */
+extern SCM scm_sys_chown ();
+extern SCM scm_sys_chmod ();
+extern SCM scm_umask ();
+extern SCM scm_intern_fd ();
+extern SCM scm_sys_open ();
+extern SCM scm_sys_create ();
+extern SCM scm_sys_close ();
+extern SCM scm_sys_write_fd ();
+extern SCM scm_sys_read_fd ();
+extern SCM scm_sys_lseek ();
+extern SCM scm_sys_dup ();
+extern SCM scm_sys_stat ();
+extern SCM scm_sys_link ();
+extern SCM scm_sys_rename ();
+extern SCM scm_sys_mkdir ();
+extern SCM scm_sys_rmdir ();
+extern SCM scm_sys_opendir ();
+extern SCM scm_sys_readdir ();
+extern SCM scm_rewinddir ();
+extern SCM scm_sys_closedir ();
+extern SCM scm_sys_chdir ();
+extern SCM scm_sys_getcwd ();
+extern SCM scm_sys_select ();
+extern SCM scm_sys_symlink();
+extern SCM scm_sys_readlink();
+extern SCM scm_sys_lstat();
+extern SCM scm_sys_copy_file ();
+extern void scm_init_filesys ();
+
+#endif /* STDC */
+
+#endif  /* FILESYSH */
diff --git a/libguile/fports.c b/libguile/fports.c
new file mode 100644
index 000000000..234c21d26
--- /dev/null
+++ b/libguile/fports.c
@@ -0,0 +1,391 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include "_scm.h"
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#else
+char *ttyname ();
+char *tmpnam ();
+scm_sizet fwrite ();
+#endif
+#ifdef HAVE_STRING_H
+#include "string.h"
+#endif
+
+
+#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
+
+
+/* {Ports - file ports}
+ * 
+ */
+
+/* should be called with SCM_DEFER_INTS active */
+#ifdef __STDC__
+SCM 
+scm_setbuf0 (SCM port)
+#else
+SCM 
+scm_setbuf0 (port)
+     SCM port;
+#endif
+{
+#ifndef NOSETBUF
+#ifndef MSDOS
+#ifdef FIONREAD
+#ifndef ultrix
+  SCM_SYSCALL (setbuf ((FILE *)SCM_STREAM (port), 0););
+#endif
+#endif
+#endif
+#endif
+  return SCM_UNSPECIFIED;
+}
+
+/* Return the flags that characterize a port based on the mode
+ * string used to open a file for that port.
+ *
+ * See PORT FLAGS in scm.h
+ */
+#ifdef __STDC__
+long
+scm_mode_bits (char *modes)
+#else
+long
+scm_mode_bits (modes)
+     char *modes;
+#endif
+{
+  return (SCM_OPN
+	  | (strchr (modes, 'r') || strchr (modes, '+') ? SCM_RDNG : 0)
+	  | (   strchr (modes, 'w')
+	     || strchr (modes, 'a')
+	     || strchr (modes, '+') ? SCM_WRTNG : 0)
+	  | (strchr (modes, '0') ? SCM_BUF0 : 0));
+}
+
+
+/* scm_open_file
+ * Return a new port open on a given file.
+ *
+ * The mode string must match the pattern: [rwa+]** which
+ * is interpreted in the usual unix way.
+ *
+ * Return the new port.
+ */
+
+#ifdef __STDC__
+SCM
+scm_mkfile (char * name, char * modes)
+#else
+SCM
+scm_mkfile (name, modes)
+     char * name;
+     char * modes;
+#endif
+{
+  register SCM port;
+  FILE *f;
+  SCM_NEWCELL (port);
+  SCM_DEFER_INTS;
+  SCM_SYSCALL (f = fopen (name, modes));
+  if (!f)
+    {
+      SCM_ALLOW_INTS;
+      port = SCM_BOOL_F;
+    }
+  else
+    {
+      struct scm_port_table * pt;
+      pt = scm_add_to_port_table (port);
+      SCM_SETPTAB_ENTRY (port, pt);
+      if (SCM_BUF0 & (SCM_CAR (port) = scm_tc16_fport | scm_mode_bits (modes)))
+	scm_setbuf0 (port);
+      SCM_SETSTREAM (port, (SCM)f);
+      SCM_PTAB_ENTRY (port)->file_name = scm_makfrom0str (name);
+      SCM_ALLOW_INTS;
+    }
+  return port;
+}
+
+SCM_PROC(s_open_file, "open-file", 2, 0, 0, scm_open_file);
+#ifdef __STDC__
+SCM
+scm_open_file (SCM filename, SCM modes)
+#else
+SCM
+scm_open_file (filename, modes)
+     SCM filename;
+     SCM modes;
+#endif
+{
+  SCM port;
+  SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename, SCM_ARG1, s_open_file);
+  SCM_ASSERT (SCM_NIMP (modes) && SCM_ROSTRINGP (modes), modes, SCM_ARG2, s_open_file);
+  if (SCM_SUBSTRP (filename))
+    filename = scm_makfromstr (SCM_ROCHARS (filename), SCM_ROLENGTH (filename), 0);
+  if (SCM_SUBSTRP (modes))
+    modes = scm_makfromstr (SCM_ROCHARS (modes), SCM_ROLENGTH (modes), 0);
+  port = scm_mkfile (SCM_ROCHARS (filename), SCM_ROCHARS (modes));
+  /* Force the compiler to keep filename and modes alive:
+   */
+  if (port == SCM_BOOL_F)
+    scm_cons (filename, modes);
+  return port;
+}
+
+/* Return the mode flags from an open port.
+ * Some modes such as "append" are only used when opening
+ * a file and are not returned here.
+ */
+
+SCM_PROC(s_port_mode, "port-mode", 1, 0, 0, scm_port_mode);
+#ifdef __STDC__
+SCM
+scm_port_mode (SCM port)
+#else
+SCM
+scm_port_mode (port)
+     SCM port;
+#endif
+{
+  char modes[3];
+  modes[0] = '\0';
+  SCM_ASSERT (SCM_NIMP (port) && SCM_OPPORTP (port), port, SCM_ARG1, s_port_mode);  
+  if (SCM_CAR (port) & SCM_RDNG) {
+    if (SCM_CAR (port) & SCM_WRTNG)
+      strcpy (modes, "r+");
+    else
+      strcpy (modes, "r");
+  }
+  else if (SCM_CAR (port) & SCM_WRTNG)
+    strcpy (modes, "w");
+  if (SCM_CAR (port) & SCM_BUF0)
+    strcat (modes, "0");
+  return scm_makfromstr (modes, strlen (modes), 0);
+}
+
+
+#ifdef __STDC__
+static int 
+prinfport (SCM exp, SCM port, int writing)
+#else
+static int 
+prinfport (exp, port, writing)
+     SCM exp;
+     SCM port;
+     int writing;
+#endif
+{
+  SCM name;
+  char * c;
+  if (SCM_CLOSEDP (exp))
+    {
+      c = "file";
+    }
+  else
+    {
+      name = SCM_PTAB_ENTRY (exp)->file_name;
+      if (SCM_NIMP (name) && SCM_ROSTRINGP (name))
+	c = SCM_ROCHARS (name);
+      else
+	c = "file";
+    }
+
+  scm_prinport (exp, port, c);
+  return !0;
+}
+
+
+#ifdef __STDC__
+static int
+scm_fgetc (FILE * s)
+#else
+static int
+scm_fgetc (s)
+     FILE * s;
+#endif
+{
+  if (feof (s))
+    return EOF;
+  else
+    return fgetc (s);
+}
+
+#ifdef vms
+#ifdef __STDC__
+static scm_sizet 
+pwrite (char *ptr, scm_sizet size, nitems, FILE *port)
+#else
+static scm_sizet 
+pwrite (ptr, size, nitems, port)
+     char *ptr;
+     scm_sizet size, nitems;
+     FILE *port;
+#endif
+{
+  scm_sizet len = size * nitems;
+  scm_sizet i = 0;
+  for (; i < len; i++)
+    putc (ptr[i], port);
+  return len;
+}
+
+#define ffwrite pwrite
+#else
+#define ffwrite fwrite
+#endif
+
+
+/* This otherwise pointless code helps some poor 
+ * crippled C compilers cope with life. 
+ */
+static int
+local_fclose (fp)
+     FILE * fp;
+{
+  return fclose (fp);
+}
+
+static int
+local_fflush (fp)
+     FILE * fp;
+{
+  return fflush (fp);
+}
+
+static int
+local_fputc (c, fp)
+     int c;
+     FILE * fp;
+{
+  return fputc (c, fp);
+}
+
+static int
+local_fputs (s, fp)
+     char * s;
+     FILE * fp;
+{
+  return fputs (s, fp);
+}
+
+static scm_sizet
+local_ffwrite (ptr, size, nitems, fp)
+     void * ptr;
+     int size;
+     int nitems;
+     FILE * fp;
+{
+  return ffwrite (ptr, size, nitems, fp);
+}
+
+
+scm_ptobfuns scm_fptob =
+{
+  scm_mark0,
+  local_fclose,
+  prinfport,
+  0,
+  local_fputc,
+  local_fputs,
+  local_ffwrite,
+  local_fflush,
+  scm_fgetc,
+  local_fclose
+};
+
+/* {Pipe ports}
+ */
+scm_ptobfuns scm_pipob =
+{
+  scm_mark0,
+  0, 				/* replaced by pclose in scm_init_ioext() */
+  0, 				/* replaced by prinpipe in scm_init_ioext() */
+  0,
+  local_fputc,
+  local_fputs,
+  local_ffwrite,
+  local_fflush,
+  scm_fgetc,
+  0
+};				/* replaced by pclose in scm_init_ioext() */
+
+
+#ifdef __STDC__
+void
+scm_init_fports (void)
+#else
+void
+scm_init_fports ()
+#endif
+{
+#include "fports.x"
+}
+
diff --git a/libguile/fports.h b/libguile/fports.h
new file mode 100644
index 000000000..a0ca6fe3b
--- /dev/null
+++ b/libguile/fports.h
@@ -0,0 +1,78 @@
+/* classes: h_files */
+
+#ifndef FPORTSH
+#define FPORTSH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+
+
+
+extern scm_ptobfuns scm_fptob;
+extern scm_ptobfuns scm_pipob;
+
+
+#ifdef __STDC__
+extern SCM scm_setbuf0 (SCM port);
+extern long scm_mode_bits (char *modes);
+extern SCM scm_mkfile (char * name, char * modes);
+extern SCM scm_open_file (SCM filename, SCM modes);
+extern SCM scm_port_mode (SCM port);
+extern void scm_init_fports (void);
+
+#else /* STDC */
+extern SCM scm_setbuf0 ();
+extern long scm_mode_bits ();
+extern SCM scm_mkfile ();
+extern SCM scm_open_file ();
+extern SCM scm_port_mode ();
+extern void scm_init_fports ();
+
+#endif /* STDC */
+
+
+
+
+
+
+#endif  /* FPORTSH */
diff --git a/libguile/gc.c b/libguile/gc.c
new file mode 100644
index 000000000..26e718158
--- /dev/null
+++ b/libguile/gc.c
@@ -0,0 +1,1690 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+#include <stdio.h>
+#include "_scm.h"
+
+#ifdef HAVE_MALLOC_H
+#include "malloc.h"
+#endif
+
+#ifdef HAVE_UNISTD_H
+#include "unistd.h"
+#endif
+
+
+/* {heap tuning parameters}
+ * 
+ * These are parameters for controlling memory allocation.  The heap
+ * is the area out of which scm_cons, and object headers are allocated.
+ *
+ * Each heap cell is 8 bytes on a 32 bit machine and 16 bytes on a
+ * 64 bit machine.  The units of the _SIZE parameters are bytes.
+ * Cons pairs and object headers occupy one heap cell.
+ *
+ * SCM_INIT_HEAP_SIZE is the initial size of heap.  If this much heap is
+ * allocated initially the heap will grow by half its current size
+ * each subsequent time more heap is needed.
+ *
+ * If SCM_INIT_HEAP_SIZE heap cannot be allocated initially, SCM_HEAP_SEG_SIZE
+ * will be used, and the heap will grow by SCM_HEAP_SEG_SIZE when more
+ * heap is needed.  SCM_HEAP_SEG_SIZE must fit into type scm_sizet.  This code
+ * is in scm_init_storage() and alloc_some_heap() in sys.c
+ * 
+ * If SCM_INIT_HEAP_SIZE can be allocated initially, the heap will grow by
+ * SCM_EXPHEAP(scm_heap_size) when more heap is needed.
+ *
+ * SCM_MIN_HEAP_SEG_SIZE is minimum size of heap to accept when more heap
+ * is needed.
+ *
+ * INIT_MALLOC_LIMIT is the initial amount of malloc usage which will
+ * trigger a GC. 
+ */
+
+#define SCM_INIT_HEAP_SIZE (32768L*sizeof(scm_cell))
+#define SCM_MIN_HEAP_SEG_SIZE (2048L*sizeof(scm_cell))
+#ifdef _QC
+# define SCM_HEAP_SEG_SIZE 32768L
+#else
+# ifdef sequent
+#  define SCM_HEAP_SEG_SIZE (7000L*sizeof(scm_cell))
+# else
+#  define SCM_HEAP_SEG_SIZE (16384L*sizeof(scm_cell))
+# endif
+#endif
+#define SCM_EXPHEAP(scm_heap_size) (scm_heap_size*2)
+#define SCM_INIT_MALLOC_LIMIT 100000
+
+/* CELL_UP and CELL_DN are used by scm_init_heap_seg to find scm_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) (SCM_CELLPTR)(~1L & ((long)(p)+1L))
+#  define CELL_DN(p) (SCM_CELLPTR)(~1L & (long)(p))
+# else
+#  define CELL_UP(p) (SCM_CELLPTR)(~(sizeof(scm_cell)-1L) & ((long)(p)+sizeof(scm_cell)-1L))
+#  define CELL_DN(p) (SCM_CELLPTR)(~(sizeof(scm_cell)-1L) & (long)(p))
+# endif				/* UNICOS */
+#endif				/* PROT386 */
+
+
+
+/* scm_freelist
+ * is the head of freelist of cons pairs.
+ */
+SCM scm_freelist = SCM_EOL;
+
+/* scm_mtrigger
+ * is the number of bytes of must_malloc allocation needed to trigger gc.
+ */
+long scm_mtrigger;
+
+
+/* scm_gc_heap_lock
+ * If set, don't expand the heap.  Set only during gc, during which no allocation
+ * is supposed to take place anyway.
+ */
+int scm_gc_heap_lock = 0;
+
+/* GC Blocking
+ * Don't pause for collection if this is set -- just
+ * expand the heap.
+ */
+
+int scm_block_gc = 1;
+
+/* 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 (scm_heap_size/4)
+
+/* During collection, this accumulates objects holding
+ * weak references.
+ */
+SCM *scm_weak_vectors;
+int scm_weak_size;
+int scm_n_weak;
+
+/* GC Statistics Keeping
+ */
+unsigned long scm_cells_allocated = 0;
+unsigned long scm_mallocated = 0;
+unsigned long scm_gc_cells_collected;
+unsigned long scm_gc_malloc_collected;
+unsigned long scm_gc_ports_collected;
+unsigned long scm_gc_rt;
+unsigned long scm_gc_time_taken = 0;
+
+SCM_SYMBOL (sym_cells_allocated, "cells-allocated");
+SCM_SYMBOL (sym_heap_size, "cell-heap-size");
+SCM_SYMBOL (sym_mallocated, "bytes-malloced");
+SCM_SYMBOL (sym_mtrigger, "gc-malloc-threshold");
+SCM_SYMBOL (sym_heap_segments, "cell-heap-segments");
+SCM_SYMBOL (sym_gc_time_taken, "gc-time-taken");
+
+
+struct scm_heap_seg_data
+{
+  SCM_CELLPTR bounds[2];	/* lower and upper */
+  SCM *freelistp;		/* the value of this may be shared */
+  int ncells;			/* per object in this segment */
+  int (*valid) ();
+};
+
+
+
+
+
+static void alloc_some_heap ();
+static void scm_mark_weak_vector_spines ();
+
+
+
+
+/* {Scheme Interface to GC}
+ */
+
+SCM_PROC (s_gc_stats, "gc-stats", 0, 0, 0, scm_gc_stats);
+#ifdef __STDC__
+SCM
+scm_gc_stats (void)
+#else
+SCM
+scm_gc_stats ()
+#endif
+{
+  int i;
+  int n;
+  SCM heap_segs;
+  SCM local_scm_mtrigger;
+  SCM local_scm_mallocated;
+  SCM local_scm_heap_size;
+  SCM local_scm_cells_allocated;
+  SCM local_scm_gc_time_taken;
+  SCM answer;
+
+  SCM_DEFER_INTS;
+  scm_block_gc = 1;
+ retry:
+  heap_segs = SCM_EOL;
+  n = scm_n_heap_segs;
+  for (i = scm_n_heap_segs; i--; )
+    heap_segs = scm_cons (scm_cons (scm_ulong2num ((unsigned long)scm_heap_table[i].bounds[1]),
+				    scm_ulong2num ((unsigned long)scm_heap_table[i].bounds[0])),
+			  heap_segs);
+  if (scm_n_heap_segs != n)
+    goto retry;
+  scm_block_gc = 0;
+
+  local_scm_mtrigger = scm_mtrigger;
+  local_scm_mallocated = scm_mallocated;
+  local_scm_heap_size = scm_heap_size;
+  local_scm_cells_allocated = scm_cells_allocated;
+  local_scm_gc_time_taken = scm_gc_time_taken;
+
+  answer = scm_listify (scm_cons (sym_gc_time_taken, scm_ulong2num (local_scm_gc_time_taken)),
+			scm_cons (sym_cells_allocated, scm_ulong2num (local_scm_cells_allocated)),
+			scm_cons (sym_heap_size, scm_ulong2num (local_scm_heap_size)),
+			scm_cons (sym_mallocated, scm_ulong2num (local_scm_mallocated)),
+			scm_cons (sym_mtrigger, scm_ulong2num (local_scm_mtrigger)),
+			scm_cons (sym_heap_segments, heap_segs),
+			SCM_UNDEFINED);
+  SCM_ALLOW_INTS;
+  return answer;
+}
+
+
+#ifdef __STDC__
+void 
+scm_gc_start (char *what)
+#else
+void 
+scm_gc_start (what)
+     char *what;
+#endif
+{
+  scm_gc_rt = SCM_INUM (scm_get_internal_run_time ());
+  scm_gc_cells_collected = 0;
+  scm_gc_malloc_collected = 0;
+  scm_gc_ports_collected = 0;
+}
+
+#ifdef __STDC__
+void 
+scm_gc_end (void)
+#else
+void 
+scm_gc_end ()
+#endif
+{
+  scm_gc_rt = SCM_INUM (scm_get_internal_run_time ()) - scm_gc_rt;
+  scm_gc_time_taken = scm_gc_time_taken + scm_gc_rt;
+  scm_take_signal (SCM_GC_SIGNAL);
+}
+
+
+SCM_PROC(s_object_address, "object-address", 1, 0, 0, scm_object_addr);
+SCM
+scm_object_addr (obj)
+     SCM obj;
+{
+  return scm_ulong2num ((unsigned long)obj);
+}
+
+
+SCM_PROC(s_gc, "gc", 0, 0, 0, scm_gc);
+#ifdef __STDC__
+SCM 
+scm_gc (void)
+#else
+SCM 
+scm_gc ()
+#endif
+{
+  SCM_DEFER_INTS;
+  scm_igc ("call");
+  SCM_ALLOW_INTS;
+  return SCM_UNSPECIFIED;
+}
+
+
+
+/* {C Interface For When GC is Triggered}
+ */
+
+#ifdef __STDC__
+void
+scm_gc_for_alloc (int ncells, SCM * freelistp)
+#else
+void
+scm_gc_for_alloc (ncells, freelistp)
+     int ncells;
+     SCM * freelistp;
+#endif
+{
+  SCM_REDEFER_INTS;
+  scm_igc ("cells");
+  if ((scm_gc_cells_collected < MIN_GC_YIELD) || SCM_IMP (*freelistp))
+    {
+      alloc_some_heap (ncells, freelistp);
+    }
+  SCM_REALLOW_INTS;
+}
+
+
+#ifdef __STDC__
+SCM 
+scm_gc_for_newcell (void)
+#else
+SCM 
+scm_gc_for_newcell ()
+#endif
+{
+  SCM fl;
+  scm_gc_for_alloc (1, &scm_freelist);
+  fl = scm_freelist;
+  scm_freelist = SCM_CDR (fl);
+  return fl;
+}
+
+#ifdef __STDC__
+void
+scm_igc (char *what)
+#else
+void
+scm_igc (what)
+     char *what;
+#endif
+{
+  int j;
+
+  scm_gc_start (what);
+  if (!scm_stack_base || scm_block_gc)
+    {
+      scm_gc_end ();
+      return;
+    }
+
+  ++scm_gc_heap_lock;
+  scm_n_weak = 0;
+
+  /* unprotect any struct types with no instances */
+#if 0
+  {
+    SCM type_list;
+    SCM * pos;
+
+    pos = &scm_type_obj_list;
+    type_list = scm_type_obj_list;
+    while (type_list != SCM_EOL)
+      if (SCM_VELTS (SCM_CAR (type_list))[scm_struct_i_refcnt])
+	{
+	  pos = &SCM_CDR (type_list);
+	  type_list = SCM_CDR (type_list);
+	}
+      else
+	{
+	  *pos = SCM_CDR (type_list);
+	  type_list = SCM_CDR (type_list);
+	}
+  }
+#endif
+
+  /* flush dead entries from the continuation stack */
+  {
+    int x;
+    int bound;
+    SCM * elts;
+    elts = SCM_VELTS (scm_continuation_stack);
+    bound = SCM_LENGTH (scm_continuation_stack);
+    x = SCM_INUM (scm_continuation_stack_ptr);
+    while (x < bound)
+      {
+	elts[x] = SCM_BOOL_F;
+	++x;
+      }
+  }
+
+  /* Protect from the C stack.  This must be the first marking
+   * done because it provides information about what objects
+   * are "in-use" by the C code.   "in-use" objects are  those
+   * for which the values from SCM_LENGTH and SCM_CHARS must remain
+   * usable.   This requirement is stricter than a liveness
+   * requirement -- in particular, it constrains the implementation
+   * of scm_vector_set_length_x.
+   */
+  SCM_FLUSH_REGISTER_WINDOWS;
+  /* This assumes that all registers are saved into the jmp_buf */
+  setjmp (scm_save_regs_gc_mark);
+  scm_mark_locations ((SCM_STACKITEM *) scm_save_regs_gc_mark,
+		      (   (scm_sizet) sizeof scm_save_regs_gc_mark
+		       / sizeof (SCM_STACKITEM)));
+
+  {
+    /* stack_len is long rather than scm_sizet in order to guarantee that
+       &stack_len is long aligned */
+#ifdef SCM_STACK_GROWS_UP
+#ifdef nosve
+    long stack_len = (SCM_STACKITEM *) (&stack_len) - scm_stack_base;
+#else
+    long stack_len = scm_stack_size (scm_stack_base);
+#endif
+    scm_mark_locations (scm_stack_base, (scm_sizet) stack_len);
+#else
+#ifdef nosve
+    long stack_len = scm_stack_base - (SCM_STACKITEM *) (&stack_len);
+#else
+    long stack_len = scm_stack_size (scm_stack_base);
+#endif
+    scm_mark_locations ((scm_stack_base - stack_len), (scm_sizet) stack_len);
+#endif
+  }
+
+
+  /* FIXME: insert a phase to un-protect string-data preserved
+   * in scm_vector_set_length_x.
+   */
+
+  j = SCM_NUM_PROTECTS;
+  while (j--)
+    scm_gc_mark (scm_sys_protects[j]);
+
+  scm_gc_mark (scm_rootcont);
+  scm_gc_mark (scm_dynwinds);
+  scm_gc_mark (scm_continuation_stack);
+  scm_gc_mark (scm_continuation_stack_ptr);
+  scm_gc_mark (scm_progargs);
+  scm_gc_mark (scm_exitval);
+  scm_gc_mark (scm_cur_inp);
+  scm_gc_mark (scm_cur_outp);
+  scm_gc_mark (scm_cur_errp);
+  scm_gc_mark (scm_def_inp);
+  scm_gc_mark (scm_def_outp);
+  scm_gc_mark (scm_def_errp);
+  scm_gc_mark (scm_top_level_lookup_thunk_var);
+  scm_gc_mark (scm_system_transformer);
+  
+  scm_mark_weak_vector_spines ();
+
+  scm_gc_sweep ();
+
+  --scm_gc_heap_lock;
+  scm_gc_end ();
+}
+
+
+/* {Mark/Sweep} 
+ */
+
+
+
+/* Mark an object precisely.
+ */
+#ifdef __STDC__
+void 
+scm_gc_mark (SCM p)
+#else
+void 
+scm_gc_mark (p)
+     SCM p;
+#endif
+{
+  register long i;
+  register SCM ptr;
+
+  ptr = p;
+
+gc_mark_loop:
+  if (SCM_IMP (ptr))
+    return;
+
+gc_mark_nimp:
+  if (SCM_NCELLP (ptr))
+    scm_wta (ptr, "rogue pointer in ", "heap");
+
+  switch (SCM_TYP7 (ptr))
+    {
+    case scm_tcs_cons_nimcar:
+      if (SCM_GCMARKP (ptr))
+	break;
+      SCM_SETGCMARK (ptr);
+      if (SCM_IMP (SCM_CDR (ptr))) /* SCM_IMP works even with a GC mark */
+	{
+	  ptr = SCM_CAR (ptr);
+	  goto gc_mark_nimp;
+	}
+      scm_gc_mark (SCM_CAR (ptr));
+      ptr = SCM_GCCDR (ptr);
+      goto gc_mark_nimp;
+    case scm_tcs_cons_imcar:
+      if (SCM_GCMARKP (ptr))
+	break;
+      SCM_SETGCMARK (ptr);
+      ptr = SCM_GCCDR (ptr);
+      goto gc_mark_loop;
+    case scm_tcs_cons_gloc:
+      if (SCM_GCMARKP (ptr))
+	break;
+      SCM_SETGCMARK (ptr);
+      {
+	SCM vcell;
+	vcell = SCM_CAR (ptr) - 1L;
+	switch (SCM_CDR (vcell))
+	  {
+	  default:
+	    scm_gc_mark (vcell);
+	    ptr = SCM_GCCDR (ptr);
+	    goto gc_mark_loop;
+	  case 1:		/* ! */
+	  case 0:		/* ! */
+	    {
+	      SCM layout;
+	      SCM * vtable_data;
+	      int len;
+	      char * fields_desc;
+	      SCM * mem;
+	      int x;
+
+	      vtable_data = (SCM *)vcell;
+	      layout = vtable_data[scm_struct_i_layout];
+	      len = SCM_LENGTH (layout);
+	      fields_desc = SCM_CHARS (layout);
+	      mem = (SCM *)SCM_GCCDR (ptr); /* like struct_data but removes mark */
+	      
+	      for (x = 0; x < len; x += 2)
+		if (fields_desc[x] == 'p')
+		  scm_gc_mark (mem[x / 2]);
+	      if (!SCM_CDR (vcell))
+		{
+		  SCM_SETGCMARK (vcell);
+		  ptr = vtable_data[scm_struct_i_vtable];
+		  goto gc_mark_loop;
+		}
+	    }
+	  }
+      }
+      break;
+    case scm_tcs_closures:
+      if (SCM_GCMARKP (ptr))
+	break;
+      SCM_SETGCMARK (ptr);
+      if (SCM_IMP (SCM_CDR (ptr)))
+	{
+	  ptr = SCM_CLOSCAR (ptr);
+	  goto gc_mark_nimp;
+	}
+      scm_gc_mark (SCM_CLOSCAR (ptr));
+      ptr = SCM_GCCDR (ptr);
+      goto gc_mark_nimp;
+    case scm_tc7_vector:
+    case scm_tc7_lvector:
+#ifdef CCLO
+    case scm_tc7_cclo:
+#endif
+      if (SCM_GC8MARKP (ptr))
+	break;
+      SCM_SETGC8MARK (ptr);
+      i = SCM_LENGTH (ptr);
+      if (i == 0)
+	break;
+      while (--i > 0)
+	if (SCM_NIMP (SCM_VELTS (ptr)[i]))
+	  scm_gc_mark (SCM_VELTS (ptr)[i]);
+      ptr = SCM_VELTS (ptr)[0];
+      goto gc_mark_loop;
+    case scm_tc7_contin:
+      if SCM_GC8MARKP
+	(ptr) break;
+      SCM_SETGC8MARK (ptr);
+      scm_mark_locations (SCM_VELTS (ptr),
+	       (scm_sizet) (SCM_LENGTH (ptr) + sizeof (regs) / sizeof (SCM_STACKITEM)));
+      break;
+    case scm_tc7_bvect:
+    case scm_tc7_byvect:
+    case scm_tc7_ivect:
+    case scm_tc7_uvect:
+    case scm_tc7_fvect:
+    case scm_tc7_dvect:
+    case scm_tc7_cvect:
+    case scm_tc7_svect:
+#ifdef LONGLONGS
+    case scm_tc7_llvect:
+#endif
+
+    case scm_tc7_string:
+    case scm_tc7_mb_string:
+      SCM_SETGC8MARK (ptr);
+      break;
+
+    case scm_tc7_substring:
+    case scm_tc7_mb_substring:
+      if (SCM_GC8MARKP(ptr))
+	break;
+      SCM_SETGC8MARK (ptr);
+      ptr = SCM_CDR (ptr);
+      goto gc_mark_loop;
+
+    case scm_tc7_wvect:
+      if (SCM_GC8MARKP(ptr))
+	break;
+      scm_weak_vectors[scm_n_weak++] = ptr;
+      if (scm_n_weak >= scm_weak_size)
+	{
+	  SCM_SYSCALL (scm_weak_vectors =
+		       (SCM *) realloc ((char *) scm_weak_vectors,
+					sizeof (SCM *) * (scm_weak_size *= 2)));
+	  if (scm_weak_vectors == NULL)
+	    {
+	      scm_gen_puts (scm_regular_string,
+			    "weak vector table",
+			    scm_cur_errp);
+	      scm_gen_puts (scm_regular_string,
+			    "\nFATAL ERROR DURING CRITICAL SCM_CODE SECTION\n",
+			    scm_cur_errp);
+	      exit(SCM_EXIT_FAILURE);
+	    }
+	}
+      SCM_SETGC8MARK (ptr);
+      if (SCM_IS_WHVEC_ANY (ptr))
+	{
+	  int x;
+	  int len;
+	  int weak_keys;
+	  int weak_values;
+
+	  len = SCM_LENGTH (ptr);
+	  weak_keys = SCM_IS_WHVEC (ptr) || SCM_IS_WHVEC_B (ptr);
+	  weak_values = SCM_IS_WHVEC_V (ptr) || SCM_IS_WHVEC_B (ptr);
+	  
+	  for (x = 0; x < len; ++x)
+	    {
+	      SCM alist;
+	      alist = SCM_VELTS (ptr)[x];
+	      /* mark everything on the alist
+	       * except the keys or values, according to weak_values and weak_keys.
+	       */
+	      while (   SCM_NIMP (alist)
+		     && SCM_CONSP (alist)
+		     && !SCM_GCMARKP (alist)
+		     && SCM_NIMP (SCM_CAR (alist))
+		     && SCM_CONSP (SCM_CAR (alist)))
+		{
+		  SCM kvpair;
+		  SCM next_alist;
+
+		  kvpair = SCM_CAR (alist);
+		  next_alist = SCM_CDR (alist);
+		  /* 
+		   * Do not do this:
+		   * 	SCM_SETGCMARK (alist);
+		   *	SCM_SETGCMARK (kvpair);
+		   *
+		   * It may be that either the key or value is protected by
+		   * an escaped reference to part of the spine of this alist.
+		   * If we mark the spine here, and only mark one or neither of the
+		   * key and value, they may never be properly marked.
+		   * This leads to a horrible situation in which an alist containing
+		   * freelist cells is exported.
+		   *
+		   * So only mark the spines of these arrays last of all marking.
+		   * If somebody confuses us by constructing a weak vector
+		   * with a circular alist then we are hosed, but at least we
+		   * won't prematurely drop table entries.
+		   */
+		  if (!weak_keys)
+		    scm_gc_mark (SCM_CAR (kvpair));
+		  if (!weak_values)
+		    scm_gc_mark (SCM_GCCDR (kvpair));
+		  alist = next_alist;
+		}
+	      if (SCM_NIMP (alist))
+		scm_gc_mark (alist);
+	    }
+	}
+      break;
+
+    case scm_tc7_msymbol:
+      if (SCM_GC8MARKP(ptr))
+	break;
+      SCM_SETGC8MARK (ptr);
+      scm_gc_mark (SCM_SYMBOL_FUNC (ptr));
+      ptr = SCM_SYMBOL_PROPS (ptr);
+      goto gc_mark_loop;
+    case scm_tc7_ssymbol:
+      if (SCM_GC8MARKP(ptr))
+	break;
+      SCM_SETGC8MARK (ptr);
+      break;
+    case scm_tcs_subrs:
+      ptr = (SCM)(scm_heap_org + (((unsigned long)SCM_CAR (ptr)) >> 8));
+      goto gc_mark_loop;
+    case scm_tc7_port:
+      i = SCM_PTOBNUM (ptr);
+      if (!(i < scm_numptob))
+	goto def;
+      if (SCM_GC8MARKP (ptr))
+	break;
+      if (SCM_PTAB_ENTRY(ptr))
+	scm_gc_mark (SCM_PTAB_ENTRY(ptr)->file_name);
+      ptr = (scm_ptobs[i].mark) (ptr);
+      goto gc_mark_loop;
+      break;
+    case scm_tc7_smob:
+      if (SCM_GC8MARKP (ptr))
+	break;
+      switch SCM_TYP16 (ptr)
+	{ /* should be faster than going through scm_smobs */
+	case scm_tc_free_cell:
+	  /* printf("found free_cell %X ", ptr); fflush(stdout); */
+	  SCM_SETGC8MARK (ptr);
+	  SCM_CDR (ptr) = SCM_EOL;
+	  break;
+	case scm_tcs_bignums:
+	case scm_tc16_flo:
+	  SCM_SETGC8MARK (ptr);
+	  break;
+	default:
+	  i = SCM_SMOBNUM (ptr);
+	  if (!(i < scm_numsmob))
+	    goto def;
+	  ptr = (scm_smobs[i].mark) (ptr);
+	  goto gc_mark_loop;
+	}
+      break;
+    default:
+    def:scm_wta (ptr, "unknown type in ", "gc_mark");
+    }
+}
+
+
+/* Mark a Region Conservatively
+ */
+
+#ifdef __STDC__
+void 
+scm_mark_locations (SCM_STACKITEM x[], scm_sizet n)
+#else
+void 
+scm_mark_locations (x, n)
+     SCM_STACKITEM x[];
+     scm_sizet n;
+#endif
+{
+  register long m = n;
+  register int i, j;
+  register SCM_CELLPTR ptr;
+
+  while (0 <= --m)
+    if SCM_CELLP (*(SCM **) & x[m])
+      {
+	ptr = (SCM_CELLPTR) SCM2PTR ((*(SCM **) & x[m]));
+	i = 0;
+	j = scm_n_heap_segs - 1;
+	if (   SCM_PTR_LE (scm_heap_table[i].bounds[0], ptr)
+	    && SCM_PTR_GT (scm_heap_table[j].bounds[1], ptr))
+	  {
+	    while (i <= j)
+	      {
+		int seg_id;
+		seg_id = -1;
+		if (   (i == j)
+		    || SCM_PTR_GT (scm_heap_table[i].bounds[1], ptr))
+		  seg_id = i;
+		else if (SCM_PTR_LE (scm_heap_table[j].bounds[0], ptr))
+		  seg_id = j;
+		else
+		  {
+		    int k;
+		    k = (i + j) / 2;
+		    if (k == i)
+		      break;
+		    if (SCM_PTR_GT (scm_heap_table[k].bounds[1], ptr))
+		      {
+			j = k;
+			++i;
+			if (SCM_PTR_LE (scm_heap_table[i].bounds[0], ptr))
+			  continue;
+			else
+			  break;
+		      }
+		    else if (SCM_PTR_LE (scm_heap_table[k].bounds[0], ptr))
+		      {
+			i = k;
+			--j;
+			if (SCM_PTR_GT (scm_heap_table[j].bounds[1], ptr))
+			  continue;
+			else
+			  break;
+		      }
+		  }
+		if (   !scm_heap_table[seg_id].valid
+		    || scm_heap_table[seg_id].valid (ptr,
+						     &scm_heap_table[seg_id]))
+		  scm_gc_mark (*(SCM *) & x[m]);
+		break;
+	      }
+
+	  }
+      }
+}
+
+
+#ifdef __STDC__
+void
+scm_mark_weak_vector_spines (void)
+#else
+void
+scm_mark_weak_vector_spines ()
+#endif
+{
+  int i;
+
+  for (i = 0; i < scm_n_weak; ++i)
+    {
+      if (SCM_IS_WHVEC_ANY (scm_weak_vectors[i]))
+	{
+	  SCM *ptr;
+	  SCM obj;
+	  int j;
+	  int n;
+
+	  obj = scm_weak_vectors[i];
+	  ptr = SCM_VELTS (scm_weak_vectors[i]);
+	  n = SCM_LENGTH (scm_weak_vectors[i]);
+	  for (j = 0; j < n; ++j)
+	    {
+	      SCM alist;
+
+	      alist = ptr[j];
+	      while (   SCM_NIMP (alist)
+		     && SCM_CONSP (alist)
+		     && !SCM_GCMARKP (alist) 
+		     && SCM_NIMP (SCM_CAR (alist))
+		     && SCM_CONSP  (SCM_CAR (alist)))
+		{
+		  SCM_SETGCMARK (alist);
+		  SCM_SETGCMARK (SCM_CAR (alist));
+		  alist = SCM_GCCDR (alist);
+		}
+	    }
+	}
+    }
+}
+
+
+
+#ifdef __STDC__
+void 
+scm_gc_sweep (void)
+#else
+void 
+scm_gc_sweep ()
+#endif
+{
+  register SCM_CELLPTR ptr;
+#ifdef SCM_POINTERS_MUNGED
+  register SCM scmptr;
+#else
+#undef scmptr
+#define scmptr (SCM)ptr
+#endif
+  register SCM nfreelist;
+  register SCM *hp_freelist;
+  register long n;
+  register long m;
+  register scm_sizet j;
+  register int span;
+  scm_sizet i;
+  scm_sizet seg_size;
+
+  n = 0;
+  m = 0;
+  i = 0;
+
+  while (i < scm_n_heap_segs)
+    {
+      hp_freelist = scm_heap_table[i].freelistp;
+      nfreelist = SCM_EOL;
+      span = scm_heap_table[i].ncells;
+      ptr = CELL_UP (scm_heap_table[i].bounds[0]);
+      seg_size = CELL_DN (scm_heap_table[i].bounds[1]) - ptr;
+      ++i;
+      for (j = seg_size + span; j -= span; ptr += span)
+	{
+#ifdef SCM_POINTERS_MUNGED
+	  scmptr = PTR2SCM (ptr);
+#endif
+	  switch SCM_TYP7 (scmptr)
+	    {
+	    case scm_tcs_cons_gloc:
+	      if (SCM_GCMARKP (scmptr))
+		{
+		  if (SCM_CDR (SCM_CAR (scmptr) - 1) == (SCM)1)
+		    SCM_CDR (SCM_CAR (scmptr) - 1) = (SCM)0;
+		  goto cmrkcontinue;
+		}
+	      {
+		SCM vcell;
+		vcell = SCM_CAR (scmptr) - 1L;
+
+		if ((SCM_CDR (vcell) == 0) || (SCM_CDR (vcell) == 1))
+		  {
+		    SCM * mem;
+		    SCM amt;
+		    mem = (SCM *)SCM_CDR (scmptr);
+		    amt = mem[-2];
+		    free (mem - 2);
+ 		    m += amt * sizeof (SCM);
+		  }
+	      }
+	      break;
+	    case scm_tcs_cons_imcar:
+	    case scm_tcs_cons_nimcar:
+	    case scm_tcs_closures:
+	      if (SCM_GCMARKP (scmptr))
+		goto cmrkcontinue;
+	      break;
+	    case scm_tc7_wvect:
+	      if (SCM_GC8MARKP (scmptr))
+		{
+		  goto c8mrkcontinue;
+		}
+	      else
+		{
+		  m += (1 + SCM_LENGTH (scmptr)) * sizeof (SCM);
+		  scm_must_free ((char *)(SCM_VELTS (scmptr) - 1));
+		  break;
+		}
+
+	    case scm_tc7_vector:
+	    case scm_tc7_lvector:
+#ifdef CCLO
+	    case scm_tc7_cclo:
+#endif
+	      if (SCM_GC8MARKP (scmptr))
+		goto c8mrkcontinue;
+
+	      m += (SCM_LENGTH (scmptr) * sizeof (SCM));
+	    freechars:
+	      scm_must_free (SCM_CHARS (scmptr));
+	      /*	SCM_SETCHARS(scmptr, 0);*/
+	      break;
+	    case scm_tc7_bvect:
+	      if SCM_GC8MARKP (scmptr)
+		goto c8mrkcontinue;
+	      m += sizeof (long) * ((SCM_HUGE_LENGTH (scmptr) + SCM_LONG_BIT - 1) / SCM_LONG_BIT);
+	      goto freechars;
+	    case scm_tc7_byvect:
+	      if SCM_GC8MARKP (scmptr)
+		goto c8mrkcontinue;
+	      m += SCM_HUGE_LENGTH (scmptr) * sizeof (char);
+	      goto freechars;
+	    case scm_tc7_ivect:
+	    case scm_tc7_uvect:
+	      if SCM_GC8MARKP (scmptr)
+		goto c8mrkcontinue;
+	      m += SCM_HUGE_LENGTH (scmptr) * sizeof (long);
+	      goto freechars;
+	    case scm_tc7_svect:
+	      if SCM_GC8MARKP (scmptr)
+		goto c8mrkcontinue;
+	      m += SCM_HUGE_LENGTH (scmptr) * sizeof (short);
+	      goto freechars;
+#ifdef LONGLONGS
+	    case scm_tc7_llvect:
+	      if SCM_GC8MARKP (scmptr)
+		goto c8mrkcontinue;
+	      m += SCM_HUGE_LENGTH (scmptr) * sizeof (long_long);
+	      goto freechars;
+#endif
+	    case scm_tc7_fvect:
+	      if SCM_GC8MARKP (scmptr)
+		goto c8mrkcontinue;
+	      m += SCM_HUGE_LENGTH (scmptr) * sizeof (float);
+	      goto freechars;
+	    case scm_tc7_dvect:
+	      if SCM_GC8MARKP (scmptr)
+		goto c8mrkcontinue;
+	      m += SCM_HUGE_LENGTH (scmptr) * sizeof (double);
+	      goto freechars;
+	    case scm_tc7_cvect:
+	      if SCM_GC8MARKP (scmptr)
+		goto c8mrkcontinue;
+	      m += SCM_HUGE_LENGTH (scmptr) * 2 * sizeof (double);
+	      goto freechars;
+	    case scm_tc7_substring:
+	    case scm_tc7_mb_substring:
+	      if (SCM_GC8MARKP (scmptr))
+		goto c8mrkcontinue;
+	      break;
+	    case scm_tc7_string:
+	    case scm_tc7_mb_string:
+	      if (SCM_GC8MARKP (scmptr))
+		goto c8mrkcontinue;
+	      m += SCM_HUGE_LENGTH (scmptr) + 1;
+	      goto freechars;
+	    case scm_tc7_msymbol:
+	      if (SCM_GC8MARKP (scmptr))
+		goto c8mrkcontinue;
+	      m += (  SCM_LENGTH (scmptr)
+		    + 1
+		    + sizeof (SCM) * ((SCM *)SCM_CHARS (scmptr) - SCM_SLOTS(scmptr)));
+	      scm_must_free ((char *)SCM_SLOTS (scmptr));
+	      break;
+	    case scm_tc7_contin:
+	      if SCM_GC8MARKP (scmptr)
+		goto c8mrkcontinue;
+	      m += SCM_LENGTH (scmptr) * sizeof (SCM_STACKITEM) + sizeof (regs);
+	      goto freechars;
+	    case scm_tc7_ssymbol:
+	      if SCM_GC8MARKP(scmptr)
+		goto c8mrkcontinue;
+	      break;
+	    case scm_tcs_subrs:
+	      continue;
+	    case scm_tc7_port:
+	      if SCM_GC8MARKP (scmptr)
+		goto c8mrkcontinue;
+	      if SCM_OPENP (scmptr)
+		{
+		  int k = SCM_PTOBNUM (scmptr);
+		  if (!(k < scm_numptob))
+		    goto sweeperr;
+		  /* Keep "revealed" ports alive.  */
+		  if (scm_revealed_count(scmptr) > 0)
+		    continue;
+		  /* Yes, I really do mean scm_ptobs[k].free */
+		  /* rather than ftobs[k].close.  .close */
+		  /* is for explicit CLOSE-PORT by user */
+		  (scm_ptobs[k].free) (SCM_STREAM (scmptr));
+		  SCM_SETSTREAM (scmptr, 0);
+		  scm_remove_from_port_table (scmptr);
+		  scm_gc_ports_collected++;
+		  SCM_CAR (scmptr) &= ~SCM_OPN;
+		}
+	      break;
+	    case scm_tc7_smob:
+	      switch SCM_GCTYP16 (scmptr)
+		{
+		case scm_tc_free_cell:
+		  if SCM_GC8MARKP (scmptr)
+		    goto c8mrkcontinue;
+		  break;
+#ifdef SCM_BIGDIG
+		case scm_tcs_bignums:
+		  if SCM_GC8MARKP (scmptr)
+		    goto c8mrkcontinue;
+		  m += (SCM_NUMDIGS (scmptr) * SCM_BITSPERDIG / SCM_CHAR_BIT);
+		  goto freechars;
+#endif /* def SCM_BIGDIG */
+		case scm_tc16_flo:
+		  if SCM_GC8MARKP (scmptr)
+		    goto c8mrkcontinue;
+		  switch ((int) (SCM_CAR (scmptr) >> 16))
+		    {
+		    case (SCM_IMAG_PART | SCM_REAL_PART) >> 16:
+		      m += sizeof (double);
+		    case SCM_REAL_PART >> 16:
+		    case SCM_IMAG_PART >> 16:
+		      m += sizeof (double);
+		      goto freechars;
+		    case 0:
+		      break;
+		    default:
+		      goto sweeperr;
+		    }
+		  break;
+		default:
+		  if SCM_GC8MARKP (scmptr)
+		    goto c8mrkcontinue;
+
+		  {
+		    int k;
+		    k = SCM_SMOBNUM (scmptr);
+		    if (!(k < scm_numsmob))
+		      goto sweeperr;
+		    m += (scm_smobs[k].free) ((SCM) scmptr);
+		    break;
+		  }
+		}
+	      break;
+	    default:
+	    sweeperr:scm_wta (scmptr, "unknown type in ", "gc_sweep");
+	    }
+	  n += span;
+#if 0
+	  if (SCM_CAR (scmptr) == (SCM) scm_tc_free_cell)
+	    exit (2);
+#endif
+	  SCM_CAR (scmptr) = (SCM) scm_tc_free_cell;
+	  SCM_CDR (scmptr) = nfreelist;
+	  nfreelist = scmptr;
+#if 0
+	  if ((nfreelist < scm_heap_table[0].bounds[0]) ||
+	      (nfreelist >= scm_heap_table[0].bounds[1]))
+	    exit (1);
+#endif
+	  continue;
+	c8mrkcontinue:
+	  SCM_CLRGC8MARK (scmptr);
+	  continue;
+	cmrkcontinue:
+	  SCM_CLRGCMARK (scmptr);
+	}
+#ifdef GC_FREE_SEGMENTS
+      if (n == seg_size)
+	{
+	  scm_heap_size -= seg_size;
+	  free ((char *) scm_heap_table[i - 1].bounds[0]);
+	  scm_heap_table[i - 1].bounds[0] = 0;
+	  for (j = i; j < scm_n_heap_segs; j++)
+	    scm_heap_table[j - 1] = scm_heap_table[j];
+	  scm_n_heap_segs -= 1;
+	  i -= 1;		/* need to scan segment just moved. */
+	}
+      else
+#endif /* ifdef GC_FREE_SEGMENTS */
+	*hp_freelist = nfreelist;
+
+      scm_gc_cells_collected += n;
+      n = 0;
+    }
+  /* Scan weak vectors. */
+  {
+    SCM *ptr;
+    for (i = 0; i < scm_n_weak; ++i)
+      {
+	if (!SCM_IS_WHVEC_ANY (scm_weak_vectors[i]))
+	  {
+	    ptr = SCM_VELTS (scm_weak_vectors[i]);
+	    n = SCM_LENGTH (scm_weak_vectors[i]);
+	    for (j = 0; j < n; ++j)
+	      if (SCM_NIMP (ptr[j]) && SCM_FREEP (ptr[j]))
+		ptr[j] = SCM_BOOL_F;
+	  }
+	else /* if (SCM_IS_WHVEC_ANY (scm_weak_vectors[i])) */
+	  {
+	    SCM obj;
+	    obj = scm_weak_vectors[i];
+	    ptr = SCM_VELTS (scm_weak_vectors[i]);
+	    n = SCM_LENGTH (scm_weak_vectors[i]);
+	    for (j = 0; j < n; ++j)
+	      {
+		SCM * fixup;
+		SCM alist;
+		int weak_keys;
+		int weak_values;
+		
+		weak_keys = SCM_IS_WHVEC (obj) || SCM_IS_WHVEC_B (obj);
+		weak_values = SCM_IS_WHVEC_V (obj) || SCM_IS_WHVEC_B (obj);
+
+		fixup = ptr + j;
+		alist = *fixup;
+
+		while (SCM_NIMP (alist)
+		       && SCM_CONSP (alist)
+		       && SCM_NIMP (SCM_CAR (alist))
+		       && SCM_CONSP (SCM_CAR (alist)))
+		  {
+		    SCM key;
+		    SCM value;
+
+		    key = SCM_CAAR (alist);
+		    value = SCM_CDAR (alist);
+		    if (   (weak_keys && SCM_NIMP (key) && SCM_FREEP (key))
+			|| (weak_values && SCM_NIMP (value) && SCM_FREEP (value)))
+		      {
+			*fixup = SCM_CDR (alist);
+		      }
+		    else
+		      fixup = &SCM_CDR (alist);
+		    alist = SCM_CDR (alist);
+		  }
+	      }
+	  }
+      }
+  }
+  scm_cells_allocated = (scm_heap_size - scm_gc_cells_collected);
+  scm_mallocated -= m;
+  scm_gc_malloc_collected = m;
+}
+
+
+
+
+/* {Front end to malloc}
+ *
+ * scm_must_malloc, scm_must_realloc, scm_must_free
+ *
+ * These functions provide services comperable to malloc, realloc, and
+ * free.  They are for allocating malloced parts of scheme objects.
+ * The primary purpose of the front end is to impose calls to gc.
+ */
+
+/* scm_must_malloc
+ * Return newly malloced storage or throw an error.
+ *
+ * The parameter WHAT is a string for error reporting.
+ * If the threshold scm_mtrigger will be passed by this 
+ * allocation, or if the first call to malloc fails,
+ * garbage collect -- on the presumption that some objects
+ * using malloced storage may be collected.
+ *
+ * The limit scm_mtrigger may be raised by this allocation.
+ */
+#ifdef __STDC__
+char *
+scm_must_malloc (long len, char *what)
+#else
+char *
+scm_must_malloc (len, what)
+     long len;
+     char *what;
+#endif
+{
+  char *ptr;
+  scm_sizet size = len;
+  long nm = scm_mallocated + size;
+  if (len != size)
+  malerr:
+    scm_wta (SCM_MAKINUM (len), (char *) SCM_NALLOC, what);
+  if ((nm <= scm_mtrigger))
+    {
+      SCM_SYSCALL (ptr = (char *) malloc (size));
+      if (NULL != ptr)
+	{
+	  scm_mallocated = nm;
+	  return ptr;
+	}
+    }
+  scm_igc (what);
+  nm = scm_mallocated + size;
+  SCM_SYSCALL (ptr = (char *) malloc (size));
+  if (NULL != ptr)
+    {
+      scm_mallocated = nm;
+      if (nm > scm_mtrigger)
+	scm_mtrigger = nm + nm / 2;
+      return ptr;
+    }
+  goto malerr;
+}
+
+
+/* scm_must_realloc
+ * is similar to scm_must_malloc.
+ */
+#ifdef __STDC__
+char *
+scm_must_realloc (char *where, long olen, long len, char *what)
+#else
+char *
+scm_must_realloc (where, olen, len, what)
+     char *where;
+     long olen;
+     long len;
+     char *what;
+#endif
+{
+  char *ptr;
+  scm_sizet size = len;
+  long nm = scm_mallocated + size - olen;
+  if (len != size)
+  ralerr:
+    scm_wta (SCM_MAKINUM (len), (char *) SCM_NALLOC, what);
+  if ((nm <= scm_mtrigger))
+    {
+      SCM_SYSCALL (ptr = (char *) realloc (where, size));
+      if (NULL != ptr)
+	{
+	  scm_mallocated = nm;
+	  return ptr;
+	}
+    }
+  scm_igc (what);
+  nm = scm_mallocated + size - olen;
+  SCM_SYSCALL (ptr = (char *) realloc (where, size));
+  if (NULL != ptr)
+    {
+      scm_mallocated = nm;
+      if (nm > scm_mtrigger)
+	scm_mtrigger = nm + nm / 2;
+      return ptr;
+    }
+  goto ralerr;
+}
+
+/* scm_must_free
+ * is for releasing memory from scm_must_realloc and scm_must_malloc.
+ */
+#ifdef __STDC__
+void 
+scm_must_free (char *obj)
+#else
+void 
+scm_must_free (obj)
+     char *obj;
+#endif
+{
+  if (obj)
+    free (obj);
+  else
+    scm_wta (SCM_INUM0, "already free", "");
+}
+
+
+
+
+/* {Heap Segments}
+ *
+ * Each heap segment is an array of objects of a particular size.
+ * Every segment has an associated (possibly shared) freelist.
+ * A table of segment records is kept that records the upper and
+ * lower extents of the segment;  this is used during the conservative
+ * phase of gc to identify probably gc roots (because they point
+ * into valid segments at reasonable offsets).
+ */
+
+/* scm_expmem
+ * is true if the first segment was smaller than INIT_HEAP_SEG.
+ * If scm_expmem is set to one, subsequent segment allocations will
+ * allocate segments of size SCM_EXPHEAP(scm_heap_size).
+ */
+int scm_expmem = 0;
+
+/* scm_heap_org
+ * is the lowest base address of any heap segment.
+ */
+SCM_CELLPTR scm_heap_org;
+
+struct scm_heap_seg_data * scm_heap_table = 0;
+int scm_n_heap_segs = 0;
+
+/* scm_heap_size
+ * is the total number of cells in heap segments.
+ */
+long scm_heap_size = 0;
+
+/* init_heap_seg
+ * initializes a new heap segment and return the number of objects it contains.
+ *
+ * The segment origin, segment size in bytes, and the span of objects
+ * in cells are input parameters.  The freelist is both input and output.
+ *
+ * This function presume that the scm_heap_table has already been expanded
+ * to accomodate a new segment record.
+ */
+
+
+#ifdef __STDC__
+static scm_sizet 
+init_heap_seg (SCM_CELLPTR seg_org, scm_sizet size, int ncells, SCM *freelistp)
+#else
+static scm_sizet 
+init_heap_seg (seg_org, size, ncells, freelistp)
+     SCM_CELLPTR seg_org;
+     scm_sizet size;
+     int ncells;
+     SCM *freelistp;
+#endif
+{
+  register SCM_CELLPTR ptr;
+#ifdef SCM_POINTERS_MUNGED
+  register SCM scmptr;
+#else
+#undef scmptr
+#define scmptr ptr
+#endif
+  SCM_CELLPTR seg_end;
+  scm_sizet new_seg_index;
+  scm_sizet n_new_objects;
+  
+  if (seg_org == NULL)
+    return 0;
+
+  ptr = seg_org;
+
+  /* Compute the ceiling on valid object pointers w/in this segment. 
+   */
+  seg_end = CELL_DN ((char *) ptr + size);
+
+  /* Find the right place and insert the segment record. 
+   *
+   */
+  for (new_seg_index = 0;
+       (   (new_seg_index < scm_n_heap_segs)
+	&& SCM_PTR_LE (scm_heap_table[new_seg_index].bounds[0], seg_org));
+       new_seg_index++)
+    ;
+
+  {
+    int i;
+    for (i = scm_n_heap_segs; i > new_seg_index; --i)
+      scm_heap_table[i] = scm_heap_table[i - 1];
+  }
+  
+  ++scm_n_heap_segs;
+
+  scm_heap_table[new_seg_index].valid = 0;
+  scm_heap_table[new_seg_index].ncells = ncells;
+  scm_heap_table[new_seg_index].freelistp = freelistp;
+  scm_heap_table[new_seg_index].bounds[0] = (SCM_CELLPTR)ptr;
+  scm_heap_table[new_seg_index].bounds[1] = (SCM_CELLPTR)seg_end;
+
+
+  /* Compute the least valid object pointer w/in this segment 
+   */
+  ptr = CELL_UP (ptr);
+
+
+  n_new_objects = seg_end - ptr;
+
+  /* Prepend objects in this segment to the freelist. 
+   */
+  while (ptr < seg_end)
+    {
+#ifdef SCM_POINTERS_MUNGED
+      scmptr = PTR2SCM (ptr);
+#endif
+      SCM_CAR (scmptr) = (SCM) scm_tc_free_cell;
+      SCM_CDR (scmptr) = PTR2SCM (ptr + ncells);
+      ptr += ncells;
+    }
+
+  ptr -= ncells;
+
+  /* Patch up the last freelist pointer in the segment
+   * to join it to the input freelist.
+   */
+  SCM_CDR (PTR2SCM (ptr)) = *freelistp;
+  *freelistp = PTR2SCM (CELL_UP (seg_org));
+
+  scm_heap_size += (ncells * n_new_objects);
+  return size;
+#ifdef scmptr
+#undef scmptr
+#endif
+}
+
+
+#ifdef __STDC__
+static void 
+alloc_some_heap (int ncells, SCM * freelistp)
+#else
+static void 
+alloc_some_heap (ncells, freelistp)
+     int ncells;
+     SCM * freelistp;
+#endif
+{
+  struct scm_heap_seg_data * tmptable;
+  SCM_CELLPTR ptr;
+  scm_sizet len;
+
+  /* Critical code sections (such as the garbage collector)
+   * aren't supposed to add heap segments.
+   */
+  if (scm_gc_heap_lock)
+    scm_wta (SCM_UNDEFINED, "need larger initial", "heap");
+
+  /* Expand the heap tables to have room for the new segment.
+   * Do not yet increment scm_n_heap_segs -- that is done by init_heap_seg
+   * only if the allocation of the segment itself succeeds.
+   */
+  len = (1 + scm_n_heap_segs) * sizeof (struct scm_heap_seg_data);
+
+  SCM_SYSCALL (tmptable = ((struct scm_heap_seg_data *)
+		       realloc ((char *)scm_heap_table, len)));
+  if (!tmptable)
+    scm_wta (SCM_UNDEFINED, "could not grow", "hplims");
+  else
+    scm_heap_table = tmptable;
+
+
+  /* Pick a size for the new heap segment.
+   * The rule for picking the size of a segment is explained in 
+   * gc.h
+   */
+  if (scm_expmem)
+    {
+      len = (scm_sizet) (SCM_EXPHEAP (scm_heap_size) * sizeof (scm_cell));
+      if ((scm_sizet) (SCM_EXPHEAP (scm_heap_size) * sizeof (scm_cell)) != len)
+	len = 0;
+    }
+  else
+    len = SCM_HEAP_SEG_SIZE;
+
+  {
+    scm_sizet smallest;
+
+    smallest = (ncells * sizeof (scm_cell));
+    if (len < smallest)
+      len = (ncells * sizeof (scm_cell));
+
+    /* Allocate with decaying ambition. */
+    while ((len >= SCM_MIN_HEAP_SEG_SIZE)
+	   && (len >= smallest))
+      {
+	SCM_SYSCALL (ptr = (SCM_CELLPTR) malloc (len));
+	if (ptr)
+	  {
+	    init_heap_seg (ptr, len, ncells, freelistp);
+	    return;
+	  }
+	len /= 2;
+      }
+  }
+
+  scm_wta (SCM_UNDEFINED, "could not grow", "heap");
+}
+
+
+
+SCM_PROC (s_unhash_name, "unhash-name", 1, 0, 0, scm_unhash_name);
+#ifdef __STDC__
+SCM
+scm_unhash_name (SCM name)
+#else
+SCM
+scm_unhash_name (name)
+     SCM name;
+#endif
+{
+  int x;
+  int bound;
+  SCM_ASSERT (SCM_NIMP (name) && SCM_SYMBOLP (name), name, SCM_ARG1, s_unhash_name);
+  SCM_DEFER_INTS;
+  bound = scm_n_heap_segs;
+  for (x = 0; x < bound; ++x)
+    {
+      SCM_CELLPTR p;
+      SCM_CELLPTR pbound;
+      p  = (SCM_CELLPTR)scm_heap_table[x].bounds[0];
+      pbound = (SCM_CELLPTR)scm_heap_table[x].bounds[1];
+      while (p < pbound)
+	{
+	  SCM incar;
+	  incar = p->car;
+	  if (1 == (7 & (int)incar))
+	    {
+	      --incar;
+	      if (   ((name == SCM_BOOL_T) || (SCM_CAR (incar) == name))
+		  && (SCM_CDR (incar) != 0)
+		  && (SCM_CDR (incar) != 1))
+		{
+		  p->car = name;
+		}
+	    }
+	  ++p;
+	}
+    }
+  SCM_ALLOW_INTS;
+  return name;
+}
+
+
+
+/* {GC Protection Helper Functions}
+ */
+
+
+#ifdef __STDC__
+void
+scm_remember (SCM * ptr)
+#else
+void
+scm_remember (ptr)
+     SCM * ptr;
+#endif
+{}
+
+#ifdef __STDC__
+SCM
+scm_return_first (SCM elt, ...)
+#else
+SCM
+scm_return_first (elt, va_alist)
+     SCM elt;
+     va_dcl
+#endif
+{
+  return elt;
+}
+
+
+#ifdef __STDC__
+SCM
+scm_permanent_object (SCM obj)
+#else
+SCM
+scm_permanent_object (obj)
+     SCM obj;
+#endif
+{
+  SCM_REDEFER_INTS;
+  scm_permobjs = scm_cons (obj, scm_permobjs);
+  SCM_REALLOW_INTS;
+  return obj;
+}
+
+
+
+#ifdef __STDC__
+int
+scm_init_storage (long init_heap_size)
+#else
+int
+scm_init_storage (init_heap_size)
+     long init_heap_size;
+#endif
+{
+  scm_sizet j;
+
+  j = SCM_NUM_PROTECTS;
+  while (j)
+    scm_sys_protects[--j] = SCM_BOOL_F;
+  scm_block_gc = 1;
+  scm_freelist = SCM_EOL;
+  scm_expmem = 0;
+
+  j = SCM_HEAP_SEG_SIZE;
+  scm_mtrigger = SCM_INIT_MALLOC_LIMIT;
+  scm_heap_table = ((struct scm_heap_seg_data *)
+		    scm_must_malloc (sizeof (struct scm_heap_seg_data), "hplims"));
+  if (0L == init_heap_size)
+    init_heap_size = SCM_INIT_HEAP_SIZE;
+  j = init_heap_size;
+  if ((init_heap_size != j)
+      || !init_heap_seg ((SCM_CELLPTR) malloc (j), j, 1, &scm_freelist))
+    {
+      j = SCM_HEAP_SEG_SIZE;
+      if (!init_heap_seg ((SCM_CELLPTR) malloc (j), j, 1, &scm_freelist))
+	return 1;
+    }
+  else
+    scm_expmem = 1;
+  scm_heap_org = CELL_UP (scm_heap_table[0].bounds[0]);
+  /* scm_hplims[0] can change. do not remove scm_heap_org */
+  if (!(scm_weak_vectors = (SCM *) malloc ((scm_weak_size = 32) * sizeof(SCM *))))
+    return 1;
+
+  /* Initialise the list of ports.  */
+  scm_port_table = (struct scm_port_table **) malloc ((long) (sizeof (struct scm_port_table)
+							      * scm_port_table_room));
+  if (!scm_port_table)
+    return 1;
+
+
+  scm_undefineds = scm_cons (SCM_UNDEFINED, SCM_EOL);
+  SCM_CDR (scm_undefineds) = scm_undefineds;
+
+  scm_listofnull = scm_cons (SCM_EOL, SCM_EOL);
+  scm_nullstr = scm_makstr (0L, 0);
+  scm_nullvect = scm_make_vector (SCM_INUM0, SCM_UNDEFINED, SCM_UNDEFINED);
+  scm_symhash = scm_make_vector ((SCM) SCM_MAKINUM (scm_symhash_dim), SCM_EOL, SCM_UNDEFINED);
+  scm_weak_symhash = scm_make_weak_hash_table ((SCM) SCM_MAKINUM (scm_symhash_dim));
+  scm_symhash_vars = scm_make_vector ((SCM) SCM_MAKINUM (scm_symhash_dim), SCM_EOL, SCM_UNDEFINED);
+  scm_permobjs = SCM_EOL;
+  scm_sysintern ("most-positive-fixnum", (SCM) SCM_MAKINUM (SCM_MOST_POSITIVE_FIXNUM));
+  scm_sysintern ("most-negative-fixnum", (SCM) SCM_MAKINUM (SCM_MOST_NEGATIVE_FIXNUM));
+#ifdef SCM_BIGDIG
+  scm_sysintern ("bignum-radix", SCM_MAKINUM (SCM_BIGRAD));
+#endif
+  return 0;
+}
+
+
+#ifdef __STDC__
+void
+scm_init_gc (void)
+#else
+void
+scm_init_gc ()
+#endif
+{
+#include "gc.x"
+}
+
diff --git a/libguile/gc.h b/libguile/gc.h
new file mode 100644
index 000000000..8760811a9
--- /dev/null
+++ b/libguile/gc.h
@@ -0,0 +1,118 @@
+/* classes: h_files */
+
+#ifndef GCH
+#define GCH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+
+
+#define SCM_FREEP(x) (SCM_CAR(x)==scm_tc_free_cell)
+#define SCM_NFREEP(x) (!SCM_FREEP(x))
+
+extern struct scm_heap_seg_data *scm_heap_table;
+extern int scm_n_heap_segs;
+extern int scm_take_stdin;
+extern int scm_block_gc;
+extern int scm_gc_heap_lock;
+
+
+
+extern long scm_heap_size;
+extern SCM_CELLPTR scm_heap_org;
+extern SCM scm_freelist;
+extern unsigned long scm_gc_cells_collected;
+extern unsigned long scm_gc_malloc_collected;
+extern unsigned long scm_gc_ports_collected;
+extern unsigned long scm_cells_allocated;
+extern unsigned long scm_mallocated;
+extern long scm_mtrigger;
+
+
+#ifdef __STDC__
+extern SCM scm_gc_stats (void);
+extern void scm_gc_start (char *what);
+extern void scm_gc_end (void);
+extern SCM scm_gc (void);
+extern void scm_gc_for_alloc (int ncells, SCM * freelistp);
+extern SCM scm_gc_for_newcell (void);
+extern void scm_igc (char *what);
+extern void scm_gc_mark (SCM p);
+extern void scm_mark_locations (SCM_STACKITEM x[], scm_sizet n);
+extern void scm_gc_sweep (void);
+extern char * scm_must_malloc (long len, char *what);
+extern char * scm_must_realloc (char *where, long olen, long len, char *what);
+extern void scm_must_free (char *obj);
+extern void scm_remember (SCM * ptr);
+extern SCM scm_return_first (SCM elt, ...);
+extern SCM scm_permanent_object (SCM obj);
+extern SCM scm_protect_object (SCM obj);
+extern SCM scm_unprotect_object (SCM obj);
+extern int scm_init_storage (long init_heap_size);
+extern void scm_init_gc (void);
+
+#else /* STDC */
+extern SCM scm_gc_stats ();
+extern void scm_gc_start ();
+extern void scm_gc_end ();
+extern SCM scm_gc ();
+extern void scm_gc_for_alloc ();
+extern SCM scm_gc_for_newcell ();
+extern void scm_igc ();
+extern void scm_gc_mark ();
+extern void scm_mark_locations ();
+extern void scm_gc_sweep ();
+extern char * scm_must_malloc ();
+extern char * scm_must_realloc ();
+extern void scm_must_free ();
+extern void scm_remember ();
+extern SCM scm_return_first ();
+extern SCM scm_permanent_object ();
+extern SCM scm_protect_object ();
+extern SCM scm_unprotect_object ();
+extern int scm_init_storage ();
+extern void scm_init_gc ();
+
+#endif /* STDC */
+#include "marksweep.h"
+#endif  /* GCH */
diff --git a/libguile/genio.c b/libguile/genio.c
new file mode 100644
index 000000000..6bc082536
--- /dev/null
+++ b/libguile/genio.c
@@ -0,0 +1,533 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+#include "extchrs.h"
+#include <stdio.h>
+#include "_scm.h"
+
+
+
+
+#ifdef __STDC__
+static void 
+scm_putc (int c, SCM port)
+#else
+static void 
+scm_putc (c, port)
+     int c;
+     SCM port;
+#endif
+{
+  scm_sizet i = SCM_PTOBNUM (port);
+  SCM_SYSCALL ((scm_ptobs[i].fputc) (c, SCM_STREAM (port)));
+}
+
+
+#ifdef __STDC__
+static void 
+scm_puts (char *s, SCM port)
+#else
+static void 
+scm_puts (s, port)
+     char *s;
+     SCM port;
+#endif
+{
+  scm_sizet i = SCM_PTOBNUM (port);
+  SCM_SYSCALL ((scm_ptobs[i].fputs) (s, SCM_STREAM (port)));
+#ifdef TRANSCRIPT_SUPPORT
+  if (scm_trans && (port == def_outp || port == cur_errp))
+    SCM_SYSCALL (fputs (s, scm_trans));
+#endif
+}
+
+
+#ifdef __STDC__
+static int 
+scm_lfwrite (char *ptr, scm_sizet size, scm_sizet nitems, SCM port)
+#else
+static int 
+scm_lfwrite (ptr, size, nitems, port)
+     char *ptr;
+     scm_sizet size;
+     scm_sizet nitems;
+     SCM port;
+#endif
+{
+  int ret;
+  scm_sizet i = SCM_PTOBNUM (port);
+  SCM_SYSCALL (ret = (scm_ptobs[i].fwrite(ptr, size, nitems, SCM_STREAM (port))));
+#ifdef TRANSCRIPT_SUPPORT
+  if (scm_trans && (port == def_outp || port == cur_errp))
+    SCM_SYSCALL (fwrite (ptr, size, nitems, scm_trans));
+#endif
+  return ret;
+}
+
+
+
+
+#ifdef __STDC__
+void
+scm_gen_putc (int c, SCM port)
+#else
+void
+scm_gen_putc (c, port)
+     int c;
+     SCM port;
+#endif
+{
+  switch (SCM_PORT_REPRESENTATION (port))
+    {
+    case scm_regular_port:
+      {
+	/* Nothing good to do with extended chars here...
+	 * just truncate them.
+	 */
+	scm_putc ((unsigned char)c, port);
+	break;
+      }
+
+    case scm_mb_port:
+      {
+	char buf[256];
+	int len;
+
+	SCM_ASSERT (XMB_CUR_MAX < sizeof (buf), SCM_MAKICHR (c),
+		"huge translation", "scm_gen_putc");
+
+	len = xwctomb (buf, c);
+	
+	SCM_ASSERT ((len >= 0), SCM_MAKICHR (c), "bogus character", "scm_gen_putc");
+
+	if (len == 0)
+	  scm_putc (0, port);
+	else
+	  {
+	    int x;
+	    for (x = 0; x < len; ++x)
+	      scm_putc (buf[x], port);
+	  }
+	break;
+      }
+
+    case scm_wchar_port:
+      {
+	scm_putc (((unsigned char)(c >> 8) & 0xff), port);
+	scm_putc ((unsigned char)(c & 0xff), port);
+	break;
+      }
+    }
+}
+
+
+
+
+
+#ifdef __STDC__
+void
+scm_gen_puts (enum scm_string_representation_type rep,
+	      char *str_data,
+	      SCM port)
+#else
+void
+scm_gen_puts (rep, str_data, port)
+     enum scm_string_representation_type rep;
+     unsigned char *str_data;
+     SCM port;
+#endif
+{
+  switch (rep)
+    {
+
+    case scm_regular_string:
+      switch (SCM_PORT_REPRESENTATION (port))
+	{
+	case scm_regular_port:
+	case scm_mb_port:
+	  scm_puts (str_data, port);
+	  return;
+	case scm_wchar_port:
+	  {
+	    while (*str_data)
+	      {
+		scm_putc (0, port);
+		scm_putc (*str_data, port);
+		++str_data;
+	      }
+	    return;
+	  }
+	}
+
+    case scm_mb_string:
+      switch (SCM_PORT_REPRESENTATION (port))
+	{
+	case scm_regular_port:
+	case scm_mb_port:
+	  scm_puts (str_data, port);
+	  return;
+	case scm_wchar_port:
+	  {
+	    xwchar_t output;
+	    int len;
+	    int size;
+
+	    size = strlen (str_data);
+	    while (size)
+	      {
+		len = xmbtowc (&output, str_data, size);
+		SCM_ASSERT ((len > 0), SCM_MAKINUM (*str_data), "bogus character", "scm_gen_puts");
+		scm_putc ((output >> 8) & 0xff, port);
+		scm_putc (output & 0xff, port);
+		size -= len;
+		str_data += len;
+	      }
+	    return;
+	  }
+	}
+
+    case scm_wchar_string:
+      {
+	xwchar_t * wstr_data;
+
+	wstr_data = (xwchar_t *)wstr_data;
+	switch (SCM_PORT_REPRESENTATION (port))
+	  {
+	  case scm_regular_port:
+	    while (*wstr_data)
+	      {
+		scm_putc ((unsigned char) *wstr_data, port);
+		++wstr_data;
+	      }
+	    return;
+
+	  case scm_mb_port:
+	    {
+	      char buf[256];
+	      SCM_ASSERT (XMB_CUR_MAX < sizeof (buf), SCM_BOOL_F,
+		      "huge translation", "scm_gen_puts");
+
+	      while (*wstr_data)
+		{
+		  int len;
+
+		  len = xwctomb (buf, *wstr_data);
+		  
+		  SCM_ASSERT ((len > 0), SCM_MAKINUM (*wstr_data), "bogus character", "scm_gen_puts");
+		  
+		  {
+		    int x;
+		    for (x = 0; x < len; ++x)
+		      scm_putc (buf[x], port);
+		  }
+		  ++wstr_data;
+		}
+	      return;
+	    }
+	    
+	  case scm_wchar_port:
+	    {
+	      int len;
+	      for (len = 0; wstr_data[len]; ++len)
+		;
+	      scm_lfwrite (str_data, sizeof (xwchar_t), len, port);
+	      return;
+	    }
+	  }
+      }
+    }
+}
+
+
+
+
+#ifdef __STDC__
+void
+scm_gen_write (enum scm_string_representation_type rep, char *str_data, scm_sizet nitems, SCM port)
+#else
+void
+scm_gen_write (rep, str_data, nitems, port)
+     enum scm_string_representation_type rep;
+     char *str_data;
+     scm_sizet nitems;
+     SCM port;
+#endif
+{
+  /* is nitems bytes or characters in the mb_string case? */
+
+  switch (rep)
+    {
+    case scm_regular_string:
+      switch (SCM_PORT_REPRESENTATION (port))
+	{
+	case scm_regular_port:
+	case scm_mb_port:
+	  scm_lfwrite (str_data, 1, nitems, port);
+	  return;
+	case scm_wchar_port:
+	  {
+	    while (nitems)
+	      {
+		scm_putc (0, port);
+		scm_putc (*str_data, port);
+		++str_data;
+		--nitems;
+	      }
+	    return;
+	  }
+	}
+
+    case scm_mb_string:
+      switch (SCM_PORT_REPRESENTATION (port))
+	{
+	case scm_regular_port:
+	case scm_mb_port:
+	  scm_lfwrite (str_data, 1, nitems, port);
+	  return;
+
+	case scm_wchar_port:
+	  {
+	    xwchar_t output;
+	    int len;
+
+	    while (nitems)
+	      {
+		len = xmbtowc (&output, str_data, nitems);
+		SCM_ASSERT ((len > 0), SCM_MAKINUM (*str_data), "bogus character", "scm_gen_puts");
+		scm_putc ((output >> 8) & 0xff, port);
+		scm_putc (output & 0xff, port);
+		nitems -= len;
+		str_data += len;
+	      }
+	    return;
+	  }
+	}
+
+    case scm_wchar_string:
+      {
+	xwchar_t * wstr_data;
+
+	wstr_data = (xwchar_t *)wstr_data;
+	switch (SCM_PORT_REPRESENTATION (port))
+	  {
+	  case scm_regular_port:
+	    while (nitems)
+	      {
+		scm_putc ((unsigned char) *wstr_data, port);
+		++wstr_data;
+		--nitems;
+	      }
+	    return;
+
+	  case scm_mb_port:
+	    {
+	      char buf[256];
+	      SCM_ASSERT (XMB_CUR_MAX < sizeof (buf), SCM_BOOL_F,
+		      "huge translation", "scm_gen_puts");
+
+	      while (nitems)
+		{
+		  int len;
+
+		  len = xwctomb (buf, *wstr_data);
+		  
+		  SCM_ASSERT ((len > 0), SCM_MAKINUM (*wstr_data), "bogus character", "scm_gen_puts");
+		  
+		  {
+		    int x;
+		    for (x = 0; x < len; ++x)
+		      scm_putc (buf[x], port);
+		  }
+		  ++wstr_data;
+		  --nitems;
+		}
+	      return;
+	    }
+	    
+	  case scm_wchar_port:
+	    {
+	      scm_lfwrite (str_data, sizeof (xwchar_t), nitems, port);
+	      return;
+	    }
+	  }
+      }
+    }
+}
+
+
+
+
+#ifdef __STDC__
+static int 
+scm_getc (SCM port)
+#else
+static int 
+scm_getc (port)
+     SCM port;
+#endif
+{
+  FILE *f;
+  int c;
+  scm_sizet i;
+
+  f = (FILE *)SCM_STREAM (port);
+  i = SCM_PTOBNUM (port);
+  SCM_SYSCALL (c = (scm_ptobs[i].fgetc) (f));
+  return c;
+}
+
+#ifdef __STDC__
+int 
+scm_gen_getc (SCM port)
+#else
+int 
+scm_gen_getc (port)
+     SCM port;
+#endif
+{
+  int c;
+
+  /* One char may be stored in the high bits of (car port) orre@nada.kth.se. */
+  if (SCM_CRDYP (port))
+    {
+      c = SCM_CGETUN (port);
+      SCM_CLRDY (port);		/* Clear ungetted char */
+
+    return_c:
+      if (c == '\n')
+	{
+	  SCM_INCLINE (port);
+	}
+      else if (c == '\t')
+	{
+	  SCM_TABCOL (port);
+	}
+      else
+	{
+	  SCM_INCCOL (port);
+	}
+      return c;
+    }
+
+
+  switch (SCM_PORT_REPRESENTATION (port))
+    {
+    case scm_regular_port:
+      c = scm_getc (port);
+      goto return_c;
+
+    case scm_mb_port:
+      {
+	int x;
+	unsigned char buf[256];
+	int c;
+
+	SCM_ASSERT (XMB_CUR_MAX < sizeof (buf), SCM_BOOL_F,
+		"huge translation", "scm_gen_puts");
+
+	x = 0;
+	while (1)
+	  {
+	    xwchar_t out;
+	    c = scm_getc (port);
+
+	    if (c == EOF)
+	      return EOF;
+	    
+	    buf[x] = c;
+
+	    if (xmbtowc (&out, buf, x + 1) > 0)
+	      {
+		c = out;
+		goto return_c;
+	      }
+
+	    SCM_ASSERT (x < sizeof (buf), SCM_BOOL_F,
+		    "huge translation", "scm_gen_getc");
+	    ++x;
+	  }
+      }
+
+
+    case scm_wchar_port:
+      {
+	int hi;
+	int lo;
+	hi = scm_getc (port);
+	lo = (hi == EOF
+	      ? EOF
+	      : scm_getc (port));
+	c = ((hi == EOF)
+	     ? EOF
+	     : ((hi << 8) | lo));
+	goto return_c;
+      }
+
+
+    default:
+      return EOF;
+    }
+}
+
+#ifdef __STDC__
+void 
+scm_gen_ungetc (int c, SCM port)
+#else
+void 
+scm_gen_ungetc (c, port)
+     int c;
+     SCM port;
+#endif
+{
+/*	SCM_ASSERT(!SCM_CRDYP(port), port, SCM_ARG2, "too many scm_gen_ungetc");*/
+  SCM_CUNGET (c, port);
+  if (c == '\n')
+    {
+      /* What should col be in this case?
+       * We'll leave it at -1.
+       */
+      SCM_LINUM (port) -= 1;
+    }
+  else
+    SCM_COL(port) -= 1;
+}
+
+
diff --git a/libguile/genio.h b/libguile/genio.h
new file mode 100644
index 000000000..30275211b
--- /dev/null
+++ b/libguile/genio.h
@@ -0,0 +1,69 @@
+/* classes: h_files */
+
+#ifndef GENIOH
+#define GENIOH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+#include "ports.h"
+
+
+#ifdef __STDC__
+extern void scm_gen_putc (int c, SCM port);
+extern void scm_gen_puts (enum scm_string_representation_type rep,
+			  char *str_data,
+			  SCM port);
+extern void scm_gen_write (enum scm_string_representation_type rep, char *str_data, scm_sizet nitems, SCM port);
+extern int scm_gen_getc (SCM port);
+extern void scm_gen_ungetc (int c, SCM port);
+
+#else /* STDC */
+extern void scm_gen_putc ();
+extern void scm_gen_puts ();
+extern void scm_gen_write ();
+extern int scm_gen_getc ();
+extern void scm_gen_ungetc ();
+
+#endif /* STDC */
+
+#endif  /* GENIOH */
diff --git a/libguile/gscm.c b/libguile/gscm.c
new file mode 100644
index 000000000..5eedc9755
--- /dev/null
+++ b/libguile/gscm.c
@@ -0,0 +1,657 @@
+/*	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.  
+ */
+
+
+
+
+
+#include <stdio.h>
+#include <sys/param.h>
+#include "gscm.h"
+#include "_scm.h"
+
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+#ifdef HAVE_STRING_H
+#include <string.h>
+#endif
+
+
+
+extern char *getenv ();
+
+
+/* {Top Level Evaluation}
+ * 
+ * Top level evaluation has to establish a dynamic root context,
+ * enable Scheme signal handlers, and catch global escapes (errors, quits,
+ * aborts, restarts, and execs) from the interpreter.
+ */
+
+
+/* {Printing Objects to Strings} 
+ */
+
+#ifdef __STDC__
+static GSCM_status
+gscm_portprint_obj (SCM port, SCM obj)
+#else
+static GSCM_status
+gscm_portprint_obj (port, obj)
+     SCM port;
+     SCM obj;
+#endif
+{
+  scm_iprin1 (obj, port, 1);
+  return GSCM_OK;
+}
+
+
+struct seval_str_frame
+{
+  GSCM_status status;
+  SCM * answer;
+  GSCM_top_level top;
+  char * str;
+};
+
+#ifdef __STDC__
+static void
+_seval_str_fn (void * vframe)
+#else
+static void
+_seval_str_fn (vframe)
+     void * vframe;
+#endif
+{
+  struct seval_str_frame * frame;
+  frame = (struct seval_str_frame *)vframe;
+  frame->status = gscm_seval_str (frame->answer, frame->top, frame->str);
+}
+
+
+
+#ifdef __STDC__
+static GSCM_status
+gscm_strprint_obj (SCM * answer, SCM obj)
+#else
+static GSCM_status
+gscm_strprint_obj (answer, obj)
+     SCM * answer;
+     SCM obj;
+#endif
+{
+  SCM str;
+  SCM port;
+  GSCM_status stat;
+  str = scm_makstr (64, 0);
+  port = scm_mkstrport (SCM_MAKINUM (0), str, SCM_OPN | SCM_WRTNG, "gscm_strprint_obj");
+  stat = gscm_portprint_obj (port, obj);
+  if (stat == GSCM_OK)
+    *answer = str;
+  else
+    *answer = SCM_BOOL_F;
+  return stat;
+}
+
+#ifdef __STDC__
+static GSCM_status
+gscm_cstr (char ** answer, SCM obj)
+#else
+static GSCM_status
+gscm_cstr (answer, obj)
+     char ** answer;
+     SCM obj;
+#endif
+{
+  GSCM_status stat;
+
+  *answer = (char *)malloc (SCM_LENGTH (obj));
+  stat = GSCM_OK;
+  if (!*answer)
+    stat = GSCM_OUT_OF_MEM;
+  else
+    memcpy (*answer, SCM_CHARS (obj), SCM_LENGTH (obj));
+  return stat;
+}
+     
+
+/* {Invoking The Interpreter}
+ */
+
+#ifdef __STDC__
+static SCM
+gscm_silent_repl (SCM env)
+#else
+static SCM
+gscm_silent_repl (env)
+     SCM env;
+#endif
+{
+  SCM source;
+  SCM answer;
+  answer = SCM_UNSPECIFIED;
+  while ((source = scm_read (SCM_UNDEFINED, SCM_UNDEFINED, SCM_UNDEFINED)) != SCM_EOF_VAL)
+    answer = scm_eval_x (source);
+  return answer;
+}
+
+
+#ifdef _UNICOS
+typedef int setjmp_type;
+#else
+typedef long setjmp_type;
+#endif
+
+#ifdef __STDC__
+static GSCM_status
+_eval_port (SCM * answer, GSCM_top_level toplvl, SCM port, int printp)
+#else
+static GSCM_status
+_eval_port (answer, toplvl, port, printp)
+     SCM * answer;
+     GSCM_top_level toplvl;
+     SCM port;
+     int printp;
+#endif
+{
+  SCM saved_inp;
+  GSCM_status status;
+  setjmp_type i;
+  static int deja_vu = 0;
+  SCM ignored;
+
+  if (deja_vu)
+    return GSCM_ILLEGALLY_REENTERED;
+
+  ++deja_vu;
+  /* Take over signal handlers for all the interesting signals.
+   */
+  scm_init_signals ();
+
+
+  /* Default return values:
+   */
+  if (!answer)
+    answer = &ignored;
+  status = GSCM_OK;
+  *answer = SCM_BOOL_F;
+
+  /* Perform evalutation under a new dynamic root.
+   *
+   */
+  SCM_BASE (scm_rootcont) = (SCM_STACKITEM *) & i;
+#ifdef DEBUG_EXTENSIONS
+  SCM_DFRAME (scm_rootcont) = last_debug_info_frame = 0;
+#endif
+  saved_inp = scm_cur_inp;
+  i = setjmp (SCM_JMPBUF (scm_rootcont));
+#ifdef SCM_STACK_CHECK
+  scm_check_stack_p = 1;
+#endif
+  if (!i)
+    {
+      scm_gc_heap_lock = 0;
+      scm_ints_disabled = 0;
+      /* need to close loading files here. */
+      scm_cur_inp = port;
+      {
+	SCM top_env;
+	top_env = SCM_EOL;
+	*answer = gscm_silent_repl (top_env);
+      }
+      scm_cur_inp = saved_inp;
+      if (printp)
+	status = gscm_strprint_obj (answer, *answer);
+    }
+  else
+    {
+      scm_cur_inp = saved_inp;
+      *answer = scm_exitval;
+      if (printp)
+	gscm_strprint_obj (answer, *answer);
+      status = GSCM_ERROR;
+    }
+
+  scm_gc_heap_lock = 1;
+  scm_ints_disabled = 1;
+  scm_restore_signals ();
+  --deja_vu;
+  return status;
+}
+
+#ifdef __STDC__
+static GSCM_status
+seval_str (SCM *answer, GSCM_top_level toplvl, char * str)
+#else
+static GSCM_status
+seval_str (answer, toplvl, str)
+     SCM *answer;
+     GSCM_top_level toplvl;
+     char * str;
+#endif
+{
+  SCM scheme_str;
+  SCM port;
+  GSCM_status status;
+
+  scheme_str = scm_makfromstr (str, strlen (str), 0);
+  port = scm_mkstrport (SCM_MAKINUM (0), scheme_str, SCM_OPN | SCM_RDNG, "gscm_seval_str");
+  status = _eval_port (answer, toplvl, port, 0);
+  return status;
+}
+
+
+#ifdef __STDC__
+GSCM_status
+gscm_seval_str (SCM *answer, GSCM_top_level toplvl, char * str)
+#else
+GSCM_status
+gscm_seval_str (answer, toplvl, str)
+     SCM *answer;
+     GSCM_top_level toplvl;
+     char * str;
+#endif
+{
+  SCM_STACKITEM i;
+  GSCM_status status;
+  scm_stack_base = &i;
+  status = seval_str (answer, toplvl, str);
+  scm_stack_base = 0;
+  return status;
+}
+
+#ifdef __STDC__
+void
+format_load_command (char * buf, char *file_name)
+#else
+void
+format_load_command (buf, file_name)
+     char * buf;
+     char *file_name;
+#endif
+{
+  char quoted_name[MAXPATHLEN + 1];
+  int source;
+  int dest;
+
+  for (source = dest = 0; file_name[source]; ++source)
+    {
+      if (file_name[source] == '"')
+	quoted_name[dest++] = '\\';
+      quoted_name[dest++] = file_name[source];
+    }
+  quoted_name[dest] = 0;
+  sprintf (buf, "(%%try-load \"%s\")", quoted_name);
+}
+
+#ifdef __STDC__
+GSCM_status
+gscm_seval_file (SCM *answer, GSCM_top_level toplvl, char * file_name)
+#else
+GSCM_status
+gscm_seval_file (answer, toplvl, file_name)
+     SCM *answer;
+     GSCM_top_level toplvl;
+     char * file_name;
+#endif
+{
+  char command[MAXPATHLEN * 3];
+  format_load_command (command, file_name);
+  return gscm_seval_str (answer, toplvl, command);
+}
+
+
+#ifdef __STDC__
+static GSCM_status
+eval_str (char ** answer, GSCM_top_level toplvl, char * str)
+#else
+static GSCM_status
+eval_str (answer, toplvl, str)
+     char ** answer;
+     GSCM_top_level toplvl;
+     char * str;
+#endif
+{
+  SCM sanswer;
+  SCM scheme_str;
+  SCM port;
+  GSCM_status status;
+
+  scheme_str = scm_makfromstr (str, strlen (str), 0);
+  port = scm_mkstrport (SCM_MAKINUM(0), scheme_str, SCM_OPN | SCM_RDNG, "gscm_eval_str");
+  status = _eval_port (&sanswer, toplvl, port, 1);
+  if (answer)
+    {
+      if (status == GSCM_OK)
+	status = gscm_cstr (answer, sanswer);
+      else
+	*answer = 0;
+    }
+  return status;
+}
+
+
+#ifdef __STDC__
+GSCM_status
+gscm_eval_str (char ** answer, GSCM_top_level toplvl, char * str)
+#else
+GSCM_status
+gscm_eval_str (answer, toplvl, str)
+     char ** answer;
+     GSCM_top_level toplvl;
+     char * str;
+#endif
+{
+  SCM_STACKITEM i;
+  GSCM_status status;
+  scm_stack_base = &i;
+  status = eval_str (answer, toplvl, str);
+  scm_stack_base = 0;
+  return status;
+}
+
+
+#ifdef __STDC__
+GSCM_status
+gscm_eval_file (char ** answer, GSCM_top_level toplvl, char * file_name)
+#else
+GSCM_status
+gscm_eval_file (answer, toplvl, file_name)
+     char ** answer;
+     GSCM_top_level toplvl;
+     char * file_name;
+#endif
+{
+  char command[MAXPATHLEN * 3];
+  format_load_command (command, file_name);
+  return gscm_eval_str (answer, toplvl, command);
+}
+
+
+
+
+/* {Error Messages}
+ */
+
+
+#ifdef __GNUC__
+# define AT(X)  [X] =
+#else
+# define AT(X)
+#endif 
+
+static char * gscm_error_msgs[] =
+{
+  AT(GSCM_OK) "No error.",
+  AT(GSCM_ERROR) "ERROR in init file.",
+  AT(GSCM_ILLEGALLY_REENTERED) "Gscm function was illegally reentered.",
+  AT(GSCM_OUT_OF_MEM) "Out of memory.",
+  AT(GSCM_ERROR_OPENING_FILE) "Error opening file.",
+  AT(GSCM_ERROR_OPENING_INIT_FILE) "Error opening init file."
+};
+
+#ifdef __STDC__
+char *
+gscm_error_msg (int n)
+#else
+char *
+gscm_error_msg (n)
+     int n;
+#endif
+{
+  if ((n < 0) || (n > (sizeof (gscm_error_msgs) / sizeof (char *))))
+    return "Unrecognized error.";
+  else
+    return gscm_error_msgs[n];
+}
+
+
+
+/* {Defining New Procedures}
+ */
+
+#ifdef __STDC__
+SCM
+gscm_make_subr (SCM (*fn)(), int req, int opt, int varp, char * doc)
+#else
+SCM
+gscm_make_subr (fn, req, opt, varp, doc)
+     SCM (*fn)();
+     int req;
+     int opt;
+     int varp;
+     char * doc;
+#endif
+{
+  return scm_make_gsubr ("*anonymous*", req, opt, varp, fn);
+}
+
+#ifdef __STDC__
+int
+gscm_2_char (SCM c)
+#else
+int
+gscm_2_char (c)
+     SCM c;
+#endif
+{
+  SCM_ASSERT (SCM_ICHRP (c), c, SCM_ARG1, "gscm_2_char");
+  return SCM_ICHR (c);
+}
+
+
+
+#ifdef __STDC__
+void
+gscm_2_str (char ** out, int * len_out, SCM * objp)
+#else
+void
+gscm_2_str (out, len_out, objp)
+     char ** out;
+     int * len_out;
+     SCM * objp;
+#endif
+{
+  SCM_ASSERT (SCM_NIMP (*objp) && SCM_STRINGP (*objp), *objp, SCM_ARG3, "gscm_2_str");
+  if (out)
+    *out = SCM_CHARS (*objp);
+  if (len_out)
+    *len_out = SCM_LENGTH (*objp);
+}
+
+
+#ifdef __STDC__
+void
+gscm_error (char * message, SCM args)
+#else
+void
+gscm_error (message, args)
+     char * message;
+     SCM args;
+#endif
+{
+  SCM errsym;
+  SCM str;
+
+  errsym = SCM_CAR (scm_intern ("error", 5));
+  str = scm_makfrom0str (message);
+  scm_throw (errsym, scm_cons (str, args));
+}
+
+
+#ifdef __STDC__
+GSCM_status
+gscm_run_scm (int argc, char ** argv, FILE * in, FILE * out, FILE * err, GSCM_status (*initfn)(), char * initfile, char * initcmd)
+#else
+GSCM_status
+gscm_run_scm (argc, argv, in, out, err, initfn, initfile, initcmd)
+     int argc;
+     char ** argv;
+     FILE * in;
+     FILE * out;
+     FILE * err;
+     GSCM_status (*initfn)();
+     char * initfile;
+     char * initcmd;
+#endif
+{
+  SCM_STACKITEM i;
+  GSCM_status status;
+  GSCM_top_level top;
+
+  scm_ports_prehistory ();
+  scm_smob_prehistory ();
+  scm_tables_prehistory ();
+  scm_init_storage (0);
+  scm_start_stack (&i, in, out, err);
+  scm_init_gsubr ();
+  scm_init_curry ();
+  scm_init_feature ();
+/*  scm_init_debug ();  */
+  scm_init_alist ();
+  scm_init_append ();
+  scm_init_arbiters ();
+  scm_init_async ();
+  scm_init_boolean ();
+  scm_init_chars ();
+  scm_init_continuations ();
+  scm_init_dynwind ();
+  scm_init_eq ();
+  scm_init_error ();
+  scm_init_fports ();
+  scm_init_files ();
+  scm_init_gc ();
+  scm_init_hash ();
+  scm_init_hashtab ();
+  scm_init_kw ();
+  scm_init_list ();
+  scm_init_lvectors ();
+  scm_init_numbers ();
+  scm_init_pairs ();
+  scm_init_ports ();
+  scm_init_procs ();
+  scm_init_procprop ();
+  scm_init_scmsigs ();
+  scm_init_stackchk ();
+  scm_init_strports ();
+  scm_init_struct ();
+  scm_init_symbols ();
+  scm_init_load ();
+  scm_init_print ();
+  scm_init_read ();
+  scm_init_sequences ();
+  scm_init_stime ();
+  scm_init_strings ();
+  scm_init_strorder ();
+  scm_init_mbstrings ();
+  scm_init_strop ();
+  scm_init_throw ();
+  scm_init_variable ();
+  scm_init_vectors ();
+  scm_init_weaks ();
+  scm_init_vports ();
+  scm_init_eval ();
+  scm_init_ramap ();
+  scm_init_unif ();
+  scm_init_simpos ();
+  scm_init_elisp ();
+  scm_init_mallocs ();
+  scm_init_cnsvobj ();
+  scm_init_guile ();
+  initfn ();
+
+  /* Save the argument list to be the return value of (program-arguments).
+   */
+  scm_progargs = scm_makfromstrs (argc, argv);
+
+  scm_gc_heap_lock = 0;
+  errno = 0;
+  scm_ints_disabled = 1;
+
+/*  init_basic (); */
+
+/*   init_init(); */
+
+  if (initfile == NULL)
+    {
+      initfile = getenv ("GUILE_INIT_PATH");
+      if (initfile == NULL)
+	initfile = SCM_IMPLINIT;
+    }
+
+  if (initfile == NULL)
+    {
+      status = GSCM_OK;
+    }
+  else
+    {
+      SCM answer;
+
+      status = gscm_seval_file (&answer, -1, initfile);
+      if ((status == GSCM_OK) && (answer == SCM_BOOL_F))
+	status = GSCM_ERROR_OPENING_INIT_FILE;
+    }
+
+  top = SCM_EOL;
+
+  if (status == GSCM_OK)
+    {
+      scm_sysintern ("*stdin*", scm_cur_inp);
+      status = gscm_seval_str (0, top, initcmd);
+    }
+  return status;
+}
+
+
+
+#ifdef __STDC__
+void
+scm_init_guile (void)
+#else
+void
+scm_init_guile ()
+#endif
+{
+#include "gscm.x"
+}
+
diff --git a/libguile/gscm.h b/libguile/gscm.h
new file mode 100644
index 000000000..c6ac44b5f
--- /dev/null
+++ b/libguile/gscm.h
@@ -0,0 +1,297 @@
+/* classes: h_files */
+
+#ifndef GSCMH
+#define GSCMH
+
+/*	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.  
+ */
+
+
+#include "libguile.h"
+
+
+/* {Locking Out Async Execution (including async GC) and Non-Local Exits}
+ */
+
+#define GSCM_DEFER_INTS			SCM_DEFER_INTS
+#define GSCM_ALLOW_INTS			SCM_ALLOW_INTS
+
+
+/* {Common Constants}
+ */
+
+#define GSCM_EOL			SCM_EOL
+#define GSCM_FALSE			SCM_BOOL_F
+#define GSCM_TRUE			SCM_BOOL_T
+
+#define GSCM_EOL_MARKER 		SCM_UNDEFINED
+#define GSCM_NOT_PASSED	 		SCM_UNDEFINED
+#define GSCM_UNSPECIFIED 		SCM_UNSPECIFIED
+
+
+/* {Booleans} 
+ */
+
+#define gscm_bool(CBOOL)	((CBOOL) ? SCM_BOOL_T : SCM_BOOL_F)
+#define gscm_2_bool(BOOL)	(((BOOL) == SCM_BOOL_F) ? 0 : 1)
+
+
+/* {Numbers}
+ */
+
+#define gscm_ulong 		scm_ulong2num
+#define gscm_long 		scm_long2num
+#define gscm_double(X)		scm_makdbl ((X), 0.0)
+
+#define gscm_2_ulong(OBJ)	scm_num2ulong((OBJ), (char *)SCM_ARG1, "gscm_2_ulong")
+#define gscm_2_long(OBJ)	scm_num2long((OBJ), (char *)SCM_ARG1, "gscm_2_long")
+#define gscm_2_double(OBJ)	scm_num2dbl((OBJ), "gscm_2_double")
+
+
+/* {Characters}
+ */
+
+#define gscm_char(C)		SCM_MAKICHR(C)
+/* extern int gscm_2_char 		P((SCM)); */
+
+
+/* {Strings}
+ */
+
+#define gscm_str(SRC, LEN)	scm_makfromstr (SRC, LEN, 0)
+#define gscm_str0		scm_makfrom0str
+
+
+
+/* {Pairs and Lists} 
+ */
+
+#define gscm_cons 			scm_cons
+#define gscm_list 			scm_listify
+#define gscm_ilength			scm_ilength
+
+
+#define gscm_set_car(OBJ, VAL) \
+   ((SCM_NIMP(OBJ) && SCM_CONSP(OBJ)) \
+		   ? (SCM_CAR(OBJ) = VAL) \
+		   : scm_wta ((OBJ), (char *)SCM_ARG1, "set-car!"))
+
+#define gscm_set_cdr(OBJ, VAL) \
+   ((SCM_NIMP(OBJ) && SCM_CONSP(OBJ)) \
+		   ? (SCM_CDR(OBJ) = VAL) \
+		   : scm_wta ((OBJ), (char *)SCM_ARG1, "set-cdr!"))
+
+
+#define GSCM_SAFE_CAR(X)   ((SCM_NIMP(X) && SCM_CONSP(X)) \
+		   ? SCM_CAR(X) \
+		   : scm_wta ((X), (char *)SCM_ARG1, "car"))
+
+#define GSCM_SAFE_CDR(X)   ((SCM_NIMP(X) && SCM_CONSP(X)) \
+		   ? SCM_CDR(X) \
+		   : scm_wta ((X), (char *)SCM_ARG1, "cdr"))
+
+#define gscm_car(OBJ)		GSCM_SAFE_CAR (OBJ)
+#define gscm_cdr(OBJ)		GSCM_SAFE_CDR (OBJ)
+
+#define gscm_caar(OBJ)		GSCM_SAFE_CAR (GSCM_SAFE_CAR (OBJ))
+#define gscm_cdar(OBJ)		GSCM_SAFE_CDR (GSCM_SAFE_CAR (OBJ))
+#define gscm_cadr(OBJ)		GSCM_SAFE_CAR (GSCM_SAFE_CDR (OBJ))
+#define gscm_cddr(OBJ)		GSCM_SAFE_CDR (GSCM_SAFE_CDR (OBJ))
+
+#define gscm_caaar(OBJ)		GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (OBJ)))
+#define gscm_cdaar(OBJ)		GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (OBJ)))
+#define gscm_cadar(OBJ)		GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (OBJ)))
+#define gscm_cddar(OBJ)		GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (OBJ)))
+#define gscm_caadr(OBJ)		GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (OBJ)))
+#define gscm_cdadr(OBJ)		GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (OBJ)))
+#define gscm_caddr(OBJ)		GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (OBJ)))
+#define gscm_cdddr(OBJ)		GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (OBJ)))
+
+#define gscm_caaaar(OBJ)	GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (OBJ))))
+#define gscm_cdaaar(OBJ)	GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (OBJ))))
+#define gscm_cadaar(OBJ)	GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (OBJ))))
+#define gscm_cddaar(OBJ)	GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (OBJ))))
+#define gscm_caadar(OBJ)	GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (OBJ))))
+#define gscm_cdadar(OBJ)	GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (OBJ))))
+#define gscm_caddar(OBJ)	GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (OBJ))))
+#define gscm_cdddar(OBJ)	GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (OBJ))))
+#define gscm_caaadr(OBJ)	GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (OBJ))))
+#define gscm_cdaadr(OBJ)	GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (OBJ))))
+#define gscm_cadadr(OBJ)	GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (OBJ))))
+#define gscm_cddadr(OBJ)	GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (OBJ))))
+#define gscm_caaddr(OBJ)	GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (OBJ))))
+#define gscm_cdaddr(OBJ)	GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (OBJ))))
+#define gscm_cadddr(OBJ)	GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (OBJ))))
+#define gscm_cddddr(OBJ)	GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (OBJ))))
+
+
+/* {Symbols}
+ */
+
+#define gscm_symbol(STR, LEN)		SCM_CAR(scm_intern (STR, LEN))
+#define gscm_tmp_symbol(STR, LEN)	SCM_CAR(scm_intern_obarray (STR, LEN, SCM_BOOL_F))
+
+
+/* {Vectors}
+ */
+
+#define gscm_vector(N, FILL)		scm_make_vector (SCM_MAKINUM(N), (FILL), SCM_UNDEFINED)
+#define gscm_vref(V, I)			scm_vector_ref ((V), SCM_MAKINUM(I))
+#define gscm_vset(V, I, VAL)		scm_vector_set_x ((V), SCM_MAKINUM(I), (VAL))
+
+
+/* {Procedures}
+ */
+
+/* extern SCM gscm_make_subr P((SCM (*fn)(), int req, int opt, int varp, char * doc)); */
+/* extern SCM gscm_curry P((SCM procedure, SCM first_arg)); */
+
+#define gscm_apply(PROC, ARGS)		scm_apply ((PROC), (ARGS), SCM_EOL)
+
+
+
+/* {Non-local Exits}
+ */
+
+
+#define gscm_catch(T, TH, H)		scm_catch ((T), (TH), (H))
+#define gscm_throw(T, V)		scm_throw ((T), (V))
+#define gscm_dynamic_wind(E, T, L)	scm_dynwind ((E), (T), (L))
+/* extern void gscm_error P((char * message, SCM args)); */
+
+
+/* {I/O}
+ */
+
+#define gscm_print_obj			scm_iprin1
+#define gscm_putc			scm_putc
+#define gscm_puts			scm_puts
+#define gscm_fwrite			scm_fwrite
+#define gscm_flush			scm_flush
+
+extern char * gscm_last_attempted_init_file;
+
+/* {Equivalence}
+ */
+
+
+#define gscm_is_eq(OBJ)		(SCM_BOOL_F != scm_eq (OBJ))
+#define gscm_is_eqv(OBJ)	(SCM_BOOL_F != scm_eqv (OBJ))
+#define gscm_is_equal(OBJ)	(SCM_BOOL_F != scm_equal_p (OBJ))
+
+
+/* {Procedure Properties}
+ */
+
+#define gscm_procedure_properties 		scm_procedure_properties
+#define gscm_set_procedure_properties_x 	scm_set_procedure_properties_x
+#define gscm_procedure_property 		scm_procedure_property
+#define gscm_set_procedure_property_x 		scm_set_procedure_property_x
+
+
+/* {Generic Length Procedure}
+ */
+
+#define gscm_obj_length				scm_obj_length
+
+
+/* {Proc Declaration Macro}
+ */
+#ifndef GSCM_MAGIC_SNARFER
+#define GSCM_PROC(RANAME, CFN, STR, REQ, OPT, VAR)  \
+	static char RANAME[]=STR;
+#else
+#define GSCM_PROC(RANAME, CFN, STR, REQ, OPT, VAR)  \
+%%% gscm_define_procedure (RANAME, CFN, REQ, OPT, VAR, "")
+#endif
+
+#define gscm_define_procedure(NAME, FN, REQ, OPT, VARP, DOC)	scm_make_gsubr(name, req, opt, varp, fn)
+#define gscm_curry 						scm_curry
+#define gscm_define						scm_sysintern
+
+
+typedef int GSCM_top_level;
+
+
+/* {Error Returns}
+ */
+
+typedef int GSCM_status;
+
+#define GSCM_OK 			0
+#define GSCM_ERROR 			1
+#define GSCM_ILLEGALLY_REENTERED 	2
+#define GSCM_OUT_OF_MEM 		3
+#define GSCM_ERROR_OPENING_FILE		4
+#define GSCM_ERROR_OPENING_INIT_FILE	5
+
+
+
+#ifdef __STDC__
+extern GSCM_status gscm_seval_str (SCM *answer, GSCM_top_level toplvl, char * str);
+extern GSCM_status gscm_seval_file (SCM *answer, GSCM_top_level toplvl, char * file_name);
+extern GSCM_status gscm_eval_str (char ** answer, GSCM_top_level toplvl, char * str);
+extern GSCM_status gscm_eval_file (char ** answer, GSCM_top_level toplvl, char * file_name);
+extern GSCM_status gscm_run_scm (int argc, char ** argv, FILE * in, FILE * out, FILE * err, GSCM_status (*initfn)(), char * initfile, char * initcmd);
+extern char * gscm_error_msg (int n);
+extern SCM gscm_make_subr (SCM (*fn)(), int req, int opt, int varp, char * doc);
+extern int gscm_2_char (SCM c);
+extern void gscm_2_str (char ** out, int * len_out, SCM * objp);
+extern void gscm_error (char * message, SCM args);
+extern void scm_init_guile (void);
+
+#else /* STDC */
+extern GSCM_status gscm_seval_str ();
+extern void format_load_command ();
+extern GSCM_status gscm_seval_file ();
+extern GSCM_status gscm_eval_str ();
+extern GSCM_status gscm_eval_file ();
+extern char * gscm_error_msg ();
+extern SCM gscm_make_subr ();
+extern int gscm_2_char ();
+extern void gscm_2_str ();
+extern void gscm_error ();
+extern GSCM_status gscm_run_scm ();
+extern void scm_init_guile ();
+
+#endif /* STDC */
+#endif  /* GSCMH */
+
diff --git a/libguile/gsubr.c b/libguile/gsubr.c
new file mode 100644
index 000000000..2f1cc75e9
--- /dev/null
+++ b/libguile/gsubr.c
@@ -0,0 +1,195 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+/*
+ * gsubr.c
+ * Provide `gsubrs' -- subrs taking a prescribed number of required, optional,
+ * and rest arguments.
+ */
+
+#include "gsubr.h"
+
+#define GSUBR_TEST 1
+
+#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) (SCM_VELTS(cclo)[1])
+#define GSUBR_PROC(cclo) (SCM_VELTS(cclo)[2])
+
+static SCM f_gsubr_apply;
+#ifdef __STDC__
+SCM
+scm_make_gsubr(char *name, int req, int opt, int rst, SCM (*fcn)())
+#else
+SCM
+scm_make_gsubr(name, req, opt, rst, fcn)
+     char *name;
+     int req;
+     int opt;
+     int rst;
+     SCM (*fcn)();
+#endif
+{
+  switch GSUBR_MAKTYPE(req, opt, rst) {
+  case GSUBR_MAKTYPE(0, 0, 0): return scm_make_subr(name, scm_tc7_subr_0, fcn);
+  case GSUBR_MAKTYPE(1, 0, 0): return scm_make_subr(name, scm_tc7_subr_1, fcn);
+  case GSUBR_MAKTYPE(0, 1, 0): return scm_make_subr(name, scm_tc7_subr_1o, fcn);
+  case GSUBR_MAKTYPE(1, 1, 0): return scm_make_subr(name, scm_tc7_subr_2o, fcn);
+  case GSUBR_MAKTYPE(2, 0, 0): return scm_make_subr(name, scm_tc7_subr_2, fcn);
+  case GSUBR_MAKTYPE(3, 0, 0): return scm_make_subr(name, scm_tc7_subr_3, fcn);
+  case GSUBR_MAKTYPE(0, 0, 1): return scm_make_subr(name, scm_tc7_lsubr, fcn);
+  case GSUBR_MAKTYPE(2, 0, 1): return scm_make_subr(name, scm_tc7_lsubr_2, fcn);
+  default:
+    {
+      SCM symcell = scm_sysintern(name, SCM_UNDEFINED);
+      SCM z, cclo = scm_makcclo(f_gsubr_apply, 3L);
+      long tmp = ((((SCM_CELLPTR)(SCM_CAR(symcell)))-scm_heap_org)<<8);
+      if (GSUBR_MAX < req + opt + rst) {
+	fputs("ERROR in scm_make_gsubr: too many args\n", stderr);
+	exit (1);
+      }
+      if ((tmp>>8) != ((SCM_CELLPTR)(SCM_CAR(symcell))-scm_heap_org))
+	tmp = 0;
+      SCM_NEWCELL(z);
+      SCM_SUBRF(z) = fcn;
+      SCM_CAR(z) = tmp + scm_tc7_subr_0;
+      GSUBR_PROC(cclo) = z;
+      GSUBR_TYPE(cclo) = SCM_MAKINUM(GSUBR_MAKTYPE(req, opt, rst));
+      SCM_CDR(symcell) = cclo;
+      return cclo;
+    }
+  }
+}
+
+
+SCM_PROC(s_gsubr_apply, "gsubr-apply", 0, 0, 1, scm_gsubr_apply);
+#ifdef __STDC__
+SCM
+scm_gsubr_apply(SCM args)
+#else
+SCM
+scm_gsubr_apply(args)
+     SCM args;
+#endif
+{
+  SCM self = SCM_CAR(args);
+  SCM (*fcn)() = SCM_SUBRF(GSUBR_PROC(self));
+  SCM v[10];			/* must agree with greatest supported arity */
+  int typ = SCM_INUM(GSUBR_TYPE(self));
+  int i, n = GSUBR_REQ(typ) + GSUBR_OPT(typ) + GSUBR_REST(typ);
+  args = SCM_CDR(args);
+  for (i = 0; i < GSUBR_REQ(typ); i++) {
+#ifndef RECKLESS
+    if (SCM_IMP(args))
+      scm_wta(SCM_UNDEFINED, (char *)SCM_WNA, SCM_CHARS(SCM_SNAME(GSUBR_PROC(self))));
+#endif
+    v[i] = SCM_CAR(args);
+    args = SCM_CDR(args);
+  }
+  for (; i < GSUBR_REQ(typ) + GSUBR_OPT(typ); i++) {
+    if (SCM_NIMP(args)) {
+      v[i] = SCM_CAR(args);
+      args = SCM_CDR(args);
+    }
+    else
+      v[i] = SCM_UNDEFINED;
+  }
+  if (GSUBR_REST(typ))
+    v[i] = args;
+  switch (n) {
+  default: scm_wta(self, "internal programming error", s_gsubr_apply);
+  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]);
+  }
+}
+
+
+#ifdef GSUBR_TEST
+/* A silly example, taking 2 required args, 1 optional, and
+   a scm_list of rest args 
+   */
+SCM
+gsubr_21l(req1, req2, opt, rst)
+     SCM req1, req2, opt, rst;
+{
+  scm_gen_puts (scm_regular_string, "gsubr-2-1-l:\n req1: ", scm_cur_outp);
+  scm_display(req1, scm_cur_outp);
+  scm_gen_puts (scm_regular_string, "\n req2: ", scm_cur_outp);
+  scm_display(req2, scm_cur_outp);
+  scm_gen_puts (scm_regular_string, "\n opt: ", scm_cur_outp);
+  scm_display(opt, scm_cur_outp);
+  scm_gen_puts (scm_regular_string, "\n rest: ", scm_cur_outp);
+  scm_display(rst, scm_cur_outp);
+  scm_newline(scm_cur_outp);
+  return SCM_UNSPECIFIED;
+}
+#endif
+
+
+#ifdef __STDC__
+void
+scm_init_gsubr(void)
+#else
+void
+scm_init_gsubr()
+#endif
+{
+  f_gsubr_apply = scm_make_subr(s_gsubr_apply, scm_tc7_lsubr, scm_gsubr_apply);
+#ifdef GSUBR_TEST
+  scm_make_gsubr("gsubr-2-1-l", 2, 1, 1, gsubr_21l); /* example */
+#endif
+}
diff --git a/libguile/gsubr.h b/libguile/gsubr.h
new file mode 100644
index 000000000..4aed7ef0a
--- /dev/null
+++ b/libguile/gsubr.h
@@ -0,0 +1,65 @@
+/* classes: h_files */
+
+#ifndef GSUBRH
+#define GSUBRH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+
+
+#ifdef __STDC__
+extern SCM scm_make_gsubr(char *name, int req, int opt, int rst, SCM (*fcn)());
+extern SCM scm_gsubr_apply(SCM args);
+extern void scm_init_gsubr(void);
+
+#else /* STDC */
+extern SCM scm_make_gsubr();
+extern SCM scm_gsubr_apply();
+extern void scm_init_gsubr();
+
+#endif /* STDC */
+
+
+
+
+#endif  /* GSUBRH */
diff --git a/libguile/hash.c b/libguile/hash.c
new file mode 100644
index 000000000..48f171a61
--- /dev/null
+++ b/libguile/hash.c
@@ -0,0 +1,252 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+
+#ifndef floor
+extern double floor();
+#endif
+
+#ifdef __STDC__
+unsigned long
+scm_hasher(SCM obj, unsigned long n, scm_sizet d)
+#else
+unsigned long
+scm_hasher(obj, n, d)
+     SCM obj;
+     unsigned long n;
+     scm_sizet d;
+#endif
+{
+  switch (7 & (int) obj) {
+  case 2: case 6:		/* SCM_INUMP(obj) */
+    return SCM_INUM(obj) % n;
+  case 4:
+    if SCM_ICHRP(obj)
+      return (unsigned)(scm_downcase(SCM_ICHR(obj))) % n;
+    switch ((int) obj) {
+#ifndef SICP
+    case (int) SCM_EOL: d = 256; break;
+#endif
+    case (int) SCM_BOOL_T: d = 257; break;
+    case (int) SCM_BOOL_F: d = 258; break;
+    case (int) SCM_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 SCM_TYP7(obj) {
+    default: return 263 % n;
+    case scm_tc7_smob:
+      switch SCM_TYP16(obj) {
+      case scm_tcs_bignums:
+      bighash: return SCM_INUM(scm_modulo(obj, SCM_MAKINUM(n)));
+      default: return 263 % n;
+#ifdef SCM_FLOATS
+      case scm_tc16_flo:
+	if SCM_REALP(obj) {
+	  double r = SCM_REALPART(obj);
+	  if (floor(r)==r) {
+	    obj = scm_inexact_to_exact (obj);
+	    if SCM_IMP(obj) return SCM_INUM(obj) % n;
+	    goto bighash;
+	  }
+	}
+	obj = scm_number_to_string(obj, SCM_MAKINUM(10));
+#endif
+      }
+    case scm_tcs_symbols:
+    case scm_tc7_string:
+    case scm_tc7_mb_string:
+    case scm_tc7_substring:
+    case scm_tc7_mb_substring:
+      return scm_strhash(SCM_ROUCHARS(obj), (scm_sizet) SCM_ROLENGTH(obj), n);
+    case scm_tc7_wvect:
+    case scm_tc7_vector:
+      {
+	scm_sizet len = SCM_LENGTH(obj);
+	SCM *data = SCM_VELTS(obj);
+	if (len>5)
+	  {
+	    scm_sizet i = d/2;
+	    unsigned long h = 1;
+	    while (i--) h = ((h<<8) + (scm_hasher(data[h % len], n, 2))) % n;
+	    return h;
+	  }
+	else
+	  {
+	    scm_sizet i = len;
+	    unsigned long h = (n)-1;
+	    while (i--) h = ((h<<8) + (scm_hasher(data[i], n, d/len))) % n;
+	    return h;
+	  }
+      }
+    case scm_tcs_cons_imcar: case scm_tcs_cons_nimcar:
+      if (d) return (scm_hasher(SCM_CAR(obj), n, d/2)+scm_hasher(SCM_CDR(obj), n, d/2)) % n;
+      else return 1;
+    case scm_tc7_port:
+      return ((SCM_RDNG & SCM_CAR(obj)) ? 260 : 261) % n;
+    case scm_tcs_closures: case scm_tc7_contin: case scm_tcs_subrs:
+      return 262 % n;
+    }
+  }
+}
+
+
+
+
+#ifdef __STDC__
+unsigned int
+scm_ihashq (SCM obj, unsigned int n)
+#else
+unsigned int
+scm_ihashq (obj, n)
+     SCM obj;
+     unsigned int n;
+#endif
+{
+  return (((unsigned int) obj) >> 1) % n;
+}
+
+
+SCM_PROC(s_hashq, "hashq", 2, 0, 0, scm_hashq);
+#ifdef __STDC__
+SCM
+scm_hashq(SCM obj, SCM n)
+#else
+SCM
+scm_hashq(obj, n)
+     SCM obj;
+     SCM n;
+#endif
+{
+  SCM_ASSERT(SCM_INUMP(n) && 0 <= n, n, SCM_ARG2, s_hashq);
+  return SCM_MAKINUM(scm_ihashq (obj, SCM_INUM (n)));
+}
+
+
+
+
+#ifdef __STDC__
+unsigned int
+scm_ihashv (SCM obj, unsigned int n)
+#else
+unsigned int
+scm_ihashv (obj, n)
+     SCM obj;
+     unsigned int n;
+#endif
+{
+  if (SCM_ICHRP(obj))
+    return ((unsigned int)(scm_downcase(SCM_ICHR(obj)))) % n; /* downcase!?!! */
+
+  if (SCM_NIMP(obj) && SCM_NUMP(obj))
+    return (unsigned int) scm_hasher(obj, n, 10);
+  else
+    return ((unsigned int)obj) % n;
+}
+
+
+SCM_PROC(s_hashv, "hashv", 2, 0, 0, scm_hashv);
+#ifdef __STDC__
+SCM
+scm_hashv(SCM obj, SCM n)
+#else
+SCM
+scm_hashv(obj, n)
+     SCM obj;
+     SCM n;
+#endif
+{
+  SCM_ASSERT(SCM_INUMP(n) && 0 <= n, n, SCM_ARG2, s_hashv);
+  return SCM_MAKINUM(scm_ihashv (obj, SCM_INUM (n)));
+}
+
+
+
+
+#ifdef __STDC__
+unsigned int
+scm_ihash (SCM obj, unsigned int n)
+#else
+unsigned int
+scm_ihash (obj, n)
+     SCM obj;
+     unsigned int n;
+#endif
+{
+  return (unsigned int)scm_hasher (obj, n, 10);
+}
+
+SCM_PROC(s_hash, "hash", 2, 0, 0, scm_hash);
+#ifdef __STDC__
+SCM
+scm_hash(SCM obj, SCM n)
+#else
+SCM
+scm_hash(obj, n)
+     SCM obj;
+     SCM n;
+#endif
+{
+  SCM_ASSERT(SCM_INUMP(n) && 0 <= n, n, SCM_ARG2, s_hash);
+  return SCM_MAKINUM(scm_ihash(obj, SCM_INUM(n)));
+}
+
+
+
+
+#ifdef __STDC__
+void
+scm_init_hash (void)
+#else
+void
+scm_init_hash ()
+#endif
+{
+#include "hash.x"
+}
+
diff --git a/libguile/hash.h b/libguile/hash.h
new file mode 100644
index 000000000..8c53d3696
--- /dev/null
+++ b/libguile/hash.h
@@ -0,0 +1,77 @@
+/* classes: h_files */
+
+#ifndef HASHH
+#define HASHH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+
+
+#ifdef __STDC__
+extern unsigned long scm_hasher(SCM obj, unsigned long n, scm_sizet d);
+extern unsigned int scm_ihashq (SCM obj, unsigned int n);
+extern SCM scm_hashq(SCM obj, SCM n);
+extern unsigned int scm_ihashv (SCM obj, unsigned int n);
+extern SCM scm_hashv(SCM obj, SCM n);
+extern unsigned int scm_ihash (SCM obj, unsigned int n);
+extern SCM scm_hash(SCM obj, SCM n);
+extern void scm_init_hash (void);
+
+#else /* STDC */
+extern unsigned long scm_hasher();
+extern unsigned int scm_ihashq ();
+extern SCM scm_hashq();
+extern unsigned int scm_ihashv ();
+extern SCM scm_hashv();
+extern unsigned int scm_ihash ();
+extern SCM scm_hash();
+extern void scm_init_hash ();
+
+#endif /* STDC */
+
+
+
+
+
+
+#endif  /* HASHH */
diff --git a/libguile/hashtab.c b/libguile/hashtab.c
new file mode 100644
index 000000000..fd37e2574
--- /dev/null
+++ b/libguile/hashtab.c
@@ -0,0 +1,651 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+
+#ifdef __STDC__
+SCM
+scm_hash_fn_get_handle (SCM table, SCM obj, unsigned int (*hash_fn)(), SCM (*assoc_fn)(), void * closure)
+#else
+SCM
+scm_hash_fn_get_handle (table, obj, hash_fn, assoc_fn, closure)
+     SCM table;
+     SCM obj;
+     unsigned int (*hash_fn)();
+     SCM (*assoc_fn)();
+     void * closure;
+#endif
+{
+  int k;
+  SCM h;
+
+  SCM_ASSERT (SCM_NIMP (table) && SCM_VECTORP (table), table, SCM_ARG1, "hash_fn_get_handle");
+  if (SCM_LENGTH (table) == 0)
+    return SCM_EOL;
+  k = hash_fn (obj, SCM_LENGTH (table), closure);
+  SCM_ASSERT ((0 <= k) && (k < SCM_LENGTH (table)),
+	      SCM_MAKINUM (k),
+	      SCM_OUTOFRANGE,
+	      "hash_fn_get_handle");
+  h = assoc_fn (obj, SCM_VELTS (table)[k], closure);
+  return h;
+}
+
+
+#ifdef __STDC__
+SCM
+scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init, unsigned int (*hash_fn)(), SCM (*assoc_fn)(), void * closure)
+#else
+SCM
+scm_hash_fn_create_handle_x (table, obj, init, hash_fn, assoc_fn, closure)
+     SCM table;
+     SCM obj;
+     SCM init;
+     unsigned int (*hash_fn)();
+     SCM (*assoc_fn)();
+     void * closure;
+#endif
+{
+  int k;
+  SCM it;
+
+  SCM_ASSERT (SCM_NIMP (table) && SCM_VECTORP (table), table, SCM_ARG1, "hash_fn_create_handle_x");
+  if (SCM_LENGTH (table) == 0)
+    return SCM_EOL;
+  k = hash_fn (obj, SCM_LENGTH (table), closure);
+  SCM_ASSERT ((0 <= k) && (k < SCM_LENGTH (table)),
+	      SCM_MAKINUM (k),
+	      SCM_OUTOFRANGE,
+	      "hash_fn_create_handle_x");
+  SCM_REDEFER_INTS;
+  it = assoc_fn (obj, SCM_VELTS (table)[k], closure);
+  if (SCM_NIMP (it))
+    {
+      return it;
+    }
+  {
+    SCM new_bucket;
+    SCM old_bucket;
+    old_bucket = SCM_VELTS (table)[k];
+    new_bucket = scm_acons (obj, init, old_bucket);
+    SCM_VELTS(table)[k] = new_bucket;
+    SCM_REALLOW_INTS;
+    return SCM_CAR (new_bucket);
+  }
+}
+
+
+
+#ifdef __STDC__
+SCM 
+scm_hash_fn_ref (SCM table, SCM obj, SCM dflt, unsigned int (*hash_fn)(), SCM (*assoc_fn)(), void * closure)
+#else
+SCM 
+scm_hash_fn_ref (table, obj, dflt, hash_fn, assoc_fn, closure)
+     SCM table;
+     SCM obj;
+     SCM dflt;
+     unsigned int (*hash_fn)();
+     SCM (*assoc_fn)();
+     void * closure;
+#endif
+{
+  SCM it;
+
+  it = scm_hash_fn_get_handle (table, obj, hash_fn, assoc_fn, closure);
+  if (SCM_IMP (it))
+    return dflt;
+  else
+    return SCM_CDR (it);
+}
+
+
+
+#ifdef __STDC__
+SCM 
+scm_hash_fn_set_x (SCM table, SCM obj, SCM val, unsigned int (*hash_fn)(), SCM (*assoc_fn)(), void * closure)
+#else
+SCM 
+scm_hash_fn_set_x (table, obj, val, hash_fn, assoc_fn, closure)
+     SCM table;
+     SCM obj;
+     SCM val;
+     unsigned int (*hash_fn)();
+     SCM (*assoc_fn)();
+     void * closure;
+#endif
+{
+  SCM it;
+
+  it = scm_hash_fn_create_handle_x (table, obj, SCM_BOOL_F, hash_fn, assoc_fn, closure);
+  SCM_SETCDR (it, val);
+  return val;
+}
+
+
+
+
+#ifdef __STDC__
+SCM 
+scm_hash_fn_remove_x (SCM table,
+		      SCM obj,
+		      unsigned int (*hash_fn)(),
+		      SCM (*assoc_fn)(),
+		      SCM (*delete_fn)(),
+		      void * closure)
+#else
+SCM 
+scm_hash_fn_remove_x (table, obj, hash_fn, assoc_fn, delete_fn, closure)
+     SCM table;
+     SCM obj;
+     unsigned int (*hash_fn)();
+     SCM (*assoc_fn)();
+     SCM (*delete_fn)();
+     void * closure;
+#endif
+{
+  int k;
+  SCM h;
+
+  SCM_ASSERT (SCM_NIMP (table) && SCM_VECTORP (table), table, SCM_ARG1, "hash_fn_remove_x");
+  if (SCM_LENGTH (table) == 0)
+    return SCM_EOL;
+  k = hash_fn (obj, SCM_LENGTH (table), closure);
+  SCM_ASSERT ((0 <= k) && (k < SCM_LENGTH (table)),
+	      SCM_MAKINUM (k),
+	      SCM_OUTOFRANGE,
+	      "hash_fn_remove_x");
+  h = assoc_fn (obj, SCM_VELTS (table)[k], closure);
+  SCM_VELTS(table)[k] = delete_fn (h, SCM_VELTS(table)[k]);
+  return h;
+}
+
+
+
+
+SCM_PROC (s_hashq_get_handle, "hashq-get-handle", 2, 0, 0, scm_hashq_get_handle);
+#ifdef __STDC__
+SCM
+scm_hashq_get_handle (SCM table, SCM obj)
+#else
+SCM
+scm_hashq_get_handle (table, obj)
+     SCM table;
+     SCM obj;
+#endif
+{
+  return scm_hash_fn_get_handle (table, obj, scm_ihashq, scm_sloppy_assq, 0);
+}
+
+
+SCM_PROC (s_hashq_create_handle_x, "hashq-create-handle!", 3, 0, 0, scm_hashq_create_handle_x);
+#ifdef __STDC__
+SCM
+scm_hashq_create_handle_x (SCM table, SCM obj, SCM init)
+#else
+SCM
+scm_hashq_create_handle_x (table, obj, init)
+     SCM table;
+     SCM obj;
+     SCM init;
+#endif
+{
+  return scm_hash_fn_create_handle_x (table, obj, init, scm_ihashq, scm_sloppy_assq, 0);
+}
+
+
+SCM_PROC (s_hashq_ref, "hashq-ref", 2, 1, 0, scm_hashq_ref);
+#ifdef __STDC__
+SCM 
+scm_hashq_ref (SCM table, SCM obj, SCM dflt)
+#else
+SCM 
+scm_hashq_ref (table, obj, dflt)
+     SCM table;
+     SCM obj;
+     SCM dflt;
+#endif
+{
+  if (dflt == SCM_UNDEFINED)
+    dflt = SCM_BOOL_F;
+  return scm_hash_fn_ref (table, obj, dflt, scm_ihashq, scm_sloppy_assq, 0);
+}
+
+
+
+SCM_PROC (s_hashq_set_x, "hashq-set!", 3, 0, 0, scm_hashq_set_x);
+#ifdef __STDC__
+SCM 
+scm_hashq_set_x (SCM table, SCM obj, SCM val)
+#else
+SCM 
+scm_hashq_set_x (table, obj, val)
+     SCM table;
+     SCM obj;
+     SCM val;
+#endif
+{
+  return scm_hash_fn_set_x (table, obj, val, scm_ihashq, scm_sloppy_assq, 0);
+}
+
+
+
+SCM_PROC (s_hashq_remove_x, "hashq-remove!", 2, 0, 0, scm_hashq_remove_x);
+#ifdef __STDC__
+SCM
+scm_hashq_remove_x (SCM table, SCM obj)
+#else
+SCM
+scm_hashq_remove_x (table, obj)
+     SCM table;
+     SCM obj;
+#endif
+{
+  return scm_hash_fn_remove_x (table, obj, scm_ihashq, scm_sloppy_assq, scm_delq_x, 0);
+}
+
+
+
+
+SCM_PROC (s_hashv_get_handle, "hashv-get-handle", 2, 0, 0, scm_hashv_get_handle);
+#ifdef __STDC__
+SCM
+scm_hashv_get_handle (SCM table, SCM obj)
+#else
+SCM
+scm_hashv_get_handle (table, obj)
+     SCM table;
+     SCM obj;
+#endif
+{
+  return scm_hash_fn_get_handle (table, obj, scm_ihashv, scm_sloppy_assv, 0);
+}
+
+
+SCM_PROC (s_hashv_create_handle_x, "hashv-create-handle!", 3, 0, 0, scm_hashv_create_handle_x);
+#ifdef __STDC__
+SCM
+scm_hashv_create_handle_x (SCM table, SCM obj, SCM init)
+#else
+SCM
+scm_hashv_create_handle_x (table, obj, init)
+     SCM table;
+     SCM obj;
+     SCM init;
+#endif
+{
+  return scm_hash_fn_create_handle_x (table, obj, init, scm_ihashv, scm_sloppy_assv, 0);
+}
+
+
+SCM_PROC (s_hashv_ref, "hashv-ref", 2, 1, 0, scm_hashv_ref);
+#ifdef __STDC__
+SCM 
+scm_hashv_ref (SCM table, SCM obj, SCM dflt)
+#else
+SCM 
+scm_hashv_ref (table, obj, dflt)
+     SCM table;
+     SCM obj;
+     SCM dflt;
+#endif
+{
+  if (dflt == SCM_UNDEFINED)
+    dflt = SCM_BOOL_F;
+  return scm_hash_fn_ref (table, obj, dflt, scm_ihashv, scm_sloppy_assv, 0);
+}
+
+
+
+SCM_PROC (s_hashv_set_x, "hashv-set!", 3, 0, 0, scm_hashv_set_x);
+#ifdef __STDC__
+SCM 
+scm_hashv_set_x (SCM table, SCM obj, SCM val)
+#else
+SCM 
+scm_hashv_set_x (table, obj, val)
+     SCM table;
+     SCM obj;
+     SCM val;
+#endif
+{
+  return scm_hash_fn_set_x (table, obj, val, scm_ihashv, scm_sloppy_assv, 0);
+}
+
+
+SCM_PROC (s_hashv_remove_x, "hashv-remove!", 2, 0, 0, scm_hashv_remove_x);
+#ifdef __STDC__
+SCM
+scm_hashv_remove_x (SCM table, SCM obj)
+#else
+SCM
+scm_hashv_remove_x (table, obj)
+     SCM table;
+     SCM obj;
+#endif
+{
+  return scm_hash_fn_remove_x (table, obj, scm_ihashv, scm_sloppy_assv, scm_delv_x, 0);
+}
+
+
+
+SCM_PROC (s_hash_get_handle, "hash-get-handle", 2, 0, 0, scm_hash_get_handle);
+#ifdef __STDC__
+SCM
+scm_hash_get_handle (SCM table, SCM obj)
+#else
+SCM
+scm_hash_get_handle (table, obj)
+     SCM table;
+     SCM obj;
+#endif
+{
+  return scm_hash_fn_get_handle (table, obj, scm_ihash, scm_sloppy_assoc, 0);
+}
+
+
+SCM_PROC (s_hash_create_handle_x, "hash-create-handle!", 3, 0, 0, scm_hash_create_handle_x);
+#ifdef __STDC__
+SCM
+scm_hash_create_handle_x (SCM table, SCM obj, SCM init)
+#else
+SCM
+scm_hash_create_handle_x (table, obj, init)
+     SCM table;
+     SCM obj;
+     SCM init;
+#endif
+{
+  return scm_hash_fn_create_handle_x (table, obj, init, scm_ihash, scm_sloppy_assoc, 0);
+}
+
+
+SCM_PROC (s_hash_ref, "hash-ref", 2, 1, 0, scm_hash_ref);
+#ifdef __STDC__
+SCM 
+scm_hash_ref (SCM table, SCM obj, SCM dflt)
+#else
+SCM 
+scm_hash_ref (table, obj, dflt)
+     SCM table;
+     SCM obj;
+     SCM dflt;
+#endif
+{
+  if (dflt == SCM_UNDEFINED)
+    dflt = SCM_BOOL_F;
+  return scm_hash_fn_ref (table, obj, dflt, scm_ihash, scm_sloppy_assoc, 0);
+}
+
+
+
+SCM_PROC (s_hash_set_x, "hash-set!", 3, 0, 0, scm_hash_set_x);
+#ifdef __STDC__
+SCM 
+scm_hash_set_x (SCM table, SCM obj, SCM val)
+#else
+SCM 
+scm_hash_set_x (table, obj, val)
+     SCM table;
+     SCM obj;
+     SCM val;
+#endif
+{
+  return scm_hash_fn_set_x (table, obj, val, scm_ihash, scm_sloppy_assoc, 0);
+}
+
+
+
+SCM_PROC (s_hash_remove_x, "hash-remove!", 2, 0, 0, scm_hash_remove_x);
+#ifdef __STDC__
+SCM
+scm_hash_remove_x (SCM table, SCM obj)
+#else
+SCM
+scm_hash_remove_x (table, obj)
+     SCM table;
+     SCM obj;
+#endif
+{
+  return scm_hash_fn_remove_x (table, obj, scm_ihash, scm_sloppy_assoc, scm_delete_x, 0);
+}
+
+
+
+
+struct scm_ihashx_closure
+{
+  SCM hash;
+  SCM assoc;
+  SCM delete;
+};
+
+
+#ifdef __STDC__
+static unsigned int
+scm_ihashx (SCM obj, unsigned int n, struct scm_ihashx_closure * closure)
+#else
+static unsigned int
+scm_ihashx (obj, n, closure)
+     SCM obj;
+     unsigned int n;
+     struct scm_ihashx_closure * closure;
+#endif
+{
+  SCM answer;
+  SCM_ALLOW_INTS;
+  answer = scm_apply (closure->hash,
+		      scm_listify (obj, scm_ulong2num ((unsigned long)n), SCM_UNDEFINED),
+		      SCM_EOL);
+  SCM_DEFER_INTS;
+  return SCM_INUM (answer);
+}
+
+
+#ifdef __STDC__
+static SCM
+scm_sloppy_assx (SCM obj, SCM alist, struct scm_ihashx_closure * closure)
+#else
+static SCM
+scm_sloppy_assx (obj, alist, closure)
+     SCM obj;
+     SCM alist;
+     struct scm_ihashx_closure * closure;
+#endif
+{
+  SCM answer;
+  SCM_ALLOW_INTS;
+  answer = scm_apply (closure->assoc,
+		      scm_listify (obj, alist, SCM_UNDEFINED),
+		      SCM_EOL);
+  SCM_DEFER_INTS;
+  return answer;
+}
+
+
+
+#ifdef __STDC__
+static SCM
+scm_delx_x (SCM obj, SCM alist, struct scm_ihashx_closure * closure)
+#else
+static SCM
+scm_delx_x (obj, alist, closure)
+     SCM obj;
+     SCM alist;
+     struct scm_ihashx_closure * closure;
+#endif
+{
+  SCM answer;
+  SCM_ALLOW_INTS;
+  answer = scm_apply (closure->delete,
+		      scm_listify (obj, alist, SCM_UNDEFINED),
+		      SCM_EOL);
+  SCM_DEFER_INTS;
+  return answer;
+}
+
+
+
+SCM_PROC (s_hashx_get_handle, "hashx-get-handle", 4, 0, 0, scm_hashx_get_handle);
+#ifdef __STDC__
+SCM
+scm_hashx_get_handle (SCM hash, SCM assoc, SCM table, SCM obj)
+#else
+SCM
+scm_hashx_get_handle (hash, assoc, table, obj)
+     SCM hash;
+     SCM assoc;
+     SCM table;
+     SCM obj;
+#endif
+{
+  struct scm_ihashx_closure closure;
+  closure.hash = hash;
+  closure.assoc = assoc;
+  return scm_hash_fn_get_handle (table, obj, scm_ihashx, scm_sloppy_assx, (void *)&closure);
+}
+
+
+SCM_PROC (s_hashx_create_handle_x, "hashx-create-handle!", 5, 0, 0, scm_hashx_create_handle_x);
+#ifdef __STDC__
+SCM
+scm_hashx_create_handle_x (SCM hash, SCM assoc, SCM table, SCM obj, SCM init)
+#else
+SCM
+scm_hashx_create_handle_x (hash, assoc, table, obj, init)
+     SCM hash;
+     SCM assoc;
+     SCM table;
+     SCM obj;
+     SCM init;
+#endif
+{
+  struct scm_ihashx_closure closure;
+  closure.hash = hash;
+  closure.assoc = assoc;
+  return scm_hash_fn_create_handle_x (table, obj, init, scm_ihashx, scm_sloppy_assx, (void *)&closure);
+}
+
+
+
+SCM_PROC (s_hashx_ref, "hashx-ref", 4, 1, 0, scm_hashx_ref);
+#ifdef __STDC__
+SCM 
+scm_hashx_ref (SCM hash, SCM assoc, SCM table, SCM obj, SCM dflt)
+#else
+SCM 
+scm_hashx_ref (hash, assoc, table, obj, dflt)
+     SCM hash;
+     SCM assoc;
+     SCM table;
+     SCM obj;
+     SCM dflt;
+#endif
+{
+  struct scm_ihashx_closure closure;
+  if (dflt == SCM_UNDEFINED)
+    dflt = SCM_BOOL_F;
+  closure.hash = hash;
+  closure.assoc = assoc;
+  return scm_hash_fn_ref (table, obj, dflt, scm_ihashx, scm_sloppy_assx, (void *)&closure);
+}
+
+
+
+
+SCM_PROC (s_hashx_set_x, "hashx-set!", 5, 0, 0, scm_hashx_set_x);
+#ifdef __STDC__
+SCM 
+scm_hashx_set_x (SCM hash, SCM assoc, SCM table, SCM obj, SCM val)
+#else
+SCM 
+scm_hashx_set_x (hash, assoc, table, obj, val)
+     SCM hash;
+     SCM assoc;
+     SCM table;
+     SCM obj;
+     SCM val;
+#endif
+{
+  struct scm_ihashx_closure closure;
+  closure.hash = hash;
+  closure.assoc = assoc;
+  return scm_hash_fn_set_x (table, obj, val, scm_ihashx, scm_sloppy_assx, (void *)&closure);
+}
+
+
+#ifdef __STDC__
+SCM
+scm_hashx_remove_x (SCM hash, SCM assoc, SCM delete, SCM table, SCM obj)
+#else
+SCM
+scm_hashx_remove_x (hash, assoc, delete, table, obj)
+     SCM hash;
+     SCM assoc;
+     SCM delete;
+     SCM table;
+     SCM obj;
+#endif
+{
+  struct scm_ihashx_closure closure;
+  closure.hash = hash;
+  closure.assoc = assoc;
+  closure.delete = delete;
+  return scm_hash_fn_remove_x (table, obj, scm_ihashx, scm_sloppy_assx, scm_delx_x, 0);
+}
+
+
+
+#ifdef __STDC__
+void
+scm_init_hashtab (void)
+#else
+void
+scm_init_hashtab ()
+#endif
+{
+#include "hashtab.x"
+}
+
diff --git a/libguile/hashtab.h b/libguile/hashtab.h
new file mode 100644
index 000000000..345303896
--- /dev/null
+++ b/libguile/hashtab.h
@@ -0,0 +1,118 @@
+/* classes: h_files */
+
+#ifndef HASHTABH
+#define HASHTABH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+
+
+#ifdef __STDC__
+extern SCM scm_hash_fn_get_handle (SCM table, SCM obj, unsigned int (*hash_fn)(), SCM (*assoc_fn)(), void * closure);
+extern SCM scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init, unsigned int (*hash_fn)(), SCM (*assoc_fn)(), void * closure);
+extern SCM scm_hash_fn_ref (SCM table, SCM obj, SCM dflt, unsigned int (*hash_fn)(), SCM (*assoc_fn)(), void * closure);
+extern SCM scm_hash_fn_set_x (SCM table, SCM obj, SCM val, unsigned int (*hash_fn)(), SCM (*assoc_fn)(), void * closure);
+extern SCM scm_hash_fn_remove_x (SCM table,
+				 SCM obj,
+				 unsigned int (*hash_fn)(),
+				 SCM (*assoc_fn)(),
+				 SCM (*delete_fn)(),
+				 void * closure);
+extern SCM scm_hashq_get_handle (SCM table, SCM obj);
+extern SCM scm_hashq_create_handle_x (SCM table, SCM obj, SCM init);
+extern SCM scm_hashq_ref (SCM table, SCM obj, SCM dflt);
+extern SCM scm_hashq_set_x (SCM table, SCM obj, SCM val);
+extern SCM scm_hashq_remove_x (SCM table, SCM obj);
+extern SCM scm_hashv_get_handle (SCM table, SCM obj);
+extern SCM scm_hashv_create_handle_x (SCM table, SCM obj, SCM init);
+extern SCM scm_hashv_ref (SCM table, SCM obj, SCM dflt);
+extern SCM scm_hashv_set_x (SCM table, SCM obj, SCM val);
+extern SCM scm_hashv_remove_x (SCM table, SCM obj);
+extern SCM scm_hash_get_handle (SCM table, SCM obj);
+extern SCM scm_hash_create_handle_x (SCM table, SCM obj, SCM init);
+extern SCM scm_hash_ref (SCM table, SCM obj, SCM dflt);
+extern SCM scm_hash_set_x (SCM table, SCM obj, SCM val);
+extern SCM scm_hash_remove_x (SCM table, SCM obj);
+extern SCM scm_hashx_get_handle (SCM hash, SCM assoc, SCM table, SCM obj);
+extern SCM scm_hashx_create_handle_x (SCM hash, SCM assoc, SCM table, SCM obj, SCM init);
+extern SCM scm_hashx_ref (SCM hash, SCM assoc, SCM table, SCM obj, SCM dflt);
+extern SCM scm_hashx_set_x (SCM hash, SCM assoc, SCM table, SCM obj, SCM val);
+extern SCM scm_hashx_remove_x (SCM hash, SCM assoc, SCM delete, SCM table, SCM obj);
+extern void scm_init_hashtab (void);
+
+#else /* STDC */
+extern SCM scm_hash_fn_get_handle ();
+extern SCM scm_hash_fn_create_handle_x ();
+extern SCM scm_hash_fn_ref ();
+extern SCM scm_hash_fn_set_x ();
+extern SCM scm_hash_fn_remove_x ();
+extern SCM scm_hashq_get_handle ();
+extern SCM scm_hashq_create_handle_x ();
+extern SCM scm_hashq_ref ();
+extern SCM scm_hashq_set_x ();
+extern SCM scm_hashq_remove_x ();
+extern SCM scm_hashv_get_handle ();
+extern SCM scm_hashv_create_handle_x ();
+extern SCM scm_hashv_ref ();
+extern SCM scm_hashv_set_x ();
+extern SCM scm_hashv_remove_x ();
+extern SCM scm_hash_get_handle ();
+extern SCM scm_hash_create_handle_x ();
+extern SCM scm_hash_ref ();
+extern SCM scm_hash_set_x ();
+extern SCM scm_hash_remove_x ();
+extern SCM scm_hashx_get_handle ();
+extern SCM scm_hashx_create_handle_x ();
+extern SCM scm_hashx_ref ();
+extern SCM scm_hashx_set_x ();
+extern SCM scm_hashx_remove_x ();
+extern void scm_init_hashtab ();
+
+#endif /* STDC */
+
+
+
+
+
+
+
+#endif  /* HASHTABH */
diff --git a/libguile/inet_aton.c b/libguile/inet_aton.c
new file mode 100644
index 000000000..f7ca832f7
--- /dev/null
+++ b/libguile/inet_aton.c
@@ -0,0 +1,157 @@
+/*
+ * Copyright (c) 1983, 1990, 1993
+ *	The Regents of the University of California.  All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ *    notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *    notice, this list of conditions and the following disclaimer in the
+ *    documentation and/or other materials provided with the distribution.
+ * 3. All advertising materials mentioning features or use of this software
+ *    must display the following acknowledgement:
+ *	This product includes software developed by the University of
+ *	California, Berkeley and its contributors.
+ * 4. Neither the name of the University nor the names of its contributors
+ *    may be used to endorse or promote products derived from this software
+ *    without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ */
+
+#if defined(LIBC_SCCS) && !defined(lint)
+static char sccsid[] = "@(#)inet_addr.c	8.1 (Berkeley) 6/17/93";
+#endif /* LIBC_SCCS and not lint */
+
+#include <ctype.h>
+
+#include <sys/param.h>
+#include <netinet/in.h>
+#include <arpa/inet.h>
+
+#ifdef 0
+
+/*
+ * Ascii internet address interpretation routine.
+ * The value returned is in network order.
+ */
+u_long
+inet_addr(cp)
+	register const char *cp;
+{
+	struct in_addr val;
+
+	if (inet_aton(cp, &val))
+		return (val.s_addr);
+	return (INADDR_NONE);
+}
+
+#endif
+
+/* 
+ * Check whether "cp" is a valid ascii representation
+ * of an Internet address and convert to a binary address.
+ * Returns 1 if the address is valid, 0 if not.
+ * This replaces inet_addr, the return value from which
+ * cannot distinguish between failure and a local broadcast address.
+ */
+int
+inet_aton(cp, addr)
+	register const char *cp;
+	struct in_addr *addr;
+{
+	register unsigned long val;
+	register int base, n;
+	register char c;
+	unsigned int parts[4];
+	register unsigned int *pp = parts;
+
+	for (;;) {
+		/*
+		 * Collect number up to ``.''.
+		 * Values are specified as for C:
+		 * 0x=hex, 0=octal, other=decimal.
+		 */
+		val = 0; base = 10;
+		if (*cp == '0') {
+			if (*++cp == 'x' || *cp == 'X')
+				base = 16, cp++;
+			else
+				base = 8;
+		}
+		while ((c = *cp) != '\0') {
+			if (isascii(c) && isdigit(c)) {
+				val = (val * base) + (c - '0');
+				cp++;
+				continue;
+			}
+			if (base == 16 && isascii(c) && isxdigit(c)) {
+				val = (val << 4) + 
+					(c + 10 - (islower(c) ? 'a' : 'A'));
+				cp++;
+				continue;
+			}
+			break;
+		}
+		if (*cp == '.') {
+			/*
+			 * Internet format:
+			 *	a.b.c.d
+			 *	a.b.c	(with c treated as 16-bits)
+			 *	a.b	(with b treated as 24 bits)
+			 */
+			if (pp >= parts + 3 || val > 0xff)
+				return (0);
+			*pp++ = val, cp++;
+		} else
+			break;
+	}
+	/*
+	 * Check for trailing characters.
+	 */
+	if (*cp && (!isascii(*cp) || !isspace(*cp)))
+		return (0);
+	/*
+	 * Concoct the address according to
+	 * the number of parts specified.
+	 */
+	n = pp - parts + 1;
+	switch (n) {
+
+	case 1:				/* a -- 32 bits */
+		break;
+
+	case 2:				/* a.b -- 8.24 bits */
+		if (val > 0xffffff)
+			return (0);
+		val |= parts[0] << 24;
+		break;
+
+	case 3:				/* a.b.c -- 8.8.16 bits */
+		if (val > 0xffff)
+			return (0);
+		val |= (parts[0] << 24) | (parts[1] << 16);
+		break;
+
+	case 4:				/* a.b.c.d -- 8.8.8.8 bits */
+		if (val > 0xff)
+			return (0);
+		val |= (parts[0] << 24) | (parts[1] << 16) | (parts[2] << 8);
+		break;
+	}
+	if (addr)
+		addr->s_addr = htonl(val);
+	return (1);
+}
diff --git a/libguile/init.c b/libguile/init.c
new file mode 100644
index 000000000..2f65c15f6
--- /dev/null
+++ b/libguile/init.c
@@ -0,0 +1,453 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+
+#ifdef __STDC__
+void
+scm_start_stack (void * base, FILE * in, FILE * out, FILE * err)
+#else
+void
+scm_start_stack (base, in, out, err)
+     void * base;
+     FILE * in;
+     FILE * out;
+     FILE * err;
+#endif
+{
+  struct scm_port_table * pt;
+
+  scm_stack_base = base;
+
+  /* Create standar ports from stdio files, if requested to do so.
+   */
+
+  if (!in)
+    {
+      scm_def_inp = SCM_BOOL_F;
+    }
+  else
+    {
+      SCM_NEWCELL (scm_def_inp);
+      pt = scm_add_to_port_table (scm_def_inp);
+      SCM_CAR (scm_def_inp) = (scm_tc16_fport | SCM_OPN | SCM_RDNG);
+      SCM_SETPTAB_ENTRY (scm_def_inp, pt);
+      SCM_SETSTREAM (scm_def_inp, (SCM)in);
+      if (isatty (fileno (in)))
+	{
+	  scm_setbuf0 (scm_def_inp); /* turn off stdin buffering */
+	  SCM_CAR (scm_def_inp) |= SCM_BUF0;
+	}
+      scm_set_port_revealed_x (scm_def_inp, SCM_MAKINUM (1));
+    }
+
+  if (!out)
+    {
+      scm_def_outp = SCM_BOOL_F;
+    }
+  else
+    {
+      SCM_NEWCELL (scm_def_outp);
+      pt = scm_add_to_port_table (scm_def_outp);
+      SCM_CAR (scm_def_outp) = (scm_tc16_fport | SCM_OPN | SCM_WRTNG);
+      SCM_SETPTAB_ENTRY (scm_def_outp, pt);
+      SCM_SETSTREAM (scm_def_outp, (SCM)out);
+      scm_set_port_revealed_x (scm_def_outp, SCM_MAKINUM (1));
+    }
+
+  if (!err)
+    {
+      scm_def_errp = SCM_BOOL_F;
+    }
+  else
+    {
+      SCM_NEWCELL (scm_def_errp);
+      pt = scm_add_to_port_table (scm_def_errp);
+      SCM_CAR (scm_def_errp) = (scm_tc16_fport | SCM_OPN | SCM_WRTNG);
+      SCM_SETPTAB_ENTRY (scm_def_errp, pt);
+      SCM_SETSTREAM (scm_def_errp, (SCM)err);
+      scm_set_port_revealed_x (scm_def_errp, SCM_MAKINUM (1));
+    }
+
+  scm_cur_inp = scm_def_inp;
+  scm_cur_outp = scm_def_outp;
+  scm_cur_errp = scm_def_errp;
+
+
+  scm_progargs = SCM_BOOL_F;	/* vestigial */
+  scm_exitval = SCM_BOOL_F;	/* vestigial */
+
+  scm_top_level_lookup_thunk_var = SCM_BOOL_F;
+  scm_system_transformer = SCM_BOOL_F;
+
+  /* Create an object to hold the root continuation.
+   */
+  SCM_NEWCELL (scm_rootcont);
+  SCM_SETJMPBUF (scm_rootcont, scm_must_malloc ((long) sizeof (regs), "continuation"));
+  SCM_CAR (scm_rootcont) = scm_tc7_contin;
+  /* The root continuation if further initialized by scm_restart_stack. */
+
+  /* Create the look-aside stack for variables that are shared between
+   * captured continuations.
+   */
+  scm_continuation_stack = scm_make_vector (SCM_MAKINUM (512), SCM_UNDEFINED, SCM_UNDEFINED);
+  /* The continuation stack is further initialized by scm_restart_stack. */
+
+  /* The remainder of stack initialization is factored out to another function so that
+   * if this stack is ever exitted, it can be re-entered using scm_restart_stack.
+   */
+  scm_restart_stack (base);
+}
+
+
+#ifdef __STDC__
+void
+scm_restart_stack (void * base)
+#else
+void
+scm_restart_stack (base)
+     void * base;
+#endif
+{
+  scm_dynwinds = SCM_EOL;
+  SCM_DYNENV (scm_rootcont) = SCM_EOL;
+  SCM_THROW_VALUE (scm_rootcont) = SCM_EOL;
+  SCM_BASE (scm_rootcont) = base;
+  scm_continuation_stack_ptr = SCM_MAKINUM (0);
+}
+
+#if 0
+static char remsg[] = "remove\n#define ", addmsg[] = "add\n#define ";
+
+#ifdef __STDC__
+static void 
+fixconfig (char *s1, char *s2, int s)
+#else
+static void 
+fixconfig (s1, s2, s)
+     char *s1;
+     char *s2;
+     int s;
+#endif
+{
+  fputs (s1, stderr);
+  fputs (s2, stderr);
+  fputs ("\nin ", stderr);
+  fputs (s ? "setjump" : "scmfig", stderr);
+  fputs (".h and recompile scm\n", stderr);
+  exit (1);
+}
+
+
+
+static void
+check_config ()
+{
+  scm_sizet j;
+
+  j = HEAP_SEG_SIZE;
+  if (HEAP_SEG_SIZE != j)
+    fixconfig ("reduce", "size of HEAP_SEG_SIZE", 0);
+
+#ifdef SCM_SINGLES
+  if (sizeof (float) != sizeof (long))
+      fixconfig (remsg, "SCM_SINGLES", 0);
+#endif /* def SCM_SINGLES */
+
+
+#ifdef SCM_BIGDIG
+  if (2 * SCM_BITSPERDIG / SCM_CHAR_BIT > sizeof (long))
+      fixconfig (remsg, "SCM_BIGDIG", 0);
+#ifndef SCM_DIGSTOOBIG
+  if (SCM_DIGSPERLONG * sizeof (SCM_BIGDIG) > sizeof (long))
+      fixconfig (addmsg, "SCM_DIGSTOOBIG", 0);
+#endif
+#endif
+
+#ifdef SCM_STACK_GROWS_UP
+  if (((SCM_STACKITEM *) & j - stack_start_ptr) < 0)
+    fixconfig (remsg, "SCM_STACK_GROWS_UP", 1);
+#else
+  if ((stack_start_ptr - (SCM_STACKITEM *) & j) < 0)
+    fixconfig (addmsg, "SCM_STACK_GROWS_UP", 1);
+#endif
+}
+#endif
+
+
+
+#ifdef _UNICOS
+typedef int setjmp_type;
+#else
+typedef long setjmp_type;
+#endif
+
+/* Fire up Scheme.
+ *
+ * argc and argv are made the return values of program-arguments.
+ *
+ * in, out, and err, if not NULL, become the standard ports.
+ *	If NULL is passed, your "scm_appinit" should set up the 
+ *      standard ports.
+ *
+ * boot_cmd is a string containing a Scheme expression to evaluate
+ *      to get things rolling.
+ *
+ * result is returned a string containing a printed result of evaluating
+ * 	the boot command.   
+ *
+ * the return value is:
+ *	scm_boot_ok       - evaluation concluded normally
+ *	scm_boot_error    - evaluation concluded with a Scheme error
+ *	scm_boot_emem     - allocation error mallocing *result
+ *	scm_boot_ereenter - scm_boot_guile was called re-entrantly, which is prohibited.
+ */
+
+#ifdef __STDC__
+int
+scm_boot_guile (char ** result, int argc, char ** argv, FILE * in, FILE * out, FILE * err, char * boot_cmd)
+#else
+int
+scm_boot_guile (result, argc, argv, in, out, err, boot_cmd)
+     char ** result;
+     int argc;
+     char ** argv;
+     FILE * in;
+     FILE * out;
+     FILE * err;
+     char * boot_cmd;
+#endif
+{
+  static int initialized = 0;
+  static int live = 0;
+  SCM_STACKITEM i;
+  setjmp_type setjmp_val;
+  int stat;
+
+  if (live)			/* This function is not re-entrant. */
+    {
+      return scm_boot_ereenter;
+    }
+
+  live = 1;
+
+  scm_ints_disabled = 1;
+  scm_block_gc = 1;
+  
+  if (initialized)
+    {
+      scm_restart_stack (&i);
+    }
+  else
+    {
+      scm_ports_prehistory ();
+      scm_smob_prehistory ();
+      scm_tables_prehistory ();
+      scm_init_storage (0);
+      scm_start_stack (&i, in, out, err);
+      scm_init_gsubr ();
+      scm_init_feature ();
+      scm_init_alist ();
+      scm_init_append ();
+      scm_init_arbiters ();
+      scm_init_async ();
+      scm_init_boolean ();
+      scm_init_chars ();
+      scm_init_continuations ();
+      scm_init_dynwind ();
+      scm_init_eq ();
+      scm_init_error ();
+      scm_init_fdsocket ();
+      scm_init_fports ();
+      scm_init_files ();
+      scm_init_filesys ();
+      scm_init_gc ();
+      scm_init_hash ();
+      scm_init_hashtab ();
+      scm_init_ioext ();
+      scm_init_kw ();
+      scm_init_list ();
+      scm_init_mallocs ();
+      scm_init_numbers ();
+      scm_init_objprop ();
+      scm_init_pairs ();
+      scm_init_ports ();
+      scm_init_posix ();
+      scm_init_procs ();
+      scm_init_procprop ();
+      scm_init_rgx ();
+      scm_init_scmsigs ();
+      scm_init_socket ();
+      scm_init_stackchk ();
+      scm_init_strports ();
+      scm_init_struct ();
+      scm_init_symbols ();
+      scm_init_tag ();
+      scm_init_load ();
+      scm_init_print ();
+      scm_init_read ();
+      scm_init_sequences ();
+      scm_init_stime ();
+      scm_init_strings ();
+      scm_init_strorder ();
+      scm_init_mbstrings ();
+      scm_init_strop ();
+      scm_init_throw ();
+      scm_init_variable ();
+      scm_init_vectors ();
+      scm_init_weaks ();
+      scm_init_vports ();
+      scm_init_eval ();
+      scm_init_ramap ();
+      scm_init_unif ();
+      scm_init_simpos ();
+      scm_appinit ();
+      scm_progargs = scm_makfromstrs (argc, argv);
+      initialized = 1;
+    }
+
+  scm_block_gc = 0;		/* permit the gc to run */
+  /* ints still disabled */
+
+  {
+    SCM command;
+
+    command = scm_makfrom0str (boot_cmd);
+
+    setjmp_val = setjmp (SCM_JMPBUF (scm_rootcont));
+
+    if (!setjmp_val)
+      {
+	SCM last;
+	scm_init_signals ();
+
+	{
+	  SCM p;
+	  SCM form;
+
+	  p = scm_mkstrport (SCM_MAKINUM (0),
+			     command,
+			     SCM_OPN | SCM_RDNG,
+			     "boot_guile");
+	  while (1)
+	    {
+	      form = scm_read (p, SCM_BOOL_F, SCM_BOOL_F);
+	      if (SCM_EOF_VAL == form)
+		break;
+	      last = scm_eval_x (form);
+	    }
+
+	}
+
+	scm_restore_signals ();
+	/* This tick gives any pending
+	 * asyncs a chance to run.  This must be done after
+	 * the call to scm_restore_signals.
+	 */
+	SCM_ASYNC_TICK;
+
+	scm_ints_disabled = 1;	/* Hopefully redundant but just to be sure. */
+
+	{
+	  SCM str_answer;
+
+	  str_answer = scm_strprint_obj (last);
+	  *result = (char *)malloc (1 + SCM_LENGTH (str_answer));
+	  if (!*result)
+	    stat = scm_boot_emem;
+	  else
+	    {
+	      memcpy (*result, SCM_CHARS (str_answer), SCM_LENGTH (str_answer));
+	      (*result)[SCM_LENGTH (str_answer)] = 0;
+	      stat = scm_boot_ok;
+	    }
+	}
+      }
+    else
+      {
+	/* This is reached if an unhandled throw terminated Scheme.
+	 * Such an occurence should be extremely unlikely -- it indicates
+	 * a programming error in the boot code.
+	 *
+	 * Details of the bogus exception are stored in scm_exitval even 
+	 * though that isn't currently reflected in the return value.
+	 * !!!
+	 */
+
+	scm_restore_signals ();
+	/* This tick gives any pending
+	 * asyncs a chance to run.  This must be done after
+	 * the call to scm_restore_signals.
+	 *
+	 * Note that an unhandled exception during signal handling
+	 * will put as back at the call to scm_restore_signals immediately
+	 * preceeding.   A sufficiently bogus signal handler could
+	 * conceivably cause an infinite loop here.
+	 */
+	SCM_ASYNC_TICK;
+
+	scm_ints_disabled = 1;	/* Hopefully redundant but just to be sure. */
+
+	{
+	  SCM str_answer;
+
+	  str_answer = scm_strprint_obj (scm_exitval);
+	  *result = (char *)malloc (1 + SCM_LENGTH (str_answer));
+	  if (!*result)
+	    stat = scm_boot_emem;
+	  else
+	    {
+	      memcpy (*result, SCM_CHARS (str_answer), SCM_LENGTH (str_answer));
+	      (*result)[SCM_LENGTH (str_answer)] = 0;
+	      stat = scm_boot_error;
+	    }
+	}
+      }
+  }
+
+  scm_block_gc = 1;
+  live = 0;
+  return stat;
+}
diff --git a/libguile/init.h b/libguile/init.h
new file mode 100644
index 000000000..a20262104
--- /dev/null
+++ b/libguile/init.h
@@ -0,0 +1,75 @@
+/* classes: h_files */
+
+#ifndef INITH
+#define INITH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+
+
+
+enum scm_boot_status
+{
+  scm_boot_ok = 0,
+  scm_boot_error,
+  scm_boot_emem,
+  scm_boot_ereenter
+};
+
+
+
+#ifdef __STDC__
+extern void scm_start_stack (void * base, FILE * in, FILE * out, FILE * err);
+extern void scm_restart_stack (void * base);
+
+#else /* STDC */
+extern void scm_start_stack ();
+extern void scm_restart_stack ();
+
+#endif /* STDC */
+
+
+
+
+
+#endif  /* INITH */
diff --git a/libguile/ioext.c b/libguile/ioext.c
new file mode 100644
index 000000000..d51b9a09d
--- /dev/null
+++ b/libguile/ioext.c
@@ -0,0 +1,535 @@
+/*	Copyright (C) 1995 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+
+#include <stdio.h>
+#include <unistd.h>
+#include "fd.h"
+#include "_scm.h"
+
+
+
+SCM_PROC (s_sys_ftell, "%ftell", 1, 0, 0, scm_sys_ftell);
+#ifdef __STDC__
+SCM 
+scm_sys_ftell (SCM port)
+#else
+SCM 
+scm_sys_ftell (port)
+     SCM port;
+#endif
+{
+  long pos;
+  SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_sys_ftell);
+  SCM_SYSCALL (pos = ftell ((FILE *)SCM_STREAM (port)));
+  if (pos < 0)
+    return SCM_BOOL_F;
+  if (pos > 0 && SCM_CRDYP (port))
+    pos--;
+  return SCM_MAKINUM (pos);
+}
+
+
+
+SCM_PROC (s_sys_fseek, "%fseek", 3, 0, 0, scm_sys_fseek);
+#ifdef __STDC__
+SCM 
+scm_sys_fseek (SCM port, SCM offset, SCM whence)
+#else
+SCM 
+scm_sys_fseek (port, offset, whence)
+     SCM port;
+     SCM offset;
+     SCM whence;
+#endif
+{
+  int rv;
+  SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_sys_fseek);
+  SCM_ASSERT (SCM_INUMP (offset), offset, SCM_ARG2, s_sys_fseek);
+  SCM_ASSERT (SCM_INUMP (whence) && (SCM_INUM (whence) < 3) && (SCM_INUM (whence) >= 0),
+	  whence, SCM_ARG3, s_sys_fseek);
+  SCM_CLRDY (port);			/* Clear ungetted char */
+  /* Values of whence are interned in scm_init_ioext.  */
+  rv = fseek ((FILE *)SCM_STREAM (port), SCM_INUM (offset), SCM_INUM (whence));
+  return rv ? SCM_MAKINUM (errno) : SCM_BOOL_T;
+}
+
+
+
+SCM_PROC (s_sys_freopen, "%freopen", 3, 0, 0, scm_sys_freopen);
+#ifdef __STDC__
+SCM 
+scm_sys_freopen (SCM filename, SCM modes, SCM port)
+#else
+SCM 
+scm_sys_freopen (filename, modes, port)
+     SCM filename;
+     SCM modes;
+     SCM port;
+#endif
+{
+  FILE *f;
+  SCM_ASSERT (SCM_NIMP (filename) && SCM_STRINGP (filename), filename, SCM_ARG1, s_sys_freopen);
+  SCM_ASSERT (SCM_NIMP (modes) && SCM_STRINGP (modes), modes, SCM_ARG2, s_sys_freopen);
+  SCM_DEFER_INTS;
+  SCM_ASSERT (SCM_NIMP (port) && SCM_FPORTP (port), port, SCM_ARG3, s_sys_freopen);
+  SCM_SYSCALL (f = freopen (SCM_CHARS (filename), SCM_CHARS (modes), (FILE *)SCM_STREAM (port)));
+  if (!f)
+    {
+      SCM p;
+      p = port;
+      port = SCM_MAKINUM (errno);
+      SCM_CAR (p) &= ~SCM_OPN;
+      scm_remove_from_port_table (p);
+    }
+  else
+    {
+      SCM_CAR (port) = scm_tc16_fport | scm_mode_bits (SCM_CHARS (modes));
+      SCM_SETSTREAM (port, (SCM)f);
+      if (SCM_BUF0 & (SCM_CAR (port) = scm_tc16_fport | scm_mode_bits (SCM_CHARS (modes))))
+	scm_setbuf0 (port);
+    }
+  SCM_ALLOW_INTS;
+  return port;
+}
+
+
+
+SCM_PROC (s_sys_duplicate_port, "%duplicate-port", 2, 0, 0, scm_sys_duplicate_port);
+#ifdef __STDC__
+SCM 
+scm_sys_duplicate_port (SCM oldpt, SCM modes)
+#else
+SCM 
+scm_sys_duplicate_port (oldpt, modes)
+     SCM oldpt;
+     SCM modes;
+#endif
+{
+  int oldfd;
+  int newfd;
+  FILE *f;
+  SCM newpt;
+  SCM_ASSERT (SCM_NIMP (oldpt) && SCM_OPPORTP (oldpt), oldpt, SCM_ARG1, s_sys_duplicate_port);
+  SCM_ASSERT (SCM_NIMP (modes) && SCM_STRINGP (modes), modes, SCM_ARG2, s_sys_duplicate_port);
+  SCM_NEWCELL (newpt);
+  SCM_DEFER_INTS;
+  oldfd = fileno ((FILE *)SCM_STREAM (oldpt));
+  if (oldfd == -1)
+    {
+      SCM_ALLOW_INTS;
+      return SCM_BOOL_F;
+    };
+  SCM_SYSCALL (newfd = dup (oldfd));
+  if (newfd == -1)
+    {
+      SCM_ALLOW_INTS;
+      return SCM_BOOL_F;
+    };
+  f = fdopen (newfd, SCM_CHARS (modes));
+  if (!f)
+    {
+      SCM_SYSCALL (close (newfd));
+      SCM_ALLOW_INTS;
+      return SCM_BOOL_F;
+    }
+  {
+    struct scm_port_table * pt;
+    pt = scm_add_to_port_table (newpt);
+    SCM_SETPTAB_ENTRY (newpt, pt);
+    if (SCM_BUF0 & (SCM_CAR (newpt) = scm_tc16_fport | scm_mode_bits (SCM_CHARS (modes))))
+      scm_setbuf0 (newpt);
+    SCM_SETSTREAM (newpt, (SCM)f);
+    SCM_PTAB_ENTRY (newpt)->file_name = SCM_PTAB_ENTRY (oldpt)->file_name;
+  }
+  SCM_ALLOW_INTS;
+  return newpt;
+}
+
+
+
+SCM_PROC (s_sys_redirect_port, "%redirect-port", 2, 0, 0, scm_sys_redirect_port);
+#ifdef __STDC__
+SCM 
+scm_sys_redirect_port (SCM into_pt, SCM from_pt)
+#else
+SCM 
+scm_sys_redirect_port (into_pt, from_pt)
+     SCM into_pt;
+     SCM from_pt;
+#endif
+{
+  int ans, oldfd, newfd;
+  SCM_DEFER_INTS;
+  SCM_ASSERT (SCM_NIMP (into_pt) && SCM_OPPORTP (into_pt), into_pt, SCM_ARG1, s_sys_redirect_port);
+  SCM_ASSERT (SCM_NIMP (from_pt) && SCM_OPPORTP (from_pt), from_pt, SCM_ARG2, s_sys_redirect_port);
+  oldfd = fileno ((FILE *)SCM_STREAM (into_pt));
+  newfd = fileno ((FILE *)SCM_STREAM (from_pt));
+  if (oldfd == -1 || newfd == -1)
+    ans = -1;
+  else
+    SCM_SYSCALL (ans = dup2 (oldfd, newfd));
+  SCM_ALLOW_INTS;
+  return (ans == -1) ? SCM_MAKINUM (errno) : SCM_BOOL_T;
+}
+
+SCM_PROC (s_sys_fileno, "%fileno", 1, 0, 0, scm_sys_fileno);
+#ifdef __STDC__
+SCM 
+scm_sys_fileno (SCM port)
+#else
+SCM 
+scm_sys_fileno (port)
+     SCM port;
+#endif
+{
+  int fd;
+  SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_sys_fileno);
+  fd = fileno ((FILE *)SCM_STREAM (port));
+  return (fd == -1) ? SCM_BOOL_F : SCM_MAKINUM (fd);
+}
+
+
+SCM_PROC (s_sys_soft_fileno, "%soft-fileno", 1, 0, 0, scm_sys_soft_fileno);
+#ifdef __STDC__
+SCM 
+scm_sys_soft_fileno (SCM port)
+#else
+SCM 
+scm_sys_soft_fileno (port)
+     SCM port;
+#endif
+{
+  int fd;
+  SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port), port, SCM_ARG1, s_sys_fileno);
+
+  if (!SCM_OPFPORTP (port))
+    return SCM_BOOL_F;
+
+  fd = fileno ((FILE *)SCM_STREAM (port));
+  return (fd == -1) ? SCM_BOOL_F : SCM_MAKINUM (fd);
+}
+
+
+
+SCM_PROC (s_sys_isatty, "%isatty?", 1, 0, 0, scm_sys_isatty_p);
+#ifdef __STDC__
+SCM 
+scm_sys_isatty_p (SCM port)
+#else
+SCM 
+scm_sys_isatty_p (port)
+     SCM port;
+#endif
+{
+  int rv;
+  SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_sys_isatty);
+  rv = fileno ((FILE *)SCM_STREAM (port));
+  if (rv == -1)
+    return SCM_MAKINUM (errno);
+  else
+    {
+      rv = isatty (rv);
+      return  rv ? SCM_BOOL_T : SCM_BOOL_F;
+    }
+}
+
+
+
+SCM_PROC (s_sys_fdopen, "%fdopen", 2, 0, 0, scm_sys_fdopen);
+#ifdef __STDC__
+SCM
+scm_sys_fdopen (SCM fdes, SCM modes)
+#else
+SCM
+scm_sys_fdopen (fdes, modes)
+     SCM fdes;
+     SCM modes;
+#endif
+{
+  FILE *f;
+  SCM port;
+
+  SCM_ASSERT (SCM_INUMP (fdes), fdes, SCM_ARG1, s_sys_fdopen);
+  SCM_ASSERT (SCM_NIMP (modes) && SCM_STRINGP (modes), modes, SCM_ARG2, s_sys_fdopen);
+  SCM_DEFER_INTS;
+  f = fdopen (SCM_INUM (fdes), SCM_CHARS (modes));
+  if (f == NULL)
+    {
+      SCM_ALLOW_INTS;
+      return SCM_MAKINUM (errno);
+    }
+  SCM_NEWCELL (port);
+  SCM_CAR (port) = scm_tc16_fport | scm_mode_bits (SCM_CHARS (modes));
+  SCM_SETSTREAM (port,(SCM)f);
+  scm_add_to_port_table (port);
+  SCM_ALLOW_INTS;
+  return port;
+}
+
+
+
+/* Move a port's underlying file descriptor to a given value.
+ * Returns: #f for error.
+ *           0 if fdes is already the given value.
+ *           1 if fdes moved. 
+ * MOVE->FDES is implemented in Scheme and calls this primitive.
+ */
+SCM_PROC (s_sys_primitive_move_to_fdes, "%primitive-move->fdes", 2, 0, 0, scm_sys_primitive_move_to_fdes);
+#ifdef __STDC__
+SCM
+scm_sys_primitive_move_to_fdes (SCM port, SCM fd)
+#else
+SCM
+scm_sys_primitive_move_to_fdes (port, fd)
+     SCM port;
+     SCM fd;
+#endif
+{
+  FILE *stream;
+  int old_fd;
+  int new_fd;
+  int rv;
+
+  SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_sys_primitive_move_to_fdes);
+  SCM_ASSERT (SCM_INUMP (fd), fd, SCM_ARG2, s_sys_primitive_move_to_fdes);
+  SCM_DEFER_INTS;
+  stream = (FILE *)SCM_STREAM (port);
+  old_fd = fileno (stream);
+  new_fd = SCM_INUM (fd);
+  if  (old_fd == new_fd)
+    {
+      SCM_ALLOW_INTS;
+      return SCM_MAKINUM (0);
+    }
+  scm_evict_ports (new_fd);
+  rv = dup2 (old_fd, new_fd);
+  if (rv == -1)
+    {
+      SCM_ALLOW_INTS;
+      return SCM_BOOL_F;
+    }
+  scm_setfileno (stream, new_fd);
+  SCM_SYSCALL (close (old_fd));  
+  SCM_ALLOW_INTS;
+  return SCM_MAKINUM (1);
+}
+
+
+
+/* FIXME  */
+#ifdef __STDC__
+void
+scm_setfileno (FILE *fs, int fd)
+#else
+void
+scm_setfileno (fs, fd)
+     FILE *fs;
+     int fd;
+#endif
+{
+#ifdef SET_FILE_FD_FIELD
+  SET_FILE_FD_FIELD(fs, fd);
+#else
+  Configure could not guess the name of the correct field in a FILE *.
+
+  This function needs to be ported to your system.
+
+  SET_FILE_FD_FIELD should change the descriptor refered to by a stdio
+  stream, and nothing else.
+
+  The way to port this file is to add cases to configure.in.  Search
+  that file for "SET_FILE_FD_FIELD" and follow the examples there.
+#endif
+}
+
+/* Move ports with the specified file descriptor to new descriptors,
+ * reseting the revealed count to 0.
+ * Should be called with SCM_DEFER_INTS active.
+ */
+#ifdef __STDC__
+void
+scm_evict_ports (int fd)
+#else
+void
+scm_evict_ports (fd)
+     int fd;
+#endif
+{
+  int i;
+
+  for (i = 0; i < scm_port_table_size; i++)
+    {
+      if (SCM_FPORTP (scm_port_table[i]->port)
+	  && fileno ((FILE *)SCM_STREAM (scm_port_table[i]->port)) == fd)
+	{
+	  scm_setfileno ((FILE *)SCM_STREAM (scm_port_table[i]->port), dup (fd));
+	  scm_set_port_revealed_x (scm_port_table[i]->port, SCM_MAKINUM (0));
+	}
+    }
+}
+
+/* Return a list of ports using a given file descriptor.  */
+SCM_PROC(s_fdes_to_ports, "fdes->ports", 1, 0, 0, scm_fdes_to_ports);
+#ifdef __STDC__
+SCM
+scm_fdes_to_ports (SCM fd)
+#else
+SCM
+scm_fdes_to_ports (fd)
+     SCM fd;
+#endif
+{
+  SCM result = SCM_EOL;
+  int int_fd;
+  int i;
+  
+  SCM_ASSERT (SCM_INUMP (fd), fd, SCM_ARG1, s_fdes_to_ports);
+  int_fd = SCM_INUM (fd);
+
+  SCM_DEFER_INTS;
+  for (i = 0; i < scm_port_table_size; i++)
+    {
+      if (SCM_FPORTP (scm_port_table[i]->port)
+	  && fileno ((FILE *)SCM_STREAM (scm_port_table[i]->port)) == int_fd)
+	result = scm_cons (scm_port_table[i]->port, result);
+    }
+  SCM_ALLOW_INTS;
+  return result;
+}    
+
+#ifdef __STDC__
+void 
+scm_init_ioext (void)
+#else
+void 
+scm_init_ioext ()
+#endif
+{
+  /* fseek() symbols.  */
+  scm_sysintern ("SEEK_SET", SCM_MAKINUM (SEEK_SET));
+  scm_sysintern ("SEEK_CUR", SCM_MAKINUM (SEEK_CUR));
+  scm_sysintern ("SEEK_END", SCM_MAKINUM (SEEK_END));
+
+  /* access() symbols.  */
+  scm_sysintern ("R_OK", SCM_MAKINUM (R_OK));
+  scm_sysintern ("W_OK", SCM_MAKINUM (W_OK));
+  scm_sysintern ("X_OK", SCM_MAKINUM (X_OK));
+  scm_sysintern ("F_OK", SCM_MAKINUM (F_OK));
+
+  /* File type/permission bits.  */
+#ifdef S_IRUSR
+  scm_sysintern ("S_IRUSR", SCM_MAKINUM (S_IRUSR));
+#endif
+#ifdef S_IWUSR
+  scm_sysintern ("S_IWUSR", SCM_MAKINUM (S_IWUSR));
+#endif
+#ifdef S_IXUSR
+  scm_sysintern ("S_IXUSR", SCM_MAKINUM (S_IXUSR));
+#endif
+#ifdef S_IRWXU
+  scm_sysintern ("S_IRWXU", SCM_MAKINUM (S_IRWXU));
+#endif
+
+#ifdef S_IRGRP
+  scm_sysintern ("S_IRGRP", SCM_MAKINUM (S_IRGRP));
+#endif
+#ifdef S_IWGRP
+  scm_sysintern ("S_IWGRP", SCM_MAKINUM (S_IWGRP));
+#endif
+#ifdef S_IXGRP
+  scm_sysintern ("S_IXGRP", SCM_MAKINUM (S_IXGRP));
+#endif
+#ifdef S_IRWXG
+  scm_sysintern ("S_IRWXG", SCM_MAKINUM (S_IRWXG));
+#endif
+
+#ifdef S_IROTH
+  scm_sysintern ("S_IROTH", SCM_MAKINUM (S_IROTH));
+#endif
+#ifdef S_IWOTH
+  scm_sysintern ("S_IWOTH", SCM_MAKINUM (S_IWOTH));
+#endif
+#ifdef S_IXOTH
+  scm_sysintern ("S_IXOTH", SCM_MAKINUM (S_IXOTH));
+#endif
+#ifdef S_IRWXO
+  scm_sysintern ("S_IRWXO", SCM_MAKINUM (S_IRWXO));
+#endif
+
+#ifdef S_ISUID
+  scm_sysintern ("S_ISUID", SCM_MAKINUM (S_ISUID));
+#endif
+#ifdef S_ISGID
+  scm_sysintern ("S_ISGID", SCM_MAKINUM (S_ISGID));
+#endif
+#ifdef S_ISVTX
+  scm_sysintern ("S_ISVTX", SCM_MAKINUM (S_ISVTX));
+#endif
+
+#ifdef S_IFMT
+  scm_sysintern ("S_IFMT", SCM_MAKINUM (S_IFMT));
+#endif
+#ifdef S_IFDIR
+  scm_sysintern ("S_IFDIR", SCM_MAKINUM (S_IFDIR));
+#endif
+#ifdef S_IFCHR
+  scm_sysintern ("S_IFCHR", SCM_MAKINUM (S_IFCHR));
+#endif
+#ifdef S_IFBLK
+  scm_sysintern ("S_IFBLK", SCM_MAKINUM (S_IFBLK));
+#endif
+#ifdef S_IFREG
+  scm_sysintern ("S_IFREG", SCM_MAKINUM (S_IFREG));
+#endif
+#ifdef S_IFLNK
+  scm_sysintern ("S_IFLNK", SCM_MAKINUM (S_IFLNK));
+#endif
+#ifdef S_IFSOCK
+  scm_sysintern ("S_IFSOCK", SCM_MAKINUM (S_IFSOCK));
+#endif
+#ifdef S_IFIFO
+  scm_sysintern ("S_IFIFO", SCM_MAKINUM (S_IFIFO));
+#endif
+#include "ioext.x"
+}
+
diff --git a/libguile/ioext.h b/libguile/ioext.h
new file mode 100644
index 000000000..b7a30e2c0
--- /dev/null
+++ b/libguile/ioext.h
@@ -0,0 +1,87 @@
+/* classes: h_files */
+
+#ifndef IOEXTH
+#define IOEXTH
+/*	Copyright (C) 1995 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+
+
+
+
+
+#ifdef __STDC__
+extern SCM scm_sys_ftell (SCM port);
+extern SCM scm_sys_fseek (SCM port, SCM offset, SCM whence);
+extern SCM scm_sys_freopen (SCM filename, SCM modes, SCM port);
+extern SCM scm_sys_duplicate_port (SCM oldpt, SCM modes);
+extern SCM scm_sys_redirect_port (SCM into_pt, SCM from_pt);
+extern SCM scm_sys_fileno (SCM port);
+extern SCM scm_sys_isatty (SCM port);
+extern SCM scm_sys_fdopen (SCM fdes, SCM modes);
+extern SCM scm_sys_primitive_move_to_fdes (SCM port, SCM fd);
+extern void scm_setfileno (FILE *fs, int fd);
+extern void scm_evict_ports (int fd);
+extern SCM scm_fdes_to_ports (SCM fd);
+extern void scm_init_ioext (void);
+
+#else /* STDC */
+extern SCM scm_sys_ftell ();
+extern SCM scm_sys_fseek ();
+extern SCM scm_sys_freopen ();
+extern SCM scm_sys_duplicate_port ();
+extern SCM scm_sys_redirect_port ();
+extern SCM scm_sys_fileno ();
+extern SCM scm_sys_isatty ();
+extern SCM scm_sys_fdopen ();
+extern SCM scm_sys_primitive_move_to_fdes ();
+extern void scm_setfileno ();
+extern void scm_evict_ports ();
+extern SCM scm_fdes_to_ports ();
+extern void scm_init_ioext ();
+
+#endif /* STDC */
+
+
+
+#endif  /* IOEXTH */
diff --git a/libguile/kw.c b/libguile/kw.c
new file mode 100644
index 000000000..e559ef3ea
--- /dev/null
+++ b/libguile/kw.c
@@ -0,0 +1,164 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+
+#ifdef __STDC__
+static scm_sizet
+free_kw (SCM obj)
+#else
+static scm_sizet
+free_kw (obj)
+     SCM obj;
+#endif
+{
+  return 0;
+}
+
+#ifdef __STDC__
+static int
+prin_kw (SCM exp, SCM port, int writing)
+#else
+static int
+prin_kw (exp, port, writing)
+     SCM exp;
+     SCM port;
+     int writing;
+#endif
+{
+  scm_gen_puts (scm_regular_string, ":", port);
+  scm_gen_puts((SCM_MB_STRINGP(SCM_CDR (exp))
+		? scm_mb_string
+		: scm_regular_string),
+	       1 + SCM_CHARS (SCM_CDR (exp)),
+	       port);
+  return 1;
+}
+
+int scm_tc16_kw;
+
+static scm_smobfuns kw_smob = {scm_markcdr, free_kw, prin_kw, 0};
+
+
+
+SCM_PROC (s_make_keyword_from_dash_symbol, "make-keyword-from-dash-symbol", 1, 0, 0, scm_make_keyword_from_dash_symbol);
+#ifdef __STDC__
+SCM
+scm_make_keyword_from_dash_symbol (SCM symbol)
+#else
+SCM
+scm_make_keyword_from_dash_symbol (symbol)
+     SCM symbol;
+#endif
+{
+  SCM vcell;
+
+  SCM_ASSERT (SCM_NIMP (symbol) && SCM_SYMBOLP(symbol) && ('-' == SCM_CHARS(symbol)[0]),
+	  symbol, SCM_ARG1, s_make_keyword_from_dash_symbol);
+
+
+  SCM_DEFER_INTS;
+  vcell = scm_sym2ovcell_soft (symbol, scm_kw_obarray);
+  if (vcell == SCM_BOOL_F)
+    {
+      SCM kw;
+      SCM_NEWCELL(kw);
+      SCM_CAR(kw) = (SCM)scm_tc16_kw;
+      SCM_CDR(kw) = symbol;
+      scm_intern_symbol (scm_kw_obarray, symbol);
+      vcell = scm_sym2ovcell_soft (symbol, scm_kw_obarray);
+      SCM_CDR (vcell) = kw;
+    }
+  SCM_ALLOW_INTS;
+  return SCM_CDR (vcell);
+}
+
+SCM_PROC(s_keyword_p, "keyword?", 1, 0, 0, scm_keyword_p);
+#ifdef __STDC__
+SCM
+scm_keyword_p (SCM obj)
+#else
+SCM
+scm_keyword_p (obj)
+     SCM obj;
+#endif
+{
+  return ( (SCM_NIMP(obj) && SCM_KEYWORDP (obj))
+	  ? SCM_BOOL_T
+	  : SCM_BOOL_F);
+}
+
+
+
+SCM_PROC(s_keyword_dash_symbol, "keyword-dash-symbol", 1, 0, 0, scm_keyword_dash_symbol);
+#ifdef __STDC__
+SCM
+scm_keyword_dash_symbol (SCM kw)
+#else
+SCM
+scm_keyword_dash_symbol (kw)
+     SCM kw;
+#endif
+{
+  SCM_ASSERT (SCM_NIMP (kw) && SCM_KEYWORDP (kw), kw, SCM_ARG1, s_keyword_dash_symbol);
+  return SCM_CDR (kw);
+}
+
+
+
+
+#ifdef __STDC__
+void
+scm_init_kw (void)
+#else
+void
+scm_init_kw ()
+#endif
+{
+  scm_tc16_kw = scm_newsmob (&kw_smob);
+  scm_kw_obarray = scm_make_vector (SCM_MAKINUM (256), SCM_EOL, SCM_UNDEFINED);
+#include "kw.x"
+}
+
diff --git a/libguile/kw.h b/libguile/kw.h
new file mode 100644
index 000000000..c84899cff
--- /dev/null
+++ b/libguile/kw.h
@@ -0,0 +1,70 @@
+/* classes: h_files */
+
+#ifndef KWH
+#define KWH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+
+
+
+extern int scm_tc16_kw;
+#define SCM_KEYWORDP(X)		(SCM_CAR(X) == scm_tc16_kw)
+#define SCM_KEYWORDSYM(X)	(SCM_CDR(X))
+
+
+
+#ifdef __STDC__
+extern SCM scm_make_keyword_from_dash_symbol (SCM symbol);
+extern SCM scm_keyword_p (SCM obj);
+extern SCM scm_keyword_dash_symbol (SCM kw);
+extern void scm_init_kw (void);
+
+#else /* STDC */
+extern SCM scm_make_keyword_from_dash_symbol ();
+extern SCM scm_keyword_p ();
+extern SCM scm_keyword_dash_symbol ();
+extern void scm_init_kw ();
+
+#endif /* STDC */
+#endif  /* KWH */
diff --git a/libguile/libguile.h b/libguile/libguile.h
new file mode 100644
index 000000000..ea18a23db
--- /dev/null
+++ b/libguile/libguile.h
@@ -0,0 +1,142 @@
+#ifndef LIBGUILEH
+#define LIBGUILEH
+
+/*	Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+
+
+#ifdef STDC_HEADERS
+# include <stdlib.h>
+# ifdef AMIGA
+#  include <stddef.h>
+# endif /* def AMIGA */
+# define scm_sizet size_t
+#else
+# ifdef _SIZE_T
+#  define scm_sizet size_t
+# else
+#  define scm_sizet unsigned int
+# endif /* def _SIZE_T */
+#endif /* def STDC_HEADERS */
+
+#include "__scm.h"
+
+#include "smob.h"
+
+
+
+#include "alist.h"
+#include "append.h"
+#include "arbiters.h"
+#include "async.h"
+#include "boolean.h"
+#include "chars.h"
+#include "continuations.h"
+#include "dynwind.h"
+#include "eq.h"
+#include "error.h"
+#include "eval.h"
+#include "extchrs.h"
+#include "fdsocket.h"
+#include "feature.h"
+#include "files.h"
+#include "filesys.h"
+#include "fports.h"
+#include "gc.h"
+#include "genio.h"
+#include "gsubr.h"
+#include "hash.h"
+#include "hashtab.h"
+#include "init.h"
+#include "ioext.h"
+#include "kw.h"
+#include "libguile.h"
+#include "list.h"
+#include "load.h"
+#include "mallocs.h"
+#include "markers.h"
+#include "marksweep.h"
+#include "mbstrings.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "params.h"
+#include "ports.h"
+#include "posix.h"
+#include "print.h"
+#include "procprop.h"
+#include "procs.h"
+#include "ramap.h"
+#include "read.h"
+#include "root.h"
+#include "scmsigs.h"
+#include "sequences.h"
+#include "simpos.h"
+#include "socket.h"
+#include "stackchk.h"
+#include "stime.h"
+#include "strings.h"
+#include "strop.h"
+#include "strorder.h"
+#include "strports.h"
+#include "struct.h"
+#include "symbols.h"
+#include "tag.h"
+#include "tags.h"
+#include "throw.h"
+#include "unif.h"
+#include "variable.h"
+#include "vectors.h"
+#include "vports.h"
+#include "weaks.h"
+
+
+
+
+#ifdef __STDC__
+
+#else /* STDC */
+
+#endif /* STDC */
+
+
+#endif  /* LIBGUILEH */
diff --git a/libguile/list.c b/libguile/list.c
new file mode 100644
index 000000000..15c20fd32
--- /dev/null
+++ b/libguile/list.c
@@ -0,0 +1,791 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+#include <stdio.h>
+#include "_scm.h"
+
+#ifdef __STDC__
+#include <stdarg.h>
+#define var_start(x, y) va_start(x, y)
+#else
+#include <varargs.h>
+#define var_start(x, y) va_start(x)
+#endif
+
+
+
+
+#ifdef __STDC__
+SCM
+scm_listify (SCM elt, ...)
+#else
+SCM
+scm_listify (elt, va_alist)
+     SCM elt;
+     va_dcl
+
+#endif
+{
+  va_list foo;
+  SCM answer;
+  SCM *pos;
+
+  var_start (foo, elt);
+  answer = SCM_EOL;
+  pos = &answer;
+  while (elt != SCM_UNDEFINED)
+    {
+      *pos = scm_cons (elt, SCM_EOL);
+      pos = &SCM_CDR (*pos);
+      elt = va_arg (foo, SCM);
+    }
+  return answer;
+}
+
+
+SCM_PROC(s_list, "list", 0, 0, 1, scm_list);
+#ifdef __STDC__
+SCM
+scm_list(SCM objs)
+#else
+SCM
+scm_list(objs)
+     SCM objs;
+#endif
+{
+  return objs;
+}
+
+
+
+
+
+SCM_PROC(s_null_p, "null?", 1, 0, 0, scm_null_p);
+#ifdef __STDC__
+SCM
+scm_null_p(SCM x)
+#else
+SCM
+scm_null_p(x)
+     SCM x;
+#endif
+{
+ return SCM_NULLP(x) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+SCM_PROC(s_list_p, "list?", 1, 0, 0, scm_list_p);
+#ifdef __STDC__
+SCM
+scm_list_p(SCM x)
+#else
+SCM
+scm_list_p(x)
+     SCM x;
+#endif
+{
+  if (scm_ilength(x)<0)
+    return SCM_BOOL_F;
+  else
+    return SCM_BOOL_T;
+}
+
+
+#ifdef __STDC__
+long
+scm_ilength(SCM sx)
+#else
+long
+scm_ilength(sx)
+     SCM sx;
+#endif
+{
+  register long i = 0;
+  register SCM x = sx;
+  do {
+    if SCM_IMP(x) return SCM_NULLP(x) ? i : -1;
+    if SCM_NCONSP(x) return -1;
+    x = SCM_CDR(x);
+    i++;
+    if SCM_IMP(x) return SCM_NULLP(x) ? i : -1;
+    if SCM_NCONSP(x) return -1;
+    x = SCM_CDR(x);
+    i++;
+    sx = SCM_CDR(sx);
+  }
+  while (x != sx);
+  return -1;
+}
+
+SCM_PROC(s_list_length, "list-length", 1, 0, 0, scm_list_length);
+#ifdef __STDC__
+SCM
+scm_list_length(SCM x)
+#else
+SCM
+scm_list_length(x)
+     SCM x;
+#endif
+{
+  int i;
+  i = scm_ilength(x);
+  SCM_ASSERT(i >= 0, x, SCM_ARG1, s_list_length);
+  return SCM_MAKINUM (i);
+}
+
+
+
+
+SCM_PROC (s_list_append, "list-append", 0, 0, 1, scm_list_append);
+#ifdef __STDC__
+SCM
+scm_list_append(SCM args)
+#else
+SCM
+scm_list_append(args)
+     SCM args;
+#endif
+{
+  SCM res = SCM_EOL;
+  SCM *lloc = &res, arg;
+  if SCM_IMP(args) {
+    SCM_ASSERT(SCM_NULLP(args), args, SCM_ARGn, s_list_append);
+    return res;
+  }
+  SCM_ASSERT(SCM_CONSP(args), args, SCM_ARGn, s_list_append);
+  while (1) {
+    arg = SCM_CAR(args);
+    args = SCM_CDR(args);
+    if SCM_IMP(args) {
+      *lloc = arg;
+      SCM_ASSERT(SCM_NULLP(args), args, SCM_ARGn, s_list_append);
+      return res;
+    }
+    SCM_ASSERT(SCM_CONSP(args), args, SCM_ARGn, s_list_append);
+    for(;SCM_NIMP(arg);arg = SCM_CDR(arg)) {
+      SCM_ASSERT(SCM_CONSP(arg), arg, SCM_ARGn, s_list_append);
+      *lloc = scm_cons(SCM_CAR(arg), SCM_EOL);
+      lloc = &SCM_CDR(*lloc);
+    }
+    SCM_ASSERT(SCM_NULLP(arg), arg, SCM_ARGn, s_list_append);
+  }
+}
+
+
+SCM_PROC (s_list_append_x, "list-append!", 0, 0, 1, scm_list_append_x);
+#ifdef __STDC__
+SCM
+scm_list_append_x(SCM args)
+#else
+SCM
+scm_list_append_x(args)
+     SCM args;
+#endif
+{
+  SCM arg;
+ tail:
+  if SCM_NULLP(args) return SCM_EOL;
+  arg = SCM_CAR(args);
+  SCM_ASSERT(SCM_NULLP(arg) || (SCM_NIMP(arg) && SCM_CONSP(arg)), arg, SCM_ARG1, s_list_append_x);
+  args = SCM_CDR(args);
+  if SCM_NULLP(args) return arg;
+  if SCM_NULLP(arg) goto tail;
+  SCM_CDR(scm_last_pair(arg)) = scm_list_append_x(args);
+  return arg;
+}
+
+
+
+
+
+SCM_PROC (s_list_reverse, "list-reverse", 1, 0, 0, scm_list_reverse);
+#ifdef __STDC__
+SCM
+scm_list_reverse(SCM lst)
+#else
+SCM
+scm_list_reverse(lst)
+     SCM lst;
+#endif
+{
+	SCM res = SCM_EOL;
+	SCM p = lst;
+	for(;SCM_NIMP(p);p = SCM_CDR(p)) {
+		SCM_ASSERT(SCM_CONSP(p), lst, SCM_ARG1, s_list_reverse);
+		res = scm_cons(SCM_CAR(p), res);
+	}
+	SCM_ASSERT(SCM_NULLP(p), lst, SCM_ARG1, s_list_reverse);
+	return res;
+}
+
+SCM_PROC (s_list_reverse_x, "list-reverse!", 1, 1, 0, scm_list_reverse_x);
+#ifdef __STDC__
+SCM
+scm_list_reverse_x (SCM lst, SCM newtail)
+#else
+SCM
+scm_list_reverse_x (lst, newtail)
+     SCM lst;
+     SCM newtail;
+#endif
+{
+  SCM old_tail;
+  if (newtail == SCM_UNDEFINED)
+    newtail = SCM_EOL;
+
+ loop:
+  if (!(SCM_NIMP (lst) && SCM_CONSP (lst)))
+    return lst;
+
+  old_tail = SCM_CDR (lst);
+  SCM_SETCDR (lst, newtail);
+  if (SCM_NULLP (old_tail))
+    return lst;
+
+  newtail = lst;
+  lst = old_tail;
+  goto loop;
+}
+
+
+
+
+
+SCM_PROC(s_list_ref, "list-ref", 2, 0, 0, scm_list_ref);
+#ifdef __STDC__
+SCM
+scm_list_ref(SCM lst, SCM k)
+#else
+SCM
+scm_list_ref(lst, k)
+     SCM lst;
+     SCM k;
+#endif
+{
+	register long i;
+	SCM_ASSERT(SCM_INUMP(k), k, SCM_ARG2, s_list_ref);
+	i = SCM_INUM(k);
+	SCM_ASSERT(i >= 0, k, SCM_ARG2, s_list_ref);
+	while (i-- > 0) {
+		SCM_ASRTGO(SCM_NIMP(lst) && SCM_CONSP(lst), erout);
+		lst = SCM_CDR(lst);
+	}
+erout:	SCM_ASSERT(SCM_NIMP(lst) && SCM_CONSP(lst),
+	       SCM_NULLP(lst)?k:lst, SCM_NULLP(lst)?SCM_OUTOFRANGE:SCM_ARG1, s_list_ref);
+	return SCM_CAR(lst);
+}
+
+SCM_PROC(s_list_set_x, "list-set!", 3, 0, 0, scm_list_set_x);
+#ifdef __STDC__
+SCM
+scm_list_set_x(SCM lst, SCM k, SCM val)
+#else
+SCM
+scm_list_set_x(lst, k, val)
+     SCM lst;
+     SCM k;
+     SCM val;
+#endif
+{
+	register long i;
+	SCM_ASSERT(SCM_INUMP(k), k, SCM_ARG2, s_list_set_x);
+	i = SCM_INUM(k);
+	SCM_ASSERT(i >= 0, k, SCM_ARG2, s_list_set_x);
+	while (i-- > 0) {
+		SCM_ASRTGO(SCM_NIMP(lst) && SCM_CONSP(lst), erout);
+		lst = SCM_CDR(lst);
+	}
+erout:	SCM_ASSERT(SCM_NIMP(lst) && SCM_CONSP(lst),
+	       SCM_NULLP(lst)?k:lst, SCM_NULLP(lst)?SCM_OUTOFRANGE:SCM_ARG1, s_list_set_x);
+	SCM_CAR (lst) = val;
+	return val;
+}
+
+
+
+SCM_PROC(s_list_cdr_set_x, "list-cdr-set!", 3, 0, 0, scm_list_cdr_set_x);
+#ifdef __STDC__
+SCM
+scm_list_cdr_set_x(SCM lst, SCM k, SCM val)
+#else
+SCM
+scm_list_cdr_set_x(lst, k, val)
+     SCM lst;
+     SCM k;
+     SCM val;
+#endif
+{
+	register long i;
+	SCM_ASSERT(SCM_INUMP(k), k, SCM_ARG2, s_list_cdr_set_x);
+	i = SCM_INUM(k);
+	SCM_ASSERT(i >= 0, k, SCM_ARG2, s_list_cdr_set_x);
+	while (i-- > 0) {
+		SCM_ASRTGO(SCM_NIMP(lst) && SCM_CONSP(lst), erout);
+		lst = SCM_CDR(lst);
+	}
+erout:	SCM_ASSERT(SCM_NIMP(lst) && SCM_CONSP(lst),
+	       SCM_NULLP(lst)?k:lst, SCM_NULLP(lst)?SCM_OUTOFRANGE:SCM_ARG1, s_list_cdr_set_x);
+	SCM_SETCDR (lst, val);
+	return val;
+}
+
+
+
+
+
+
+SCM_PROC(s_last_pair, "last-pair", 1, 0, 0, scm_last_pair);
+#ifdef __STDC__
+SCM
+scm_last_pair(SCM sx)
+#else
+SCM
+scm_last_pair(sx)
+     SCM sx;
+#endif
+{
+  register SCM res = sx;
+  register SCM x;
+
+  if (SCM_NULLP (sx))
+    return SCM_EOL;
+
+  SCM_ASSERT(SCM_NIMP(res) && SCM_CONSP(res), res, SCM_ARG1, s_last_pair);
+  while (!0) {
+    x = SCM_CDR(res);
+    if (SCM_IMP(x) || SCM_NCONSP(x)) return res;
+    res = x;
+    x = SCM_CDR(res);
+    if (SCM_IMP(x) || SCM_NCONSP(x)) return res;
+    res = x;
+    sx = SCM_CDR(sx);
+    SCM_ASSERT(x != sx, sx, SCM_ARG1, s_last_pair);
+  }
+}
+
+SCM_PROC(s_list_cdr_ref, "list-cdr-ref", 2, 0, 0, scm_list_tail);
+SCM_PROC(s_list_tail, "list-tail", 2, 0, 0, scm_list_tail);
+#ifdef __STDC__
+SCM
+scm_list_tail(SCM lst, SCM k)
+#else
+SCM
+scm_list_tail(lst, k)
+     SCM lst;
+     SCM k;
+#endif
+{
+  register long i;
+  SCM_ASSERT(SCM_INUMP(k), k, SCM_ARG2, s_list_tail);
+  i = SCM_INUM(k);
+  while (i-- > 0) {
+    SCM_ASSERT(SCM_NIMP(lst) && SCM_CONSP(lst), lst, SCM_ARG1, s_list_tail);
+    lst = SCM_CDR(lst);
+  }
+  return lst;
+}
+
+
+SCM_PROC(s_list_head, "list-head", 2, 0, 0, scm_list_head);
+#ifdef __STDC__
+SCM
+scm_list_head(SCM lst, SCM k)
+#else
+SCM
+scm_list_head(lst, k)
+     SCM lst;
+     SCM k;
+#endif
+{
+  SCM answer;
+  SCM * pos;
+  register long i;
+
+  SCM_ASSERT(SCM_INUMP(k), k, SCM_ARG2, s_list_head);
+  answer = SCM_EOL;
+  pos = &answer;
+  i = SCM_INUM(k);
+  while (i-- > 0)
+    {
+      SCM_ASSERT(SCM_NIMP(lst) && SCM_CONSP(lst), lst, SCM_ARG1, s_list_head);
+      *pos = scm_cons (SCM_CAR (lst), SCM_EOL);
+      pos = &SCM_CDR (*pos);
+      lst = SCM_CDR(lst);
+    }
+  return answer;
+}
+
+
+
+
+#ifdef __STDC__
+static void
+sloppy_mem_check (SCM obj, char * where, char * why)
+#else
+static void
+sloppy_mem_check (obj, where, why)
+     SCM obj;
+     char * where;
+     char * why;
+#endif
+{
+  SCM_ASSERT ((scm_ilength (obj) >= 0), obj, where, why);
+}
+
+
+SCM_PROC (s_sloppy_memq, "sloppy-memq", 2, 0, 0, scm_sloppy_memq);
+#ifdef __STDC__
+SCM
+scm_sloppy_memq(SCM x, SCM lst)
+#else
+SCM
+scm_sloppy_memq(x, lst)
+     SCM x;
+     SCM lst;
+#endif
+{
+  for(;  SCM_NIMP(lst) && SCM_CONSP (lst);  lst = SCM_CDR(lst))
+    {
+      if (SCM_CAR(lst)==x)
+	return lst;
+    }
+  return lst;
+}
+
+
+SCM_PROC (s_sloppy_memv, "sloppy-memv", 2, 0, 0, scm_sloppy_memv);
+#ifdef __STDC__
+SCM
+scm_sloppy_memv(SCM x, SCM lst)
+#else
+SCM
+scm_sloppy_memv(x, lst)
+     SCM x;
+     SCM lst;
+#endif
+{
+  for(;  SCM_NIMP(lst) && SCM_CONSP (lst);  lst = SCM_CDR(lst))
+    {
+      if (SCM_BOOL_F != scm_eqv_p (SCM_CAR(lst), x))
+	return lst;
+    }
+  return lst;
+}
+
+
+SCM_PROC (s_sloppy_member, "sloppy-member", 2, 0, 0, scm_sloppy_member);
+#ifdef __STDC__
+SCM
+scm_sloppy_member (SCM x, SCM lst)
+#else
+SCM
+scm_sloppy_member (x, lst)
+     SCM x;
+     SCM lst;
+#endif
+{
+  for(;  SCM_NIMP(lst) && SCM_CONSP (lst);  lst = SCM_CDR(lst))
+    {
+      if (SCM_BOOL_F != scm_equal_p (SCM_CAR(lst), x))
+	return lst;
+    }
+  return lst;
+}
+
+
+
+SCM_PROC(s_memq, "memq", 2, 0, 0, scm_memq);
+#ifdef __STDC__
+SCM
+scm_memq(SCM x, SCM lst)
+#else
+SCM
+scm_memq(x, lst)
+     SCM x;
+     SCM lst;
+#endif
+{
+  SCM answer;
+  answer = scm_sloppy_memq (x, lst);
+  sloppy_mem_check (answer, (char *)SCM_ARG2, s_memq);
+  return answer;
+}
+
+
+
+SCM_PROC(s_memv, "memv", 2, 0, 0, scm_memv);
+#ifdef __STDC__
+SCM
+scm_memv(SCM x, SCM lst)
+#else
+SCM
+scm_memv(x, lst)
+     SCM x;
+     SCM lst;
+#endif
+{
+  SCM answer;
+  answer = scm_sloppy_memv (x, lst);
+  sloppy_mem_check (answer, (char *)SCM_ARG2, s_memv);
+  return answer;
+}
+
+
+SCM_PROC(s_member, "member", 2, 0, 0, scm_member);
+#ifdef __STDC__
+SCM
+scm_member(SCM x, SCM lst)
+#else
+SCM
+scm_member(x, lst)
+     SCM x;
+     SCM lst;
+#endif
+{
+  SCM answer;
+  answer = scm_sloppy_member (x, lst);
+  sloppy_mem_check (answer, (char *)SCM_ARG2, s_member);
+  return answer;
+}
+
+
+
+
+SCM_PROC(s_delq_x, "delq!", 2, 0, 0, scm_delq_x);
+#ifdef __STDC__
+SCM
+scm_delq_x (SCM item, SCM lst)
+#else
+SCM
+scm_delq_x (item, lst)
+     SCM item;
+     SCM lst;
+#endif
+{
+  SCM start;
+
+  if (SCM_IMP (lst) || SCM_NCONSP (lst))
+    return lst;
+
+  if (SCM_CAR (lst) == item)
+    return SCM_CDR (lst);
+
+  start = lst;
+
+  while (SCM_NIMP (SCM_CDR (lst)) && SCM_CONSP (SCM_CDR (lst)))
+    {
+      if (SCM_CAR (SCM_CDR (lst)) == item)
+	{
+	  SCM_SETCDR (lst, SCM_CDR (SCM_CDR (lst)));
+	  return start;
+	}
+      lst = SCM_CDR (lst);
+    }
+  return start;
+}
+
+
+SCM_PROC(s_delv_x, "delv!", 2, 0, 0, scm_delv_x);
+#ifdef __STDC__
+SCM
+scm_delv_x (SCM item, SCM lst)
+#else
+SCM
+scm_delv_x (item, lst)
+     SCM item;
+     SCM lst;
+#endif
+{
+  SCM start;
+
+  if (SCM_IMP (lst) || SCM_NCONSP (lst))
+    return lst;
+
+  if (SCM_BOOL_F != scm_eqv_p (SCM_CAR (lst), item))
+    return SCM_CDR (lst);
+
+  start = lst;
+
+  while (SCM_NIMP (SCM_CDR (lst)) && SCM_CONSP (SCM_CDR (lst)))
+    {
+      if (SCM_BOOL_F != scm_eqv_p (SCM_CAR (SCM_CDR (lst)), item))
+	{
+	  SCM_SETCDR (lst, SCM_CDR (SCM_CDR (lst)));
+	  return start;
+	}
+      lst = SCM_CDR (lst);
+    }
+  return start;
+}
+
+
+
+SCM_PROC(s_delete_x, "delete!", 2, 0, 0, scm_delete_x);
+#ifdef __STDC__
+SCM
+scm_delete_x (SCM item, SCM lst)
+#else
+SCM
+scm_delete_x (item, lst)
+     SCM item;
+     SCM lst;
+#endif
+{
+  SCM start;
+
+  if (SCM_IMP (lst) || SCM_NCONSP (lst))
+    return lst;
+
+  if (SCM_BOOL_F != scm_equal_p (SCM_CAR (lst), item))
+    return SCM_CDR (lst);
+
+  start = lst;
+
+  while (SCM_NIMP (SCM_CDR (lst)) && SCM_CONSP (SCM_CDR (lst)))
+    {
+      if (SCM_BOOL_F != scm_equal_p (SCM_CAR (SCM_CDR (lst)), item))
+	{
+	  SCM_SETCDR (lst, SCM_CDR (SCM_CDR (lst)));
+	  return start;
+	}
+      lst = SCM_CDR (lst);
+    }
+  return start;
+}
+
+
+
+
+SCM_PROC (s_list_copy, "list-copy", 1, 0, 0, scm_list_copy);
+#ifdef __STDC__
+SCM 
+scm_list_copy (SCM lst)
+#else
+SCM 
+scm_list_copy (lst)
+     SCM lst;
+#endif
+{
+  SCM newlst;
+  SCM * fill_here;
+  SCM from_here;
+
+  newlst = SCM_EOL;
+  fill_here = &newlst;
+  from_here = lst;
+
+  while (SCM_NIMP (from_here) && SCM_CONSP (from_here))
+    {
+      SCM c;
+      c = scm_cons (SCM_CAR (from_here), SCM_CDR (from_here));
+      *fill_here = c;
+      fill_here = &SCM_CDR (c);
+      from_here = SCM_CDR (from_here);
+    }
+  return newlst;
+}
+
+
+
+SCM_PROC (s_delq, "delq", 2, 0, 0, scm_delq);
+#ifdef __STDC__
+SCM
+scm_delq (SCM item, SCM lst)
+#else
+SCM
+scm_delq (item, lst)
+     SCM item;
+     SCM lst;
+#endif
+{
+  SCM copy;
+
+  copy = scm_list_copy (lst);
+  return scm_delq_x (item, copy);
+}
+
+SCM_PROC (s_delv, "delv", 2, 0, 0, scm_delv);
+#ifdef __STDC__
+SCM
+scm_delv (SCM item, SCM lst)
+#else
+SCM
+scm_delv (item, lst)
+     SCM item;
+     SCM lst;
+#endif
+{
+  SCM copy;
+
+  copy = scm_list_copy (lst);
+  return scm_delv_x (item, copy);
+}
+
+SCM_PROC (s_delete, "delete", 2, 0, 0, scm_delete);
+#ifdef __STDC__
+SCM
+scm_delete (SCM item, SCM lst)
+#else
+SCM
+scm_delete (item, lst)
+     SCM item;
+     SCM lst;
+#endif
+{
+  SCM copy;
+
+  copy = scm_list_copy (lst);
+  return scm_delete_x (item, copy);
+}
+
+
+
+
+#ifdef __STDC__
+void
+scm_init_list (void)
+#else
+void
+scm_init_list ()
+#endif
+{
+#include "list.x"
+}
+
diff --git a/libguile/list.h b/libguile/list.h
new file mode 100644
index 000000000..ab0555540
--- /dev/null
+++ b/libguile/list.h
@@ -0,0 +1,126 @@
+/* classes: h_files */
+
+#ifndef LISTH
+#define LISTH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+
+
+
+
+
+
+#ifdef __STDC__
+extern SCM scm_listify (SCM elt, ...);
+extern SCM scm_list(SCM objs);
+extern SCM scm_null_p(SCM x);
+extern SCM scm_list_p(SCM x);
+extern long scm_ilength(SCM sx);
+extern SCM scm_list_length(SCM x);
+extern SCM scm_list_append(SCM args);
+extern SCM scm_list_append_x(SCM args);
+extern SCM scm_list_reverse(SCM lst);
+extern SCM scm_list_reverse_x (SCM lst, SCM newtail);
+extern SCM scm_list_ref(SCM lst, SCM k);
+extern SCM scm_list_set_x(SCM lst, SCM k, SCM val);
+extern SCM scm_list_cdr_ref(SCM lst, SCM k);
+extern SCM scm_list_cdr_set_x(SCM lst, SCM k, SCM val);
+extern SCM scm_last_pair(SCM sx);
+extern SCM scm_list_tail(SCM lst, SCM k);
+extern SCM scm_sloppy_memq(SCM x, SCM lst);
+extern SCM scm_sloppy_memv(SCM x, SCM lst);
+extern SCM scm_sloppy_member (SCM x, SCM lst);
+extern SCM scm_memq(SCM x, SCM lst);
+extern SCM scm_memv(SCM x, SCM lst);
+extern SCM scm_member(SCM x, SCM lst);
+extern SCM scm_delq_x (SCM item, SCM lst);
+extern SCM scm_delv_x (SCM item, SCM lst);
+extern SCM scm_delete_x (SCM item, SCM lst);
+extern SCM scm_list_copy (SCM lst);
+extern SCM scm_delq (SCM item, SCM lst);
+extern SCM scm_delv (SCM item, SCM lst);
+extern SCM scm_delete (SCM item, SCM lst);
+extern void scm_init_list (void);
+
+#else /* STDC */
+extern SCM scm_listify ();
+extern SCM scm_list();
+extern SCM scm_null_p();
+extern SCM scm_list_p();
+extern long scm_ilength();
+extern SCM scm_list_length();
+extern SCM scm_list_append();
+extern SCM scm_list_append_x();
+extern SCM scm_list_reverse();
+extern SCM scm_list_reverse_x ();
+extern SCM scm_list_ref();
+extern SCM scm_list_set_x();
+extern SCM scm_list_cdr_ref();
+extern SCM scm_list_cdr_set_x();
+extern SCM scm_last_pair();
+extern SCM scm_list_tail();
+extern SCM scm_sloppy_memq();
+extern SCM scm_sloppy_memv();
+extern SCM scm_sloppy_member ();
+extern SCM scm_memq();
+extern SCM scm_memv();
+extern SCM scm_member();
+extern SCM scm_delq_x ();
+extern SCM scm_delv_x ();
+extern SCM scm_delete_x ();
+extern SCM scm_list_copy ();
+extern SCM scm_delq ();
+extern SCM scm_delv ();
+extern SCM scm_delete ();
+extern void scm_init_list ();
+
+#endif /* STDC */
+
+
+
+
+
+
+
+#endif  /* LISTH */
diff --git a/libguile/load.c b/libguile/load.c
new file mode 100644
index 000000000..b2a54d79a
--- /dev/null
+++ b/libguile/load.c
@@ -0,0 +1,91 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+
+SCM_PROC(s_sys_try_load, "%try-load", 1, 2, 0, scm_sys_try_load);
+#ifdef __STDC__
+SCM 
+scm_sys_try_load (SCM filename, SCM case_insensative_p, SCM sharp)
+#else
+SCM 
+scm_sys_try_load (filename, case_insensative_p, sharp)
+     SCM filename;
+     SCM case_insensative_p;
+     SCM sharp;
+#endif
+{
+  SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename, SCM_ARG1, s_sys_try_load);
+  {
+    SCM form, port;
+    port = scm_open_file (filename,
+			  scm_makfromstr ("r", (scm_sizet) sizeof (char), 0));
+    if (SCM_FALSEP (port))
+      return SCM_BOOL_F;
+    while (1)
+      {
+	form = scm_read (port, case_insensative_p, sharp);
+	if (SCM_EOF_VAL == form)
+	  break;
+	scm_eval_x (form);
+      }
+    scm_close_port (port);
+  }
+  return SCM_BOOL_T;
+}
+
+
+
+#ifdef __STDC__
+void
+scm_init_load (void)
+#else
+void
+scm_init_load ()
+#endif
+{
+#include "load.x"
+}
+
diff --git a/libguile/load.h b/libguile/load.h
new file mode 100644
index 000000000..eab41b173
--- /dev/null
+++ b/libguile/load.h
@@ -0,0 +1,62 @@
+/* classes: h_files */
+
+#ifndef LOADH
+#define LOADH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+
+
+#ifdef __STDC__
+extern SCM scm_sys_try_load (SCM filename, SCM casep, SCM sharp);
+extern void scm_init_load (void);
+
+#else /* STDC */
+extern SCM scm_sys_try_load ();
+extern void scm_init_load ();
+
+#endif /* STDC */
+
+
+
+
+#endif  /* LOADH */
diff --git a/libguile/mallocs.c b/libguile/mallocs.c
new file mode 100644
index 000000000..27f1a791c
--- /dev/null
+++ b/libguile/mallocs.c
@@ -0,0 +1,113 @@
+/* classes: src_files */
+
+/*	Copyright (C) 1995 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ */
+
+
+
+#include <stdio.h>
+#include "_scm.h"
+#include "mallocs.h"
+#ifdef HAVE_MALLOC_H
+#include "malloc.h"
+#endif
+#ifdef HAVE_UNISTD_H
+#include "unistd.h"
+#endif
+
+
+
+
+
+#ifdef __STDC__
+static scm_sizet
+fmalloc(SCM ptr)
+#else
+static scm_sizet
+fmalloc(ptr)
+     SCM ptr;
+#endif
+{
+  if (SCM_MALLOCDATA (ptr))
+    free (SCM_MALLOCDATA (ptr));
+  return 0;
+}
+
+#ifdef __STDC__
+static int
+prinmalloc (SCM exp, SCM port, int writing)
+#else
+static int
+prinmalloc (exp, port, writing)
+     SCM exp;
+     SCM port;
+     int writing;
+#endif
+{
+  scm_gen_puts(scm_regular_string, "#<malloc ", port);
+  scm_intprint(SCM_CDR(exp), 16, port);
+  scm_gen_putc('>', port);
+  return 1;
+}
+
+
+int scm_tc16_malloc;
+static scm_smobfuns mallocsmob = {scm_mark0, fmalloc, prinmalloc, 0};
+
+
+
+#ifdef __STDC__
+SCM
+scm_malloc_obj (scm_sizet n)
+#else
+SCM
+scm_malloc_obj (n)
+     scm_sizet n;
+#endif
+{
+  SCM answer;
+  SCM mem;
+
+  SCM_NEWCELL (answer);
+  SCM_DEFER_INTS;
+  mem = (n
+	 ? (SCM)malloc (n)
+	 : 0);
+  if (n && !mem)
+    {
+      SCM_ALLOW_INTS;
+      return SCM_BOOL_F;
+    }
+  SCM_CDR (answer) = mem;
+  SCM_CAR (answer) = scm_tc16_malloc;
+  SCM_ALLOW_INTS;
+  return answer;
+}
+
+
+
+#ifdef __STDC__
+void 
+scm_init_mallocs (void)
+#else
+void 
+scm_init_mallocs ()
+#endif
+{
+  scm_tc16_malloc = scm_newsmob (&mallocsmob);
+}
+
diff --git a/libguile/mallocs.h b/libguile/mallocs.h
new file mode 100644
index 000000000..779c25d18
--- /dev/null
+++ b/libguile/mallocs.h
@@ -0,0 +1,66 @@
+/* classes: h_files */
+
+#ifndef MALLOCSH
+#define MALLOCSH
+/*	Copyright (C) 1995 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+extern int scm_tc16_malloc;
+
+#define SCM_MALLOCP(X)  (SCM_TYP16 (X) == scm_tc16_malloc)
+#define SCM_MALLOCDATA(obj) ((char *)SCM_CDR(obj))
+#define SCM_SETMALLOCDATA(obj, val) ((char *)SCM_SETCDR(obj, val))
+
+
+#ifdef __STDC__
+extern SCM scm_malloc_obj (scm_sizet n);
+extern void scm_init_mallocs (void);
+
+#else /* STDC */
+extern SCM scm_malloc_obj ();
+extern void scm_init_mallocs ();
+
+#endif /* STDC */
+
+
+
+#endif  /* MALLOCSH */
diff --git a/libguile/markers.c b/libguile/markers.c
new file mode 100644
index 000000000..d6a3c8288
--- /dev/null
+++ b/libguile/markers.c
@@ -0,0 +1,92 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+
+/* {GC marking}
+ */
+
+#ifdef __STDC__
+SCM 
+scm_mark0 (SCM ptr)
+#else
+SCM 
+scm_mark0 (ptr)
+     SCM ptr;
+#endif
+{
+  SCM_SETGC8MARK (ptr);
+  return SCM_BOOL_F;
+}
+
+
+#ifdef __STDC__
+SCM 
+scm_markcdr (SCM ptr)
+#else
+SCM 
+scm_markcdr (ptr)
+     SCM ptr;
+#endif
+{
+  if (SCM_GC8MARKP (ptr))
+    return SCM_BOOL_F;
+  SCM_SETGC8MARK (ptr);
+  return SCM_CDR (ptr);
+}
+
+#ifdef __STDC__
+scm_sizet 
+scm_free0 (SCM ptr)
+#else
+scm_sizet 
+scm_free0 (ptr)
+     SCM ptr;
+#endif
+{
+  return 0;
+}
+
+
diff --git a/libguile/markers.h b/libguile/markers.h
new file mode 100644
index 000000000..0debbc4ac
--- /dev/null
+++ b/libguile/markers.h
@@ -0,0 +1,68 @@
+/* classes: h_files */
+
+#ifndef MARKERSH
+#define MARKERSH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+
+
+
+
+
+
+#ifdef __STDC__
+extern SCM scm_mark0 (SCM ptr);
+extern SCM scm_markcdr (SCM ptr);
+extern scm_sizet scm_free0 (SCM ptr);
+
+#else /* STDC */
+extern SCM scm_mark0 ();
+extern SCM scm_markcdr ();
+extern scm_sizet scm_free0 ();
+
+#endif /* STDC */
+
+
+
+#endif  /* MARKERSH */
diff --git a/libguile/mbstrings.c b/libguile/mbstrings.c
new file mode 100644
index 000000000..4d8bb1834
--- /dev/null
+++ b/libguile/mbstrings.c
@@ -0,0 +1,568 @@
+
+
+/*	Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+
+#include "extchrs.h"
+#include <stdio.h>
+#include "_scm.h"
+
+
+
+SCM_PROC(s_multi_byte_string_p, "multi-byte-string?", 1, 0, 0, scm_multi_byte_string_p);
+#ifdef __STDC__
+SCM
+scm_multi_byte_string_p (SCM obj)
+#else
+SCM
+scm_multi_byte_string_p (obj)
+     SCM obj;
+#endif
+{
+  return (SCM_MB_STRINGP (obj)
+	  ? SCM_BOOL_T
+	  : SCM_BOOL_F);
+}
+
+
+#ifdef __STDC__
+SCM
+scm_regular_string_p (SCM obj)
+#else
+SCM
+scm_regular_string_p (obj)
+     SCM obj;
+#endif
+{
+  return (SCM_REGULAR_STRINGP (obj)
+	  ? SCM_BOOL_T
+	  : SCM_BOOL_F);
+}
+
+SCM_PROC(s_list_to_multi_byte_string, "list->multi-byte-string", 1, 0, 0, scm_multi_byte_string);
+SCM_PROC(s_multi_byte_string, "multi-byte-string", 0, 0, 1, scm_multi_byte_string);
+#ifdef __STDC__
+SCM
+scm_multi_byte_string (SCM chrs)
+#else
+SCM
+scm_multi_byte_string (chrs)
+     SCM chrs;
+#endif
+{
+  SCM res;
+  register char *data;
+  long i;
+  long byte_len;
+
+  i = scm_ilength (chrs);
+  SCM_ASSERT (i >= 0, chrs, SCM_ARG1, s_multi_byte_string);
+  i = i * XMB_CUR_MAX;
+  res = scm_makstr (i, 0);
+  SCM_SETLENGTH (res, SCM_LENGTH (res), scm_tc7_mb_string);
+  data = SCM_CHARS (res);
+  byte_len = 0;
+  xwctomb (0, 0);
+  while (i && SCM_NNULLP (chrs))
+    {
+      int used;
+      SCM ch;
+
+      ch = SCM_CAR (chrs);
+      SCM_ASSERT (SCM_ICHRP (ch), chrs, SCM_ARG1, s_multi_byte_string);
+      used = xwctomb (data + byte_len,  SCM_ICHR (ch));
+      SCM_ASSERT (used >= 0, chrs, SCM_ARG1, s_multi_byte_string);
+      byte_len += (used ? used : 1);
+      chrs = SCM_CDR (chrs);
+      --i;
+    }
+  res = scm_vector_set_length_x (res, SCM_MAKINUM (byte_len));
+  return res;
+}
+
+#ifdef __STDC__
+int
+scm_mb_ilength (unsigned char * data, int size)
+#else
+int
+scm_mb_ilength (data, size)
+     unsigned char * data;
+     int size;
+#endif
+{
+  int pos;
+  int len;
+  
+  len = 0;
+  pos = 0;
+  xmblen (0, 0);
+  while (pos < size)
+    {
+      int inc;
+
+      inc = xmblen (data + pos, size - pos);
+      if (inc == 0)
+	++inc;
+      
+      if (inc < 0)
+	return -1;
+
+      ++len;
+      pos += inc;
+    }
+
+  return len;
+}
+
+SCM_PROC(s_multi_byte_string_length, "multi-byte-string-length", 1, 0, 0, scm_multi_byte_string_length);
+#ifdef __STDC__
+SCM
+scm_multi_byte_string_length (SCM str)
+#else
+SCM
+scm_multi_byte_string_length (str)
+     SCM str;
+#endif
+{
+  int size;
+  int len;
+  unsigned char * data;
+
+  SCM_ASSERT (SCM_NIMP (str) && SCM_ROSTRINGP (str), str, SCM_ARG1, s_multi_byte_string_length);
+
+  data = SCM_ROCHARS (str);
+  size = SCM_ROLENGTH (str);
+  len = scm_mb_ilength (data, size);
+  SCM_ASSERT (len >= 0, str, SCM_ARG1, s_multi_byte_string_length);
+  return SCM_MAKINUM (len);
+}
+
+
+SCM_PROC(s_symbol_multi_byte_p, "symbol-multi-byte?", 1, 0, 0, scm_symbol_multi_byte_p);
+#ifdef __STDC__
+SCM
+scm_symbol_multi_byte_p (SCM symbol)
+#else
+SCM
+scm_symbol_multi_byte_p (symbol)
+     SCM symbol;
+#endif
+{
+  return SCM_SYMBOL_MULTI_BYTE_SCM_STRINGP(symbol);
+}
+
+SCM_PROC(s_set_symbol_multi_byte_x, "set-symbol-multi-byte!", 2, 0, 0, scm_set_symbol_multi_byte_x);
+#ifdef __STDC__
+SCM
+scm_set_symbol_multi_byte_x (SCM symbol, SCM val)
+#else
+SCM
+scm_set_symbol_multi_byte_x (symbol, val)
+     SCM symbol;
+     SCM val;
+#endif
+{
+  if (SCM_TYP7 (symbol) == scm_tc7_msymbol)
+    {
+      SCM_SYMBOL_MULTI_BYTE_SCM_STRINGP(symbol) = (SCM_FALSEP (val)
+						   ? SCM_BOOL_F
+						   : SCM_BOOL_T);
+    }
+  return SCM_UNSPECIFIED;
+}
+
+
+SCM_PROC(s_regular_port_p, "regular-port?", 1, 0, 0, scm_regular_port_p);
+#ifdef __STDC__
+SCM 
+scm_regular_port_p (SCM p)
+#else
+SCM 
+scm_regular_port_p (p)
+     SCM p;
+#endif
+{
+  return (SCM_PORT_REPRESENTATION(p) == scm_regular_port
+	  ? SCM_BOOL_T
+	  : SCM_BOOL_F);
+}
+
+SCM_PROC(s_regular_port_x, "regular-port!", 1, 0, 0, scm_regular_port_x);
+#ifdef __STDC__
+SCM 
+scm_regular_port_x (SCM p)
+#else
+SCM 
+scm_regular_port_x (p)
+     SCM p;
+#endif
+{
+  SCM_PORT_REPRESENTATION(p) = scm_regular_port;
+  return SCM_UNSPECIFIED;
+}
+
+SCM_PROC(s_multi_byte_port_p, "multi-byte-port?", 1, 0, 0, scm_multi_byte_port_p);
+#ifdef __STDC__
+SCM 
+scm_multi_byte_port_p (SCM p)
+#else
+SCM 
+scm_multi_byte_port_p (p)
+     SCM p;
+#endif
+{
+  return (SCM_PORT_REPRESENTATION(p) == scm_mb_port
+	  ? SCM_BOOL_T
+	  : SCM_BOOL_F);
+}
+
+SCM_PROC(s_multi_byte_port_x, "multi-byte-port!", 1, 0, 0, scm_multi_byte_port_x);
+#ifdef __STDC__
+SCM 
+scm_multi_byte_port_x (SCM p)
+#else
+SCM 
+scm_multi_byte_port_x (p)
+     SCM p;
+#endif
+{
+  SCM_PORT_REPRESENTATION(p) = scm_mb_port;
+  return SCM_UNSPECIFIED;
+}
+
+
+SCM_PROC(s_wide_character_port_p, "wide-character-port?", 1, 0, 0, scm_wide_character_port_p);
+#ifdef __STDC__
+SCM 
+scm_wide_character_port_p (SCM p)
+#else
+SCM 
+scm_wide_character_port_p (p)
+     SCM p;
+#endif
+{
+  return (SCM_PORT_REPRESENTATION(p) == scm_wchar_port
+	  ? SCM_BOOL_T
+	  : SCM_BOOL_F);
+}
+
+SCM_PROC(s_wide_character_port_x, "wide-character-port!", 1, 0, 0, scm_wide_character_port_x);
+#ifdef __STDC__
+SCM 
+scm_wide_character_port_x (SCM p)
+#else
+SCM 
+scm_wide_character_port_x (p)
+     SCM p;
+#endif
+{
+  SCM_PORT_REPRESENTATION(p) = scm_wchar_port;
+  return SCM_UNSPECIFIED;
+}
+
+
+
+
+
+#ifdef __STDC__
+void
+scm_put_wchar (int c, SCM port, int writing)
+#else
+void
+scm_put_wchar (c, port, writing)
+     int c;
+     SCM port;
+     int writing;
+#endif
+{
+  if (writing)
+    scm_gen_puts (scm_regular_string, "#\\", port);
+  switch (SCM_PORT_REPRESENTATION (port))
+    {
+    case scm_regular_port:
+      {
+	if (c < 256)
+	  {
+	    if (!writing)
+	      scm_gen_putc ((unsigned char)c, port);
+	    else if ((c <= ' ') && scm_charnames[c])
+	      scm_gen_puts (scm_regular_string, scm_charnames[c], port);
+	    else if (c > '\177')
+	      scm_intprint (c, 8, port);
+	    else
+	      scm_gen_putc ((int) c, port);
+	  }
+	else
+	  {
+	  print_octal:
+	    if (!writing)
+	      scm_gen_putc ('\\', port);
+	    scm_intprint (c, 8, port);
+	  }
+	break;
+      }
+
+    case scm_mb_port:
+      {
+	char buf[256];
+	int len;
+
+	if (XMB_CUR_MAX > sizeof (buf))
+	  goto print_octal;
+
+	len = xwctomb (buf, c);
+
+	if (len < 0)
+	  goto print_octal;
+
+	if (len == 0)
+	  scm_gen_putc (0, port);
+	else
+	  scm_gen_putc (c, port);
+	break;
+      }
+
+    case scm_wchar_port:
+      {
+	scm_gen_putc (c, port);
+	break;
+      }
+    }
+}
+
+
+
+
+
+#ifdef __STDC__
+void
+scm_print_mb_string (SCM exp, SCM port, int writing)
+#else
+void
+scm_print_mb_string (exp, port, writing)
+     SCM exp;
+     SCM port;
+     int writing;
+#endif
+{
+  if (writing)
+    {
+      int i;
+      int len;
+      char * data;
+
+      scm_gen_putc ('\"', port);
+      i = 0;
+      len = SCM_ROLENGTH (exp);
+      data = SCM_ROCHARS (exp);
+
+      while (i < len)
+	{
+	  xwchar_t c;
+	  int inc;
+
+	  inc = xmbtowc (&c, data + i, len - i);
+	  if (inc == 0)
+	    inc = 1;
+	  if (inc < 0)
+	    {
+	      inc = 1;
+	      c = data[i];
+	    }
+	  i += inc;
+	  switch (c)
+	    {
+	    case '\"':
+	    case '\\':
+	      scm_gen_putc ('\\', port);
+	    default:
+	      scm_gen_putc (c, port);
+	    }
+	}
+      scm_gen_putc ('\"', port);
+    }
+  else
+    scm_gen_write (scm_mb_string, SCM_ROCHARS (exp), SCM_ROLENGTH (exp), port);
+}
+
+
+#ifdef __STDC__
+void
+scm_print_mb_symbol (SCM exp, SCM port)
+#else
+void
+scm_print_mb_symbol (exp, port)
+     SCM exp;
+     SCM port;
+#endif
+{
+  int pos;
+  int end;
+  int len;
+  char * str;
+  int weird;
+  int maybe_weird;
+  int mw_pos;
+  int inc;
+  xwchar_t c;
+
+  len = SCM_LENGTH (exp);
+  str = SCM_CHARS (exp);
+  scm_remember (&exp);
+  pos = 0;
+  weird = 0;
+  maybe_weird = 0;
+
+  for (end = pos; end < len; end += inc)
+    {
+      inc = xmbtowc (&c, str + end, len - end);
+      if (inc < 0)
+	{
+	  inc = 1;
+	  c = str[end];
+	  goto weird_handler;
+	}
+      if (inc == 0)
+	{
+	  inc = 1;
+	  goto weird_handler;
+	}
+      switch (c)
+	{
+#ifdef BRACKETS_AS_PARENS
+	case '[':
+	case ']':
+#endif
+	case '(':
+	case ')':
+	case '\"':
+	case ';':
+	case SCM_WHITE_SPACES:
+	case SCM_LINE_INCREMENTORS:
+	weird_handler:
+	  if (maybe_weird)
+	    {
+	      end = mw_pos;
+	      maybe_weird = 0;
+	    }
+	  if (!weird)
+	    {
+	      scm_gen_write (scm_regular_string, "#{", 2, port);
+	      weird = 1;
+	    }
+	  if (pos < end)
+	    {
+	      int q;
+	      int qinc;
+
+	      q = pos;
+	      while (q < end)
+		{
+		  qinc = xmbtowc (&c, str + q, end - q);
+		  if (inc <= 0)
+		    {
+		      inc = 1;
+		      c = str[q];
+		    }
+		  scm_gen_putc (c, port);
+		  q += qinc;
+		}
+	    }
+	  {
+	    char buf[2];
+	    buf[0] = '\\';
+	    buf[1] = str[end];
+	    scm_gen_write (scm_regular_string, buf, 2, port);
+	  }
+	  pos = end + 1;
+	  break;
+	case '\\':
+	  if (weird)
+	    goto weird_handler;
+	  if (!maybe_weird)
+	    {
+	      maybe_weird = 1;
+	      mw_pos = pos;
+	    }
+	  break;
+	case '}':
+	case '#':
+	  if (weird)
+	    goto weird_handler;
+	  break;
+	default:
+	  break;
+	}
+    }
+  if (pos < end)
+    {
+      int q;
+      int qinc;
+      q = pos;
+      while (q < end)
+	{
+	  qinc = xmbtowc (&c, str + q, end - q);
+	  if (inc <= 0)
+	    inc = 1;
+	  scm_gen_putc (c, port);
+	  q += qinc;
+	}
+    }
+  if (weird)
+    scm_gen_write (scm_regular_string, "}#", 2, port);
+}
+
+
+
+
+#ifdef __STDC__
+void
+scm_init_mbstrings (void)
+#else
+void
+scm_init_mbstrings ()
+#endif
+{
+#include "mbstrings.x"
+}
+
diff --git a/libguile/mbstrings.h b/libguile/mbstrings.h
new file mode 100644
index 000000000..e1d3ef0cb
--- /dev/null
+++ b/libguile/mbstrings.h
@@ -0,0 +1,100 @@
+/* classes: h_files */
+
+#ifndef MBSTRINGSH
+#define MBSTRINGSH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+#include "symbols.h"
+
+
+#define SCM_MB_STRINGP(x) (   (SCM_TYP7(x)==scm_tc7_mb_string) \
+			   || (   (SCM_TYP7(x) == scm_tc7_msymbol) \
+			       && (SCM_SYMBOL_MULTI_BYTE_SCM_STRINGP (x) != SCM_BOOL_F)))
+#define SCM_REGULAR_STRINGP(x) (SCM_TYP7D(x)==scm_tc7_string)
+				    
+
+
+
+#ifdef __STDC__
+extern SCM scm_multi_byte_string_p (SCM obj);
+extern SCM scm_regular_string_p (SCM obj);
+extern SCM scm_multi_byte_string (SCM chrs);
+extern int scm_mb_ilength (unsigned char * data, int size);
+extern SCM scm_multi_byte_string_length (SCM str);
+extern SCM scm_symbol_multi_byte_p (SCM symbol);
+extern SCM scm_set_symbol_multi_byte_x (SCM symbol, SCM val);
+extern SCM scm_regular_port_p (SCM p);
+extern SCM scm_regular_port_x (SCM p);
+extern SCM scm_multi_byte_port_p (SCM p);
+extern SCM scm_multi_byte_port_x (SCM p);
+extern SCM scm_wide_character_port_p (SCM p);
+extern SCM scm_wide_character_port_x (SCM p);
+extern void scm_put_wchar (int c, SCM port, int writing);
+extern void scm_print_mb_string (SCM exp, SCM port, int writing);
+extern void scm_print_mb_symbol (SCM exp, SCM port);
+extern void scm_init_mbstrings (void);
+
+#else /* STDC */
+extern SCM scm_multi_byte_string_p ();
+extern SCM scm_regular_string_p ();
+extern SCM scm_multi_byte_string ();
+extern int scm_mb_ilength ();
+extern SCM scm_multi_byte_string_length ();
+extern SCM scm_symbol_multi_byte_p ();
+extern SCM scm_set_symbol_multi_byte_x ();
+extern SCM scm_regular_port_p ();
+extern SCM scm_regular_port_x ();
+extern SCM scm_multi_byte_port_p ();
+extern SCM scm_multi_byte_port_x ();
+extern SCM scm_wide_character_port_p ();
+extern SCM scm_wide_character_port_x ();
+extern void scm_put_wchar ();
+extern void scm_print_mb_string ();
+extern void scm_print_mb_symbol ();
+extern void scm_init_mbstrings ();
+
+#endif /* STDC */
+
+
+#endif  /* MBSTRINGSH */
diff --git a/libguile/numbers.c b/libguile/numbers.c
new file mode 100644
index 000000000..b572ed79f
--- /dev/null
+++ b/libguile/numbers.c
@@ -0,0 +1,4101 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include <math.h>
+#include "_scm.h"
+
+
+
+#define DIGITS '0':case '1':case '2':case '3':case '4':\
+ case '5':case '6':case '7':case '8':case '9'
+
+
+/* IS_INF tests its floating point number for infiniteness
+ */
+#ifndef IS_INF
+# define IS_INF(x) ((x)==(x)/2)
+#endif
+
+/* MAXEXP is the maximum double precision expontent
+ * FLTMAX is less than or scm_equal the largest single precision float
+ */
+
+#ifdef SCM_FLOATS
+# ifdef STDC_HEADERS
+#  ifndef GO32
+#   include <float.h>
+#  endif /* ndef GO32 */
+# endif /* def STDC_HEADERS */
+# ifdef DBL_MAX_10_EXP
+#  define MAXEXP DBL_MAX_10_EXP
+# else
+#  define MAXEXP 308   /* IEEE doubles */
+# endif /* def DBL_MAX_10_EXP */
+# ifdef FLT_MAX
+#  define FLTMAX FLT_MAX
+# else
+#  define FLTMAX 1e+23
+# endif /* def FLT_MAX */
+#endif /* def SCM_FLOATS */
+
+
+
+SCM_PROC(s_exact_p, "exact?", 1, 0, 0, scm_exact_p);
+#ifdef __STDC__
+SCM
+scm_exact_p(SCM x)
+#else
+SCM
+scm_exact_p(x)
+     SCM x;
+#endif
+{
+  if SCM_INUMP(x) return SCM_BOOL_T;
+#ifdef SCM_BIGDIG
+  if (SCM_NIMP(x) && SCM_BIGP(x)) return SCM_BOOL_T;
+#endif
+  return SCM_BOOL_F;
+}
+
+SCM_PROC(s_odd_p, "odd?", 1, 0, 0, scm_odd_p);
+#ifdef __STDC__
+SCM
+scm_odd_p(SCM n)
+#else
+SCM
+scm_odd_p(n)
+     SCM n;
+#endif
+{
+#ifdef SCM_BIGDIG
+  if SCM_NINUMP(n) {
+    SCM_ASSERT(SCM_NIMP(n) && SCM_BIGP(n), n, SCM_ARG1, s_odd_p);
+    return (1 & SCM_BDIGITS(n)[0]) ? SCM_BOOL_T : SCM_BOOL_F;
+  }
+#else
+  SCM_ASSERT(SCM_INUMP(n), n, SCM_ARG1, s_odd_p);
+#endif
+  return (4 & (int)n) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+SCM_PROC(s_even_p, "even?", 1, 0, 0, scm_even_p);
+#ifdef __STDC__
+SCM
+scm_even_p(SCM n)
+#else
+SCM
+scm_even_p(n)
+     SCM n;
+#endif
+{
+#ifdef SCM_BIGDIG
+  if SCM_NINUMP(n) {
+    SCM_ASSERT(SCM_NIMP(n) && SCM_BIGP(n), n, SCM_ARG1, s_even_p);
+    return (1 & SCM_BDIGITS(n)[0]) ? SCM_BOOL_F : SCM_BOOL_T;
+  }
+#else
+  SCM_ASSERT(SCM_INUMP(n), n, SCM_ARG1, s_even_p);
+#endif
+  return (4 & (int)n) ? SCM_BOOL_F : SCM_BOOL_T;
+}
+
+SCM_PROC(s_abs, "abs", 1, 0, 0, scm_abs);
+#ifdef __STDC__
+SCM
+scm_abs(SCM x)
+#else
+SCM
+scm_abs(x)
+     SCM x;
+#endif
+{
+#ifdef SCM_BIGDIG
+  if SCM_NINUMP(x) {
+    SCM_ASSERT(SCM_NIMP(x) && SCM_BIGP(x), x, SCM_ARG1, s_abs);
+    if (SCM_TYP16(x)==scm_tc16_bigpos) return x;
+    return scm_copybig(x, 0);
+  }
+#else
+  SCM_ASSERT(SCM_INUMP(x), x, SCM_ARG1, s_abs);
+#endif
+  if (SCM_INUM(x) >= 0) return x;
+  x = -SCM_INUM(x);
+  if (!SCM_POSSCM_FIXABLE(x))
+#ifdef SCM_BIGDIG
+    return scm_long2big(x);
+#else
+  scm_wta(SCM_MAKINUM(-x), (char *)SCM_OVSCM_FLOW, s_abs);
+#endif
+  return SCM_MAKINUM(x);
+}
+
+SCM_PROC(s_quotient, "quotient", 2, 0, 0, scm_quotient);
+#ifdef __STDC__
+SCM
+scm_quotient(SCM x, SCM y)
+#else
+SCM
+scm_quotient(x, y)
+     SCM x;
+     SCM y;
+#endif
+{
+  register long z;
+#ifdef SCM_BIGDIG
+  if SCM_NINUMP(x) {
+    long w;
+    SCM_ASSERT(SCM_NIMP(x) && SCM_BIGP(x), x, SCM_ARG1, s_quotient);
+    if SCM_NINUMP(y) {
+      SCM_ASRTGO(SCM_NIMP(y) && SCM_BIGP(y), bady);
+      return scm_divbigbig(SCM_BDIGITS(x),
+			   SCM_NUMDIGS(x),
+			   SCM_BDIGITS(y),
+			   SCM_NUMDIGS(y),
+			   SCM_BIGSIGN(x) ^ SCM_BIGSIGN(y),
+			   2);
+    }
+    z = SCM_INUM(y);
+    SCM_ASRTGO(z, ov);
+    if (1==z) return x;
+    if (z < 0) z = -z;
+    if (z < SCM_BIGRAD) {
+      w = scm_copybig(x, SCM_BIGSIGN(x) ? (y>0) : (y<0));
+      scm_divbigdig(SCM_BDIGITS(w), SCM_NUMDIGS(w), (SCM_BIGDIG)z);
+      return scm_normbig(w);
+    }
+#ifndef SCM_DIGSTOOBIG
+    w = scm_pseudolong(z);
+    return scm_divbigbig(SCM_BDIGITS(x), SCM_NUMDIGS(x), (SCM_BIGDIG *)&w, SCM_DIGSPERLONG,
+			 SCM_BIGSIGN(x) ? (y>0) : (y<0), 2);
+#else
+    { SCM_BIGDIG zdigs[SCM_DIGSPERLONG];
+      scm_longdigs(z, zdigs);
+      return scm_divbigbig(SCM_BDIGITS(x), SCM_NUMDIGS(x), zdigs, SCM_DIGSPERLONG,
+			   SCM_BIGSIGN(x) ? (y>0) : (y<0), 2);
+    }
+#endif
+  }
+  if SCM_NINUMP(y) {
+# ifndef RECKLESS
+    if (!(SCM_NIMP(y) && SCM_BIGP(y)))
+    bady: scm_wta(y, (char *)SCM_ARG2, s_quotient);
+# endif
+    return SCM_INUM0;
+  }
+#else
+  SCM_ASSERT(SCM_INUMP(x), x, SCM_ARG1, s_quotient);
+  SCM_ASSERT(SCM_INUMP(y), y, SCM_ARG2, s_quotient);
+#endif
+  if ((z = SCM_INUM(y))==0)
+    ov: scm_wta(y, (char *)SCM_OVSCM_FLOW, s_quotient);
+  z = SCM_INUM(x)/z;
+#ifdef BADIVSGNS
+  {
+#if (__TURBOC__==1)
+    long t = ((y<0) ? -SCM_INUM(x) : SCM_INUM(x))%SCM_INUM(y);
+#else
+    long t = SCM_INUM(x)%SCM_INUM(y);
+#endif
+    if (t==0) ;
+    else if (t < 0)
+      if (x < 0) ;
+      else z--;
+    else if (x < 0) z++;
+  }
+#endif
+  if (!SCM_FIXABLE(z))
+#ifdef SCM_BIGDIG
+    return scm_long2big(z);
+#else
+  scm_wta(x, (char *)SCM_OVSCM_FLOW, s_quotient);
+#endif
+  return SCM_MAKINUM(z);
+}
+
+SCM_PROC(s_remainder, "remainder", 2, 0, 0, scm_remainder);
+#ifdef __STDC__
+SCM
+scm_remainder(SCM x, SCM y)
+#else
+SCM
+scm_remainder(x, y)
+     SCM x;
+     SCM y;
+#endif
+{
+  register long z;
+#ifdef SCM_BIGDIG
+  if SCM_NINUMP(x) {
+    SCM_ASSERT(SCM_NIMP(x) && SCM_BIGP(x), x, SCM_ARG1, s_remainder);
+    if SCM_NINUMP(y) {
+      SCM_ASRTGO(SCM_NIMP(y) && SCM_BIGP(y), bady);
+      return scm_divbigbig(SCM_BDIGITS(x), SCM_NUMDIGS(x), SCM_BDIGITS(y), SCM_NUMDIGS(y),
+			   SCM_BIGSIGN(x), 0);
+    }
+    if (!(z = SCM_INUM(y))) goto ov;
+    return scm_divbigint(x, z, SCM_BIGSIGN(x), 0);
+  }
+  if SCM_NINUMP(y) {
+# ifndef RECKLESS
+    if (!(SCM_NIMP(y) && SCM_BIGP(y)))
+    bady: scm_wta(y, (char *)SCM_ARG2, s_remainder);
+# endif
+    return x;
+  }
+#else
+  SCM_ASSERT(SCM_INUMP(x), x, SCM_ARG1, s_remainder);
+  SCM_ASSERT(SCM_INUMP(y), y, SCM_ARG2, s_remainder);
+#endif
+  if (!(z = SCM_INUM(y)))
+    ov: scm_wta(y, (char *)SCM_OVSCM_FLOW, s_remainder);
+#if (__TURBOC__==1)
+  if (z < 0) z = -z;
+#endif
+  z = SCM_INUM(x)%z;
+#ifdef BADIVSGNS
+  if (!z) ;
+  else if (z < 0)
+    if (x < 0) ;
+    else z += SCM_INUM(y);
+  else if (x < 0) z -= SCM_INUM(y);
+#endif
+  return SCM_MAKINUM(z);
+}
+
+SCM_PROC(s_modulo, "modulo", 2, 0, 0, scm_modulo);
+#ifdef __STDC__
+SCM
+scm_modulo(SCM x, SCM y)
+#else
+SCM
+scm_modulo(x, y)
+     SCM x;
+     SCM y;
+#endif
+{
+  register long yy, z;
+#ifdef SCM_BIGDIG
+  if SCM_NINUMP(x) {
+    SCM_ASSERT(SCM_NIMP(x) && SCM_BIGP(x), x, SCM_ARG1, s_modulo);
+    if SCM_NINUMP(y) {
+      SCM_ASRTGO(SCM_NIMP(y) && SCM_BIGP(y), bady);
+      return scm_divbigbig(SCM_BDIGITS(x), SCM_NUMDIGS(x), SCM_BDIGITS(y), SCM_NUMDIGS(y),
+			   SCM_BIGSIGN(y), (SCM_BIGSIGN(x) ^ SCM_BIGSIGN(y)) ? 1 : 0);
+    }
+    if (!(z = SCM_INUM(y))) goto ov;
+    return scm_divbigint(x, z, y < 0, (SCM_BIGSIGN(x) ? (y > 0) : (y < 0)) ? 1 : 0);
+  }
+  if SCM_NINUMP(y) {
+# ifndef RECKLESS
+    if (!(SCM_NIMP(y) && SCM_BIGP(y)))
+    bady: scm_wta(y, (char *)SCM_ARG2, s_modulo);
+# endif
+    return (SCM_BIGSIGN(y) ? (x>0) : (x<0)) ? scm_sum(x, y) : x;
+  }
+#else
+  SCM_ASSERT(SCM_INUMP(x), x, SCM_ARG1, s_modulo);
+  SCM_ASSERT(SCM_INUMP(y), y, SCM_ARG2, s_modulo);
+#endif
+  if (!(yy = SCM_INUM(y)))
+    ov: scm_wta(y, (char *)SCM_OVSCM_FLOW, s_modulo);
+#if (__TURBOC__==1)
+  z = SCM_INUM(x);
+  z = ((yy<0) ? -z : z)%yy;
+#else
+  z = SCM_INUM(x)%yy;
+#endif
+  return SCM_MAKINUM(((yy<0) ? (z>0) : (z<0)) ? z+yy : z);
+}
+
+SCM_PROC1 (s_gcd, "gcd", scm_tc7_asubr, scm_gcd);
+#ifdef __STDC__
+SCM
+scm_gcd(SCM x, SCM y)
+#else
+SCM
+scm_gcd(x, y)
+     SCM x;
+     SCM y;
+#endif
+{
+  register long u, v, k, t;
+  if SCM_UNBNDP(y) return SCM_UNBNDP(x) ? SCM_INUM0 : x;
+ tailrec:
+#ifdef SCM_BIGDIG
+  if SCM_NINUMP(x) {
+  big_gcd:
+    SCM_ASSERT(SCM_NIMP(x) && SCM_BIGP(x), x, SCM_ARG1, s_gcd);
+    if SCM_BIGSIGN(x) x = scm_copybig(x, 0);
+  newy:
+    if SCM_NINUMP(y) {
+      SCM_ASSERT(SCM_NIMP(y) && SCM_BIGP(y), y, SCM_ARG2, s_gcd);
+      if SCM_BIGSIGN(y) y = scm_copybig(y, 0);
+      switch (scm_bigcomp(x, y)) {
+      case -1:
+      swaprec: t = scm_remainder(x, y); x = y; y = t; goto tailrec;
+      case  0: return x;
+      case  1: y = scm_remainder(y, x); goto newy;
+      }
+      /* instead of the switch, we could just return scm_gcd(y, scm_modulo(x, y)); */
+    }
+    if (SCM_INUM0==y) return x; goto swaprec;
+  }
+  if SCM_NINUMP(y) { t=x; x=y; y=t; goto big_gcd;}
+#else
+  SCM_ASSERT(SCM_INUMP(x), x, SCM_ARG1, s_gcd);
+  SCM_ASSERT(SCM_INUMP(y), y, SCM_ARG2, s_gcd);
+#endif
+  u = SCM_INUM(x);
+  if (u<0) u = -u;
+  v = SCM_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 = SCM_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 (!SCM_POSSCM_FIXABLE(u))
+#ifdef SCM_BIGDIG
+    return scm_long2big(u);
+#else
+  scm_wta(x, (char *)SCM_OVSCM_FLOW, s_gcd);
+#endif
+  return SCM_MAKINUM(u);
+}
+
+SCM_PROC1 (s_lcm, "lcm", scm_tc7_asubr, scm_lcm);
+#ifdef __STDC__
+SCM
+scm_lcm(SCM n1, SCM n2)
+#else
+SCM
+scm_lcm(n1, n2)
+     SCM n1;
+     SCM n2;
+#endif
+{
+  SCM d;
+  if SCM_UNBNDP(n2) {
+    n2 = SCM_MAKINUM(1L);
+    if SCM_UNBNDP(n1) return n2;
+  }
+  d = scm_gcd(n1, n2);
+  if (SCM_INUM0==d) return d;
+  return scm_abs(scm_product(n1, scm_quotient(n2, d)));
+}
+
+#ifndef SCM_BIGDIG
+# ifndef SCM_FLOATS
+#  define scm_long2num SCM_MAKINUM
+# endif
+#endif
+
+#ifndef scm_long2num
+SCM_PROC1 (s_logand, "logand", scm_tc7_asubr, scm_logand);
+#ifdef __STDC__
+SCM
+scm_logand(SCM n1, SCM n2)
+#else
+SCM
+scm_logand(n1, n2)
+     SCM n1;
+     SCM n2;
+#endif
+{
+  return scm_long2num(scm_num2long(n1, (char *)SCM_ARG1, s_logand)
+		      & scm_num2long(n2, (char *)SCM_ARG2, s_logand));
+}
+
+SCM_PROC1 (s_logior, "logior", scm_tc7_asubr, scm_logior);
+#ifdef __STDC__
+SCM
+scm_logior(SCM n1, SCM n2)
+#else
+SCM
+scm_logior(n1, n2)
+     SCM n1;
+     SCM n2;
+#endif
+{
+  return scm_long2num(scm_num2long(n1, (char *)SCM_ARG1, s_logior)
+		      | scm_num2long(n2, (char *)SCM_ARG2, s_logior));
+}
+
+SCM_PROC1 (s_logxor, "logxor", scm_tc7_asubr, scm_logxor);
+#ifdef __STDC__
+SCM
+scm_logxor(SCM n1, SCM n2)
+#else
+SCM
+scm_logxor(n1, n2)
+     SCM n1;
+     SCM n2;
+#endif
+{
+  return scm_long2num(scm_num2long(n1, (char *)SCM_ARG1, s_logxor)
+		      ^ scm_num2long(n2, (char *)SCM_ARG2, s_logxor));
+}
+
+SCM_PROC(s_logtest, "logtest", 2, 0, 0, scm_logtest);
+#ifdef __STDC__
+SCM
+scm_logtest(SCM n1, SCM n2)
+#else
+SCM
+scm_logtest(n1, n2)
+     SCM n1;
+     SCM n2;
+#endif
+{
+  return ((scm_num2long (n1, (char *)SCM_ARG1, s_logtest)
+	   & scm_num2long (n2, (char *)SCM_ARG2, s_logtest))
+	  ? SCM_BOOL_T : SCM_BOOL_F);
+}
+
+
+SCM_PROC(s_logbit_p, "logbit?", 2, 0, 0, scm_logbit_p);
+#ifdef __STDC__
+SCM
+scm_logbit_p(SCM n1, SCM n2)
+#else
+SCM
+scm_logbit_p(n1, n2)
+     SCM n1;
+     SCM n2;
+#endif
+{
+  return (((1 << scm_num2long (n1, (char *)SCM_ARG1, s_logtest))
+	   & scm_num2long (n2, (char *)SCM_ARG2, s_logtest))
+	  ? SCM_BOOL_T : SCM_BOOL_F);
+}
+
+#else
+
+SCM_PROC1 (s_logand, "logand", scm_tc7_asubr, scm_logand);
+#ifdef __STDC__
+SCM
+scm_logand(SCM n1, SCM n2)
+#else
+SCM
+scm_logand(n1, n2)
+     SCM n1;
+     SCM n2;
+#endif
+{
+  SCM_ASSERT(SCM_INUMP(n1), n1, SCM_ARG1, s_logand);
+  SCM_ASSERT(SCM_INUMP(n2), n2, SCM_ARG2, s_logand);
+  return SCM_MAKINUM(SCM_INUM(n1) & SCM_INUM(n2));
+}
+
+SCM_PROC1 (s_logior, "logior", scm_tc7_asubr, scm_logior);
+#ifdef __STDC__
+SCM
+scm_logior(SCM n1, SCM n2)
+#else
+SCM
+scm_logior(n1, n2)
+     SCM n1;
+     SCM n2;
+#endif
+{
+  SCM_ASSERT(SCM_INUMP(n1), n1, SCM_ARG1, s_logior);
+  SCM_ASSERT(SCM_INUMP(n2), n2, SCM_ARG2, s_logior);
+  return SCM_MAKINUM(SCM_INUM(n1) | SCM_INUM(n2));
+}
+
+SCM_PROC1 (s_logxor, "logxor", scm_tc7_asubr, scm_logxor);
+#ifdef __STDC__
+SCM
+scm_logxor(SCM n1, SCM n2)
+#else
+SCM
+scm_logxor(n1, n2)
+     SCM n1;
+     SCM n2;
+#endif
+{
+  SCM_ASSERT(SCM_INUMP(n1), n1, SCM_ARG1, s_logxor);
+  SCM_ASSERT(SCM_INUMP(n2), n2, SCM_ARG2, s_logxor);
+  return SCM_MAKINUM(SCM_INUM(n1) ^ SCM_INUM(n2));
+}
+
+SCM_PROC(s_logtest, "logtest", 2, 0, 0, scm_logtest);
+#ifdef __STDC__
+SCM
+scm_logtest(SCM n1, SCM n2)
+#else
+SCM
+scm_logtest(n1, n2)
+     SCM n1;
+     SCM n2;
+#endif
+{
+  SCM_ASSERT(SCM_INUMP(n1), n1, SCM_ARG1, s_logtest);
+  SCM_ASSERT(SCM_INUMP(n2), n2, SCM_ARG2, s_logtest);
+  return (SCM_INUM(n1) & SCM_INUM(n2)) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+SCM_PROC(s_logbit_p, "logbit?", 2, 0, 0, scm_logbit_p);
+#ifdef __STDC__
+SCM
+scm_logbit_p(SCM n1, SCM n2)
+#else
+SCM
+scm_logbit_p(n1, n2)
+     SCM n1;
+     SCM n2;
+#endif
+{
+  SCM_ASSERT(SCM_INUMP(n1) && SCM_INUM(n1) >= 0, n1, SCM_ARG1, s_logbit_p);
+  SCM_ASSERT(SCM_INUMP(n2), n2, SCM_ARG2, s_logbit_p);
+  return ((1 << SCM_INUM(n1)) & SCM_INUM(n2)) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+#endif
+
+SCM_PROC(s_lognot, "lognot", 1, 0, 0, scm_lognot);
+#ifdef __STDC__
+SCM
+scm_lognot(SCM n)
+#else
+SCM
+scm_lognot(n)
+     SCM n;
+#endif
+{
+  SCM_ASSERT(SCM_INUMP(n), n, SCM_ARG1, s_lognot);
+  return scm_difference(SCM_MAKINUM(-1L), n);
+}
+
+SCM_PROC(s_integer_expt, "integer-expt", 2, 0, 0, scm_integer_expt);
+#ifdef __STDC__
+SCM
+scm_integer_expt(SCM z1, SCM z2)
+#else
+SCM
+scm_integer_expt(z1, z2)
+     SCM z1;
+     SCM z2;
+#endif
+{
+  SCM acc = SCM_MAKINUM(1L);
+#ifdef SCM_BIGDIG
+  if (SCM_INUM0==z1 || acc==z1) return z1;
+  else if (SCM_MAKINUM(-1L)==z1) return SCM_BOOL_F==scm_even_p(z2)?z1:acc;
+#endif
+  SCM_ASSERT(SCM_INUMP(z2), z2, SCM_ARG2, s_integer_expt);
+  z2 = SCM_INUM(z2);
+  if (z2 < 0) {
+    z2 = -z2;
+    z1 = scm_divide(z1, SCM_UNDEFINED);
+  }
+  while(1) {
+    if (0==z2) return acc;
+    if (1==z2) return scm_product(acc, z1);
+    if (z2 & 1) acc = scm_product(acc, z1);
+    z1 = scm_product(z1, z1);
+    z2 >>= 1;
+  }
+}
+
+SCM_PROC(s_ash, "ash", 2, 0, 0, scm_ash);
+#ifdef __STDC__
+SCM
+scm_ash(SCM n, SCM cnt)
+#else
+SCM
+scm_ash(n, cnt)
+     SCM n;
+     SCM cnt;
+#endif
+{
+  SCM res = SCM_INUM(n);
+  SCM_ASSERT(SCM_INUMP(cnt), cnt, SCM_ARG2, s_ash);
+#ifdef SCM_BIGDIG
+  if(cnt < 0) {
+    res = scm_integer_expt(SCM_MAKINUM(2), SCM_MAKINUM(-SCM_INUM(cnt)));
+    if (SCM_NFALSEP(scm_negative_p(n)))
+      return scm_sum(SCM_MAKINUM(-1L), scm_quotient(scm_sum(SCM_MAKINUM(1L), n), res));
+    else return scm_quotient(n, res);
+  }
+  else return scm_product(n, scm_integer_expt(SCM_MAKINUM(2), cnt));
+#else
+  SCM_ASSERT(SCM_INUMP(n), n, SCM_ARG1, s_ash);
+  cnt = SCM_INUM(cnt);
+  if (cnt < 0) return SCM_MAKINUM(SCM_SRS(res, -cnt));
+  res = SCM_MAKINUM(res<<cnt);
+  if (SCM_INUM(res)>>cnt != SCM_INUM(n)) scm_wta(n, (char *)SCM_OVSCM_FLOW, s_ash);
+  return res;
+#endif
+}
+
+SCM_PROC(s_bit_extract, "bit-extract", 3, 0, 0, scm_bit_extract);
+#ifdef __STDC__
+SCM
+scm_bit_extract(SCM n, SCM start, SCM end)
+#else
+SCM
+scm_bit_extract(n, start, end)
+     SCM n;
+     SCM start;
+     SCM end;
+#endif
+{
+  SCM_ASSERT(SCM_INUMP(start), start, SCM_ARG2, s_bit_extract);
+  SCM_ASSERT(SCM_INUMP(end), end, SCM_ARG3, s_bit_extract);
+  start = SCM_INUM(start); end = SCM_INUM(end);
+  SCM_ASSERT(end >= start, SCM_MAKINUM(end), SCM_OUTOFRANGE, s_bit_extract);
+#ifdef SCM_BIGDIG
+  if SCM_NINUMP(n)
+    return
+      scm_logand(scm_difference(scm_integer_expt(SCM_MAKINUM(2), SCM_MAKINUM(end - start)),
+				SCM_MAKINUM(1L)),
+		 scm_ash(n, SCM_MAKINUM(-start)));
+#else
+  SCM_ASSERT(SCM_INUMP(n), n, SCM_ARG1, s_bit_extract);
+#endif
+  return SCM_MAKINUM((SCM_INUM(n)>>start) & ((1L<<(end-start))-1));
+}
+
+char scm_logtab[] = {0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4};
+SCM_PROC(s_logcount, "logcount", 1, 0, 0, scm_logcount);
+#ifdef __STDC__
+SCM
+scm_logcount (SCM n)
+#else
+SCM
+scm_logcount(n)
+     SCM n;
+#endif
+{
+  register unsigned long c = 0;
+  register long nn;
+#ifdef SCM_BIGDIG
+  if SCM_NINUMP(n) {
+    scm_sizet i; SCM_BIGDIG *ds, d;
+    SCM_ASSERT(SCM_NIMP(n) && SCM_BIGP(n), n, SCM_ARG1, s_logcount);
+    if SCM_BIGSIGN(n) return scm_logcount(scm_difference(SCM_MAKINUM(-1L), n));
+    ds = SCM_BDIGITS(n);
+    for(i = SCM_NUMDIGS(n); i--; )
+      for(d = ds[i]; d; d >>= 4) c += scm_logtab[15 & d];
+    return SCM_MAKINUM(c);
+  }
+#else
+  SCM_ASSERT(SCM_INUMP(n), n, SCM_ARG1, s_logcount);
+#endif
+  if ((nn = SCM_INUM(n)) < 0) nn = -1 - nn;
+  for(; nn; nn >>= 4) c += scm_logtab[15 & nn];
+  return SCM_MAKINUM(c);
+}
+
+char scm_ilentab[] = {0, 1, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4};
+SCM_PROC(s_integer_length, "integer-length", 1, 0, 0, scm_integer_length);
+#ifdef __STDC__
+SCM
+scm_integer_length(SCM n)
+#else
+SCM
+scm_integer_length(n)
+     SCM n;
+#endif
+{
+  register unsigned long c = 0;
+  register long nn;
+  unsigned int l = 4;
+#ifdef SCM_BIGDIG
+  if SCM_NINUMP(n) {
+    SCM_BIGDIG *ds, d;
+    SCM_ASSERT(SCM_NIMP(n) && SCM_BIGP(n), n, SCM_ARG1, s_integer_length);
+    if SCM_BIGSIGN(n) return scm_integer_length(scm_difference(SCM_MAKINUM(-1L), n));
+    ds = SCM_BDIGITS(n);
+    d = ds[c = SCM_NUMDIGS(n)-1];
+    for(c *= SCM_BITSPERDIG; d; d >>= 4) {c += 4; l = scm_ilentab[15 & d];}
+    return SCM_MAKINUM(c - 4 + l);
+  }
+#else
+  SCM_ASSERT(SCM_INUMP(n), n, SCM_ARG1, s_integer_length);
+#endif
+  if ((nn = SCM_INUM(n)) < 0) nn = -1 - nn;
+  for(;nn; nn >>= 4) {c += 4; l = scm_ilentab[15 & nn];}
+  return SCM_MAKINUM(c - 4 + l);
+}
+
+
+#ifdef SCM_BIGDIG
+char s_bignum[] = "bignum";
+#ifdef __STDC__
+SCM
+scm_mkbig(scm_sizet nlen, int sign)
+#else
+SCM
+scm_mkbig(nlen, sign)
+     scm_sizet nlen;
+     int sign;
+#endif
+{
+  SCM v = nlen;
+  if (((v << 16) >> 16) != nlen)
+    scm_wta(SCM_MAKINUM(nlen), (char *)SCM_NALLOC, s_bignum);
+  SCM_NEWCELL(v);
+  SCM_DEFER_INTS;
+  SCM_SETCHARS(v, scm_must_malloc((long)(nlen*sizeof(SCM_BIGDIG)), s_bignum));
+  SCM_SETNUMDIGS(v, nlen, sign?scm_tc16_bigneg:scm_tc16_bigpos);
+  SCM_ALLOW_INTS;
+  return v;
+}
+
+#ifdef __STDC__
+SCM
+scm_big2inum(SCM b, scm_sizet l)
+#else
+SCM
+scm_big2inum(b, l)
+     SCM b;
+     scm_sizet l;
+#endif
+{
+  unsigned long num = 0;
+  SCM_BIGDIG *tmp = SCM_BDIGITS(b);
+  while (l--) num = SCM_BIGUP(num) + tmp[l];
+  if (SCM_TYP16(b)==scm_tc16_bigpos) {
+    if SCM_POSSCM_FIXABLE(num) return SCM_MAKINUM(num);
+  }
+  else if SCM_UNEGSCM_FIXABLE(num) return SCM_MAKINUM(-num);
+  return b;
+}
+
+
+char s_adjbig[] = "scm_adjbig";
+#ifdef __STDC__
+SCM
+scm_adjbig(SCM b, scm_sizet nlen)
+#else
+SCM
+scm_adjbig(b, nlen)
+     SCM b;
+     scm_sizet nlen;
+#endif
+{
+  long nsiz = nlen;
+  if (((nsiz << 16) >> 16) != nlen) scm_wta(SCM_MAKINUM(nsiz), (char *)SCM_NALLOC, s_adjbig);
+  SCM_DEFER_INTS;
+  SCM_SETCHARS(b, (SCM_BIGDIG *)scm_must_realloc((char *)SCM_CHARS(b),
+					 (long)(SCM_NUMDIGS(b)*sizeof(SCM_BIGDIG)),
+					 (long)(nsiz*sizeof(SCM_BIGDIG)), s_adjbig));
+  SCM_SETNUMDIGS(b, nsiz, SCM_TYP16(b));
+  SCM_ALLOW_INTS;
+  return b;
+}
+
+
+#ifdef __STDC__
+SCM
+scm_normbig(SCM b)
+#else
+SCM
+scm_normbig(b)
+     SCM b;
+#endif
+{
+#ifndef _UNICOS  
+  scm_sizet nlen = SCM_NUMDIGS(b);
+#else
+  int nlen = SCM_NUMDIGS(b);	/* unsigned nlen breaks on Cray when nlen => 0 */
+#endif
+  SCM_BIGDIG *zds = SCM_BDIGITS(b);
+  while (nlen-- && !zds[nlen]); nlen++;
+  if (nlen * SCM_BITSPERDIG/SCM_CHAR_BIT <= sizeof(SCM))
+    if SCM_INUMP(b = scm_big2inum(b, (scm_sizet)nlen)) return b;
+  if (SCM_NUMDIGS(b)==nlen) return b;
+  return scm_adjbig(b, (scm_sizet)nlen);
+}
+
+
+#ifdef __STDC__
+SCM
+scm_copybig(SCM b, int sign)
+#else
+SCM
+scm_copybig(b, sign)
+     SCM b;
+     int sign;
+#endif
+{
+  scm_sizet i = SCM_NUMDIGS(b);
+  SCM ans = scm_mkbig(i, sign);
+  SCM_BIGDIG *src = SCM_BDIGITS(b), *dst = SCM_BDIGITS(ans);
+  while (i--) dst[i] = src[i];
+  return ans;
+}
+
+
+#ifdef __STDC__
+SCM
+scm_long2big(long n)
+#else
+SCM
+scm_long2big(n)
+     long n;
+#endif
+{
+  scm_sizet i = 0;
+  SCM_BIGDIG *digits;
+  SCM ans = scm_mkbig(SCM_DIGSPERLONG, n<0);
+  digits = SCM_BDIGITS(ans);
+  if (n < 0) n = -n;
+  while (i < SCM_DIGSPERLONG) {
+    digits[i++] = SCM_BIGLO(n);
+    n = SCM_BIGDN((unsigned long)n);
+  }
+  return ans;
+}
+
+#ifdef LONGLONGS
+#ifdef __STDC__
+SCM
+scm_long_long2big(long_long n)
+#else
+SCM
+scm_long_long2big(n)
+     long_long n;
+#endif
+{
+  scm_sizet i;
+  SCM_BIGDIG *digits;
+  SCM ans;
+  int n_digits;
+
+  {
+    long tn;
+    tn = (long) n;
+    if ((long long)tn == n)
+      return scm_long2big (tn);
+  }
+
+  {
+    long_long tn;
+
+    for (tn = n, n_digits = 0;
+	 tn;
+	 ++n_digits, tn = SCM_BIGDN ((ulong_long)tn))
+      ;
+  }
+
+  i = 0;
+  ans = scm_mkbig(n_digits, n<0);
+  digits = SCM_BDIGITS(ans);
+  if (n < 0)
+    n = -n;
+  while (i < n_digits) {
+    digits[i++] = SCM_BIGLO(n);
+    n = SCM_BIGDN((ulong_long)n);
+  }
+  return ans;
+}
+#endif
+
+#ifdef __STDC__
+SCM
+scm_2ulong2big(unsigned long * np)
+#else
+SCM
+scm_2ulong2big(np)
+     unsigned long * np;
+#endif
+{
+  unsigned long n;
+  scm_sizet i;
+  SCM_BIGDIG *digits;
+  SCM ans;
+
+  ans = scm_mkbig(2 * SCM_DIGSPERLONG, 0);
+  digits = SCM_BDIGITS(ans);
+
+  n = np[0];
+  for (i = 0; i < SCM_DIGSPERLONG; ++i)
+    {
+      digits[i] = SCM_BIGLO(n);
+      n = SCM_BIGDN((unsigned long)n);
+    }
+  n = np[1];
+  for (i = 0; i < SCM_DIGSPERLONG; ++i)
+    {
+      digits[i + SCM_DIGSPERLONG] = SCM_BIGLO(n);
+      n = SCM_BIGDN((unsigned long)n);
+    }
+  return ans;
+}
+
+
+#ifdef __STDC__
+SCM
+scm_ulong2big(unsigned long n)
+#else
+SCM
+scm_ulong2big(n)
+     unsigned long n;
+#endif
+{
+  scm_sizet i = 0;
+  SCM_BIGDIG *digits;
+  SCM ans = scm_mkbig(SCM_DIGSPERLONG, 0);
+  digits = SCM_BDIGITS(ans);
+  while (i < SCM_DIGSPERLONG) {
+    digits[i++] = SCM_BIGLO(n);
+    n = SCM_BIGDN(n);
+  }
+  return ans;
+}
+
+
+#ifdef __STDC__
+int
+scm_bigcomp(SCM x, SCM y)
+#else
+int
+scm_bigcomp(x, y)
+     SCM x;
+     SCM y;
+#endif
+{
+  int xsign = SCM_BIGSIGN(x);
+  int ysign = SCM_BIGSIGN(y);
+  scm_sizet xlen, ylen;
+  if (ysign < xsign) return 1;
+  if (ysign > xsign) return -1;
+  if ((ylen = SCM_NUMDIGS(y)) > (xlen = SCM_NUMDIGS(x))) return (xsign) ? -1 : 1;
+  if (ylen < xlen) return (xsign) ? 1 : -1;
+  while(xlen-- && (SCM_BDIGITS(y)[xlen]==SCM_BDIGITS(x)[xlen]));
+  if (-1==xlen) return 0;
+  return (SCM_BDIGITS(y)[xlen] > SCM_BDIGITS(x)[xlen]) ?
+    (xsign ? -1 : 1) : (xsign ? 1 : -1);
+}
+
+#ifndef SCM_DIGSTOOBIG
+
+#ifdef __STDC__
+long
+scm_pseudolong(long x)
+#else
+long
+scm_pseudolong(x)
+     long x;
+#endif
+{
+  union {
+    long l;
+    SCM_BIGDIG bd[SCM_DIGSPERLONG];
+  } p;
+  scm_sizet i = 0;
+  if (x < 0) x = -x;
+  while (i < SCM_DIGSPERLONG) {p.bd[i++] = SCM_BIGLO(x); x = SCM_BIGDN(x);}
+  /*  p.bd[0] = SCM_BIGLO(x); p.bd[1] = SCM_BIGDN(x); */
+  return p.l;
+}
+
+#else
+
+#ifdef __STDC__
+void
+scm_longdigs(long x, SCM_BIGDIG digs[])
+#else
+void
+scm_longdigs(x, digs)
+     long x;
+     SCM_BIGDIG digs[];
+#endif
+{
+  scm_sizet i = 0;
+  if (x < 0) x = -x;
+  while (i < SCM_DIGSPERLONG) {digs[i++] = SCM_BIGLO(x); x = SCM_BIGDN(x);}
+}
+#endif
+
+
+#ifdef __STDC__
+SCM
+scm_addbig(SCM_BIGDIG *x, scm_sizet nx, int xsgn, SCM bigy, int sgny)
+#else
+SCM
+scm_addbig(x, nx, xsgn, bigy, sgny)
+     SCM_BIGDIG *x;
+     scm_sizet nx;
+     int xsgn;
+     SCM bigy;
+     int sgny;
+#endif
+{
+  /* Assumes nx <= SCM_NUMDIGS(bigy) */
+  /* Assumes xsgn and sgny scm_equal either 0 or 0x0100 */
+  long num = 0;
+  scm_sizet i = 0, ny = SCM_NUMDIGS(bigy);
+  SCM z = scm_copybig(bigy, SCM_BIGSIGN(bigy) ^ sgny);
+  SCM_BIGDIG *zds = SCM_BDIGITS(z);
+  if (xsgn ^ SCM_BIGSIGN(z)) {
+    do {
+      num += (long) zds[i] - x[i];
+      if (num < 0) {zds[i] = num + SCM_BIGRAD; num = -1;}
+      else {zds[i] = SCM_BIGLO(num); num = 0;}
+    } while (++i < nx);
+    if (num && nx==ny) {
+      num = 1; i = 0;
+      SCM_CAR(z) ^= 0x0100;
+      do {
+	num += (SCM_BIGRAD-1) - zds[i];
+	zds[i++] = SCM_BIGLO(num);
+	num = SCM_BIGDN(num);
+      } while (i < ny);
+    }
+    else while (i < ny) {
+      num += zds[i];
+      if (num < 0) {zds[i++] = num + SCM_BIGRAD; num = -1;}
+      else {zds[i++] = SCM_BIGLO(num); num = 0;}
+    }
+  } else {
+    do {
+      num += (long) zds[i] + x[i];
+      zds[i++] = SCM_BIGLO(num);
+      num = SCM_BIGDN(num);
+    } while (i < nx);
+    if (!num) return z;
+    while (i < ny) {
+      num += zds[i];
+      zds[i++] = SCM_BIGLO(num);
+      num = SCM_BIGDN(num);
+      if (!num) return z;
+    }
+    if (num) {z = scm_adjbig(z, ny+1); SCM_BDIGITS(z)[ny] = num; return z;}
+  }
+  return scm_normbig(z);
+}
+
+#ifdef __STDC__
+SCM
+scm_mulbig(SCM_BIGDIG *x, scm_sizet nx, SCM_BIGDIG *y, scm_sizet ny, int sgn)
+#else
+SCM
+scm_mulbig(x, nx, y, ny, sgn)
+     SCM_BIGDIG *x;
+     scm_sizet nx;
+     SCM_BIGDIG *y;
+     scm_sizet ny;
+     int sgn;
+#endif
+{
+  scm_sizet i = 0, j = nx + ny;
+  unsigned long n = 0;
+  SCM z = scm_mkbig(j, sgn);
+  SCM_BIGDIG *zds = SCM_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++] = SCM_BIGLO(n);
+	n = SCM_BIGDN(n);
+      } while (j < ny);
+      if (n) {zds[i + j] = n; n = 0;}
+    }
+  } while (++i < nx);
+  return scm_normbig(z);
+}
+
+#ifdef __STDC__
+unsigned int
+scm_divbigdig(SCM_BIGDIG *ds, scm_sizet h, SCM_BIGDIG div)
+#else
+unsigned int
+scm_divbigdig(ds, h, div)
+     SCM_BIGDIG *ds;
+     scm_sizet h;
+     SCM_BIGDIG div;
+#endif
+{
+  register unsigned long t2 = 0;
+  while(h--) {
+    t2 = SCM_BIGUP(t2) + ds[h];
+    ds[h] = t2 / div;
+    t2 %= div;
+  }
+  return t2;
+}
+
+
+#ifdef __STDC__
+SCM
+scm_divbigint(SCM x, long z, int sgn, int mode)
+#else
+SCM
+scm_divbigint(x, z, sgn, mode)
+     SCM x;
+     long z;
+     int sgn;
+     int mode;
+#endif
+{
+  if (z < 0) z = -z;
+  if (z < SCM_BIGRAD) {
+    register unsigned long t2 = 0;
+    register SCM_BIGDIG *ds = SCM_BDIGITS(x);
+    scm_sizet nd = SCM_NUMDIGS(x);
+    while(nd--) t2 = (SCM_BIGUP(t2) + ds[nd]) % z;
+    if (mode) t2 = z - t2;
+    return SCM_MAKINUM(sgn ? -t2 : t2);
+  }
+  {
+#ifndef SCM_DIGSTOOBIG
+    unsigned long t2 = scm_pseudolong(z);
+    return scm_divbigbig(SCM_BDIGITS(x), SCM_NUMDIGS(x), (SCM_BIGDIG *)&t2,
+			 SCM_DIGSPERLONG, sgn, mode); 
+#else
+    SCM_BIGDIG t2[SCM_DIGSPERLONG];
+    scm_longdigs(z, t2);
+    return scm_divbigbig(SCM_BDIGITS(x), SCM_NUMDIGS(x), t2, SCM_DIGSPERLONG, sgn, mode);
+#endif
+  }
+}
+
+#ifdef __STDC__
+SCM
+scm_divbigbig(SCM_BIGDIG *x, scm_sizet nx, SCM_BIGDIG *y, scm_sizet ny, int sgn, int modes)
+#else
+SCM
+scm_divbigbig(x, nx, y, ny, sgn, modes)
+     SCM_BIGDIG *x;
+     scm_sizet nx;
+     SCM_BIGDIG *y;
+     scm_sizet ny;
+     int sgn;
+     int modes;
+#endif
+{
+  /* modes description
+     0	remainder
+     1	scm_modulo
+     2	quotient
+     3	quotient but returns 0 if division is not exact. */
+  scm_sizet i = 0, j = 0;
+  long num = 0;
+  unsigned long t2 = 0;
+  SCM z, newy;
+  SCM_BIGDIG  d = 0, qhat, *zds, *yds;
+  /* algorithm requires nx >= ny */
+  if (nx < ny)
+    switch (modes) {
+    case 0:			/* remainder -- just return x */
+      z = scm_mkbig(nx, sgn); zds = SCM_BDIGITS(z);
+      do {zds[i] = x[i];} while (++i < nx);
+      return z;
+    case 1:			/* scm_modulo -- return y-x */
+      z = scm_mkbig(ny, sgn); zds = SCM_BDIGITS(z);
+      do {
+	num += (long) y[i] - x[i];
+	if (num < 0) {zds[i] = num + SCM_BIGRAD; num = -1;}
+	else {zds[i] = num; num = 0;}
+      } while (++i < nx);
+      while (i < ny) {
+	num += y[i];
+	if (num < 0) {zds[i++] = num + SCM_BIGRAD; num = -1;}
+	else {zds[i++] = num; num = 0;}
+      }
+      goto doadj;
+    case 2: return SCM_INUM0;	/* quotient is zero */
+    case 3: return 0;		/* the division is not exact */
+    }
+
+  z = scm_mkbig(nx==ny ? nx+2 : nx+1, sgn); zds = SCM_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] < (SCM_BIGRAD>>1)) {  /* normalize operands */
+    d = SCM_BIGRAD/(y[ny-1]+1);
+    newy = scm_mkbig(ny, 0); yds = SCM_BDIGITS(newy);
+    while(j < ny)
+      {t2 += (unsigned long) y[j]*d; yds[j++] = SCM_BIGLO(t2); t2 = SCM_BIGDN(t2);}
+    y = yds; j = 0; t2 = 0;
+    while(j < nx)
+      {t2 += (unsigned long) x[j]*d; zds[j++] = SCM_BIGLO(t2); t2 = SCM_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 = SCM_BIGRAD-1;
+    else qhat = (SCM_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] - SCM_BIGLO(t2);
+      if (num < 0) {zds[j - ny + i] = num + SCM_BIGRAD; num = -1;}
+      else {zds[j - ny + i] = num; num = 0;}
+      t2 = SCM_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] = SCM_BIGLO(num);
+	num = SCM_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 scm_modulo */
+    i = 0; num = 0; j = 0;
+    do {num += y[i] - zds[i];
+	j = j | zds[i];
+	if (num < 0) {zds[i] = num + SCM_BIGRAD; num = -1;}
+	else {zds[i] = num; num = 0;}
+      } while (++i < ny);
+    if (!j) return SCM_INUM0;
+  case 0:			/* just normalize remainder */
+    if (d) scm_divbigdig(zds, ny, d);
+  }
+ doadj:
+  for(j = ny;j && !zds[j-1];--j) ;
+  if (j * SCM_BITSPERDIG <= sizeof(SCM)*SCM_CHAR_BIT)
+    if SCM_INUMP(z = scm_big2inum(z, j)) return z;
+  return scm_adjbig(z, j);
+}
+#endif
+
+
+
+
+
+/*** NUMBERS -> STRINGS ***/
+#ifdef SCM_FLOATS
+int scm_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};
+
+
+
+#ifdef __STDC__
+static scm_sizet
+idbl2str(double f, char *a)
+#else
+static scm_sizet
+idbl2str(f, a)
+     double f;
+     char *a;
+#endif
+{
+  int efmt, dpt, d, i, wp = scm_dblprec;
+  scm_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;
+}
+
+#ifdef __STDC__
+static scm_sizet
+iflo2str(SCM flt, char *str)
+#else
+static scm_sizet
+iflo2str(flt, str)
+     SCM flt;
+     char *str;
+#endif
+{
+  scm_sizet i;
+# ifdef SCM_SINGLES
+  if SCM_SINGP(flt) i = idbl2str(SCM_FLO(flt), str);
+  else
+# endif
+    i = idbl2str(SCM_REAL(flt), str);
+  if SCM_CPLXP(flt) {
+    if(0 <= SCM_IMAG(flt))		/* jeh */
+      str[i++] = '+';		/* jeh */
+    i += idbl2str(SCM_IMAG(flt), &str[i]);
+    str[i++] = 'i';
+  }
+  return i;
+}
+#endif				/* SCM_FLOATS */
+
+#ifdef __STDC__
+scm_sizet
+scm_iint2str(long num, int rad, char *p)
+#else
+scm_sizet
+scm_iint2str(num, rad, p)
+     long num;
+     int rad;
+     char *p;
+#endif
+{
+  scm_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 SCM_BIGDIG
+#ifdef __STDC__
+static SCM
+big2str(SCM b, register unsigned int radix)
+#else
+static SCM
+big2str(b, radix)
+     SCM b;
+     register unsigned int radix;
+#endif
+{
+  SCM t = scm_copybig(b, 0);	/* sign of temp doesn't matter */
+  register SCM_BIGDIG *ds = SCM_BDIGITS(t);
+  scm_sizet i = SCM_NUMDIGS(t);
+  scm_sizet j = radix==16 ? (SCM_BITSPERDIG*i)/4+2
+    : radix >= 10 ? (SCM_BITSPERDIG*i*241L)/800+2
+      : (SCM_BITSPERDIG*i)+2;
+  scm_sizet k = 0;
+  scm_sizet radct = 0;
+  scm_sizet ch;			/* jeh */
+  SCM_BIGDIG radpow = 1, radmod = 0;
+  SCM ss = scm_makstr((long)j, 0);
+  char *s = SCM_CHARS(ss), c;
+  while ((long) radpow * radix < SCM_BIGRAD) {
+    radpow *= radix;
+    radct++;
+  }
+  s[0] = scm_tc16_bigneg==SCM_TYP16(b) ? '-' : '+';
+  while ((i || radmod) && j) {
+    if (k == 0) {
+      radmod = (SCM_BIGDIG)scm_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 < SCM_LENGTH(ss);j++) s[ch+j-i] = s[j]; /* jeh */
+    scm_vector_set_length_x(ss, (SCM)SCM_MAKINUM(ch+SCM_LENGTH(ss)-i)); /* jeh */
+  }
+  return ss;
+}
+#endif
+
+
+SCM_PROC(s_number_to_string, "number->string", 1, 1, 0, scm_number_to_string);
+#ifdef __STDC__
+SCM
+scm_number_to_string(SCM x, SCM radix)
+#else
+SCM
+scm_number_to_string(x, radix)
+     SCM x;
+     SCM radix;
+#endif
+{
+  if SCM_UNBNDP(radix) radix=SCM_MAKINUM(10L);
+  else SCM_ASSERT(SCM_INUMP(radix), radix, SCM_ARG2, s_number_to_string);
+#ifdef SCM_FLOATS
+  if SCM_NINUMP(x) {
+    char num_buf[SCM_FLOBUFLEN];
+# ifdef SCM_BIGDIG
+    SCM_ASRTGO(SCM_NIMP(x), badx);
+    if SCM_BIGP(x) return big2str(x, (unsigned int)SCM_INUM(radix));
+#  ifndef RECKLESS
+    if (!(SCM_INEXP(x)))
+    badx: scm_wta(x, (char *)SCM_ARG1, s_number_to_string);
+#  endif
+# else
+    SCM_ASSERT(SCM_NIMP(x) && SCM_INEXP(x), x, SCM_ARG1, s_number_to_string);
+# endif
+    return scm_makfromstr(num_buf, iflo2str(x, num_buf), 0);
+  }
+#else
+# ifdef SCM_BIGDIG
+  if SCM_NINUMP(x) {
+    SCM_ASSERT(SCM_NIMP(x) && SCM_BIGP(x), x, SCM_ARG1, s_number_to_string);
+    return big2str(x, (unsigned int)SCM_INUM(radix));
+  }
+# else
+  SCM_ASSERT(SCM_INUMP(x), x, SCM_ARG1, s_number_to_string);
+# endif
+#endif
+  {
+    char num_buf[SCM_INTBUFLEN];
+    return scm_makfromstr(num_buf,
+			  scm_iint2str(SCM_INUM(x), (int)SCM_INUM(radix), num_buf), 0);
+  }
+}
+
+
+/* These print routines are stubbed here so that scm_repl.c doesn't need
+   SCM_FLOATS or SCM_BIGDIGs conditionals */
+#ifdef __STDC__
+int
+scm_floprint(SCM sexp, SCM port, int writing)
+#else
+int
+scm_floprint(sexp, port, writing)
+     SCM sexp;
+     SCM port;
+     int writing;
+#endif
+{
+#ifdef SCM_FLOATS
+  char num_buf[SCM_FLOBUFLEN];
+  scm_gen_write (scm_regular_string, num_buf, iflo2str(sexp, num_buf), port);
+#else
+  scm_ipruk("float", sexp, port);
+#endif
+  return !0;
+}
+
+
+#ifdef __STDC__
+int
+scm_bigprint(SCM exp, SCM port, int writing)
+#else
+int
+scm_bigprint(exp, port, writing)
+     SCM exp;
+     SCM port;
+     int writing;
+#endif
+{
+#ifdef SCM_BIGDIG
+  exp = big2str(exp, (unsigned int)10);
+  scm_gen_write (scm_regular_string, SCM_CHARS(exp), (scm_sizet)SCM_LENGTH(exp), port);
+#else
+  scm_ipruk("bignum", exp, port);
+#endif
+  return !0;
+}
+/*** END nums->strs ***/
+
+/*** STRINGS -> NUMBERS ***/
+#ifdef SCM_BIGDIG
+#ifdef __STDC__
+SCM
+scm_istr2int(char *str, long len, long radix)
+#else
+SCM
+scm_istr2int(str, len, radix)
+     char *str;
+     long len;
+     long radix;
+#endif
+{
+  scm_sizet j;
+  register scm_sizet k, blen = 1;
+  scm_sizet i = 0;
+  int c;
+  SCM res;
+  register SCM_BIGDIG *ds;
+  register unsigned long t2;
+
+  if (0 >= len) return SCM_BOOL_F;	/* zero scm_length */
+  if (16==radix) j = 1+(4*len*sizeof(char))/(SCM_BITSPERDIG);
+  else if (10 <= radix)
+    j = 1+(84*len*sizeof(char))/(SCM_BITSPERDIG*25);
+  else j = 1+(len*sizeof(char))/(SCM_BITSPERDIG);
+  switch (str[0]) {		/* leading sign */
+  case '-':
+  case '+': if (++i==len) return SCM_BOOL_F; /* bad if lone `+' or `-' */
+  }
+  res = scm_mkbig(j, '-'==str[0]);
+  ds = SCM_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 SCM_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++] = SCM_BIGLO(t2);
+	t2 = SCM_BIGDN(t2);
+      }
+      SCM_ASSERT(blen <= j, (SCM)SCM_MAKINUM(blen), SCM_OVSCM_FLOW, "bignum");
+      if (t2) {blen++; goto moretodo;}
+      break;
+    default:
+      return SCM_BOOL_F;		/* not a digit */
+    }
+  } while (i < len);
+  if (blen * SCM_BITSPERDIG/SCM_CHAR_BIT <= sizeof(SCM))
+    if SCM_INUMP(res = scm_big2inum(res, blen)) return res;
+  if (j==blen) return res;
+  return scm_adjbig(res, blen);
+}
+#else
+
+
+
+#ifdef __STDC__
+SCM
+scm_istr2int(char *str, long len, long radix)
+#else
+SCM
+scm_istr2int(str, len, radix)
+     char *str;
+     long len;
+     long radix;
+#endif
+{
+  register long n = 0, ln;
+  register int c;
+  register int i = 0;
+  int lead_neg = 0;
+  if (0 >= len) return SCM_BOOL_F;	/* zero scm_length */
+  switch (*str) {		/* leading sign */
+  case '-': lead_neg = 1;
+  case '+': if (++i==len) return SCM_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 SCM_BOOL_F; /* bad digit for radix */
+      ln = n;
+      n = n * radix - c;
+      /* Negation is a workaround for HP700 cc bug */
+      if (n > ln || (-n > -SCM_MOST_NEGATIVE_FIXNUM)) goto ovfl;
+      break;
+    default:
+      return SCM_BOOL_F;		/* not a digit */
+    }
+  } while (i < len);
+  if (!lead_neg) if ((n = -n) > SCM_MOST_POSITIVE_FIXNUM) goto ovfl;
+  return SCM_MAKINUM(n);
+ ovfl:				/* overflow scheme integer */
+  return SCM_BOOL_F;
+}
+#endif
+
+#ifdef SCM_FLOATS
+#ifdef __STDC__
+SCM
+scm_istr2flo(char *str, long len, long radix)
+#else
+SCM
+scm_istr2flo(str, len, radix)
+     char *str;
+     long len;
+     long radix;
+#endif
+{
+  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 SCM_BOOL_F;	/* zero scm_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 SCM_BOOL_F;	/* bad if lone `+' or `-' */
+
+  if (str[i]=='i' || str[i]=='I') { /* handle `+i' and `-i'   */
+    if (lead_sgn==0.0) return SCM_BOOL_F; /* must have leading sign */
+    if (++i < len) return SCM_BOOL_F; /* `i' not last character */
+    return scm_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 SCM_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 SCM_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 SCM_BOOL_F;
+	tmp = tmp * radix + c;
+	break;
+      default:
+	goto out2;
+      }
+    }
+  out2:
+    if (tmp==0.0) return SCM_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 SCM_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 SCM_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 SCM_BOOL_F; /* only in radix 10 */
+    if (++i==len) return SCM_BOOL_F; /* bad exponent */
+    switch (str[i]) {
+    case '-':  expsgn=(-1);
+    case '+':  if (++i==len) return SCM_BOOL_F; /* bad exponent */
+    }
+    if (str[i] < '0' || str[i] > '9') return SCM_BOOL_F; /* bad exponent */
+    do {
+      switch (c = str[i]) {
+      case DIGITS:
+	expon = expon*10 + c-'0';
+	if (expon > MAXEXP)  return SCM_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 scm_makdbl(res, 0.0);
+
+  if (str[i]=='i' || str[i]=='I') { /* pure imaginary number  */
+    if (lead_sgn==0.0) return SCM_BOOL_F; /* must have leading sign */
+    if (++i < len) return SCM_BOOL_F; /* `i' not last character */
+    return scm_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 scm_angle */
+    second = scm_istr2flo(&str[i], (long)(len-i), radix);
+    if (!(SCM_INEXP(second))) return SCM_BOOL_F; /* not `real' */
+    if (SCM_CPLXP(second))    return SCM_BOOL_F; /* not `real' */
+    tmp = SCM_REALPART(second);
+    return scm_makdbl(res*cos(tmp), res*sin(tmp));
+  }
+  default: return SCM_BOOL_F;
+  }
+
+  /* at this point, last char must be `i' */
+  if (str[len-1] != 'i' && str[len-1] != 'I') return SCM_BOOL_F;
+  /* handles `x+i' and `x-i' */
+  if (i==(len-1))  return scm_makdbl(res, lead_sgn);
+  /* get a `ureal' for complex part */
+  second = scm_istr2flo(&str[i], (long)((len-i)-1), radix);
+  if (!(SCM_INEXP(second))) return SCM_BOOL_F; /* not `ureal' */
+  if (SCM_CPLXP(second))    return SCM_BOOL_F; /* not `ureal' */
+  tmp = SCM_REALPART(second);
+  if (tmp < 0.0)	return SCM_BOOL_F; /* not `ureal' */
+  return scm_makdbl(res, (lead_sgn*tmp));
+}
+#endif				/* SCM_FLOATS */
+
+
+#ifdef __STDC__
+SCM
+scm_istring2number(char *str, long len, long radix)
+#else
+SCM
+scm_istring2number(str, len, radix)
+     char *str;
+     long len;
+     long radix;
+#endif
+{
+  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 SCM_BOOL_F;
+
+  while ((len-i) >= 2  &&  str[i]=='#' && ++i)
+    switch (str[i++]) {
+    case 'b': case 'B':  if (rx_p++) return SCM_BOOL_F; radix = 2;  break;
+    case 'o': case 'O':  if (rx_p++) return SCM_BOOL_F; radix = 8;  break;
+    case 'd': case 'D':  if (rx_p++) return SCM_BOOL_F; radix = 10; break;
+    case 'x': case 'X':  if (rx_p++) return SCM_BOOL_F; radix = 16; break;
+    case 'i': case 'I':  if (ex_p++) return SCM_BOOL_F; ex = 2;     break;
+    case 'e': case 'E':  if (ex_p++) return SCM_BOOL_F; ex = 1;     break;
+    default:  return SCM_BOOL_F;
+    }
+
+  switch (ex) {
+  case 1:
+    return scm_istr2int(&str[i], len-i, radix);
+  case 0:
+    res = scm_istr2int(&str[i], len-i, radix);
+    if SCM_NFALSEP(res) return res;
+#ifdef SCM_FLOATS
+  case 2: return scm_istr2flo(&str[i], len-i, radix);
+#endif
+  }
+  return SCM_BOOL_F;
+}
+
+
+SCM_PROC(s_string_to_number, "string->number", 1, 1, 0, scm_string_to_number);
+#ifdef __STDC__
+SCM
+scm_string_to_number(SCM str, SCM radix)
+#else
+SCM
+scm_string_to_number(str, radix)
+     SCM str;
+     SCM radix;
+#endif
+{
+  SCM answer;
+  if SCM_UNBNDP(radix) radix=SCM_MAKINUM(10L);
+  else SCM_ASSERT(SCM_INUMP(radix), radix, SCM_ARG2, s_string_to_number);
+  SCM_ASSERT(SCM_NIMP(str) && SCM_ROSTRINGP(str), str, SCM_ARG1, s_string_to_number);
+  answer = scm_istring2number(SCM_ROCHARS(str), SCM_ROLENGTH(str), SCM_INUM(radix));
+  return scm_return_first (answer, str);
+}
+/*** END strs->nums ***/
+
+#ifdef SCM_FLOATS
+#ifdef __STDC__
+SCM
+scm_makdbl (double x, double y)
+#else
+SCM
+scm_makdbl (x, y)
+     double x;
+     double y;
+#endif
+{
+  SCM z;
+  if ((y==0.0) && (x==0.0)) return scm_flo0;
+  SCM_NEWCELL(z);
+  SCM_DEFER_INTS;
+  if (y==0.0) {
+# ifdef SCM_SINGLES
+    float fx = x;
+#  ifndef SCM_SINGLESONLY
+    if ((-FLTMAX < x) && (x < FLTMAX) && (fx==x))
+#  endif
+      {
+	SCM_CAR(z) = scm_tc_flo;
+	SCM_FLO(z) = x;
+	SCM_ALLOW_INTS;
+	return z;
+      }
+# endif/* def SCM_SINGLES */
+    SCM_CDR(z) = (SCM)scm_must_malloc(1L*sizeof(double), "real");
+    SCM_CAR(z) = scm_tc_dblr;
+  }
+  else {
+    SCM_CDR(z) = (SCM)scm_must_malloc(2L*sizeof(double), "complex");
+    SCM_CAR(z) = scm_tc_dblc;
+    SCM_IMAG(z) = y;
+  }
+  SCM_REAL(z) = x;
+  SCM_ALLOW_INTS;
+  return z;
+}
+#endif
+
+
+#ifdef __STDC__
+SCM
+scm_bigequal(SCM x, SCM y)
+#else
+SCM
+scm_bigequal(x, y)
+     SCM x;
+     SCM y;
+#endif
+{
+#ifdef SCM_BIGDIG
+  if (0==scm_bigcomp(x, y)) return SCM_BOOL_T;
+#endif
+  return SCM_BOOL_F;
+}
+
+
+#ifdef __STDC__
+SCM
+scm_floequal(SCM x, SCM y)
+#else
+SCM
+scm_floequal(x, y)
+     SCM x;
+     SCM y;
+#endif
+{
+#ifdef SCM_FLOATS
+  if (SCM_REALPART(x) != SCM_REALPART(y)) return SCM_BOOL_F;
+  if (!(SCM_CPLXP(x) && (SCM_IMAG(x) != SCM_IMAG(y)))) return SCM_BOOL_T;
+#endif
+  return SCM_BOOL_F;
+}
+
+
+
+
+SCM_PROC(s_number_p, "number?", 1, 0, 0, scm_number_p);
+SCM_PROC(s_complex_p, "complex?", 1, 0, 0, scm_number_p);
+#ifdef __STDC__
+SCM
+scm_number_p(SCM x)
+#else
+SCM
+scm_number_p(x)
+     SCM x;
+#endif
+{
+  if SCM_INUMP(x) return SCM_BOOL_T;
+#ifdef SCM_FLOATS
+  if (SCM_NIMP(x) && SCM_NUMP(x)) return SCM_BOOL_T;
+#else
+# ifdef SCM_BIGDIG
+  if (SCM_NIMP(x) && SCM_NUMP(x)) return SCM_BOOL_T;
+# endif
+#endif
+  return SCM_BOOL_F;
+}
+
+
+
+#ifdef SCM_FLOATS
+SCM_PROC(s_real_p, "real?", 1, 0, 0, scm_real_p);
+SCM_PROC(s_rational_p, "rational?", 1, 0, 0, scm_real_p);
+#ifdef __STDC__
+SCM
+scm_real_p(SCM x)
+#else
+SCM
+scm_real_p(x)
+     SCM x;
+#endif
+{
+  if (SCM_INUMP(x))
+    return SCM_BOOL_T;
+  if (SCM_IMP(x))
+    return SCM_BOOL_F;
+  if (SCM_REALP(x))
+    return SCM_BOOL_T;
+# ifdef SCM_BIGDIG
+  if (SCM_BIGP(x))
+    return SCM_BOOL_T;
+# endif
+  return SCM_BOOL_F;
+}
+
+
+
+SCM_PROC(s_int_p, "int?", 1, 0, 0, scm_int_p);
+#ifdef __STDC__
+SCM
+scm_int_p(SCM x)
+#else
+SCM
+scm_int_p(x)
+     SCM x;
+#endif
+{
+  double r;
+  if SCM_INUMP(x) return SCM_BOOL_T;
+  if SCM_IMP(x) return SCM_BOOL_F;
+# ifdef SCM_BIGDIG
+  if SCM_BIGP(x) return SCM_BOOL_T;
+# endif
+  if (!SCM_INEXP(x)) return SCM_BOOL_F;
+  if SCM_CPLXP(x) return SCM_BOOL_F;
+  r = SCM_REALPART(x);
+  if (r==floor(r)) return SCM_BOOL_T;
+  return SCM_BOOL_F;
+}
+
+
+
+#endif				/* SCM_FLOATS */
+
+SCM_PROC(s_inexact_p, "inexact?", 1, 0, 0, scm_inexact_p);
+#ifdef __STDC__
+SCM
+scm_inexact_p(SCM x)
+#else
+SCM
+scm_inexact_p(x)
+     SCM x;
+#endif
+{
+#ifdef SCM_FLOATS
+  if (SCM_NIMP(x) && SCM_INEXP(x)) return SCM_BOOL_T;
+#endif
+  return SCM_BOOL_F;
+}
+
+
+
+
+SCM_PROC1 (s_eq_p, "=?", scm_tc7_rpsubr, scm_num_eq_p);
+#ifdef __STDC__
+SCM
+scm_num_eq_p (SCM x, SCM y)
+#else
+SCM
+scm_num_eq_p (x, y)
+     SCM x;
+     SCM y;
+#endif
+{
+#ifdef SCM_FLOATS
+  SCM t;
+  if SCM_NINUMP(x) {
+# ifdef SCM_BIGDIG
+#  ifndef RECKLESS
+    if (!(SCM_NIMP(x)))
+    badx: scm_wta(x, (char *)SCM_ARG1, s_eq_p);
+#  endif
+    if SCM_BIGP(x) {
+      if SCM_INUMP(y) return SCM_BOOL_F;
+      SCM_ASRTGO(SCM_NIMP(y), bady);
+      if SCM_BIGP(y) return (0==scm_bigcomp(x, y)) ? SCM_BOOL_T : SCM_BOOL_F;
+      SCM_ASRTGO(SCM_INEXP(y), bady);
+    bigreal:
+      return (SCM_REALP(y) && (scm_big2dbl(x)==SCM_REALPART(y))) ? SCM_BOOL_T : SCM_BOOL_F;
+    }
+    SCM_ASRTGO(SCM_INEXP(x), badx);
+# else
+    SCM_ASSERT(SCM_NIMP(x) && SCM_INEXP(x), x, SCM_ARG1, s_eq_p);
+# endif
+    if SCM_INUMP(y) {t = x; x = y; y = t; goto realint;}
+# ifdef SCM_BIGDIG
+    SCM_ASRTGO(SCM_NIMP(y), bady);
+    if SCM_BIGP(y) {t = x; x = y; y = t; goto bigreal;}
+    SCM_ASRTGO(SCM_INEXP(y), bady);
+# else
+    SCM_ASRTGO(SCM_NIMP(y) && SCM_INEXP(y), bady);
+# endif
+    if (SCM_REALPART(x) != SCM_REALPART(y)) return SCM_BOOL_F;
+    if SCM_CPLXP(x)
+      return (SCM_CPLXP(y) && (SCM_IMAG(x)==SCM_IMAG(y))) ? SCM_BOOL_T : SCM_BOOL_F;
+    return SCM_CPLXP(y) ? SCM_BOOL_F : SCM_BOOL_T;
+  }
+  if SCM_NINUMP(y) {
+# ifdef SCM_BIGDIG
+    SCM_ASRTGO(SCM_NIMP(y), bady);
+    if SCM_BIGP(y) return SCM_BOOL_F;
+#  ifndef RECKLESS
+    if (!(SCM_INEXP(y)))
+    bady: scm_wta(y, (char *)SCM_ARG2, s_eq_p);
+#  endif
+# else
+#  ifndef RECKLESS
+    if (!(SCM_NIMP(y) && SCM_INEXP(y)))
+    bady: scm_wta(y, (char *)SCM_ARG2, s_eq_p);
+#  endif
+# endif
+  realint:
+    return (SCM_REALP(y) && (((double)SCM_INUM(x))==SCM_REALPART(y))) ? SCM_BOOL_T : SCM_BOOL_F;
+  }
+#else
+# ifdef SCM_BIGDIG
+  if SCM_NINUMP(x) {
+    SCM_ASSERT(SCM_NIMP(x) && SCM_BIGP(x), x, SCM_ARG1, s_eq_p);
+    if SCM_INUMP(y) return SCM_BOOL_F;
+    SCM_ASRTGO(SCM_NIMP(y) && SCM_BIGP(y), bady);
+    return (0==scm_bigcomp(x, y)) ? SCM_BOOL_T : SCM_BOOL_F;
+  }
+  if SCM_NINUMP(y) {
+#  ifndef RECKLESS
+    if (!(SCM_NIMP(y) && SCM_BIGP(y)))
+    bady: scm_wta(y, (char *)SCM_ARG2, s_eq_p);
+#  endif
+    return SCM_BOOL_F;
+  }
+# else
+  SCM_ASSERT(SCM_INUMP(x), x, SCM_ARG1, s_eq_p);
+  SCM_ASSERT(SCM_INUMP(y), y, SCM_ARG2, s_eq_p);
+# endif
+#endif
+  return ((long)x==(long)y) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+
+
+SCM_PROC1 (s_less_p, "<?", scm_tc7_rpsubr, scm_less_p);
+#ifdef __STDC__
+SCM
+scm_less_p(SCM x, SCM y)
+#else
+SCM
+scm_less_p(x, y)
+     SCM x;
+     SCM y;
+#endif
+{
+#ifdef SCM_FLOATS
+  if SCM_NINUMP(x) {
+# ifdef SCM_BIGDIG
+#  ifndef RECKLESS
+    if (!(SCM_NIMP(x)))
+    badx: scm_wta(x, (char *)SCM_ARG1, s_less_p);
+#  endif
+    if SCM_BIGP(x) {
+      if SCM_INUMP(y) return SCM_BIGSIGN(x) ? SCM_BOOL_T : SCM_BOOL_F;
+      SCM_ASRTGO(SCM_NIMP(y), bady);
+      if SCM_BIGP(y) return (1==scm_bigcomp(x, y)) ? SCM_BOOL_T : SCM_BOOL_F;
+      SCM_ASRTGO(SCM_REALP(y), bady);
+      return (scm_big2dbl(x) < SCM_REALPART(y)) ? SCM_BOOL_T : SCM_BOOL_F;
+    }
+    SCM_ASRTGO(SCM_REALP(x), badx);
+# else
+    SCM_ASSERT(SCM_NIMP(x) && SCM_REALP(x), x, SCM_ARG1, s_less_p);
+# endif
+    if (SCM_INUMP(y))
+      return (SCM_REALPART(x) < ((double)SCM_INUM(y))) ? SCM_BOOL_T : SCM_BOOL_F;
+# ifdef SCM_BIGDIG
+    SCM_ASRTGO(SCM_NIMP(y), bady);
+    if SCM_BIGP(y) return (SCM_REALPART(x) < scm_big2dbl(y)) ? SCM_BOOL_T : SCM_BOOL_F;
+    SCM_ASRTGO(SCM_REALP(y), bady);
+# else
+    SCM_ASRTGO(SCM_NIMP(y) && SCM_REALP(y), bady);
+# endif
+    return (SCM_REALPART(x) < SCM_REALPART(y)) ? SCM_BOOL_T : SCM_BOOL_F;
+  }
+  if SCM_NINUMP(y) {
+# ifdef SCM_BIGDIG
+    SCM_ASRTGO(SCM_NIMP(y), bady);
+    if SCM_BIGP(y) return SCM_BIGSIGN(y) ? SCM_BOOL_F : SCM_BOOL_T;
+#  ifndef RECKLESS
+    if (!(SCM_REALP(y)))
+    bady: scm_wta(y, (char *)SCM_ARG2, s_less_p);
+#  endif
+# else
+#  ifndef RECKLESS
+    if (!(SCM_NIMP(y) && SCM_REALP(y)))
+    bady: scm_wta(y, (char *)SCM_ARG2, s_less_p);
+#  endif
+# endif
+    return (((double)SCM_INUM(x)) < SCM_REALPART(y)) ? SCM_BOOL_T : SCM_BOOL_F;
+  }
+#else
+# ifdef SCM_BIGDIG
+  if SCM_NINUMP(x) {
+    SCM_ASSERT(SCM_NIMP(x) && SCM_BIGP(x), x, SCM_ARG1, s_less_p);
+    if SCM_INUMP(y) return SCM_BIGSIGN(x) ? SCM_BOOL_T : SCM_BOOL_F;
+    SCM_ASRTGO(SCM_NIMP(y) && SCM_BIGP(y), bady);
+    return (1==scm_bigcomp(x, y)) ? SCM_BOOL_T : SCM_BOOL_F;
+  }
+  if SCM_NINUMP(y) {
+#  ifndef RECKLESS
+    if (!(SCM_NIMP(y) && SCM_BIGP(y)))
+    bady: scm_wta(y, (char *)SCM_ARG2, s_less_p);
+#  endif
+    return SCM_BIGSIGN(y) ? SCM_BOOL_F : SCM_BOOL_T;
+  }
+# else
+  SCM_ASSERT(SCM_INUMP(x), x, SCM_ARG1, s_less_p);
+  SCM_ASSERT(SCM_INUMP(y), y, SCM_ARG2, s_less_p);
+# endif
+#endif
+  return ((long)x < (long)y) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+
+SCM_PROC1 (s_gr_p, ">?", scm_tc7_rpsubr, scm_gr_p);
+#ifdef __STDC__
+SCM
+scm_gr_p(SCM x, SCM y)
+#else
+SCM
+scm_gr_p(x, y)
+     SCM x;
+     SCM y;
+#endif
+{
+  return scm_less_p(y, x);
+}
+
+
+
+SCM_PROC1 (s_leq_p, "<=?", scm_tc7_rpsubr, scm_leq_p);
+#ifdef __STDC__
+SCM
+scm_leq_p(SCM x, SCM y)
+#else
+SCM
+scm_leq_p(x, y)
+     SCM x;
+     SCM y;
+#endif
+{
+  return SCM_BOOL_NOT(scm_less_p(y, x));
+}
+
+
+
+SCM_PROC1 (s_geq_p, ">=?", scm_tc7_rpsubr, scm_geq_p);
+#ifdef __STDC__
+SCM
+scm_geq_p(SCM x, SCM y)
+#else
+SCM
+scm_geq_p(x, y)
+     SCM x;
+     SCM y;
+#endif
+{
+  return SCM_BOOL_NOT(scm_less_p(x, y));
+}
+
+
+
+SCM_PROC(s_zero_p, "zero?", 1, 0, 0, scm_zero_p);
+#ifdef __STDC__
+SCM
+scm_zero_p(SCM z)
+#else
+SCM
+scm_zero_p(z)
+     SCM z;
+#endif
+{
+#ifdef SCM_FLOATS
+  if SCM_NINUMP(z) {
+# ifdef SCM_BIGDIG
+    SCM_ASRTGO(SCM_NIMP(z), badz);
+    if SCM_BIGP(z) return SCM_BOOL_F;
+#  ifndef RECKLESS
+    if (!(SCM_INEXP(z)))
+    badz: scm_wta(z, (char *)SCM_ARG1, s_zero_p);
+#  endif
+# else
+    SCM_ASSERT(SCM_NIMP(z) && SCM_INEXP(z), z, SCM_ARG1, s_zero_p);
+# endif
+    return (z==scm_flo0) ? SCM_BOOL_T : SCM_BOOL_F;
+  }
+#else
+# ifdef SCM_BIGDIG
+  if SCM_NINUMP(z) {
+    SCM_ASSERT(SCM_NIMP(z) && SCM_BIGP(z), z, SCM_ARG1, s_zero_p);
+    return SCM_BOOL_F;
+  }
+# else
+  SCM_ASSERT(SCM_INUMP(z), z, SCM_ARG1, s_zero_p);
+# endif
+#endif
+  return (z==SCM_INUM0) ? SCM_BOOL_T: SCM_BOOL_F;
+}
+
+
+
+SCM_PROC(s_positive_p, "positive?", 1, 0, 0, scm_positive_p);
+#ifdef __STDC__
+SCM
+scm_positive_p(SCM x)
+#else
+SCM
+scm_positive_p(x)
+     SCM x;
+#endif
+{
+#ifdef SCM_FLOATS
+  if SCM_NINUMP(x) {
+# ifdef SCM_BIGDIG
+    SCM_ASRTGO(SCM_NIMP(x), badx);
+    if SCM_BIGP(x) return SCM_TYP16(x)==scm_tc16_bigpos ? SCM_BOOL_T : SCM_BOOL_F;
+#  ifndef RECKLESS
+    if (!(SCM_REALP(x)))
+    badx: scm_wta(x, (char *)SCM_ARG1, s_positive_p);
+#  endif
+# else
+    SCM_ASSERT(SCM_NIMP(x) && SCM_REALP(x), x, SCM_ARG1, s_positive_p);
+# endif
+    return (SCM_REALPART(x) > 0.0) ? SCM_BOOL_T : SCM_BOOL_F;
+  }
+#else
+# ifdef SCM_BIGDIG
+  if SCM_NINUMP(x) {
+    SCM_ASSERT(SCM_NIMP(x) && SCM_BIGP(x), x, SCM_ARG1, s_positive_p);
+    return SCM_TYP16(x)==scm_tc16_bigpos ? SCM_BOOL_T : SCM_BOOL_F;
+  }
+# else
+  SCM_ASSERT(SCM_INUMP(x), x, SCM_ARG1, s_positive_p);
+# endif
+#endif
+  return (x > SCM_INUM0) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+
+
+SCM_PROC(s_negative_p, "negative?", 1, 0, 0, scm_negative_p);
+#ifdef __STDC__
+SCM
+scm_negative_p(SCM x)
+#else
+SCM
+scm_negative_p(x)
+     SCM x;
+#endif
+{
+#ifdef SCM_FLOATS
+  if SCM_NINUMP(x) {
+# ifdef SCM_BIGDIG
+    SCM_ASRTGO(SCM_NIMP(x), badx);
+    if SCM_BIGP(x) return SCM_TYP16(x)==scm_tc16_bigpos ? SCM_BOOL_F : SCM_BOOL_T;
+#  ifndef RECKLESS
+    if (!(SCM_REALP(x)))
+    badx: scm_wta(x, (char *)SCM_ARG1, s_negative_p);
+#  endif
+# else
+    SCM_ASSERT(SCM_NIMP(x) && SCM_REALP(x), x, SCM_ARG1, s_negative_p);
+# endif
+    return (SCM_REALPART(x) < 0.0) ? SCM_BOOL_T : SCM_BOOL_F;
+  }
+#else
+# ifdef SCM_BIGDIG
+  if SCM_NINUMP(x) {
+    SCM_ASSERT(SCM_NIMP(x) && SCM_BIGP(x), x, SCM_ARG1, s_negative_p);
+    return (SCM_TYP16(x)==scm_tc16_bigneg) ? SCM_BOOL_T : SCM_BOOL_F;
+  }
+# else
+  SCM_ASSERT(SCM_INUMP(x), x, SCM_ARG1, s_negative_p);
+# endif
+#endif
+  return (x < SCM_INUM0) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+
+SCM_PROC1 (s_max, "max", scm_tc7_asubr, scm_max);
+#ifdef __STDC__
+SCM
+scm_max(SCM x, SCM y)
+#else
+SCM
+scm_max(x, y)
+     SCM x;
+     SCM y;
+#endif
+{
+#ifdef SCM_FLOATS
+  double z;
+#endif
+  if SCM_UNBNDP(y) {
+#ifndef RECKLESS
+    if (!(SCM_NUMBERP(x)))
+      badx: scm_wta(x, (char *)SCM_ARG1, s_max);
+#endif
+    return x;
+  }
+#ifdef SCM_FLOATS
+  if SCM_NINUMP(x) {
+# ifdef SCM_BIGDIG
+    SCM_ASRTGO(SCM_NIMP(x), badx);
+    if SCM_BIGP(x) {
+      if SCM_INUMP(y) return SCM_BIGSIGN(x) ? y : x;
+      SCM_ASRTGO(SCM_NIMP(y), bady);
+      if SCM_BIGP(y) return (1==scm_bigcomp(x, y)) ? y : x;
+      SCM_ASRTGO(SCM_REALP(y), bady);
+      z = scm_big2dbl(x);
+      return (z < SCM_REALPART(y)) ? y : scm_makdbl(z, 0.0);
+    }
+    SCM_ASRTGO(SCM_REALP(x), badx);
+# else
+    SCM_ASSERT(SCM_NIMP(x) && SCM_REALP(x), x, SCM_ARG1, s_max);
+# endif
+    if (SCM_INUMP(y))
+      return (SCM_REALPART(x) < (z = SCM_INUM(y))) ? scm_makdbl(z, 0.0) : x;
+# ifdef SCM_BIGDIG
+    SCM_ASRTGO(SCM_NIMP(y), bady);
+    if (SCM_BIGP(y))
+      return (SCM_REALPART(x) < (z = scm_big2dbl(y))) ? scm_makdbl(z, 0.0) : x;
+    SCM_ASRTGO(SCM_REALP(y), bady);
+# else
+    SCM_ASRTGO(SCM_NIMP(y) && SCM_REALP(y), bady);
+# endif
+    return (SCM_REALPART(x) < SCM_REALPART(y)) ? y : x;
+  }
+  if SCM_NINUMP(y) {
+# ifdef SCM_BIGDIG
+    SCM_ASRTGO(SCM_NIMP(y), bady);
+    if SCM_BIGP(y) return SCM_BIGSIGN(y) ? x : y;
+#  ifndef RECKLESS
+    if (!(SCM_REALP(y)))
+    bady: scm_wta(y, (char *)SCM_ARG2, s_max);
+#  endif
+# else
+#  ifndef RECKLESS
+    if (!(SCM_NIMP(y) && SCM_REALP(y)))
+    bady: scm_wta(y, (char *)SCM_ARG2, s_max);
+#  endif
+# endif
+    return ((z = SCM_INUM(x)) < SCM_REALPART(y)) ? y : scm_makdbl(z, 0.0);
+  }
+#else
+# ifdef SCM_BIGDIG
+  if SCM_NINUMP(x) {
+    SCM_ASSERT(SCM_NIMP(x) && SCM_BIGP(x), x, SCM_ARG1, s_max);
+    if SCM_INUMP(y) return SCM_BIGSIGN(x) ? y : x;
+    SCM_ASRTGO(SCM_NIMP(y) && SCM_BIGP(y), bady);
+    return (1==scm_bigcomp(x, y)) ? y : x;
+  }
+  if SCM_NINUMP(y) {
+#  ifndef RECKLESS
+    if (!(SCM_NIMP(y) && SCM_BIGP(y)))
+    bady: scm_wta(y, (char *)SCM_ARG2, s_max);
+#  endif
+    return SCM_BIGSIGN(y) ? x : y;
+  }
+# else
+  SCM_ASSERT(SCM_INUMP(x), x, SCM_ARG1, s_max);
+  SCM_ASSERT(SCM_INUMP(y), y, SCM_ARG2, s_max);
+# endif
+#endif
+  return ((long)x < (long)y) ? y : x;
+}
+
+
+
+
+SCM_PROC1 (s_min, "min", scm_tc7_asubr, scm_min);
+#ifdef __STDC__
+SCM
+scm_min(SCM x, SCM y)
+#else
+SCM
+scm_min(x, y)
+     SCM x;
+     SCM y;
+#endif
+{
+#ifdef SCM_FLOATS
+  double z;
+#endif
+  if SCM_UNBNDP(y) {
+#ifndef RECKLESS
+    if (!(SCM_NUMBERP(x)))
+      badx:scm_wta(x, (char *)SCM_ARG1, s_min);
+#endif
+    return x;
+  }
+#ifdef SCM_FLOATS
+  if SCM_NINUMP(x) {
+# ifdef SCM_BIGDIG
+    SCM_ASRTGO(SCM_NIMP(x), badx);
+    if SCM_BIGP(x) {
+      if SCM_INUMP(y) return SCM_BIGSIGN(x) ? x : y;
+      SCM_ASRTGO(SCM_NIMP(y), bady);
+      if SCM_BIGP(y) return (-1==scm_bigcomp(x, y)) ? y : x;
+      SCM_ASRTGO(SCM_REALP(y), bady);
+      z = scm_big2dbl(x);
+      return (z > SCM_REALPART(y)) ? y : scm_makdbl(z, 0.0);
+    }
+    SCM_ASRTGO(SCM_REALP(x), badx);
+# else
+    SCM_ASSERT(SCM_NIMP(x) && SCM_REALP(x), x, SCM_ARG1, s_min);
+# endif
+    if SCM_INUMP(y) return (SCM_REALPART(x) > (z = SCM_INUM(y))) ? scm_makdbl(z, 0.0) : x;
+# ifdef SCM_BIGDIG
+    SCM_ASRTGO(SCM_NIMP(y), bady);
+    if SCM_BIGP(y) return (SCM_REALPART(x) > (z = scm_big2dbl(y))) ? scm_makdbl(z, 0.0) : x;
+    SCM_ASRTGO(SCM_REALP(y), bady);
+# else
+    SCM_ASRTGO(SCM_NIMP(y) && SCM_REALP(y), bady);
+# endif
+    return (SCM_REALPART(x) > SCM_REALPART(y)) ? y : x;
+  }
+  if SCM_NINUMP(y) {
+# ifdef SCM_BIGDIG
+    SCM_ASRTGO(SCM_NIMP(y), bady);
+    if SCM_BIGP(y) return SCM_BIGSIGN(y) ? y : x;
+#  ifndef RECKLESS
+    if (!(SCM_REALP(y)))
+    bady: scm_wta(y, (char *)SCM_ARG2, s_min);
+#  endif
+# else
+#  ifndef RECKLESS
+    if (!(SCM_NIMP(y) && SCM_REALP(y)))
+    bady: scm_wta(y, (char *)SCM_ARG2, s_min);
+#  endif
+# endif
+    return ((z = SCM_INUM(x)) > SCM_REALPART(y)) ? y : scm_makdbl(z, 0.0);
+  }
+#else
+# ifdef SCM_BIGDIG
+  if SCM_NINUMP(x) {
+    SCM_ASSERT(SCM_NIMP(x) && SCM_BIGP(x), x, SCM_ARG1, s_min);
+    if SCM_INUMP(y) return SCM_BIGSIGN(x) ? x : y;
+    SCM_ASRTGO(SCM_NIMP(y) && SCM_BIGP(y), bady);
+    return (-1==scm_bigcomp(x, y)) ? y : x;
+  }
+  if SCM_NINUMP(y) {
+#  ifndef RECKLESS
+    if (!(SCM_NIMP(y) && SCM_BIGP(y)))
+    bady: scm_wta(y, (char *)SCM_ARG2, s_min);
+#  endif
+    return SCM_BIGSIGN(y) ? y : x;
+  }
+# else
+  SCM_ASSERT(SCM_INUMP(x), x, SCM_ARG1, s_min);
+  SCM_ASSERT(SCM_INUMP(y), y, SCM_ARG2, s_min);
+# endif
+#endif
+  return ((long)x > (long)y) ? y : x;
+}
+
+
+
+
+SCM_PROC1 (s_sum, "+", scm_tc7_asubr, scm_sum);
+#ifdef __STDC__
+SCM
+scm_sum(SCM x, SCM y)
+#else
+SCM
+scm_sum(x, y)
+     SCM x;
+     SCM y;
+#endif
+{
+  if SCM_UNBNDP(y) {
+    if SCM_UNBNDP(x) return SCM_INUM0;
+#ifndef RECKLESS
+    if (!(SCM_NUMBERP(x)))
+    badx: scm_wta(x, (char *)SCM_ARG1, s_sum);
+#endif
+    return x;
+  }
+#ifdef SCM_FLOATS
+  if SCM_NINUMP(x) {
+    SCM t;
+# ifdef SCM_BIGDIG
+    SCM_ASRTGO(SCM_NIMP(x), badx);
+    if SCM_BIGP(x) {
+      if SCM_INUMP(y) {t = x; x = y; y = t; goto intbig;}
+      SCM_ASRTGO(SCM_NIMP(y), bady);
+      if SCM_BIGP(y) {
+	if (SCM_NUMDIGS(x) > SCM_NUMDIGS(y)) {t = x; x = y; y = t;}
+	return scm_addbig(SCM_BDIGITS(x), SCM_NUMDIGS(x), SCM_BIGSIGN(x), y, 0);
+      }
+      SCM_ASRTGO(SCM_INEXP(y), bady);
+    bigreal: return scm_makdbl(scm_big2dbl(x)+SCM_REALPART(y), SCM_CPLXP(y)?SCM_IMAG(y):0.0);
+    }
+    SCM_ASRTGO(SCM_INEXP(x), badx);
+# else
+    SCM_ASRTGO(SCM_NIMP(x) && SCM_INEXP(x), badx);
+# endif
+    if SCM_INUMP(y) {t = x; x = y; y = t; goto intreal;}
+# ifdef SCM_BIGDIG
+    SCM_ASRTGO(SCM_NIMP(y), bady);
+    if SCM_BIGP(y) {t = x; x = y; y = t; goto bigreal;}
+#  ifndef RECKLESS
+    else if (!(SCM_INEXP(y)))
+    bady: scm_wta(y, (char *)SCM_ARG2, s_sum);
+#  endif
+# else
+#  ifndef RECKLESS
+    if (!(SCM_NIMP(y) && SCM_INEXP(y)))
+    bady: scm_wta(y, (char *)SCM_ARG2, s_sum);
+#  endif
+# endif
+    { double i = 0.0;
+      if SCM_CPLXP(x) i = SCM_IMAG(x);
+      if SCM_CPLXP(y) i += SCM_IMAG(y);
+      return scm_makdbl(SCM_REALPART(x)+SCM_REALPART(y), i); }
+  }
+  if SCM_NINUMP(y) {
+# ifdef SCM_BIGDIG
+    SCM_ASRTGO(SCM_NIMP(y), bady);
+    if SCM_BIGP(y)
+    intbig: {
+#  ifndef SCM_DIGSTOOBIG
+      long z = scm_pseudolong(SCM_INUM(x));
+      return scm_addbig((SCM_BIGDIG *)&z, SCM_DIGSPERLONG, (x < 0) ? 0x0100 : 0, y, 0);
+#  else
+      SCM_BIGDIG zdigs[SCM_DIGSPERLONG];
+      scm_longdigs(SCM_INUM(x), zdigs);
+      return scm_addbig(zdigs, SCM_DIGSPERLONG, (x < 0) ? 0x0100 : 0, y, 0);
+#  endif
+    }
+    SCM_ASRTGO(SCM_INEXP(y), bady);
+# else
+    SCM_ASRTGO(SCM_NIMP(y) && SCM_INEXP(y), bady);
+# endif
+  intreal: return scm_makdbl(SCM_INUM(x)+SCM_REALPART(y), SCM_CPLXP(y)?SCM_IMAG(y):0.0);
+  }
+#else
+# ifdef SCM_BIGDIG
+  if SCM_NINUMP(x) {
+    SCM t;
+    SCM_ASRTGO(SCM_NIMP(x) && SCM_BIGP(x), badx);
+    if SCM_INUMP(y) {t = x; x = y; y = t; goto intbig;}
+    SCM_ASRTGO(SCM_NIMP(y) && SCM_BIGP(y), bady);
+    if (SCM_NUMDIGS(x) > SCM_NUMDIGS(y)) {t = x; x = y; y = t;}
+    return scm_addbig(SCM_BDIGITS(x), SCM_NUMDIGS(x), SCM_BIGSIGN(x), y, 0);
+  }
+  if SCM_NINUMP(y) {
+#  ifndef RECKLESS
+    if (!(SCM_NIMP(y) && SCM_BIGP(y)))
+    bady: scm_wta(y, (char *)SCM_ARG2, s_sum);
+#  endif
+  intbig: {
+#  ifndef SCM_DIGSTOOBIG
+    long z = scm_pseudolong(SCM_INUM(x));
+    return scm_addbig(&z, SCM_DIGSPERLONG, (x < 0) ? 0x0100 : 0, y, 0);
+#  else
+    SCM_BIGDIG zdigs[SCM_DIGSPERLONG];
+    scm_longdigs(SCM_INUM(x), zdigs);
+    return scm_addbig(zdigs, SCM_DIGSPERLONG, (x < 0) ? 0x0100 : 0, y, 0);
+#  endif
+  }
+  }
+# else
+  SCM_ASRTGO(SCM_INUMP(x), badx);
+  SCM_ASSERT(SCM_INUMP(y), y, SCM_ARG2, s_sum);
+# endif
+#endif
+  x = SCM_INUM(x)+SCM_INUM(y);
+  if SCM_FIXABLE(x) return SCM_MAKINUM(x);
+#ifdef SCM_BIGDIG
+  return scm_long2big(x);
+#else
+# ifdef SCM_FLOATS
+  return scm_makdbl((double)x, 0.0);
+# else
+  scm_wta(y, (char *)SCM_OVSCM_FLOW, s_sum);
+  return SCM_UNSPECIFIED;
+# endif
+#endif
+}
+
+
+
+
+SCM_PROC1 (s_difference, "-", scm_tc7_asubr, scm_difference);
+#ifdef __STDC__
+SCM
+scm_difference(SCM x, SCM y)
+#else
+SCM
+scm_difference(x, y)
+     SCM x;
+     SCM y;
+#endif
+{
+#ifdef SCM_FLOATS
+  if SCM_NINUMP(x) {
+# ifndef RECKLESS
+    if (!(SCM_NIMP(x)))
+    badx: scm_wta(x, (char *)SCM_ARG1, s_difference);
+# endif
+    if SCM_UNBNDP(y) {
+# ifdef SCM_BIGDIG
+      if SCM_BIGP(x) {
+	x = scm_copybig(x, !SCM_BIGSIGN(x));
+	return SCM_NUMDIGS(x) * SCM_BITSPERDIG/SCM_CHAR_BIT <= sizeof(SCM) ?
+	  scm_big2inum(x, SCM_NUMDIGS(x)) : x;
+      }
+# endif
+      SCM_ASRTGO(SCM_INEXP(x), badx);
+      return scm_makdbl(-SCM_REALPART(x), SCM_CPLXP(x)?-SCM_IMAG(x):0.0);
+    }
+    if SCM_INUMP(y) return scm_sum(x, SCM_MAKINUM(-SCM_INUM(y)));
+# ifdef SCM_BIGDIG
+    SCM_ASRTGO(SCM_NIMP(y), bady);
+    if SCM_BIGP(x) {
+      if SCM_BIGP(y) return (SCM_NUMDIGS(x) < SCM_NUMDIGS(y)) ?
+	scm_addbig(SCM_BDIGITS(x), SCM_NUMDIGS(x), SCM_BIGSIGN(x), y, 0x0100) :
+      scm_addbig(SCM_BDIGITS(y), SCM_NUMDIGS(y), SCM_BIGSIGN(y) ^ 0x0100, x, 0);
+      SCM_ASRTGO(SCM_INEXP(y), bady);
+      return scm_makdbl(scm_big2dbl(x)-SCM_REALPART(y), SCM_CPLXP(y)?-SCM_IMAG(y):0.0);
+    }
+    SCM_ASRTGO(SCM_INEXP(x), badx);
+    if SCM_BIGP(y) return scm_makdbl(SCM_REALPART(x)-scm_big2dbl(y), SCM_CPLXP(x)?SCM_IMAG(x):0.0);
+    SCM_ASRTGO(SCM_INEXP(y), bady);
+# else
+    SCM_ASRTGO(SCM_INEXP(x), badx);
+    SCM_ASRTGO(SCM_NIMP(y) && SCM_INEXP(y), bady);
+# endif
+    if SCM_CPLXP(x)
+      if SCM_CPLXP(y)
+	return scm_makdbl(SCM_REAL(x)-SCM_REAL(y), SCM_IMAG(x)-SCM_IMAG(y));
+      else
+	return scm_makdbl(SCM_REAL(x)-SCM_REALPART(y), SCM_IMAG(x));
+    return scm_makdbl(SCM_REALPART(x)-SCM_REALPART(y), SCM_CPLXP(y)?-SCM_IMAG(y):0.0);
+  }
+  if SCM_UNBNDP(y) {x = -SCM_INUM(x); goto checkx;}
+  if SCM_NINUMP(y) {
+# ifdef SCM_BIGDIG
+    SCM_ASRTGO(SCM_NIMP(y), bady);
+    if SCM_BIGP(y) {
+#  ifndef SCM_DIGSTOOBIG
+      long z = scm_pseudolong(SCM_INUM(x));
+      return scm_addbig((SCM_BIGDIG *)&z, SCM_DIGSPERLONG, (x < 0) ? 0x0100 : 0, y, 0x0100);
+#  else
+      SCM_BIGDIG zdigs[SCM_DIGSPERLONG];
+      scm_longdigs(SCM_INUM(x), zdigs);
+      return scm_addbig(zdigs, SCM_DIGSPERLONG, (x < 0) ? 0x0100 : 0, y, 0x0100);
+#  endif
+    }
+#  ifndef RECKLESS
+    if (!(SCM_INEXP(y)))
+    bady: scm_wta(y, (char *)SCM_ARG2, s_difference);
+#  endif
+# else
+#  ifndef RECKLESS
+    if (!(SCM_NIMP(y) && SCM_INEXP(y)))
+    bady: scm_wta(y, (char *)SCM_ARG2, s_difference);
+#  endif
+# endif
+    return scm_makdbl(SCM_INUM(x)-SCM_REALPART(y), SCM_CPLXP(y)?-SCM_IMAG(y):0.0);
+  }
+#else
+# ifdef SCM_BIGDIG
+  if SCM_NINUMP(x) {
+    SCM_ASSERT(SCM_NIMP(x) && SCM_BIGP(x), x, SCM_ARG1, s_difference);
+    if SCM_UNBNDP(y) {
+      x = scm_copybig(x, !SCM_BIGSIGN(x));
+      return SCM_NUMDIGS(x) * SCM_BITSPERDIG/SCM_CHAR_BIT <= sizeof(SCM) ?
+	scm_big2inum(x, SCM_NUMDIGS(x)) : x;
+    }
+    if SCM_INUMP(y) {
+#  ifndef SCM_DIGSTOOBIG
+      long z = scm_pseudolong(SCM_INUM(y));
+      return scm_addbig(&z, SCM_DIGSPERLONG, (y < 0) ? 0 : 0x0100, x, 0);
+#  else
+      SCM_BIGDIG zdigs[SCM_DIGSPERLONG];
+      scm_longdigs(SCM_INUM(x), zdigs);
+      return scm_addbig(zdigs, SCM_DIGSPERLONG, (y < 0) ? 0 : 0x0100, x, 0);
+#  endif
+    }
+    SCM_ASRTGO(SCM_NIMP(y) && SCM_BIGP(y), bady);
+    return (SCM_NUMDIGS(x) < SCM_NUMDIGS(y)) ?
+      scm_addbig(SCM_BDIGITS(x), SCM_NUMDIGS(x), SCM_BIGSIGN(x), y, 0x0100) :
+    scm_addbig(SCM_BDIGITS(y), SCM_NUMDIGS(y), SCM_BIGSIGN(y) ^ 0x0100, x, 0);
+  }
+  if SCM_UNBNDP(y) {x = -SCM_INUM(x); goto checkx;}
+  if SCM_NINUMP(y) {
+#  ifndef RECKLESS
+    if (!(SCM_NIMP(y) && SCM_BIGP(y)))
+    bady: scm_wta(y, (char *)SCM_ARG2, s_difference);
+#  endif
+    {
+#  ifndef SCM_DIGSTOOBIG
+      long z = scm_pseudolong(SCM_INUM(x));
+      return scm_addbig(&z, SCM_DIGSPERLONG, (x < 0) ? 0x0100 : 0, y, 0x0100);
+#  else
+      SCM_BIGDIG zdigs[SCM_DIGSPERLONG];
+      scm_longdigs(SCM_INUM(x), zdigs);
+      return scm_addbig(zdigs, SCM_DIGSPERLONG, (x < 0) ? 0x0100 : 0, y, 0x0100);
+#  endif
+    }
+  }
+# else
+  SCM_ASSERT(SCM_INUMP(x), x, SCM_ARG1, s_difference);
+  if SCM_UNBNDP(y) {x = -SCM_INUM(x); goto checkx;}
+  SCM_ASSERT(SCM_INUMP(y), y, SCM_ARG2, s_difference);
+# endif
+#endif
+  x = SCM_INUM(x)-SCM_INUM(y);
+ checkx:
+  if SCM_FIXABLE(x) return SCM_MAKINUM(x);
+#ifdef SCM_BIGDIG
+  return scm_long2big(x);
+#else
+# ifdef SCM_FLOATS
+  return scm_makdbl((double)x, 0.0);
+# else
+  scm_wta(y, (char *)SCM_OVSCM_FLOW, s_difference);
+  return SCM_UNSPECIFIED;
+# endif
+#endif
+}
+
+
+
+
+SCM_PROC1 (s_product, "*", scm_tc7_asubr, scm_product);
+#ifdef __STDC__
+SCM
+scm_product(SCM x, SCM y)
+#else
+SCM
+scm_product(x, y)
+     SCM x;
+     SCM y;
+#endif
+{
+  if SCM_UNBNDP(y) {
+    if SCM_UNBNDP(x) return SCM_MAKINUM(1L);
+#ifndef RECKLESS
+    if (!(SCM_NUMBERP(x)))
+    badx: scm_wta(x, (char *)SCM_ARG1, s_product);
+#endif
+    return x;
+  }
+#ifdef SCM_FLOATS
+  if SCM_NINUMP(x) {
+    SCM t;
+# ifdef SCM_BIGDIG
+    SCM_ASRTGO(SCM_NIMP(x), badx);
+    if SCM_BIGP(x) {
+      if SCM_INUMP(y) {t = x; x = y; y = t; goto intbig;}
+      SCM_ASRTGO(SCM_NIMP(y), bady);
+      if SCM_BIGP(y) return scm_mulbig(SCM_BDIGITS(x), SCM_NUMDIGS(x), SCM_BDIGITS(y), SCM_NUMDIGS(y),
+				   SCM_BIGSIGN(x) ^ SCM_BIGSIGN(y));
+      SCM_ASRTGO(SCM_INEXP(y), bady);
+    bigreal: {
+      double bg = scm_big2dbl(x);
+      return scm_makdbl(bg*SCM_REALPART(y), SCM_CPLXP(y)?bg*SCM_IMAG(y):0.0); }
+    }
+    SCM_ASRTGO(SCM_INEXP(x), badx);
+# else
+    SCM_ASRTGO(SCM_NIMP(x) && SCM_INEXP(x), badx);
+# endif
+    if SCM_INUMP(y) {t = x; x = y; y = t; goto intreal;}
+# ifdef SCM_BIGDIG
+    SCM_ASRTGO(SCM_NIMP(y), bady);
+    if SCM_BIGP(y) {t = x; x = y; y = t; goto bigreal;}
+#  ifndef RECKLESS
+    else if (!(SCM_INEXP(y)))
+    bady: scm_wta(y, (char *)SCM_ARG2, s_product);
+#  endif
+# else
+#  ifndef RECKLESS
+    if (!(SCM_NIMP(y) && SCM_INEXP(y)))
+    bady: scm_wta(y, (char *)SCM_ARG2, s_product);
+#  endif
+# endif
+    if SCM_CPLXP(x)
+      if SCM_CPLXP(y)
+	return scm_makdbl(SCM_REAL(x)*SCM_REAL(y)-SCM_IMAG(x)*SCM_IMAG(y),
+			  SCM_REAL(x)*SCM_IMAG(y)+SCM_IMAG(x)*SCM_REAL(y));
+      else
+	return scm_makdbl(SCM_REAL(x)*SCM_REALPART(y), SCM_IMAG(x)*SCM_REALPART(y));
+    return scm_makdbl(SCM_REALPART(x)*SCM_REALPART(y),
+		      SCM_CPLXP(y)?SCM_REALPART(x)*SCM_IMAG(y):0.0);
+  }
+  if SCM_NINUMP(y) {
+# ifdef SCM_BIGDIG
+    SCM_ASRTGO(SCM_NIMP(y), bady);
+    if SCM_BIGP(y) {
+    intbig: if (SCM_INUM0==x) return x; if (SCM_MAKINUM(1L)==x) return y;
+      {
+#  ifndef SCM_DIGSTOOBIG
+	long z = scm_pseudolong(SCM_INUM(x));
+	return scm_mulbig((SCM_BIGDIG *)&z, SCM_DIGSPERLONG, SCM_BDIGITS(y), SCM_NUMDIGS(y),
+			  SCM_BIGSIGN(y) ? (x>0) : (x<0));
+#  else
+	SCM_BIGDIG zdigs[SCM_DIGSPERLONG];
+	scm_longdigs(SCM_INUM(x), zdigs);
+	return scm_mulbig(zdigs, SCM_DIGSPERLONG, SCM_BDIGITS(y), SCM_NUMDIGS(y),
+			  SCM_BIGSIGN(y) ? (x>0) : (x<0));
+#  endif
+      }
+    }
+    SCM_ASRTGO(SCM_INEXP(y), bady);
+# else
+    SCM_ASRTGO(SCM_NIMP(y) && SCM_INEXP(y), bady);
+# endif
+  intreal: return scm_makdbl(SCM_INUM(x)*SCM_REALPART(y), SCM_CPLXP(y)?SCM_INUM(x)*SCM_IMAG(y):0.0);
+  }
+#else
+# ifdef SCM_BIGDIG
+  if SCM_NINUMP(x) {
+    SCM_ASRTGO(SCM_NIMP(x) && SCM_BIGP(x), badx);
+    if SCM_INUMP(y) {SCM t = x; x = y; y = t; goto intbig;}
+    SCM_ASRTGO(SCM_NIMP(y) && SCM_BIGP(y), bady);
+    return scm_mulbig(SCM_BDIGITS(x), SCM_NUMDIGS(x), SCM_BDIGITS(y), SCM_NUMDIGS(y),
+		      SCM_BIGSIGN(x) ^ SCM_BIGSIGN(y));
+  }
+  if SCM_NINUMP(y) {
+#  ifndef RECKLESS
+    if (!(SCM_NIMP(y) && SCM_BIGP(y)))
+    bady: scm_wta(y, (char *)SCM_ARG2, s_product);
+#  endif
+  intbig: if (SCM_INUM0==x) return x; if (SCM_MAKINUM(1L)==x) return y;
+    {
+#  ifndef SCM_DIGSTOOBIG
+      long z = scm_pseudolong(SCM_INUM(x));
+      return scm_mulbig(&z, SCM_DIGSPERLONG, SCM_BDIGITS(y), SCM_NUMDIGS(y),
+			SCM_BIGSIGN(y) ? (x>0) : (x<0));
+#  else
+      SCM_BIGDIG zdigs[SCM_DIGSPERLONG];
+      scm_longdigs(SCM_INUM(x), zdigs);
+      return scm_mulbig(zdigs, SCM_DIGSPERLONG, SCM_BDIGITS(y), SCM_NUMDIGS(y),
+			SCM_BIGSIGN(y) ? (x>0) : (x<0));
+#  endif
+    }
+  }
+# else
+  SCM_ASRTGO(SCM_INUMP(x), badx);
+  SCM_ASSERT(SCM_INUMP(y), y, SCM_ARG2, s_product);
+# endif
+#endif
+  {
+    long i, j, k;
+    i = SCM_INUM(x);
+    if (0==i) return x;
+    j = SCM_INUM(y);
+    k = i * j;
+    y = SCM_MAKINUM(k);
+    if (k != SCM_INUM(y) || k/i != j)
+#ifdef SCM_BIGDIG
+      { int sgn = (i < 0) ^ (j < 0);
+# ifndef SCM_DIGSTOOBIG
+	i = scm_pseudolong(i);
+	j = scm_pseudolong(j);
+	return scm_mulbig((SCM_BIGDIG *)&i, SCM_DIGSPERLONG,
+			  (SCM_BIGDIG *)&j, SCM_DIGSPERLONG, sgn);
+# else /* SCM_DIGSTOOBIG */
+	SCM_BIGDIG idigs[SCM_DIGSPERLONG];
+	SCM_BIGDIG jdigs[SCM_DIGSPERLONG];
+	scm_longdigs(i, idigs);
+	scm_longdigs(j, jdigs);
+	return scm_mulbig(idigs, SCM_DIGSPERLONG, jdigs, SCM_DIGSPERLONG, sgn);
+# endif
+      }
+#else
+# ifdef SCM_FLOATS
+    return scm_makdbl(((double)i)*((double)j), 0.0);
+# else
+    scm_wta(y, (char *)SCM_OVSCM_FLOW, s_product);
+# endif
+#endif
+    return y;
+  }
+}
+
+
+#ifdef __STDC__
+double
+scm_num2dbl (SCM a, char * why)
+#else
+double
+scm_num2dbl (a, why)
+     SCM a;
+     char * why;
+#endif
+{
+  if (SCM_INUMP (a))
+    return (double) SCM_INUM (a);
+#ifdef SCM_FLOATS
+  SCM_ASSERT (SCM_NIMP (a), a, "wrong type argument", why);
+  if (SCM_REALP (a))
+    return (SCM_REALPART (a));
+#endif
+#ifdef SCM_BIGDIG
+  return scm_big2dbl (a);
+#endif
+  SCM_ASSERT (0, a, "wrong type argument", why);
+  return SCM_UNSPECIFIED;
+}
+
+
+SCM_PROC(s_fuck, "fuck", 1, 0, 0, scm_fuck);
+#ifdef __STDC__
+SCM
+scm_fuck (SCM a)
+#else
+SCM
+scm_fuck (a)
+     SCM a;
+#endif
+{
+  return scm_makdbl (scm_num2dbl (a, "just because"), 0.0);
+}
+
+SCM_PROC1 (s_divide, "/", scm_tc7_asubr, scm_divide);
+#ifdef __STDC__
+SCM
+scm_divide(SCM x, SCM y)
+#else
+SCM
+scm_divide(x, y)
+     SCM x;
+     SCM y;
+#endif
+{
+#ifdef SCM_FLOATS
+  double d, r, i, a;
+  if SCM_NINUMP(x) {
+# ifndef RECKLESS
+    if (!(SCM_NIMP(x)))
+    badx: scm_wta(x, (char *)SCM_ARG1, s_divide);
+# endif
+    if SCM_UNBNDP(y) {
+# ifdef SCM_BIGDIG
+      if SCM_BIGP(x) return scm_makdbl(1.0/scm_big2dbl(x), 0.0);
+# endif
+      SCM_ASRTGO(SCM_INEXP(x), badx);
+      if SCM_REALP(x) return scm_makdbl(1.0/SCM_REALPART(x), 0.0);
+      r = SCM_REAL(x);  i = SCM_IMAG(x);  d = r*r+i*i;
+      return scm_makdbl(r/d, -i/d);
+    }
+# ifdef SCM_BIGDIG
+    if SCM_BIGP(x) {
+      SCM z;
+      if SCM_INUMP(y) {
+        z = SCM_INUM(y);
+        SCM_ASSERT(z, y, SCM_OVSCM_FLOW, s_divide);
+	if (1==z) return x;
+        if (z < 0) z = -z;
+        if (z < SCM_BIGRAD) {
+          SCM w = scm_copybig(x, SCM_BIGSIGN(x) ? (y>0) : (y<0));
+          return scm_divbigdig(SCM_BDIGITS(w), SCM_NUMDIGS(w), (SCM_BIGDIG)z) ?
+	    scm_makdbl(scm_big2dbl(x)/SCM_INUM(y), 0.0) : scm_normbig(w);
+	}
+#  ifndef SCM_DIGSTOOBIG
+        z = scm_pseudolong(z);
+        z = scm_divbigbig(SCM_BDIGITS(x), SCM_NUMDIGS(x), (SCM_BIGDIG *)&z, SCM_DIGSPERLONG,
+			  SCM_BIGSIGN(x) ? (y>0) : (y<0), 3);
+#  else
+	{ SCM_BIGDIG zdigs[SCM_DIGSPERLONG];
+	  scm_longdigs(z, zdigs);
+	  z = scm_divbigbig(SCM_BDIGITS(x), SCM_NUMDIGS(x), zdigs, SCM_DIGSPERLONG,
+			    SCM_BIGSIGN(x) ? (y>0) : (y<0), 3);}
+#  endif
+        return z ? z : scm_makdbl(scm_big2dbl(x)/SCM_INUM(y), 0.0);
+      }
+      SCM_ASRTGO(SCM_NIMP(y), bady);
+      if SCM_BIGP(y) {
+	z = scm_divbigbig(SCM_BDIGITS(x), SCM_NUMDIGS(x), SCM_BDIGITS(y), SCM_NUMDIGS(y),
+			  SCM_BIGSIGN(x) ^ SCM_BIGSIGN(y), 3);
+	return z ? z : scm_makdbl(scm_big2dbl(x)/scm_big2dbl(y), 0.0);
+      }
+      SCM_ASRTGO(SCM_INEXP(y), bady);
+      if SCM_REALP(y) return scm_makdbl(scm_big2dbl(x)/SCM_REALPART(y), 0.0);
+      a = scm_big2dbl(x);
+      goto complex_div;
+    }
+# endif
+    SCM_ASRTGO(SCM_INEXP(x), badx);
+    if SCM_INUMP(y) {d = SCM_INUM(y); goto basic_div;}
+# ifdef SCM_BIGDIG
+    SCM_ASRTGO(SCM_NIMP(y), bady);
+    if SCM_BIGP(y) {d = scm_big2dbl(y); goto basic_div;}
+    SCM_ASRTGO(SCM_INEXP(y), bady);
+# else
+    SCM_ASRTGO(SCM_NIMP(y) && SCM_INEXP(y), bady);
+# endif
+    if SCM_REALP(y) {
+      d = SCM_REALPART(y);
+    basic_div: return scm_makdbl(SCM_REALPART(x)/d, SCM_CPLXP(x)?SCM_IMAG(x)/d:0.0);
+    }
+    a = SCM_REALPART(x);
+    if SCM_REALP(x) goto complex_div;
+    r = SCM_REAL(y);  i = SCM_IMAG(y);  d = r*r+i*i;
+    return scm_makdbl((a*r+SCM_IMAG(x)*i)/d, (SCM_IMAG(x)*r-a*i)/d);
+  }
+  if SCM_UNBNDP(y) {
+    if ((SCM_MAKINUM(1L)==x) || (SCM_MAKINUM(-1L)==x)) return x;
+    return scm_makdbl(1.0/((double)SCM_INUM(x)), 0.0);
+  }
+  if SCM_NINUMP(y) {
+# ifdef SCM_BIGDIG
+    SCM_ASRTGO(SCM_NIMP(y), bady);
+    if SCM_BIGP(y) return scm_makdbl(SCM_INUM(x)/scm_big2dbl(y), 0.0);
+#  ifndef RECKLESS
+    if (!(SCM_INEXP(y)))
+    bady: scm_wta(y, (char *)SCM_ARG2, s_divide);
+#  endif
+# else
+#  ifndef RECKLESS
+    if (!(SCM_NIMP(y) && SCM_INEXP(y)))
+    bady: scm_wta(y, (char *)SCM_ARG2, s_divide);
+#  endif
+# endif
+    if (SCM_REALP(y))
+      return scm_makdbl(SCM_INUM(x)/SCM_REALPART(y), 0.0);
+    a = SCM_INUM(x);
+  complex_div:
+    r = SCM_REAL(y);  i = SCM_IMAG(y);  d = r*r+i*i;
+    return scm_makdbl((a*r)/d, (-a*i)/d);
+  }
+#else
+# ifdef SCM_BIGDIG
+  if SCM_NINUMP(x) {
+    SCM z;
+    SCM_ASSERT(SCM_NIMP(x) && SCM_BIGP(x), x, SCM_ARG1, s_divide);
+    if SCM_UNBNDP(y) goto ov;
+    if SCM_INUMP(y) {
+      z = SCM_INUM(y);
+      if (!z) goto ov;
+      if (1==z) return x;
+      if (z < 0) z = -z;
+      if (z < SCM_BIGRAD) {
+        SCM w = scm_copybig(x, SCM_BIGSIGN(x) ? (y>0) : (y<0));
+        if (scm_divbigdig(SCM_BDIGITS(w), SCM_NUMDIGS(w), (SCM_BIGDIG)z)) goto ov;
+        return w;
+      }
+#  ifndef SCM_DIGSTOOBIG
+      z = scm_pseudolong(z);
+      z = scm_divbigbig(SCM_BDIGITS(x), SCM_NUMDIGS(x), &z, SCM_DIGSPERLONG,
+			SCM_BIGSIGN(x) ? (y>0) : (y<0), 3);
+#  else
+      { SCM_BIGDIG zdigs[SCM_DIGSPERLONG];
+	scm_longdigs(z, zdigs);
+	z = scm_divbigbig(SCM_BDIGITS(x), SCM_NUMDIGS(x), zdigs, SCM_DIGSPERLONG,
+			  SCM_BIGSIGN(x) ? (y>0) : (y<0), 3);}
+#  endif
+    } else {
+      SCM_ASRTGO(SCM_NIMP(y) && SCM_BIGP(y), bady);
+      z = scm_divbigbig(SCM_BDIGITS(x), SCM_NUMDIGS(x), SCM_BDIGITS(y), SCM_NUMDIGS(y),
+			SCM_BIGSIGN(x) ^ SCM_BIGSIGN(y), 3);
+    }
+    if (!z) goto ov;
+    return z;
+  }
+  if SCM_UNBNDP(y) {
+    if ((SCM_MAKINUM(1L)==x) || (SCM_MAKINUM(-1L)==x)) return x;
+    goto ov;
+  }
+  if SCM_NINUMP(y) {
+#  ifndef RECKLESS
+    if (!(SCM_NIMP(y) && SCM_BIGP(y)))
+    bady: scm_wta(y, (char *)SCM_ARG2, s_divide);
+#  endif
+    goto ov;
+  }
+# else
+  SCM_ASSERT(SCM_INUMP(x), x, SCM_ARG1, s_divide);
+  if SCM_UNBNDP(y) {
+    if ((SCM_MAKINUM(1L)==x) || (SCM_MAKINUM(-1L)==x)) return x;
+    goto ov;
+  }
+  SCM_ASSERT(SCM_INUMP(y), y, SCM_ARG2, s_divide);
+# endif
+#endif
+  {
+    long z = SCM_INUM(y);
+    if ((0==z) || SCM_INUM(x)%z) goto ov;
+    z = SCM_INUM(x)/z;
+    if SCM_FIXABLE(z) return SCM_MAKINUM(z);
+#ifdef SCM_BIGDIG
+    return scm_long2big(z);
+#endif
+#ifdef SCM_FLOATS
+  ov: return scm_makdbl(((double)SCM_INUM(x))/((double)SCM_INUM(y)), 0.0);
+#else
+  ov: scm_wta(x, (char *)SCM_OVSCM_FLOW, s_divide);
+    return SCM_UNSPECIFIED;
+#endif
+  }
+}
+
+
+
+
+#ifdef SCM_FLOATS
+SCM_PROC1 (s_asinh, "$asinh", scm_tc7_cxr, (SCM (*)()) scm_asinh);
+#ifdef __STDC__
+double
+scm_asinh(double x)
+#else
+double
+scm_asinh(x)
+     double x;
+#endif
+{
+  return log(x+sqrt(x*x+1));
+}
+
+
+
+
+SCM_PROC1 (s_acosh, "$acosh", scm_tc7_cxr, (SCM (*)()) scm_acosh);
+#ifdef __STDC__
+double
+scm_acosh(double x)
+#else
+double
+scm_acosh(x)
+     double x;
+#endif
+{
+  return log(x+sqrt(x*x-1));
+}
+
+
+
+
+SCM_PROC1 (s_atanh, "$atanh", scm_tc7_cxr, (SCM (*)()) scm_atanh);
+#ifdef __STDC__
+double
+scm_atanh(double x)
+#else
+double
+scm_atanh(x)
+     double x;
+#endif
+{
+  return 0.5*log((1+x)/(1-x));
+}
+
+
+
+
+SCM_PROC1 (s_truncate, "truncate", scm_tc7_cxr, (SCM (*)()) scm_truncate);
+#ifdef __STDC__
+double
+scm_truncate(double x)
+#else
+double
+scm_truncate(x)
+     double x;
+#endif
+{
+  if (x < 0.0) return -floor(-x);
+  return floor(x);
+}
+
+
+
+SCM_PROC1 (s_round, "round", scm_tc7_cxr, (SCM (*)()) scm_round);
+#ifdef __STDC__
+double
+scm_round(double x)
+#else
+double
+scm_round(x)
+     double x;
+#endif
+{
+  double plus_half = x + 0.5;
+  double result = floor(plus_half);
+  /* Adjust so that the scm_round is towards even.  */
+  return (plus_half == result && plus_half / 2 != floor(plus_half / 2))
+    ? result - 1 : result;
+}
+
+
+
+SCM_PROC1 (s_exact_to_inexact, "exact->inexact", scm_tc7_cxr, (SCM (*)()) scm_exact_to_inexact);
+#ifdef __STDC__
+double
+scm_exact_to_inexact(double z)
+#else
+double
+scm_exact_to_inexact(z)
+     double z;
+#endif
+{
+  return z;
+}
+
+
+SCM_PROC1 (s_i_floor, "floor", scm_tc7_cxr, (SCM (*)()) floor);
+SCM_PROC1 (s_i_ceil, "ceiling", scm_tc7_cxr, (SCM (*)()) ceil);
+SCM_PROC1 (s_i_sqrt, "$sqrt", scm_tc7_cxr, (SCM (*)())sqrt);
+SCM_PROC1 (s_i_abs, "$abs", scm_tc7_cxr, (SCM (*)())fabs);
+SCM_PROC1 (s_i_exp, "$exp", scm_tc7_cxr, (SCM (*)())exp);
+SCM_PROC1 (s_i_log, "$log", scm_tc7_cxr, (SCM (*)())log);
+SCM_PROC1 (s_i_sin, "$sin", scm_tc7_cxr, (SCM (*)())sin);
+SCM_PROC1 (s_i_cos, "$cos", scm_tc7_cxr, (SCM (*)())cos);
+SCM_PROC1 (s_i_tan, "$tan", scm_tc7_cxr, (SCM (*)())tan);
+SCM_PROC1 (s_i_asin, "$asin", scm_tc7_cxr, (SCM (*)())asin);
+SCM_PROC1 (s_i_acos, "$acos", scm_tc7_cxr, (SCM (*)())acos);
+SCM_PROC1 (s_i_atan, "$atan", scm_tc7_cxr, (SCM (*)())atan);
+SCM_PROC1 (s_i_sinh, "$sinh", scm_tc7_cxr, (SCM (*)())sinh);
+SCM_PROC1 (s_i_cosh, "$cosh", scm_tc7_cxr, (SCM (*)())cosh);
+SCM_PROC1 (s_i_tanh, "$tanh", scm_tc7_cxr, (SCM (*)())tanh);
+
+struct dpair {double x, y;};
+
+void scm_two_doubles(z1, z2, sstring, xy)
+     SCM z1, z2;
+     char *sstring;
+     struct dpair *xy;
+{
+  if SCM_INUMP(z1) xy->x = SCM_INUM(z1);
+  else {
+# ifdef SCM_BIGDIG
+    SCM_ASRTGO(SCM_NIMP(z1), badz1);
+    if SCM_BIGP(z1) xy->x = scm_big2dbl(z1);
+    else {
+#  ifndef RECKLESS
+      if (!(SCM_REALP(z1)))
+      badz1: scm_wta(z1, (char *)SCM_ARG1, sstring);
+#  endif
+      xy->x = SCM_REALPART(z1);}
+# else
+    {SCM_ASSERT(SCM_NIMP(z1) && SCM_REALP(z1), z1, SCM_ARG1, sstring);
+     xy->x = SCM_REALPART(z1);}
+# endif
+  }
+  if SCM_INUMP(z2) xy->y = SCM_INUM(z2);
+  else {
+# ifdef SCM_BIGDIG
+    SCM_ASRTGO(SCM_NIMP(z2), badz2);
+    if SCM_BIGP(z2) xy->y = scm_big2dbl(z2);
+    else {
+#  ifndef RECKLESS
+      if (!(SCM_REALP(z2)))
+      badz2: scm_wta(z2, (char *)SCM_ARG2, sstring);
+#  endif
+      xy->y = SCM_REALPART(z2);}
+# else
+    {SCM_ASSERT(SCM_NIMP(z2) && SCM_REALP(z2), z2, SCM_ARG2, sstring);
+     xy->y = SCM_REALPART(z2);}
+# endif
+  }
+}
+
+
+
+
+SCM_PROC(s_sys_expt, "%expt", 2, 0, 0, scm_sys_expt);
+#ifdef __STDC__
+SCM
+scm_sys_expt(SCM z1, SCM z2)
+#else
+SCM
+scm_sys_expt(z1, z2)
+     SCM z1;
+     SCM z2;
+#endif
+{
+  struct dpair xy;
+  scm_two_doubles(z1, z2, s_sys_expt, &xy);
+  return scm_makdbl(pow(xy.x, xy.y), 0.0);
+}
+
+
+
+SCM_PROC(s_sys_atan2, "%atan2", 2, 0, 0, scm_sys_atan2);
+#ifdef __STDC__
+SCM
+scm_sys_atan2(SCM z1, SCM z2)
+#else
+SCM
+scm_sys_atan2(z1, z2)
+     SCM z1;
+     SCM z2;
+#endif
+{
+  struct dpair xy;
+  scm_two_doubles(z1, z2, s_sys_atan2, &xy);
+  return scm_makdbl(atan2(xy.x, xy.y), 0.0);
+}
+
+
+
+SCM_PROC(s_make_rectangular, "make-rectangular", 2, 0, 0, scm_make_rectangular);
+#ifdef __STDC__
+SCM
+scm_make_rectangular(SCM z1, SCM z2)
+#else
+SCM
+scm_make_rectangular(z1, z2)
+     SCM z1;
+     SCM z2;
+#endif
+{
+  struct dpair xy;
+  scm_two_doubles(z1, z2, s_make_rectangular, &xy);
+  return scm_makdbl(xy.x, xy.y);
+}
+
+
+
+SCM_PROC(s_make_polar, "make-polar", 2, 0, 0, scm_make_polar);
+#ifdef __STDC__
+SCM
+scm_make_polar(SCM z1, SCM z2)
+#else
+SCM
+scm_make_polar(z1, z2)
+     SCM z1;
+     SCM z2;
+#endif
+{
+  struct dpair xy;
+  scm_two_doubles(z1, z2, s_make_polar, &xy);
+  return scm_makdbl(xy.x*cos(xy.y), xy.x*sin(xy.y));
+}
+
+
+
+
+SCM_PROC(s_real_part, "real-part", 1, 0, 0, scm_real_part);
+#ifdef __STDC__
+SCM
+scm_real_part(SCM z)
+#else
+SCM
+scm_real_part(z)
+     SCM z;
+#endif
+{
+  if SCM_NINUMP(z) {
+# ifdef SCM_BIGDIG
+    SCM_ASRTGO(SCM_NIMP(z), badz);
+    if SCM_BIGP(z) return z;
+#  ifndef RECKLESS
+    if (!(SCM_INEXP(z)))
+    badz: scm_wta(z, (char *)SCM_ARG1, s_real_part);
+#  endif
+# else
+    SCM_ASSERT(SCM_NIMP(z) && SCM_INEXP(z), z, SCM_ARG1, s_real_part);
+# endif
+    if SCM_CPLXP(z) return scm_makdbl(SCM_REAL(z), 0.0);
+  }
+  return z;
+}
+
+
+
+SCM_PROC(s_imag_part, "imag-part", 1, 0, 0, scm_imag_part);
+#ifdef __STDC__
+SCM
+scm_imag_part(SCM z)
+#else
+SCM
+scm_imag_part(z)
+     SCM z;
+#endif
+{
+  if SCM_INUMP(z) return SCM_INUM0;
+# ifdef SCM_BIGDIG
+  SCM_ASRTGO(SCM_NIMP(z), badz);
+  if SCM_BIGP(z) return SCM_INUM0;
+#  ifndef RECKLESS
+  if (!(SCM_INEXP(z)))
+  badz: scm_wta(z, (char *)SCM_ARG1, s_imag_part);
+#  endif
+# else
+  SCM_ASSERT(SCM_NIMP(z) && SCM_INEXP(z), z, SCM_ARG1, s_imag_part);
+# endif
+  if SCM_CPLXP(z) return scm_makdbl(SCM_IMAG(z), 0.0);
+  return scm_flo0;
+}
+
+
+
+SCM_PROC(s_magnitude, "magnitude", 1, 0, 0, scm_magnitude);
+#ifdef __STDC__
+SCM
+scm_magnitude(SCM z)
+#else
+SCM
+scm_magnitude(z)
+     SCM z;
+#endif
+{
+  if SCM_INUMP(z) return scm_abs(z);
+# ifdef SCM_BIGDIG
+  SCM_ASRTGO(SCM_NIMP(z), badz);
+  if SCM_BIGP(z) return scm_abs(z);
+#  ifndef RECKLESS
+  if (!(SCM_INEXP(z)))
+  badz: scm_wta(z, (char *)SCM_ARG1, s_magnitude);
+#  endif
+# else
+  SCM_ASSERT(SCM_NIMP(z) && SCM_INEXP(z), z, SCM_ARG1, s_magnitude);
+# endif
+  if SCM_CPLXP(z)
+    {
+      double i = SCM_IMAG(z), r = SCM_REAL(z);
+      return scm_makdbl(sqrt(i*i+r*r), 0.0);
+    }
+  return scm_makdbl(fabs(SCM_REALPART(z)), 0.0);
+}
+
+
+
+
+SCM_PROC(s_angle, "angle", 1, 0, 0, scm_angle);
+#ifdef __STDC__
+SCM
+scm_angle(SCM z)
+#else
+SCM
+scm_angle(z)
+     SCM z;
+#endif
+{
+  double x, y = 0.0;
+  if SCM_INUMP(z) {x = (z>=SCM_INUM0) ? 1.0 : -1.0; goto do_angle;}
+# ifdef SCM_BIGDIG
+  SCM_ASRTGO(SCM_NIMP(z), badz);
+  if SCM_BIGP(z) {x = (SCM_TYP16(z)==scm_tc16_bigpos) ? 1.0 : -1.0; goto do_angle;}
+#  ifndef RECKLESS
+  if (!(SCM_INEXP(z))) {
+  badz: scm_wta(z, (char *)SCM_ARG1, s_angle);}
+#  endif
+# else
+  SCM_ASSERT(SCM_NIMP(z) && SCM_INEXP(z), z, SCM_ARG1, s_angle);
+# endif
+  if (SCM_REALP(z))
+    {
+      x = SCM_REALPART(z);
+      goto do_angle;
+    }
+  x = SCM_REAL(z); y = SCM_IMAG(z);
+ do_angle:
+  return scm_makdbl(atan2(y, x), 0.0);
+}
+
+
+SCM_PROC(s_inexact_to_exact, "inexact->exact", 1, 0, 0, scm_inexact_to_exact);
+#ifdef __STDC__
+SCM
+scm_inexact_to_exact(SCM z)
+#else
+SCM
+scm_inexact_to_exact(z)
+     SCM z;
+#endif
+{
+  if SCM_INUMP(z) return z;
+# ifdef SCM_BIGDIG
+  SCM_ASRTGO(SCM_NIMP(z), badz);
+  if SCM_BIGP(z) return z;
+#  ifndef RECKLESS
+  if (!(SCM_REALP(z)))
+  badz: scm_wta(z, (char *)SCM_ARG1, s_inexact_to_exact);
+#  endif
+# else
+  SCM_ASSERT(SCM_NIMP(z) && SCM_REALP(z), z, SCM_ARG1, s_inexact_to_exact);
+# endif
+# ifdef SCM_BIGDIG
+  {
+    double u = floor(SCM_REALPART(z)+0.5);
+    if ((u <= SCM_MOST_POSITIVE_FIXNUM) && (-u <= -SCM_MOST_NEGATIVE_FIXNUM)) {
+      /* Negation is a workaround for HP700 cc bug */
+      SCM ans = SCM_MAKINUM((long)u);
+      if (SCM_INUM(ans)==(long)u) return ans;
+    }
+    SCM_ASRTGO(!IS_INF(u), badz);	/* problem? */
+    return scm_dbl2big(u);
+  }
+# else
+  return SCM_MAKINUM((long)floor(SCM_REALPART(z)+0.5));
+# endif
+}
+
+
+
+#else				/* ~SCM_FLOATS */
+SCM_PROC(s_trunc, "truncate", 1, 0, 0, scm_trunc);
+#ifdef __STDC__
+SCM
+scm_trunc(SCM x)
+#else
+SCM
+scm_trunc(x)
+     SCM x;
+#endif
+{
+  SCM_ASSERT(SCM_INUMP(x), x, SCM_ARG1, s_truncate);
+  return x;
+}
+
+
+
+#endif				/* SCM_FLOATS */
+
+#ifdef SCM_BIGDIG
+# ifdef SCM_FLOATS
+/* d must be integer */
+#ifdef __STDC__
+SCM
+scm_dbl2big(double d)
+#else
+SCM
+scm_dbl2big(d)
+     double d;
+#endif
+{
+  scm_sizet i = 0;
+  long c;
+  SCM_BIGDIG *digits;
+  SCM ans;
+  double u = (d < 0)?-d:d;
+  while (0 != floor(u)) {u /= SCM_BIGRAD;i++;}
+  ans = scm_mkbig(i, d < 0);
+  digits = SCM_BDIGITS(ans);
+  while (i--) {
+    u *= SCM_BIGRAD;
+    c = floor(u);
+    u -= c;
+    digits[i] = c;
+  }
+  SCM_ASSERT(0==u, SCM_INUM0, SCM_OVSCM_FLOW, "dbl2big");
+  return ans;
+}
+
+
+
+#ifdef __STDC__
+double
+scm_big2dbl(SCM b)
+#else
+double
+scm_big2dbl(b)
+     SCM b;
+#endif
+{
+  double ans = 0.0;
+  scm_sizet i = SCM_NUMDIGS(b);
+  SCM_BIGDIG *digits = SCM_BDIGITS(b);
+  while (i--) ans = digits[i] + SCM_BIGRAD*ans;
+  if (scm_tc16_bigneg==SCM_TYP16(b)) return -ans;
+  return ans;
+}
+# endif
+#endif
+
+#ifdef __STDC__
+SCM
+scm_long2num(long sl)
+#else
+SCM
+scm_long2num(sl)
+     long sl;
+#endif
+{
+  if (!SCM_FIXABLE(sl)) {
+#ifdef SCM_BIGDIG
+    return scm_long2big(sl);
+#else
+# ifdef SCM_FLOATS
+    return scm_makdbl((double) sl, 0.0);
+# else
+    return SCM_BOOL_F;
+# endif
+#endif
+  }
+  return SCM_MAKINUM(sl);
+}
+
+
+#ifdef LONGLONGS
+#ifdef __STDC__
+SCM
+scm_long_long2num(long_long sl)
+#else
+SCM
+scm_long_long2num(sl)
+     long_long sl;
+#endif
+{
+  if (!SCM_FIXABLE(sl)) {
+#ifdef SCM_BIGDIG
+    return scm_long_long2big(sl);
+#else
+# ifdef SCM_FLOATS
+    return scm_makdbl((double) sl, 0.0);
+# else
+    return SCM_BOOL_F;
+# endif
+#endif
+  }
+  return SCM_MAKINUM(sl);
+}
+#endif
+
+
+#ifdef __STDC__
+SCM
+scm_ulong2num(unsigned long sl)
+#else
+SCM
+scm_ulong2num(sl)
+     unsigned long sl;
+#endif
+{
+  if (!SCM_POSSCM_FIXABLE(sl)) {
+#ifdef SCM_BIGDIG
+    return scm_ulong2big(sl);
+#else
+# ifdef SCM_FLOATS
+    return scm_makdbl((double) sl, 0.0);
+# else
+    return SCM_BOOL_F;
+# endif
+#endif
+  }
+  return SCM_MAKINUM(sl);
+}
+
+#ifdef __STDC__
+long
+scm_num2long(SCM num, char *pos, char *s_caller)
+#else
+long
+scm_num2long(num, pos, s_caller)
+     SCM num;
+     char *pos;
+     char *s_caller;
+#endif
+{
+  long res;
+  if (SCM_INUMP(num))
+    {
+      res = SCM_INUM(num);
+      return res;
+    }
+  SCM_ASRTGO(SCM_NIMP(num), errout);
+#ifdef SCM_FLOATS
+  if (SCM_REALP(num))
+    {
+      double u = SCM_REALPART(num);
+      res = u;
+      if ((double)res == u)
+	{
+	  return res;
+	}
+    }
+#endif
+#ifdef SCM_BIGDIG
+  if (SCM_BIGP(num)) {
+    long oldres;
+    scm_sizet l;
+    res = 0;
+    oldres = 0;
+    for(l = SCM_NUMDIGS(num);l--;)
+      {
+	res = SCM_BIGUP(res) + SCM_BDIGITS(num)[l];
+	if (res < oldres)
+	  goto errout;
+	oldres = res;
+      }
+    if (SCM_TYP16 (num) == scm_tc16_bigpos)
+      return res;
+    else
+      return -res;
+  }
+#endif
+ errout: scm_wta(num, pos, s_caller);
+  return SCM_UNSPECIFIED;
+}
+
+
+
+
+#ifdef __STDC__
+long
+num2long(SCM num, char *pos, char *s_caller)
+#else
+long
+num2long(num, pos, s_caller)
+     SCM num;
+     char *pos;
+     char *s_caller;
+#endif
+{
+  long res;
+  if SCM_INUMP(num) {
+    res = SCM_INUM((long)num);
+    return res;
+  }
+  SCM_ASRTGO(SCM_NIMP(num), errout);
+#ifdef SCM_FLOATS
+  if SCM_REALP(num) {
+    double u = SCM_REALPART(num);
+    if (((SCM_MOST_NEGATIVE_FIXNUM * 4) <= u)
+	&& (u <= (SCM_MOST_POSITIVE_FIXNUM * 4 + 3))) {
+      res = u;
+      return res;
+    }
+  }
+#endif
+#ifdef SCM_BIGDIG
+  if SCM_BIGP(num) {
+    scm_sizet l = SCM_NUMDIGS(num);
+    SCM_ASRTGO(SCM_DIGSPERLONG >= l, errout);
+    res = 0;
+    for(;l--;) res = SCM_BIGUP(res) + SCM_BDIGITS(num)[l];
+    return res;
+  }
+#endif
+ errout: scm_wta(num, pos, s_caller);
+  return SCM_UNSPECIFIED;
+}
+
+
+#ifdef LONGLONGS
+#ifdef __STDC__
+long_long
+scm_num2long_long(SCM num, char *pos, char *s_caller)
+#else
+long_long
+scm_num2long_long(num, pos, s_caller)
+     SCM num;
+     char *pos;
+     char *s_caller;
+#endif
+{
+  long_long res;
+  if SCM_INUMP(num) {
+    res = SCM_INUM((long_long)num);
+    return res;
+  }
+  SCM_ASRTGO(SCM_NIMP(num), errout);
+#ifdef SCM_FLOATS
+  if SCM_REALP(num) {
+    double u = SCM_REALPART(num);
+    if (((SCM_MOST_NEGATIVE_FIXNUM * 4) <= u)
+	&& (u <= (SCM_MOST_POSITIVE_FIXNUM * 4 + 3))) {
+      res = u;
+      return res;
+    }
+  }
+#endif
+#ifdef SCM_BIGDIG
+  if SCM_BIGP(num) {
+    scm_sizet l = SCM_NUMDIGS(num);
+    SCM_ASRTGO(SCM_DIGSPERLONGLONG >= l, errout);
+    res = 0;
+    for(;l--;) res = SCM_LONGLONGSCM_BIGUP(res) + SCM_BDIGITS(num)[l];
+    return res;
+  }
+#endif
+ errout: scm_wta(num, pos, s_caller);
+  return SCM_UNSPECIFIED;
+}
+#endif
+
+
+#ifdef __STDC__
+unsigned long
+scm_num2ulong(SCM num, char *pos, char *s_caller)
+#else
+unsigned long
+scm_num2ulong(num, pos, s_caller)
+     SCM num;
+     char *pos;
+     char *s_caller;
+#endif
+{
+  unsigned long res;
+  if (SCM_INUMP(num))
+    {
+      res = SCM_INUM((unsigned long)num);
+      return res;
+    }
+  SCM_ASRTGO(SCM_NIMP(num), errout);
+#ifdef SCM_FLOATS
+  if (SCM_REALP(num))
+    {
+      double u = SCM_REALPART(num);
+      if ((0 <= u) && (u <= (unsigned long)~0L))
+	{
+	  res = u;
+	  return res;
+	}
+    }
+#endif
+#ifdef SCM_BIGDIG
+  if (SCM_BIGP(num)) {
+    unsigned long oldres;
+    scm_sizet l;
+    res = 0;
+    oldres = 0;
+    for(l = SCM_NUMDIGS(num);l--;)
+      {
+	res = SCM_BIGUP(res) + SCM_BDIGITS(num)[l];
+	if (res < oldres)
+	  goto errout;
+	oldres = res;
+      }
+    return res;
+  }
+#endif
+ errout: scm_wta(num, pos, s_caller);
+  return SCM_UNSPECIFIED;
+}
+
+
+#ifdef SCM_FLOATS
+# ifndef DBL_DIG
+static void add1(f, fsum)
+     double f, *fsum;
+{
+  *fsum = f + 1.0;
+}
+# endif
+#endif
+
+
+#ifdef __STDC__
+void
+scm_init_numbers (void)
+#else
+void
+scm_init_numbers ()
+#endif
+{
+#ifdef SCM_FLOATS
+  SCM_NEWCELL(scm_flo0);
+# ifdef SCM_SINGLES
+  SCM_CAR(scm_flo0) = scm_tc_flo;
+  SCM_FLO(scm_flo0) = 0.0;
+# else
+  SCM_CDR(scm_flo0) = (SCM)scm_must_malloc(1L*sizeof(double), "real");
+  SCM_REAL(scm_flo0) = 0.0;
+  SCM_CAR(scm_flo0) = scm_tc_dblr;
+# endif
+# ifdef DBL_DIG
+  scm_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 (++scm_dblprec > 20) break;
+      add1(f, &fsum);
+    }
+    scm_dblprec = scm_dblprec-1;
+  }
+# endif /* DBL_DIG */
+#endif
+#include "numbers.x"
+}
+
diff --git a/libguile/numbers.h b/libguile/numbers.h
new file mode 100644
index 000000000..abd1e7a24
--- /dev/null
+++ b/libguile/numbers.h
@@ -0,0 +1,436 @@
+/* classes: h_files */
+
+#ifndef NUMBERSH
+#define NUMBERSH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+
+
+
+
+/* Immediate Numbers 
+ *
+ * Inums are exact integer data that fits within an SCM word.
+ *
+ * SCM_INUMP applies only to values known to be Scheme objects.
+ * In particular, SCM_INUMP (SCM_CAR (x)) is valid only if x is known
+ * to be a SCM_CONSP.  If x is only known to be a SCM_NIMP, 
+ * SCM_INUMP (SCM_CAR (x)) can give wrong answers.
+ */
+
+#define SCM_INUMP(x)	(2 & (int)(x))
+#define SCM_NINUMP(x) 	(!SCM_INUMP(x))
+
+#ifdef __TURBOC__
+/* shifts of more than one are done by a library call, single shifts are
+ * performed in registers
+ */
+# define SCM_MAKINUM(x) ((((x)<<1)<<1)+2L)
+#else
+# define SCM_MAKINUM(x) (((x)<<2)+2L)
+#endif /* def __TURBOC__ */
+
+
+/* SCM_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 SCM_SRS(x, y) ((x)>>y)
+# ifdef __TURBOC__
+#  define SCM_INUM(x) (((x)>>1)>>1)
+# else
+#  define SCM_INUM(x) SCM_SRS(x, 2)
+# endif /* def __TURBOC__ */
+#else
+# define SCM_SRS(x, y) (((x)<0) ? ~((~(x))>>y) : (x)>>y)
+# define SCM_INUM(x) SCM_SRS(x, 2)
+#endif /*  (-1==(((-1)<<2)+2)>>2) && (__TURBOC__ != 0x295) */
+
+
+/* A name for 0.
+ */
+#define SCM_INUM0 ((SCM) 2)
+
+
+
+/* SCM_FIXABLE is non-0 if its long argument can be encoded in an SCM_INUM.
+ */
+#define SCM_POSSCM_FIXABLE(n) ((n) <= SCM_MOST_POSITIVE_FIXNUM)
+#define SCM_NEGSCM_FIXABLE(n) ((n) >= SCM_MOST_NEGATIVE_FIXNUM)
+#define SCM_UNEGSCM_FIXABLE(n) ((n) <= -SCM_MOST_NEGATIVE_FIXNUM)
+#define SCM_FIXABLE(n) (SCM_POSSCM_FIXABLE(n) && SCM_NEGSCM_FIXABLE(n))
+
+/* SCM_INTBUFLEN is the maximum number of characters neccessary for the
+ * printed or scm_string representation of an exact immediate.
+ */
+
+#ifndef SCM_CHAR_BIT
+# define SCM_CHAR_BIT 8
+#endif /* ndef SCM_CHAR_BIT */
+#ifndef SCM_LONG_BIT
+# define SCM_LONG_BIT (SCM_CHAR_BIT*sizeof(long)/sizeof(char))
+#endif /* ndef SCM_LONG_BIT */
+#define SCM_INTBUFLEN (5+SCM_LONG_BIT)
+
+/* SCM_FLOBUFLEN is the maximum number of characters neccessary for the
+ * printed or scm_string representation of an inexact number.
+ */
+
+#define SCM_FLOBUFLEN (10+2*(sizeof(double)/sizeof(char)*SCM_CHAR_BIT*3+9)/10)
+
+
+
+
+/* Numbers 
+ */
+
+#define SCM_INEXP(x) (SCM_TYP16(x)==scm_tc16_flo)
+#define SCM_CPLXP(x) (SCM_CAR(x)==scm_tc_dblc)
+#define SCM_REAL(x) (*(((scm_dbl *) (SCM2PTR(x)))->real))
+#define SCM_IMAG(x) (*((double *)(SCM_CHARS(x)+sizeof(double))))
+/* ((&SCM_REAL(x))[1]) */
+
+
+#ifdef SCM_SINGLES
+#define SCM_REALP(x) ((~SCM_REAL_PART & SCM_CAR(x))==scm_tc_flo)
+#define SCM_SINGP(x) (SCM_CAR(x)==scm_tc_flo)
+#define SCM_FLO(x) (((scm_flo *)(SCM2PTR(x)))->num)
+#define SCM_REALPART(x) (SCM_SINGP(x)?0.0+SCM_FLO(x):SCM_REAL(x))
+#else /* SCM_SINGLES */
+#define SCM_REALP(x) (SCM_CAR(x)==scm_tc_dblr)
+#define SCM_REALPART SCM_REAL
+#endif /* SCM_SINGLES */
+
+
+/* Define SCM_BIGDIG to an integer type whose size is smaller than long if
+ * you want bignums.  SCM_BIGRAD is one greater than the biggest SCM_BIGDIG. 
+ *
+ * Define SCM_DIGSTOOBIG if the digits equivalent to a long won't fit in a long. 
+ */
+#ifdef BIGNUMS
+# ifdef _UNICOS
+#  define SCM_DIGSTOOBIG
+#  if (1L << 31) <= SCM_USHRT_MAX
+#   define SCM_BIGDIG unsigned  short
+#  else
+#   define SCM_BIGDIG unsigned int
+#  endif /*  (1L << 31) <= USHRT_MAX */
+#  define SCM_BITSPERDIG 32
+# else
+#  define SCM_BIGDIG unsigned short
+#  define SCM_BITSPERDIG (sizeof(SCM_BIGDIG)*SCM_CHAR_BIT)
+# endif /* def _UNICOS */
+
+# define SCM_BIGRAD (1L << SCM_BITSPERDIG)
+# define SCM_DIGSPERLONG ((scm_sizet)((sizeof(long)*SCM_CHAR_BIT+SCM_BITSPERDIG-1)/SCM_BITSPERDIG))
+# define SCM_DIGSPERLONGLONG ((scm_sizet)((sizeof(long long)*SCM_CHAR_BIT+SCM_BITSPERDIG-1)/SCM_BITSPERDIG))
+# define SCM_BIGUP(x) ((unsigned long)(x) << SCM_BITSPERDIG)
+# define SCM_LONGLONGSCM_BIGUP(x) ((ulong_long)(x) << SCM_BITSPERDIG)
+# define SCM_BIGDN(x) ((x) >> SCM_BITSPERDIG)
+# define SCM_BIGLO(x) ((x) & (SCM_BIGRAD-1))
+#endif /* def BIGNUMS */
+
+#ifndef SCM_BIGDIG
+/* Definition is not really used but helps various function
+ * prototypes to compile with conditionalization.
+ */
+# define SCM_BIGDIG unsigned short
+# define NO_SCM_BIGDIG
+# ifndef SCM_FLOATS
+#  define SCM_INUMS_ONLY
+# endif /* ndef SCM_FLOATS */
+#endif /* ndef SCM_BIGDIG */
+
+#ifdef SCM_FLOATS
+#define SCM_NUMBERP(x) (SCM_INUMP(x) || (SCM_NIMP(x) && SCM_NUMP(x)))
+#else
+#ifdef SCM_BIGDIG
+#define SCM_NUMBERP(x) (SCM_INUMP(x) || (SCM_NIMP(x) && SCM_NUMP(x)))
+#else
+#define SCM_NUMBERP SCM_INUMP
+#endif
+#endif
+#define SCM_NUMP(x) ((0xfcff & (int)SCM_CAR(x))==scm_tc7_smob)
+#define SCM_BIGP(x) (SCM_TYP16S(x)==scm_tc16_bigpos)
+#define SCM_BIGSIGN(x) (0x0100 & (int)SCM_CAR(x))
+#define SCM_BDIGITS(x) ((SCM_BIGDIG *)(SCM_CDR(x)))
+#define SCM_NUMDIGS(x) ((scm_sizet)(SCM_CAR(x)>>16))
+#define SCM_SETNUMDIGS(x, v, t) SCM_CAR(x) = (((v)+0L)<<16)+(t)
+
+
+#ifdef SCM_FLOATS
+typedef struct scm_dblproc
+{
+  char *scm_string;
+  double (*cproc) ();
+} scm_dblproc;
+
+#ifdef SCM_SINGLES
+typedef struct scm_flo
+{
+  SCM type;
+  float num;
+} scm_flo;
+#endif
+
+typedef struct scm_dbl
+{
+  SCM type;
+  double *real;
+} scm_dbl;
+#endif
+
+
+
+
+#ifdef __STDC__
+extern SCM scm_exact_p(SCM x);
+extern SCM scm_odd_p(SCM n);
+extern SCM scm_even_p(SCM n);
+extern SCM scm_abs(SCM x);
+extern SCM scm_quotient(SCM x, SCM y);
+extern SCM scm_remainder(SCM x, SCM y);
+extern SCM scm_modulo(SCM x, SCM y);
+extern SCM scm_gcd(SCM x, SCM y);
+extern SCM scm_lcm(SCM n1, SCM n2);
+extern SCM scm_logand(SCM n1, SCM n2);
+extern SCM scm_logior(SCM n1, SCM n2);
+extern SCM scm_logxor(SCM n1, SCM n2);
+extern SCM scm_logtest(SCM n1, SCM n2);
+extern SCM scm_logbit_p(SCM n1, SCM n2);
+extern SCM scm_logand(SCM n1, SCM n2);
+extern SCM scm_logior(SCM n1, SCM n2);
+extern SCM scm_logxor(SCM n1, SCM n2);
+extern SCM scm_logtest(SCM n1, SCM n2);
+extern SCM scm_logbit_p(SCM n1, SCM n2);
+extern SCM scm_lognot(SCM n);
+extern SCM scm_integer_expt(SCM z1, SCM z2);
+extern SCM scm_ash(SCM n, SCM cnt);
+extern SCM scm_bit_extract(SCM n, SCM start, SCM end);
+extern SCM scm_logcount (SCM n);
+extern SCM scm_integer_length(SCM n);
+extern SCM scm_mkbig(scm_sizet nlen, int sign);
+extern SCM scm_big2inum(SCM b, scm_sizet l);
+extern SCM scm_adjbig(SCM b, scm_sizet nlen);
+extern SCM scm_normbig(SCM b);
+extern SCM scm_copybig(SCM b, int sign);
+extern SCM scm_long2big(long n);
+extern SCM scm_long_long2big(long_long n);
+extern SCM scm_2ulong2big(unsigned long * np);
+extern SCM scm_ulong2big(unsigned long n);
+extern int scm_bigcomp(SCM x, SCM y);
+extern long scm_pseudolong(long x);
+extern void scm_longdigs(long x, SCM_BIGDIG digs[]);
+extern SCM scm_addbig(SCM_BIGDIG *x, scm_sizet nx, int xsgn, SCM bigy, int sgny);
+extern SCM scm_mulbig(SCM_BIGDIG *x, scm_sizet nx, SCM_BIGDIG *y, scm_sizet ny, int sgn);
+extern unsigned int scm_divbigdig(SCM_BIGDIG *ds, scm_sizet h, SCM_BIGDIG div);
+extern SCM scm_divbigint(SCM x, long z, int sgn, int mode);
+extern SCM scm_divbigbig(SCM_BIGDIG *x, scm_sizet nx, SCM_BIGDIG *y, scm_sizet ny, int sgn, int modes);
+extern scm_sizet scm_iint2str(long num, int rad, char *p);
+extern SCM scm_number_to_string(SCM x, SCM radix);
+extern int scm_floprint(SCM sexp, SCM port, int writing);
+extern int scm_bigprint(SCM exp, SCM port, int writing);
+extern SCM scm_istr2int(char *str, long len, long radix);
+extern SCM scm_istr2int(char *str, long len, long radix);
+extern SCM scm_istr2flo(char *str, long len, long radix);
+extern SCM scm_istring2number(char *str, long len, long radix);
+extern SCM scm_string_to_number(SCM str, SCM radix);
+extern SCM scm_makdbl (double x, double y);
+extern SCM scm_bigequal(SCM x, SCM y);
+extern SCM scm_floequal(SCM x, SCM y);
+extern SCM scm_number_p(SCM x);
+extern SCM scm_real_p(SCM x);
+extern SCM scm_int_p(SCM x);
+extern SCM scm_inexact_p(SCM x);
+extern SCM scm_num_eq_p (SCM x, SCM y);
+extern SCM scm_less_p(SCM x, SCM y);
+extern SCM scm_gr_p(SCM x, SCM y);
+extern SCM scm_leq_p(SCM x, SCM y);
+extern SCM scm_geq_p(SCM x, SCM y);
+extern SCM scm_zero_p(SCM z);
+extern SCM scm_positive_p(SCM x);
+extern SCM scm_negative_p(SCM x);
+extern SCM scm_max(SCM x, SCM y);
+extern SCM scm_min(SCM x, SCM y);
+extern SCM scm_sum(SCM x, SCM y);
+extern SCM scm_difference(SCM x, SCM y);
+extern SCM scm_product(SCM x, SCM y);
+extern double scm_num2dbl (SCM a, char * why);
+extern SCM scm_fuck (SCM a);
+extern SCM scm_divide(SCM x, SCM y);
+extern double scm_asinh(double x);
+extern double scm_acosh(double x);
+extern double scm_atanh(double x);
+extern double scm_truncate(double x);
+extern double scm_round(double x);
+extern double scm_exact_to_inexact(double z);
+extern SCM scm_sys_expt(SCM z1, SCM z2);
+extern SCM scm_sys_atan2(SCM z1, SCM z2);
+extern SCM scm_make_rectangular(SCM z1, SCM z2);
+extern SCM scm_make_polar(SCM z1, SCM z2);
+extern SCM scm_real_part(SCM z);
+extern SCM scm_imag_part(SCM z);
+extern SCM scm_magnitude(SCM z);
+extern SCM scm_angle(SCM z);
+extern SCM scm_inexact_to_exact(SCM z);
+extern SCM scm_trunc(SCM x);
+extern SCM scm_dbl2big(double d);
+extern double scm_big2dbl(SCM b);
+extern SCM scm_long2num(long sl);
+extern SCM scm_long_long2num(long_long sl);
+extern SCM scm_ulong2num(unsigned long sl);
+extern long scm_num2long(SCM num, char *pos, char *s_caller);
+extern long num2long(SCM num, char *pos, char *s_caller);
+extern long_long scm_num2long_long(SCM num, char *pos, char *s_caller);
+extern unsigned long scm_num2ulong(SCM num, char *pos, char *s_caller);
+extern void scm_init_numbers (void);
+
+#else /* STDC */
+extern SCM scm_exact_p();
+extern SCM scm_odd_p();
+extern SCM scm_even_p();
+extern SCM scm_abs();
+extern SCM scm_quotient();
+extern SCM scm_remainder();
+extern SCM scm_modulo();
+extern SCM scm_gcd();
+extern SCM scm_lcm();
+extern SCM scm_logand();
+extern SCM scm_logior();
+extern SCM scm_logxor();
+extern SCM scm_logtest();
+extern SCM scm_logbit_p();
+extern SCM scm_logand();
+extern SCM scm_logior();
+extern SCM scm_logxor();
+extern SCM scm_logtest();
+extern SCM scm_logbit_p();
+extern SCM scm_lognot();
+extern SCM scm_integer_expt();
+extern SCM scm_ash();
+extern SCM scm_bit_extract();
+extern SCM scm_logcount ();
+extern SCM scm_integer_length();
+extern SCM scm_mkbig();
+extern SCM scm_big2inum();
+extern SCM scm_adjbig();
+extern SCM scm_normbig();
+extern SCM scm_copybig();
+extern SCM scm_long2big();
+extern SCM scm_long_long2big();
+extern SCM scm_2ulong2big();
+extern SCM scm_ulong2big();
+extern int scm_bigcomp();
+extern long scm_pseudolong();
+extern void scm_longdigs();
+extern SCM scm_addbig();
+extern SCM scm_mulbig();
+extern unsigned int scm_divbigdig();
+extern SCM scm_divbigint();
+extern SCM scm_divbigbig();
+extern scm_sizet scm_iint2str();
+extern SCM scm_number_to_string();
+extern int scm_floprint();
+extern int scm_bigprint();
+extern SCM scm_istr2int();
+extern SCM scm_istr2int();
+extern SCM scm_istr2flo();
+extern SCM scm_istring2number();
+extern SCM scm_string_to_number();
+extern SCM scm_makdbl ();
+extern SCM scm_bigequal();
+extern SCM scm_floequal();
+extern SCM scm_number_p();
+extern SCM scm_real_p();
+extern SCM scm_int_p();
+extern SCM scm_inexact_p();
+extern SCM scm_num_eq_p ();
+extern SCM scm_less_p();
+extern SCM scm_gr_p();
+extern SCM scm_leq_p();
+extern SCM scm_geq_p();
+extern SCM scm_zero_p();
+extern SCM scm_positive_p();
+extern SCM scm_negative_p();
+extern SCM scm_max();
+extern SCM scm_min();
+extern SCM scm_sum();
+extern SCM scm_difference();
+extern SCM scm_product();
+extern double scm_num2dbl ();
+extern SCM scm_fuck ();
+extern SCM scm_divide();
+extern double scm_asinh();
+extern double scm_acosh();
+extern double scm_atanh();
+extern double scm_truncate();
+extern double scm_round();
+extern double scm_exact_to_inexact();
+extern SCM scm_sys_expt();
+extern SCM scm_sys_atan2();
+extern SCM scm_make_rectangular();
+extern SCM scm_make_polar();
+extern SCM scm_real_part();
+extern SCM scm_imag_part();
+extern SCM scm_magnitude();
+extern SCM scm_angle();
+extern SCM scm_inexact_to_exact();
+extern SCM scm_trunc();
+extern SCM scm_dbl2big();
+extern double scm_big2dbl();
+extern SCM scm_long2num();
+extern SCM scm_long_long2num();
+extern SCM scm_ulong2num();
+extern long scm_num2long();
+extern long num2long();
+extern long_long scm_num2long_long();
+extern unsigned long scm_num2ulong();
+extern void scm_init_numbers ();
+
+#endif /* STDC */
+
+
+
+#endif  /* NUMBERSH */
diff --git a/libguile/objprop.c b/libguile/objprop.c
new file mode 100644
index 000000000..e97b591ce
--- /dev/null
+++ b/libguile/objprop.c
@@ -0,0 +1,137 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+
+/* {Object Properties}
+ */
+
+SCM_PROC(s_object_properties, "object-properties", 1, 0, 0, scm_object_properties);
+#ifdef __STDC__
+SCM
+scm_object_properties (SCM obj)
+#else
+SCM
+scm_object_properties (obj)
+     SCM obj;
+#endif
+{
+  return scm_hashq_create_handle_x (scm_object_whash, obj, SCM_EOL);
+}
+
+
+SCM_PROC(s_set_object_properties_x, "set-object-properties!", 2, 0, 0, scm_set_object_properties_x);
+#ifdef __STDC__
+SCM
+scm_set_object_properties_x (SCM obj, SCM plist)
+#else
+SCM
+scm_set_object_properties_x (obj, plist)
+     SCM obj;
+     SCM plist;
+#endif
+{
+  SCM handle;
+  scm_hashq_create_handle_x (scm_object_whash, obj, plist);
+  SCM_SETCDR (handle, plist);
+  return plist;
+}
+
+SCM_PROC(s_object_property, "object-property", 2, 0, 0, scm_object_property);
+#ifdef __STDC__
+SCM
+scm_object_property (SCM obj, SCM key)
+#else
+SCM
+scm_object_property (obj, key)
+     SCM obj;
+     SCM key;
+#endif
+{
+  SCM assoc;
+  assoc = scm_assq (key, SCM_CDR (scm_object_properties (obj)));
+  return (SCM_NIMP (assoc) ? SCM_CDR (assoc) : SCM_BOOL_F);
+}
+
+SCM_PROC(s_set_object_property_x, "set-object-property!", 3, 0, 0, scm_set_object_property_x);
+#ifdef __STDC__
+SCM
+scm_set_object_property_x (SCM obj, SCM key, SCM val)
+#else
+SCM
+scm_set_object_property_x (obj, key, val)
+     SCM obj;
+     SCM key;
+     SCM val;
+#endif
+{
+  SCM h;
+  SCM assoc;
+  h = scm_hashq_create_handle_x (scm_object_whash, obj, SCM_EOL);
+  SCM_DEFER_INTS;
+  assoc = scm_assoc (key, SCM_CDR (h));
+  if (SCM_NIMP (assoc))
+    SCM_SETCDR (assoc, val);
+  else
+    {
+      assoc = scm_acons (key, val, SCM_CDR (h));
+      SCM_SETCDR (h, assoc);
+    }
+  SCM_ALLOW_INTS;
+  return val;
+}
+
+#ifdef __STDC__
+void
+scm_init_objprop (void)
+#else
+void
+scm_init_objprop ()
+#endif
+{
+  scm_object_whash = scm_make_weak_hash_table (SCM_MAKINUM (511));
+#include "objprop.x"
+}
+
diff --git a/libguile/objprop.h b/libguile/objprop.h
new file mode 100644
index 000000000..af3771c22
--- /dev/null
+++ b/libguile/objprop.h
@@ -0,0 +1,73 @@
+/* classes: h_files */
+
+#ifndef OBJPROPH
+#define OBJPROPH
+/*	Copyright (C) 1995 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+
+
+
+
+#ifdef __STDC__
+extern SCM scm_object_properties (SCM obj);
+extern SCM scm_set_object_properties_x (SCM obj, SCM plist);
+extern SCM scm_object_property (SCM obj, SCM key);
+extern SCM scm_set_object_property_x (SCM obj, SCM key, SCM val);
+extern void scm_init_objprop (void);
+
+#else /* STDC */
+extern SCM scm_object_properties ();
+extern SCM scm_set_object_properties_x ();
+extern SCM scm_object_property ();
+extern SCM scm_set_object_property_x ();
+extern void scm_init_objprop ();
+
+#endif /* STDC */
+
+
+
+#endif  /* OBJPROPH */
diff --git a/libguile/pairs.c b/libguile/pairs.c
new file mode 100644
index 000000000..26cd3da1f
--- /dev/null
+++ b/libguile/pairs.c
@@ -0,0 +1,196 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+#include <stdio.h>
+#include "_scm.h"
+
+#ifdef __STDC__
+#include <stdarg.h>
+#define var_start(x, y) va_start(x, y)
+#else
+#include <varargs.h>
+#define var_start(x, y) va_start(x)
+#endif
+
+
+
+
+/* {Pairs}
+ */
+
+SCM_PROC(s_cons, "cons", 2, 0, 0, scm_cons);
+#ifdef __STDC__
+SCM 
+scm_cons (SCM x, SCM y)
+#else
+SCM 
+scm_cons (x, y)
+     SCM x;
+     SCM y;
+#endif
+{
+  register SCM z;
+  SCM_NEWCELL (z);
+  SCM_CAR (z) = x;
+  SCM_CDR (z) = y;
+  return z;
+}
+
+#ifdef __STDC__
+SCM 
+scm_cons2 (SCM w, SCM x, SCM y)
+#else
+SCM 
+scm_cons2 (w, x, y)
+     SCM w;
+     SCM x;
+     SCM y;
+#endif
+{
+  register SCM z;
+  SCM_NEWCELL (z);
+  SCM_CAR (z) = x;
+  SCM_CDR (z) = y;
+  x = z;
+  SCM_NEWCELL (z);
+  SCM_CAR (z) = w;
+  SCM_CDR (z) = x;
+  return z;
+}
+
+
+SCM_PROC(s_pair_p, "pair?", 1, 0, 0, scm_pair_p);
+#ifdef __STDC__
+SCM
+scm_pair_p(SCM x)
+#else
+SCM
+scm_pair_p(x)
+     SCM x;
+#endif
+{
+	if SCM_IMP(x) return SCM_BOOL_F;
+	return SCM_CONSP(x) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+SCM_PROC(s_set_car_x, "set-car!", 2, 0, 0, scm_set_car_x);
+#ifdef __STDC__
+SCM
+scm_set_car_x(SCM pair, SCM value)
+#else
+SCM
+scm_set_car_x(pair, value)
+     SCM pair;
+     SCM value;
+#endif
+{
+	SCM_ASSERT(SCM_NIMP(pair) && SCM_CONSP(pair), pair, SCM_ARG1, s_set_car_x);
+	SCM_CAR(pair) = value;
+	return value;
+}
+
+SCM_PROC(s_set_cdr_x, "set-cdr!", 2, 0, 0, scm_set_cdr_x);
+#ifdef __STDC__
+SCM
+scm_set_cdr_x(SCM pair, SCM value)
+#else
+SCM
+scm_set_cdr_x(pair, value)
+     SCM pair;
+     SCM value;
+#endif
+{
+	SCM_ASSERT(SCM_NIMP(pair) && SCM_CONSP(pair), pair, SCM_ARG1, s_set_cdr_x);
+	SCM_CDR(pair) = value;
+	return value;
+}
+
+
+
+
+static scm_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}
+};
+
+
+#ifdef __STDC__
+void
+scm_init_pairs (void)
+#else
+void
+scm_init_pairs ()
+#endif
+{
+  scm_init_iprocs(cxrs, scm_tc7_cxr);
+#include "pairs.x"
+}
+
diff --git a/libguile/pairs.h b/libguile/pairs.h
new file mode 100644
index 000000000..b27e9c908
--- /dev/null
+++ b/libguile/pairs.h
@@ -0,0 +1,170 @@
+/* classes: h_files */
+
+#ifndef PAIRSH
+#define PAIRSH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+
+
+
+typedef struct scm_cell
+{
+  SCM car;
+  SCM cdr;
+} scm_cell;
+
+/* SCM_PTR_LT defines how to compare two SCM_CELLPTRs (which may not be in the
+ * same scm_array).  SCM_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__)
+
+typedef scm_cell *SCM_CELLPTR;
+typedef SCM  *SCMPTR;
+
+# ifdef nosve
+#  define SCM_PTR_MASK 0xffffffffffff
+#  define SCM_PTR_LT(x, y) (((int)(x)&SCM_PTR_MASK) < ((int)(y)&SCM_PTR_MASK))
+# else
+#  define SCM_PTR_LT(x, y) ((x) < (y))
+# endif /* def nosve */
+
+#else /* defined(__TURBOC__) && !defined(__TOS__) */
+
+# ifdef PROT386
+typedef scm_cell *SCM_CELLPTR;
+typedef SCM *SCMPTR;
+#  define SCM_PTR_LT(x, y) (((long)(x)) < ((long)(y)))
+# else
+typedef scm_cell huge *SCM_CELLPTR;
+typedef SCM  huge *SCMPTR;
+#  define SCM_PTR_LT(x, y) ((x) < (y))
+# endif /* def PROT386 */
+
+#endif /*  defined(__TURBOC__) && !defined(__TOS__) */
+
+#define SCM_PTR_GT(x, y) SCM_PTR_LT(y, x)
+#define SCM_PTR_LE(x, y) (!SCM_PTR_GT(x, y))
+#define SCM_PTR_GE(x, y) (!SCM_PTR_LT(x, y))
+
+#define SCM_EOL 		SCM_BOOL_F
+#define SCM_NULLP(x) 		(SCM_EOL == (x))
+#define SCM_NNULLP(x) 		(SCM_EOL != (x))
+
+
+
+
+/* Cons Pairs
+ */
+
+#define SCM_CAR(x) (((scm_cell *)(SCM2PTR(x)))->car)
+#define SCM_CDR(x) (((scm_cell *)(SCM2PTR(x)))->cdr)
+#define SCM_GCCDR(x) (~1L & SCM_CDR(x))
+#define SCM_SETCDR(x, v) SCM_CDR(x) = (SCM)(v)
+#define SCM_SETCAR(x, v) SCM_CAR(x) = (SCM)(v)
+
+#define SCM_CAAR(OBJ)		SCM_CAR (SCM_CAR (OBJ))
+#define SCM_CDAR(OBJ)		SCM_CDR (SCM_CAR (OBJ))
+#define SCM_CADR(OBJ)		SCM_CAR (SCM_CDR (OBJ))
+#define SCM_CDDR(OBJ)		SCM_CDR (SCM_CDR (OBJ))
+
+#define SCM_CAAAR(OBJ)		SCM_CAR (SCM_CAR (SCM_CAR (OBJ)))
+#define SCM_CDAAR(OBJ)		SCM_CDR (SCM_CAR (SCM_CAR (OBJ)))
+#define SCM_CADAR(OBJ)		SCM_CAR (SCM_CDR (SCM_CAR (OBJ)))
+#define SCM_CDDAR(OBJ)		SCM_CDR (SCM_CDR (SCM_CAR (OBJ)))
+#define SCM_CAADR(OBJ)		SCM_CAR (SCM_CAR (SCM_CDR (OBJ)))
+#define SCM_CDADR(OBJ)		SCM_CDR (SCM_CAR (SCM_CDR (OBJ)))
+#define SCM_CADDR(OBJ)		SCM_CAR (SCM_CDR (SCM_CDR (OBJ)))
+#define SCM_CDDDR(OBJ)		SCM_CDR (SCM_CDR (SCM_CDR (OBJ)))
+
+#define SCM_CAAAAR(OBJ)		SCM_CAR (SCM_CAR (SCM_CAR (SCM_CAR (OBJ))))
+#define SCM_CDAAAR(OBJ)		SCM_CDR (SCM_CAR (SCM_CAR (SCM_CAR (OBJ))))
+#define SCM_CADAAR(OBJ)		SCM_CAR (SCM_CDR (SCM_CAR (SCM_CAR (OBJ))))
+#define SCM_CDDAAR(OBJ)		SCM_CDR (SCM_CDR (SCM_CAR (SCM_CAR (OBJ))))
+#define SCM_CAADAR(OBJ)		SCM_CAR (SCM_CAR (SCM_CDR (SCM_CAR (OBJ))))
+#define SCM_CDADAR(OBJ)		SCM_CDR (SCM_CAR (SCM_CDR (SCM_CAR (OBJ))))
+#define SCM_CADDAR(OBJ)		SCM_CAR (SCM_CDR (SCM_CDR (SCM_CAR (OBJ))))
+#define SCM_CDDDAR(OBJ)		SCM_CDR (SCM_CDR (SCM_CDR (SCM_CAR (OBJ))))
+#define SCM_CAAADR(OBJ)		SCM_CAR (SCM_CAR (SCM_CAR (SCM_CDR (OBJ))))
+#define SCM_CDAADR(OBJ)		SCM_CDR (SCM_CAR (SCM_CAR (SCM_CDR (OBJ))))
+#define SCM_CADADR(OBJ)		SCM_CAR (SCM_CDR (SCM_CAR (SCM_CDR (OBJ))))
+#define SCM_CDDADR(OBJ)		SCM_CDR (SCM_CDR (SCM_CAR (SCM_CDR (OBJ))))
+#define SCM_CAADDR(OBJ)		SCM_CAR (SCM_CAR (SCM_CDR (SCM_CDR (OBJ))))
+#define SCM_CDADDR(OBJ)		SCM_CDR (SCM_CAR (SCM_CDR (SCM_CDR (OBJ))))
+#define SCM_CADDDR(OBJ)		SCM_CAR (SCM_CDR (SCM_CDR (SCM_CDR (OBJ))))
+#define SCM_CDDDDR(OBJ)		SCM_CDR (SCM_CDR (SCM_CDR (SCM_CDR (OBJ))))
+
+
+#define SCM_NEWCELL(_into) \
+	{ \
+	  if (SCM_IMP(scm_freelist)) \
+	     _into = scm_gc_for_newcell();\
+	  else \
+	    { \
+	       _into = scm_freelist; \
+	       scm_freelist = SCM_CDR(scm_freelist);\
+	       ++scm_cells_allocated; \
+	    } \
+	}
+
+
+#ifdef __STDC__
+extern SCM scm_cons (SCM x, SCM y);
+extern SCM scm_cons2 (SCM w, SCM x, SCM y);
+extern SCM scm_pair_p(SCM x);
+extern SCM scm_set_car_x(SCM pair, SCM value);
+extern SCM scm_set_cdr_x(SCM pair, SCM value);
+extern void scm_init_pairs (void);
+
+#else /* STDC */
+extern SCM scm_cons ();
+extern SCM scm_cons2 ();
+extern SCM scm_pair_p();
+extern SCM scm_set_car_x();
+extern SCM scm_set_cdr_x();
+extern void scm_init_pairs ();
+
+#endif /* STDC */
+#endif  /* PAIRSH */
diff --git a/libguile/ports.c b/libguile/ports.c
new file mode 100644
index 000000000..cbaecbc03
--- /dev/null
+++ b/libguile/ports.c
@@ -0,0 +1,1000 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+#ifdef HAVE_MALLOC_H
+#include "malloc.h"
+#endif
+
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+
+
+
+
+/* scm_ptobs scm_numptob
+ * implement a dynamicly resized array of ptob records.
+ * Indexes into this table are used when generating type
+ * tags for smobjects (if you know a tag you can get an index and conversely).
+ */
+scm_ptobfuns *scm_ptobs;
+scm_sizet scm_numptob;
+
+#ifdef __STDC__
+SCM 
+scm_markstream (SCM ptr)
+#else
+SCM 
+scm_markstream (ptr)
+     SCM ptr;
+#endif
+{
+  int openp;
+  if (SCM_GC8MARKP (ptr))
+    return SCM_BOOL_F;
+  openp = SCM_CAR (ptr) & SCM_OPN;
+  SCM_SETGC8MARK (ptr);
+  if (openp)
+    return SCM_STREAM  (ptr);
+  else
+    return SCM_BOOL_F;
+}
+
+
+#ifdef __STDC__
+long 
+scm_newptob (scm_ptobfuns *ptob)
+#else
+long 
+scm_newptob (ptob)
+     scm_ptobfuns *ptob;
+#endif
+{
+  char *tmp;
+  if (255 <= scm_numptob)
+    goto ptoberr;
+  SCM_DEFER_INTS;
+  SCM_SYSCALL (tmp = (char *) realloc ((char *) scm_ptobs, (1 + scm_numptob) * sizeof (scm_ptobfuns)));
+  if (tmp)
+    {
+      scm_ptobs = (scm_ptobfuns *) tmp;
+      scm_ptobs[scm_numptob].mark = ptob->mark;
+      scm_ptobs[scm_numptob].free = ptob->free;
+      scm_ptobs[scm_numptob].print = ptob->print;
+      scm_ptobs[scm_numptob].equalp = ptob->equalp;
+      scm_ptobs[scm_numptob].fputc = ptob->fputc;
+      scm_ptobs[scm_numptob].fputs = ptob->fputs;
+      scm_ptobs[scm_numptob].fwrite = ptob->fwrite;
+      scm_ptobs[scm_numptob].fflush = ptob->fflush;
+      scm_ptobs[scm_numptob].fgetc = ptob->fgetc;
+      scm_ptobs[scm_numptob].fclose = ptob->fclose;
+      scm_numptob++;
+    }
+  SCM_ALLOW_INTS;
+  if (!tmp)
+  ptoberr:scm_wta (SCM_MAKINUM ((long) scm_numptob), (char *) SCM_NALLOC, "newptob");
+  return scm_tc7_port + (scm_numptob - 1) * 256;
+}
+
+
+/* internal SCM call */
+#ifdef __STDC__
+void 
+scm_fflush (SCM port)
+#else
+void 
+scm_fflush (port)
+     SCM port;
+#endif
+{
+  scm_sizet i = SCM_PTOBNUM (port);
+  (scm_ptobs[i].fflush) (SCM_STREAM (port));
+}
+
+
+
+
+#ifdef __IBMC__
+# define MSDOS
+#endif
+#ifdef MSDOS
+# ifndef GO32
+#  include <io.h>
+#  include <conio.h>
+#ifdef __STDC__
+static int 
+input_waiting (FILE *f)
+#else
+static int 
+input_waiting (f)
+     FILE *f;
+#endif
+{
+  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 __STDC__
+static int
+input_waiting(FILE *f)
+#else
+static int
+input_waiting(f)
+     FILE *f;
+#endif
+{
+# ifdef FIONREAD
+  long remir;
+  if (feof(f)) return 1;
+  ioctl(fileno(f), FIONREAD, &remir);
+  return remir;
+# else
+  return -1;
+# endif
+}
+#endif
+
+SCM_PROC(s_char_ready_p, "char-ready?", 1, 0, 0, scm_char_ready_p);
+#ifdef __STDC__
+SCM 
+scm_char_ready_p (SCM port)
+#else
+SCM 
+scm_char_ready_p (port)
+     SCM port;
+#endif
+{
+  if (SCM_UNBNDP (port))
+    port = scm_cur_inp;
+  else
+    SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), port, SCM_ARG1, s_char_ready_p);
+  if (SCM_CRDYP (port) || !SCM_FPORTP (port))
+    return SCM_BOOL_T;
+  return input_waiting ((FILE *)SCM_STREAM (port)) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+
+
+
+SCM_PROC (s_ungetc_char_ready_p, "ungetc-char-ready?", 1, 0, 0, scm_ungetc_char_ready_p);
+#ifdef __STDC__
+SCM 
+scm_ungetc_char_ready_p (SCM port)
+#else
+SCM 
+scm_ungetc_char_ready_p (port)
+     SCM port;
+#endif
+{
+  if (SCM_UNBNDP (port))
+    port = scm_cur_inp;
+  else
+    SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), port, SCM_ARG1, s_ungetc_char_ready_p);
+  return (SCM_CRDYP (port)
+	  ? SCM_BOOL_T
+	  : SCM_BOOL_F);
+}
+
+
+
+
+
+/* {Standard Ports}
+ */
+SCM_PROC(s_current_input_port, "current-input-port", 0, 0, 0, scm_current_input_port);
+#ifdef __STDC__
+SCM 
+scm_current_input_port (void)
+#else
+SCM 
+scm_current_input_port ()
+#endif
+{
+  return scm_cur_inp;
+}
+
+SCM_PROC(s_current_output_port, "current-output-port", 0, 0, 0, scm_current_output_port);
+#ifdef __STDC__
+SCM 
+scm_current_output_port (void)
+#else
+SCM 
+scm_current_output_port ()
+#endif
+{
+  return scm_cur_outp;
+}
+
+SCM_PROC(s_current_error_port, "current-error-port", 0, 0, 0, scm_current_error_port);
+#ifdef __STDC__
+SCM 
+scm_current_error_port (void)
+#else
+SCM 
+scm_current_error_port ()
+#endif
+{
+  return scm_cur_errp;
+}
+
+SCM_PROC(s_set_current_input_port, "set-current-input-port", 1, 0, 0, scm_set_current_input_port);
+#ifdef __STDC__
+SCM 
+scm_set_current_input_port (SCM port)
+#else
+SCM 
+scm_set_current_input_port (port)
+     SCM port;
+#endif
+{
+  SCM oinp = scm_cur_inp;
+  SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), port, SCM_ARG1, s_set_current_input_port);
+  scm_cur_inp = port;
+  return oinp;
+}
+
+
+SCM_PROC(s_set_current_output_port, "set-current-output-port", 1, 0, 0, scm_set_current_output_port);
+#ifdef __STDC__
+SCM 
+scm_set_current_output_port (SCM port)
+#else
+SCM 
+scm_set_current_output_port (port)
+     SCM port;
+#endif
+{
+  SCM ooutp = scm_cur_outp;
+  SCM_ASSERT (SCM_NIMP (port) && SCM_OPOUTPORTP (port), port, SCM_ARG1, s_set_current_output_port);
+  scm_cur_outp = port;
+  return ooutp;
+}
+
+
+SCM_PROC(s_set_current_error_port, "set-current-error-port", 1, 0, 0, scm_set_current_error_port);
+#ifdef __STDC__
+SCM 
+scm_set_current_error_port (SCM port)
+#else
+SCM 
+scm_set_current_error_port (port)
+     SCM port;
+#endif
+{
+  SCM oerrp = scm_cur_errp;
+  SCM_ASSERT (SCM_NIMP (port) && SCM_OPOUTPORTP (port), port, SCM_ARG1, s_set_current_error_port);
+  scm_cur_errp = port;
+  return oerrp;
+}
+
+
+
+/* {Ports - in general}
+ * 
+ */
+
+/* Array of open ports, required for reliable MOVE->FDES etc.  */
+struct scm_port_table **scm_port_table;
+
+int scm_port_table_size = 0;	/* Number of ports in scm_port_table.  */
+int scm_port_table_room = 20;	/* Size of the array.  */
+
+/* Add a port to the table.  Call with SCM_DEFER_INTS active.  */
+#ifdef __STDC__
+struct scm_port_table *
+scm_add_to_port_table (SCM port)
+#else
+struct scm_port_table *
+scm_add_to_port_table (port)
+     SCM port;
+#endif
+{
+  if (scm_port_table_size == scm_port_table_room)
+    {
+      scm_port_table = ((struct scm_port_table **)
+			realloc ((char *) scm_port_table,
+				 (long) (sizeof (struct scm_port_table)
+					 * scm_port_table_room * 2)));
+      /* !!! error checking */
+      scm_port_table_room *= 2;
+    }
+  scm_port_table[scm_port_table_size] = ((struct scm_port_table *)
+					 scm_must_malloc (sizeof (struct scm_port_table),
+							  "system port table"));
+  scm_port_table[scm_port_table_size]->port = port;
+  scm_port_table[scm_port_table_size]->revealed = 0;
+  scm_port_table[scm_port_table_size]->stream = 0;
+  scm_port_table[scm_port_table_size]->file_name = SCM_BOOL_F;
+  scm_port_table[scm_port_table_size]->line_number = 1;
+  scm_port_table[scm_port_table_size]->column_number = 0;
+  scm_port_table[scm_port_table_size]->representation = scm_regular_port;
+  return scm_port_table[scm_port_table_size++];
+}
+
+/* Remove a port from the table.  Call with SCM_DEFER_INTS active.  */
+#ifdef __STDC__
+void
+scm_remove_from_port_table (SCM port)
+#else
+void
+scm_remove_from_port_table (port)
+     SCM port;
+#endif
+{
+  int i = 0;
+  while (scm_port_table[i]->port != port)
+    {
+      i++;
+      /* Error if not found: too violent?  May occur in GC.  */
+      if (i >= scm_port_table_size)
+	scm_wta (port, "Port not in table", "scm_remove_from_port_table");
+    }
+  scm_must_free ((char *)scm_port_table[i]);
+  scm_mallocated -= sizeof (*scm_port_table[i]);
+  scm_port_table[i] = scm_port_table[scm_port_table_size - 1];
+  SCM_SETPTAB_ENTRY (port, 0);
+  scm_port_table_size--;
+}
+
+#ifdef DEBUG
+/* Undocumented functions for debugging.  */
+/* Return the number of ports in the table.  */
+static char s_pt_size[] = "pt-size";
+#ifdef __STDC__
+SCM
+scm_pt_size (void)
+#else
+SCM
+scm_pt_size ()
+#endif
+{
+  return SCM_MAKINUM (scm_port_table_size);
+}
+
+/* Return the ith member of the port table.  */
+static char s_pt_member[] = "pt-member";
+#ifdef __STDC__
+SCM
+scm_pt_member (SCM member)
+#else
+SCM
+scm_pt_member (member)
+     SCM member;
+#endif
+{
+  int i;
+  SCM_ASSERT (SCM_INUMP (member), member, SCM_ARG1, s_pt_member);
+  i = SCM_INUM (member);
+  if (i < 0 || i >= scm_port_table_size)
+    return SCM_BOOL_F;
+  else
+    return scm_port_table[i]->port;
+}
+#endif
+
+
+/* Find a port in the table and return its revealed count.  Return -1
+ * if the port isn't in the table (should not happen).  Also used by
+ * the garbage collector.
+ */
+#ifdef __STDC__
+int
+scm_revealed_count (SCM port)
+#else
+int
+scm_revealed_count (port)
+     SCM port;
+#endif
+{
+  return SCM_REVEALED(port);
+}
+
+
+
+/* Return the revealed count for a port.  */
+
+SCM_PROC(s_port_revealed, "port-revealed", 1, 0, 0, scm_port_revealed);
+#ifdef __STDC__
+SCM
+scm_port_revealed (SCM port)
+#else
+SCM
+scm_port_revealed (port)
+     SCM port;
+#endif
+{
+  int result;
+
+  SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port), port, SCM_ARG1, s_port_revealed);
+
+  if ((result = scm_revealed_count (port)) == -1)
+    return SCM_BOOL_F;
+  else
+    return SCM_MAKINUM (result);
+}
+
+/* Set the revealed count for a port.  */
+SCM_PROC(s_set_port_revealed_x, "set-port-revealed!", 2, 0, 0, scm_set_port_revealed_x);
+#ifdef __STDC__
+SCM
+scm_set_port_revealed_x (SCM port, SCM rcount)
+#else
+SCM
+scm_set_port_revealed_x (port, rcount)
+     SCM port;
+     SCM rcount;
+#endif
+{
+  SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port), port, SCM_ARG1, s_set_port_revealed_x);
+  SCM_ASSERT (SCM_INUMP (rcount), rcount, SCM_ARG2, s_set_port_revealed_x);
+  SCM_DEFER_INTS;
+  SCM_REVEALED (port) = SCM_INUM (rcount);
+  SCM_ALLOW_INTS;
+  return SCM_BOOL_F;
+}
+
+/* scm_close_port
+ * Call the close operation on a port object. 
+ */
+SCM_PROC(s_close_port, "close-port", 1, 0, 0, scm_close_port);
+#ifdef __STDC__
+SCM
+scm_close_port (SCM port)
+#else
+SCM
+scm_close_port (port)
+     SCM port;
+#endif
+{
+  scm_sizet i;
+  SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port), port, SCM_ARG1, s_close_port);
+  if (SCM_CLOSEDP (port))
+    return SCM_UNSPECIFIED;
+  i = SCM_PTOBNUM (port);
+  SCM_DEFER_INTS;
+  if (scm_ptobs[i].fclose)
+    SCM_SYSCALL ((scm_ptobs[i].fclose) (SCM_STREAM (port)));
+  scm_remove_from_port_table (port);
+  SCM_CAR (port) &= ~SCM_OPN;
+  SCM_ALLOW_INTS;
+  return SCM_UNSPECIFIED;
+}
+
+SCM_PROC(s_close_all_ports_except, "close-all-ports-except", 0, 0, 1, scm_close_all_ports_except);
+#ifdef __STDC__
+SCM
+scm_close_all_ports_except (SCM ports)
+#else
+SCM
+scm_close_all_ports_except (ports)
+     SCM ports;
+#endif
+{
+  int i = 0;
+  SCM_ASSERT (SCM_NIMP (ports) && SCM_CONSP (ports), ports, SCM_ARG1, s_close_all_ports_except);
+  SCM_DEFER_INTS;  
+  while (i < scm_port_table_size)
+    {
+      SCM thisport = scm_port_table[i]->port;
+      int found = 0;
+      SCM ports_ptr = ports;
+
+      while (SCM_NNULLP (ports_ptr))
+	{
+	  SCM port = SCM_CAR (ports_ptr);
+	  if (i == 0)
+	    SCM_ASSERT (SCM_NIMP (port) && SCM_OPPORTP (port), port, SCM_ARG1, s_close_all_ports_except);
+	  if (port == thisport)
+	    found = 1;
+	  ports_ptr = SCM_CDR (ports_ptr);
+	}
+      if (found)
+	i++;
+      else
+	/* i is not to be incremented here.  */
+	scm_close_port (thisport);
+    }
+  SCM_ALLOW_INTS;
+  return SCM_UNSPECIFIED;
+}
+
+SCM_PROC(s_input_port_p, "input-port?", 1, 0, 0, scm_input_port_p);
+#ifdef __STDC__
+SCM 
+scm_input_port_p (SCM x)
+#else
+SCM 
+scm_input_port_p (x)
+     SCM x;
+#endif
+{
+  if (SCM_IMP (x))
+ return SCM_BOOL_F;
+  return SCM_INPORTP (x) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+SCM_PROC(s_output_port_p, "output-port?", 1, 0, 0, scm_output_port_p);
+#ifdef __STDC__
+SCM 
+scm_output_port_p (SCM x)
+#else
+SCM 
+scm_output_port_p (x)
+     SCM x;
+#endif
+{
+  if (SCM_IMP (x))
+ return SCM_BOOL_F;
+  return SCM_OUTPORTP (x) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+
+SCM_PROC(s_eof_object_p, "eof-object?", 1, 0, 0, scm_eof_object_p);
+#ifdef __STDC__
+SCM 
+scm_eof_object_p (SCM x)
+#else
+SCM 
+scm_eof_object_p (x)
+     SCM x;
+#endif
+{
+  return (SCM_EOF_VAL == x) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+SCM_PROC(s_force_output, "force-output", 0, 1, 0, scm_force_output);
+#ifdef __STDC__
+SCM 
+scm_force_output (SCM port)
+#else
+SCM 
+scm_force_output (port)
+     SCM port;
+#endif
+{
+  if (SCM_UNBNDP (port))
+ port = scm_cur_outp;
+  else
+    SCM_ASSERT (SCM_NIMP (port) && SCM_OPOUTPORTP (port), port, SCM_ARG1, s_force_output);
+  {
+    scm_sizet i = SCM_PTOBNUM (port);
+    SCM_SYSCALL ((scm_ptobs[i].fflush) (SCM_STREAM (port)));
+    return SCM_UNSPECIFIED;
+  }
+}
+
+
+SCM_PROC(s_read_char, "read-char", 0, 1, 0, scm_read_char);
+#ifdef __STDC__
+SCM 
+scm_read_char (SCM port)
+#else
+SCM 
+scm_read_char (port)
+     SCM port;
+#endif
+{
+  int c;
+  if (SCM_UNBNDP (port))
+ port = scm_cur_inp;
+  else
+    SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), port, SCM_ARG1, s_read_char);
+  c = scm_gen_getc (port);
+  if (EOF == c)
+    return SCM_EOF_VAL;
+  return SCM_MAKICHR (c);
+}
+
+
+SCM_PROC(s_peek_char, "peek-char", 0, 1, 0, scm_peek_char);
+#ifdef __STDC__
+SCM 
+scm_peek_char (SCM port)
+#else
+SCM 
+scm_peek_char (port)
+     SCM port;
+#endif
+{
+  int c;
+  if (SCM_UNBNDP (port))
+    port = scm_cur_inp;
+  else
+    SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), port, SCM_ARG1, s_peek_char);
+  c = scm_gen_getc (port);
+  if (EOF == c)
+    return SCM_EOF_VAL;
+  scm_gen_ungetc (c, port);
+  return SCM_MAKICHR (c);
+}
+
+SCM_PROC (s_unread_char, "unread-char", 2, 0, 0, scm_unread_char);
+#ifdef __STDC__
+SCM 
+scm_unread_char (SCM cobj, SCM port)
+#else
+SCM 
+scm_unread_char (cobj, port)
+     SCM cobj;
+     SCM port;
+#endif
+{
+  int c;
+
+  SCM_ASSERT (SCM_ICHRP (cobj), cobj, SCM_ARG1, s_unread_char);
+
+  if (SCM_UNBNDP (port))
+    port = scm_cur_inp;
+  else
+    SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), port, SCM_ARG2, s_unread_char);
+
+
+  c = SCM_ICHR (cobj);
+
+  scm_gen_ungetc (c, port);
+  return cobj;
+}
+
+
+
+SCM_PROC (s_line_number, "line-number", 0, 1, 0, scm_line_number);
+#ifdef __STDC__
+SCM 
+scm_line_number (SCM port)
+#else
+SCM 
+scm_line_number (port)
+     SCM port;
+#endif
+{
+  SCM p;
+  p = ((port == SCM_UNDEFINED)
+       ? scm_cur_inp
+       : port);
+  if (!(SCM_NIMP (p) && SCM_PORTP (p)))
+    return SCM_BOOL_F;
+  else
+    return SCM_MAKINUM (SCM_LINUM (p));
+}
+
+SCM_PROC (s_column_number, "column-number", 0, 1, 0, scm_column_number);
+#ifdef __STDC__
+SCM
+scm_column_number (SCM port)
+#else
+SCM
+scm_column_number  (port)
+     SCM port;
+#endif
+{
+  SCM p;
+  p = ((port == SCM_UNDEFINED)
+       ? scm_cur_inp
+       : port);
+  if (!(SCM_NIMP (p) && SCM_PORTP (p)))
+    return SCM_BOOL_F;
+  else
+    return SCM_MAKINUM (SCM_COL (p));
+}
+
+/* !!! dubious feature */
+SCM_PROC (s_port_file_name, "port-file-name", 0, 1, 0, scm_port_file_name);
+#ifdef __STDC__
+SCM 
+scm_port_file_name (SCM port)
+#else
+SCM 
+scm_port_file_name (port)
+     SCM port;
+#endif
+{
+  SCM p;
+  p = ((port == SCM_UNDEFINED)
+       ? scm_cur_inp
+       : port);
+  if (!(SCM_NIMP (p) && SCM_PORTP (p)))
+    return SCM_BOOL_F;
+  else
+    return SCM_PTAB_ENTRY (p)->file_name;
+}
+
+#ifndef ttyname
+extern char * ttyname();
+#endif
+
+#ifdef __STDC__
+void 
+scm_prinport (SCM exp, SCM port, char *type)
+#else
+void 
+scm_prinport (exp, port, type)
+     SCM exp;
+     SCM port;
+     char *type;
+#endif
+{
+  scm_gen_puts (scm_regular_string, "#<", port);
+  if (SCM_CLOSEDP (exp))
+    scm_gen_puts (scm_regular_string, "closed: ", port);
+  else
+    {
+      if (SCM_RDNG & SCM_CAR (exp))
+	scm_gen_puts (scm_regular_string, "input: ", port);
+      if (SCM_WRTNG & SCM_CAR (exp))
+	scm_gen_puts (scm_regular_string, "output: ", port);
+    }
+  scm_gen_puts (scm_regular_string, type, port);
+  scm_gen_putc (' ', port);
+#ifndef MSDOS
+#ifndef __EMX__
+#ifndef _DCC
+#ifndef AMIGA
+#ifndef THINK_C
+  if (SCM_OPENP (exp) && scm_tc16_fport == SCM_TYP16 (exp) && isatty (fileno ((FILE *)SCM_STREAM (exp))))
+    scm_gen_puts (scm_regular_string, ttyname (fileno ((FILE *)SCM_STREAM (exp))), port);
+  else
+#endif
+#endif
+#endif
+#endif
+#endif
+  if (SCM_OPFPORTP (exp))
+    scm_intprint ((long) fileno ((FILE *)SCM_STREAM (exp)), 10, port);
+  else
+    scm_intprint (SCM_CDR (exp), 16, port);
+  scm_gen_putc ('>', port);
+}
+
+#ifdef __STDC__
+void
+scm_ports_prehistory (void)
+#else
+void
+scm_ports_prehistory ()
+#endif
+{
+  scm_numptob = 0;
+  scm_ptobs = (scm_ptobfuns *) malloc (sizeof (scm_ptobfuns));
+  
+  /* WARNING: These scm_newptob calls must be done in this order.
+   * They must agree with the port declarations in tags.h.
+   */
+  /* scm_tc16_fport = */ scm_newptob (&scm_fptob);
+  /* scm_tc16_pipe = */ scm_newptob (&scm_pipob);
+  /* scm_tc16_strport = */ scm_newptob (&scm_stptob);
+  /* scm_tc16_sfport = */ scm_newptob (&scm_sfptob);
+}
+
+
+
+/* {Void Ports}
+ */
+
+int scm_tc16_void_port = 0;
+
+static int
+print_void_port (exp, port, writing)
+     SCM exp;
+     SCM port;
+     int writing;
+{
+  scm_prinport (exp, port, "void");
+  return 1;
+}
+
+static int
+putc_void_port (c, strm)
+     int c;
+     SCM strm;
+{
+  return 0;			/* vestigial return value */
+}
+
+static int
+puts_void_port (s, strm)
+     char * s;
+     SCM strm;
+{
+  return 0;			/* vestigial return value */
+}
+
+static scm_sizet
+write_void_port (ptr, size, nitems, strm)
+     void * ptr;
+     int size;
+     int nitems;
+     SCM strm;
+{
+  int len;
+  len = size * nitems;
+  return len;
+}
+
+#ifdef __STDC__
+static int
+flush_void_port (SCM strm)
+#else
+static int
+flush_void_port (strm)
+     SCM strm;
+#endif
+{
+  return 0;
+}
+
+#ifdef __STDC__
+static int
+getc_void_port (SCM strm)
+#else
+static int
+getc_void_port (strm)
+     SCM strm;
+#endif
+{
+  return EOF;
+}
+
+#ifdef __STDC__
+static int
+close_void_port (SCM strm)
+#else
+static int
+close_void_port (strm)
+     SCM strm;
+#endif
+{
+  return 0;			/* this is ignored by scm_close_port. */
+}
+
+
+#ifdef __STDC__
+static int 
+noop0 (FILE *stream)
+#else
+static int 
+noop0 (stream)
+     FILE *stream;
+#endif
+{
+  return 0;
+}
+
+
+static struct scm_ptobfuns  void_port_ptob =
+{
+  scm_mark0, 
+  noop0,
+  print_void_port,
+  0,				/* equal? */
+  putc_void_port,
+  puts_void_port,
+  write_void_port,
+  flush_void_port,
+  getc_void_port,
+  close_void_port,
+};
+
+
+
+#ifdef __STDC__
+SCM
+scm_void_port (char * mode_str)
+#else
+SCM
+scm_void_port (mode_str)
+     char * mode_str;
+#endif
+{
+  int mode_bits;
+  SCM answer;
+  struct scm_port_table * pt;
+
+  SCM_NEWCELL (answer);
+  SCM_DEFER_INTS;
+  mode_bits = scm_mode_bits (mode_str);
+  pt = scm_add_to_port_table (answer);
+  SCM_CAR (answer) = scm_tc16_void_port | mode_bits;
+  SCM_SETPTAB_ENTRY (answer, pt);
+  SCM_SETSTREAM (answer, SCM_BOOL_F);
+  SCM_ALLOW_INTS;
+  return answer;
+}
+
+
+SCM_PROC (s_sys_make_void_port, "%make-void-port", 1, 0, 0, scm_sys_make_void_port);
+#ifdef __STDC__
+SCM
+scm_sys_make_void_port (SCM mode)
+#else
+SCM
+scm_sys_make_void_port (mode)
+     SCM mode;
+#endif
+{
+  SCM_ASSERT (SCM_NIMP (mode) && SCM_STRINGP (mode), mode,
+	      SCM_ARG1, s_sys_make_void_port);
+
+  return scm_void_port (SCM_ROCHARS (mode));
+}
+
+
+
+
+
+#ifdef __STDC__
+void
+scm_init_ports (void)
+#else
+void
+scm_init_ports ()
+#endif
+{
+  scm_tc16_void_port = scm_newptob (&void_port_ptob);
+#include "ports.x"
+}
+
diff --git a/libguile/ports.h b/libguile/ports.h
new file mode 100644
index 000000000..fac20af77
--- /dev/null
+++ b/libguile/ports.h
@@ -0,0 +1,229 @@
+/* classes: h_files */
+
+#ifndef PORTSH
+#define PORTSH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+#include "smob.h"
+
+
+
+enum scm_port_representation_type
+{
+  scm_regular_port,
+  scm_mb_port,
+  scm_wchar_port
+};
+
+enum scm_string_representation_type
+{
+  scm_regular_string = scm_regular_port,
+  scm_mb_string = scm_mb_port,
+  scm_wchar_string = scm_wchar_port
+};
+
+
+struct scm_port_table 
+{
+  SCM port;			/* Open port.  */
+  int revealed;			/* 0 not revealed, > 1 revealed.
+				 * Revealed ports do not get GC'd.
+				 */
+
+  SCM stream;
+  SCM file_name;
+  int unchr;			/* pushed back character, if any */
+
+  int line_number;
+  int column_number;
+
+  enum scm_port_representation_type representation;
+};
+
+extern struct scm_port_table **scm_port_table;
+extern scm_port_table_size; /* Number of ports in scm_port_table.  */
+
+
+
+
+/* PORT FLAGS
+ * A set of flags caracterizes a port.
+ */
+#define SCM_OPN		(1L<<16) /* Is the port open? */
+#define SCM_RDNG	(2L<<16) /* Is it a readable port? */
+#define SCM_WRTNG	(4L<<16) /* Is it writable? */
+#define SCM_BUF0	(8L<<16)
+#define SCM_CRDY	(32L<<16) /* Should char-ready? return #t? */
+
+/* A mask used to clear the char-ready port flag. */
+#define SCM_CUC		0x001fffffL
+
+#define SCM_PORTP(x) (SCM_TYP7(x)==scm_tc7_port)
+#define SCM_OPPORTP(x) (((0x7f | SCM_OPN) & SCM_CAR(x))==(scm_tc7_port | SCM_OPN))
+#define SCM_OPINPORTP(x) (((0x7f | SCM_OPN | SCM_RDNG) & SCM_CAR(x))==(scm_tc7_port | SCM_OPN | SCM_RDNG))
+#define SCM_OPOUTPORTP(x) (((0x7f | SCM_OPN | SCM_WRTNG) & SCM_CAR(x))==(scm_tc7_port | SCM_OPN | SCM_WRTNG))
+#define SCM_FPORTP(x) (SCM_TYP16S(x)==scm_tc7_port)
+#define SCM_OPFPORTP(x) (((0xfeff | SCM_OPN) & SCM_CAR(x))==(scm_tc7_port | SCM_OPN))
+#define SCM_OPINFPORTP(x) (((0xfeff | SCM_OPN | SCM_RDNG) & SCM_CAR(x))==(scm_tc7_port | SCM_OPN | SCM_RDNG))
+#define SCM_OPOUTFPORTP(x) (((0xfeff | SCM_OPN | SCM_WRTNG) & SCM_CAR(x))==(scm_tc7_port | SCM_OPN | SCM_WRTNG))
+
+#define SCM_INPORTP(x) (((0x7f | SCM_RDNG) & SCM_CAR(x))==(scm_tc7_port | SCM_RDNG))
+#define SCM_OUTPORTP(x) (((0x7f | SCM_WRTNG) & SCM_CAR(x))==(scm_tc7_port | SCM_WRTNG))
+#define SCM_OPENP(x) (SCM_OPN & SCM_CAR(x))
+#define SCM_CLOSEDP(x) (!SCM_OPENP(x))
+#define SCM_PTAB_ENTRY(x) ((struct scm_port_table *)SCM_CDR(x))
+#define SCM_SETPTAB_ENTRY(x,ent) SCM_SETCDR ((x), (SCM)(ent))
+#define SCM_STREAM(x) SCM_PTAB_ENTRY(x)->stream
+#define SCM_SETSTREAM(x,s) (SCM_PTAB_ENTRY(x)->stream = s)
+#define SCM_LINUM(x) SCM_PTAB_ENTRY(x)->line_number
+#define SCM_COL(x) SCM_PTAB_ENTRY(x)->column_number
+#define SCM_REVEALED(x) SCM_PTAB_ENTRY(x)->revealed
+#define SCM_SETREVEALED(x,s) (SCM_PTAB_ENTRY(x)->revealed = s)
+#define SCM_PORT_REPRESENTATION(x) SCM_PTAB_ENTRY(x)->representation
+#define SCM_SET_PORT_REPRESENTATION(x,s) (SCM_PTAB_ENTRY(x)->representation = s)
+#define SCM_CRDYP(port) (SCM_CAR(port) & SCM_CRDY)
+#define SCM_CLRDY(port) {SCM_CAR(port) &= SCM_CUC;}
+#define SCM_SETRDY(port) {SCM_CAR(port) |= SCM_CRDY;}
+#define SCM_CUNGET(c,port) {SCM_PTAB_ENTRY(port)->unchr = c; SCM_SETRDY(port);}
+#define SCM_CGETUN(port) (SCM_PTAB_ENTRY(port)->unchr)
+
+#define SCM_INCLINE(port)  	{SCM_LINUM (port) += 1; SCM_COL (port) = 0;}
+#define SCM_INCCOL(port)  	{SCM_COL (port) += 1;}
+#define SCM_TABCOL(port)  	{SCM_COL (port) += (SCM_COL (port) + 1) % 8;}
+
+
+
+
+
+extern scm_ptobfuns *scm_ptobs;
+extern scm_sizet scm_numptob;
+extern int scm_port_table_room;
+
+
+#ifdef __STDC__
+extern SCM scm_markstream (SCM ptr);
+extern long scm_newptob (scm_ptobfuns *ptob);
+extern void scm_fflush (SCM port);
+extern SCM scm_char_ready_p (SCM port);
+extern SCM scm_ungetc_char_ready_p (SCM port);
+extern SCM scm_current_input_port (void);
+extern SCM scm_current_output_port (void);
+extern SCM scm_current_error_port (void);
+extern SCM scm_set_current_input_port (SCM port);
+extern SCM scm_set_current_output_port (SCM port);
+extern SCM scm_set_current_error_port (SCM port);
+extern struct scm_port_table * scm_add_to_port_table (SCM port);
+extern void scm_remove_from_port_table (SCM port);
+extern SCM scm_pt_size (void);
+extern SCM scm_pt_member (SCM member);
+extern int scm_revealed_count (SCM port);
+extern SCM scm_port_revealed (SCM port);
+extern SCM scm_set_port_revealed_x (SCM port, SCM rcount);
+extern SCM scm_close_port (SCM port);
+extern SCM scm_input_port_p (SCM x);
+extern SCM scm_output_port_p (SCM x);
+extern SCM scm_eof_object_p (SCM x);
+extern SCM scm_force_output (SCM port);
+extern SCM scm_read_char (SCM port);
+extern SCM scm_peek_char (SCM port);
+extern SCM scm_unread_char (SCM cobj, SCM port);
+extern SCM scm_line_number (SCM port);
+extern SCM scm_column_number (SCM port);
+extern SCM scm_port_file_name (SCM port);
+extern void scm_prinport (SCM exp, SCM port, char *type);
+extern void scm_ports_prehistory (void);
+extern SCM scm_void_port (char * mode_str);
+extern SCM scm_sys_make_void_port (SCM mode);
+extern void scm_init_ports (void);
+
+#else /* STDC */
+extern SCM scm_markstream ();
+extern long scm_newptob ();
+extern void scm_fflush ();
+extern SCM scm_char_ready_p ();
+extern SCM scm_ungetc_char_ready_p ();
+extern SCM scm_current_input_port ();
+extern SCM scm_current_output_port ();
+extern SCM scm_current_error_port ();
+extern SCM scm_set_current_input_port ();
+extern SCM scm_set_current_output_port ();
+extern SCM scm_set_current_error_port ();
+extern struct scm_port_table * scm_add_to_port_table ();
+extern void scm_remove_from_port_table ();
+extern SCM scm_pt_size ();
+extern SCM scm_pt_member ();
+extern int scm_revealed_count ();
+extern SCM scm_port_revealed ();
+extern SCM scm_set_port_revealed_x ();
+extern SCM scm_close_port ();
+extern SCM scm_input_port_p ();
+extern SCM scm_output_port_p ();
+extern SCM scm_eof_object_p ();
+extern SCM scm_force_output ();
+extern SCM scm_read_char ();
+extern SCM scm_peek_char ();
+extern SCM scm_unread_char ();
+extern SCM scm_line_number ();
+extern SCM scm_column_number ();
+extern SCM scm_port_file_name ();
+extern void scm_prinport ();
+extern void scm_ports_prehistory ();
+extern SCM scm_void_port ();
+extern SCM scm_sys_make_void_port ();
+extern void scm_init_ports ();
+
+#endif /* STDC */
+
+
+
+
+
+
+
+
+
+
+
+
+#endif  /* PORTSH */
diff --git a/libguile/posix.c b/libguile/posix.c
new file mode 100644
index 000000000..11136be1d
--- /dev/null
+++ b/libguile/posix.c
@@ -0,0 +1,1510 @@
+/*	Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+
+#ifdef TIME_WITH_SYS_TIME
+# include <sys/time.h>
+# include <time.h>
+#else
+# if HAVE_SYS_TIME_H
+#  include <sys/time.h>
+# else
+#  include <time.h>
+# endif
+#endif
+
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+
+#ifdef HAVE_SYS_SELECT_H
+#include <sys/select.h>
+#endif
+
+#include <sys/stat.h>
+#include <fcntl.h>
+
+#include <pwd.h>
+
+#if HAVE_SYS_WAIT_H
+# include <sys/wait.h>
+#endif
+#ifndef WEXITSTATUS
+# define WEXITSTATUS(stat_val) ((unsigned)(stat_val) >> 8)
+#endif
+#ifndef WIFEXITED
+# define WIFEXITED(stat_val) (((stat_val) & 255) == 0)
+#endif
+
+#include <signal.h>
+
+#ifdef FD_SET
+
+#define SELECT_TYPE fd_set
+#define SELECT_SET_SIZE FD_SETSIZE
+
+#else /* no FD_SET */
+
+/* Define the macros to access a single-int bitmap of descriptors.  */
+#define SELECT_SET_SIZE 32
+#define SELECT_TYPE int
+#define FD_SET(n, p) (*(p) |= (1 << (n)))
+#define FD_CLR(n, p) (*(p) &= ~(1 << (n)))
+#define FD_ISSET(n, p) (*(p) & (1 << (n)))
+#define FD_ZERO(p) (*(p) = 0)
+
+#endif /* no FD_SET */
+
+extern char *ttyname ();
+extern FILE *popen ();
+extern char ** environ;
+
+#include <grp.h>
+#include <sys/utsname.h>
+
+#if HAVE_DIRENT_H
+# include <dirent.h>
+# define NAMLEN(dirent) strlen((dirent)->d_name)
+#else
+# define dirent direct
+# define NAMLEN(dirent) (dirent)->d_namlen
+# if HAVE_SYS_NDIR_H
+#  include <sys/ndir.h>
+# endif
+# if HAVE_SYS_DIR_H
+#  include <sys/dir.h>
+# endif
+# if HAVE_NDIR_H
+#  include <ndir.h>
+# endif
+#endif
+
+char *strptime ();
+
+#ifdef HAVE_SETLOCALE
+#include <locale.h>
+#endif
+
+
+
+
+
+SCM_PROC (s_sys_pipe, "%pipe", 0, 0, 0, scm_sys_pipe);
+#ifdef __STDC__
+SCM 
+scm_sys_pipe (void)
+#else
+SCM 
+scm_sys_pipe ()
+#endif
+{
+  int fd[2], rv;
+  FILE *f_rd, *f_wt;
+  SCM p_rd, p_wt;
+  SCM_NEWCELL (p_rd);
+  SCM_NEWCELL (p_wt);
+  rv = pipe (fd);
+  if (rv)
+    {
+      SCM_ALLOW_INTS;
+      return SCM_BOOL_F;
+    }
+  f_rd = fdopen (fd[0], "r");
+  if (!f_rd)
+    {
+      SCM_SYSCALL (close (fd[0]));
+      SCM_SYSCALL (close (fd[1]));
+      SCM_ALLOW_INTS;
+      return SCM_BOOL_F;
+    }
+  f_wt = fdopen (fd[1], "w");
+  if (!f_wt)
+    {
+      int en;
+      en = errno;
+      fclose (f_rd);
+      SCM_SYSCALL (close (fd[1]));
+      SCM_ALLOW_INTS;
+      return SCM_MAKINUM (en);
+    }
+    {
+      struct scm_port_table * ptr;
+      struct scm_port_table * ptw;
+
+      ptr = scm_add_to_port_table (p_rd);
+      ptw = scm_add_to_port_table (p_wt);
+      SCM_SETPTAB_ENTRY (p_rd, ptr);
+      SCM_SETPTAB_ENTRY (p_wt, ptw);
+      SCM_CAR (p_rd) = scm_tc16_fport | scm_mode_bits ("r");
+      SCM_CAR (p_wt) = scm_tc16_fport | scm_mode_bits ("w");
+      SCM_SETSTREAM (p_rd, (SCM)f_rd);
+      SCM_SETSTREAM (p_wt, (SCM)f_wt);
+    }
+  SCM_ALLOW_INTS;
+  return scm_cons (p_rd, p_wt);
+}
+
+
+
+SCM_PROC (s_sys_getgroups, "%getgroups", 0, 0, 0, scm_sys_getgroups);
+#ifdef __STDC__
+SCM
+scm_sys_getgroups(void)
+#else
+SCM
+scm_sys_getgroups()
+#endif
+{
+  SCM grps, ans;
+  int ngroups = getgroups (0, NULL);
+  if (!ngroups) return SCM_BOOL_F;
+  SCM_NEWCELL(grps);
+  SCM_DEFER_INTS;
+  {
+    GETGROUPS_T *groups;
+    int val;
+
+    groups = (gid_t *)scm_must_malloc(ngroups * sizeof(GETGROUPS_T),
+				      s_sys_getgroups);
+    val = getgroups(ngroups, groups);
+    if (val < 0)
+      {
+	scm_must_free((char *)groups);
+	SCM_ALLOW_INTS;
+	return SCM_MAKINUM (errno);
+      }
+    SCM_SETCHARS(grps, groups);	/* set up grps as a GC protect */
+    SCM_SETLENGTH(grps, 0L + ngroups * sizeof(GETGROUPS_T), scm_tc7_string);
+    SCM_ALLOW_INTS;
+    ans = scm_make_vector(SCM_MAKINUM(ngroups), SCM_UNDEFINED, SCM_BOOL_F);
+    while (--ngroups >= 0) SCM_VELTS(ans)[ngroups] = SCM_MAKINUM(groups[ngroups]);
+    SCM_SETCHARS(grps, groups);	/* to make sure grps stays around. */
+    return ans;
+  }
+}  
+
+
+
+SCM_PROC (s_sys_getpwuid, "%getpw", 0, 1, 0, scm_sys_getpwuid);
+#ifdef __STDC__
+SCM 
+scm_sys_getpwuid (SCM user)
+#else
+SCM 
+scm_sys_getpwuid (user)
+     SCM user;
+#endif
+{
+  SCM result;
+  struct passwd *entry;
+  SCM *ve;
+
+  result = scm_make_vector (SCM_MAKINUM (7), SCM_UNSPECIFIED, SCM_BOOL_F);
+  ve = SCM_VELTS (result);
+  if (SCM_UNBNDP (user) || SCM_FALSEP (user))
+    {
+      SCM_DEFER_INTS;
+      SCM_SYSCALL (entry = getpwent ());
+    }
+  else if (SCM_INUMP (user))
+    {
+      SCM_DEFER_INTS;
+      entry = getpwuid (SCM_INUM (user));
+    }
+  else
+    {
+      SCM_ASSERT (SCM_NIMP (user) && SCM_ROSTRINGP (user), user, SCM_ARG1, s_sys_getpwuid);
+      if (SCM_SUBSTRP (user))
+	user = scm_makfromstr (SCM_ROCHARS (user), SCM_ROLENGTH (user), 0);
+      SCM_DEFER_INTS;
+      entry = getpwnam (SCM_ROCHARS (user));
+    }
+  if (!entry)
+    {
+      SCM_ALLOW_INTS;
+      return SCM_BOOL_F;
+    }
+  ve[0] = scm_makfrom0str (entry->pw_name);
+  ve[1] = scm_makfrom0str (entry->pw_passwd);
+  ve[2] = scm_ulong2num ((unsigned long) entry->pw_uid);
+  ve[3] = scm_ulong2num ((unsigned long) entry->pw_gid);
+  ve[4] = scm_makfrom0str (entry->pw_gecos);
+  if (!entry->pw_dir)
+    ve[5] = scm_makfrom0str ("");
+  else
+    ve[5] = scm_makfrom0str (entry->pw_dir);
+  if (!entry->pw_shell)
+    ve[6] = scm_makfrom0str ("");
+  else
+    ve[6] = scm_makfrom0str (entry->pw_shell);
+  SCM_ALLOW_INTS;
+  return result;
+}
+
+
+
+SCM_PROC (s_setpwent, "setpw", 0, 1, 0, scm_setpwent);
+#ifdef __STDC__
+SCM 
+scm_setpwent (SCM arg)
+#else
+SCM 
+scm_setpwent (arg)
+     SCM arg;
+#endif
+{
+  if (SCM_UNBNDP (arg) || SCM_FALSEP (arg))
+    endpwent ();
+  else
+    setpwent ();
+  return SCM_UNSPECIFIED;
+}
+
+
+
+/* Combines getgrgid and getgrnam.  */
+SCM_PROC (s_sys_getgrgid, "%getgr", 0, 1, 0, scm_sys_getgrgid);
+#ifdef __STDC__
+SCM 
+scm_sys_getgrgid (SCM name)
+#else
+SCM 
+scm_sys_getgrgid (name)
+     SCM name;
+#endif
+{
+  SCM result;
+  struct group *entry;
+  SCM *ve;
+  result = scm_make_vector (SCM_MAKINUM (4), SCM_UNSPECIFIED, SCM_BOOL_F);
+  ve = SCM_VELTS (result);
+  SCM_DEFER_INTS;
+  if (SCM_UNBNDP (name) || (name == SCM_BOOL_F))
+    SCM_SYSCALL (entry = getgrent ());
+  else if (SCM_INUMP (name))
+    SCM_SYSCALL (entry = getgrgid (SCM_INUM (name)));
+  else
+    {
+      SCM_ASSERT (SCM_NIMP (name) && SCM_STRINGP (name), name, SCM_ARG1, s_sys_getgrgid);
+      if (SCM_SUBSTRP (name))
+	name = scm_makfromstr (SCM_ROCHARS (name), SCM_ROLENGTH (name), 0);
+      SCM_SYSCALL (entry = getgrnam (SCM_CHARS (name)));
+    }
+  if (!entry)
+    {
+      SCM_ALLOW_INTS;
+      return SCM_MAKINUM (errno);
+    }
+  ve[0] = scm_makfrom0str (entry->gr_name);
+  ve[1] = scm_makfrom0str (entry->gr_passwd);
+  ve[2] = scm_ulong2num ((unsigned long) entry->gr_gid);
+  ve[3] = scm_makfromstrs (-1, entry->gr_mem);
+  SCM_ALLOW_INTS;
+  return result;
+}
+
+
+
+SCM_PROC (s_setgrent, "setgr", 0, 1, 0, scm_setgrent);
+#ifdef __STDC__
+SCM 
+scm_setgrent (SCM arg)
+#else
+SCM 
+scm_setgrent (arg)
+     SCM arg;
+#endif
+{
+  if (SCM_UNBNDP (arg) || SCM_FALSEP (arg))
+    endgrent ();
+  else
+    setgrent ();
+  return SCM_UNSPECIFIED;
+}
+
+
+
+SCM_PROC (s_sys_kill, "%kill", 2, 0, 0, scm_sys_kill);
+#ifdef __STDC__
+SCM 
+scm_sys_kill (SCM pid, SCM sig)
+#else
+SCM 
+scm_sys_kill (pid, sig)
+     SCM pid;
+     SCM sig;
+#endif
+{
+  int i;
+  SCM_ASSERT (SCM_INUMP (pid), pid, SCM_ARG1, s_sys_kill);
+  SCM_ASSERT (SCM_INUMP (sig), sig, SCM_ARG2, s_sys_kill);
+  /* Signal values are interned in scm_init_posix().  */
+  SCM_SYSCALL (i = kill ((int) SCM_INUM (pid), (int) SCM_INUM (sig)));
+  return i ? SCM_MAKINUM (errno) : SCM_BOOL_T;
+}
+
+
+
+SCM_PROC (s_sys_waitpid, "%waitpid", 1, 1, 0, scm_sys_waitpid);
+#ifdef __STDC__
+SCM 
+scm_sys_waitpid (SCM pid, SCM options)
+#else
+SCM 
+scm_sys_waitpid (pid, options)
+     SCM pid;
+     SCM options;
+#endif
+{
+  int i;
+  int status;
+  int ioptions;
+  SCM_ASSERT (SCM_INUMP (pid), pid, SCM_ARG1, s_sys_waitpid);
+  if (SCM_UNBNDP (options))
+    ioptions = 0;
+  else
+    {
+      SCM_ASSERT (SCM_INUMP (options), options, SCM_ARG2, s_sys_waitpid);
+      /* Flags are interned in scm_init_posix.  */
+      ioptions = SCM_INUM (options);
+    }
+  SCM_SYSCALL (i = waitpid (SCM_INUM (pid), &status, ioptions));
+  return ((i == -1)
+	  ? SCM_MAKINUM (errno)
+	  : scm_cons (SCM_MAKINUM (0L + i), SCM_MAKINUM (0L + status)));
+}
+
+
+
+SCM_PROC (s_getppid, "getppid", 0, 0, 0, scm_getppid);
+#ifdef __STDC__
+SCM 
+scm_getppid (void)
+#else
+SCM 
+scm_getppid ()
+#endif
+{
+  return SCM_MAKINUM (0L + getppid ());
+}
+
+
+
+SCM_PROC (s_getuid, "getuid", 0, 0, 0, scm_getuid);
+#ifdef __STDC__
+SCM 
+scm_getuid (void)
+#else
+SCM 
+scm_getuid ()
+#endif
+{
+  return SCM_MAKINUM (0L + getuid ());
+}
+
+
+
+SCM_PROC (s_getgid, "getgid", 0, 0, 0, scm_getgid);
+#ifdef __STDC__
+SCM 
+scm_getgid (void)
+#else
+SCM 
+scm_getgid ()
+#endif
+{
+  return SCM_MAKINUM (0L + getgid ());
+}
+
+
+
+SCM_PROC (s_geteuid, "geteuid", 0, 0, 0, scm_geteuid);
+#ifdef __STDC__
+SCM 
+scm_geteuid (void)
+#else
+SCM 
+scm_geteuid ()
+#endif
+{
+#ifdef HAVE_GETEUID
+  return SCM_MAKINUM (0L + geteuid ());
+#else
+  return SCM_MAKINUM (0L + getuid ());
+#endif
+}
+
+
+
+SCM_PROC (s_getegid, "getegid", 0, 0, 0, scm_getegid);
+#ifdef __STDC__
+SCM 
+scm_getegid (void)
+#else
+SCM 
+scm_getegid ()
+#endif
+{
+#ifdef HAVE_GETEUID
+  return SCM_MAKINUM (0L + getegid ());
+#else
+  return SCM_MAKINUM (0L + getgid ());
+#endif
+}
+
+
+SCM_PROC (s_sys_setuid, "%setuid", 1, 0, 0, scm_sys_setuid);
+#ifdef __STDC__
+SCM 
+scm_sys_setuid (SCM id)
+#else
+SCM 
+scm_sys_setuid (id)
+     SCM id;
+#endif
+{
+  SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_sys_setuid);
+  return setuid (SCM_INUM (id)) ? SCM_MAKINUM (errno) : SCM_BOOL_T;
+}
+
+SCM_PROC (s_sys_setgid, "%setgid", 1, 0, 0, scm_sys_setgid);
+#ifdef __STDC__
+SCM 
+scm_sys_setgid (SCM id)
+#else
+SCM 
+scm_sys_setgid (id)
+     SCM id;
+#endif
+{
+  SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_sys_setgid);
+  return setgid (SCM_INUM (id)) ? SCM_MAKINUM (errno) : SCM_BOOL_T;
+}
+
+SCM_PROC (s_sys_seteuid, "%seteuid", 1, 0, 0, scm_sys_seteuid);
+#ifdef __STDC__
+SCM 
+scm_sys_seteuid (SCM id)
+#else
+SCM 
+scm_sys_seteuid (id)
+     SCM id;
+#endif
+{
+  SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_sys_seteuid);
+#ifdef HAVE_SETEUID
+  return seteuid (SCM_INUM (id)) ? SCM_MAKINUM (errno) : SCM_BOOL_T;
+#else
+  return setuid (SCM_INUM (id)) ? SCM_MAKINUM (errno) : SCM_BOOL_T;
+#endif
+}
+
+SCM_PROC (s_sys_setegid, "%setegid", 1, 0, 0, scm_sys_setegid);
+#ifdef __STDC__
+SCM 
+scm_sys_setegid (SCM id)
+#else
+SCM 
+scm_sys_setegid (id)
+     SCM id;
+#endif
+{
+  SCM_ASSERT (SCM_INUMP (id), id, SCM_ARG1, s_sys_setegid);
+#ifdef HAVE_SETEUID
+  return setegid (SCM_INUM (id)) ? SCM_MAKINUM (errno) : SCM_BOOL_T;
+#else
+  return setgid (SCM_INUM (id)) ? SCM_MAKINUM (errno) : SCM_BOOL_T;
+#endif
+}
+
+SCM_PROC (s_getpgrp, "getpgrp", 0, 0, 0, scm_getpgrp);
+SCM 
+scm_getpgrp ()
+{
+  int (*fn)();
+  fn = getpgrp;
+  return SCM_MAKINUM (fn (0));
+}
+
+SCM_PROC (s_setpgid, "%setpgid", 2, 0, 0, scm_setpgid);
+SCM 
+scm_setpgid (pid, pgid)
+     SCM pid, pgid;
+{
+  SCM_ASSERT (SCM_INUMP (pid), pid, SCM_ARG1, s_setpgid);
+  SCM_ASSERT (SCM_INUMP (pgid), pgid, SCM_ARG2, s_setpgid);
+  /* This may be known as setpgrp, from BSD.  */
+  return setpgid (SCM_INUM (pid), SCM_INUM (pgid)) ? SCM_MAKINUM (errno) : SCM_BOOL_T;
+}
+
+SCM_PROC (s_setsid, "%setsid", 0, 0, 0, scm_setsid);
+SCM 
+scm_setsid ()
+{
+  pid_t sid = setsid ();
+  return (sid == -1) ? SCM_BOOL_F : SCM_MAKINUM (sid);
+}
+
+#ifndef ttyname
+extern char * ttyname();
+#endif
+
+SCM_PROC (s_ttyname, "%ttyname", 1, 0, 0, scm_ttyname);
+#ifdef __STDC__
+SCM 
+scm_ttyname (SCM port)
+#else
+SCM 
+scm_ttyname (port)
+     SCM port;
+#endif
+{
+  char *ans;
+  int fd;
+  SCM_ASSERT (SCM_NIMP (port) && SCM_OPPORTP (port), port, SCM_ARG1, s_ttyname);
+  if (scm_tc16_fport != SCM_TYP16 (port))
+    return SCM_BOOL_F;
+  fd = fileno ((FILE *)SCM_STREAM (port));
+  if (fd != -1)
+    SCM_SYSCALL (ans = ttyname (fd));
+  /* ans could be overwritten by another call to ttyname */
+  return (((fd != -1) && ans)
+	  ? scm_makfrom0str (ans)
+	  : SCM_MAKINUM (errno));
+}
+
+
+SCM_PROC (s_ctermid, "%ctermid", 0, 0, 0, scm_ctermid);
+SCM 
+scm_ctermid ()
+{
+  char *result = ctermid (NULL);
+  return *result == '\0' ? SCM_BOOL_F : scm_makfrom0str (result);
+}
+
+SCM_PROC (s_tcgetpgrp, "%tcgetpgrp", 1, 0, 0, scm_tcgetpgrp);
+SCM 
+scm_tcgetpgrp (port)
+     SCM port;
+{
+  int fd;
+  pid_t pgid;
+  SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_tcgetpgrp);
+  fd = fileno ((FILE *)SCM_STREAM (port));
+  if (fd == -1 || (pgid = tcgetpgrp (fd)) == -1)
+    return SCM_BOOL_F;
+  else
+    return SCM_MAKINUM (pgid);
+}    
+
+SCM_PROC (s_tcsetpgrp, "%tcsetpgrp", 2, 0, 0, scm_tcsetpgrp);
+SCM 
+scm_tcsetpgrp (port, pgid)
+     SCM port, pgid;
+{
+  int fd;
+  SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_tcsetpgrp);
+  SCM_ASSERT (SCM_INUMP (pgid), pgid, SCM_ARG2, s_tcsetpgrp);
+  fd = fileno ((FILE *)SCM_STREAM (port));
+  if (fd == -1 || tcsetpgrp (fd, SCM_INUM (pgid)) == -1)
+    return SCM_BOOL_F;
+  else
+    return SCM_BOOL_T;
+}    
+
+/* Copy exec args from an SCM vector into a new C array.  */
+#ifdef __STDC__
+static char **
+scm_convert_exec_args (SCM args)
+#else
+static char **
+scm_convert_exec_args (args)
+     SCM args;
+#endif
+{
+  char **execargv;
+  int num_args;
+  int i;
+  SCM_DEFER_INTS;
+  num_args = scm_ilength (args);
+  execargv = (char **) 
+    scm_must_malloc ((num_args + 1) * sizeof (char *), s_ttyname);
+  for (i = 0; SCM_NNULLP (args); args = SCM_CDR (args), ++i)
+    {
+      scm_sizet len;
+      char *dst;
+      char *src;
+      SCM_ASSERT (SCM_NIMP (SCM_CAR (args)) && SCM_ROSTRINGP (SCM_CAR (args)), SCM_CAR (args),
+	      "wrong type in SCM_ARG", "exec arg");
+      len = 1 + SCM_ROLENGTH (SCM_CAR (args));
+      dst = (char *) scm_must_malloc ((long) len, s_ttyname);
+      src = SCM_ROCHARS (SCM_CAR (args));
+      while (len--) 
+	dst[len] = src[len];
+      execargv[i] = dst;
+    }
+  execargv[i] = 0;
+  SCM_ALLOW_INTS;
+  return execargv;
+}
+
+SCM_PROC (s_sys_execl, "%execl", 0, 0, 1, scm_sys_execl);
+#ifdef __STDC__
+SCM
+scm_sys_execl (SCM args)
+#else
+SCM
+scm_sys_execl (args)
+     SCM args;
+#endif
+{
+  char **execargv;
+  SCM filename = SCM_CAR (args);
+  SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename, SCM_ARG1, s_sys_execl);
+  if (SCM_SUBSTRP (filename))
+    filename = scm_makfromstr (SCM_ROCHARS (filename), SCM_ROLENGTH (filename), 0);
+  args = SCM_CDR (args);
+  execargv = scm_convert_exec_args (args);
+  execv (SCM_ROCHARS (filename), execargv);
+  return SCM_MAKINUM (errno);
+}
+
+SCM_PROC (s_sys_execlp, "%execlp", 0, 0, 1, scm_sys_execlp);
+#ifdef __STDC__
+SCM
+scm_sys_execlp (SCM args)
+#else
+SCM
+scm_sys_execlp (args)
+     SCM args;
+#endif
+{
+  char **execargv;
+  SCM filename = SCM_CAR (args);
+  SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename, SCM_ARG1, s_sys_execlp);
+  if (SCM_SUBSTRP (filename))
+    filename = scm_makfromstr (SCM_ROCHARS (filename), SCM_ROLENGTH (filename), 0);
+  args = SCM_CDR (args);
+  execargv = scm_convert_exec_args (args);
+  execvp (SCM_ROCHARS (filename), execargv);
+  return SCM_MAKINUM (errno);
+}
+
+/* Flushing streams etc., is not done here.  */
+SCM_PROC (s_sys_fork, "%fork", 0, 0, 0, scm_sys_fork);
+#ifdef __STDC__
+SCM
+scm_sys_fork(void)
+#else
+SCM
+scm_sys_fork()
+#endif
+{
+  pid_t pid;
+  pid = fork ();
+  if (pid == -1)
+    return SCM_BOOL_F;
+  else
+    return SCM_MAKINUM (0L+pid);
+}
+
+
+SCM_PROC (s_sys_uname, "%uname", 0, 0, 0, scm_sys_uname);
+#ifdef __STDC__
+SCM 
+scm_sys_uname (void)
+#else
+SCM 
+scm_sys_uname ()
+#endif
+{
+#ifdef HAVE_UNAME
+  struct utsname buf;
+  SCM ans = scm_make_vector(SCM_MAKINUM(5), SCM_UNSPECIFIED, SCM_BOOL_F);
+  SCM *ve = SCM_VELTS (ans);
+  if (uname (&buf))
+    return SCM_MAKINUM (errno);
+  ve[0] = scm_makfrom0str (buf.sysname);
+  ve[1] = scm_makfrom0str (buf.nodename);
+  ve[2] = scm_makfrom0str (buf.release);
+  ve[3] = scm_makfrom0str (buf.version);
+  ve[4] = scm_makfrom0str (buf.machine);
+/* 
+  FIXME
+  ve[5] = scm_makfrom0str (buf.domainname);
+*/
+  return ans;
+#else
+  return SCM_MAKINUM (ENOSYS);
+#endif
+}
+
+SCM_PROC (s_environ, "environ", 0, 1, 0, scm_environ);
+#ifdef __STDC__
+SCM
+scm_environ (SCM env)
+#else
+SCM
+scm_environ (env)
+     SCM env;
+#endif
+{
+  if (SCM_UNBNDP (env))
+    return scm_makfromstrs (-1, environ);
+  else
+    {
+      int num_strings;
+      char **new_environ;
+      int i = 0;
+      SCM_ASSERT (SCM_NULLP (env) || (SCM_NIMP (env) && SCM_CONSP (env)),
+	      env, SCM_ARG1, s_environ);
+      num_strings = scm_ilength (env);
+      new_environ = (char **) scm_must_malloc ((num_strings + 1)
+					       * sizeof (char *),
+					       s_environ);
+      while (SCM_NNULLP (env))
+	{
+	  int len;
+	  char *src;
+	  SCM_ASSERT (SCM_NIMP (SCM_CAR (env)) && SCM_ROSTRINGP (SCM_CAR (env)), env, SCM_ARG1,
+		  s_environ);
+	  len = 1 + SCM_ROLENGTH (SCM_CAR (env));
+	  new_environ[i] = scm_must_malloc ((long) len, s_environ);
+	  src = SCM_ROCHARS (SCM_CAR (env));
+	  while (len--) 
+	    new_environ[i][len] = src[len];
+	  env = SCM_CDR (env);
+	  i++;
+	}
+      new_environ[i] = 0;
+      /* Free the old environment, except when called for the first
+       * time.
+       */
+      {
+	char **ep;
+	static int first = 1;
+	if (!first)
+	  {
+	    for (ep = environ; *ep != NULL; ep++)
+	      scm_must_free (*ep);
+	    scm_must_free ((char *) environ);
+	  }
+	first = 0;
+      }
+      environ = new_environ;
+      return SCM_UNSPECIFIED;
+    }
+}
+
+
+SCM_PROC (s_open_pipe, "open-pipe", 2, 0, 0, scm_open_pipe);
+#ifdef __STDC__
+SCM 
+scm_open_pipe (SCM pipestr, SCM modes)
+#else
+SCM 
+scm_open_pipe (pipestr, modes)
+     SCM pipestr;
+     SCM modes;
+#endif
+{
+  FILE *f;
+  register SCM z;
+  SCM_ASSERT (SCM_NIMP (pipestr) && SCM_ROSTRINGP (pipestr), pipestr, SCM_ARG1, s_open_pipe);
+  if (SCM_SUBSTRP (pipestr))
+    pipestr = scm_makfromstr (SCM_ROCHARS (pipestr), SCM_ROLENGTH (pipestr), 0);
+  SCM_ASSERT (SCM_NIMP (modes) && SCM_ROSTRINGP (modes), modes, SCM_ARG2, s_open_pipe);
+  if (SCM_SUBSTRP (modes))
+    modes = scm_makfromstr (SCM_ROCHARS (modes), SCM_ROLENGTH (modes), 0);
+  SCM_NEWCELL (z);
+  SCM_DEFER_INTS;
+  scm_ignore_signals ();
+  SCM_SYSCALL (f = popen (SCM_ROCHARS (pipestr), SCM_ROCHARS (modes)));
+  scm_unignore_signals ();
+  if (!f)
+    z = SCM_BOOL_F;
+  else
+    {
+      struct scm_port_table * pt;
+      pt = scm_add_to_port_table (z);
+      SCM_SETPTAB_ENTRY (z, pt);
+      SCM_CAR (z) = scm_tc16_pipe | SCM_OPN | (strchr (SCM_ROCHARS (modes), 'r') ? SCM_RDNG : SCM_WRTNG);
+      SCM_SETSTREAM (z, (SCM)f);
+    }
+  SCM_ALLOW_INTS;
+  return z;
+}
+
+
+SCM_PROC (s_open_input_pipe, "open-input-pipe", 1, 0, 0, scm_open_input_pipe);
+#ifdef __STDC__
+SCM
+scm_open_input_pipe(SCM pipestr)
+#else
+SCM
+scm_open_input_pipe(pipestr)
+     SCM pipestr;
+#endif
+{
+  return scm_open_pipe(pipestr, scm_makfromstr("r", (sizeof "r")-1, 0));
+}
+
+SCM_PROC (s_open_output_pipe, "open-output-pipe", 1, 0, 0, scm_open_output_pipe);
+#ifdef __STDC__
+SCM
+scm_open_output_pipe(SCM pipestr)
+#else
+SCM
+scm_open_output_pipe(pipestr)
+     SCM pipestr;
+#endif
+{
+  return scm_open_pipe(pipestr, scm_makfromstr("w", (sizeof "w")-1, 0));
+}
+
+
+#ifdef __EMX__
+#include <sys/utime.h>
+#else
+#include <utime.h>
+#endif
+
+SCM_PROC (s_sys_utime, "%utime", 1, 2, 0, scm_sys_utime);
+#ifdef __STDC__
+SCM 
+scm_sys_utime (SCM pathname, SCM actime, SCM modtime)
+#else
+SCM 
+scm_sys_utime (pathname, actime, modtime)
+     SCM pathname;
+     SCM actime;
+     SCM modtime;
+#endif
+{
+  int rv;
+  struct utimbuf utm_tmp;
+
+  SCM_ASSERT (SCM_NIMP (pathname) && SCM_STRINGP (pathname), pathname, SCM_ARG1, s_sys_utime);
+
+  if (SCM_UNBNDP (actime))
+    SCM_SYSCALL (time (&utm_tmp.actime));
+  else
+    utm_tmp.actime = scm_num2ulong (actime, (char *) SCM_ARG2, s_sys_utime);
+
+  if (SCM_UNBNDP (modtime))
+    SCM_SYSCALL (time (&utm_tmp.modtime));
+  else
+    utm_tmp.modtime = scm_num2ulong (modtime, (char *) SCM_ARG3, s_sys_utime);
+
+  SCM_SYSCALL (rv = utime (SCM_CHARS (pathname), &utm_tmp));
+  return rv ? SCM_MAKINUM (errno) : SCM_BOOL_T;
+}
+
+
+
+
+
+SCM_PROC (s_sys_access, "access?", 2, 0, 0, scm_sys_access);
+#ifdef __STDC__
+SCM 
+scm_sys_access (SCM path, SCM how)
+#else
+SCM 
+scm_sys_access (path, how)
+     SCM path;
+     SCM how;
+#endif
+{
+  int rv;
+
+  SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1, s_sys_access);
+  if (SCM_SUBSTRP (path))
+    path = scm_makfromstr (SCM_ROCHARS (path), SCM_ROLENGTH (path), 0);
+  SCM_ASSERT (SCM_INUMP (how), how, SCM_ARG2, s_sys_access);
+  rv = access (SCM_ROCHARS (path), SCM_INUM (how));
+  return rv ? SCM_BOOL_F : SCM_BOOL_T;
+}
+
+
+
+SCM_PROC (s_getpid, "getpid", 0, 0, 0, scm_getpid);
+#ifdef __STDC__
+SCM 
+scm_getpid (void)
+#else
+SCM 
+scm_getpid ()
+#endif
+{
+  return SCM_MAKINUM ((unsigned long) getpid ());
+}
+
+
+SCM_PROC (s_sys_putenv, "%putenv", 1, 0, 0, scm_sys_putenv);
+#ifdef __STDC__
+SCM
+scm_sys_putenv (SCM str)
+#else
+SCM
+scm_sys_putenv (str)
+     SCM str;
+#endif
+{
+#ifdef HAVE_PUTENV
+  SCM_ASSERT (SCM_NIMP (str) && SCM_STRINGP (str), str, SCM_ARG1, s_sys_putenv);
+  return putenv (SCM_CHARS (str)) ? SCM_MAKINUM (errno) : SCM_BOOL_T;
+#else
+  return SCM_MAKINUM (ENOSYS);
+#endif
+}
+
+
+SCM_PROC (s_read_line, "read-line", 0, 2, 0, scm_read_line);
+#ifdef __STDC__
+SCM 
+scm_read_line (SCM port, SCM include_terminator)
+#else
+SCM 
+scm_read_line (port, include_terminator)
+     SCM port;
+     SCM include_terminator;
+#endif
+{
+  register int c;
+  register int j = 0;
+  scm_sizet len = 30;
+  SCM tok_buf;
+  register char *p;
+  int include;
+
+  tok_buf = scm_makstr ((long) len, 0);
+  p = SCM_CHARS (tok_buf);
+  if (SCM_UNBNDP (port))
+    port = scm_cur_inp;
+  else
+    SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), port, SCM_ARG1, s_read_line);
+
+  if (SCM_UNBNDP (include_terminator))
+    include = 0;
+  else
+    include = SCM_NFALSEP (include_terminator);
+
+  if (EOF == (c = scm_gen_getc (port)))
+    return SCM_EOF_VAL;
+  while (1)
+    {
+      switch (c)
+	{
+	case SCM_LINE_INCREMENTORS:
+	  if (j >= len)
+	    {
+	      p = scm_grow_tok_buf (&tok_buf);
+	      len = SCM_LENGTH (tok_buf);
+	    }
+	  p[j++] = c;
+	  /* fallthrough */
+	case EOF:
+	  if (len == j)
+	    return tok_buf;
+	  return scm_vector_set_length_x (tok_buf, (SCM) SCM_MAKINUM (j));
+
+	default:
+	  if (j >= len)
+	    {
+	      p = scm_grow_tok_buf (&tok_buf);
+	      len = SCM_LENGTH (tok_buf);
+	    }
+	  p[j++] = c;
+	  c = scm_gen_getc (port);
+	  break;
+	}
+    }
+}
+
+
+
+SCM_PROC (s_read_line_x, "read-line!", 1, 1, 0, scm_read_line_x);
+#ifdef __STDC__
+SCM 
+scm_read_line_x (SCM str, SCM port)
+#else
+SCM 
+scm_read_line_x (str, port)
+     SCM str;
+     SCM port;
+#endif
+{
+  register int c;
+  register int j = 0;
+  register char *p;
+  scm_sizet len;
+  SCM_ASSERT (SCM_NIMP (str) && SCM_STRINGP (str), str, SCM_ARG1, s_read_line_x);
+  p = SCM_CHARS (str);
+  len = SCM_LENGTH (str);
+  if SCM_UNBNDP
+    (port) port = scm_cur_inp;
+  else
+    SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), port, SCM_ARG2, s_read_line_x);
+  c = scm_gen_getc (port);
+  if (EOF == c)
+    return SCM_EOF_VAL;
+  while (1)
+    {
+      switch (c)
+	{
+	case SCM_LINE_INCREMENTORS:
+	case EOF:
+	  return SCM_MAKINUM (j);
+	default:
+	  if (j >= len)
+	    {
+	      scm_gen_ungetc (c, port);
+	      return SCM_BOOL_F;
+	    }
+	  p[j++] = c;
+	  c = scm_gen_getc (port);
+	}
+    }
+}
+
+
+
+SCM_PROC (s_write_line, "write-line", 1, 1, 0, scm_write_line);
+#ifdef __STDC__
+SCM 
+scm_write_line (SCM obj, SCM port)
+#else
+SCM 
+scm_write_line (obj, port)
+     SCM obj;
+     SCM port;
+#endif
+{
+  scm_display (obj, port);
+  return scm_newline (port);
+}
+
+
+
+SCM_PROC (s_setlocale, "%setlocale", 1, 1, 0, scm_setlocale);
+#ifdef __STDC__
+SCM
+scm_setlocale (SCM category, SCM locale)
+#else
+SCM
+scm_setlocale (category, locale)
+     SCM category;
+     SCM locale;
+#endif
+{
+#ifdef HAVE_SETLOCALE
+  char *clocale;
+  char *rv;
+
+  SCM_ASSERT (SCM_INUMP (category), category, SCM_ARG1, s_setlocale);
+  if (SCM_UNBNDP (locale))
+    {
+      clocale = NULL;
+    }
+  else
+    {
+      SCM_ASSERT (SCM_NIMP (locale) && SCM_STRINGP (locale), locale, SCM_ARG2, s_setlocale);
+      clocale = SCM_CHARS (locale);
+    }
+
+  rv = setlocale (SCM_INUM (category), clocale);
+  return rv ? scm_makfrom0str (rv) : SCM_MAKINUM (errno);
+#else
+  /* setlocale not available.  */
+  return SCM_MAKINUM (errno);
+#endif
+}
+
+SCM_PROC (s_strftime, "strftime", 2, 0, 0, scm_strftime);
+#ifdef __STDC__
+SCM
+scm_strftime (SCM format, SCM stime)
+#else
+SCM
+scm_strftime (format, stime)
+     SCM format;
+     SCM stime;
+#endif
+{
+  struct tm t;
+
+  char *tbuf;
+  int n;
+  int size = 50;
+  char *fmt;
+  int len;
+
+  SCM_ASSERT (SCM_NIMP (format) && SCM_STRINGP (format), format, SCM_ARG1, s_strftime);
+  SCM_ASSERT (SCM_NIMP (stime) && SCM_VECTORP (stime) && scm_obj_length (stime) == 9,
+	  stime, SCM_ARG2, s_strftime);
+
+  fmt = SCM_ROCHARS (format);
+  len = SCM_ROLENGTH (format);
+
+#define tm_deref scm_num2long (SCM_VELTS (stime)[n++], (char *)SCM_ARG2, s_strftime)
+  n = 0;
+  t.tm_sec = tm_deref;
+  t.tm_min = tm_deref;
+  t.tm_hour = tm_deref;
+  t.tm_mday = tm_deref;
+  t.tm_mon = tm_deref;
+  t.tm_year = tm_deref;
+  /* not used by mktime.
+     t.tm_wday = tm_deref;
+     t.tm_yday = tm_deref; */
+  t.tm_isdst = tm_deref;
+#undef tm_deref
+
+  /* fill in missing fields and set the timezone.  */
+  mktime (&t);
+
+  tbuf = scm_must_malloc (size, s_strftime);
+  while ((len = strftime (tbuf, size, fmt, &t)) == size)
+    {
+      scm_must_free (tbuf);
+      size *= 2;
+      tbuf = scm_must_malloc (size, s_strftime);
+    }
+  return scm_makfromstr (tbuf, len, 0);
+}
+
+
+
+SCM_PROC (s_sys_strptime, "%strptime", 2, 0, 0, scm_sys_strptime);
+#ifdef __STDC__
+SCM
+scm_sys_strptime (SCM format, SCM string)
+#else
+SCM
+scm_sys_strptime (format, string)
+     SCM format;
+     SCM string;
+#endif
+{
+#ifdef HAVE_STRPTIME
+  SCM stime;
+  struct tm t;
+
+  char *fmt, *str, *rest;
+  int len;
+  int n;
+
+  SCM_ASSERT (SCM_NIMP (format) && SCM_ROSTRINGP (format), format, SCM_ARG1, s_sys_strptime);
+  if (SCM_SUBSTRP (format))
+    format =  scm_makfromstr (SCM_ROCHARS (format), SCM_ROLENGTH (format), 0);
+  SCM_ASSERT (SCM_NIMP (string) && SCM_ROSTRINGP (string), string, SCM_ARG2, s_sys_strptime);
+  if (SCM_SUBSTRP (string))
+    string =  scm_makfromstr (SCM_ROCHARS (string), SCM_ROLENGTH (string), 0);
+
+  fmt = SCM_CHARS (format);
+  str = SCM_CHARS (string);
+
+  /* initialize the struct tm */
+#define tm_init(field) t.field = 0
+  tm_init (tm_sec);
+  tm_init (tm_min);
+  tm_init (tm_hour);
+  tm_init (tm_mday);
+  tm_init (tm_mon);
+  tm_init (tm_year);
+  tm_init (tm_wday);
+  tm_init (tm_yday);
+  tm_init (tm_isdst);
+#undef tm_init
+
+  SCM_DEFER_INTS;
+  rest = strptime (str, fmt, &t);
+  SCM_ALLOW_INTS;
+
+  if (rest == NULL) {
+    return SCM_BOOL_F;
+  }
+
+  stime = scm_make_vector (SCM_MAKINUM (9), scm_long2num (0), SCM_UNDEFINED);
+
+#define stime_set(val) scm_vector_set_x (stime, SCM_MAKINUM (n++), scm_long2num (t.val));
+  n = 0;
+  stime_set (tm_sec);
+  stime_set (tm_min);
+  stime_set (tm_hour);
+  stime_set (tm_mday);
+  stime_set (tm_mon);
+  stime_set (tm_year);
+  stime_set (tm_wday);
+  stime_set (tm_yday);
+  stime_set (tm_isdst);
+#undef stime_set
+
+  return scm_cons (stime, scm_makfrom0str (rest));
+#else
+  scm_wta (SCM_UNSPECIFIED, "strptime is not available and no replacement has (yet) been supplied", "strptime");
+  return SCM_BOOL_F;
+#endif
+}
+
+SCM_PROC (s_sys_mknod, "%mknod", 3, 0, 0, scm_sys_mknod);
+#ifdef __STDC__
+SCM
+scm_sys_mknod(SCM path, SCM mode, SCM dev)
+#else
+SCM
+scm_sys_mknod(path, mode, dev)
+     SCM path;
+     SCM mode;
+     SCM dev;
+#endif
+{
+#ifdef HAVE_MKNOD
+  int val;
+  SCM_ASSERT(SCM_NIMP(path) && SCM_STRINGP(path), path, SCM_ARG1, s_sys_mknod);
+  SCM_ASSERT(SCM_INUMP(mode), mode, SCM_ARG2, s_sys_mknod);
+  SCM_ASSERT(SCM_INUMP(dev), dev, SCM_ARG3, s_sys_mknod);
+  SCM_SYSCALL(val = mknod(SCM_CHARS(path), SCM_INUM(mode), SCM_INUM(dev)));
+  return val ? SCM_BOOL_F : SCM_BOOL_T;
+#else
+  return SCM_BOOL_F;
+#endif
+}
+
+
+SCM_PROC (s_sys_nice, "%nice", 1, 0, 0, scm_sys_nice);
+#ifdef __STDC__
+SCM
+scm_sys_nice(SCM incr)
+#else
+SCM
+scm_sys_nice(incr)
+     SCM incr;
+#endif
+{
+#ifdef HAVE_NICE
+  SCM_ASSERT(SCM_INUMP(incr), incr, SCM_ARG1, s_sys_nice);
+  return nice(SCM_INUM(incr)) ? SCM_MAKINUM (errno) : SCM_BOOL_T;
+#else
+  return SCM_MAKINUM (ENOSYS);
+#endif
+}
+
+
+SCM_PROC (s_sync, "sync", 0, 0, 0, scm_sync);
+#ifdef __STDC__
+SCM
+scm_sync(void)
+#else
+SCM
+scm_sync()
+#endif
+{
+#ifdef HAVE_SYNC
+  sync();
+#endif
+  return SCM_UNSPECIFIED;
+}
+
+
+
+#ifdef __STDC__
+void 
+scm_init_posix (void)
+#else
+void 
+scm_init_posix ()
+#endif
+{
+  scm_add_feature ("posix");
+#ifdef HAVE_GETEUID
+  scm_add_feature ("EIDs");
+#endif
+#ifdef WAIT_ANY
+  scm_sysintern ("WAIT_ANY", SCM_MAKINUM (WAIT_ANY));
+#endif
+#ifdef WAIT_MYPGRP
+  scm_sysintern ("WAIT_MYPGRP", SCM_MAKINUM (WAIT_MYPGRP));
+#endif
+#ifdef WNOHANG
+  scm_sysintern ("WNOHANG", SCM_MAKINUM (WNOHANG));
+#endif
+#ifdef WUNTRACED
+  scm_sysintern ("WUNTRACED", SCM_MAKINUM (WUNTRACED));
+#endif
+
+#ifdef EINTR
+  scm_sysintern ("EINTR", SCM_MAKINUM (EINTR));
+#endif
+
+#ifdef SIGHUP
+  scm_sysintern ("SIGHUP", SCM_MAKINUM (SIGHUP));
+#endif
+#ifdef SIGINT
+  scm_sysintern ("SIGINT", SCM_MAKINUM (SIGINT));
+#endif
+#ifdef SIGQUIT
+  scm_sysintern ("SIGQUIT", SCM_MAKINUM (SIGQUIT));
+#endif
+#ifdef SIGILL
+  scm_sysintern ("SIGILL", SCM_MAKINUM (SIGILL));
+#endif
+#ifdef SIGTRAP
+  scm_sysintern ("SIGTRAP", SCM_MAKINUM (SIGTRAP));
+#endif
+#ifdef SIGABRT
+  scm_sysintern ("SIGABRT", SCM_MAKINUM (SIGABRT));
+#endif
+#ifdef SIGIOT
+  scm_sysintern ("SIGIOT", SCM_MAKINUM (SIGIOT));
+#endif
+#ifdef SIGBUS
+  scm_sysintern ("SIGBUS", SCM_MAKINUM (SIGBUS));
+#endif
+#ifdef SIGFPE
+  scm_sysintern ("SIGFPE", SCM_MAKINUM (SIGFPE));
+#endif
+#ifdef SIGKILL
+  scm_sysintern ("SIGKILL", SCM_MAKINUM (SIGKILL));
+#endif
+#ifdef SIGUSR1
+  scm_sysintern ("SIGUSR1", SCM_MAKINUM (SIGUSR1));
+#endif
+#ifdef SIGSEGV
+  scm_sysintern ("SIGSEGV", SCM_MAKINUM (SIGSEGV));
+#endif
+#ifdef SIGUSR2
+  scm_sysintern ("SIGUSR2", SCM_MAKINUM (SIGUSR2));
+#endif
+#ifdef SIGPIPE
+  scm_sysintern ("SIGPIPE", SCM_MAKINUM (SIGPIPE));
+#endif
+#ifdef SIGALRM
+  scm_sysintern ("SIGALRM", SCM_MAKINUM (SIGALRM));
+#endif
+#ifdef SIGTERM
+  scm_sysintern ("SIGTERM", SCM_MAKINUM (SIGTERM));
+#endif
+#ifdef SIGSTKFLT
+  scm_sysintern ("SIGSTKFLT", SCM_MAKINUM (SIGSTKFLT));
+#endif
+#ifdef SIGCHLD
+  scm_sysintern ("SIGCHLD", SCM_MAKINUM (SIGCHLD));
+#endif
+#ifdef SIGCONT
+  scm_sysintern ("SIGCONT", SCM_MAKINUM (SIGCONT));
+#endif
+#ifdef SIGSTOP
+  scm_sysintern ("SIGSTOP", SCM_MAKINUM (SIGSTOP));
+#endif
+#ifdef SIGTSTP
+  scm_sysintern ("SIGTSTP", SCM_MAKINUM (SIGTSTP));
+#endif
+#ifdef SIGTTIN
+  scm_sysintern ("SIGTTIN", SCM_MAKINUM (SIGTTIN));
+#endif
+#ifdef SIGTTOU
+  scm_sysintern ("SIGTTOU", SCM_MAKINUM (SIGTTOU));
+#endif
+#ifdef SIGIO
+  scm_sysintern ("SIGIO", SCM_MAKINUM (SIGIO));
+#endif
+#ifdef SIGPOLL
+  scm_sysintern ("SIGPOLL", SCM_MAKINUM (SIGPOLL));
+#endif
+#ifdef SIGURG
+  scm_sysintern ("SIGURG", SCM_MAKINUM (SIGURG));
+#endif
+#ifdef SIGXCPU
+  scm_sysintern ("SIGXCPU", SCM_MAKINUM (SIGXCPU));
+#endif
+#ifdef SIGXFSZ
+  scm_sysintern ("SIGXFSZ", SCM_MAKINUM (SIGXFSZ));
+#endif
+#ifdef SIGVTALRM
+  scm_sysintern ("SIGVTALRM", SCM_MAKINUM (SIGVTALRM));
+#endif
+#ifdef SIGPROF
+  scm_sysintern ("SIGPROF", SCM_MAKINUM (SIGPROF));
+#endif
+#ifdef SIGWINCH
+  scm_sysintern ("SIGWINCH", SCM_MAKINUM (SIGWINCH));
+#endif
+#ifdef SIGLOST
+  scm_sysintern ("SIGLOST", SCM_MAKINUM (SIGLOST));
+#endif
+#ifdef SIGPWR
+  scm_sysintern ("SIGPWR", SCM_MAKINUM (SIGPWR));
+#endif
+  /* access() symbols.  */
+  scm_sysintern ("R_OK", SCM_MAKINUM (R_OK));
+  scm_sysintern ("W_OK", SCM_MAKINUM (W_OK));
+  scm_sysintern ("X_OK", SCM_MAKINUM (X_OK));
+  scm_sysintern ("F_OK", SCM_MAKINUM (F_OK));
+
+#ifdef LC_COLLATE
+  scm_sysintern ("LC_COLLATE", SCM_MAKINUM (LC_COLLATE));
+#endif
+#ifdef LC_CTYPE
+  scm_sysintern ("LC_CTYPE", SCM_MAKINUM (LC_CTYPE));
+#endif
+#ifdef LC_MONETARY
+  scm_sysintern ("LC_MONETARY", SCM_MAKINUM (LC_MONETARY));
+#endif
+#ifdef LC_NUMERIC
+  scm_sysintern ("LC_NUMERIC", SCM_MAKINUM (LC_NUMERIC));
+#endif
+#ifdef LC_TIME
+  scm_sysintern ("LC_TIME", SCM_MAKINUM (LC_TIME));
+#endif
+#ifdef LC_MESSAGES
+  scm_sysintern ("LC_MESSAGES", SCM_MAKINUM (LC_MESSAGES));
+#endif
+#ifdef LC_ALL
+  scm_sysintern ("LC_ALL", SCM_MAKINUM (LC_ALL));
+#endif
+#include "posix.x"
+}
diff --git a/libguile/posix.h b/libguile/posix.h
new file mode 100644
index 000000000..2bef059c8
--- /dev/null
+++ b/libguile/posix.h
@@ -0,0 +1,145 @@
+/* classes: h_files */
+
+#ifndef POSIXH
+#define POSIXH
+/*	Copyright (C) 1995 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+
+
+
+
+
+#ifdef __STDC__
+extern SCM scm_sys_pipe (void);
+extern SCM scm_sys_getgroups(void);
+extern SCM scm_sys_getpwuid (SCM user);
+extern SCM scm_setpwent (SCM arg);
+extern SCM scm_sys_getgrgid (SCM name);
+extern SCM scm_setgrent (SCM arg);
+extern SCM scm_sys_kill (SCM pid, SCM sig);
+extern SCM scm_sys_waitpid (SCM pid, SCM options);
+extern SCM scm_getppid (void);
+extern SCM scm_getuid (void);
+extern SCM scm_getgid (void);
+extern SCM scm_geteuid (void);
+extern SCM scm_getegid (void);
+extern SCM scm_sys_setuid (SCM id);
+extern SCM scm_sys_setgid (SCM id);
+extern SCM scm_sys_seteuid (SCM id);
+extern SCM scm_sys_setegid (SCM id);
+extern SCM scm_ttyname (SCM port);
+extern SCM scm_sys_execl (SCM args);
+extern SCM scm_sys_execlp (SCM args);
+extern SCM scm_sys_fork(void);
+extern SCM scm_sys_uname (void);
+extern SCM scm_environ (SCM env);
+extern SCM scm_open_pipe (SCM pipestr, SCM modes);
+extern SCM scm_open_input_pipe(SCM pipestr);
+extern SCM scm_open_output_pipe(SCM pipestr);
+extern SCM scm_sys_utime (SCM pathname, SCM actime, SCM modtime);
+extern SCM scm_sys_access (SCM path, SCM how);
+extern SCM scm_getpid (void);
+extern SCM scm_sys_putenv (SCM str);
+extern SCM scm_read_line (SCM port, SCM include_terminator);
+extern SCM scm_read_line_x (SCM str, SCM port);
+extern SCM scm_write_line (SCM obj, SCM port);
+extern SCM scm_setlocale (SCM category, SCM locale);
+extern SCM scm_strftime (SCM format, SCM stime);
+extern SCM scm_sys_strptime (SCM format, SCM string);
+extern SCM scm_sys_mknod(SCM path, SCM mode, SCM dev);
+extern SCM scm_sys_nice(SCM incr);
+extern SCM scm_sync(void);
+extern void scm_init_posix (void);
+
+#else /* STDC */
+extern SCM scm_sys_pipe ();
+extern SCM scm_sys_getgroups();
+extern SCM scm_sys_getpwuid ();
+extern SCM scm_setpwent ();
+extern SCM scm_sys_getgrgid ();
+extern SCM scm_setgrent ();
+extern SCM scm_sys_kill ();
+extern SCM scm_sys_waitpid ();
+extern SCM scm_getppid ();
+extern SCM scm_getuid ();
+extern SCM scm_getgid ();
+extern SCM scm_geteuid ();
+extern SCM scm_getegid ();
+extern SCM scm_sys_setuid ();
+extern SCM scm_sys_setgid ();
+extern SCM scm_sys_seteuid ();
+extern SCM scm_sys_setegid ();
+extern SCM scm_ttyname ();
+extern SCM scm_sys_execl ();
+extern SCM scm_sys_execlp ();
+extern SCM scm_sys_fork();
+extern SCM scm_sys_uname ();
+extern SCM scm_environ ();
+extern SCM scm_open_pipe ();
+extern SCM scm_open_input_pipe();
+extern SCM scm_open_output_pipe();
+extern SCM scm_sys_utime ();
+extern SCM scm_sys_access ();
+extern SCM scm_getpid ();
+extern SCM scm_sys_putenv ();
+extern SCM scm_read_line ();
+extern SCM scm_read_line_x ();
+extern SCM scm_write_line ();
+extern SCM scm_setlocale ();
+extern SCM scm_strftime ();
+extern SCM scm_sys_strptime ();
+extern SCM scm_sys_mknod();
+extern SCM scm_sys_nice();
+extern SCM scm_sync();
+extern void scm_init_posix ();
+
+#endif /* STDC */
+
+
+
+
+
+
+
+#endif  /* POSIXH */
diff --git a/libguile/print.c b/libguile/print.c
new file mode 100644
index 000000000..0877f2ace
--- /dev/null
+++ b/libguile/print.c
@@ -0,0 +1,570 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+
+
+
+/* {Names of immediate symbols}
+ * 
+ * This table must agree with the declarations in scm.h: {Immediate Symbols}.
+ */
+
+char *scm_isymnames[] =
+{
+  /* This table must agree with the declarations */
+  "#@and",
+  "#@begin",
+  "#@case",
+  "#@cond",
+  "#@do",
+  "#@if",
+  "#@lambda",
+  "#@let",
+  "#@let*",
+  "#@letrec",
+  "#@or",
+  "#@quote",
+  "#@set!",
+  "#@define",
+#if 0
+  "#@literal-variable-ref",
+  "#@literal-variable-set!",
+#endif
+  "#@apply",
+  "#@call-with-current-continuation",
+
+ /* user visible ISYMS */
+ /* other keywords */
+ /* Flags */
+
+  "#f",
+  "#t",
+  "#<undefined>",
+  "#<eof>",
+  "()",
+  "#<unspecified>"
+};
+
+
+/* {Printing of Scheme Objects}
+ */
+
+/* Print generally.  Handles both write and display according to WRITING.
+ */
+#ifdef __STDC__
+void 
+scm_iprin1 (SCM exp, SCM port, int writing)
+#else
+void 
+scm_iprin1 (exp, port, writing)
+     SCM exp;
+     SCM port;
+     int writing;
+#endif
+{
+  register long i;
+taloop:
+  switch (7 & (int) exp)
+    {
+    case 2:
+    case 6:
+      scm_intprint (SCM_INUM (exp), 10, port);
+      break;
+    case 4:
+      if (SCM_ICHRP (exp))
+	{
+	  i = SCM_ICHR (exp);
+	  scm_put_wchar (i, port, writing);
+
+	}
+      else if (   SCM_IFLAGP (exp)
+	       && (SCM_ISYMNUM (exp) < (sizeof scm_isymnames / sizeof (char *))))
+	  scm_gen_puts (scm_regular_string, SCM_ISYMSCM_CHARS (exp), port);
+      else if (SCM_ILOCP (exp))
+	{
+	  scm_gen_puts (scm_regular_string, "#@", port);
+	  scm_intprint ((long) SCM_IFRAME (exp), 10, port);
+	  scm_gen_putc (SCM_ICDRP (exp) ? '-' : '+', port);
+	  scm_intprint ((long) SCM_IDIST (exp), 10, port);
+	}
+      else
+	goto idef;
+      break;
+    case 1:
+      /* gloc */
+      scm_gen_puts (scm_regular_string, "#@", port);
+      exp = SCM_CAR (exp - 1);
+      goto taloop;
+    default:
+    idef:
+      scm_ipruk ("immediate", exp, port);
+      break;
+    case 0:
+      switch (SCM_TYP7 (exp))
+	{
+	case scm_tcs_cons_gloc:
+
+	  if (SCM_CDR (SCM_CAR (exp) - 1L) == 0)
+	    {
+	      scm_gen_write (scm_regular_string, "#<struct ", (scm_sizet) 9, port);
+	      scm_intprint(exp, 16, port);
+	      scm_gen_putc ('>', port);
+	      break;
+	    }
+
+	case scm_tcs_cons_imcar:
+	case scm_tcs_cons_nimcar:
+	  scm_iprlist ("(", exp, ')', port, writing);
+	  break;
+	case scm_tcs_closures:
+#ifdef DEBUG_EXTENSIONS
+	  if (PRINT_PROCNAMES)
+	    {
+	      SCM name;
+	      name = scm_procedure_property (exp, scm_i_name);
+	      scm_gen_puts (scm_regular_string, "#<procedure", port);
+	      if (SCM_NFALSEP (name))
+		{
+		  scm_gen_putc (' ', port);
+		  /* FIXME */
+		  scm_gen_puts (scm_regular_string, SCM_CHARS (name), port);
+		}
+	      scm_gen_putc ('>', port);
+	    }
+	  else
+#endif
+	    {
+	      exp = SCM_CODE (exp);
+	      scm_iprlist ("#<CLOSURE ", exp, '>', port, writing);
+	    }
+	  break;
+	case scm_tc7_mb_string:
+	case scm_tc7_mb_substring:
+	  scm_print_mb_string (exp, port, writing);
+	  break;
+	case scm_tc7_substring:
+	case scm_tc7_string:
+	  if (writing)
+	    {
+	      scm_gen_putc ('\"', port);
+	      for (i = 0; i < SCM_ROLENGTH (exp); ++i)
+		switch (SCM_ROCHARS (exp)[i])
+		  {
+		  case '\"':
+		  case '\\':
+		    scm_gen_putc ('\\', port);
+		  default:
+		    scm_gen_putc (SCM_ROCHARS (exp)[i], port);
+		  }
+	      scm_gen_putc ('\"', port);
+	      break;
+	    }
+	  else
+	    scm_gen_write (scm_regular_string, SCM_ROCHARS (exp),
+			   (scm_sizet) SCM_ROLENGTH (exp),
+			   port);
+	  break;
+	case scm_tcs_symbols:
+	  if (SCM_MB_STRINGP (exp))
+	    {
+	      scm_print_mb_symbol (exp, port);
+	      break;
+	    }
+	  else
+	    {
+	      int pos;
+	      int end;
+	      int len;
+	      char * str;
+	      int weird;
+	      int maybe_weird;
+	      int mw_pos;
+
+	      len = SCM_LENGTH (exp);
+	      str = SCM_CHARS (exp);
+	      scm_remember (&exp);
+	      pos = 0;
+	      weird = 0;
+	      maybe_weird = 0;
+
+	      if (len == 0)
+		scm_gen_write (scm_regular_string, "#{}#", 4, port);
+
+	      for (end = pos; end < len; ++end)
+		switch (str[end])
+		  {
+#ifdef BRACKETS_AS_PARENS
+		  case '[':
+		  case ']':
+#endif
+		  case '(':
+		  case ')':
+		  case '\"':
+		  case ';':
+		  case SCM_WHITE_SPACES:
+		  case SCM_LINE_INCREMENTORS:
+		  weird_handler:
+		    if (maybe_weird)
+		      {
+			end = mw_pos;
+			maybe_weird = 0;
+		      }
+		    if (!weird)
+		      {
+			scm_gen_write (scm_regular_string, "#{", 2, port);
+			weird = 1;
+		      }
+		    if (pos < end)
+		      {
+			scm_gen_write (scm_regular_string, str + pos, end - pos, port);
+		      }
+		    {
+		      char buf[2];
+		      buf[0] = '\\';
+		      buf[1] = str[end];
+		      scm_gen_write (scm_regular_string, buf, 2, port);
+		    }
+		    pos = end + 1;
+		    break;
+		  case '\\':
+		    if (weird)
+		      goto weird_handler;
+		    if (!maybe_weird)
+		      {
+			maybe_weird = 1;
+			mw_pos = pos;
+		      }
+		    break;
+		  case '}':
+		  case '#':
+		    if (weird)
+		      goto weird_handler;
+		    break;
+		  default:
+		    break;
+		  }
+	      if (pos < end)
+		scm_gen_write (scm_regular_string, str + pos, end - pos, port);
+	      if (weird)
+		scm_gen_write (scm_regular_string, "}#", 2, port);
+	      break;
+	    }
+	case scm_tc7_wvect:
+	  if (SCM_IS_WHVEC (exp))
+	    scm_gen_puts (scm_regular_string, "#wh(", port);
+	  else
+	    scm_gen_puts (scm_regular_string, "#w(", port);
+	  goto common_vector_printer;
+
+	case scm_tc7_vector:
+	  scm_gen_puts (scm_regular_string, "#(", port);
+	common_vector_printer:
+	  for (i = 0; i + 1 < SCM_LENGTH (exp); ++i)
+	    {
+	      /* CHECK_INTS; */
+	      scm_iprin1 (SCM_VELTS (exp)[i], port, writing);
+	      scm_gen_putc (' ', port);
+	    }
+	  if (i < SCM_LENGTH (exp))
+	    {
+	      /* CHECK_INTS; */
+	      scm_iprin1 (SCM_VELTS (exp)[i], port, writing);
+	    }
+	  scm_gen_putc (')', port);
+	  break;
+	case scm_tc7_bvect:
+	case scm_tc7_byvect:
+	case scm_tc7_svect:
+	case scm_tc7_ivect:
+	case scm_tc7_uvect:
+	case scm_tc7_fvect:
+	case scm_tc7_dvect:
+	case scm_tc7_cvect:
+#ifdef LONGLONGS
+	case scm_tc7_llvect:
+#endif
+	  scm_raprin1 (exp, port, writing);
+	  break;
+	case scm_tcs_subrs:
+	  scm_gen_puts (scm_regular_string, "#<primitive-procedure ", port);
+	  scm_gen_puts ((SCM_MB_STRINGP (SCM_SNAME(exp))
+			 ? scm_mb_string
+			 : scm_regular_string),
+			SCM_CHARS (SCM_SNAME (exp)), port);
+	  scm_gen_putc ('>', port);
+	  break;
+#ifdef CCLO
+	case scm_tc7_cclo:
+	  scm_gen_puts (scm_regular_string, "#<compiled-closure ", port);
+	  scm_iprin1 (SCM_CCLO_SUBR (exp), port, writing);
+	  scm_gen_putc ('>', port);
+	  break;
+#endif
+	case scm_tc7_contin:
+	  scm_gen_puts (scm_regular_string, "#<continuation ", port);
+	  scm_intprint (SCM_LENGTH (exp), 10, port);
+	  scm_gen_puts (scm_regular_string, " @ ", port);
+	  scm_intprint ((long) SCM_CHARS (exp), 16, port);
+	  scm_gen_putc ('>', port);
+	  break;
+	case scm_tc7_port:
+	  i = SCM_PTOBNUM (exp);
+	  if (i < scm_numptob && scm_ptobs[i].print && (scm_ptobs[i].print) (exp, port, writing))
+	    break;
+	  goto punk;
+	case scm_tc7_smob:
+	  i = SCM_SMOBNUM (exp);
+	  if (i < scm_numsmob && scm_smobs[i].print
+	      && (scm_smobs[i].print) (exp, port, writing))
+	    break;
+	  goto punk;
+	default:
+	punk:scm_ipruk ("type", exp, port);
+	}
+    }
+}
+
+
+/* Print an integer.
+ */
+#ifdef __STDC__
+void 
+scm_intprint (long n, int radix, SCM port)
+#else
+void 
+scm_intprint (n, radix, port)
+     long n;
+     int radix;
+     SCM port;
+#endif
+{
+  char num_buf[SCM_INTBUFLEN];
+  scm_gen_write (scm_regular_string, num_buf, scm_iint2str (n, radix, num_buf), port);
+}
+
+/* Print an object of unrecognized type.
+ */
+#ifdef __STDC__
+void 
+scm_ipruk (char *hdr, SCM ptr, SCM port)
+#else
+void 
+scm_ipruk (hdr, ptr, port)
+     char *hdr;
+     SCM ptr;
+     SCM port;
+#endif
+{
+  scm_gen_puts (scm_regular_string, "#<unknown-", port);
+  scm_gen_puts (scm_regular_string, hdr, port);
+  if (SCM_CELLP (ptr))
+    {
+      scm_gen_puts (scm_regular_string, " (0x", port);
+      scm_intprint (SCM_CAR (ptr), 16, port);
+      scm_gen_puts (scm_regular_string, " . 0x", port);
+      scm_intprint (SCM_CDR (ptr), 16, port);
+      scm_gen_puts (scm_regular_string, ") @", port);
+    }
+  scm_gen_puts (scm_regular_string, " 0x", port);
+  scm_intprint (ptr, 16, port);
+  scm_gen_putc ('>', port);
+}
+
+/* Print a list.
+ */
+#ifdef __STDC__
+void 
+scm_iprlist (char *hdr, SCM exp, char tlr, SCM port, int writing)
+#else
+void 
+scm_iprlist (hdr, exp, tlr, port, writing)
+     char *hdr;
+     SCM exp;
+     char tlr;
+     SCM port;
+     int writing;
+#endif
+{
+  scm_gen_puts (scm_regular_string, hdr, port);
+  /* CHECK_INTS; */
+  scm_iprin1 (SCM_CAR (exp), port, writing);
+  exp = SCM_CDR (exp);
+  for (; SCM_NIMP (exp); exp = SCM_CDR (exp))
+    {
+      if (SCM_NECONSP (exp))
+	break;
+      scm_gen_putc (' ', port);
+      /* CHECK_INTS; */
+      scm_iprin1 (SCM_CAR (exp), port, writing);
+    }
+  if (SCM_NNULLP (exp))
+    {
+      scm_gen_puts (scm_regular_string, " . ", port);
+      scm_iprin1 (exp, port, writing);
+    }
+  scm_gen_putc (tlr, port);
+}
+
+
+
+SCM_PROC(s_write, "write", 1, 1, 0, scm_write);
+#ifdef __STDC__
+SCM 
+scm_write (SCM obj, SCM port)
+#else
+SCM 
+scm_write (obj, port)
+     SCM obj;
+     SCM port;
+#endif
+{
+  if (SCM_UNBNDP (port))
+    port = scm_cur_outp;
+  else
+    SCM_ASSERT (SCM_NIMP (port) && SCM_OPOUTPORTP (port), port, SCM_ARG2, s_write);
+  scm_iprin1 (obj, port, 1);
+#ifdef HAVE_PIPE
+# ifdef EPIPE
+  if (EPIPE == errno)
+    scm_close_port (port);
+# endif
+#endif
+  return SCM_UNSPECIFIED;
+}
+
+
+SCM_PROC(s_display, "display", 1, 1, 0, scm_display);
+#ifdef __STDC__
+SCM 
+scm_display (SCM obj, SCM port)
+#else
+SCM 
+scm_display (obj, port)
+     SCM obj;
+     SCM port;
+#endif
+{
+  if (SCM_UNBNDP (port))
+    port = scm_cur_outp;
+  else
+    SCM_ASSERT (SCM_NIMP (port) && SCM_OPOUTPORTP (port), port, SCM_ARG2, s_display);
+  scm_iprin1 (obj, port, 0);
+#ifdef HAVE_PIPE
+# ifdef EPIPE
+  if (EPIPE == errno)
+    scm_close_port (port);
+# endif
+#endif
+  return SCM_UNSPECIFIED;
+}
+
+SCM_PROC(s_newline, "newline", 0, 1, 0, scm_newline);
+#ifdef __STDC__
+SCM
+scm_newline(SCM port)
+#else
+SCM 
+scm_newline (port)
+     SCM port;
+#endif
+{
+  if (SCM_UNBNDP (port))
+ port = scm_cur_outp;
+  else
+    SCM_ASSERT (SCM_NIMP (port) && SCM_OPOUTPORTP (port), port, SCM_ARG1, s_newline);
+  scm_gen_putc ('\n', port);
+#ifdef HAVE_PIPE
+# ifdef EPIPE
+  if (EPIPE == errno)
+    scm_close_port (port);
+  else
+# endif
+#endif
+  if (port == scm_cur_outp)
+    scm_fflush (port);
+  return SCM_UNSPECIFIED;
+}
+
+SCM_PROC(s_write_char, "write-char", 1, 1, 0, scm_write_char);
+#ifdef __STDC__
+SCM 
+scm_write_char (SCM chr, SCM port)
+#else
+SCM 
+scm_write_char (chr, port)
+     SCM chr;
+     SCM port;
+#endif
+{
+  if (SCM_UNBNDP (port))
+ port = scm_cur_outp;
+  else
+    SCM_ASSERT (SCM_NIMP (port) && SCM_OPOUTPORTP (port), port, SCM_ARG2, s_write_char);
+  SCM_ASSERT (SCM_ICHRP (chr), chr, SCM_ARG1, s_write_char);
+  scm_gen_putc ((int) SCM_ICHR (chr), port);
+#ifdef HAVE_PIPE
+# ifdef EPIPE
+  if (EPIPE == errno)
+    scm_close_port (port);
+# endif
+#endif
+  return SCM_UNSPECIFIED;
+}
+
+
+
+
+#ifdef __STDC__
+void
+scm_init_print (void)
+#else
+void
+scm_init_print ()
+#endif
+{
+#include "print.x"
+}
+
diff --git a/libguile/print.h b/libguile/print.h
new file mode 100644
index 000000000..ae23eaf00
--- /dev/null
+++ b/libguile/print.h
@@ -0,0 +1,74 @@
+/* classes: h_files */
+
+#ifndef PRINTH
+#define PRINTH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+
+
+#ifdef __STDC__
+extern void scm_intprint (long n, int radix, SCM port);
+extern void scm_ipruk (char *hdr, SCM ptr, SCM port);
+extern void scm_iprlist (char *hdr, SCM exp, char tlr, SCM port, int writing);
+extern void scm_iprin1 (SCM exp, SCM port, int writing);
+extern SCM scm_write (SCM obj, SCM port);
+extern SCM scm_display (SCM obj, SCM port);
+extern SCM scm_newline(SCM port);
+extern SCM scm_write_char (SCM chr, SCM port);
+extern void scm_init_print (void);
+
+#else /* STDC */
+extern void scm_intprint ();
+extern void scm_ipruk ();
+extern void scm_iprlist ();
+extern void scm_iprin1 ();
+extern SCM scm_write ();
+extern SCM scm_display ();
+extern SCM scm_newline();
+extern SCM scm_write_char ();
+extern void scm_init_print ();
+
+#endif /* STDC */
+
+#endif  /* PRINTH */
diff --git a/libguile/procprop.c b/libguile/procprop.c
new file mode 100644
index 000000000..a984008db
--- /dev/null
+++ b/libguile/procprop.c
@@ -0,0 +1,155 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+
+static SCM
+scm_stand_in_scm_proc(proc)
+     SCM proc;
+{
+  SCM answer;
+  answer = scm_assoc (proc, scm_stand_in_procs);
+  if (answer == SCM_BOOL_F)
+    {
+      answer = scm_closure (scm_listify (SCM_EOL, SCM_BOOL_F, SCM_UNDEFINED),
+			    SCM_EOL);
+      scm_stand_in_procs = scm_cons (scm_cons (proc, answer),
+				     scm_stand_in_procs);
+    }
+  else
+    answer = SCM_CDR (answer);
+  return answer;
+}
+
+SCM_PROC(s_procedure_properties, "procedure-properties", 1, 0, 0, scm_procedure_properties);
+#ifdef __STDC__
+SCM
+scm_procedure_properties (SCM proc)
+#else
+SCM
+scm_procedure_properties (proc)
+     SCM proc;
+#endif
+{
+  SCM_ASSERT (scm_procedure_p (proc), proc, SCM_ARG1, s_procedure_properties);
+  if (!(SCM_NIMP (proc) && SCM_CLOSUREP (proc)))
+    proc = scm_stand_in_scm_proc(proc);
+  return SCM_PROCPROPS (proc);
+}
+
+SCM_PROC(s_set_procedure_properties_x, "set-procedure-properties!", 2, 0, 0, scm_set_procedure_properties_x);
+#ifdef __STDC__
+SCM
+scm_set_procedure_properties_x (SCM proc, SCM new_val)
+#else
+SCM
+scm_set_procedure_properties_x (proc, new_val)
+     SCM proc;
+     SCM new_val;
+#endif
+{
+  if (!(SCM_NIMP (proc) && SCM_CLOSUREP (proc)))
+    proc = scm_stand_in_scm_proc(proc);
+  SCM_ASSERT (SCM_NIMP (proc) && SCM_CLOSUREP (proc), proc, SCM_ARG1, s_set_procedure_properties_x);
+  SCM_PROCPROPS (proc) = new_val;
+  return SCM_UNSPECIFIED;
+}
+
+SCM_PROC(s_procedure_property, "procedure-property", 2, 0, 0, scm_procedure_property);
+#ifdef __STDC__
+SCM
+scm_procedure_property (SCM p, SCM k)
+#else
+SCM
+scm_procedure_property (p, k)
+     SCM p;
+     SCM k;
+#endif
+{
+  SCM assoc;
+  if (!(SCM_NIMP (p) && SCM_CLOSUREP (p)))
+    p = scm_stand_in_scm_proc(p);
+  SCM_ASSERT (scm_procedure_p (p), p, SCM_ARG1, s_procedure_property);
+  assoc = scm_sloppy_assq (k, SCM_PROCPROPS (p));
+  return (SCM_NIMP (assoc) ? SCM_CDR (assoc) : SCM_BOOL_F);
+}
+
+SCM_PROC(s_set_procedure_property_x, "set-procedure-property!", 3, 0, 0, scm_set_procedure_property_x);
+#ifdef __STDC__
+SCM
+scm_set_procedure_property_x (SCM p, SCM k, SCM v)
+#else
+SCM
+scm_set_procedure_property_x (p, k, v)
+     SCM p;
+     SCM k;
+     SCM v;
+#endif
+{
+  SCM assoc;
+  if (!(SCM_NIMP (p) && SCM_CLOSUREP (p)))
+    p = scm_stand_in_scm_proc(p);
+  SCM_ASSERT (SCM_NIMP (p) && SCM_CLOSUREP (p), p, SCM_ARG1, s_set_procedure_property_x);
+  assoc = scm_sloppy_assq (k, SCM_PROCPROPS (p));
+  if (SCM_NIMP (assoc))
+    SCM_SETCDR (assoc, v);
+  else
+    SCM_PROCPROPS (p) = scm_acons (k, v, SCM_PROCPROPS (p));
+  return SCM_UNSPECIFIED;
+}
+
+
+
+#ifdef __STDC__
+void
+scm_init_procprop (void)
+#else
+void
+scm_init_procprop ()
+#endif
+{
+#include "procprop.x"
+}
+
diff --git a/libguile/procprop.h b/libguile/procprop.h
new file mode 100644
index 000000000..ee6f37cb3
--- /dev/null
+++ b/libguile/procprop.h
@@ -0,0 +1,72 @@
+/* classes: h_files */
+
+#ifndef PROCPROPH
+#define PROCPROPH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+
+
+
+
+
+
+#ifdef __STDC__
+extern SCM scm_procedure_properties (SCM proc);
+extern SCM scm_set_procedure_properties_x (SCM proc, SCM new_val);
+extern SCM scm_procedure_property (SCM p, SCM k);
+extern SCM scm_set_procedure_property_x (SCM p, SCM k, SCM v);
+extern void scm_init_procprop (void);
+
+#else /* STDC */
+extern SCM scm_procedure_properties ();
+extern SCM scm_set_procedure_properties_x ();
+extern SCM scm_procedure_property ();
+extern SCM scm_set_procedure_property_x ();
+extern void scm_init_procprop ();
+
+#endif /* STDC */
+
+
+
+#endif  /* PROCPROPH */
diff --git a/libguile/procs.c b/libguile/procs.c
new file mode 100644
index 000000000..6c5a5b2c4
--- /dev/null
+++ b/libguile/procs.c
@@ -0,0 +1,177 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+
+
+
+/* {Procedures}
+ */
+
+#ifdef __STDC__
+SCM 
+scm_make_subr_opt (char *name, int type, SCM (*fcn) (), int set)
+#else
+SCM 
+scm_make_subr_opt (name, type, fcn, set)
+     char *name;
+     int type;
+     SCM (*fcn) ();
+     int set;
+#endif
+{
+  SCM symcell;
+  long tmp;
+  register SCM z;
+  symcell = scm_sysintern (name, SCM_UNDEFINED);
+  tmp = ((((SCM_CELLPTR) (SCM_CAR (symcell))) - scm_heap_org) << 8);
+  if ((tmp >> 8) != ((SCM_CELLPTR) (SCM_CAR (symcell)) - scm_heap_org))
+    tmp = 0;
+  SCM_NEWCELL (z);
+  SCM_SUBRF (z) = fcn;
+  SCM_CAR (z) = tmp + type;
+  if (set)
+    SCM_CDR (symcell) = z;
+  return z;
+}
+
+
+#ifdef __STDC__
+SCM 
+scm_make_subr (char *name, int type, SCM (*fcn) ())
+#else
+SCM 
+scm_make_subr (name, type, fcn)
+     char *name;
+     int type;
+     SCM (*fcn) ();
+#endif
+{
+  return scm_make_subr_opt (name, type, fcn, 1);
+}
+
+#ifdef CCLO
+#ifdef __STDC__
+SCM 
+scm_makcclo (SCM proc, long len)
+#else
+SCM 
+scm_makcclo (proc, len)
+     SCM proc;
+     long len;
+#endif
+{
+  SCM s;
+  SCM_NEWCELL (s);
+  SCM_DEFER_INTS;
+  SCM_SETCHARS (s, scm_must_malloc (len * sizeof (SCM), "compiled-closure"));
+  SCM_SETLENGTH (s, len, scm_tc7_cclo);
+  while (--len)
+    SCM_VELTS (s)[len] = SCM_UNSPECIFIED;
+  SCM_CCLO_SUBR (s) = proc;
+  SCM_ALLOW_INTS;
+  return s;
+}
+#endif
+
+
+
+SCM_PROC(s_procedure_p, "procedure?", 1, 0, 0, scm_procedure_p);
+#ifdef __STDC__
+SCM 
+scm_procedure_p (SCM obj)
+#else
+SCM 
+scm_procedure_p (obj)
+     SCM obj;
+#endif
+{
+  if (SCM_NIMP (obj))
+    switch (SCM_TYP7 (obj))
+      {
+      case scm_tcs_closures:
+      case scm_tc7_contin:
+      case scm_tcs_subrs:
+#ifdef CCLO
+      case scm_tc7_cclo:
+#endif
+	return SCM_BOOL_T;
+      default:
+	return SCM_BOOL_F;
+      }
+  return SCM_BOOL_F;
+}
+
+
+#ifdef __STDC__
+void
+scm_init_iprocs(scm_iproc *subra, int type)
+#else
+void
+scm_init_iprocs(subra, type)
+     scm_iproc *subra;
+     int type;
+#endif
+{
+  for(;subra->scm_string; subra++)
+    scm_make_subr(subra->scm_string,
+		  type,
+		  subra->cproc);
+}
+
+
+
+
+#ifdef __STDC__
+void
+scm_init_procs (void)
+#else
+void
+scm_init_procs ()
+#endif
+{
+#include "procs.x"
+}
+
diff --git a/libguile/procs.h b/libguile/procs.h
new file mode 100644
index 000000000..332e06c1f
--- /dev/null
+++ b/libguile/procs.h
@@ -0,0 +1,107 @@
+/* classes: h_files */
+
+#ifndef PROCSH
+#define PROCSH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+
+
+
+
+/* Subrs 
+ */
+
+typedef struct scm_subr
+{
+  long sname;
+  SCM (*cproc) ();
+} scm_subr;
+
+typedef struct scm_iproc
+{
+  char *scm_string;
+  SCM (*cproc) ();
+} scm_iproc;
+
+typedef struct scm_dsubr
+{
+  long sname;
+  double (*dproc) ();
+} scm_dsubr;
+
+#define SCM_SNAME(x) ((SCM_CAR(x)>>8)?(SCM)(scm_heap_org+(SCM_CAR(x)>>8)):scm_nullstr)
+#define SCM_SUBRF(x) (((scm_subr *)(SCM2PTR(x)))->cproc)
+#define SCM_DSUBRF(x) (((scm_dsubr *)(SCM2PTR(x)))->dproc)
+#define SCM_CCLO_SUBR(x) (SCM_VELTS(x)[0])
+
+/* Closures
+ */
+
+#define SCM_CLOSUREP(x) (SCM_TYP3(x)==scm_tc3_closure)
+#define SCM_CLOSCAR(x) (SCM_CAR(x)-scm_tc3_closure)
+#define SCM_CODE(x) SCM_CAR(SCM_CLOSCAR (x))
+#define SCM_PROCPROPS(x) SCM_CDR(SCM_CLOSCAR (x))
+#define SCM_SETCODE(x, e) SCM_CAR(x) = (scm_cons ((e), SCM_EOL) + scm_tc3_closure)
+#define SCM_ENV(x) SCM_CDR(x)
+#define SCM_TOP_LEVEL(SCM_ENV)  (SCM_NULLP(SCM_ENV) || (SCM_BOOL_T == scm_procedure_p (SCM_CAR (SCM_ENV))))
+
+
+
+
+#ifdef __STDC__
+extern SCM scm_make_subr (char *name, int type, SCM (*fcn) ());
+extern SCM scm_makcclo (SCM proc, long len);
+extern SCM scm_procedure_p (SCM obj);
+extern void scm_init_iprocs(scm_iproc *subra, int type);
+extern void scm_init_procs (void);
+
+#else /* STDC */
+extern SCM scm_make_subr ();
+extern SCM scm_makcclo ();
+extern SCM scm_procedure_p ();
+extern void scm_init_iprocs();
+extern void scm_init_procs ();
+
+#endif /* STDC */
+#endif  /* PROCSH */
diff --git a/libguile/ramap.c b/libguile/ramap.c
new file mode 100644
index 000000000..a913da0e6
--- /dev/null
+++ b/libguile/ramap.c
@@ -0,0 +1,2229 @@
+/*	Copyright (C) 1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+
+
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+
+#ifdef ARRAYS
+
+typedef struct
+{
+  char *name;
+  SCM sproc;
+  int (*vproc) ();
+} ra_iproc;
+
+static ra_iproc ra_rpsubrs[];
+static ra_iproc ra_asubrs[];
+
+#define BVE_REF(a, i) ((SCM_VELTS(a)[(i)/SCM_LONG_BIT] & (1L<<((i)%SCM_LONG_BIT))) ? 1 : 0)
+#define BVE_SET(a, i) (SCM_VELTS(a)[(i)/SCM_LONG_BIT] |= (1L<<((i)%SCM_LONG_BIT)))
+#define BVE_CLR(a, i) (SCM_VELTS(a)[(i)/SCM_LONG_BIT] &= ~(1L<<((i)%SCM_LONG_BIT)))
+
+/* Fast, recycling scm_vector ref */
+#define RVREF(ra, i, e) (e = scm_cvref(ra, i, e))
+
+/* #define RVREF(ra, i, e) (scm_cvref(ra, i, SCM_UNDEFINED)) to turn off */
+
+/* IVDEP means "ignore scm_vector dependencies", meaning we guarantee that
+   elements of scm_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. */
+
+#ifdef __STDC__
+static scm_sizet 
+cind (SCM ra, SCM inds)
+#else
+static scm_sizet 
+cind (ra, inds)
+     SCM ra;
+     SCM inds;
+#endif
+{
+  scm_sizet i;
+  int k;
+  long *ve = SCM_VELTS (inds);
+  if (!SCM_ARRAYP (ra))
+    return *ve;
+  i = SCM_ARRAY_BASE (ra);
+  for (k = 0; k < SCM_ARRAY_NDIM (ra); k++)
+    i += (ve[k] - SCM_ARRAY_DIMS (ra)[k].lbnd) * SCM_ARRAY_DIMS (ra)[k].inc;
+  return i;
+}
+
+
+/* Checker for scm_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.
+   */
+#ifdef __STDC__
+int 
+scm_ra_matchp (SCM ra0, SCM ras)
+#else
+int 
+scm_ra_matchp (ra0, ras)
+     SCM ra0;
+     SCM ras;
+#endif
+{
+  SCM ra1;
+  scm_array_dim dims;
+  scm_array_dim *s0 = &dims;
+  scm_array_dim *s1;
+  scm_sizet bas0 = 0;
+  int i, ndim = 1;
+  int exact = 2			/* 4 */ ;	/* Don't care about values >2 (yet?) */
+  if SCM_IMP
+    (ra0) return 0;
+  switch (SCM_TYP7 (ra0))
+      {
+      default:
+	return 0;
+      case scm_tc7_vector:
+      case scm_tc7_string:
+      case scm_tc7_bvect:
+      case scm_tc7_uvect:
+      case scm_tc7_ivect:
+      case scm_tc7_fvect:
+      case scm_tc7_dvect:
+      case scm_tc7_cvect:
+	s0->lbnd = 0;
+	s0->inc = 1;
+	s0->ubnd = (long) SCM_LENGTH (ra0) - 1;
+	break;
+      case scm_tc7_smob:
+	if (!SCM_ARRAYP (ra0))
+	  return 0;
+	ndim = SCM_ARRAY_NDIM (ra0);
+	s0 = SCM_ARRAY_DIMS (ra0);
+	bas0 = SCM_ARRAY_BASE (ra0);
+	break;
+      }
+  while SCM_NIMP
+    (ras)
+      {
+	ra1 = SCM_CAR (ras);
+	if SCM_IMP
+	  (ra1) return 0;
+	switch SCM_TYP7
+	  (ra1)
+	    {
+	    default:
+	      return 0;
+	    case scm_tc7_vector:
+	    case scm_tc7_string:
+	    case scm_tc7_bvect:
+	    case scm_tc7_uvect:
+	    case scm_tc7_ivect:
+	    case scm_tc7_fvect:
+	    case scm_tc7_dvect:
+	    case scm_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 == SCM_LENGTH (ra1) - 1))
+		    break;
+		  exact = 1;
+		case 1:
+		  if (s0->lbnd < 0 || s0->ubnd >= SCM_LENGTH (ra1))
+		    return 0;
+		}
+	      break;
+	    case scm_tc7_smob:
+	      if (!SCM_ARRAYP (ra1) || ndim != SCM_ARRAY_NDIM (ra1))
+		return 0;
+	      s1 = SCM_ARRAY_DIMS (ra1);
+	      if (bas0 != SCM_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)
+		      return (s0[i].lbnd <= s0[i].ubnd ? 0 : 1);
+		  }
+	      break;
+	    }
+	ras = SCM_CDR (ras);
+      }
+  return exact;
+}
+
+static char s_ra_mismatch[] = "array shape mismatch";
+
+#ifdef __STDC__
+int 
+scm_ramapc (int (*cproc) (), SCM data, SCM ra0, SCM lra, char *what)
+#else
+int 
+scm_ramapc (cproc, data, ra0, lra, what)
+     int (*cproc) ();
+     SCM data;
+     SCM ra0;
+     SCM lra;
+     char *what;
+#endif
+{
+  SCM inds, z;
+  SCM vra0, ra1, vra1;
+  SCM lvra, *plvra;
+  long *vinds;
+  int k, kmax;
+  switch (scm_ra_matchp (ra0, lra))
+    {
+    default:
+    case 0:
+      scm_wta (ra0, s_ra_mismatch, what);
+    case 2:
+    case 3:
+    case 4:			/* Try unrolling arrays */
+      kmax = (SCM_ARRAYP (ra0) ? SCM_ARRAY_NDIM (ra0) - 1 : 0);
+      if (kmax < 0)
+	goto gencase;
+      vra0 = scm_array_contents (ra0, SCM_UNDEFINED);
+      if SCM_IMP
+	(vra0) goto gencase;
+      if (!SCM_ARRAYP (vra0))
+	{
+	  vra1 = scm_make_ra (1);
+	  SCM_ARRAY_BASE (vra1) = 0;
+	  SCM_ARRAY_DIMS (vra1)->lbnd = 0;
+	  SCM_ARRAY_DIMS (vra1)->ubnd = SCM_LENGTH (vra0) - 1;
+	  SCM_ARRAY_DIMS (vra1)->inc = 1;
+	  SCM_ARRAY_V (vra1) = vra0;
+	  vra0 = vra1;
+	}
+      lvra = SCM_EOL;
+      plvra = &lvra;
+      for (z = lra; SCM_NIMP (z); z = SCM_CDR (z))
+	{
+	  ra1 = SCM_CAR (z);
+	  vra1 = scm_make_ra (1);
+	  SCM_ARRAY_DIMS (vra1)->lbnd = SCM_ARRAY_DIMS (vra0)->lbnd;
+	  SCM_ARRAY_DIMS (vra1)->ubnd = SCM_ARRAY_DIMS (vra0)->ubnd;
+	  if (!SCM_ARRAYP (ra1))
+	    {
+	      SCM_ARRAY_BASE (vra1) = 0;
+	      SCM_ARRAY_DIMS (vra1)->inc = 1;
+	      SCM_ARRAY_V (vra1) = ra1;
+	    }
+	  else if (!SCM_ARRAY_CONTP (ra1))
+	    goto gencase;
+	  else
+	    {
+	      SCM_ARRAY_BASE (vra1) = SCM_ARRAY_BASE (ra1);
+	      SCM_ARRAY_DIMS (vra1)->inc = SCM_ARRAY_DIMS (ra1)[kmax].inc;
+	      SCM_ARRAY_V (vra1) = SCM_ARRAY_V (ra1);
+	    }
+	  *plvra = scm_cons (vra1, SCM_EOL);
+	  plvra = &SCM_CDR (*plvra);
+	}
+      return (SCM_UNBNDP (data) ? cproc(vra0, lvra) : cproc(vra0, data, lvra));
+    case 1:
+    gencase:			/* Have to loop over all dimensions. */
+      vra0 = scm_make_ra (1);
+      if SCM_ARRAYP
+	(ra0)
+	  {
+	    kmax = SCM_ARRAY_NDIM (ra0) - 1;
+	    if (kmax < 0)
+	      {
+		SCM_ARRAY_DIMS (vra0)->lbnd = 0;
+		SCM_ARRAY_DIMS (vra0)->ubnd = 0;
+		SCM_ARRAY_DIMS (vra0)->inc = 1;
+	      }
+	    else
+	      {
+		SCM_ARRAY_DIMS (vra0)->lbnd = SCM_ARRAY_DIMS (ra0)[kmax].lbnd;
+		SCM_ARRAY_DIMS (vra0)->ubnd = SCM_ARRAY_DIMS (ra0)[kmax].ubnd;
+		SCM_ARRAY_DIMS (vra0)->inc = SCM_ARRAY_DIMS (ra0)[kmax].inc;
+	      }
+	    SCM_ARRAY_BASE (vra0) = SCM_ARRAY_BASE (ra0);
+	    SCM_ARRAY_V (vra0) = SCM_ARRAY_V (ra0);
+	  }
+      else
+	{
+	  kmax = 0;
+	  SCM_ARRAY_DIMS (vra0)->lbnd = 0;
+	  SCM_ARRAY_DIMS (vra0)->ubnd = SCM_LENGTH (ra0) - 1;
+	  SCM_ARRAY_DIMS (vra0)->inc = 1;
+	  SCM_ARRAY_BASE (vra0) = 0;
+	  SCM_ARRAY_V (vra0) = ra0;
+	  ra0 = vra0;
+	}
+      lvra = SCM_EOL;
+      plvra = &lvra;
+      for (z = lra; SCM_NIMP (z); z = SCM_CDR (z))
+	{
+	  ra1 = SCM_CAR (z);
+	  vra1 = scm_make_ra (1);
+	  SCM_ARRAY_DIMS (vra1)->lbnd = SCM_ARRAY_DIMS (vra0)->lbnd;
+	  SCM_ARRAY_DIMS (vra1)->ubnd = SCM_ARRAY_DIMS (vra0)->ubnd;
+	  if SCM_ARRAYP
+	    (ra1)
+	      {
+		if (kmax >= 0)
+		  SCM_ARRAY_DIMS (vra1)->inc = SCM_ARRAY_DIMS (ra1)[kmax].inc;
+		SCM_ARRAY_V (vra1) = SCM_ARRAY_V (ra1);
+	      }
+	  else
+	    {
+	      SCM_ARRAY_DIMS (vra1)->inc = 1;
+	      SCM_ARRAY_V (vra1) = ra1;
+	    }
+	  *plvra = scm_cons (vra1, SCM_EOL);
+	  plvra = &SCM_CDR (*plvra);
+	}
+      inds = scm_make_uve (SCM_ARRAY_NDIM (ra0), SCM_MAKINUM (-1L));
+      vinds = (long *) SCM_VELTS (inds);
+      for (k = 0; k <= kmax; k++)
+	vinds[k] = SCM_ARRAY_DIMS (ra0)[k].lbnd;
+      k = kmax;
+      do
+	{
+	  if (k == kmax)
+	    {
+	      SCM y = lra;
+	      SCM_ARRAY_BASE (vra0) = cind (ra0, inds);
+	      for (z = lvra; SCM_NIMP (z); z = SCM_CDR (z), y = SCM_CDR (y))
+		SCM_ARRAY_BASE (SCM_CAR (z)) = cind (SCM_CAR (y), inds);
+	      if (0 == (SCM_UNBNDP (data) ? cproc(vra0, lvra) : cproc(vra0, data, lvra)))
+		return 0;
+	      k--;
+	      continue;
+	    }
+	  if (vinds[k] < SCM_ARRAY_DIMS (ra0)[k].ubnd)
+	    {
+	      vinds[k]++;
+	      k++;
+	      continue;
+	    }
+	  vinds[k] = SCM_ARRAY_DIMS (ra0)[k].lbnd - 1;
+	  k--;
+	}
+      while (k >= 0);
+      return 1;
+    }
+}
+
+
+static char s_array_fill_x[];
+#ifdef __STDC__
+int 
+scm_array_fill_int (SCM ra, SCM fill, SCM ignore)
+#else
+int 
+scm_array_fill_int (ra, fill, ignore)
+     SCM ra;
+     SCM fill;
+     SCM ignore;
+#endif
+{
+  scm_sizet i, n = SCM_ARRAY_DIMS (ra)->ubnd - SCM_ARRAY_DIMS (ra)->lbnd + 1;
+  long inc = SCM_ARRAY_DIMS (ra)->inc;
+  scm_sizet base = SCM_ARRAY_BASE (ra);
+  ra = SCM_ARRAY_V (ra);
+  switch SCM_TYP7
+    (ra)
+      {
+      default:
+	for (i = base; n--; i += inc)
+	  scm_array_set_x (ra, fill, SCM_MAKINUM (i));
+	break;
+      case scm_tc7_vector:
+	for (i = base; n--; i += inc)
+	  SCM_VELTS (ra)[i] = fill;
+	break;
+      case scm_tc7_string:
+	SCM_ASRTGO (SCM_ICHRP (fill), badarg2);
+	for (i = base; n--; i += inc)
+	  SCM_CHARS (ra)[i] = SCM_ICHR (fill);
+	break;
+      case scm_tc7_bvect:
+	{
+	  long *ve = (long *) SCM_VELTS (ra);
+	  if (1 == inc && (n >= SCM_LONG_BIT || n == SCM_LENGTH (ra)))
+	    {
+	      i = base / SCM_LONG_BIT;
+	      if (SCM_BOOL_F == fill)
+		{
+		  if (base % SCM_LONG_BIT) /* leading partial word */
+		    ve[i++] &= ~(~0L << (base % SCM_LONG_BIT));
+		  for (; i < (base + n) / SCM_LONG_BIT; i++)
+		    ve[i] = 0L;
+		  if ((base + n) % SCM_LONG_BIT) /* trailing partial word */
+		    ve[i] &= (~0L << ((base + n) % SCM_LONG_BIT));
+		}
+	      else if (SCM_BOOL_T == fill)
+		{
+		  if (base % SCM_LONG_BIT)
+		    ve[i++] |= ~0L << (base % SCM_LONG_BIT);
+		  for (; i < (base + n) / SCM_LONG_BIT; i++)
+		    ve[i] = ~0L;
+		  if ((base + n) % SCM_LONG_BIT)
+		    ve[i] |= ~(~0L << ((base + n) % SCM_LONG_BIT));
+		}
+	      else
+	      badarg2:scm_wta (fill, (char *) SCM_ARG2, s_array_fill_x);
+	    }
+	  else
+	    {
+	      if (SCM_BOOL_F == fill)
+		for (i = base; n--; i += inc)
+		  ve[i / SCM_LONG_BIT] &= ~(1L << (i % SCM_LONG_BIT));
+	      else if (SCM_BOOL_T == fill)
+		for (i = base; n--; i += inc)
+		  ve[i / SCM_LONG_BIT] |= (1L << (i % SCM_LONG_BIT));
+	      else
+		goto badarg2;
+	    }
+	  break;
+	}
+      case scm_tc7_uvect:
+	SCM_ASRTGO (0 <= SCM_INUM (fill), badarg2);
+      case scm_tc7_ivect:
+	SCM_ASRTGO (SCM_INUMP (fill), badarg2);
+	{
+	  long f = SCM_INUM (fill), *ve = (long *) SCM_VELTS (ra);
+	  for (i = base; n--; i += inc)
+	    ve[i] = f;
+	  break;
+	}
+#ifdef SCM_FLOATS
+#ifdef SCM_SINGLES
+      case scm_tc7_fvect:
+	{
+	  float f, *ve = (float *) SCM_VELTS (ra);
+	  SCM_ASRTGO (SCM_NIMP (fill) && SCM_REALP (fill), badarg2);
+	  f = SCM_REALPART (fill);
+	  for (i = base; n--; i += inc)
+	    ve[i] = f;
+	  break;
+	}
+#endif /* SCM_SINGLES */
+      case scm_tc7_dvect:
+	{
+	  double f, *ve = (double *) SCM_VELTS (ra);
+	  SCM_ASRTGO (SCM_NIMP (fill) && SCM_REALP (fill), badarg2);
+	  f = SCM_REALPART (fill);
+	  for (i = base; n--; i += inc)
+	    ve[i] = f;
+	  break;
+	}
+      case scm_tc7_cvect:
+	{
+	  double fr, fi;
+	  double (*ve)[2] = (double (*)[2]) SCM_VELTS (ra);
+	  SCM_ASRTGO (SCM_NIMP (fill) && SCM_INEXP (fill), badarg2);
+	  fr = SCM_REALPART (fill);
+	  fi = (SCM_CPLXP (fill) ? SCM_IMAG (fill) : 0.0);
+	  for (i = base; n--; i += inc)
+	    {
+	      ve[i][0] = fr;
+	      ve[i][1] = fi;
+	    }
+	  break;
+	}
+#endif /* SCM_FLOATS */
+      }
+  return 1;
+}
+
+SCM_PROC(s_array_fill_x, "array-fill!", 2, 0, 0, scm_array_fill_x);
+#ifdef __STDC__
+SCM 
+scm_array_fill_x (SCM ra, SCM fill)
+#else
+SCM 
+scm_array_fill_x (ra, fill)
+     SCM ra;
+     SCM fill;
+#endif
+{
+  scm_ramapc (scm_array_fill_int, fill, ra, SCM_EOL, s_array_fill_x);
+  return SCM_UNSPECIFIED;
+}
+
+
+
+#ifdef __STDC__
+static int 
+racp (SCM dst, SCM src)
+#else
+static int 
+racp (src, dst)
+     SCM dst;
+     SCM src;
+#endif
+{
+  long n = (SCM_ARRAY_DIMS (src)->ubnd - SCM_ARRAY_DIMS (src)->lbnd + 1);
+  long inc_d, inc_s = SCM_ARRAY_DIMS (src)->inc;
+  scm_sizet i_d, i_s = SCM_ARRAY_BASE (src);
+  dst = SCM_CAR (dst);
+  inc_d = SCM_ARRAY_DIMS (dst)->inc;
+  i_d = SCM_ARRAY_BASE (dst);
+  src = SCM_ARRAY_V (src);
+  dst = SCM_ARRAY_V (dst);
+  switch SCM_TYP7
+    (dst)
+      {
+      default:
+      gencase: case scm_tc7_vector:
+	for (; n-- > 0; i_s += inc_s, i_d += inc_d)
+	  scm_array_set_x (dst, scm_cvref (src, i_s, SCM_UNDEFINED), SCM_MAKINUM (i_d));
+	break;
+      case scm_tc7_string:
+	if (scm_tc7_string != SCM_TYP7 (dst))
+	  goto gencase;
+	for (; n-- > 0; i_s += inc_s, i_d += inc_d)
+	  SCM_CHARS (dst)[i_d] = SCM_CHARS (src)[i_s];
+	break;
+      case scm_tc7_bvect:
+	if (scm_tc7_bvect != SCM_TYP7 (dst))
+	  goto gencase;
+	if (1 == inc_d && 1 == inc_s && i_s % SCM_LONG_BIT == i_d % SCM_LONG_BIT && n >= SCM_LONG_BIT)
+	  {
+	    long *sv = (long *) SCM_VELTS (src);
+	    long *dv = (long *) SCM_VELTS (dst);
+	    sv += i_s / SCM_LONG_BIT;
+	    dv += i_d / SCM_LONG_BIT;
+	    if (i_s % SCM_LONG_BIT)
+	      {			/* leading partial word */
+		*dv = (*dv & ~(~0L << (i_s % SCM_LONG_BIT))) | (*sv & (~0L << (i_s % SCM_LONG_BIT)));
+		dv++;
+		sv++;
+		n -= SCM_LONG_BIT - (i_s % SCM_LONG_BIT);
+	      }
+	    IVDEP (src != dst,
+		   for (; n >= SCM_LONG_BIT; n -= SCM_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 (SCM_VELTS (src)[i_s / SCM_LONG_BIT] & (1L << (i_s % SCM_LONG_BIT)))
+		SCM_VELTS (dst)[i_d / SCM_LONG_BIT] |= (1L << (i_d % SCM_LONG_BIT));
+	      else
+		SCM_VELTS (dst)[i_d / SCM_LONG_BIT] &= ~(1L << (i_d % SCM_LONG_BIT));
+	  }
+	break;
+      case scm_tc7_uvect:
+	if (scm_tc7_uvect != SCM_TYP7 (src))
+	  goto gencase;
+	else
+	  {
+	    long *d = (long *) SCM_VELTS (dst), *s = (long *) SCM_VELTS (src);
+	    IVDEP (src != dst,
+		   for (; n-- > 0; i_s += inc_s, i_d += inc_d)
+		   d[i_d] = s[i_s];)
+	      break;
+	  }
+      case scm_tc7_ivect:
+	if (scm_tc7_uvect != SCM_TYP7 (src) && scm_tc7_ivect != SCM_TYP7 (src))
+	  goto gencase;
+	else
+	  {
+	    long *d = (long *) SCM_VELTS (dst), *s = (long *) SCM_VELTS (src);
+	    IVDEP (src != dst,
+		   for (; n-- > 0; i_s += inc_s, i_d += inc_d)
+		   d[i_d] = s[i_s];)
+	      break;
+	  }
+#ifdef SCM_FLOATS
+#ifdef SCM_SINGLES
+      case scm_tc7_fvect:
+	{
+	  float *d = (float *) SCM_VELTS (dst);
+	  float *s = (float *) SCM_VELTS (src);
+	  switch SCM_TYP7
+	    (src)
+	      {
+	      default:
+		goto gencase;
+	      case scm_tc7_ivect:
+	      case scm_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 scm_tc7_fvect:
+		IVDEP (src != dst,
+		       for (; n-- > 0; i_s += inc_s, i_d += inc_d)
+		       d[i_d] = s[i_s];)
+		  break;
+	      case scm_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 /* SCM_SINGLES */
+      case scm_tc7_dvect:
+	{
+	  double *d = (double *) SCM_VELTS (dst);
+	  double *s = (double *) SCM_VELTS (src);
+	  switch SCM_TYP7
+	    (src)
+	      {
+	      default:
+		goto gencase;
+	      case scm_tc7_ivect:
+	      case scm_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 scm_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 scm_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 scm_tc7_cvect:
+	{
+	  double (*d)[2] = (double (*)[2]) SCM_VELTS (dst);
+	  double (*s)[2] = (double (*)[2]) SCM_VELTS (src);
+	  switch SCM_TYP7
+	    (src)
+	      {
+	      default:
+		goto gencase;
+	      case scm_tc7_ivect:
+	      case scm_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 scm_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 scm_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 scm_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 /* SCM_FLOATS */
+  return 1;
+}
+
+
+SCM_PROC(s_serial_array_copy_x, "serial-array-copy!", 2, 0, 0, scm_array_copy_x);
+SCM_PROC(s_array_copy_x, "array-copy!", 2, 0, 0, scm_array_copy_x);
+#ifdef __STDC__
+SCM
+scm_array_copy_x (SCM src, SCM dst)
+#else
+SCM
+scm_array_copy_x (src, dst)
+     SCM src;
+     SCM dst;
+#endif
+{
+  scm_ramapc (racp, SCM_UNDEFINED, src, scm_cons (dst, SCM_EOL), s_array_copy_x);
+  return SCM_UNSPECIFIED;
+}
+
+/* Functions callable by ARRAY-MAP! */
+
+#ifdef __STDC__
+int
+scm_ra_eqp (SCM ra0, SCM ras)
+#else
+int
+scm_ra_eqp (ra0, ras)
+     SCM ra0;
+     SCM ras;
+#endif
+{
+  SCM ra1 = SCM_CAR (ras), ra2 = SCM_CAR (SCM_CDR (ras));
+  long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
+  scm_sizet i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1), i2 = SCM_ARRAY_BASE (ra2);
+  long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
+  long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
+  long inc2 = SCM_ARRAY_DIMS (ra1)->inc;
+  ra0 = SCM_ARRAY_V (ra0);
+  ra1 = SCM_ARRAY_V (ra1);
+  ra2 = SCM_ARRAY_V (ra2);
+  switch (SCM_TYP7 (ra1) == SCM_TYP7 (ra2) ? SCM_TYP7 (ra1) : 0)
+    {
+    default:
+      {
+	SCM e1 = SCM_UNDEFINED, e2 = SCM_UNDEFINED;
+	for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
+	  if BVE_REF
+	    (ra0, i0)
+	      if SCM_FALSEP
+		(scm_eq_p (RVREF (ra1, i1, e1), RVREF (ra2, i2, e2)))
+		  BVE_CLR (ra0, i0);
+	break;
+      }
+    case scm_tc7_uvect:
+    case scm_tc7_ivect:
+      for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
+	if BVE_REF
+	  (ra0, i0)
+	    if (SCM_VELTS (ra1)[i1] != SCM_VELTS (ra2)[i2])
+	      BVE_CLR (ra0, i0);
+      break;
+#ifdef SCM_FLOATS
+#ifdef SCM_SINGLES
+    case scm_tc7_fvect:
+      for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
+	if BVE_REF
+	  (ra0, i0)
+	    if (((float *) SCM_VELTS (ra1))[i1] != ((float *) SCM_VELTS (ra2))[i2])
+	      BVE_CLR (ra0, i0);
+      break;
+#endif /*SCM_SINGLES*/
+    case scm_tc7_dvect:
+      for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
+	if BVE_REF
+	  (ra0, i0)
+	    if (((double *) SCM_VELTS (ra1))[i1] != ((double *) SCM_VELTS (ra2))[i2])
+	      BVE_CLR (ra0, i0);
+      break;
+    case scm_tc7_cvect:
+      for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
+	if BVE_REF
+	  (ra0, i0)
+	    if (((double *) SCM_VELTS (ra1))[2 * i1] != ((double *) SCM_VELTS (ra2))[2 * i2] ||
+		((double *) SCM_VELTS (ra1))[2 * i1 + 1] != ((double *) SCM_VELTS (ra2))[2 * i2 + 1])
+	      BVE_CLR (ra0, i0);
+      break;
+#endif /*SCM_FLOATS*/
+    }
+  return 1;
+}
+
+/* opt 0 means <, nonzero means >= */
+#ifdef __STDC__
+static int
+ra_compare (SCM ra0, SCM ra1, SCM ra2, int opt)
+#else
+static int
+ra_compare (ra0, ra1, ra2, opt)
+     SCM ra0;
+     SCM ra1;
+     SCM ra2;
+     int opt;
+#endif
+{
+  long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
+  scm_sizet i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1), i2 = SCM_ARRAY_BASE (ra2);
+  long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
+  long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
+  long inc2 = SCM_ARRAY_DIMS (ra1)->inc;
+  ra0 = SCM_ARRAY_V (ra0);
+  ra1 = SCM_ARRAY_V (ra1);
+  ra2 = SCM_ARRAY_V (ra2);
+  switch (SCM_TYP7 (ra1) == SCM_TYP7 (ra2) ? SCM_TYP7 (ra1) : 0)
+    {
+    default:
+      {
+	SCM e1 = SCM_UNDEFINED, e2 = SCM_UNDEFINED;
+	for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
+	  if BVE_REF
+	    (ra0, i0)
+	      if (opt ?
+		  SCM_NFALSEP (scm_less_p (RVREF (ra1, i1, e1), RVREF (ra2, i2, e2))) :
+		  SCM_FALSEP (scm_less_p (RVREF (ra1, i1, e1), RVREF (ra2, i2, e2))))
+		BVE_CLR (ra0, i0);
+	break;
+      }
+    case scm_tc7_uvect:
+    case scm_tc7_ivect:
+      for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
+	{
+	  if BVE_REF
+	    (ra0, i0)
+	      if (opt ?
+		  SCM_VELTS (ra1)[i1] < SCM_VELTS (ra2)[i2] :
+		  SCM_VELTS (ra1)[i1] >= SCM_VELTS (ra2)[i2])
+		BVE_CLR (ra0, i0);
+	}
+      break;
+#ifdef SCM_FLOATS
+#ifdef SCM_SINGLES
+    case scm_tc7_fvect:
+      for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
+	if BVE_REF
+	  (ra0, i0)
+	    if (opt ?
+		((float *) SCM_VELTS (ra1))[i1] < ((float *) SCM_VELTS (ra2))[i2] :
+		((float *) SCM_VELTS (ra1))[i1] >= ((float *) SCM_VELTS (ra2))[i2])
+	      BVE_CLR (ra0, i0);
+      break;
+#endif /*SCM_SINGLES*/
+    case scm_tc7_dvect:
+      for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
+	if BVE_REF
+	  (ra0, i0)
+	    if (opt ?
+		((double *) SCM_VELTS (ra1))[i1] < ((double *) SCM_VELTS (ra2))[i2] :
+		((double *) SCM_VELTS (ra1))[i1] >= ((double *) SCM_VELTS (ra2))[i2])
+	      BVE_CLR (ra0, i0);
+      break;
+#endif /*SCM_FLOATS*/
+    }
+  return 1;
+}
+
+
+#ifdef __STDC__
+int
+scm_ra_lessp (SCM ra0, SCM ras)
+#else
+int
+scm_ra_lessp (ra0, ras)
+     SCM ra0;
+     SCM ras;
+#endif
+{
+  return ra_compare (ra0, SCM_CAR (ras), SCM_CAR (SCM_CDR (ras)), 0);
+}
+
+#ifdef __STDC__
+int
+scm_ra_leqp (SCM ra0, SCM ras)
+#else
+int
+scm_ra_leqp (ra0, ras)
+     SCM ra0;
+     SCM ras;
+#endif
+{
+  return ra_compare (ra0, SCM_CAR (SCM_CDR (ras)), SCM_CAR (ras), 1);
+}
+
+#ifdef __STDC__
+int
+scm_ra_grp (SCM ra0, SCM ras)
+#else
+int
+scm_ra_grp (ra0, ras)
+     SCM ra0;
+     SCM ras;
+#endif
+{
+  return ra_compare (ra0, SCM_CAR (SCM_CDR (ras)), SCM_CAR (ras), 0);
+}
+
+#ifdef __STDC__
+int
+scm_ra_greqp (SCM ra0, SCM ras)
+#else
+int
+scm_ra_greqp (ra0, ras)
+     SCM ra0;
+     SCM ras;
+#endif
+{
+  return ra_compare (ra0, SCM_CAR (ras), SCM_CAR (SCM_CDR (ras)), 1);
+}
+
+
+#ifdef __STDC__
+int
+scm_ra_sum (SCM ra0, SCM ras)
+#else
+int
+scm_ra_sum (ra0, ras)
+     SCM ra0;
+     SCM ras;
+#endif
+{
+  long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
+  scm_sizet i0 = SCM_ARRAY_BASE (ra0);
+  long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
+  ra0 = SCM_ARRAY_V (ra0);
+  if SCM_NNULLP
+    (ras)
+      {
+	SCM ra1 = SCM_CAR (ras);
+	scm_sizet i1 = SCM_ARRAY_BASE (ra1);
+	long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
+	ra1 = SCM_ARRAY_V (ra1);
+	switch (SCM_TYP7 (ra0) == SCM_TYP7 (ra1) ? SCM_TYP7 (ra0) : 0)
+	  {
+	  default:
+	    {
+	      SCM e0 = SCM_UNDEFINED, e1 = SCM_UNDEFINED;
+	      for (; n-- > 0; i0 += inc0, i1 += inc1)
+		scm_array_set_x (ra0, scm_sum (RVREF (ra0, i0, e0), RVREF (ra1, i1, e1)),
+		      SCM_MAKINUM (i0));
+	      break;
+	    }
+	  case scm_tc7_uvect:
+	  case scm_tc7_ivect:
+	    {
+	      long *v0 = SCM_VELTS (ra0);
+	      long *v1 = SCM_VELTS (ra1);
+	      IVDEP (ra0 != ra1,
+		     for (; n-- > 0; i0 += inc0, i1 += inc1)
+		     v0[i0] += v1[i1]);
+	      break;
+	    }
+#ifdef SCM_FLOATS
+#ifdef SCM_SINGLES
+	  case scm_tc7_fvect:
+	    {
+	      float *v0 = (float *) SCM_VELTS (ra0);
+	      float *v1 = (float *) SCM_VELTS (ra1);
+	      IVDEP (ra0 != ra1,
+		     for (; n-- > 0; i0 += inc0, i1 += inc1)
+		     v0[i0] += v1[i1]);
+	      break;
+	    }
+#endif /* SCM_SINGLES */
+	  case scm_tc7_dvect:
+	    {
+	      double *v0 = (double *) SCM_VELTS (ra0);
+	      double *v1 = (double *) SCM_VELTS (ra1);
+	      IVDEP (ra0 != ra1,
+		     for (; n-- > 0; i0 += inc0, i1 += inc1)
+		     v0[i0] += v1[i1]);
+	      break;
+	    }
+	  case scm_tc7_cvect:
+	    {
+	      double (*v0)[2] = (double (*)[2]) SCM_VELTS (ra0);
+	      double (*v1)[2] = (double (*)[2]) SCM_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 /* SCM_FLOATS */
+	  }
+      }
+  return 1;
+}
+
+
+#ifdef __STDC__
+int
+scm_ra_difference (SCM ra0, SCM ras)
+#else
+int
+scm_ra_difference (ra0, ras)
+     SCM ra0;
+     SCM ras;
+#endif
+{
+  long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
+  scm_sizet i0 = SCM_ARRAY_BASE (ra0);
+  long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
+  ra0 = SCM_ARRAY_V (ra0);
+  if SCM_NULLP
+    (ras)
+      {
+	switch SCM_TYP7
+	  (ra0)
+	    {
+	    default:
+	      {
+		SCM e0 = SCM_UNDEFINED;
+		for (; n-- > 0; i0 += inc0)
+		  scm_array_set_x (ra0, scm_difference (RVREF (ra0, i0, e0), SCM_UNDEFINED), SCM_MAKINUM (i0));
+		break;
+	      }
+#ifdef SCM_FLOATS
+#ifdef SCM_SINGLES
+	    case scm_tc7_fvect:
+	      {
+		float *v0 = (float *) SCM_VELTS (ra0);
+		for (; n-- > 0; i0 += inc0)
+		  v0[i0] = -v0[i0];
+		break;
+	      }
+#endif /* SCM_SINGLES */
+	    case scm_tc7_dvect:
+	      {
+		double *v0 = (double *) SCM_VELTS (ra0);
+		for (; n-- > 0; i0 += inc0)
+		  v0[i0] = -v0[i0];
+		break;
+	      }
+	    case scm_tc7_cvect:
+	      {
+		double (*v0)[2] = (double (*)[2]) SCM_VELTS (ra0);
+		for (; n-- > 0; i0 += inc0)
+		  {
+		    v0[i0][0] = -v0[i0][0];
+		    v0[i0][1] = -v0[i0][1];
+		  }
+		break;
+	      }
+#endif /* SCM_FLOATS */
+	    }
+      }
+  else
+    {
+      SCM ra1 = SCM_CAR (ras);
+      scm_sizet i1 = SCM_ARRAY_BASE (ra1);
+      long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
+      ra1 = SCM_ARRAY_V (ra1);
+      switch (SCM_TYP7 (ra0) == SCM_TYP7 (ra1) ? SCM_TYP7 (ra0) : 0)
+	{
+	default:
+	  {
+	    SCM e0 = SCM_UNDEFINED, e1 = SCM_UNDEFINED;
+	    for (; n-- > 0; i0 += inc0, i1 += inc1)
+	      scm_array_set_x (ra0, scm_difference (RVREF (ra0, i0, e0), RVREF (ra1, i1, e1)), SCM_MAKINUM (i0));
+	    break;
+	  }
+#ifdef SCM_FLOATS
+#ifdef SCM_SINGLES
+	case scm_tc7_fvect:
+	  {
+	    float *v0 = (float *) SCM_VELTS (ra0);
+	    float *v1 = (float *) SCM_VELTS (ra1);
+	    IVDEP (ra0 != ra1,
+		   for (; n-- > 0; i0 += inc0, i1 += inc1)
+		   v0[i0] -= v1[i1]);
+	    break;
+	  }
+#endif /* SCM_SINGLES */
+	case scm_tc7_dvect:
+	  {
+	    double *v0 = (double *) SCM_VELTS (ra0);
+	    double *v1 = (double *) SCM_VELTS (ra1);
+	    IVDEP (ra0 != ra1,
+		   for (; n-- > 0; i0 += inc0, i1 += inc1)
+		   v0[i0] -= v1[i1]);
+	    break;
+	  }
+	case scm_tc7_cvect:
+	  {
+	    double (*v0)[2] = (double (*)[2]) SCM_VELTS (ra0);
+	    double (*v1)[2] = (double (*)[2]) SCM_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 /* SCM_FLOATS */
+	}
+    }
+  return 1;
+}
+
+
+#ifdef __STDC__
+int
+scm_ra_product (SCM ra0, SCM ras)
+#else
+int
+scm_ra_product (ra0, ras)
+     SCM ra0;
+     SCM ras;
+#endif
+{
+  long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
+  scm_sizet i0 = SCM_ARRAY_BASE (ra0);
+  long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
+  ra0 = SCM_ARRAY_V (ra0);
+  if SCM_NNULLP
+    (ras)
+      {
+	SCM ra1 = SCM_CAR (ras);
+	scm_sizet i1 = SCM_ARRAY_BASE (ra1);
+	long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
+	ra1 = SCM_ARRAY_V (ra1);
+	switch (SCM_TYP7 (ra0) == SCM_TYP7 (ra1) ? SCM_TYP7 (ra0) : 0)
+	  {
+	  default:
+	    {
+	      SCM e0 = SCM_UNDEFINED, e1 = SCM_UNDEFINED;
+	      for (; n-- > 0; i0 += inc0, i1 += inc1)
+		scm_array_set_x (ra0, scm_product (RVREF (ra0, i0, e0), RVREF (ra1, i1, e1)),
+		      SCM_MAKINUM (i0));
+	      break;
+	    }
+	  case scm_tc7_uvect:
+	  case scm_tc7_ivect:
+	    {
+	      long *v0 = SCM_VELTS (ra0);
+	      long *v1 = SCM_VELTS (ra1);
+	      IVDEP (ra0 != ra1,
+		     for (; n-- > 0; i0 += inc0, i1 += inc1)
+		     v0[i0] *= v1[i1]);
+	      break;
+	    }
+#ifdef SCM_FLOATS
+#ifdef SCM_SINGLES
+	  case scm_tc7_fvect:
+	    {
+	      float *v0 = (float *) SCM_VELTS (ra0);
+	      float *v1 = (float *) SCM_VELTS (ra1);
+	      IVDEP (ra0 != ra1,
+		     for (; n-- > 0; i0 += inc0, i1 += inc1)
+		     v0[i0] *= v1[i1]);
+	      break;
+	    }
+#endif /* SCM_SINGLES */
+	  case scm_tc7_dvect:
+	    {
+	      double *v0 = (double *) SCM_VELTS (ra0);
+	      double *v1 = (double *) SCM_VELTS (ra1);
+	      IVDEP (ra0 != ra1,
+		     for (; n-- > 0; i0 += inc0, i1 += inc1)
+		     v0[i0] *= v1[i1]);
+	      break;
+	    }
+	  case scm_tc7_cvect:
+	    {
+	      double (*v0)[2] = (double (*)[2]) SCM_VELTS (ra0);
+	      register double r;
+	      double (*v1)[2] = (double (*)[2]) SCM_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 /* SCM_FLOATS */
+	  }
+      }
+  return 1;
+}
+
+#ifdef __STDC__
+int
+scm_ra_divide (SCM ra0, SCM ras)
+#else
+int
+scm_ra_divide (ra0, ras)
+     SCM ra0;
+     SCM ras;
+#endif
+{
+  long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
+  scm_sizet i0 = SCM_ARRAY_BASE (ra0);
+  long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
+  ra0 = SCM_ARRAY_V (ra0);
+  if SCM_NULLP
+    (ras)
+      {
+	switch SCM_TYP7
+	  (ra0)
+	    {
+	    default:
+	      {
+		SCM e0 = SCM_UNDEFINED;
+		for (; n-- > 0; i0 += inc0)
+		  scm_array_set_x (ra0, scm_divide (RVREF (ra0, i0, e0), SCM_UNDEFINED), SCM_MAKINUM (i0));
+		break;
+	      }
+#ifdef SCM_FLOATS
+#ifdef SCM_SINGLES
+	    case scm_tc7_fvect:
+	      {
+		float *v0 = (float *) SCM_VELTS (ra0);
+		for (; n-- > 0; i0 += inc0)
+		  v0[i0] = 1.0 / v0[i0];
+		break;
+	      }
+#endif /* SCM_SINGLES */
+	    case scm_tc7_dvect:
+	      {
+		double *v0 = (double *) SCM_VELTS (ra0);
+		for (; n-- > 0; i0 += inc0)
+		  v0[i0] = 1.0 / v0[i0];
+		break;
+	      }
+	    case scm_tc7_cvect:
+	      {
+		register double d;
+		double (*v0)[2] = (double (*)[2]) SCM_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 /* SCM_FLOATS */
+	    }
+      }
+  else
+    {
+      SCM ra1 = SCM_CAR (ras);
+      scm_sizet i1 = SCM_ARRAY_BASE (ra1);
+      long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
+      ra1 = SCM_ARRAY_V (ra1);
+      switch (SCM_TYP7 (ra0) == SCM_TYP7 (ra1) ? SCM_TYP7 (ra0) : 0)
+	{
+	default:
+	  {
+	    SCM e0 = SCM_UNDEFINED, e1 = SCM_UNDEFINED;
+	    for (; n-- > 0; i0 += inc0, i1 += inc1)
+	      scm_array_set_x (ra0, scm_divide (RVREF (ra0, i0, e0), RVREF (ra1, i1, e1)), SCM_MAKINUM (i0));
+	    break;
+	  }
+#ifdef SCM_FLOATS
+#ifdef SCM_SINGLES
+	case scm_tc7_fvect:
+	  {
+	    float *v0 = (float *) SCM_VELTS (ra0);
+	    float *v1 = (float *) SCM_VELTS (ra1);
+	    IVDEP (ra0 != ra1,
+		   for (; n-- > 0; i0 += inc0, i1 += inc1)
+		   v0[i0] /= v1[i1]);
+	    break;
+	  }
+#endif /* SCM_SINGLES */
+	case scm_tc7_dvect:
+	  {
+	    double *v0 = (double *) SCM_VELTS (ra0);
+	    double *v1 = (double *) SCM_VELTS (ra1);
+	    IVDEP (ra0 != ra1,
+		   for (; n-- > 0; i0 += inc0, i1 += inc1)
+		   v0[i0] /= v1[i1]);
+	    break;
+	  }
+	case scm_tc7_cvect:
+	  {
+	    register double d, r;
+	    double (*v0)[2] = (double (*)[2]) SCM_VELTS (ra0);
+	    double (*v1)[2] = (double (*)[2]) SCM_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 /* SCM_FLOATS */
+	}
+    }
+  return 1;
+}
+
+#ifdef __STDC__
+int
+scm_array_identity (SCM src, SCM dst)
+#else
+int
+scm_array_identity (dst, src)
+     SCM src;
+     SCM dst;
+#endif
+{
+  return racp (SCM_CAR (src), scm_cons (dst, SCM_EOL));
+}
+
+
+#ifdef __STDC__
+static
+int
+ramap (SCM ra0, SCM proc, SCM ras)
+#else
+static int 
+ramap (ra0, proc, ras)
+     SCM ra0;
+     SCM proc;
+     SCM ras;
+#endif
+{
+  long i = SCM_ARRAY_DIMS (ra0)->lbnd;
+  long inc = SCM_ARRAY_DIMS (ra0)->inc;
+  long n = SCM_ARRAY_DIMS (ra0)->ubnd;
+  long base = SCM_ARRAY_BASE (ra0) - i * inc;
+  ra0 = SCM_ARRAY_V (ra0);
+  if SCM_NULLP
+    (ras)
+      for (; i <= n; i++)
+	scm_array_set_x (ra0, scm_apply (proc, SCM_EOL, SCM_EOL), SCM_MAKINUM (i * inc + base));
+  else
+    {
+      SCM ra1 = SCM_CAR (ras);
+      SCM args, *ve = &ras;
+      scm_sizet k, i1 = SCM_ARRAY_BASE (ra1);
+      long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
+      ra1 = SCM_ARRAY_V (ra1);
+      ras = SCM_CDR (ras);
+      if SCM_NULLP
+	(ras)
+	  ras = scm_nullvect;
+      else
+	{
+	  ras = scm_vector (ras);
+	  ve = SCM_VELTS (ras);
+	}
+      for (; i <= n; i++, i1 += inc1)
+	{
+	  args = SCM_EOL;
+	  for (k = SCM_LENGTH (ras); k--;)
+	    args = scm_cons (scm_uniform_vector_ref (ve[k], SCM_MAKINUM (i)), args);
+	  args = scm_cons (scm_cvref (ra1, i1, SCM_UNDEFINED), args);
+	  scm_array_set_x (ra0, scm_apply (proc, args, SCM_EOL), SCM_MAKINUM (i * inc + base));
+	}
+    }
+  return 1;
+}
+
+#ifdef __STDC__
+static int
+ramap_cxr (SCM ra0, SCM proc, SCM ras)
+#else
+static int
+ramap_cxr (ra0, proc, ras)
+     SCM ra0;
+     SCM proc;
+     SCM ras;
+#endif
+{
+  SCM ra1 = SCM_CAR (ras);
+  SCM e1 = SCM_UNDEFINED;
+  scm_sizet i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1);
+  long inc0 = SCM_ARRAY_DIMS (ra0)->inc, inc1 = SCM_ARRAY_DIMS (ra1)->inc;
+  long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra1)->lbnd + 1;
+  ra0 = SCM_ARRAY_V (ra0);
+  ra1 = SCM_ARRAY_V (ra1);
+  switch SCM_TYP7
+    (ra0)
+      {
+      default:
+      gencase:
+	for (; n-- > 0; i0 += inc0, i1 += inc1)
+	  scm_array_set_x (ra0, scm_apply (proc, RVREF (ra1, i1, e1), scm_listofnull), SCM_MAKINUM (i0));
+	break;
+#ifdef SCM_FLOATS
+#ifdef SCM_SINGLES
+      case scm_tc7_fvect:
+	{
+	  float *dst = (float *) SCM_VELTS (ra0);
+	  switch SCM_TYP7
+	    (ra1)
+	      {
+	      default:
+		goto gencase;
+	      case scm_tc7_fvect:
+		for (; n-- > 0; i0 += inc0, i1 += inc1)
+		  dst[i0] = SCM_DSUBRF (proc) ((double) ((float *) SCM_VELTS (ra1))[i1]);
+		break;
+	      case scm_tc7_uvect:
+	      case scm_tc7_ivect:
+		for (; n-- > 0; i0 += inc0, i1 += inc1)
+		  dst[i0] = SCM_DSUBRF (proc) ((double) SCM_VELTS (ra1)[i1]);
+		break;
+	      }
+	  break;
+	}
+#endif /* SCM_SINGLES */
+      case scm_tc7_dvect:
+	{
+	  double *dst = (double *) SCM_VELTS (ra0);
+	  switch SCM_TYP7
+	    (ra1)
+	      {
+	      default:
+		goto gencase;
+	      case scm_tc7_dvect:
+		for (; n-- > 0; i0 += inc0, i1 += inc1)
+		  dst[i0] = SCM_DSUBRF (proc) (((double *) SCM_VELTS (ra1))[i1]);
+		break;
+	      case scm_tc7_uvect:
+	      case scm_tc7_ivect:
+		for (; n-- > 0; i0 += inc0, i1 += inc1)
+		  dst[i0] = SCM_DSUBRF (proc) ((double) SCM_VELTS (ra1)[i1]);
+		break;
+	      }
+	  break;
+	}
+#endif /* SCM_FLOATS */
+      }
+  return 1;
+}
+
+
+#ifdef __STDC__
+static int
+ramap_rp (SCM ra0, SCM proc, SCM ras)
+#else
+static int
+ramap_rp (ra0, proc, ras)
+     SCM ra0;
+     SCM proc;
+     SCM ras;
+#endif
+{
+  SCM ra1 = SCM_CAR (ras), ra2 = SCM_CAR (SCM_CDR (ras));
+  SCM e1 = SCM_UNDEFINED, e2 = SCM_UNDEFINED;
+  long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
+  scm_sizet i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1), i2 = SCM_ARRAY_BASE (ra2);
+  long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
+  long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
+  long inc2 = SCM_ARRAY_DIMS (ra1)->inc;
+  ra0 = SCM_ARRAY_V (ra0);
+  ra1 = SCM_ARRAY_V (ra1);
+  ra2 = SCM_ARRAY_V (ra2);
+  switch (SCM_TYP7 (ra1) == SCM_TYP7 (ra2) ? SCM_TYP7 (ra1) : 0)
+    {
+    default:
+      for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
+	if BVE_REF
+	  (ra0, i0)
+	    if SCM_FALSEP
+	      (SCM_SUBRF (proc) (RVREF (ra1, i1, e1), RVREF (ra2, i2, e2)))
+		BVE_CLR (ra0, i0);
+      break;
+    case scm_tc7_uvect:
+    case scm_tc7_ivect:
+      for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
+	if BVE_REF
+	  (ra0, i0)
+	    {
+	      if SCM_FALSEP
+		(SCM_SUBRF (proc) (SCM_MAKINUM (SCM_VELTS (ra1)[i1]),
+			       SCM_MAKINUM (SCM_VELTS (ra2)[i2])))
+		  BVE_CLR (ra0, i0);
+	    }
+      break;
+#ifdef SCM_FLOATS
+#ifdef SCM_SINGLES
+    case scm_tc7_fvect:
+      {
+	SCM a1 = scm_makflo (1.0), a2 = scm_makflo (1.0);
+	for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
+	  if BVE_REF
+	    (ra0, i0)
+	      {
+		SCM_FLO (a1) = ((float *) SCM_VELTS (ra1))[i1];
+		SCM_FLO (a2) = ((float *) SCM_VELTS (ra2))[i2];
+		if SCM_FALSEP
+		  (SCM_SUBRF (proc) (a1, a2))
+		    BVE_CLR (ra0, i0);
+	      }
+	break;
+      }
+#endif /*SCM_SINGLES*/
+    case scm_tc7_dvect:
+      {
+	SCM a1 = scm_makdbl (1.0 / 3.0, 0.0), a2 = scm_makdbl (1.0 / 3.0, 0.0);
+	for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
+	  if BVE_REF
+	    (ra0, i0)
+	      {
+		SCM_REAL (a1) = ((double *) SCM_VELTS (ra1))[i1];
+		SCM_REAL (a2) = ((double *) SCM_VELTS (ra2))[i2];
+		if SCM_FALSEP
+		  (SCM_SUBRF (proc) (a1, a2))
+		    BVE_CLR (ra0, i0);
+	      }
+	break;
+      }
+    case scm_tc7_cvect:
+      {
+	SCM a1 = scm_makdbl (1.0, 1.0), a2 = scm_makdbl (1.0, 1.0);
+	for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
+	  if BVE_REF
+	    (ra0, i0)
+	      {
+		SCM_REAL (a1) = ((double *) SCM_VELTS (ra1))[2 * i1];
+		SCM_IMAG (a1) = ((double *) SCM_VELTS (ra1))[2 * i1 + 1];
+		SCM_REAL (a2) = ((double *) SCM_VELTS (ra2))[2 * i2];
+		SCM_IMAG (a2) = ((double *) SCM_VELTS (ra2))[2 * i2 + 1];
+		if SCM_FALSEP
+		  (SCM_SUBRF (proc) (a1, a2))
+		    BVE_CLR (ra0, i0);
+	      }
+	break;
+      }
+#endif /*SCM_FLOATS*/
+    }
+  return 1;
+}
+
+
+#ifdef __STDC__
+static int
+ramap_1 (SCM ra0, SCM proc, SCM ras)
+#else
+static int
+ramap_1 (ra0, proc, ras)
+     SCM ra0;
+     SCM proc;
+     SCM ras;
+#endif
+{
+  SCM ra1 = SCM_CAR (ras);
+  SCM e1 = SCM_UNDEFINED;
+  long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
+  scm_sizet i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1);
+  long inc0 = SCM_ARRAY_DIMS (ra0)->inc, inc1 = SCM_ARRAY_DIMS (ra1)->inc;
+  ra0 = SCM_ARRAY_V (ra0);
+  ra1 = SCM_ARRAY_V (ra1);
+  if (scm_tc7_vector == SCM_TYP7 (ra0))
+    for (; n-- > 0; i0 += inc0, i1 += inc1)
+      scm_array_set_x (ra0, SCM_SUBRF (proc) (scm_cvref (ra1, i1, SCM_UNDEFINED)), SCM_MAKINUM (i0));
+  else
+    for (; n-- > 0; i0 += inc0, i1 += inc1)
+      scm_array_set_x (ra0, SCM_SUBRF (proc) (RVREF (ra1, i1, e1)), SCM_MAKINUM (i0));
+  return 1;
+}
+
+
+#ifdef __STDC__
+static int
+ramap_2o (SCM ra0, SCM proc, SCM ras)
+#else
+static int
+ramap_2o (ra0, proc, ras)
+     SCM ra0;
+     SCM proc;
+     SCM ras;
+#endif
+{
+  SCM ra1 = SCM_CAR (ras);
+  SCM e1 = SCM_UNDEFINED;
+  long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
+  scm_sizet i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1);
+  long inc0 = SCM_ARRAY_DIMS (ra0)->inc, inc1 = SCM_ARRAY_DIMS (ra1)->inc;
+  ra0 = SCM_ARRAY_V (ra0);
+  ra1 = SCM_ARRAY_V (ra1);
+  ras = SCM_CDR (ras);
+  if SCM_NULLP
+    (ras)
+      {
+	if (scm_tc7_vector == SCM_TYP7 (ra0))
+	  for (; n-- > 0; i0 += inc0, i1 += inc1)
+	    scm_array_set_x (ra0, SCM_SUBRF (proc) (scm_cvref (ra1, i1, SCM_UNDEFINED), SCM_UNDEFINED),
+		  SCM_MAKINUM (i0));
+	else
+	  for (; n-- > 0; i0 += inc0, i1 += inc1)
+	    scm_array_set_x (ra0, SCM_SUBRF (proc) (RVREF (ra1, i1, e1), SCM_UNDEFINED),
+		  SCM_MAKINUM (i0));
+      }
+  else
+    {
+      SCM ra2 = SCM_CAR (ras);
+      SCM e2 = SCM_UNDEFINED;
+      scm_sizet i2 = SCM_ARRAY_BASE (ra2);
+      long inc2 = SCM_ARRAY_DIMS (ra2)->inc;
+      ra2 = SCM_ARRAY_V (ra2);
+      if (scm_tc7_vector == SCM_TYP7 (ra0))
+	for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
+	  scm_array_set_x (ra0,
+		SCM_SUBRF (proc) (scm_cvref (ra1, i1, SCM_UNDEFINED), scm_cvref (ra2, i2, SCM_UNDEFINED)),
+		SCM_MAKINUM (i0));
+      else
+	for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
+	  scm_array_set_x (ra0,
+		SCM_SUBRF (proc) (RVREF (ra1, i1, e1), RVREF (ra2, i2, e2)),
+		SCM_MAKINUM (i0));
+    }
+  return 1;
+}
+
+
+#ifdef __STDC__
+static int
+ramap_a (SCM ra0, SCM proc, SCM ras)
+#else
+static int
+ramap_a (ra0, proc, ras)
+     SCM ra0;
+     SCM proc;
+     SCM ras;
+#endif
+{
+  SCM e0 = SCM_UNDEFINED, e1 = SCM_UNDEFINED;
+  long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
+  scm_sizet i0 = SCM_ARRAY_BASE (ra0);
+  long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
+  ra0 = SCM_ARRAY_V (ra0);
+  if SCM_NULLP
+    (ras)
+      for (; n-- > 0; i0 += inc0)
+	scm_array_set_x (ra0, SCM_SUBRF (proc) (RVREF (ra0, i0, e0), SCM_UNDEFINED), SCM_MAKINUM (i0));
+  else
+    {
+      SCM ra1 = SCM_CAR (ras);
+      scm_sizet i1 = SCM_ARRAY_BASE (ra1);
+      long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
+      ra1 = SCM_ARRAY_V (ra1);
+      for (; n-- > 0; i0 += inc0, i1 += inc1)
+	scm_array_set_x (ra0, SCM_SUBRF (proc) (RVREF (ra0, i0, e0), RVREF (ra1, i1, e1)),
+	      SCM_MAKINUM (i0));
+    }
+  return 1;
+}
+
+SCM_PROC(s_serial_array_map, "serial-array-map", 2, 0, 1, scm_array_map);
+SCM_PROC(s_array_map, "array-map", 2, 0, 1, scm_array_map);
+#ifdef __STDC__
+SCM
+scm_array_map (SCM ra0, SCM proc, SCM lra)
+#else
+SCM
+scm_array_map (ra0, proc, lra)
+     SCM ra0;
+     SCM proc;
+     SCM lra;
+#endif
+{
+  SCM_ASSERT (SCM_BOOL_T == scm_procedure_p (proc), proc, SCM_ARG2, s_array_map);
+  switch (SCM_TYP7 (proc))
+      {
+      default:
+      gencase:
+	scm_ramapc (ramap, proc, ra0, lra, s_array_map);
+	return SCM_UNSPECIFIED;
+      case scm_tc7_subr_1:
+	scm_ramapc (ramap_1, proc, ra0, lra, s_array_map);
+	return SCM_UNSPECIFIED;
+      case scm_tc7_subr_2:
+      case scm_tc7_subr_2o:
+	scm_ramapc (ramap_2o, proc, ra0, lra, s_array_map);
+	return SCM_UNSPECIFIED;
+      case scm_tc7_cxr:
+	if (!SCM_SUBRF (proc))
+	  goto gencase;
+	scm_ramapc (ramap_cxr, proc, ra0, lra, s_array_map);
+	return SCM_UNSPECIFIED;
+      case scm_tc7_rpsubr:
+	{
+	  ra_iproc *p;
+	  if (SCM_FALSEP (scm_array_p (ra0, SCM_BOOL_T)))
+	    goto gencase;
+	  scm_array_fill_x (ra0, SCM_BOOL_T);
+	  for (p = ra_rpsubrs; p->name; p++)
+	    if (proc == p->sproc)
+	      {
+		while (SCM_NNULLP (lra) && SCM_NNULLP (SCM_CDR (lra)))
+		  {
+		    scm_ramapc (p->vproc, SCM_UNDEFINED, ra0, lra, s_array_map);
+		    lra = SCM_CDR (lra);
+		  }
+		return SCM_UNSPECIFIED;
+	      }
+	  while (SCM_NNULLP (lra) && SCM_NNULLP (SCM_CDR (lra)))
+	    {
+	      scm_ramapc (ramap_rp, proc, ra0, lra, s_array_map);
+	      lra = SCM_CDR (lra);
+	    }
+	  return SCM_UNSPECIFIED;
+	}
+      case scm_tc7_asubr:
+	if SCM_NULLP
+	  (lra)
+	    {
+	      SCM prot, fill = SCM_SUBRF (proc) (SCM_UNDEFINED, SCM_UNDEFINED);
+	      if SCM_INUMP
+		(fill)
+		  {
+		    prot = scm_array_prototype (ra0);
+		    if (SCM_NIMP (prot) && SCM_INEXP (prot))
+		      fill = scm_makdbl ((double) SCM_INUM (fill), 0.0);
+		  }
+
+	      scm_array_fill_x (ra0, fill);
+	    }
+	else
+	  {
+	    SCM tail, ra1 = SCM_CAR (lra);
+	    SCM v0 = (SCM_NIMP (ra0) && SCM_ARRAYP (ra0) ? SCM_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 || (SCM_NIMP (ra1) && SCM_ARRAYP (ra1) && v0 == SCM_ARRAY_V (ra1)))
+	      if (ra0 != ra1 || (SCM_ARRAYP(ra0) && !SCM_ARRAY_CONTP(ra0)))
+		goto gencase;
+	    for (tail = SCM_CDR (lra); SCM_NNULLP (tail); tail = SCM_CDR (tail))
+	      {
+		ra1 = SCM_CAR (tail);
+		if (v0 == ra1 || (SCM_NIMP (ra1) && SCM_ARRAYP (ra1) && v0 == SCM_ARRAY_V (ra1)))
+		  goto gencase;
+	      }
+	    for (p = ra_asubrs; p->name; p++)
+	      if (proc == p->sproc)
+		{
+		  if (ra0 != SCM_CAR (lra))
+		    scm_ramapc (scm_array_identity, SCM_UNDEFINED, ra0, scm_cons (SCM_CAR (lra), SCM_EOL), s_array_map);
+		  lra = SCM_CDR (lra);
+		  while (1)
+		    {
+		      scm_ramapc (p->vproc, SCM_UNDEFINED, ra0, lra, s_array_map);
+		      if (SCM_IMP (lra) || SCM_IMP (SCM_CDR (lra)))
+			return SCM_UNSPECIFIED;
+		      lra = SCM_CDR (lra);
+		    }
+		}
+	    scm_ramapc (ramap_2o, proc, ra0, lra, s_array_map);
+	    lra = SCM_CDR (lra);
+	    if SCM_NIMP
+	      (lra)
+		for (lra = SCM_CDR (lra); SCM_NIMP (lra); lra = SCM_CDR (lra))
+		  scm_ramapc (ramap_a, proc, ra0, lra, s_array_map);
+	  }
+	return SCM_UNSPECIFIED;
+      }
+}
+
+#ifdef __STDC__
+static int
+rafe (SCM ra0, SCM proc, SCM ras)
+#else
+static int
+rafe (ra0, proc, ras)
+     SCM ra0;
+     SCM proc;
+     SCM ras;
+#endif
+{
+  long i = SCM_ARRAY_DIMS (ra0)->lbnd;
+  scm_sizet i0 = SCM_ARRAY_BASE (ra0);
+  long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
+  long n = SCM_ARRAY_DIMS (ra0)->ubnd;
+  ra0 = SCM_ARRAY_V (ra0);
+  if SCM_NULLP
+    (ras)
+      for (; i <= n; i++, i0 += inc0)
+	scm_apply (proc, scm_cvref (ra0, i0, SCM_UNDEFINED), scm_listofnull);
+  else
+    {
+      SCM ra1 = SCM_CAR (ras);
+      SCM args, *ve = &ras;
+      scm_sizet k, i1 = SCM_ARRAY_BASE (ra1);
+      long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
+      ra1 = SCM_ARRAY_V (ra1);
+      ras = SCM_CDR (ras);
+      if SCM_NULLP
+	(ras)
+	  ras = scm_nullvect;
+      else
+	{
+	  ras = scm_vector (ras);
+	  ve = SCM_VELTS (ras);
+	}
+      for (; i <= n; i++, i0 += inc0, i1 += inc1)
+	{
+	  args = SCM_EOL;
+	  for (k = SCM_LENGTH (ras); k--;)
+	    args = scm_cons (scm_uniform_vector_ref (ve[k], SCM_MAKINUM (i)), args);
+	  args = scm_cons2 (scm_cvref (ra0, i0, SCM_UNDEFINED), scm_cvref (ra1, i1, SCM_UNDEFINED), args);
+	  scm_apply (proc, args, SCM_EOL);
+	}
+    }
+  return 1;
+}
+
+
+SCM_PROC(s_array_for_each, "array-for-each", 2, 0, 1, scm_array_for_each);
+#ifdef __STDC__
+SCM
+scm_array_for_each (SCM proc, SCM ra0, SCM lra)
+#else
+SCM
+scm_array_for_each (proc, ra0, lra)
+     SCM proc;
+     SCM ra0;
+     SCM lra;
+#endif
+{
+  SCM_ASSERT (SCM_BOOL_T == scm_procedure_p (proc), proc, SCM_ARG1, s_array_for_each);
+  scm_ramapc (rafe, proc, ra0, lra, s_array_for_each);
+  return SCM_UNSPECIFIED;
+}
+
+SCM_PROC(s_array_index_map_x, "array-index-map!", 2, 0, 0, scm_array_index_map_x);
+#ifdef __STDC__
+SCM
+scm_array_index_map_x (SCM ra, SCM proc)
+#else
+SCM
+scm_array_index_map_x (ra, proc)
+     SCM ra;
+     SCM proc;
+#endif
+{
+  scm_sizet i;
+  SCM_ASSERT (SCM_NIMP (ra), ra, SCM_ARG1, s_array_index_map_x);
+  SCM_ASSERT (SCM_BOOL_T == scm_procedure_p (proc), proc, SCM_ARG2, s_array_index_map_x);
+  switch SCM_TYP7
+    (ra)
+      {
+      default:
+      badarg:scm_wta (ra, (char *) SCM_ARG1, s_array_index_map_x);
+      case scm_tc7_vector:
+	{
+	  SCM *ve = SCM_VELTS (ra);
+	  for (i = 0; i < SCM_LENGTH (ra); i++)
+	    ve[i] = scm_apply (proc, SCM_MAKINUM (i), scm_listofnull);
+	  return SCM_UNSPECIFIED;
+	}
+      case scm_tc7_string:
+      case scm_tc7_bvect:
+      case scm_tc7_uvect:
+      case scm_tc7_ivect:
+      case scm_tc7_fvect:
+      case scm_tc7_dvect:
+      case scm_tc7_cvect:
+	for (i = 0; i < SCM_LENGTH (ra); i++)
+	  scm_array_set_x (ra, scm_apply (proc, SCM_MAKINUM (i), scm_listofnull), SCM_MAKINUM (i));
+	return SCM_UNSPECIFIED;
+      case scm_tc7_smob:
+	SCM_ASRTGO (SCM_ARRAYP (ra), badarg);
+	{
+	  SCM args = SCM_EOL;
+	  SCM inds = scm_make_uve (SCM_ARRAY_NDIM (ra), SCM_MAKINUM (-1L));
+	  long *vinds = SCM_VELTS (inds);
+	  int j, k, kmax = SCM_ARRAY_NDIM (ra) - 1;
+	  for (k = 0; k <= kmax; k++)
+	    vinds[k] = SCM_ARRAY_DIMS (ra)[k].lbnd;
+	  k = kmax;
+	  do
+	    {
+	      if (k == kmax)
+		{
+		  vinds[k] = SCM_ARRAY_DIMS (ra)[k].lbnd;
+		  i = cind (ra, inds);
+		  for (; vinds[k] <= SCM_ARRAY_DIMS (ra)[k].ubnd; vinds[k]++)
+		    {
+		      for (j = kmax + 1, args = SCM_EOL; j--;)
+			args = scm_cons (SCM_MAKINUM (vinds[j]), args);
+		      scm_array_set_x (SCM_ARRAY_V (ra), scm_apply (proc, args, SCM_EOL), SCM_MAKINUM (i));
+		      i += SCM_ARRAY_DIMS (ra)[k].inc;
+		    }
+		  k--;
+		  continue;
+		}
+	      if (vinds[k] < SCM_ARRAY_DIMS (ra)[k].ubnd)
+		{
+		  vinds[k]++;
+		  k++;
+		  continue;
+		}
+	      vinds[k] = SCM_ARRAY_DIMS (ra)[k].lbnd - 1;
+	      k--;
+	    }
+	  while (k >= 0);
+	  return SCM_UNSPECIFIED;
+	}
+      }
+}
+
+#ifdef __STDC__
+static int
+raeql_1 (SCM ra0, SCM as_equal, SCM ra1)
+#else
+static int
+raeql_1 (ra0, as_equal, ra1)
+     SCM ra0;
+     SCM as_equal;
+     SCM ra1;
+#endif
+{
+  SCM e0 = SCM_UNDEFINED, e1 = SCM_UNDEFINED;
+  scm_sizet i0 = 0, i1 = 0;
+  long inc0 = 1, inc1 = 1;
+  scm_sizet n = SCM_LENGTH (ra0);
+  ra1 = SCM_CAR (ra1);
+  if SCM_ARRAYP
+    (ra0)
+      {
+	n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
+	i0 = SCM_ARRAY_BASE (ra0);
+	inc0 = SCM_ARRAY_DIMS (ra0)->inc;
+	ra0 = SCM_ARRAY_V (ra0);
+      }
+  if SCM_ARRAYP
+    (ra1)
+      {
+	i1 = SCM_ARRAY_BASE (ra1);
+	inc1 = SCM_ARRAY_DIMS (ra1)->inc;
+	ra1 = SCM_ARRAY_V (ra1);
+      }
+  switch SCM_TYP7
+    (ra0)
+      {
+      case scm_tc7_vector:
+      default:
+	for (; n--; i0 += inc0, i1 += inc1)
+	  {
+	    if SCM_FALSEP
+	      (as_equal)
+		{
+		  if SCM_FALSEP
+		    (scm_array_equal_p (RVREF (ra0, i0, e0), RVREF (ra1, i1, e1)))
+		      return 0;
+		}
+	    else if SCM_FALSEP
+	      (scm_equal_p (RVREF (ra0, i0, e0), RVREF (ra1, i1, e1)))
+		return 0;
+	  }
+	return 1;
+      case scm_tc7_string:
+	{
+	  char *v0 = SCM_CHARS (ra0) + i0;
+	  char *v1 = SCM_CHARS (ra1) + i1;
+	  for (; n--; v0 += inc0, v1 += inc1)
+	    if (*v0 != *v1)
+	      return 0;
+	  return 1;
+	}
+      case scm_tc7_bvect:
+	for (; n--; i0 += inc0, i1 += inc1)
+	  if (BVE_REF (ra0, i0) != BVE_REF (ra1, i1))
+	    return 0;
+	return 1;
+      case scm_tc7_uvect:
+      case scm_tc7_ivect:
+	{
+	  long *v0 = (long *) SCM_VELTS (ra0) + i0;
+	  long *v1 = (long *) SCM_VELTS (ra1) + i1;
+	  for (; n--; v0 += inc0, v1 += inc1)
+	    if (*v0 != *v1)
+	      return 0;
+	  return 1;
+	}
+#ifdef SCM_FLOATS
+#ifdef SCM_SINGLES
+      case scm_tc7_fvect:
+	{
+	  float *v0 = (float *) SCM_VELTS (ra0) + i0;
+	  float *v1 = (float *) SCM_VELTS (ra1) + i1;
+	  for (; n--; v0 += inc0, v1 += inc1)
+	    if (*v0 != *v1)
+	      return 0;
+	  return 1;
+	}
+#endif /* SCM_SINGLES */
+      case scm_tc7_dvect:
+	{
+	  double *v0 = (double *) SCM_VELTS (ra0) + i0;
+	  double *v1 = (double *) SCM_VELTS (ra1) + i1;
+	  for (; n--; v0 += inc0, v1 += inc1)
+	    if (*v0 != *v1)
+	      return 0;
+	  return 1;
+	}
+      case scm_tc7_cvect:
+	{
+	  double (*v0)[2] = (double (*)[2]) SCM_VELTS (ra0) + i0;
+	  double (*v1)[2] = (double (*)[2]) SCM_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 /* SCM_FLOATS */
+      }
+}
+
+
+#ifdef __STDC__
+static int
+raeql (SCM ra0, SCM as_equal, SCM ra1)
+#else
+static int
+raeql (ra0, as_equal, ra1)
+     SCM ra0;
+     SCM as_equal;
+     SCM ra1;
+#endif
+{
+  SCM v0 = ra0, v1 = ra1;
+  scm_array_dim dim0, dim1;
+  scm_array_dim *s0 = &dim0, *s1 = &dim1;
+  scm_sizet bas0 = 0, bas1 = 0;
+  int k, unroll = 1, vlen = 1, ndim = 1;
+  if SCM_ARRAYP
+    (ra0)
+      {
+	ndim = SCM_ARRAY_NDIM (ra0);
+	s0 = SCM_ARRAY_DIMS (ra0);
+	bas0 = SCM_ARRAY_BASE (ra0);
+	v0 = SCM_ARRAY_V (ra0);
+      }
+  else
+    {
+      s0->inc = 1;
+      s0->lbnd = 0;
+      s0->ubnd = SCM_LENGTH (v0) - 1;
+      unroll = 0;
+    }
+  if SCM_ARRAYP
+    (ra1)
+      {
+	if (ndim != SCM_ARRAY_NDIM (ra1))
+	  return 0;
+	s1 = SCM_ARRAY_DIMS (ra1);
+	bas1 = SCM_ARRAY_BASE (ra1);
+	v1 = SCM_ARRAY_V (ra1);
+      }
+  else
+    {
+      if (1 != ndim)
+	return SCM_BOOL_F;
+      s1->inc = 1;
+      s1->lbnd = 0;
+      s1->ubnd = SCM_LENGTH (v1) - 1;
+      unroll = 0;
+    }
+  if (SCM_TYP7 (v0) != SCM_TYP7 (v1))
+    return 0;
+  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);
+	  vlen *= s0[k].ubnd - s1[k].lbnd + 1;
+	}
+    }
+  if (unroll && bas0 == bas1 && v0 == v1)
+    return SCM_BOOL_T;
+  return scm_ramapc (raeql_1, as_equal, ra0, scm_cons (ra1, SCM_EOL), "");
+}
+
+#ifdef __STDC__
+SCM
+scm_raequal (SCM ra0, SCM ra1)
+#else
+SCM
+scm_raequal (ra0, ra1)
+     SCM ra0;
+     SCM ra1;
+#endif
+{
+  return (raeql (ra0, SCM_BOOL_T, ra1) ? SCM_BOOL_T : SCM_BOOL_F);
+}
+
+static char s_array_equal_p[] = "array-equal?";
+
+#ifdef __STDC__
+SCM
+scm_array_equal_p (SCM ra0, SCM ra1)
+#else
+SCM
+scm_array_equal_p (ra0, ra1)
+     SCM ra0;
+     SCM ra1;
+#endif
+{
+  if (SCM_IMP (ra0) || SCM_IMP (ra1))
+  callequal:return scm_equal_p (ra0, ra1);
+  switch SCM_TYP7
+    (ra0)
+      {
+      default:
+	goto callequal;
+      case scm_tc7_bvect:
+      case scm_tc7_string:
+      case scm_tc7_uvect:
+      case scm_tc7_ivect:
+      case scm_tc7_fvect:
+      case scm_tc7_dvect:
+      case scm_tc7_cvect:
+      case scm_tc7_vector:
+	break;
+      case scm_tc7_smob:
+	if (!SCM_ARRAYP (ra0))
+	  goto callequal;
+      }
+  switch SCM_TYP7
+    (ra1)
+      {
+      default:
+	goto callequal;
+      case scm_tc7_bvect:
+      case scm_tc7_string:
+      case scm_tc7_uvect:
+      case scm_tc7_ivect:
+      case scm_tc7_fvect:
+      case scm_tc7_dvect:
+      case scm_tc7_cvect:
+      case scm_tc7_vector:
+	break;
+      case scm_tc7_smob:
+	if (!SCM_ARRAYP (ra1))
+	  goto callequal;
+      }
+  return (raeql (ra0, SCM_BOOL_F, ra1) ? SCM_BOOL_T : SCM_BOOL_F);
+}
+
+
+
+
+/* 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 SCM_CAR of all subrs (like those selected by SCM_SMOBNUM) to hold an
+ * offset into a table of vectorized subrs.  
+ */
+
+static ra_iproc ra_rpsubrs[] =
+{
+  {"=", SCM_UNDEFINED, scm_ra_eqp},
+  {"<", SCM_UNDEFINED, scm_ra_lessp},
+  {"<=", SCM_UNDEFINED, scm_ra_leqp},
+  {">", SCM_UNDEFINED, scm_ra_grp},
+  {">=", SCM_UNDEFINED, scm_ra_greqp},
+  {0, 0, 0}
+};
+
+static ra_iproc ra_asubrs[] =
+{
+  {"+", SCM_UNDEFINED, scm_ra_sum},
+  {"-", SCM_UNDEFINED, scm_ra_difference},
+  {"*", SCM_UNDEFINED, scm_ra_product},
+  {"/", SCM_UNDEFINED, scm_ra_divide},
+  {0, 0, 0}
+};
+
+static void init_raprocs (subra)
+     ra_iproc *subra;
+{
+  for (; subra->name; subra++)
+    subra->sproc = SCM_CDR (scm_intern (subra->name, strlen (subra->name)));
+}
+
+#ifdef __STDC__
+void
+scm_init_ramap (void)
+#else
+void
+scm_init_ramap ()
+#endif
+{
+  init_raprocs (ra_rpsubrs);
+  init_raprocs (ra_asubrs);
+  scm_make_subr (s_array_equal_p, scm_tc7_rpsubr, scm_array_equal_p);
+  scm_smobs[0x0ff & (scm_tc16_array >> 8)].equalp = scm_raequal;
+#include "ramap.x"
+  scm_add_feature (s_array_for_each);
+}
+
+#endif /* ARRAYS */
diff --git a/libguile/ramap.h b/libguile/ramap.h
new file mode 100644
index 000000000..a198f59ee
--- /dev/null
+++ b/libguile/ramap.h
@@ -0,0 +1,101 @@
+/* classes: h_files */
+
+#ifndef RAMAPH
+#define RAMAPH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+
+
+#ifdef __STDC__
+extern int scm_ra_matchp (SCM ra0, SCM ras);
+extern int scm_ramapc (int (*cproc) (), SCM data, SCM ra0, SCM lra, char *what);
+extern int scm_array_fill_int (SCM ra, SCM fill, SCM ignore);
+extern SCM scm_array_fill_x (SCM ra, SCM fill);
+extern SCM scm_array_copy (SCM src, SCM dst);
+extern int scm_ra_eqp (SCM ra0, SCM ras);
+extern int scm_ra_lessp (SCM ra0, SCM ras);
+extern int scm_ra_leqp (SCM ra0, SCM ras);
+extern int scm_ra_grp (SCM ra0, SCM ras);
+extern int scm_ra_greqp (SCM ra0, SCM ras);
+extern int scm_ra_sum (SCM ra0, SCM ras);
+extern int scm_ra_difference (SCM ra0, SCM ras);
+extern int scm_ra_product (SCM ra0, SCM ras);
+extern int scm_ra_divide (SCM ra0, SCM ras);
+extern int scm_array_identity (SCM src, SCM dst);
+extern SCM scm_array_map (SCM ra0, SCM proc, SCM lra);
+extern SCM scm_array_for_each (SCM proc, SCM ra0, SCM lra);
+extern SCM scm_array_index_map_x (SCM ra, SCM proc);
+extern SCM scm_raequal (SCM ra0, SCM ra1);
+extern SCM scm_array_equal_p (SCM ra0, SCM ra1);
+extern void scm_init_ramap (void);
+
+#else /* STDC */
+extern int scm_ra_matchp ();
+extern int scm_ramapc ();
+extern int scm_array_fill_int ();
+extern SCM scm_array_fill_x ();
+extern SCM scm_array_copy ();
+extern int scm_ra_eqp ();
+extern int scm_ra_lessp ();
+extern int scm_ra_leqp ();
+extern int scm_ra_grp ();
+extern int scm_ra_greqp ();
+extern int scm_ra_sum ();
+extern int scm_ra_difference ();
+extern int scm_ra_product ();
+extern int scm_ra_divide ();
+extern int scm_array_identity ();
+extern SCM scm_array_map ();
+extern SCM scm_array_for_each ();
+extern SCM scm_array_index_map_x ();
+extern SCM scm_raequal ();
+extern SCM scm_array_equal_p ();
+extern void scm_init_ramap ();
+
+#endif /* STDC */
+
+
+
+
+#endif  /* RAMAPH */
diff --git a/libguile/read.c b/libguile/read.c
new file mode 100644
index 000000000..1340fc1f4
--- /dev/null
+++ b/libguile/read.c
@@ -0,0 +1,597 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "extchrs.h"
+#include <stdio.h>
+#include "_scm.h"
+#include "read.h"
+
+
+
+#define default_case_i 0
+
+
+
+SCM_PROC (s_read, "read", 0, 3, 0, scm_read);
+#ifdef __STDC__
+SCM 
+scm_read (SCM port, SCM case_insensative_p, SCM sharp)
+#else
+SCM 
+scm_read (port, case_insensative_p, sharp)
+     SCM port;
+     SCM case_insensative_p;
+     SCM sharp;
+#endif
+{
+  int c;
+  SCM tok_buf;
+  int case_i;
+
+  if (SCM_UNBNDP (port))
+    port = scm_cur_inp;
+  else
+    SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), port, SCM_ARG1, s_read);
+
+  case_i = (SCM_UNBNDP (case_insensative_p)
+	    ? default_case_i
+	    : (case_insensative_p == SCM_BOOL_F));
+  
+  if (SCM_UNBNDP (sharp))
+    sharp = SCM_BOOL_F;
+
+  c = scm_flush_ws (port, (char *) NULL);
+  if (EOF == c)
+    return SCM_EOF_VAL;
+  scm_gen_ungetc (c, port);
+
+  tok_buf = scm_makstr (30L, 0);
+  return scm_lreadr (&tok_buf, port, case_i, sharp);
+}
+
+
+#ifdef __STDC__
+char *
+scm_grow_tok_buf (SCM * tok_buf)
+#else
+char *
+scm_grow_tok_buf (tok_buf)
+     SCM * tok_buf;
+#endif
+{
+  SCM t2;
+  scm_sizet len;
+
+  len = SCM_LENGTH (*tok_buf);
+  len += (len / 2 ? len / 2 : 1);
+  t2 = scm_makstr (len, 0);
+  {
+    char * a;
+    char * b;
+    int l;
+    for (a = SCM_CHARS (*tok_buf), b = SCM_CHARS (t2), l = SCM_LENGTH (*tok_buf);
+	 l;
+	 --l, ++a, ++b)
+      *b = *a;
+  }
+  *tok_buf = t2;
+  return SCM_CHARS (*tok_buf);
+}
+
+
+#ifdef __STDC__
+int 
+scm_flush_ws (SCM port, char *eoferr)
+#else
+int 
+scm_flush_ws (port, eoferr)
+     SCM port;
+     char *eoferr;
+#endif
+{
+  register int c;
+  while (1)
+    switch (c = scm_gen_getc (port))
+      {
+      case EOF:
+      goteof:
+	if (eoferr)
+	  scm_wta (SCM_UNDEFINED, "end of file in ", eoferr);
+	return c;
+      case ';':
+      lp:
+	switch (c = scm_gen_getc (port))
+	  {
+	  case EOF:
+	    goto goteof;
+	  default:
+	    goto lp;
+	  case SCM_LINE_INCREMENTORS:
+	    break;
+	  }
+	break;
+      case SCM_LINE_INCREMENTORS:
+	break;
+      case SCM_SINGLE_SPACES:
+	SCM_INCCOL (port);
+	break;
+      case '\t':
+	SCM_TABCOL (port);
+	break;
+      default:
+	return c;
+      }
+}
+
+
+#ifdef __STDC__
+int
+scm_casei_streq (char * s1, char * s2)
+#else
+int
+scm_casei_streq (s1, s2)
+     char * s1;
+     char * s2;
+#endif
+{
+  while (*s1 && *s2)
+    if (scm_downcase((int)*s1) != scm_downcase((int)*s2))
+      return 0;
+    else
+      {
+	++s1;
+	++s2;
+      }
+  return !(*s1 || *s2);
+}
+
+
+#ifdef __STDC__
+SCM 
+scm_lreadr (SCM * tok_buf, SCM port, int case_i, SCM sharp)
+#else
+SCM 
+scm_lreadr (tok_buf, port, case_i, sharp)
+     SCM * tok_buf;
+     SCM port;
+     int case_i;
+     SCM sharp;
+#endif
+{
+  int c;
+  scm_sizet j;
+  SCM p;
+
+tryagain:
+  c = scm_flush_ws (port, s_read);
+  switch (c)
+    {
+    case EOF:
+      return SCM_EOF_VAL;
+
+    case '(':
+      return scm_lreadparen (tok_buf, port, "list", case_i, sharp);
+
+    case ')':
+      scm_wta (SCM_UNDEFINED, "unexpected \")\"", "read");
+      goto tryagain;
+    
+    case '\'':
+      return scm_cons2 (scm_i_quote, scm_lreadr (tok_buf, port, case_i, sharp), SCM_EOL);
+
+    case '`':
+      return scm_cons2 (scm_i_quasiquote, scm_lreadr (tok_buf, port, case_i, sharp), SCM_EOL);
+
+    case ',':
+      c = scm_gen_getc (port);
+      if ('@' == c)
+	p = scm_i_uq_splicing;
+      else
+	{
+	  scm_gen_ungetc (c, port);
+	  p = scm_i_unquote;
+	}
+      return scm_cons2 (p, scm_lreadr (tok_buf, port, case_i, sharp), SCM_EOL);
+
+    case '#':
+      c = scm_gen_getc (port);
+      switch (c)
+	{
+	case '(':
+	  p = scm_lreadparen (tok_buf, port, "vector", case_i, sharp);
+	  return SCM_NULLP (p) ? scm_nullvect : scm_vector (p);
+
+	case 't':
+	case 'T':
+	  return SCM_BOOL_T;
+	case 'f':
+	case 'F':
+	  return SCM_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':
+	  scm_gen_ungetc (c, port);
+	  c = '#';
+	  goto num;
+
+	case '*':
+	  j = scm_read_token (c, tok_buf, port, case_i, 0);
+	  p = scm_istr2bve (SCM_CHARS (*tok_buf) + 1, (long) (j - 1));
+	  if (SCM_NFALSEP (p))
+	    return p;
+	  else
+	    goto unkshrp;
+
+	case '{':
+	  j = scm_read_token (c, tok_buf, port, case_i, 1);
+	  p = scm_intern (SCM_CHARS (*tok_buf), j);
+	  if (SCM_PORT_REPRESENTATION (port) != scm_regular_port)
+	    scm_set_symbol_multi_byte_x (SCM_CAR (p), SCM_BOOL_T);
+	  return SCM_CAR (p);
+
+	case '\\':
+	  c = scm_gen_getc (port);
+	  j = scm_read_token (c, tok_buf, port, case_i, 0);
+	  if (j == 1)
+	    return SCM_MAKICHR (c);
+	  if (c >= '0' && c < '8')
+	    {
+	      p = scm_istr2int (SCM_CHARS (*tok_buf), (long) j, 8);
+	      if (SCM_NFALSEP (p))
+		return SCM_MAKICHR (SCM_INUM (p));
+	    }
+	  for (c = 0; c < scm_n_charnames; c++)
+	    if (scm_charnames[c]
+		&& (scm_casei_streq (scm_charnames[c], SCM_CHARS (*tok_buf))))
+	      return SCM_MAKICHR (scm_charnums[c]);
+	  scm_wta (SCM_UNDEFINED, "unknown # object: #\\", SCM_CHARS (*tok_buf));
+
+
+	default:
+	callshrp:
+	  if (SCM_NIMP (sharp))
+	    {
+	      SCM got;
+	      got = scm_apply (sharp, SCM_MAKICHR (c), scm_acons (port, SCM_EOL, SCM_EOL));
+	      if (SCM_UNSPECIFIED == got)
+		goto unkshrp;
+	      return got;
+	    }
+	unkshrp:scm_wta ((SCM) SCM_MAKICHR (c), "unknown # object", "");
+	}
+
+    case '"':
+      j = 0;
+      while ('"' != (c = scm_gen_getc (port)))
+	{
+	  SCM_ASSERT (EOF != c, SCM_UNDEFINED, "end of file in ", "string");
+
+	  while (j + sizeof(xwchar_t) + XMB_CUR_MAX >= SCM_LENGTH (*tok_buf))
+	    scm_grow_tok_buf (tok_buf);
+
+	  if (c == '\\')
+	    switch (c = scm_gen_getc (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;
+	      }
+	  if (SCM_PORT_REPRESENTATION(port) == scm_regular_port)
+	    {
+	      SCM_CHARS (*tok_buf)[j] = c;
+	      ++j;
+	    }
+	  else
+	    {
+	      int len;
+	      len = xwctomb (SCM_CHARS (*tok_buf) + j, c);
+	      if (len == 0)
+		len = 1;
+	      SCM_ASSERT (len > 0, SCM_MAKINUM (c), "bogus char", "read");
+	      j += len;
+	    }
+	}
+      if (j == 0)
+	return scm_nullstr;
+      SCM_CHARS (*tok_buf)[j] = 0;
+      {
+	SCM str;
+	str = scm_makfromstr (SCM_CHARS (*tok_buf), j, 0);
+	if (SCM_PORT_REPRESENTATION(port) != scm_regular_port)
+	  {
+	    SCM_SETLENGTH (str, SCM_LENGTH (str), scm_tc7_mb_string);
+	  }
+	return str;
+      }
+
+    case'0':case '1':case '2':case '3':case '4':
+    case '5':case '6':case '7':case '8':case '9':
+    case '.':
+    case '-':
+    case '+':
+    num:
+      j = scm_read_token (c, tok_buf, port, case_i, 0);
+      p = scm_istring2number (SCM_CHARS (*tok_buf), (long) j, 10L);
+      if (SCM_NFALSEP (p))
+	return p;
+      if (c == '#')
+	{
+	  if ((j == 2) && (scm_gen_getc (port) == '('))
+	    {
+	      scm_gen_ungetc ('(', port);
+	      c = SCM_CHARS (*tok_buf)[1];
+	      goto callshrp;
+	    }
+	  scm_wta (SCM_UNDEFINED, "unknown # object", SCM_CHARS (*tok_buf));
+	}
+      goto tok;
+
+    case ':':
+      j = scm_read_token ('-', tok_buf, port, case_i, 0);
+      p = scm_intern (SCM_CHARS (*tok_buf), j);
+      if (SCM_PORT_REPRESENTATION (port) != scm_regular_port)
+	scm_set_symbol_multi_byte_x (SCM_CAR (p), SCM_BOOL_T);
+      return scm_make_keyword_from_dash_symbol (SCM_CAR (p));
+
+    default:
+      j = scm_read_token (c, tok_buf, port, case_i, 0);
+      /* fallthrough */
+
+    tok:
+      p = scm_intern (SCM_CHARS (*tok_buf), j);
+      if (SCM_PORT_REPRESENTATION (port) != scm_regular_port)
+	scm_set_symbol_multi_byte_x (SCM_CAR (p), SCM_BOOL_T);
+      return SCM_CAR (p);
+    }
+}
+
+#ifdef _UNICOS
+_Pragma ("noopt");		/* # pragma _CRI noopt */
+#endif
+#ifdef __STDC__
+scm_sizet 
+scm_read_token (int ic, SCM * tok_buf, SCM port, int case_i, int weird)
+#else
+scm_sizet 
+scm_read_token (ic, * tok_buf, port, case_i, weird)
+     int ic;
+     SCM *tok_buf;
+     SCM port;
+     int case_i;
+     int weird;
+#endif
+{
+  register scm_sizet j;
+  register int c;
+  register char *p;
+
+  c = ic;
+  p = SCM_CHARS (*tok_buf);
+
+  if (weird)
+    j = 0;
+  else
+    {
+      j = 0;
+      while (j + sizeof(xwchar_t) + XMB_CUR_MAX >= SCM_LENGTH (*tok_buf))
+	p = scm_grow_tok_buf (tok_buf);
+      if (SCM_PORT_REPRESENTATION(port) == scm_regular_port)
+	{
+	  p[j] = c;
+	  ++j;
+	}
+      else
+	{
+	  int len;
+	  len = xwctomb (p + j, c);
+	  if (len == 0)
+	    len = 1;
+	  SCM_ASSERT (len > 0, SCM_MAKINUM (c), "bogus char", "read");
+	  j += len;
+	}
+    }
+
+  while (1)
+    {
+      while (j + sizeof(xwchar_t) + XMB_CUR_MAX >= SCM_LENGTH (*tok_buf))
+	p = scm_grow_tok_buf (tok_buf);
+      c = scm_gen_getc (port);
+      switch (c)
+	{
+	case '(':
+	case ')':
+	case '"':
+	case ';':
+	case SCM_WHITE_SPACES:
+	case SCM_LINE_INCREMENTORS:
+	  if (weird)
+	    goto default_case;
+
+	  scm_gen_ungetc (c, port);
+	case EOF:
+	eof_case:
+	  p[j] = 0;
+	  return j;
+	case '\\':
+	  if (!weird)
+	    goto default_case;
+	  else
+	    {
+	      c = scm_gen_getc (port);
+	      if (c == EOF)
+		goto eof_case;
+	      else
+		goto default_case;
+	    }
+	case '}':
+	  if (!weird)
+	    goto default_case;
+
+	  c = scm_gen_getc (port);
+	  if (c == '#')
+	    {
+	      p[j] = 0;
+	      return j;
+	    }
+	  else
+	    {
+	      scm_gen_ungetc (c, port);
+	      c = '}';
+	      goto default_case;
+	    }
+
+	default:
+	default_case:
+	  {
+	    c = (case_i ? scm_downcase(c) : c);
+	    if (SCM_PORT_REPRESENTATION(port) == scm_regular_port)
+	      {
+		p[j] = c;
+		++j;
+	      }
+	    else
+	      {
+		int len;
+		len = xwctomb (p + j, c);
+		if (len == 0)
+		  len = 1;
+		SCM_ASSERT (len > 0, SCM_MAKINUM (c), "bogus char", "read");
+		j += len;
+	      }
+	  }
+
+	}
+    }
+}
+#ifdef _UNICOS
+_Pragma ("opt");		/* # pragma _CRI opt */
+#endif
+
+#ifdef __STDC__
+SCM 
+scm_lreadparen (SCM * tok_buf, SCM port, char *name, int case_i, SCM sharp)
+#else
+SCM 
+scm_lreadparen (tok_buf, port, name, case_i, sharp)
+     SCM *tok_buf;
+     SCM port;
+     char *name;
+     int case_i;
+     SCM sharp;
+#endif
+{
+  SCM tmp;
+  SCM tl;
+  SCM ans;
+  int c;
+
+  c = scm_flush_ws (port, name);
+  if (')' == c)
+    return SCM_EOL;
+  scm_gen_ungetc (c, port);
+  if (scm_i_dot == (tmp = scm_lreadr (tok_buf, port, case_i, sharp)))
+    {
+      ans = scm_lreadr (tok_buf, port, case_i, sharp);
+    closeit:
+      if (')' != (c = scm_flush_ws (port, name)))
+	scm_wta (SCM_UNDEFINED, "missing close paren", "");
+      return ans;
+    }
+  ans = tl = scm_cons (tmp, SCM_EOL);
+  while (')' != (c = scm_flush_ws (port, name)))
+    {
+      scm_gen_ungetc (c, port);
+      if (scm_i_dot == (tmp = scm_lreadr (tok_buf, port, case_i, sharp)))
+	{
+	  SCM_CDR (tl) = scm_lreadr (tok_buf, port, case_i, sharp);
+	  goto closeit;
+	}
+      tl = (SCM_CDR (tl) = scm_cons (tmp, SCM_EOL));
+    }
+  return ans;
+}
+
+
+
+
+
+#ifdef __STDC__
+void
+scm_init_read (void)
+#else
+void
+scm_init_read ()
+#endif
+{
+#include "read.x"
+}
+
diff --git a/libguile/read.h b/libguile/read.h
new file mode 100644
index 000000000..edaea932b
--- /dev/null
+++ b/libguile/read.h
@@ -0,0 +1,94 @@
+/* classes: h_files */
+
+#ifndef READH
+#define READH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+
+
+
+/* SCM_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.
+ *
+ * SCM_WHITE_SPACES are other characters which should be treated like spaces
+ * in programs.
+ */
+
+#define SCM_LINE_INCREMENTORS  '\n'
+
+#ifdef MSDOS
+# define SCM_SINGLE_SPACES  ' ':case '\r':case '\f': case 26
+#else
+# define SCM_SINGLE_SPACES  ' ':case '\r':case '\f'
+#endif
+
+#define SCM_WHITE_SPACES  SCM_SINGLE_SPACES: case '\t'
+
+
+
+#ifdef __STDC__
+extern SCM scm_read (SCM port, SCM casep, SCM sharp);
+extern char * scm_grow_tok_buf (SCM * tok_buf);
+extern int scm_flush_ws (SCM port, char *eoferr);
+extern int scm_casei_streq (char * s1, char * s2);
+extern SCM scm_lreadr (SCM * tok_buf, SCM port, int case_i, SCM sharp);
+extern scm_sizet scm_read_token (int ic, SCM * tok_buf, SCM port, int case_i, int weird);
+extern SCM scm_lreadparen (SCM * tok_buf, SCM port, char *name, int case_i, SCM sharp);
+extern void scm_init_read (void);
+
+#else /* STDC */
+extern SCM scm_read ();
+extern char * scm_grow_tok_buf ();
+extern int scm_flush_ws ();
+extern int scm_casei_streq ();
+extern SCM scm_lreadr ();
+extern scm_sizet scm_read_token ();
+extern SCM scm_lreadparen ();
+extern void scm_init_read ();
+
+#endif /* STDC */
+
+
+#endif  /* READH */
diff --git a/libguile/root.c b/libguile/root.c
new file mode 100644
index 000000000..9db2e9b18
--- /dev/null
+++ b/libguile/root.c
@@ -0,0 +1,101 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+
+SCM scm_sys_protects[SCM_NUM_PROTECTS];
+struct scm_root_state the_scm_root;
+struct scm_root_state * scm_root = &the_scm_root;
+
+
+
+
+
+
+
+/* Call thunk(closure) underneath a top-level error handler.
+ * If an error occurs, pass the exitval through err_filter and return it.
+ * If no error occurs, return the value of thunk.
+ */
+
+
+#ifdef _UNICOS
+typedef int setjmp_type;
+#else
+typedef long setjmp_type;
+#endif
+
+
+#ifdef __STDC__
+SCM
+scm_call_catching_errors (SCM (*thunk)(), SCM (*err_filter)(), void * closure)
+#else
+SCM
+scm_call_catching_errors (thunk, err_filter, closure)
+     SCM (*thunk)();
+     SCM (*err_filter)();
+     void * closure;
+#endif
+{
+  SCM answer;
+  setjmp_type i;
+  i = setjmp (SCM_JMPBUF (scm_rootcont));
+  if (!i)
+    {
+      scm_gc_heap_lock = 0;
+      answer = thunk (closure);
+    }
+  else
+    {
+      scm_gc_heap_lock = 1;
+      answer = err_filter (scm_exitval, closure);
+    }
+  return answer;
+}
+
+
+
+
+
diff --git a/libguile/root.h b/libguile/root.h
new file mode 100644
index 000000000..370563dad
--- /dev/null
+++ b/libguile/root.h
@@ -0,0 +1,138 @@
+/* classes: h_files */
+
+#ifndef ROOTH
+#define ROOTH
+
+/*	Copyright (C) 1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+
+
+#include "__scm.h"
+
+
+
+#define scm_flo0 scm_sys_protects[0]
+#define scm_listofnull scm_sys_protects[1]
+#define scm_undefineds scm_sys_protects[2]
+#define scm_nullvect scm_sys_protects[3]
+#define scm_nullstr scm_sys_protects[4]
+#define scm_symhash scm_sys_protects[5]
+#define scm_weak_symhash scm_sys_protects[6]
+#define scm_symhash_vars scm_sys_protects[7]
+#define scm_kw_obarray scm_sys_protects[8]
+#define scm_type_obj_list scm_sys_protects[9]
+#define scm_first_type scm_sys_protects[10]
+#define scm_stand_in_procs scm_sys_protects[11]
+#define scm_object_whash scm_sys_protects[12]
+#define scm_permobjs scm_sys_protects[13]
+#define scm_asyncs scm_sys_protects[14]
+#define SCM_NUM_PROTECTS 15
+
+extern SCM scm_sys_protects[];
+
+
+
+struct scm_root_state
+{
+  SCM_STACKITEM * stack_base;
+  jmp_buf save_regs_gc_mark;
+  int errjmp_bad;
+
+  SCM rootcont;
+  SCM dynwinds;
+  SCM continuation_stack;
+  SCM continuation_stack_ptr;
+
+  SCM progargs;			/* vestigial */
+  SCM exitval;			/* vestigial */
+
+  SCM cur_inp;
+  SCM cur_outp;
+  SCM cur_errp;
+  SCM def_inp;
+  SCM def_outp;
+  SCM def_errp;
+
+  SCM system_transformer;
+  SCM top_level_lookup_thunk_var;
+};
+
+#define scm_stack_base			(scm_root->stack_base)
+#define scm_save_regs_gc_mark		(scm_root->save_regs_gc_mark)
+#define scm_errjmp_bad			(scm_root->errjmp_bad)
+
+#define scm_rootcont			(scm_root->rootcont)
+#define scm_dynwinds			(scm_root->dynwinds)
+#define scm_continuation_stack		(scm_root->continuation_stack)
+#define scm_continuation_stack_ptr	(scm_root->continuation_stack_ptr)
+#define scm_progargs			(scm_root->progargs)
+#define scm_exitval 			(scm_root->exitval)
+#define scm_cur_inp			(scm_root->cur_inp)
+#define scm_cur_outp			(scm_root->cur_outp)
+#define scm_cur_errp			(scm_root->cur_errp)
+#define scm_def_inp			(scm_root->def_inp)
+#define scm_def_outp			(scm_root->def_outp)
+#define scm_def_errp			(scm_root->def_errp)
+#define scm_top_level_lookup_thunk_var	(scm_root->top_level_lookup_thunk_var)
+#define scm_system_transformer		(scm_root->system_transformer)
+
+
+extern struct scm_root_state * scm_root;
+
+
+
+
+#ifdef __STDC__
+extern SCM scm_call_catching_errors (SCM (*thunk)(), SCM (*err_filter)(), void * closure);
+
+#else /* STDC */
+extern SCM scm_call_catching_errors ();
+
+#endif /* STDC */
+
+
+
+
+
+
+#endif  /* ROOTH */
diff --git a/libguile/scmconfig.h.in b/libguile/scmconfig.h.in
new file mode 100644
index 000000000..af237dbdc
--- /dev/null
+++ b/libguile/scmconfig.h.in
@@ -0,0 +1,159 @@
+/* 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 to the type of elements in the array set by `getgroups'.
+   Usually this is either `int' or `gid_t'.  */
+#undef GETGROUPS_T
+
+/* Define to `int' if <sys/types.h> doesn't define.  */
+#undef gid_t
+
+/* Define if your struct stat has st_blksize.  */
+#undef HAVE_ST_BLKSIZE
+
+/* Define if your struct stat has st_blocks.  */
+#undef HAVE_ST_BLOCKS
+
+/* Define if your struct stat has st_rdev.  */
+#undef HAVE_ST_RDEV
+
+/* Define if you have <sys/wait.h> that is POSIX.1 compatible.  */
+#undef HAVE_SYS_WAIT_H
+
+/* Define if on MINIX.  */
+#undef _MINIX
+
+/* 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 to `int' if <sys/types.h> doesn't define.  */
+#undef uid_t
+
+/* Define if you have the ftime function.  */
+#undef HAVE_FTIME
+
+/* Define if you have the getcwd function.  */
+#undef HAVE_GETCWD
+
+/* Define if you have the geteuid function.  */
+#undef HAVE_GETEUID
+
+/* Define if you have the lstat function.  */
+#undef HAVE_LSTAT
+
+/* Define if you have the mkdir function.  */
+#undef HAVE_MKDIR
+
+/* Define if you have the mknod function.  */
+#undef HAVE_MKNOD
+
+/* Define if you have the nice function.  */
+#undef HAVE_NICE
+
+/* Define if you have the putenv function.  */
+#undef HAVE_PUTENV
+
+/* Define if you have the readlink function.  */
+#undef HAVE_READLINK
+
+/* Define if you have the rename function.  */
+#undef HAVE_RENAME
+
+/* Define if you have the rmdir function.  */
+#undef HAVE_RMDIR
+
+/* Define if you have the select function.  */
+#undef HAVE_SELECT
+
+/* Define if you have the setlocale function.  */
+#undef HAVE_SETLOCALE
+
+/* Define if you have the strftime function.  */
+#undef HAVE_STRFTIME
+
+/* Define if you have the strptime function.  */
+#undef HAVE_STRPTIME
+
+/* Define if you have the symlink function.  */
+#undef HAVE_SYMLINK
+
+/* Define if you have the sync function.  */
+#undef HAVE_SYNC
+
+/* Define if you have the times function.  */
+#undef HAVE_TIMES
+
+/* Define if you have the uname function.  */
+#undef HAVE_UNAME
+
+/* Define if you have the <dirent.h> header file.  */
+#undef HAVE_DIRENT_H
+
+/* Define if you have the <limits.h> header file.  */
+#undef HAVE_LIMITS_H
+
+/* Define if you have the <malloc.h> header file.  */
+#undef HAVE_MALLOC_H
+
+/* Define if you have the <memory.h> header file.  */
+#undef HAVE_MEMORY_H
+
+/* Define if you have the <ndir.h> header file.  */
+#undef HAVE_NDIR_H
+
+/* Define if you have the <string.h> header file.  */
+#undef HAVE_STRING_H
+
+/* Define if you have the <sys/dir.h> header file.  */
+#undef HAVE_SYS_DIR_H
+
+/* Define if you have the <sys/ndir.h> header file.  */
+#undef HAVE_SYS_NDIR_H
+
+/* Define if you have the <sys/select.h> header file.  */
+#undef HAVE_SYS_SELECT_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
+
+#undef SCM_SINGLES
+
+#undef SCM_STACK_GROWS_UP
+
diff --git a/libguile/scmhob.h b/libguile/scmhob.h
new file mode 100644
index 000000000..127f4d5c1
--- /dev/null
+++ b/libguile/scmhob.h
@@ -0,0 +1,205 @@
+/* This was modified to try out compiling with Guile. */
+
+
+/*   scmhob.h is a header file for scheme source compiled with hobbit4d
+     Copyright (C) 1992, 1993, 1994, 1995 Tanel Tammet 
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 1, or (at your option)
+any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+*/
+
+
+#include <stdio.h>
+#include <ctype.h>
+#include "_scm.h"
+
+
+
+#define abrt 			scm_abort
+#define absval 			scm_abs
+#define angle			scm_angle
+#define append			scm_append
+#define assoc			scm_assoc
+#define assq			scm_assq
+#define assv			scm_assv
+#define big2dbl			scm_big2dbl
+#define close_port		scm_close_port
+#define cons			scm_cons
+#define cur_input_port		scm_current_input_port
+#define cur_output_port		scm_current_output_port
+#define difference		scm_difference
+#define display			scm_display
+#define divide			scm_divide
+#define eof_objectp		scm_eof_object_p
+#define eqp			scm_eq_p
+#define equal			scm_equal_p
+#define eqv			scm_eqv_p
+#define evenp			scm_even_p
+#define exactp			scm_exact_p
+#define greaterp		scm_gr_p
+#define greqp			scm_geq_p
+#define imag_part		scm_imag_part
+#define in2ex			scm_inexact_to_exact
+#define inexactp		scm_inexact_p
+#define input_portp		scm_input_port_p
+#define intp			scm_int_p
+#define length			scm_length
+#define leqp			scm_leq_p
+#define lessp			scm_less_p
+#define lgcd			scm_gcd
+#define list_ref		scm_list_ref
+#define list_tail		scm_list_tail
+#define listp			scm_list_p
+#define llcm			scm_lcm
+#define lmax			scm_max
+#define lmin			scm_min
+#define lquotient		scm_quotient
+#define lread(X)		scm_read((X), SCM_UNDEFINED)
+#define lremainder		scm_remainder
+#define lwrite			scm_write
+#define magnitude		scm_magnitude
+#define makcclo			scm_makcclo
+#define makdbl			scm_makdbl
+#define make_string		scm_make_string
+#define make_vector		scm_make_vector
+#define makpolar		scm_make_polar
+#define makrect			scm_make_rectangular
+#define member			scm_member
+#define memq			scm_memq
+#define memv			scm_memv
+#define modulo			scm_modulo
+#define my_time			scm_get_internal_run_time
+#define negativep		scm_negative_p
+#define newline			scm_newline
+#define number2string		scm_number_to_string
+#define oddp			scm_odd_p
+#define open_file		scm_open_file
+#define output_portp		scm_output_port_p
+#define peek_char		scm_peek_char
+#define positivep		scm_positive_p
+#define procedurep		scm_procedure_p
+#define product			scm_product
+#define quit			scm_quit
+#define read_char		scm_read_char
+#define real_part		scm_real_part
+#define realp			scm_real_p
+#define reverse			scm_reverse
+#define set_inp			scm_set_current_input_port
+#define set_outp		scm_set_current_output_port
+#define st_append		scm_string_append
+#define st_equal		scm_string_equal_p
+#define st_leqp			scm_string_leq_p
+#define st_lessp		scm_string_less_p
+#define st_set			scm_string_set_x
+#define stci_equal		scm_string_ci_equal_p
+#define stci_leqp		scm_string_ci_leq_p
+#define stci_lessp		scm_string_ci_less_p
+#define string			scm_string
+#define string2list		scm_string_to_list
+#define string2number		scm_string_to_number
+#define string2symbol		scm_string_to_symbol
+#define string_copy		scm_string_copy
+#define string_fill		scm_string_fill_x
+#define substring		scm_substring
+#define sum			scm_sum
+#define symbol2string		scm_symbol_to_string
+#define vector			scm_vector
+#define vector2list		scm_vector_to_list
+#define vector_ref		scm_vector_ref
+#define vector_set		scm_vector_set_x
+#define write_char		scm_write_char
+#define zerop			scm_zero_p
+			
+
+
+#define STBL_VECTOR_SET(v,k,o) (v[((long)SCM_INUM(k))] = o)
+#define STBL_VECTOR_REF(v,k) (v[((long)SCM_INUM(k))])
+#define CHAR_LESSP(x,y) ((SCM_ICHR(x) < SCM_ICHR(y)) ? SCM_BOOL_T : SCM_BOOL_F)
+#define CHAR_LEQP(x,y) ((SCM_ICHR(x) <= SCM_ICHR(y)) ? SCM_BOOL_T : SCM_BOOL_F)
+#define CHCI_EQ(x,y) ((upcase[SCM_ICHR(x)]==upcase[SCM_ICHR(y)]) ? SCM_BOOL_T : SCM_BOOL_F)
+#define CHCI_LESSP(x,y) ((upcase[SCM_ICHR(x)] < upcase[SCM_ICHR(y)]) ? SCM_BOOL_T : SCM_BOOL_F)
+#define CHCI_LEQP(x,y) ((upcase[SCM_ICHR(x)] <= upcase[SCM_ICHR(y)]) ? SCM_BOOL_T : SCM_BOOL_F)
+#define CHAR_ALPHAP(chr) ((isascii(SCM_ICHR(chr)) && isalpha(SCM_ICHR(chr))) ? SCM_BOOL_T : SCM_BOOL_F)
+#define CHAR_SCM_NUMP(chr) ((isascii(SCM_ICHR(chr)) && isdigit(SCM_ICHR(chr))) ? SCM_BOOL_T : SCM_BOOL_F)
+#define CHAR_WHITEP(chr) ((isascii(SCM_ICHR(chr)) && isspace(SCM_ICHR(chr))) ? SCM_BOOL_T : SCM_BOOL_F)
+#define CHAR_UPPERP(chr) ((isascii(SCM_ICHR(chr)) && isupper(SCM_ICHR(chr))) ? SCM_BOOL_T : SCM_BOOL_F)
+#define CHAR_LOWERP(chr) ((isascii(SCM_ICHR(chr)) && islower(SCM_ICHR(chr))) ? SCM_BOOL_T : SCM_BOOL_F)
+#define CHAR2INT(chr) SCM_MAKINUM(SCM_ICHR(chr))
+#define INT2CHAR(n) SCM_MAKICHR(SCM_INUM(n))
+#define CHAR_UPCASE(chr) SCM_MAKICHR(upcase[SCM_ICHR(chr)])
+#define CHAR_DOWNCASE(chr) SCM_MAKICHR(downcase[SCM_ICHR(chr)])
+#define ST_SCM_LENGTH(str) SCM_MAKINUM(SCM_LENGTH(str))
+#define ST_REF(str,k) SCM_MAKICHR(SCM_CHARS(str)[SCM_INUM(k)])
+#define VECTOR_SCM_LENGTH(v)  SCM_MAKINUM(SCM_LENGTH(v))
+
+#ifdef SCM_FLOATS
+#include <math.h>
+#endif
+#ifdef SCM_BIGDIG
+#define PRE_TRANSC_FUN(x) (SCM_INUMP(x) ? (double) SCM_INUM(x) : (SCM_REALP(x) ? (double) SCM_REALPART(x) : (double) big2dbl(x)))
+#else
+#define PRE_TRANSC_FUN(x) (SCM_INUMP(x) ?  (double) SCM_INUM(x) : (double) SCM_REALPART(x))
+#endif
+
+#define SIN_FUN(x) (makdbl( sin( PRE_TRANSC_FUN(x)), 0.0))
+#define COS_FUN(x) (makdbl( cos( PRE_TRANSC_FUN(x)), 0.0))
+#define TAN_FUN(x) (makdbl( tan( PRE_TRANSC_FUN(x)), 0.0))
+#define ASIN_FUN(x) (makdbl( asin( PRE_TRANSC_FUN(x)), 0.0))
+#define ACOS_FUN(x) (makdbl( acos( PRE_TRANSC_FUN(x)), 0.0))
+#define ATAN_FUN(x) (makdbl( atan( PRE_TRANSC_FUN(x)), 0.0))
+#define SINH_FUN(x) (makdbl( sinh( PRE_TRANSC_FUN(x)), 0.0))
+#define COSH_FUN(x) (makdbl( cosh( PRE_TRANSC_FUN(x)), 0.0))
+#define TANH_FUN(x) (makdbl( tanh( PRE_TRANSC_FUN(x)), 0.0))
+#define ASINH_FUN(x) (makdbl( asinh( PRE_TRANSC_FUN(x)), 0.0))
+#define ACOSH_FUN(x) (makdbl( acosh( PRE_TRANSC_FUN(x)), 0.0))
+#define ATANH_FUN(x) (makdbl( atanh( PRE_TRANSC_FUN(x)), 0.0))
+#define SQRT_FUN(x) (makdbl( sqrt( PRE_TRANSC_FUN(x)), 0.0))
+#define EXPT_FUN(x,y) (makdbl( pow(( PRE_TRANSC_FUN(x)), ( PRE_TRANSC_FUN(y))), 0.0))
+#define EXP_FUN(x) (makdbl( exp( PRE_TRANSC_FUN(x)), 0.0))
+#define LOG_FUN(x) (makdbl( log( PRE_TRANSC_FUN(x)), 0.0))
+#define ABS_FUN(x) (makdbl( fabs( PRE_TRANSC_FUN(x)), 0.0))
+#define EX2IN_FUN(x) (makdbl( PRE_TRANSC_FUN(x), 0.0))
+#define SCM_FLOOR_FUN(x) (makdbl( floor( PRE_TRANSC_FUN(x)), 0.0))
+#define CEILING_FUN(x) (makdbl( ceil( PRE_TRANSC_FUN(x)), 0.0))
+#define TRUNCATE_FUN(x) (makdbl( ltrunc( PRE_TRANSC_FUN(x)), 0.0))
+#define ROUND_FUN(x) (makdbl(round( PRE_TRANSC_FUN(x)), 0.0))
+
+/* the following defs come from the #ifdef HOBBIT part of scm.h */
+
+#define SBOOL(x) ((x) ? SCM_BOOL_T : SCM_BOOL_F)
+
+#define BOOLEAN_P(x) ((x)==SCM_BOOL_T || (x)==SCM_BOOL_F)
+#define CHAR_P SCM_ICHRP
+#define SYMBOL_P(x) (SCM_ISYMP(x) || (!(SCM_IMP(x)) && SCM_SYMBOLP(x))) 
+#define VECTOR_P(x) (!(SCM_IMP(x)) && SCM_VECTORP(x)) 
+#define PAIR_P(x) (!(SCM_IMP(x)) && SCM_CONSP(x))     
+#define NUMBER_P SCM_INUMP
+#define INTEGER_P SCM_INUMP
+#define STRING_P(x) (!(SCM_IMP(x)) && SCM_STRINGP(x))
+#define NULL_P SCM_NULLP
+#define ZERO_P(x) ((x)==SCM_INUM0)
+#define POSITIVE_P(x) ((x) > SCM_INUM0)
+#define NEGATIVE_P(x) ((x) < SCM_INUM0)
+
+#define NOT(x) ((x)==SCM_BOOL_F ? SCM_BOOL_T : SCM_BOOL_F)
+#define SET_CAR(x,y) (CAR(x) = (SCM)(y))
+#define SET_CDR(x,y) (CDR(x) = (SCM)(y))
+#define VECTOR_SET(v,k,o) (SCM_VELTS(v)[((long)SCM_INUM(k))] = o)
+#define VECTOR_REF(v,k) (SCM_VELTS(v)[((long)SCM_INUM(k))])
+#define CL_VECTOR_SET(v,k,o) (SCM_VELTS(v)[k] = o)
+#define CL_VECTOR_REF(v,k) (SCM_VELTS(v)[k])
+#define GLOBAL(x) (*(x))
+
+#define append2(lst1,lst2) (append(scm_cons2(lst1,lst2,SCM_EOL)))
+#define procedure_pred_(x) (SCM_BOOL_T==procedurep(x))
diff --git a/libguile/scmsigs.c b/libguile/scmsigs.c
new file mode 100644
index 000000000..bb7f740f9
--- /dev/null
+++ b/libguile/scmsigs.c
@@ -0,0 +1,397 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include <signal.h>
+#include "_scm.h"
+
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+
+
+
+
+#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
+
+
+
+#define SIGFN(NAME, SCM_NAME, SIGNAL) \
+static SIGRETTYPE \
+NAME (sig) \
+     int sig; \
+{ \
+  signal (SIGNAL, NAME); \
+  scm_take_signal (SCM_NAME); \
+}
+
+#ifdef SIGHUP
+SIGFN(scm_hup_signal, SCM_HUP_SIGNAL, SIGHUP)
+#endif
+
+#ifdef SIGINT
+SIGFN(scm_int_signal, SCM_INT_SIGNAL, SIGINT)
+#endif
+
+#ifdef SIGFPE
+SIGFN(scm_fpe_signal, SCM_FPE_SIGNAL, SIGFPE)
+#endif
+
+#ifdef SIGBUS
+SIGFN(scm_bus_signal, SCM_BUS_SIGNAL, SIGBUS)
+#endif
+
+#ifdef SIGSEGV
+SIGFN(scm_segv_signal, SCM_SEGV_SIGNAL, SIGSEGV)
+#endif
+
+#ifdef SIGALRM
+SIGFN(scm_alrm_signal, SCM_ALRM_SIGNAL, SIGALRM)
+#endif
+
+#define FAKESIGFN(NAME, SCM_NAME) \
+static SIGRETTYPE \
+NAME (sig) \
+     int sig; \
+{ \
+  scm_take_signal (SCM_NAME); \
+}
+
+#if 0
+/* !!! */
+FAKESIGFN(scm_gc_signal, SCM_GC_SIGNAL)
+FAKESIGFN(scm_tick_signal, SCM_TICK_SIGNAL)
+#endif
+
+
+SCM_PROC(s_alarm, "alarm", 1, 0, 0, scm_alarm);
+#ifdef __STDC__
+SCM 
+scm_alarm (SCM i)
+#else
+SCM 
+scm_alarm (i)
+     SCM i;
+#endif
+{
+  unsigned int j;
+  SCM_ASSERT (SCM_INUMP (i) && (SCM_INUM (i) >= 0), i, SCM_ARG1, s_alarm);
+  SCM_SYSCALL (j = alarm (SCM_INUM (i)));
+  return SCM_MAKINUM (j);
+}
+
+
+SCM_PROC(s_pause, "pause", 0, 0, 0, scm_pause);
+#ifdef __STDC__
+SCM 
+scm_pause (void)
+#else
+SCM 
+scm_pause ()
+#endif
+{
+  pause ();
+  return SCM_UNSPECIFIED;
+}
+
+SCM_PROC(s_sleep, "sleep", 1, 0, 0, scm_sleep);
+#ifdef __STDC__
+SCM 
+scm_sleep (SCM i)
+#else
+SCM 
+scm_sleep (i)
+     SCM i;
+#endif
+{
+  unsigned int j;
+  SCM_ASSERT (SCM_INUMP (i) && (SCM_INUM (i) >= 0), i, SCM_ARG1, s_sleep);
+#ifdef __HIGHC__
+  SCM_SYSCALL(j = 0; sleep(SCM_INUM(i)););
+#else
+  SCM_SYSCALL(j = sleep(SCM_INUM(i)););
+#endif
+  return SCM_MAKINUM (j);
+}
+
+SCM_PROC(s_raise, "raise", 1, 0, 0, scm_raise);
+#ifdef __STDC__
+SCM
+scm_raise(SCM sig)
+#else
+SCM
+scm_raise(sig)
+     SCM sig;
+#endif
+{
+  SCM_ASSERT(SCM_INUMP(sig), sig, SCM_ARG1, s_raise);
+# ifdef vms
+  return SCM_MAKINUM(gsignal((int)SCM_INUM(sig)));
+# else
+  return kill (getpid(), (int)SCM_INUM(sig)) ? SCM_BOOL_F : SCM_BOOL_T;
+# endif
+}
+
+
+#ifdef SIGHUP
+static SIGRETTYPE (*oldhup) ();
+#endif
+
+#ifdef SIGINT
+static SIGRETTYPE (*oldint) ();
+#endif
+
+#ifdef SIGFPE
+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
+
+
+#ifdef __STDC__
+void 
+scm_init_signals (void)
+#else
+void 
+scm_init_signals ()
+#endif
+{
+#ifdef SIGINT
+  oldint = signal (SIGINT, scm_int_signal);
+#endif
+#ifdef SIGHUP
+  oldhup = signal (SIGHUP, scm_hup_signal);
+#endif
+#ifdef SIGFPE
+  oldfpe = signal (SIGFPE, scm_fpe_signal);
+#endif
+#ifdef SIGBUS
+  oldbus = signal (SIGBUS, scm_bus_signal);
+#endif
+#ifdef SIGSEGV			/* AMIGA lacks! */
+  oldsegv = signal (SIGSEGV, scm_segv_signal);
+#endif
+#ifdef SIGALRM
+  alarm (0);			/* kill any pending ALRM interrupts */
+  oldalrm = signal (SIGALRM, scm_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 */
+#ifdef __STDC__
+void 
+scm_ignore_signals (void)
+#else
+void 
+scm_ignore_signals ()
+#endif
+{
+#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 SCM_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 scm_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);
+}
+
+#ifdef __STDC__
+void 
+scm_unignore_signals (void)
+#else
+void 
+scm_unignore_signals ()
+#endif
+{
+  signal (SIGINT, scm_int_signal);
+#ifdef SIGHUP
+  signal (SIGHUP, scm_hup_signal);
+#endif
+#ifdef SCM_FLOATS
+  signal (SIGFPE, scm_fpe_signal);
+#endif
+#ifdef SIGBUS
+  signal (SIGBUS, scm_bus_signal);
+#endif
+#ifdef SIGSEGV			/* AMIGA lacks! */
+  signal (SIGSEGV, scm_segv_signal);
+#endif
+#ifdef SIGALRM
+  signal (SIGALRM, scm_alrm_signal);
+#endif
+#ifdef ultrix
+  siginterrupt (SIGINT, 1);
+  siginterrupt (SIGALRM, 1);
+  siginterrupt (SIGHUP, 1);
+  siginterrupt (SIGPIPE, 1);
+#endif /* ultrix */
+}
+
+SCM_PROC (s_restore_signals, "restore-signals", 0, 0, 0, scm_restore_signals);
+#ifdef __STDC__
+SCM
+scm_restore_signals (void)
+#else
+SCM
+scm_restore_signals ()
+#endif
+{
+#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 SCM_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
+  return SCM_UNSPECIFIED;
+}
+
+
+#ifdef __STDC__
+void
+scm_init_scmsigs (void)
+#else
+void
+scm_init_scmsigs ()
+#endif
+{
+#include "scmsigs.x"
+}
+
diff --git a/libguile/scmsigs.h b/libguile/scmsigs.h
new file mode 100644
index 000000000..484b15e9d
--- /dev/null
+++ b/libguile/scmsigs.h
@@ -0,0 +1,79 @@
+/* classes: h_files */
+
+#ifndef SCMSIGSH
+#define SCMSIGSH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+
+
+#ifdef __STDC__
+extern SCM scm_alarm (SCM i);
+extern SCM scm_pause (void);
+extern SCM scm_sleep (SCM i);
+extern SCM scm_raise(SCM sig);
+extern void scm_init_signals (void);
+extern void scm_ignore_signals (void);
+extern void scm_unignore_signals (void);
+extern SCM scm_restore_signals (void);
+extern void scm_init_scmsigs (void);
+
+#else /* STDC */
+extern SCM scm_alarm ();
+extern SCM scm_pause ();
+extern SCM scm_sleep ();
+extern SCM scm_raise();
+extern void scm_init_signals ();
+extern void scm_ignore_signals ();
+extern void scm_unignore_signals ();
+extern SCM scm_restore_signals ();
+extern void scm_init_scmsigs ();
+
+#endif /* STDC */
+
+
+
+
+
+
+
+#endif  /* SCMSIGSH */
diff --git a/libguile/sequences.c b/libguile/sequences.c
new file mode 100644
index 000000000..6973f74dc
--- /dev/null
+++ b/libguile/sequences.c
@@ -0,0 +1,128 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+
+
+
+#ifdef __STDC__
+int
+scm_obj_length (SCM obj)
+#else
+int
+scm_obj_length (obj)
+     SCM obj;
+#endif
+{
+  int i;
+  i = scm_ilength(obj);
+  if (i >= 0)
+    return i;
+  else if (SCM_NIMP (obj))
+    {
+      if (SCM_ROSTRINGP (obj))
+	return SCM_ROLENGTH (obj);
+      else if (SCM_VECTORP (obj))
+	return SCM_LENGTH (obj);
+      else
+	return -1;
+    }
+  else
+    return -1;
+}
+
+
+SCM_PROC(s_length, "length", 1, 0, 0, scm_length);
+#ifdef __STDC__
+SCM
+scm_length(SCM x)
+#else
+SCM
+scm_length(x)
+     SCM x;
+#endif
+{
+  int i;
+  i = scm_obj_length(x);
+  if (i >= 0)
+    return SCM_MAKINUM (i);
+  else
+    {
+      SCM_ASSERT(0, x, SCM_ARG1, s_length);
+      return SCM_BOOL_F;
+    }
+}
+
+
+
+
+
+SCM_PROC (s_reverse, "reverse", 1, 0, 0, scm_reverse);
+#ifdef __STDC__
+SCM
+scm_reverse (SCM objs)
+#else
+SCM
+scm_reverse (objs)
+     SCM objs;
+#endif
+{
+  return scm_list_reverse (objs);
+}
+
+
+
+
+#ifdef __STDC__
+void
+scm_init_sequences (void)
+#else
+void
+scm_init_sequences ()
+#endif
+{
+#include "sequences.x"
+}
+
diff --git a/libguile/sequences.h b/libguile/sequences.h
new file mode 100644
index 000000000..a508daa9b
--- /dev/null
+++ b/libguile/sequences.h
@@ -0,0 +1,70 @@
+/* classes: h_files */
+
+#ifndef SEQUENCESH
+#define SEQUENCESH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+#include "__scm.h"
+
+
+
+
+
+
+#ifdef __STDC__
+extern int scm_obj_length (SCM obj);
+extern SCM scm_length(SCM x);
+extern SCM scm_reverse (SCM objs);
+extern void scm_init_sequences (void);
+
+#else /* STDC */
+extern int scm_obj_length ();
+extern SCM scm_length();
+extern SCM scm_reverse ();
+extern void scm_init_sequences ();
+
+#endif /* STDC */
+
+
+
+
+#endif  /* SEQUENCESH */
diff --git a/libguile/simpos.c b/libguile/simpos.c
new file mode 100644
index 000000000..f04e28cc5
--- /dev/null
+++ b/libguile/simpos.c
@@ -0,0 +1,163 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include "_scm.h"
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+
+
+extern int system();
+
+
+#ifndef _Windows
+SCM_PROC(s_system, "system", 1, 0, 0, scm_system);
+#ifdef __STDC__
+SCM
+scm_system(SCM cmd)
+#else
+SCM
+scm_system(cmd)
+     SCM cmd;
+#endif
+{
+  SCM_ASSERT(SCM_NIMP(cmd) && SCM_ROSTRINGP(cmd), cmd, SCM_ARG1, s_system);
+  if (SCM_ROSTRINGP (cmd))
+    cmd = scm_makfromstr (SCM_ROCHARS (cmd), SCM_ROLENGTH (cmd), 0);
+  scm_ignore_signals();
+# ifdef AZTEC_C
+  cmd = SCM_MAKINUM(Execute(SCM_ROCHARS(cmd), 0, 0));
+# else
+  cmd = SCM_MAKINUM(0L+system(SCM_ROCHARS(cmd)));
+# endif
+  scm_unignore_signals();
+  return cmd;
+}
+#endif
+
+extern char *getenv();
+SCM_PROC (s_sys_getenv, "%getenv", 1, 0, 0, scm_sys_getenv);
+#ifdef __STDC__
+SCM
+scm_sys_getenv(SCM nam)
+#else
+SCM
+scm_sys_getenv(nam)
+     SCM nam;
+#endif
+{
+  char *val;
+  SCM_ASSERT(SCM_NIMP(nam) && SCM_ROSTRINGP(nam), nam, SCM_ARG1, s_sys_getenv);
+  if (SCM_ROSTRINGP (nam))
+    nam = scm_makfromstr (SCM_ROCHARS (nam), SCM_ROLENGTH (nam), 0);
+  val = getenv(SCM_CHARS(nam));
+  if (!val)
+    return SCM_BOOL_F;
+  return scm_makfromstr(val, (scm_sizet)strlen(val), 0);
+}
+
+#ifdef vms
+# define SYSTNAME "VMS"
+#endif
+#ifdef unix
+# define SYSTNAME "UNIX"
+#endif
+#ifdef MWC
+# define SYSTNAME "COHERENT"
+#endif
+#ifdef _Windows
+# define SYSTNAME "WINDOWS"
+#else
+# ifdef MSDOS
+#  define SYSTNAME "MS-DOS"
+# endif
+#endif
+#ifdef __EMX__
+# define SYSTNAME "OS/2"
+#endif
+#ifdef __IBMC__
+# define SYSTNAME "OS/2"
+#endif
+#ifdef THINK_C
+# define SYSTNAME "THINKC"
+#endif
+#ifdef AMIGA
+# define SYSTNAME "AMIGA"
+#endif
+#ifdef atarist
+# define SYSTNAME "ATARIST"
+#endif
+#ifdef mach
+# define SYSTNAME "MACH"
+#endif
+#ifdef ARM_ULIB
+# define SYSTNAME "ACORN"
+#endif
+
+SCM_PROC(s_software_type, "software-type", 0, 0, 0, scm_software_type);
+#ifdef __STDC__
+SCM
+scm_software_type(void)
+#else
+SCM
+scm_software_type()
+#endif
+{
+#ifdef nosve
+  return SCM_CAR(scm_intern("nosve", 5));
+#else
+  return SCM_CAR(scm_intern(SYSTNAME, sizeof SYSTNAME/sizeof(char) -1));
+#endif
+}
+
+#ifdef __STDC__
+void
+scm_init_simpos (void)
+#else
+void
+scm_init_simpos ()
+#endif
+{
+#include "simpos.x"
+}
+
diff --git a/libguile/simpos.h b/libguile/simpos.h
new file mode 100644
index 000000000..78cce68a5
--- /dev/null
+++ b/libguile/simpos.h
@@ -0,0 +1,67 @@
+/* classes: h_files */
+
+#ifndef SSCM_IMPOSH
+#define SSCM_IMPOSH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+
+
+#ifdef __STDC__
+extern SCM scm_system(SCM cmd);
+extern SCM scm_sys_getenv(SCM nam);
+extern SCM scm_software_type(void);
+extern void scm_init_simpos (void);
+
+#else /* STDC */
+extern SCM scm_system();
+extern SCM scm_sys_getenv();
+extern SCM scm_software_type();
+extern void scm_init_simpos ();
+
+#endif /* STDC */
+
+
+
+
+
+#endif  /* SSCM_IMPOSH */
diff --git a/libguile/smob.c b/libguile/smob.c
new file mode 100644
index 000000000..4843d486f
--- /dev/null
+++ b/libguile/smob.c
@@ -0,0 +1,134 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include "_scm.h"
+#ifdef HAVE_MALLOC_H
+#include <malloc.h>
+#endif
+
+
+
+/* scm_smobs scm_numsmob
+ * implement a dynamicly resized array of smob records.
+ * Indexes into this table are used when generating type
+ * tags for smobjects (if you know a tag you can get an index and conversely).
+ */
+scm_sizet scm_numsmob;
+scm_smobfuns *scm_smobs;
+
+#ifdef __STDC__
+long 
+scm_newsmob (scm_smobfuns *smob)
+#else
+long 
+scm_newsmob (smob)
+     scm_smobfuns *smob;
+#endif
+{
+  char *tmp;
+  if (255 <= scm_numsmob)
+    goto smoberr;
+  SCM_DEFER_INTS;
+  SCM_SYSCALL (tmp = (char *) realloc ((char *) scm_smobs, (1 + scm_numsmob) * sizeof (scm_smobfuns)));
+  if (tmp)
+    {
+      scm_smobs = (scm_smobfuns *) tmp;
+      scm_smobs[scm_numsmob].mark = smob->mark;
+      scm_smobs[scm_numsmob].free = smob->free;
+      scm_smobs[scm_numsmob].print = smob->print;
+      scm_smobs[scm_numsmob].equalp = smob->equalp;
+      scm_numsmob++;
+    }
+  SCM_ALLOW_INTS;
+  if (!tmp)
+  smoberr:scm_wta (SCM_MAKINUM ((long) scm_numsmob), (char *) SCM_NALLOC, "newsmob");
+  return scm_tc7_smob + (scm_numsmob - 1) * 256;
+}
+
+/* {Initialization for i/o types, float, bignum, the type of free cells}
+ */
+
+static scm_smobfuns freecell =
+{
+  scm_mark0,
+  scm_free0,
+  0,
+  0
+};
+
+static scm_smobfuns flob =
+{
+  scm_mark0,
+  /*flofree*/ 0,
+  scm_floprint,
+  scm_floequal
+};
+
+static scm_smobfuns bigob =
+{
+  scm_mark0,
+  /*bigfree*/ 0,
+  scm_bigprint,
+  scm_bigequal
+};
+
+
+
+#ifdef __STDC__
+void
+scm_smob_prehistory (void)
+#else
+void
+scm_smob_prehistory ()
+#endif
+{
+  scm_numsmob = 0;
+  scm_smobs = (scm_smobfuns *) malloc (7 * sizeof (scm_smobfuns));
+
+  /* WARNING: These scm_newsmob calls must be done in this order */
+  scm_newsmob (&freecell);
+  scm_newsmob (&flob);
+  scm_newsmob (&bigob);
+  scm_newsmob (&bigob);		/* n.b.: two smobs, one smobfuns */
+}
+
diff --git a/libguile/smob.h b/libguile/smob.h
new file mode 100644
index 000000000..a35cefc27
--- /dev/null
+++ b/libguile/smob.h
@@ -0,0 +1,103 @@
+/* classes: h_files */
+
+#ifndef SMOBH
+#define SMOBH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+#include "__scm.h"
+#include "params.h"
+
+
+
+
+
+typedef struct scm_smobfuns
+{
+  SCM (*mark) SCM_P ((SCM));
+  scm_sizet (*free) SCM_P ((SCM));
+  int (*print) SCM_P ((SCM exp, SCM port, int writing));
+  SCM (*equalp) SCM_P ((SCM, SCM));
+} scm_smobfuns;
+
+typedef struct scm_ptobfuns
+{
+  SCM (*mark) ();
+  int (*free) ();
+  int (*print) ();
+  SCM (*equalp) ();
+  int (*fputc) ();
+  int (*fputs) ();
+  scm_sizet (*fwrite) ();
+  int (*fflush) ();
+  int (*fgetc) ();
+  int (*fclose) ();
+
+  
+  
+} scm_ptobfuns;
+
+
+
+
+#define SCM_SMOBNUM(x) (0x0ff & (SCM_CAR(x)>>8));
+#define SCM_PTOBNUM(x) (0x0ff & (SCM_CAR(x)>>8));
+
+extern scm_sizet scm_numsmob;
+extern scm_smobfuns *scm_smobs;
+
+
+#ifdef __STDC__
+extern long scm_newsmob (scm_smobfuns *smob);
+extern void scm_smob_prehistory (void);
+
+#else /* STDC */
+extern long scm_newsmob ();
+extern void scm_smob_prehistory ();
+
+#endif /* STDC */
+
+
+
+
+
+
+#endif  /* SMOBH */
diff --git a/libguile/socket.c b/libguile/socket.c
new file mode 100644
index 000000000..944609714
--- /dev/null
+++ b/libguile/socket.c
@@ -0,0 +1,408 @@
+/* "socket.c" internet socket support for client/server in SCM
+    Copyright (C) 1994 Aubrey Jaffer.
+    Thanks to Hallvard.Tretteberg@si.sintef.no
+    who credits NCSA httpd software by Rob McCool 3/21/93.
+    Rewritten by Gary Houston to be a closer interface to the C
+    socket library.
+    */
+
+
+#include <stdio.h>
+#include <string.h>
+#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 */
+
+SCM_PROC (s_sys_inet_aton, "%inet-aton", 1, 0, 0, scm_sys_inet_aton);
+#ifdef __STDC__
+SCM 
+scm_sys_inet_aton (SCM address)
+#else
+SCM 
+scm_sys_inet_aton (address)
+     SCM address;
+#endif
+{
+  struct in_addr soka;
+  int rv;
+  SCM_ASSERT (SCM_NIMP (address) && SCM_ROSTRINGP (address), address, SCM_ARG1, s_sys_inet_aton);
+  if (SCM_SUBSTRP (address))
+    address = scm_makfromstr (SCM_ROCHARS (address), SCM_ROLENGTH (address), 0);
+  rv = inet_aton (SCM_ROCHARS (address), &soka);
+  return rv ? scm_ulong2num (ntohl (soka.s_addr)) : SCM_BOOL_F;
+}
+
+
+SCM_PROC (s_inet_ntoa, "inet-ntoa", 1, 0, 0, scm_inet_ntoa);
+#ifdef __STDC__
+SCM 
+scm_inet_ntoa (SCM inetid)
+#else
+SCM 
+scm_inet_ntoa (inetid)
+     SCM inetid;
+#endif
+{
+  struct in_addr addr;
+  char *s;
+  SCM answer;
+  addr.s_addr = htonl (scm_num2ulong (inetid, (char *) SCM_ARG1, s_inet_ntoa));
+  SCM_DEFER_INTS;
+  s = inet_ntoa (addr);
+  answer = scm_makfromstr (s, strlen (s), 0);
+  SCM_ALLOW_INTS;
+  return answer;
+}
+
+SCM_PROC (s_inet_netof, "inet-netof", 1, 0, 0, scm_inet_netof);
+#ifdef __STDC__
+SCM 
+scm_inet_netof (SCM address)
+#else
+SCM 
+scm_inet_netof (address)
+     SCM address;
+#endif
+{
+  struct in_addr addr;
+  addr.s_addr = htonl (scm_num2ulong (address, (char *) SCM_ARG1, s_inet_netof));
+  return scm_ulong2num ((unsigned long) inet_netof (addr));
+}
+
+SCM_PROC (s_lnaof, "lnaof", 1, 0, 0, scm_lnaof);
+#ifdef __STDC__
+SCM 
+scm_lnaof (SCM address)
+#else
+SCM 
+scm_lnaof (address)
+     SCM address;
+#endif
+{
+  struct in_addr addr;
+  addr.s_addr = htonl (scm_num2ulong (address, (char *) SCM_ARG1, s_lnaof));
+  return scm_ulong2num ((unsigned long) inet_lnaof (addr));
+}
+
+
+SCM_PROC (s_inet_makeaddr, "inet-makeaddr", 2, 0, 0, scm_inet_makeaddr);
+#ifdef __STDC__
+SCM 
+scm_inet_makeaddr (SCM net, SCM lna)
+#else
+SCM 
+scm_inet_makeaddr (net, lna)
+     SCM net;
+     SCM lna;
+#endif
+{
+  struct in_addr addr;
+  unsigned long netnum;
+  unsigned long lnanum;
+
+  netnum = scm_num2ulong (net, (char *) SCM_ARG1, s_inet_makeaddr);
+  lnanum = scm_num2ulong (lna, (char *) SCM_ARG2, s_inet_makeaddr);
+  addr = inet_makeaddr (netnum, lnanum);
+  return scm_ulong2num (ntohl (addr.s_addr));
+}
+
+
+/* !!! Doesn't take address format.
+ * Assumes hostent stream isn't reused.
+ */
+
+SCM_PROC (s_sys_gethost, "%gethost", 0, 1, 0, scm_sys_gethost);
+#ifdef __STDC__
+SCM 
+scm_sys_gethost (SCM name)
+#else
+SCM 
+scm_sys_gethost (name)
+     SCM name;
+#endif
+{
+  SCM ans = scm_make_vector (SCM_MAKINUM (5), SCM_UNSPECIFIED, SCM_BOOL_F);
+  SCM *ve = SCM_VELTS (ans);
+  SCM lst = SCM_EOL;
+  struct hostent *entry;
+  struct in_addr inad;
+  char **argv;
+  int i = 0;
+#ifdef HAVE_GETHOSTENT
+  if (SCM_UNBNDP (name))
+    {
+      SCM_DEFER_INTS;
+      entry = gethostent ();
+    }
+  else
+#endif
+  if (SCM_NIMP (name) && SCM_STRINGP (name))
+    {
+      SCM_DEFER_INTS;
+      entry = gethostbyname (SCM_CHARS (name));
+    }
+  else
+    {
+      inad.s_addr = htonl (scm_num2ulong (name, (char *) SCM_ARG1, s_sys_gethost));
+      SCM_DEFER_INTS;
+      entry = gethostbyaddr ((char *) &inad, sizeof (inad), AF_INET);
+    }
+  SCM_ALLOW_INTS;
+  if (!entry)
+    return SCM_BOOL_F;
+  ve[0] = scm_makfromstr (entry->h_name, (scm_sizet) strlen (entry->h_name), 0);
+  ve[1] = scm_makfromstrs (-1, entry->h_aliases);
+  ve[2] = SCM_MAKINUM (entry->h_addrtype + 0L);
+  ve[3] = SCM_MAKINUM (entry->h_length + 0L);
+  if (sizeof (struct in_addr) != entry->h_length)
+    {
+      ve[4] = SCM_BOOL_F;
+      return ans;
+    }
+  for (argv = entry->h_addr_list; argv[i]; i++);
+  while (i--)
+    {
+      inad = *(struct in_addr *) argv[i];
+      lst = scm_cons (scm_ulong2num (ntohl (inad.s_addr)), lst);
+    }
+  ve[4] = lst;
+  return ans;
+}
+
+
+SCM_PROC (s_sys_getnet, "%getnet", 0, 1, 0, scm_sys_getnet);
+#ifdef __STDC__
+SCM 
+scm_sys_getnet (SCM name)
+#else
+SCM 
+scm_sys_getnet (name)
+     SCM name;
+#endif
+{
+  SCM ans;
+  SCM *ve;
+  struct netent *entry;
+
+  ans = scm_make_vector (SCM_MAKINUM (4), SCM_UNSPECIFIED, SCM_BOOL_F);
+  ve = SCM_VELTS (ans);
+  if (SCM_UNBNDP (name))
+    {
+      SCM_DEFER_INTS;
+      entry = getnetent ();
+    }
+  else if (SCM_NIMP (name) && SCM_STRINGP (name))
+    {
+      SCM_DEFER_INTS;
+      entry = getnetbyname (SCM_CHARS (name));
+    }
+  else
+    {
+      unsigned long netnum;
+      netnum = scm_num2ulong (name, (char *) SCM_ARG1, s_sys_getnet);
+      SCM_DEFER_INTS;
+      entry = getnetbyaddr (netnum, AF_INET);
+    }
+  SCM_ALLOW_INTS;
+  if (!entry)
+    return SCM_BOOL_F;
+  ve[0] = scm_makfromstr (entry->n_name, (scm_sizet) strlen (entry->n_name), 0);
+  ve[1] = scm_makfromstrs (-1, entry->n_aliases);
+  ve[2] = SCM_MAKINUM (entry->n_addrtype + 0L);
+  ve[3] = scm_ulong2num (entry->n_net + 0L);
+  return ans;
+}
+
+SCM_PROC (s_sys_getproto, "%getproto", 0, 1, 0, scm_sys_getproto);
+#ifdef __STDC__
+SCM 
+scm_sys_getproto (SCM name)
+#else
+SCM 
+scm_sys_getproto (name)
+     SCM name;
+#endif
+{
+  SCM ans;
+  SCM *ve;
+  struct protoent *entry;
+
+  ans = scm_make_vector (SCM_MAKINUM (3), SCM_UNSPECIFIED, SCM_BOOL_F);
+  ve = SCM_VELTS (ans);
+  if (SCM_UNBNDP (name))
+    {
+      SCM_DEFER_INTS;
+      entry = getprotoent ();
+    }
+  else if (SCM_NIMP (name) && SCM_STRINGP (name))
+    {
+      SCM_DEFER_INTS;
+      entry = getprotobyname (SCM_CHARS (name));
+    }
+  else
+    {
+      unsigned long protonum;
+      protonum = scm_num2ulong (name, (char *) SCM_ARG1, s_sys_getproto);
+      SCM_DEFER_INTS;
+      entry = getprotobynumber (protonum);
+    }
+  SCM_ALLOW_INTS;
+  if (!entry)
+    return SCM_BOOL_F;
+  ve[0] = scm_makfromstr (entry->p_name, (scm_sizet) strlen (entry->p_name), 0);
+  ve[1] = scm_makfromstrs (-1, entry->p_aliases);
+  ve[2] = SCM_MAKINUM (entry->p_proto + 0L);
+  return ans;
+}
+
+#ifdef __STDC__
+static SCM
+scm_return_entry (struct servent *entry)
+#else
+static SCM
+scm_return_entry (entry)
+     struct servent *entry;
+#endif
+{
+  SCM ans;
+  SCM *ve;
+
+  ans = scm_make_vector (SCM_MAKINUM (4), SCM_UNSPECIFIED, SCM_BOOL_F);
+  ve = SCM_VELTS (ans);
+  if (!entry)
+    {
+      SCM_ALLOW_INTS;
+      return SCM_BOOL_F;
+    }
+  ve[0] = scm_makfromstr (entry->s_name, (scm_sizet) strlen (entry->s_name), 0);
+  ve[1] = scm_makfromstrs (-1, entry->s_aliases);
+  ve[2] = SCM_MAKINUM (ntohs (entry->s_port) + 0L);
+  ve[3] = scm_makfromstr (entry->s_proto, (scm_sizet) strlen (entry->s_proto), 0);
+  SCM_ALLOW_INTS;
+  return ans;
+}
+
+SCM_PROC (s_sys_getserv, "%getserv", 0, 2, 0, scm_sys_getserv);
+#ifdef __STDC__
+SCM 
+scm_sys_getserv (SCM name, SCM proto)
+#else
+SCM 
+scm_sys_getserv (name, proto)
+     SCM name;
+     SCM proto;
+#endif
+{
+  struct servent *entry;
+  if (SCM_UNBNDP (name))
+    {
+      SCM_DEFER_INTS;
+      entry = getservent ();
+      return scm_return_entry (entry);
+    }
+  SCM_ASSERT (SCM_NIMP (proto) && SCM_STRINGP (proto), proto, SCM_ARG2, s_sys_getserv);
+  if (SCM_NIMP (name) && SCM_STRINGP (name))
+    {
+      SCM_DEFER_INTS;
+      entry = getservbyname (SCM_CHARS (name), SCM_CHARS (proto));
+    }
+  else
+    {
+      SCM_ASSERT (SCM_INUMP (name), name, SCM_ARG1, s_sys_getserv);
+      SCM_DEFER_INTS;
+      entry = getservbyport (SCM_INUM (name), SCM_CHARS (proto));
+    }
+  return scm_return_entry (entry);
+}
+
+SCM_PROC (s_sethost, "sethost", 0, 1, 0, scm_sethost);
+#ifdef __STDC__
+SCM 
+scm_sethost (SCM arg)
+#else
+SCM 
+scm_sethost (arg)
+     SCM arg;
+#endif
+{
+  if (SCM_UNBNDP (arg))
+    endhostent ();
+  else
+    sethostent (SCM_NFALSEP (arg));
+  return SCM_UNSPECIFIED;
+}
+
+SCM_PROC (s_setnet, "setnet", 0, 1, 0, scm_setnet);
+#ifdef __STDC__
+SCM 
+scm_setnet (SCM arg)
+#else
+SCM 
+scm_setnet (arg)
+     SCM arg;
+#endif
+{
+  if (SCM_UNBNDP (arg))
+    endnetent ();
+  else
+    setnetent (SCM_NFALSEP (arg));
+  return SCM_UNSPECIFIED;
+}
+
+SCM_PROC (s_setproto, "setproto", 0, 1, 0, scm_setproto);
+#ifdef __STDC__
+SCM 
+scm_setproto (SCM arg)
+#else
+SCM 
+scm_setproto (arg)
+     SCM arg;
+#endif
+{
+  if (SCM_UNBNDP (arg))
+    endprotoent ();
+  else
+    setprotoent (SCM_NFALSEP (arg));
+  return SCM_UNSPECIFIED;
+}
+
+SCM_PROC (s_setserv, "setserv", 0, 1, 0, scm_setserv);
+#ifdef __STDC__
+SCM 
+scm_setserv (SCM arg)
+#else
+SCM 
+scm_setserv (arg)
+     SCM arg;
+#endif
+{
+  if (SCM_UNBNDP (arg))
+    endservent ();
+  else
+    setservent (SCM_NFALSEP (arg));
+  return SCM_UNSPECIFIED;
+}
+
+#ifdef __STDC__
+void 
+scm_init_socket (void)
+#else
+void 
+scm_init_socket ()
+#endif
+{
+  scm_add_feature ("socket");
+#include "socket.x"
+}
+
+
diff --git a/libguile/socket.h b/libguile/socket.h
new file mode 100644
index 000000000..28413a228
--- /dev/null
+++ b/libguile/socket.h
@@ -0,0 +1,119 @@
+/* classes: h_files */
+
+#ifndef SOCKETH
+#define SOCKETH
+/*	Copyright (C) 1995 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+
+
+
+
+
+#ifdef __STDC__
+extern SCM scm_sys_inet_aton (SCM address);
+extern SCM scm_inet_ntoa (SCM inetid);
+extern SCM scm_inet_netof (SCM address);
+extern SCM scm_lnaof (SCM address);
+extern SCM scm_inet_makeaddr (SCM net, SCM lna);
+extern SCM scm_sys_getnet (SCM name);
+extern SCM scm_sys_getproto (SCM name);
+extern SCM scm_sys_getserv (SCM name, SCM proto);
+extern SCM scm_sethost (SCM arg);
+extern SCM scm_setnet (SCM arg);
+extern SCM scm_setproto (SCM arg);
+extern SCM scm_setserv (SCM arg);
+extern SCM scm_sys_socket (SCM family, SCM style, SCM proto);
+extern SCM scm_sys_socketpair (SCM family, SCM style, SCM proto);
+
+extern SCM scm_sys_getsockopt (SCM port, SCM level, SCM optname);
+extern SCM scm_sys_setsockopt (SCM port, SCM level, SCM optname, SCM value);
+extern SCM scm_sys_shutdown (SCM port, SCM how);
+extern SCM scm_sys_connect (SCM sockpt, SCM fam, SCM address, SCM args);
+extern SCM scm_sys_bind (SCM sockpt, SCM fam, SCM address);
+extern SCM scm_sys_listen (SCM port, SCM backlog);
+extern void scm_init_addr_buffer (void);
+extern SCM scm_sys_accept (SCM sockpt);
+extern SCM scm_sys_getsockname (SCM sockpt);
+extern SCM scm_sys_getpeername (SCM sockpt);
+extern SCM scm_sys_recv (SCM sockpt, SCM buff_or_size, SCM flags);
+extern SCM scm_sys_send (SCM sockpt, SCM message, SCM flags);
+extern SCM scm_sys_recvfrom (SCM sockpt, SCM buff_or_size, SCM flags);
+extern SCM scm_sys_sendto (SCM sockpt, SCM message, SCM fam, SCM address, SCM args_and_flags);
+extern void scm_init_socket (void);
+
+#else /* STDC */
+extern SCM scm_sys_inet_aton ();
+extern SCM scm_inet_ntoa ();
+extern SCM scm_inet_netof ();
+extern SCM scm_lnaof ();
+extern SCM scm_inet_makeaddr ();
+extern SCM scm_sys_getnet ();
+extern SCM scm_sys_getproto ();
+extern SCM scm_sys_getserv ();
+extern SCM scm_sethost ();
+extern SCM scm_setnet ();
+extern SCM scm_setproto ();
+extern SCM scm_setserv ();
+extern SCM scm_sys_socket ();
+extern SCM scm_sys_socketpair ();
+extern SCM scm_sys_getsockopt ();
+extern SCM scm_sys_setsockopt ();
+extern SCM scm_sys_shutdown ();
+extern SCM scm_sys_connect ();
+extern SCM scm_sys_bind ();
+extern SCM scm_sys_listen ();
+extern void scm_init_addr_buffer ();
+extern SCM scm_sys_accept ();
+extern SCM scm_sys_getsockname ();
+extern SCM scm_sys_getpeername ();
+extern SCM scm_sys_recv ();
+extern SCM scm_sys_send ();
+extern SCM scm_sys_recvfrom ();
+extern SCM scm_sys_sendto ();
+extern void scm_init_socket ();
+
+#endif /* STDC */
+
+
+#endif  /* SOCKETH */
diff --git a/libguile/stackchk.c b/libguile/stackchk.c
new file mode 100644
index 000000000..53a7556be
--- /dev/null
+++ b/libguile/stackchk.c
@@ -0,0 +1,112 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+
+/* {Stack Checking}
+ */
+
+#ifdef SCM_STACK_CHECK
+int scm_check_stack_p;
+
+void
+scm_report_stack_overflow ()
+{
+  scm_check_stack_p = 0;
+  scm_wta (SCM_UNDEFINED, (char *) STACK_SCM_OVSCM_FLOW, NULL);
+}
+
+#endif
+#ifdef __STDC__
+long 
+scm_stack_size (SCM_STACKITEM *start)
+#else
+long 
+scm_stack_size (start)
+     SCM_STACKITEM *start;
+#endif
+{
+  SCM_STACKITEM stack;
+#ifdef SCM_STACK_GROWS_UP
+  return &stack - start;
+#else
+  return start - &stack;
+#endif /* def SCM_STACK_GROWS_UP */
+}
+
+#ifdef __STDC__
+void 
+scm_stack_report (void)
+#else
+void 
+scm_stack_report ()
+#endif
+{
+  SCM_STACKITEM stack;
+  scm_intprint (scm_stack_size (SCM_BASE (scm_rootcont)) * sizeof (SCM_STACKITEM),
+		16, scm_cur_errp);
+  scm_gen_puts (scm_regular_string, " of stack: 0x", scm_cur_errp);
+  scm_intprint ((long) SCM_BASE (scm_rootcont), 16, scm_cur_errp);
+  scm_gen_puts (scm_regular_string, " - 0x", scm_cur_errp);
+  scm_intprint ((long) &stack, 16, scm_cur_errp);
+  scm_gen_puts (scm_regular_string, "\n", scm_cur_errp);
+}
+
+
+
+#ifdef __STDC__
+void
+scm_init_stackchk (void)
+#else
+void
+scm_init_stackchk ()
+#endif
+{
+#ifdef SCM_STACK_CHECK
+  scm_check_stack_p = 1;
+#endif
+#include "stackchk.x"
+}
+
diff --git a/libguile/stackchk.h b/libguile/stackchk.h
new file mode 100644
index 000000000..eb3c436a2
--- /dev/null
+++ b/libguile/stackchk.h
@@ -0,0 +1,90 @@
+/* classes: h_files */
+
+#ifndef STACKCHKH
+#define STACKCHKH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+#include "__scm.h"
+
+
+
+#ifdef SCM_STACK_LIMIT
+# define SCM_STACK_CHECK
+# ifdef SCM_STACK_GROWS_UP
+#  define SCM_STACK_OVERFLOW_P(s) (s - SCM_BASE (rootcont) > SCM_STACK_LIMIT * sizeof (SCM_STACKITEM))
+# else
+#  define SCM_STACK_OVERFLOW_P(s) (SCM_BASE (rootcont) - s > SCM_STACK_LIMIT * sizeof (SCM_STACKITEM))
+# endif
+# define SCM_CHECK_STACK\
+    {\
+       SCM_STACKITEM stack;\
+       if (SCM_STACK_OVERFLOW_P (&stack) && scm_check_stack_p)\
+	 scm_report_stack_overflow ();\
+    }
+#else
+# define SCM_CHECK_STACK /**/
+#endif /* def SCM_STACK_LIMIT */
+
+
+extern int scm_check_stack_p;
+
+
+#ifdef __STDC__
+extern long scm_stack_size (SCM_STACKITEM *start);
+extern void scm_stack_report (void);
+extern void scm_init_stackchk (void);
+
+#else /* STDC */
+extern long scm_stack_size ();
+extern void scm_stack_report ();
+extern void scm_init_stackchk ();
+
+#endif /* STDC */
+
+
+
+
+
+
+
+
+#endif  /* STACKCHKH */
diff --git a/libguile/stime.c b/libguile/stime.c
new file mode 100644
index 000000000..77ead9a7a
--- /dev/null
+++ b/libguile/stime.c
@@ -0,0 +1,236 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include "_scm.h"
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#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 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
+#  define CLKTCK 60
+# endif
+#endif
+
+
+# ifdef HAVE_FTIME
+#   include <sys/timeb.h>
+# endif
+
+
+#ifdef __STDC__
+# define timet time_t
+#else
+# define timet long
+#endif
+
+#ifdef HAVE_TIMES
+#ifdef __STDC__
+static
+long mytime(void)
+#else
+static
+long mytime()
+#endif
+{
+  struct tms time_buffer;
+  times(&time_buffer);
+  return time_buffer.tms_utime + time_buffer.tms_stime;
+}
+#else
+# ifdef LACK_CLOCK
+#    define mytime() ((time((timet*)0) - scm_your_base) * CLKTCK)
+# else
+#  define mytime clock
+# endif
+#endif
+
+
+
+#ifdef HAVE_FTIME
+
+struct timeb scm_your_base = {0};
+SCM_PROC(s_get_internal_real_time, "get-internal-real-time", 0, 0, 0, scm_get_internal_real_time);
+#ifdef __STDC__
+SCM
+scm_get_internal_real_time(void)
+#else
+SCM
+scm_get_internal_real_time()
+#endif
+{
+  struct timeb time_buffer;
+  long tmp;
+  ftime(&time_buffer);
+  time_buffer.time -= scm_your_base.time;
+  tmp = time_buffer.millitm - scm_your_base.millitm;
+  tmp = time_buffer.time*1000L + tmp;
+  tmp *= CLKTCK;
+  tmp /= 1000;
+  return SCM_MAKINUM(tmp);
+}
+
+#else
+
+timet scm_your_base = 0;
+SCM_PROC(s_get_internal_real_time, "get-internal-real-time", 0, 0, 0, scm_get_internal_real_time);
+#ifdef __STDC__
+SCM
+scm_get_internal_real_time(void)
+#else
+SCM
+scm_get_internal_real_time()
+#endif
+{
+	return SCM_MAKINUM((time((timet*)0) - scm_your_base) * (int)CLKTCK);
+}
+#endif
+
+
+
+static long scm_my_base = 0;
+
+SCM_PROC(s_get_internal_run_time, "get-internal-run-time", 0, 0, 0, scm_get_internal_run_time);
+#ifdef __STDC__
+SCM
+scm_get_internal_run_time(void)
+#else
+SCM
+scm_get_internal_run_time()
+#endif
+{
+  return SCM_MAKINUM(mytime()-scm_my_base);
+}
+
+SCM_PROC(s_current_time, "current-time", 0, 0, 0, scm_current_time);
+#ifdef __STDC__
+SCM
+scm_current_time(void)
+#else
+SCM
+scm_current_time()
+#endif
+{
+  timet timv = time((timet*)0);
+  SCM ans;
+  ans = scm_ulong2num(timv);
+  return SCM_BOOL_F==ans ? SCM_MAKINUM(timv) : ans;
+}
+
+#ifdef __STDC__
+long 
+scm_time_in_msec(long x)
+#else
+long 
+scm_time_in_msec(x)
+     long x;
+#endif
+{
+  if (CLKTCK==60) return (x*50)/3;
+  else
+    return (CLKTCK < 1000 ? x*(1000L/(long)CLKTCK) : (x*1000L)/(long)CLKTCK);
+}
+
+#ifdef __STDC__
+void
+scm_init_stime(void)
+#else
+void
+scm_init_stime()
+#endif
+{
+  scm_sysintern("internal-time-units-per-second",
+		SCM_MAKINUM((long)CLKTCK));
+
+#ifdef HAVE_FTIME
+  if (!scm_your_base.time) ftime(&scm_your_base);
+#else
+  if (!scm_your_base) time(&scm_your_base);
+#endif
+
+  if (!scm_my_base) scm_my_base = mytime();
+
+#include "stime.x"
+}
+
diff --git a/libguile/stime.h b/libguile/stime.h
new file mode 100644
index 000000000..c492d40fe
--- /dev/null
+++ b/libguile/stime.h
@@ -0,0 +1,75 @@
+/* classes: h_files */
+
+#ifndef TIMEH
+#define TIMEH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+
+
+#ifdef __STDC__
+extern SCM scm_get_internal_real_time(void);
+extern SCM scm_get_internal_real_time(void);
+extern SCM scm_get_internal_real_time(void);
+extern SCM scm_get_internal_run_time(void);
+extern SCM scm_current_time(void);
+extern long scm_time_in_msec(long x);
+extern void scm_init_stime(void);
+
+#else /* STDC */
+extern SCM scm_get_internal_real_time();
+extern SCM scm_get_internal_real_time();
+extern SCM scm_get_internal_real_time();
+extern SCM scm_get_internal_run_time();
+extern SCM scm_current_time();
+extern long scm_time_in_msec();
+extern void scm_init_stime();
+
+#endif /* STDC */
+
+
+
+
+
+
+#endif  /* TIMEH */
diff --git a/libguile/strings.c b/libguile/strings.c
new file mode 100644
index 000000000..ea96e8c30
--- /dev/null
+++ b/libguile/strings.c
@@ -0,0 +1,473 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+
+/* {Strings}
+ */
+
+SCM_PROC(s_string_p, "string?", 1, 0, 0, scm_string_p);
+#ifdef __STDC__
+SCM
+scm_string_p (SCM x)
+#else
+SCM
+scm_string_p (x)
+     SCM x;
+#endif
+{
+  if (SCM_IMP (x))
+    return SCM_BOOL_F;
+  return SCM_STRINGP (x) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+SCM_PROC(s_read_only_string_p, "read-only-string?", 1, 0, 0, scm_read_only_string_p);
+#ifdef __STDC__
+SCM
+scm_read_only_string_p (SCM x)
+#else
+SCM
+scm_read_only_string_p (x)
+     SCM x;
+#endif
+{
+  if (SCM_IMP (x))
+    return SCM_BOOL_F;
+  return SCM_ROSTRINGP (x) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+SCM_PROC(s_list_to_string, "list->string", 1, 0, 0, scm_string);
+SCM_PROC(s_string, "string", 0, 0, 1, scm_string);
+#ifdef __STDC__
+SCM
+scm_string (SCM chrs)
+#else
+SCM
+scm_string (chrs)
+     SCM chrs;
+#endif
+{
+  SCM res;
+  register char *data;
+  long i;
+  long len;
+  SCM_DEFER_INTS;
+  i = scm_ilength (chrs);
+  if (i < 0)
+    {
+      SCM_ALLOW_INTS;
+      SCM_ASSERT (0, chrs, SCM_ARG1, s_string);
+    }
+  len = 0;
+  {
+    SCM s;
+
+    for (len = 0, s = chrs; s != SCM_EOL; s = SCM_CDR (s))
+      if (SCM_ICHRP (SCM_CAR (s)))
+	len += 1;
+      else if (SCM_NIMP (SCM_CAR (s)) && SCM_ROSTRINGP (SCM_CAR (s)))
+	len += SCM_ROLENGTH (SCM_CAR (s));
+      else
+	{
+	  SCM_ALLOW_INTS;
+	  SCM_ASSERT (0, s, SCM_ARG1, s_string);
+	}
+  }
+  res = scm_makstr (len, 0);
+  data = SCM_CHARS (res);
+  for (;SCM_NNULLP (chrs);chrs = SCM_CDR (chrs))
+    {
+      if (SCM_ICHRP (SCM_CAR (chrs)))
+	*data++ = SCM_ICHR (SCM_CAR (chrs));
+      else
+	{
+	  int l;
+	  char * c;
+	  l = SCM_ROLENGTH (SCM_CAR (chrs));
+	  c = SCM_ROCHARS (SCM_CAR (chrs));
+	  while (l)
+	    {
+	      --l;
+	      *data++ = *c++;
+	    }
+	}
+    }
+  SCM_ALLOW_INTS;
+  return res;
+}
+
+#ifdef __STDC__
+SCM 
+scm_makstr (long len, int slots)
+#else
+SCM 
+scm_makstr (len, slots)
+     long len;
+     int slots;
+#endif
+{
+  SCM s;
+  SCM * mem;
+  SCM_NEWCELL (s);
+  --slots;
+  SCM_REDEFER_INTS;
+  mem = (SCM *)scm_must_malloc (sizeof (SCM) * (slots + 1) + len + 1,
+				s_string);
+  if (slots >= 0)
+    {
+      int x;
+      mem[slots] = (SCM)mem;
+      for (x = 0; x < slots; ++x)
+	mem[x] = SCM_BOOL_F;
+    }
+  SCM_SETCHARS (s, (char *) (mem + slots + 1));
+  SCM_SETLENGTH (s, len, scm_tc7_string);
+  SCM_REALLOW_INTS;
+  SCM_CHARS (s)[len] = 0;
+  return s;
+}
+
+/* converts C scm_array of strings to SCM scm_list of strings. */
+/* If argc < 0, a null terminated scm_array is assumed. */
+#ifdef __STDC__
+SCM 
+scm_makfromstrs (int argc, char **argv)
+#else
+SCM 
+scm_makfromstrs (argc, argv)
+     int argc;
+     char **argv;
+#endif
+{
+  int i = argc;
+  SCM lst = SCM_EOL;
+  if (0 > i)
+    for (i = 0; argv[i]; i++);
+  while (i--)
+    lst = scm_cons (scm_makfromstr (argv[i], (scm_sizet) strlen (argv[i]), 0), lst);
+  return lst;
+}
+
+
+#ifdef __STDC__
+SCM
+scm_take0str (char * it)
+#else
+SCM
+scm_take0str (it)
+     char * it;
+#endif
+{
+  SCM answer;
+  SCM_NEWCELL (answer);
+  SCM_DEFER_INTS;
+  SCM_SETLENGTH (answer, strlen (it), scm_tc7_string);
+  SCM_SETCHARS (answer, it);
+  SCM_ALLOW_INTS;
+  return answer;
+}
+
+#ifdef __STDC__
+SCM 
+scm_makfromstr (const char *src, scm_sizet len, int slots)
+#else
+SCM 
+scm_makfromstr (src, len, slots)
+     const char *src;
+     scm_sizet len;
+     int slots;
+#endif
+{
+  SCM s;
+  register char *dst;
+  s = scm_makstr ((long) len, slots);
+  dst = SCM_CHARS (s);
+  while (len--)
+    *dst++ = *src++;
+  return s;
+}
+
+
+#ifdef __STDC__
+SCM 
+scm_makfrom0str (char *src)
+#else
+SCM 
+scm_makfrom0str (src)
+     char *src;
+#endif
+{
+  if (!src) return SCM_BOOL_F;
+  return scm_makfromstr (src, (scm_sizet) strlen (src), 0);
+}
+
+#ifdef __STDC__
+SCM 
+scm_makfrom0str_opt (char *src)
+#else
+SCM 
+scm_makfrom0str_opt (src)
+     char *src;
+#endif
+{
+  return scm_makfrom0str (src);
+}
+
+
+
+
+SCM_PROC(s_make_string, "make-string", 1, 1, 0, scm_make_string);
+#ifdef __STDC__
+SCM
+scm_make_string (SCM k, SCM chr)
+#else
+SCM
+scm_make_string (k, chr)
+     SCM k;
+     SCM chr;
+#endif
+{
+  SCM res;
+  register char *dst;
+  register long i;
+  SCM_ASSERT (SCM_INUMP (k) && (k >= 0), k, SCM_ARG1, s_make_string);
+  i = SCM_INUM (k);
+  res = scm_makstr (i, 0);
+  dst = SCM_CHARS (res);
+  if SCM_ICHRP (chr)
+    {
+      char c = SCM_ICHR (chr);
+      for (i--;i >= 0;i--)
+	{
+	  dst[i] = c;
+	}
+    }
+  return res;
+}
+
+SCM_PROC(s_string_length, "string-length", 1, 0, 0, scm_string_length);
+#ifdef __STDC__
+SCM
+scm_string_length (SCM str)
+#else
+SCM
+scm_string_length (str)
+     SCM str;
+#endif
+{
+  SCM_ASSERT (SCM_NIMP (str) && SCM_ROSTRINGP (str), str, SCM_ARG1, s_string_length);
+  return SCM_MAKINUM (SCM_ROLENGTH (str));
+}
+
+SCM_PROC(s_string_ref, "string-ref", 1, 1, 0, scm_string_ref);
+#ifdef __STDC__
+SCM
+scm_string_ref (SCM str, SCM k)
+#else
+SCM
+scm_string_ref (str, k)
+     SCM str;
+     SCM k;
+#endif
+{
+  SCM_ASSERT (SCM_NIMP (str) && SCM_ROSTRINGP (str), str, SCM_ARG1, s_string_ref);
+  if (k == SCM_UNDEFINED)
+    k = SCM_MAKINUM (0);
+  SCM_ASSERT (SCM_INUMP (k), k, SCM_ARG2, s_string_ref);
+  SCM_ASSERT (SCM_INUM (k) < SCM_ROLENGTH (str) && SCM_INUM (k) >= 0, k, SCM_OUTOFRANGE, s_string_ref);
+  return SCM_MAKICHR (SCM_ROCHARS (str)[SCM_INUM (k)]);
+}
+
+SCM_PROC(s_string_set_x, "string-set!", 3, 0, 0, scm_string_set_x);
+#ifdef __STDC__
+SCM
+scm_string_set_x (SCM str, SCM k, SCM chr)
+#else
+SCM
+scm_string_set_x (str, k, chr)
+     SCM str;
+     SCM k;
+     SCM chr;
+#endif
+{
+  SCM_ASSERT (SCM_NIMP (str) && SCM_STRINGP (str), str, SCM_ARG1, s_string_set_x);
+  SCM_ASSERT (SCM_INUMP (k), k, SCM_ARG2, s_string_set_x);
+  SCM_ASSERT (SCM_ICHRP (chr), chr, SCM_ARG3, s_string_set_x);
+  SCM_ASSERT (SCM_INUM (k) < SCM_LENGTH (str) && SCM_INUM (k) >= 0, k, SCM_OUTOFRANGE, s_string_set_x);
+  SCM_CHARS (str)[SCM_INUM (k)] = SCM_ICHR (chr);
+  return SCM_UNSPECIFIED;
+}
+
+
+
+SCM_PROC(s_substring, "substring", 2, 1, 0, scm_substring);
+#ifdef __STDC__
+SCM
+scm_substring (SCM str, SCM start, SCM end)
+#else
+SCM
+scm_substring (str, start, end)
+     SCM str;
+     SCM start;
+     SCM end;
+#endif
+{
+  long l;
+  SCM_ASSERT (SCM_NIMP (str) && SCM_ROSTRINGP (str),
+	 str, SCM_ARG1, s_substring);
+  SCM_ASSERT (SCM_INUMP (start), start, SCM_ARG2, s_substring);
+  if (end == SCM_UNDEFINED)
+    end = SCM_MAKINUM (SCM_ROLENGTH (str));
+  SCM_ASSERT (SCM_INUMP (end), end, SCM_ARG3, s_substring);
+  SCM_ASSERT (SCM_INUM (start) <= SCM_ROLENGTH (str), start, SCM_OUTOFRANGE, s_substring);
+  SCM_ASSERT (SCM_INUM (end) <= SCM_ROLENGTH (str), end, SCM_OUTOFRANGE, s_substring);
+  l = SCM_INUM (end)-SCM_INUM (start);
+  SCM_ASSERT (l >= 0, SCM_MAKINUM (l), SCM_OUTOFRANGE, s_substring);
+  return scm_makfromstr (&SCM_ROCHARS (str)[SCM_INUM (start)], (scm_sizet)l, 0);
+}
+
+SCM_PROC(s_string_append, "string-append", 0, 0, 1, scm_string_append);
+#ifdef __STDC__
+SCM
+scm_string_append (SCM args)
+#else
+SCM
+scm_string_append (args)
+     SCM args;
+#endif
+{
+  SCM res;
+  register long i = 0;
+  register SCM l, s;
+  register char *data;
+  for (l = args;SCM_NIMP (l);) {
+    SCM_ASSERT (SCM_CONSP (l), l, SCM_ARGn, s_string_append);
+    s = SCM_CAR (l);
+    SCM_ASSERT (SCM_NIMP (s) && SCM_ROSTRINGP (s),
+	   s, SCM_ARGn, s_string_append);
+    i += SCM_ROLENGTH (s);
+    l = SCM_CDR (l);
+  }
+  SCM_ASSERT (SCM_NULLP (l), args, SCM_ARGn, s_string_append);
+  res = scm_makstr (i, 0);
+  data = SCM_CHARS (res);
+  for (l = args;SCM_NIMP (l);l = SCM_CDR (l)) {
+    s = SCM_CAR (l);
+    for (i = 0;i<SCM_ROLENGTH (s);i++) *data++ = SCM_ROCHARS (s)[i];
+  }
+  return res;
+}
+
+SCM_PROC(s_make_shared_substring, "make-shared-substring", 1, 2, 0, scm_make_shared_substring);
+#ifdef __STDC__
+SCM
+scm_make_shared_substring (SCM str, SCM frm, SCM to)
+#else
+SCM
+scm_make_shared_substring (str, frm, to)
+     SCM str;
+     SCM frm;
+     SCM to;
+#endif
+{
+  long f;
+  long t;
+  SCM answer;
+  SCM len_str;
+
+  SCM_ASSERT (SCM_NIMP (str) && SCM_ROSTRINGP (str), str, SCM_ARG1, s_make_shared_substring);
+
+  if (frm == SCM_UNDEFINED)
+    frm = SCM_MAKINUM (0);
+  else
+    SCM_ASSERT (SCM_INUMP (frm), frm, SCM_ARG2, s_make_shared_substring);
+
+  if (to == SCM_UNDEFINED)
+    to = SCM_MAKINUM (SCM_ROLENGTH (str));
+  else
+    SCM_ASSERT (SCM_INUMP (to), to, SCM_ARG3, s_make_shared_substring);
+
+  f = SCM_INUM (frm);
+  t = SCM_INUM (to);
+  SCM_ASSERT ((f >= 0), frm, SCM_OUTOFRANGE, s_make_shared_substring);
+  SCM_ASSERT ((f <= t) && (t <= SCM_ROLENGTH (str)), to, SCM_OUTOFRANGE, s_make_shared_substring);
+
+  SCM_NEWCELL (answer);
+  SCM_NEWCELL (len_str);
+
+  SCM_DEFER_INTS;
+  if (SCM_SUBSTRP (str))
+    {
+      long offset;
+      offset = SCM_INUM (SCM_SUBSTR_OFFSET (str));
+      f += offset;
+      t += offset;
+      SCM_SETCAR (len_str, SCM_MAKINUM (f));
+      SCM_SETCDR (len_str, SCM_SUBSTR_STR (str));
+      SCM_SETCDR (answer, len_str);
+      SCM_SETLENGTH (answer, t - f, scm_tc7_substring);
+    }
+  else
+    {
+      SCM_SETCAR (len_str, SCM_MAKINUM (f));
+      SCM_SETCDR (len_str, str);
+      SCM_SETCDR (answer, len_str);
+      SCM_SETLENGTH (answer, t - f, scm_tc7_substring);
+    }
+  SCM_ALLOW_INTS;
+  return answer;
+}
+
+#ifdef __STDC__
+void
+scm_init_strings (void)
+#else
+void
+scm_init_strings ()
+#endif
+{
+#include "strings.x"
+}
+
diff --git a/libguile/strings.h b/libguile/strings.h
new file mode 100644
index 000000000..6615e2330
--- /dev/null
+++ b/libguile/strings.h
@@ -0,0 +1,109 @@
+/* classes: h_files */
+
+#ifndef STRINGSH
+#define STRINGSH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+
+
+
+#define SCM_STRINGP(x) (SCM_TYP7S(x)==scm_tc7_string)
+#define SCM_NSTRINGP(x) (!SCM_STRINGP(x))
+
+
+
+#ifdef __STDC__
+extern SCM scm_string_p (SCM x);
+extern SCM scm_read_only_string_p (SCM x);
+extern SCM scm_string (SCM chrs);
+extern SCM scm_makstr (long len, int slots);
+extern SCM scm_makfromstrs (int argc, char **argv);
+extern SCM scm_take0str (char * it);
+extern SCM scm_makfromstr (const char *src, scm_sizet len, int slots);
+extern SCM scm_makfrom0str (char *src);
+extern SCM scm_makfrom0str_opt (char *src);
+extern SCM scm_make_string (SCM k, SCM chr);
+extern SCM scm_string_length (SCM str);
+extern SCM scm_string_ref (SCM str, SCM k);
+extern SCM scm_string_set_x (SCM str, SCM k, SCM chr);
+extern SCM scm_substring (SCM str, SCM start, SCM end);
+extern SCM scm_string_append (SCM args);
+extern SCM scm_make_shared_substring (SCM str, SCM frm, SCM to);
+extern void scm_init_strings (void);
+
+#else /* STDC */
+extern SCM scm_string_p ();
+extern SCM scm_read_only_string_p ();
+extern SCM scm_string ();
+extern SCM scm_makstr ();
+extern SCM scm_makfromstrs ();
+extern SCM scm_take0str ();
+extern SCM scm_makfromstr ();
+extern SCM scm_makfrom0str ();
+extern SCM scm_makfrom0str_opt ();
+extern SCM scm_make_string ();
+extern SCM scm_string_length ();
+extern SCM scm_string_ref ();
+extern SCM scm_string_set_x ();
+extern SCM scm_substring ();
+extern SCM scm_string_append ();
+extern SCM scm_make_shared_substring ();
+extern void scm_init_strings ();
+
+#endif /* STDC */
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+#endif  /* STRINGSH */
diff --git a/libguile/strop.c b/libguile/strop.c
new file mode 100644
index 000000000..366d249da
--- /dev/null
+++ b/libguile/strop.c
@@ -0,0 +1,368 @@
+/* classes: src_files */
+
+/*	Copyright (C) 1994 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.  */
+
+
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+
+#ifdef __STDC__
+int
+scm_i_index (SCM * str, SCM chr, SCM sub_start, SCM sub_end, int pos, int pos2, int pos3, int pos4, char * why)
+#else
+int
+scm_i_index (str, chr, sub_start, sub_end, pos, pos2, pos3, pos4, why)
+     SCM * str;
+     SCM chr;
+     SCM sub_start;
+     SCM sub_end;
+     int pos;
+     int pos2;
+     int pos3;
+     int pos4;
+     char * why;
+#endif
+{
+  unsigned char * p;
+  int x;
+  int bound;
+  int ch;
+
+  SCM_ASSERT (SCM_NIMP (*str) && SCM_ROSTRINGP (*str), *str, pos, why);
+  SCM_ASSERT (SCM_ICHRP (chr), chr, pos2, why);
+
+  if (sub_start == SCM_BOOL_F)
+    sub_start = SCM_MAKINUM (0);
+  else
+    SCM_ASSERT (   SCM_INUMP (sub_start)
+	    && (0 <= SCM_INUM (sub_start))
+	    && (SCM_INUM (sub_start) <= SCM_ROLENGTH (*str)),
+	    sub_start, pos3, why);
+
+  if (sub_end == SCM_BOOL_F)
+    sub_end = SCM_MAKINUM (SCM_ROLENGTH (*str));
+  else
+    SCM_ASSERT (   SCM_INUMP (sub_end)
+	    && (SCM_INUM (sub_start) <= SCM_INUM (sub_end))
+	    && (SCM_INUM (sub_end) <= SCM_ROLENGTH (*str)),
+	    sub_end, pos4, why);
+
+  p = (unsigned char *)SCM_ROCHARS (*str) + SCM_INUM (sub_start);
+  bound = SCM_INUM (sub_end);
+  ch = SCM_ICHR (chr);
+
+  for (x = SCM_INUM (sub_start); x < bound; ++x, ++p)
+    if (*p == ch)
+      return x;
+
+  return -1;
+}
+
+#ifdef __STDC__
+int
+scm_i_rindex (SCM * str, SCM chr, SCM sub_start, SCM sub_end, int pos, int pos2, int pos3, int pos4, char * why)
+#else
+int
+scm_i_rindex (str, chr, sub_start, sub_end, pos, pos2, pos3, pos4, why)
+     SCM * str;
+     SCM chr;
+     SCM sub_start;
+     SCM sub_end;
+     int pos;
+     int pos2;
+     int pos3;
+     int pos4;
+     char * why;
+#endif
+{
+  unsigned char * p;
+  int x;
+  int upper_bound;
+  int lower_bound;
+  int ch;
+
+  SCM_ASSERT (SCM_NIMP (*str) && SCM_ROSTRINGP (*str), *str, pos, why);
+  SCM_ASSERT (SCM_ICHRP (chr), chr, pos2, why);
+
+  if (sub_start == SCM_BOOL_F)
+    sub_start = SCM_MAKINUM (0);
+  else
+    SCM_ASSERT (   SCM_INUMP (sub_start)
+	    && (0 <= SCM_INUM (sub_start))
+	    && (SCM_INUM (sub_start) <= SCM_ROLENGTH (*str)),
+	    sub_start, pos3, why);
+
+  if (sub_end == SCM_BOOL_F)
+    sub_end = SCM_MAKINUM (SCM_ROLENGTH (*str));
+  else
+    SCM_ASSERT (   SCM_INUMP (sub_end)
+	    && (SCM_INUM (sub_start) <= SCM_INUM (sub_end))
+	    && (SCM_INUM (sub_end) <= SCM_ROLENGTH (*str)),
+	    sub_end, pos4, why);
+
+  upper_bound = SCM_INUM (sub_end);
+  lower_bound = SCM_INUM (sub_start);
+  p = upper_bound - 1 + (unsigned char *)SCM_ROCHARS (*str);
+  ch = SCM_ICHR (chr);
+  for (x = upper_bound - 1; x >= lower_bound; --x, --p)
+    if (*p == ch)
+      return x;
+
+  return -1;
+}
+
+
+SCM_PROC(s_string_index, "string-index", 2, 2, 0, scm_string_index);
+#ifdef __STDC__
+SCM 
+scm_string_index (SCM str, SCM chr, SCM frm, SCM to)
+#else
+SCM 
+scm_string_index (str, chr, frm, to)
+     SCM str;
+     SCM chr;
+     SCM frm;
+     SCM to;
+#endif
+{
+  int pos;
+  
+  if (frm == SCM_UNDEFINED)
+    frm = SCM_BOOL_F;
+  if (to == SCM_UNDEFINED)
+    to = SCM_BOOL_F;
+  pos = scm_i_index (&str, chr, frm, to, SCM_ARG1, SCM_ARG2, SCM_ARG3, SCM_ARG4, s_string_index);
+  return (pos < 0
+	  ? SCM_BOOL_F
+	  : SCM_MAKINUM (pos));
+}
+
+SCM_PROC(s_string_rindex, "string-rindex", 2, 2, 0, scm_string_rindex);
+#ifdef __STDC__
+SCM 
+scm_string_rindex (SCM str, SCM chr, SCM frm, SCM to)
+#else
+SCM 
+scm_string_rindex (str, chr, frm, to)
+     SCM str;
+     SCM chr;
+     SCM frm;
+     SCM to;
+#endif
+{
+  int pos;
+  
+  if (frm == SCM_UNDEFINED)
+    frm = SCM_BOOL_F;
+  if (to == SCM_UNDEFINED)
+    to = SCM_BOOL_F;
+  pos = scm_i_rindex (&str, chr, frm, to, SCM_ARG1, SCM_ARG2, SCM_ARG3, SCM_ARG4, s_string_index);
+  return (pos < 0
+	  ? SCM_BOOL_F
+	  : SCM_MAKINUM (pos));
+}
+
+
+
+
+
+ 
+SCM_PROC(s_substring_move_left_x, "substring-move-left!", 2, 0, 1, scm_substring_move_left_x);
+#ifdef __STDC__
+SCM
+scm_substring_move_left_x (SCM str1, SCM start1, SCM args)
+#else
+SCM
+scm_substring_move_left_x (str1, start1, args)
+     SCM str1;
+     SCM start1;
+     SCM args;
+#endif
+{
+  SCM end1, str2, start2;
+  long i, j, e;
+  SCM_ASSERT (3==scm_ilength (args), args, SCM_WNA, s_substring_move_left_x);
+  end1 = SCM_CAR (args); args = SCM_CDR (args);
+  str2 = SCM_CAR (args); args = SCM_CDR (args);
+  start2 = SCM_CAR (args);
+  SCM_ASSERT (SCM_NIMP (str1) && SCM_STRINGP (str1), str1, SCM_ARG1, s_substring_move_left_x);
+  SCM_ASSERT (SCM_INUMP (start1), start1, SCM_ARG2, s_substring_move_left_x);
+  SCM_ASSERT (SCM_INUMP (end1), end1, SCM_ARG3, s_substring_move_left_x);
+  SCM_ASSERT (SCM_NIMP (str2) && SCM_STRINGP (str2), str2, SCM_ARG4, s_substring_move_left_x);
+  SCM_ASSERT (SCM_INUMP (start2), start2, SCM_ARG5, s_substring_move_left_x);
+  i = SCM_INUM (start1), j = SCM_INUM (start2), e = SCM_INUM (end1);
+  SCM_ASSERT (i <= SCM_LENGTH (str1) && i >= 0, start1, SCM_OUTOFRANGE, s_substring_move_left_x);
+  SCM_ASSERT (j <= SCM_LENGTH (str2) && j >= 0, start2, SCM_OUTOFRANGE, s_substring_move_left_x);
+  SCM_ASSERT (e <= SCM_LENGTH (str1) && e >= 0, end1, SCM_OUTOFRANGE, s_substring_move_left_x);
+  SCM_ASSERT (e-i+j <= SCM_LENGTH (str2), start2, SCM_OUTOFRANGE, s_substring_move_left_x);
+  while (i<e) SCM_CHARS (str2)[j++] = SCM_CHARS (str1)[i++];
+  return SCM_UNSPECIFIED;
+}
+
+
+SCM_PROC(s_substring_move_right_x, "substring-move-right!", 2, 0, 1, scm_substring_move_right_x);
+#ifdef __STDC__
+SCM
+scm_substring_move_right_x (SCM str1, SCM start1, SCM args)
+#else
+SCM
+scm_substring_move_right_x (str1, start1, args)
+     SCM str1;
+     SCM start1;
+     SCM args;
+#endif
+{
+  SCM end1, str2, start2;
+  long i, j, e;
+  SCM_ASSERT (3==scm_ilength (args), args, SCM_WNA, s_substring_move_right_x);
+  end1 = SCM_CAR (args); args = SCM_CDR (args);
+  str2 = SCM_CAR (args); args = SCM_CDR (args);
+  start2 = SCM_CAR (args);
+  SCM_ASSERT (SCM_NIMP (str1) && SCM_STRINGP (str1), str1, SCM_ARG1, s_substring_move_right_x);
+  SCM_ASSERT (SCM_INUMP (start1), start1, SCM_ARG2, s_substring_move_right_x);
+  SCM_ASSERT (SCM_INUMP (end1), end1, SCM_ARG3, s_substring_move_right_x);
+  SCM_ASSERT (SCM_NIMP (str2) && SCM_STRINGP (str2), str2, SCM_ARG4, s_substring_move_right_x);
+  SCM_ASSERT (SCM_INUMP (start2), start2, SCM_ARG5, s_substring_move_right_x);
+  i = SCM_INUM (start1), j = SCM_INUM (start2), e = SCM_INUM (end1);
+  SCM_ASSERT (i <= SCM_LENGTH (str1) && i >= 0, start1, SCM_OUTOFRANGE, s_substring_move_right_x);
+  SCM_ASSERT (j <= SCM_LENGTH (str2) && j >= 0, start2, SCM_OUTOFRANGE, s_substring_move_right_x);
+  SCM_ASSERT (e <= SCM_LENGTH (str1) && e >= 0, end1, SCM_OUTOFRANGE, s_substring_move_right_x);
+  SCM_ASSERT ((j = e-i+j) <= SCM_LENGTH (str2), start2, SCM_OUTOFRANGE, s_substring_move_right_x);
+  while (i<e) SCM_CHARS (str2)[--j] = SCM_CHARS (str1)[--e];
+  return SCM_UNSPECIFIED;
+}
+
+
+SCM_PROC(s_substring_fill_x, "substring-fill!", 2, 0, 1, scm_substring_fill_x);
+#ifdef __STDC__
+SCM
+scm_substring_fill_x (SCM str, SCM start, SCM args)
+#else
+SCM
+scm_substring_fill_x (str, start, args)
+     SCM str;
+     SCM start;
+     SCM args;
+#endif
+{
+  SCM end, fill;
+  long i, e;
+  char c;
+  SCM_ASSERT (2==scm_ilength (args), args, SCM_WNA, s_substring_fill_x);
+  end = SCM_CAR (args); args = SCM_CDR (args);
+  fill = SCM_CAR (args);
+  SCM_ASSERT (SCM_NIMP (str) && SCM_STRINGP (str), str, SCM_ARG1, s_substring_fill_x);
+  SCM_ASSERT (SCM_INUMP (start), start, SCM_ARG2, s_substring_fill_x);
+  SCM_ASSERT (SCM_INUMP (end), end, SCM_ARG3, s_substring_fill_x);
+  SCM_ASSERT (SCM_ICHRP (fill), fill, SCM_ARG4, s_substring_fill_x);
+  i = SCM_INUM (start), e = SCM_INUM (end);c = SCM_ICHR (fill);
+  SCM_ASSERT (i <= SCM_LENGTH (str) && i >= 0, start, SCM_OUTOFRANGE, s_substring_fill_x);
+  SCM_ASSERT (e <= SCM_LENGTH (str) && e >= 0, end, SCM_OUTOFRANGE, s_substring_fill_x);
+  while (i<e) SCM_CHARS (str)[i++] = c;
+  return SCM_UNSPECIFIED;
+}
+
+
+SCM_PROC(s_string_null_p, "string-null?", 1, 0, 0, scm_string_null_p);
+#ifdef __STDC__
+SCM
+scm_string_null_p (SCM str)
+#else
+SCM
+scm_string_null_p (str)
+     SCM str;
+#endif
+{
+  SCM_ASSERT (SCM_NIMP (str) && SCM_ROSTRINGP (str), str, SCM_ARG1, s_string_null_p);
+  return (SCM_ROLENGTH (str)
+	  ? SCM_BOOL_F
+	  : SCM_BOOL_T);
+}
+
+
+SCM_PROC(s_string_to_list, "string->list", 1, 0, 0, scm_string_to_list);
+#ifdef __STDC__
+SCM
+scm_string_to_list (SCM str)
+#else
+SCM
+scm_string_to_list (str)
+     SCM str;
+#endif
+{
+  long i;
+  SCM res = SCM_EOL;
+  unsigned char *src;
+  SCM_ASSERT (SCM_NIMP (str) && SCM_ROSTRINGP (str), str, SCM_ARG1, s_string_to_list);
+  src = SCM_ROUCHARS (str);
+  for (i = SCM_ROLENGTH (str)-1;i >= 0;i--) res = scm_cons ((SCM)SCM_MAKICHR (src[i]), res);
+  return res;
+}
+
+
+
+SCM_PROC(s_string_copy, "string-copy", 1, 0, 0, scm_string_copy);
+#ifdef __STDC__
+SCM
+scm_string_copy (SCM str)
+#else
+SCM
+scm_string_copy (str)
+     SCM str;
+#endif
+{
+  SCM_ASSERT (SCM_NIMP (str) && SCM_STRINGP (str), str, SCM_ARG1, s_string_copy);
+  return scm_makfromstr (SCM_CHARS (str), (scm_sizet)SCM_LENGTH (str), 0);
+}
+
+
+SCM_PROC(s_string_fill_x, "string-fill!", 2, 0, 0, scm_string_fill_x);
+#ifdef __STDC__
+SCM
+scm_string_fill_x (SCM str, SCM chr)
+#else
+SCM
+scm_string_fill_x (str, chr)
+     SCM str;
+     SCM chr;
+#endif
+{
+  register char *dst, c;
+  register long k;
+  SCM_ASSERT (SCM_NIMP (str) && SCM_STRINGP (str), str, SCM_ARG1, s_string_fill_x);
+  SCM_ASSERT (SCM_ICHRP (chr), chr, SCM_ARG2, s_string_fill_x);
+  c = SCM_ICHR (chr);
+  dst = SCM_CHARS (str);
+  for (k = SCM_LENGTH (str)-1;k >= 0;k--) dst[k] = c;
+  return SCM_UNSPECIFIED;
+}
+
+
+#ifdef __STDC__
+void
+scm_init_strop (void)
+#else
+void
+scm_init_strop ()
+#endif
+{
+#include "strop.x"
+}
+
diff --git a/libguile/strop.h b/libguile/strop.h
new file mode 100644
index 000000000..d2b9a9c00
--- /dev/null
+++ b/libguile/strop.h
@@ -0,0 +1,89 @@
+/* classes: h_files */
+
+#ifndef STROPH
+#define STROPH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+
+
+
+#ifdef __STDC__
+extern int scm_i_index (SCM * str, SCM chr, SCM sub_start, SCM sub_end, int pos, int pos2, int pos3, int pos4, char * why);
+extern int scm_i_rindex (SCM * str, SCM chr, SCM sub_start, SCM sub_end, int pos, int pos2, int pos3, int pos4, char * why);
+extern SCM scm_string_index (SCM str, SCM chr, SCM frm, SCM to);
+extern SCM scm_string_rindex (SCM str, SCM chr, SCM frm, SCM to);
+extern SCM scm_substring_move_left_x (SCM str1, SCM start1, SCM args);
+extern SCM scm_substring_move_right_x (SCM str1, SCM start1, SCM args);
+extern SCM scm_substring_fill_x (SCM str, SCM start, SCM args);
+extern SCM scm_string_null_p (SCM str);
+extern SCM scm_string_to_list (SCM str);
+extern SCM scm_string_copy (SCM str);
+extern SCM scm_string_fill_x (SCM str, SCM chr);
+extern void scm_init_strop (void);
+
+#else /* STDC */
+extern int scm_i_index ();
+extern int scm_i_rindex ();
+extern SCM scm_string_index ();
+extern SCM scm_string_rindex ();
+extern SCM scm_substring_move_left_x ();
+extern SCM scm_substring_move_right_x ();
+extern SCM scm_substring_fill_x ();
+extern SCM scm_string_null_p ();
+extern SCM scm_string_to_list ();
+extern SCM scm_string_copy ();
+extern SCM scm_string_fill_x ();
+extern void scm_init_strop ();
+
+#endif /* STDC */
+
+
+
+
+
+
+
+
+
+#endif  /* STROPH */
diff --git a/libguile/strorder.c b/libguile/strorder.c
new file mode 100644
index 000000000..5e1a15a26
--- /dev/null
+++ b/libguile/strorder.c
@@ -0,0 +1,266 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+
+SCM_PROC1 (s_string_equal_p, "string=?", scm_tc7_rpsubr, scm_string_equal_p);
+#ifdef __STDC__
+SCM
+scm_string_equal_p (SCM s1, SCM s2)
+#else
+SCM
+scm_string_equal_p (s1, s2)
+     SCM s1;
+     SCM s2;
+#endif
+{
+  register scm_sizet i;
+  register char *c1, *c2;
+  SCM_ASSERT (SCM_NIMP (s1) && SCM_ROSTRINGP (s1), s1, SCM_ARG1, s_string_equal_p);
+  SCM_ASSERT (SCM_NIMP (s2) && SCM_ROSTRINGP (s2), s2, SCM_ARG2, s_string_equal_p);
+
+  i = SCM_ROLENGTH (s2);
+  if (SCM_ROLENGTH (s1) != i)
+    {
+      return SCM_BOOL_F;
+    }
+  c1 = SCM_ROCHARS (s1);
+  c2 = SCM_ROCHARS (s2);
+  while (0 != i--)
+    if (*c1++ != *c2++)
+      return SCM_BOOL_F;
+  return SCM_BOOL_T;
+}
+
+SCM_PROC1 (s_string_ci_equal_p, "string-ci=?", scm_tc7_rpsubr, scm_string_ci_equal_p);
+#ifdef __STDC__
+SCM
+scm_string_ci_equal_p (SCM s1, SCM s2)
+#else
+SCM
+scm_string_ci_equal_p (s1, s2)
+     SCM s1;
+     SCM s2;
+#endif
+{
+  register scm_sizet i;
+  register unsigned char *c1, *c2;
+  SCM_ASSERT (SCM_NIMP (s1) && SCM_ROSTRINGP (s1), s1, SCM_ARG1, s_string_ci_equal_p);
+  SCM_ASSERT (SCM_NIMP (s2) && SCM_ROSTRINGP (s2), s2, SCM_ARG2, s_string_ci_equal_p);
+  i = SCM_ROLENGTH (s2);
+  if (SCM_ROLENGTH (s1) != i)
+    {
+      return SCM_BOOL_F;
+    }
+  c1 = SCM_ROUCHARS (s1);
+  c2 = SCM_ROUCHARS (s2);
+  while (0 != i--)
+    if (scm_upcase(*c1++) != scm_upcase(*c2++))
+      return SCM_BOOL_F;
+  return SCM_BOOL_T;
+}
+
+SCM_PROC1 (s_string_less_p, "string<?", scm_tc7_rpsubr, scm_string_less_p);
+#ifdef __STDC__
+SCM
+scm_string_less_p (SCM s1, SCM s2)
+#else
+SCM
+scm_string_less_p (s1, s2)
+     SCM s1;
+     SCM s2;
+#endif
+{
+  register scm_sizet i, len, s2len;
+  register unsigned char *c1, *c2;
+  register int c;
+
+  SCM_ASSERT (SCM_NIMP (s1) && SCM_ROSTRINGP (s1), s1, SCM_ARG1, s_string_less_p);
+  SCM_ASSERT (SCM_NIMP (s2) && SCM_ROSTRINGP (s2), s2, SCM_ARG2, s_string_less_p);
+  len = SCM_ROLENGTH (s1);
+  s2len = i = SCM_ROLENGTH (s2);
+  if (len>i) i = len;
+  c1 = SCM_ROUCHARS (s1);
+  c2 = SCM_ROUCHARS (s2);
+
+  for (i = 0;i<len;i++) {
+    c = (*c1++ - *c2++);
+    if (c>0)
+      return SCM_BOOL_F;
+    if (c<0)
+      return SCM_BOOL_T;
+  }
+  {
+    SCM answer;
+    answer = (s2len != len) ? SCM_BOOL_T : SCM_BOOL_F;
+    return answer;
+  }
+}
+
+SCM_PROC1 (s_string_leq_p, "string<=?", scm_tc7_rpsubr, scm_string_leq_p);
+#ifdef __STDC__
+SCM
+scm_string_leq_p (SCM s1, SCM s2)
+#else
+SCM
+scm_string_leq_p (s1, s2)
+     SCM s1;
+     SCM s2;
+#endif
+{
+  return SCM_BOOL_NOT (scm_string_less_p (s2, s1));
+}
+
+SCM_PROC1 (s_string_gr_p, "string>?", scm_tc7_rpsubr, scm_string_gr_p);
+#ifdef __STDC__
+SCM
+scm_string_gr_p (SCM s1, SCM s2)
+#else
+SCM
+scm_string_gr_p (s1, s2)
+     SCM s1;
+     SCM s2;
+#endif
+{
+  return scm_string_less_p (s2, s1);
+}
+
+SCM_PROC1 (s_string_geq_p, "string>=?", scm_tc7_rpsubr, scm_string_geq_p);
+#ifdef __STDC__
+SCM
+scm_string_geq_p (SCM s1, SCM s2)
+#else
+SCM
+scm_string_geq_p (s1, s2)
+     SCM s1;
+     SCM s2;
+#endif
+{
+  return SCM_BOOL_NOT (scm_string_less_p (s1, s2));
+}
+
+SCM_PROC1 (s_string_ci_less_p, "string-ci<?", scm_tc7_rpsubr, scm_string_ci_less_p);
+#ifdef __STDC__
+SCM
+scm_string_ci_less_p (SCM s1, SCM s2)
+#else
+SCM
+scm_string_ci_less_p (s1, s2)
+     SCM s1;
+     SCM s2;
+#endif
+{
+  register scm_sizet i, len, s2len;
+  register unsigned char *c1, *c2;
+  register int c;
+  SCM_ASSERT (SCM_NIMP (s1) && SCM_ROSTRINGP (s1), s1, SCM_ARG1, s_string_ci_less_p);
+  SCM_ASSERT (SCM_NIMP (s2) && SCM_ROSTRINGP (s2), s2, SCM_ARG2, s_string_ci_less_p);
+  len = SCM_ROLENGTH (s1);
+  s2len = i = SCM_ROLENGTH (s2);
+  if (len>i) i=len;
+  c1 = SCM_ROUCHARS (s1);
+  c2 = SCM_ROUCHARS (s2);
+  for (i = 0;i<len;i++) {
+    c = (scm_upcase(*c1++) - scm_upcase(*c2++));
+    if (c>0) return SCM_BOOL_F;
+    if (c<0) return SCM_BOOL_T;
+  }
+  return (s2len != len) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+SCM_PROC1 (s_string_ci_leq_p, "string-ci<=?", scm_tc7_rpsubr, scm_string_ci_leq_p);
+#ifdef __STDC__
+SCM
+scm_string_ci_leq_p (SCM s1, SCM s2)
+#else
+SCM
+scm_string_ci_leq_p (s1, s2)
+     SCM s1;
+     SCM s2;
+#endif
+{
+  return SCM_BOOL_NOT (scm_string_ci_less_p (s2, s1));
+}
+
+SCM_PROC1 (s_string_ci_gr_p, "string-ci>?", scm_tc7_rpsubr, scm_string_ci_gr_p);
+#ifdef __STDC__
+SCM
+scm_string_ci_gr_p (SCM s1, SCM s2)
+#else
+SCM
+scm_string_ci_gr_p (s1, s2)
+     SCM s1;
+     SCM s2;
+#endif
+{
+  return scm_string_ci_less_p (s2, s1);
+}
+
+SCM_PROC1 (s_string_ci_geq_p, "string-ci>=?", scm_tc7_rpsubr, scm_string_ci_geq_p);
+#ifdef __STDC__
+SCM
+scm_string_ci_geq_p (SCM s1, SCM s2)
+#else
+SCM
+scm_string_ci_geq_p (s1, s2)
+     SCM s1;
+     SCM s2;
+#endif
+{
+  return SCM_BOOL_NOT (scm_string_ci_less_p (s1, s2));
+}
+
+
+#ifdef __STDC__
+void
+scm_init_strorder (void)
+#else
+void
+scm_init_strorder ()
+#endif
+{
+#include "strorder.x"
+}
+
diff --git a/libguile/strorder.h b/libguile/strorder.h
new file mode 100644
index 000000000..ebc4a8de8
--- /dev/null
+++ b/libguile/strorder.h
@@ -0,0 +1,85 @@
+/* classes: h_files */
+
+#ifndef STRORDERH
+#define STRORDERH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+
+
+
+
+
+
+
+#ifdef __STDC__
+extern SCM scm_string_equal_p (SCM s1, SCM s2);
+extern SCM scm_string_ci_equal_p (SCM s1, SCM s2);
+extern SCM scm_string_less_p (SCM s1, SCM s2);
+extern SCM scm_string_leq_p (SCM s1, SCM s2);
+extern SCM scm_string_gr_p (SCM s1, SCM s2);
+extern SCM scm_string_geq_p (SCM s1, SCM s2);
+extern SCM scm_string_ci_less_p (SCM s1, SCM s2);
+extern SCM scm_string_ci_leq_p (SCM s1, SCM s2);
+extern SCM scm_string_ci_gr_p (SCM s1, SCM s2);
+extern SCM scm_string_ci_geq_p (SCM s1, SCM s2);
+extern void scm_init_strorder (void);
+
+#else /* STDC */
+extern SCM scm_string_equal_p ();
+extern SCM scm_string_ci_equal_p ();
+extern SCM scm_string_less_p ();
+extern SCM scm_string_leq_p ();
+extern SCM scm_string_gr_p ();
+extern SCM scm_string_geq_p ();
+extern SCM scm_string_ci_less_p ();
+extern SCM scm_string_ci_leq_p ();
+extern SCM scm_string_ci_gr_p ();
+extern SCM scm_string_ci_geq_p ();
+extern void scm_init_strorder ();
+
+#endif /* STDC */
+
+
+
+#endif  /* STRORDERH */
diff --git a/libguile/strports.c b/libguile/strports.c
new file mode 100644
index 000000000..1ba808a51
--- /dev/null
+++ b/libguile/strports.c
@@ -0,0 +1,285 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+
+/* {Ports - string ports}
+ *
+ */
+
+#ifdef __STDC__
+static int 
+prinstpt (SCM exp, SCM port, int writing)
+#else
+static int 
+prinstpt (exp, port, writing)
+     SCM exp;
+     SCM port;
+     int writing;
+#endif
+{
+  scm_prinport (exp, port, "string");
+  return !0;
+}
+
+#ifdef __STDC__
+static int 
+stputc (int c, SCM p)
+#else
+static int 
+stputc (c, p)
+     int c;
+     SCM p;
+#endif
+{
+  scm_sizet ind = SCM_INUM (SCM_CAR (p));
+  SCM_DEFER_INTS;
+  if (ind >= SCM_LENGTH (SCM_CDR (p)))
+    scm_vector_set_length_x (SCM_CDR (p), SCM_MAKINUM (ind + (ind >> 1)));
+  SCM_ALLOW_INTS;
+  SCM_CHARS (SCM_CDR (p))[ind] = c;
+  SCM_CAR (p) = SCM_MAKINUM (ind + 1);
+  return c;
+}
+
+#ifdef __STDC__
+static scm_sizet 
+stwrite (char *str, scm_sizet siz, scm_sizet num, SCM p)
+#else
+static scm_sizet 
+stwrite (str, siz, num, p)
+     char *str;
+     scm_sizet siz;
+     scm_sizet num;
+     SCM p;
+#endif
+{
+  scm_sizet ind = SCM_INUM (SCM_CAR (p));
+  scm_sizet len = siz * num;
+  char *dst;
+  SCM_DEFER_INTS;
+  if (ind + len >= SCM_LENGTH (SCM_CDR (p)))
+    scm_vector_set_length_x (SCM_CDR (p), SCM_MAKINUM (ind + len + ((ind + len) >> 1)));
+  SCM_ALLOW_INTS;
+  dst = &(SCM_CHARS (SCM_CDR (p))[ind]);
+  while (len--)
+    dst[len] = str[len];
+  SCM_CAR (p) = SCM_MAKINUM (ind + siz * num);
+  return num;
+}
+
+#ifdef __STDC__
+static int 
+stputs (char *s, SCM p)
+#else
+static int 
+stputs (s, p)
+     char *s;
+     SCM p;
+#endif
+{
+  stwrite (s, 1, strlen (s), p);
+  return 0;
+}
+
+#ifdef __STDC__
+static int 
+stgetc (SCM p)
+#else
+static int 
+stgetc (p)
+     SCM p;
+#endif
+{
+  scm_sizet ind = SCM_INUM (SCM_CAR (p));
+  if (ind >= SCM_ROLENGTH (SCM_CDR (p)))
+    return EOF;
+  SCM_CAR (p) = SCM_MAKINUM (ind + 1);
+  return SCM_ROUCHARS (SCM_CDR (p))[ind];
+}
+
+#ifdef __STDC__
+SCM 
+scm_mkstrport (SCM pos, SCM str, long modes, char * caller)
+#else
+SCM 
+scm_mkstrport (pos, str, modes, caller)
+     SCM pos;
+     SCM str;
+     long modes;
+     char * caller;
+#endif
+{
+  SCM z;
+  SCM stream;
+  struct scm_port_table * pt;
+
+  SCM_ASSERT(SCM_INUMP(pos) && SCM_INUM(pos) >= 0, pos, SCM_ARG1, caller);
+  SCM_ASSERT(SCM_NIMP(str) && SCM_ROSTRINGP(str), str, SCM_ARG1, caller);
+  stream = scm_cons(pos, str);
+  SCM_NEWCELL (z);
+  SCM_DEFER_INTS;
+  pt = scm_add_to_port_table (z);
+  SCM_CAR (z) = scm_tc16_strport | modes;
+  SCM_SETPTAB_ENTRY (z, pt);
+  SCM_SETSTREAM (z, stream);
+  SCM_ALLOW_INTS;
+  return z;
+}
+
+SCM_PROC(s_call_with_output_string, "call-with-output-string", 1, 0, 0, scm_call_with_output_string);
+#ifdef __STDC__
+SCM 
+scm_call_with_output_string (SCM proc)
+#else
+SCM 
+scm_call_with_output_string (proc)
+     SCM proc;
+#endif
+{
+  SCM p;
+  p = scm_mkstrport(SCM_INUM0, scm_make_string(SCM_MAKINUM(30), SCM_UNDEFINED),
+			SCM_OPN | SCM_WRTNG,
+			s_call_with_output_string);
+  scm_apply (proc, p, scm_listofnull);
+  {
+    SCM answer;
+    SCM_DEFER_INTS;
+    answer = scm_makfromstr (SCM_CHARS (SCM_CDR (SCM_STREAM (p))),
+			     SCM_INUM (SCM_CAR (SCM_STREAM (p))),
+			     0);
+    SCM_ALLOW_INTS;
+    return answer;
+  }
+}
+
+
+
+/* Return a Scheme string obtained by printing a given object.
+ */
+
+#ifdef __STDC__
+SCM
+scm_strprint_obj (SCM obj)
+#else
+SCM
+scm_strprint_obj (obj)
+     SCM obj;
+#endif
+{
+  SCM str;
+  SCM port;
+
+  str = scm_makstr (64, 0);
+  port = scm_mkstrport (SCM_MAKINUM (0), str, SCM_OPN | SCM_WRTNG, "scm_strprint_obj");
+  scm_iprin1 (obj, port, 1);
+  {
+    SCM answer;
+    SCM_DEFER_INTS;
+    answer = scm_makfromstr (SCM_CHARS (SCM_CDR (SCM_STREAM (port))),
+			     SCM_INUM (SCM_CAR (SCM_STREAM (port))),
+			     0);
+    SCM_ALLOW_INTS;
+    return answer;
+  }
+}
+
+
+
+
+SCM_PROC(s_call_with_input_string, "call-with-input-string", 2, 0, 0, scm_call_with_input_string);
+#ifdef __STDC__
+SCM 
+scm_call_with_input_string (SCM str, SCM proc)
+#else
+SCM 
+scm_call_with_input_string (str, proc)
+     SCM str;
+     SCM proc;
+#endif
+{
+  SCM p = scm_mkstrport(SCM_INUM0, str, SCM_OPN | SCM_RDNG, s_call_with_input_string);
+  return scm_apply (proc, p, scm_listofnull);
+}
+
+#ifdef __STDC__
+static int 
+noop0 (FILE *stream)
+#else
+static int 
+noop0 (stream)
+     FILE *stream;
+#endif
+{
+  return 0;
+}
+
+
+scm_ptobfuns scm_stptob =
+{
+  scm_markstream,
+  noop0,
+  prinstpt,
+  0,
+  stputc,
+  stputs,
+  stwrite,
+  noop0,
+  stgetc,
+  0
+};
+
+
+#ifdef __STDC__
+void
+scm_init_strports (void)
+#else
+void
+scm_init_strports ()
+#endif
+{
+#include "strports.x"
+}
+
diff --git a/libguile/strports.h b/libguile/strports.h
new file mode 100644
index 000000000..2eb01961e
--- /dev/null
+++ b/libguile/strports.h
@@ -0,0 +1,75 @@
+/* classes: h_files */
+
+#ifndef STRPORTSH
+#define STRPORTSH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+
+extern scm_ptobfuns scm_stptob;
+
+
+#ifdef __STDC__
+extern SCM scm_mkstrport (SCM pos, SCM str, long modes, char * caller);
+extern SCM scm_call_with_output_string (SCM proc);
+extern SCM scm_strprint_obj (SCM obj);
+extern SCM scm_call_with_input_string (SCM str, SCM proc);
+extern void scm_init_strports (void);
+
+#else /* STDC */
+extern SCM scm_mkstrport ();
+extern SCM scm_call_with_output_string ();
+extern SCM scm_strprint_obj ();
+extern SCM scm_call_with_input_string ();
+extern void scm_init_strports ();
+
+#endif /* STDC */
+
+
+
+
+
+
+
+
+#endif  /* STRPORTSH */
diff --git a/libguile/struct.c b/libguile/struct.c
new file mode 100644
index 000000000..265c7d4fd
--- /dev/null
+++ b/libguile/struct.c
@@ -0,0 +1,548 @@
+/*	Copyright (C) 1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+
+static SCM required_vtable_fields = SCM_BOOL_F;
+static int struct_num = 0;
+
+
+SCM_PROC (s_struct_make_layout, "make-struct-layout", 1, 0, 0, scm_make_struct_layout);
+#ifdef __STDC__
+SCM
+scm_make_struct_layout (SCM fields)
+#else
+SCM
+scm_make_struct_layout (fields)
+     SCM fields;
+#endif
+{
+  SCM new_sym;
+  SCM_ASSERT (SCM_NIMP (fields) && SCM_ROSTRINGP (fields),
+	      fields, SCM_ARG1, s_struct_make_layout);
+
+  {
+    char * field_desc;
+    int len;
+    int x;
+
+    len = SCM_ROLENGTH (fields);
+    field_desc = SCM_ROCHARS (fields);
+    SCM_ASSERT (!(len & 1), fields, "odd length field specification", s_struct_make_layout);
+
+    for (x = 0; x < len; x += 2)
+      {
+	switch (field_desc[x])
+	  {
+	  case 'u':
+	  case 'p':
+#if 0
+	  case 'i':
+	  case 'd':
+#endif
+	  case 's':
+	    break;
+	  default:
+	    SCM_ASSERT (0, SCM_MAKICHR (field_desc[x]) , "unrecognized field type", s_struct_make_layout);
+	  }
+
+	switch (field_desc[x + 1])
+	  {
+	  case 'w':
+	    SCM_ASSERT ((field_desc[x] != 's'), SCM_MAKICHR (field_desc[x + 1]),
+			"self fields not writable", s_struct_make_layout);
+	      
+	  case 'r':
+	  case 'o':
+	    break;
+	  default:
+	    SCM_ASSERT (0, SCM_MAKICHR (field_desc[x]) , "unrecognized ref specification", s_struct_make_layout);
+	  }
+#if 0
+	if (field_desc[x] == 'd')
+	  {
+	    SCM_ASSERT (field_desc[x + 2] == '-', SCM_MAKINUM (x / 2), "missing dash field", s_struct_make_layout);
+	    x += 2;
+	    goto recheck_ref;
+	  }
+#endif
+      }
+    new_sym = SCM_CAR (scm_intern_obarray (field_desc, len, SCM_BOOL_F));
+  }
+  return scm_return_first (new_sym, fields);
+}
+
+
+
+
+#ifdef __STDC__
+static void
+init_struct (SCM handle, SCM tail_elts, SCM inits)
+#else
+static void
+init_struct (handle, tail_elts, inits)
+     SCM handle;
+     SCM tail_elts;
+     SCM inits;
+#endif
+{
+  SCM layout;
+  SCM * data;
+  unsigned char * fields_desc;
+  int n_fields;
+  SCM * mem;
+
+  layout = SCM_STRUCT_LAYOUT (handle);
+  data = SCM_STRUCT_DATA (handle);
+  fields_desc = (unsigned char *)SCM_CHARS (layout);
+  n_fields = SCM_LENGTH (layout) / 2;
+  mem = SCM_STRUCT_DATA (handle);
+  while (n_fields)
+    {
+      switch (*fields_desc)
+	{
+#if 0
+	case 'i':
+	  if (   ((fields_desc[1] != 'r') && (fields_desc[1] != 'w'))
+	      || ((inits == SCM_EOL) || !SCM_NUMBERP (SCM_CAR (inits))))
+	    *mem = 0;
+	  else
+	    {
+	      *mem = scm_num2long (SCM_CAR (inits), SCM_ARGn, "init_struct");
+	      inits = SCM_CDR (inits);
+	    }
+	  break;
+#endif
+
+	case 'u':
+	  if (   ((fields_desc[1] != 'r') && (fields_desc[1] != 'w'))
+	      || ((inits == SCM_EOL) || !SCM_NUMBERP (SCM_CAR (inits))))
+	    *mem = 0;
+	  else
+	    {
+	      *mem = scm_num2ulong (SCM_CAR (inits), SCM_ARGn, "init_struct");
+	      inits = SCM_CDR (inits);
+	    }
+	  break;
+
+	case 'p':
+	  if (   ((fields_desc[1] != 'r') && (fields_desc[1] != 'w'))
+	      || (inits == SCM_EOL))
+	    *mem = SCM_EOL;
+	  else
+	    {
+	      *mem = SCM_CAR (inits);
+	      inits = SCM_CDR (inits);
+	    }
+	      
+	  break;
+
+#if 0
+	case 'd':
+	  if (   ((fields_desc[1] != 'r') && (fields_desc[1] != 'w'))
+	      || ((inits == SCM_EOL) || !SCM_NUMBERP (SCM_CAR (inits))))
+	    *((double *)mem) = 0.0;
+	  else
+	    {
+	      *mem = scm_num2dbl (SCM_CAR (inits), "init_struct");
+	      inits = SCM_CDR (inits);
+	    }
+	  fields_desc += 2;
+	  break;
+#endif
+
+	case 's':
+	  *mem = handle;
+	  break;
+	}
+
+      fields_desc += 2;
+      n_fields--;
+      mem++;
+    }
+}
+
+
+SCM_PROC (s_struct_p, "struct?", 1, 0, 0, scm_struct_p);
+#ifdef __STDC__
+SCM
+scm_struct_p (SCM x)
+#else
+SCM
+scm_struct_p (x)
+     SCM x;
+#endif
+{
+  return ((SCM_NIMP (x) && SCM_STRUCTP (x))
+	  ? SCM_BOOL_T
+	  : SCM_BOOL_F);
+}
+
+SCM_PROC (s_struct_vtable_p, "struct-vtable?", 1, 0, 0, scm_struct_vtable_p);
+#ifdef __STDC__
+SCM
+scm_struct_vtable_p (SCM x)
+#else
+SCM
+scm_struct_vtable_p (x)
+     SCM x;
+#endif
+{
+  SCM layout;
+  SCM * mem;
+
+  if (SCM_IMP (x))
+    return SCM_BOOL_F;
+
+  if (!SCM_STRUCTP (x))
+    return SCM_BOOL_F;
+
+  layout = SCM_STRUCT_LAYOUT (x);
+
+  if (SCM_LENGTH (layout) < SCM_LENGTH (required_vtable_fields))
+    return SCM_BOOL_F;
+
+  if (strncmp (SCM_CHARS (layout), SCM_CHARS (required_vtable_fields),
+	       SCM_LENGTH (required_vtable_fields)))
+    return SCM_BOOL_F;
+
+  mem = SCM_STRUCT_DATA (x);
+
+  if (mem[1] != 0)
+    return SCM_BOOL_F;
+
+  if (SCM_IMP (mem[0]))
+    return SCM_BOOL_F;
+
+  return (SCM_SYMBOLP (mem[0])
+	  ? SCM_BOOL_T
+	  : SCM_BOOL_F);
+}
+
+SCM_PROC (s_make_struct, "make-struct", 2, 0, 1, scm_make_struct);
+#ifdef __STDC__
+SCM
+scm_make_struct (SCM vtable, SCM tail_array_size, SCM init)
+#else
+SCM
+scm_make_struct (vtable, tail_array_size, init)
+     SCM vtable;
+     SCM tail_array_size;
+     SCM init;
+#endif
+{
+  SCM layout;
+  int basic_size;
+  int tail_elts;
+  SCM * data;
+  SCM handle;
+
+  SCM_ASSERT ((SCM_BOOL_F != scm_struct_vtable_p (vtable)),
+	      vtable, SCM_ARG1, s_make_struct);
+  SCM_ASSERT (SCM_INUMP (tail_array_size), tail_array_size, SCM_ARG2, s_make_struct);
+
+  layout = SCM_STRUCT_DATA (vtable)[scm_struct_i_layout];
+  basic_size = SCM_LENGTH (layout) / 2;
+  tail_elts = SCM_INUM (tail_array_size);
+  SCM_NEWCELL (handle);
+  SCM_DEFER_INTS;
+  data = (SCM*)scm_must_malloc (sizeof (SCM) * (2 + basic_size + tail_elts), "structure");
+  *data = (SCM)(2 + basic_size + tail_elts);
+  data[1] = struct_num++;
+  data += 2;
+  SCM_SETCDR (handle, data);
+  SCM_SETCAR (handle, ((SCM)SCM_STRUCT_DATA (vtable)) + 1);
+  init_struct (handle, tail_elts, init);
+  SCM_ALLOW_INTS;
+  return handle;
+}
+
+
+
+SCM_PROC (s_make_vtable_vtable, "make-vtable-vtable", 2, 0, 1, scm_make_vtable_vtable);
+#ifdef __STDC__
+SCM
+scm_make_vtable_vtable (SCM extra_fields, SCM tail_array_size, SCM init)
+#else
+SCM
+scm_make_vtable_vtable (extra_fields, tail_array_size, init)
+     SCM extra_fields;
+     SCM tail_array_size;
+     SCM init;
+#endif
+{
+  SCM fields;
+  SCM layout;
+  int basic_size;
+  int tail_elts;
+  SCM * data;
+  SCM handle;
+
+  SCM_ASSERT (SCM_NIMP (extra_fields) && SCM_ROSTRINGP (extra_fields),
+	      extra_fields, SCM_ARG1, s_make_vtable_vtable);
+  SCM_ASSERT (SCM_INUMP (tail_array_size), tail_array_size, SCM_ARG3, s_make_vtable_vtable);
+  
+
+  fields = scm_string_append (scm_listify (required_vtable_fields,
+					   extra_fields,
+					   SCM_UNDEFINED));
+  layout = scm_make_struct_layout (fields);
+  basic_size = SCM_LENGTH (layout) / 2;
+  tail_elts = SCM_INUM (tail_array_size);
+  SCM_NEWCELL (handle);
+  SCM_DEFER_INTS;
+  data = (SCM*)scm_must_malloc (sizeof (SCM) * (2 + basic_size + tail_elts), "structure");
+  *data = (SCM)(2 + basic_size + tail_elts);
+  data[1] = struct_num++;
+  data += 2;
+  SCM_SETCDR (handle, data);
+  SCM_SETCAR (handle, ((SCM)data) + 1);
+  SCM_STRUCT_LAYOUT (handle) = layout;
+  init_struct (handle, tail_elts, scm_cons (layout, init));
+  SCM_ALLOW_INTS;
+  return handle;
+}
+
+
+
+
+SCM_PROC (s_struct_ref, "struct-ref", 2, 0, 0, scm_struct_ref);
+#ifdef __STDC__
+SCM
+scm_struct_ref (SCM handle, SCM pos)
+#else
+SCM
+scm_struct_ref (handle, pos)
+     SCM handle;
+     SCM pos;
+#endif
+{
+  SCM answer;
+  SCM * data;
+  SCM layout;
+  int p;
+  int n_fields;
+  unsigned char * fields_desc;
+  unsigned char field_type;
+  
+
+  SCM_ASSERT (SCM_NIMP (handle) && SCM_STRUCTP (handle), handle,
+	      SCM_ARG1, s_struct_ref);
+  SCM_ASSERT (SCM_INUMP (pos), pos, SCM_ARG2, s_struct_ref);
+
+  layout = SCM_STRUCT_LAYOUT (handle);
+  data = SCM_STRUCT_DATA (handle);
+  p = SCM_INUM (pos);
+
+  fields_desc = (unsigned char *)SCM_CHARS (layout);
+  n_fields = SCM_LENGTH (layout) / 2;
+
+  SCM_ASSERT (p <= n_fields, pos, SCM_OUTOFRANGE, s_struct_ref);
+
+  field_type = fields_desc[p * 2];
+  {
+    unsigned char ref;
+    ref = fields_desc [p * 2 + 1];
+    if ((ref != 'r') && (ref != 'w'))
+      {
+	if ((ref == 'R') || (ref == 'W'))
+	  field_type = 'u';
+	else
+	  SCM_ASSERT (0, pos, "ref denied", s_struct_ref);
+      }
+  }
+  switch (field_type)
+    {
+    case 'u':
+      answer = scm_ulong2num (data[p]);
+      break;
+
+#if 0
+    case 'i':
+      answer = scm_long2num (data[p]);
+      break;
+
+    case 'd':
+      answer = scm_makdbl (*((double *)&(data[p])), 0.0);
+      break;
+#endif
+
+    case 's':
+    case 'p':
+      answer = data[p];
+      break;
+
+
+    default:
+      SCM_ASSERT (0, SCM_MAKICHR (field_type), "unrecognized field type", s_struct_ref);
+      break;
+    }
+
+  return answer;
+}
+
+
+SCM_PROC (s_struct_set_x, "struct-set!", 3, 0, 0, scm_struct_set_x);
+#ifdef __STDC__
+SCM
+scm_struct_set_x (SCM handle, SCM pos, SCM val)
+#else
+SCM
+scm_struct_set_x (handle, pos, val)
+     SCM handle;
+     SCM pos;
+     SCM val;
+#endif
+{
+  SCM * data;
+  SCM layout;
+  int p;
+  int n_fields;
+  unsigned char * fields_desc;
+  unsigned char field_type;
+  
+
+
+  SCM_ASSERT (SCM_NIMP (handle) && SCM_STRUCTP (handle), handle,
+	      SCM_ARG1, s_struct_ref);
+  SCM_ASSERT (SCM_INUMP (pos), pos, SCM_ARG2, s_struct_ref);
+
+  layout = SCM_STRUCT_LAYOUT (handle);
+  data = SCM_STRUCT_DATA (handle);
+  p = SCM_INUM (pos);
+
+  fields_desc = (unsigned char *)SCM_CHARS (layout);
+  n_fields = SCM_LENGTH (layout) / 2;
+
+  SCM_ASSERT (p <= n_fields, pos, SCM_OUTOFRANGE, s_struct_set_x);
+
+  field_type = fields_desc[p * 2];
+  {
+    unsigned char set_x;
+    set_x = fields_desc [p * 2 + 1];
+    if (set_x != 'w')
+      SCM_ASSERT (0, pos, "set_x denied", s_struct_set_x);
+  }
+  switch (field_type)
+    {
+    case 'u':
+      data[p] = (SCM)scm_num2ulong (val, (char *)SCM_ARG3, s_struct_set_x);
+      break;
+
+#if 0
+    case 'i':
+      data[p] = scm_num2long (val, (char *)SCM_ARG3, s_struct_set_x);
+      break;
+
+    case 'd':
+      *((double *)&(data[p])) = scm_num2dbl (val, (char *)SCM_ARG3);
+      break;
+#endif
+
+    case 'p':
+      data[p] = val;
+      break;
+
+    case 's':
+      SCM_ASSERT (0, SCM_MAKICHR (field_type), "self fields immutable", s_struct_set_x);
+      break;
+
+    default:
+      SCM_ASSERT (0, SCM_MAKICHR (field_type), "unrecognized field type", s_struct_set_x);
+      break;
+    }
+
+  return val;
+}
+
+
+SCM_PROC (s_struct_vtable, "struct-vtable", 1, 0, 0, scm_struct_vtable);
+#ifdef __STDC__
+SCM
+scm_struct_vtable (SCM handle)
+#else
+SCM
+scm_struct_vtable (handle)
+     SCM handle;
+#endif
+{
+  SCM_ASSERT (SCM_NIMP (handle) && SCM_STRUCTP (handle), handle,
+	      SCM_ARG1, s_struct_vtable);
+  return SCM_STRUCT_VTABLE (handle);
+}
+
+
+SCM_PROC (s_struct_vtable_tag, "struct-vtable-tag", 1, 0, 0, scm_struct_vtable_tag);
+#ifdef __STDC__
+SCM
+scm_struct_vtable_tag (SCM handle)
+#else
+SCM
+scm_struct_vtable_tag (handle)
+     SCM handle;
+#endif
+{
+  SCM_ASSERT (SCM_NIMP (handle) && (SCM_BOOL_F != scm_struct_vtable_p (handle)),
+	      handle, SCM_ARG1, s_struct_vtable_tag);
+  return scm_long2num (SCM_STRUCT_DATA (handle)[-1]);
+}
+
+
+
+
+#ifdef __STDC__
+void
+scm_init_struct (void)
+#else
+void
+scm_init_struct ()
+#endif
+{
+  required_vtable_fields = SCM_CAR (scm_intern_obarray ("pruosr", sizeof ("pruosr") - 1, SCM_BOOL_F));
+  scm_permanent_object (required_vtable_fields);
+  scm_sysintern ("struct-vtable-offset", SCM_MAKINUM (scm_struct_i_vtable_offset));
+#include "struct.x"
+}
+
diff --git a/libguile/struct.h b/libguile/struct.h
new file mode 100644
index 000000000..b444e282b
--- /dev/null
+++ b/libguile/struct.h
@@ -0,0 +1,101 @@
+/* classes: h_files */
+
+#ifndef STRUCTH
+#define STRUCTH
+/*	Copyright (C) 1995 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+
+
+
+/* These are how the initial words of a vtable are allocated. */
+#define scm_struct_i_n_words -2	/* How many words allocated to this struct? */
+#define scm_struct_i_tag -1	/* A unique tag for this type.. */
+#define scm_struct_i_layout 0	/* A symbol describing the physical arrangement of this type. */
+#define scm_struct_i_vcell 1	/* An opaque word, managed by the garbage collector.  */
+#define scm_struct_i_vtable 2	/* A pointer to the handle for this vtable. */
+#define scm_struct_i_vtable_offset 3 /* Where do user fields start? */
+
+
+#define SCM_STRUCTP(X)  		(SCM_TYP3(X) == scm_tc3_cons_gloc)
+#define SCM_STRUCT_DATA(X) 		((SCM*)(SCM_CDR(X)))
+#define SCM_STRUCT_VTABLE_DATA(X) 	((SCM *)(SCM_CAR(X) - 1))
+#define SCM_STRUCT_LAYOUT(X) 		(SCM_STRUCT_VTABLE_DATA(X)[scm_struct_i_layout])
+#define SCM_STRUCT_VTABLE(X) 		(SCM_STRUCT_VTABLE_DATA(X)[scm_struct_i_vtable])
+
+
+
+#ifdef __STDC__
+extern SCM scm_make_struct_layout (SCM fields);
+extern SCM scm_struct_p (SCM x);
+extern SCM scm_struct_vtable_p (SCM x);
+extern SCM scm_make_struct (SCM vtable, SCM tail_array_size, SCM init);
+extern SCM scm_make_vtable_vtable (SCM extra_fields, SCM tail_array_size, SCM init);
+extern SCM scm_struct_ref (SCM handle, SCM pos);
+extern SCM scm_struct_set_x (SCM handle, SCM pos, SCM val);
+extern SCM scm_struct_vtable (SCM handle);
+extern SCM scm_struct_vtable_tag (SCM handle);
+extern void scm_init_struct (void);
+
+#else /* STDC */
+extern SCM scm_make_struct_layout ();
+extern SCM scm_struct_p ();
+extern SCM scm_struct_vtable_p ();
+extern SCM scm_make_struct ();
+extern SCM scm_make_vtable_vtable ();
+extern SCM scm_struct_ref ();
+extern SCM scm_struct_set_x ();
+extern SCM scm_struct_vtable ();
+extern SCM scm_struct_vtable_tag ();
+extern void scm_init_struct ();
+
+#endif /* STDC */
+
+
+
+
+
+
+
+
+#endif  /* STRUCTH */
diff --git a/libguile/symbols.c b/libguile/symbols.c
new file mode 100644
index 000000000..4a6dd6065
--- /dev/null
+++ b/libguile/symbols.c
@@ -0,0 +1,781 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+
+
+/* NUM_HASH_BUCKETS is the number of symbol scm_hash table buckets. 
+ */
+#define NUM_HASH_BUCKETS 137
+
+
+
+
+/* {Symbols}
+ */
+
+#ifdef __STDC__
+unsigned long 
+scm_strhash (unsigned char *str, scm_sizet len, unsigned long n)
+#else
+unsigned long 
+scm_strhash (str, len, n)
+     unsigned char *str;
+     scm_sizet len;
+     unsigned long n;
+#endif
+{
+  if (len > 5)
+    {
+      scm_sizet i = 5;
+      unsigned long h = 264 % n;
+      while (i--)
+	h = ((h << 8) + ((unsigned) (scm_downcase[str[h % len]]))) % n;
+      return h;
+    }
+  else
+    {
+      scm_sizet i = len;
+      unsigned long h = 0;
+      while (i)
+	h = ((h << 8) + ((unsigned) (scm_downcase[str[--i]]))) % n;
+      return h;
+    }
+}
+
+int scm_symhash_dim = NUM_HASH_BUCKETS;
+
+
+/* scm_sym2vcell
+ * looks up the symbol in the symhash table. 
+ */
+#ifdef __STDC__
+SCM 
+scm_sym2vcell (SCM sym, SCM thunk, SCM definep)
+#else
+SCM 
+scm_sym2vcell (sym, thunk, definep)
+     SCM sym;
+     SCM thunk;
+     SCM definep;
+#endif
+{
+  if (SCM_NIMP(thunk))
+    {
+      SCM var = scm_apply (thunk, sym, scm_cons(definep, scm_listofnull));
+
+      if (var == SCM_BOOL_F)
+	return SCM_BOOL_F;
+      else
+	{
+	  if (SCM_IMP(var) || !SCM_VARIABLEP (var))
+	    scm_wta (sym, "strangely interned symbol? ", "");
+	  return SCM_VARVCELL (var);
+	}
+    }
+  else
+    {
+      SCM lsym;
+      SCM * lsymp;
+      SCM z;
+      scm_sizet scm_hash = scm_strhash (SCM_UCHARS (sym), (scm_sizet) SCM_LENGTH (sym),
+				    (unsigned long) scm_symhash_dim);
+
+      SCM_DEFER_INTS;
+      for (lsym = SCM_VELTS (scm_symhash)[scm_hash]; SCM_NIMP (lsym); lsym = SCM_CDR (lsym))
+	{
+	  z = SCM_CAR (lsym);
+	  if (SCM_CAR (z) == sym)
+	    {
+	      SCM_ALLOW_INTS;
+	      return z;
+	    }
+	}
+
+      for (lsym = *(lsymp = &SCM_VELTS (scm_weak_symhash)[scm_hash]);
+	   SCM_NIMP (lsym);
+	   lsym = *(lsymp = &SCM_CDR (lsym)))
+	{
+	  z = SCM_CAR (lsym);
+	  if (SCM_CAR (z) == sym)
+	    {
+	      if (definep)
+		{
+		  *lsymp = SCM_CDR (lsym);
+		  SCM_SETCDR (lsym, SCM_VELTS(scm_symhash)[scm_hash]);
+		  SCM_VELTS(scm_symhash)[scm_hash] = lsym;
+		}
+	      SCM_ALLOW_INTS;
+	      return z;
+	    }
+	}
+      SCM_ALLOW_INTS;
+      return scm_wta (sym, "uninterned symbol? ", "");
+    }
+}
+
+/* scm_sym2ovcell
+ * looks up the symbol in an arbitrary obarray (defaulting to scm_symhash).
+ */
+#ifdef __STDC__
+SCM 
+scm_sym2ovcell_soft (SCM sym, SCM obarray)
+#else
+SCM 
+scm_sym2ovcell_soft (sym, obarray)
+     SCM sym;
+     SCM obarray;
+#endif
+{
+  SCM lsym, z;
+  scm_sizet scm_hash;
+
+  scm_hash = scm_strhash (SCM_UCHARS (sym),
+			  (scm_sizet) SCM_LENGTH (sym),
+			  SCM_LENGTH (obarray));
+  SCM_REDEFER_INTS;
+  for (lsym = SCM_VELTS (obarray)[scm_hash];
+       SCM_NIMP (lsym);
+       lsym = SCM_CDR (lsym))
+    {
+      z = SCM_CAR (lsym);
+      if (SCM_CAR (z) == sym)
+	{
+	  SCM_REALLOW_INTS;
+	  return z;
+	}
+    }
+  SCM_REALLOW_INTS;
+  return SCM_BOOL_F;
+}
+
+#ifdef __STDC__
+SCM 
+scm_sym2ovcell (SCM sym, SCM obarray)
+#else
+SCM 
+scm_sym2ovcell (sym, obarray)
+     SCM sym;
+     SCM obarray;
+#endif
+{
+  SCM answer;
+  answer = scm_sym2ovcell_soft (sym, obarray);
+  if (answer != SCM_BOOL_F)
+    return answer;
+  scm_wta (sym, "uninterned symbol? ", "");
+  return SCM_UNSPECIFIED;		/* not reached */
+}
+
+#ifdef __STDC__
+SCM 
+scm_intern_obarray_soft (char *name, scm_sizet len, SCM obarray, int softness)
+#else
+SCM 
+scm_intern_obarray_soft (name, len, obarray, softness)
+     char *name;
+     scm_sizet len;
+     SCM obarray;
+     int softness;
+#endif
+{
+  SCM lsym;
+  SCM z;
+  register scm_sizet i;
+  register unsigned char *tmp;
+  scm_sizet scm_hash;
+
+  SCM_REDEFER_INTS;
+
+  i = len;
+  tmp = (unsigned char *) name;
+
+  if (obarray == SCM_BOOL_F)
+    {
+      scm_hash = scm_strhash (tmp, i, 1019);
+      goto uninterned_symbol;
+    }
+
+  scm_hash = scm_strhash (tmp, i, SCM_LENGTH(obarray));
+
+  if (softness == -1)
+    goto mustintern_symbol;
+
+ retry_new_obarray:
+  for (lsym = SCM_VELTS (obarray)[scm_hash]; SCM_NIMP (lsym); lsym = SCM_CDR (lsym))
+    {
+      z = SCM_CAR (lsym);
+      z = SCM_CAR (z);
+      tmp = SCM_UCHARS (z);
+      if (SCM_LENGTH (z) != len)
+	goto trynext;
+      for (i = len; i--;)
+	if (((unsigned char *) name)[i] != tmp[i])
+	  goto trynext;
+      {
+	SCM a;
+	a = SCM_CAR (lsym);
+	SCM_REALLOW_INTS;
+	return a;
+      }
+    trynext:;
+    }
+
+  if (obarray == scm_symhash)
+    {
+      obarray = scm_weak_symhash;
+      goto retry_new_obarray;
+    }
+  
+ uninterned_symbol:
+  if (softness)
+    {
+      SCM_REALLOW_INTS;
+      return SCM_BOOL_F;
+    }
+
+ mustintern_symbol:
+  lsym = scm_makfromstr (name, len, SCM_SYMBOL_SLOTS);
+
+  SCM_SETLENGTH (lsym, (long) len, scm_tc7_msymbol);
+  SCM_SYMBOL_MULTI_BYTE_SCM_STRINGP (lsym) = SCM_BOOL_F;
+  SCM_SYMBOL_HASH (lsym) = scm_hash;
+  if (obarray == SCM_BOOL_F)
+    {
+      SCM answer;
+      SCM_REALLOW_INTS;
+      SCM_NEWCELL (answer);
+      SCM_DEFER_INTS;
+      SCM_CAR (answer) = lsym;
+      SCM_CDR (answer) = SCM_UNDEFINED;
+      SCM_REALLOW_INTS;
+      return answer;
+    }
+  else
+    {
+      SCM a;
+      SCM b;
+
+      SCM_NEWCELL (a);
+      SCM_NEWCELL (b);
+      SCM_SETCAR (a, lsym);
+      SCM_SETCDR (a, SCM_UNDEFINED);
+      SCM_SETCAR (b, a);
+      SCM_SETCDR (b, SCM_VELTS(obarray)[scm_hash]);
+      SCM_VELTS(obarray)[scm_hash] = b;
+      SCM_REALLOW_INTS;
+      return SCM_CAR (b);
+    }
+}
+
+#ifdef __STDC__
+SCM
+scm_intern_obarray (char *name, scm_sizet len, SCM obarray)
+#else
+SCM
+scm_intern_obarray (name, len, obarray)
+     char *name;
+     scm_sizet len;
+     SCM obarray;
+#endif
+{
+  return scm_intern_obarray_soft (name, len, obarray, 0);
+}
+
+
+#ifdef __STDC__
+SCM 
+scm_intern (char *name, scm_sizet len)
+#else
+SCM 
+scm_intern (name, len)
+     char *name;
+     scm_sizet len;
+#endif
+{
+  return scm_intern_obarray (name, len, scm_symhash);
+}
+
+#ifdef __STDC__
+SCM
+scm_intern0 (char * name)
+#else
+SCM
+scm_intern0 (name)
+     char * name;
+#endif
+{
+  return scm_intern (name, strlen (name));
+}
+
+
+#ifdef __STDC__
+SCM 
+scm_sysintern (char *name, SCM val)
+#else
+SCM 
+scm_sysintern (name, val)
+     char *name;
+     SCM val;
+#endif
+{
+  SCM easy_answer;
+  SCM_DEFER_INTS;
+  easy_answer = scm_intern_obarray_soft (name, strlen (name), scm_symhash, 1);
+  if (SCM_NIMP (easy_answer))
+    {
+      SCM_CDR (easy_answer) = val;
+      SCM_ALLOW_INTS;
+      return easy_answer;
+    }
+  else
+    {
+      SCM lsym;
+      scm_sizet len = strlen (name);
+      register unsigned char *tmp = (unsigned char *) name;
+      scm_sizet scm_hash = scm_strhash (tmp, len, (unsigned long) scm_symhash_dim);
+      SCM_NEWCELL (lsym);
+      SCM_SETLENGTH (lsym, (long) len, scm_tc7_ssymbol);
+      SCM_SETCHARS (lsym, name);
+      lsym = scm_cons (lsym, val);
+      SCM_VELTS (scm_symhash)[scm_hash] = scm_cons (lsym, SCM_VELTS (scm_symhash)[scm_hash]);
+      SCM_ALLOW_INTS;
+      return lsym;
+    }
+}
+
+
+SCM_PROC(s_symbol_p, "symbol?", 1, 0, 0, scm_symbol_p);
+#ifdef __STDC__
+SCM
+scm_symbol_p(SCM x)
+#else
+SCM
+scm_symbol_p(x)
+     SCM x;
+#endif
+{
+	if SCM_IMP(x) return SCM_BOOL_F;
+	return SCM_SYMBOLP(x) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+SCM_PROC(s_symbol_to_string, "symbol->string", 1, 0, 0, scm_symbol_to_string);
+#ifdef __STDC__
+SCM
+scm_symbol_to_string(SCM s)
+#else
+SCM
+scm_symbol_to_string(s)
+     SCM s;
+#endif
+{
+	SCM_ASSERT(SCM_NIMP(s) && SCM_SYMBOLP(s), s, SCM_ARG1, s_symbol_to_string);
+	return scm_makfromstr(SCM_CHARS(s), (scm_sizet)SCM_LENGTH(s), 0);
+}
+
+
+SCM_PROC(s_string_to_symbol, "string->symbol", 1, 0, 0, scm_string_to_symbol);
+#ifdef __STDC__
+SCM
+scm_string_to_symbol(SCM s)
+#else
+SCM
+scm_string_to_symbol(s)
+     SCM s;
+#endif
+{
+  SCM vcell;
+  SCM answer;
+
+  SCM_ASSERT(SCM_NIMP(s) && SCM_ROSTRINGP(s), s, SCM_ARG1, s_string_to_symbol);
+  vcell = scm_intern(SCM_ROCHARS(s), (scm_sizet)SCM_LENGTH(s));
+  answer = SCM_CAR (vcell);
+  if (SCM_TYP7 (answer) == scm_tc7_msymbol)
+    {
+      if (SCM_REGULAR_STRINGP (s))
+	SCM_SYMBOL_MULTI_BYTE_SCM_STRINGP (answer) = SCM_BOOL_F;
+      else
+	SCM_SYMBOL_MULTI_BYTE_SCM_STRINGP (answer) = SCM_BOOL_T;
+    }
+  return answer;
+}
+
+
+SCM_PROC(s_string_to_obarray_symbol, "string->obarray-symbol", 2, 1, 0, scm_string_to_obarray_symbol);
+#ifdef __STDC__
+SCM
+scm_string_to_obarray_symbol(SCM o, SCM s, SCM softp)
+#else
+SCM
+scm_string_to_obarray_symbol(o, s, softp)
+     SCM o;
+     SCM s;
+     SCM softp;
+#endif
+{
+  SCM vcell;
+  SCM answer;
+  int softness;
+
+  SCM_ASSERT(SCM_NIMP(s) && SCM_ROSTRINGP(s), s, SCM_ARG2, s_string_to_obarray_symbol);
+  SCM_ASSERT((o == SCM_BOOL_F) || (o == SCM_BOOL_T) || (SCM_NIMP(o) && SCM_VECTORP(o)),
+	 o, SCM_ARG1, s_string_to_obarray_symbol);
+
+  softness = ((softp != SCM_UNDEFINED) && (softp != SCM_BOOL_F));
+  /* iron out some screwy calling conventions */
+  if (o == SCM_BOOL_F)
+    o = scm_symhash;
+  else if (o == SCM_BOOL_T)
+    o = SCM_BOOL_F;
+    
+  vcell = scm_intern_obarray_soft (SCM_ROCHARS(s), (scm_sizet)SCM_ROLENGTH(s), o, softness);
+  if (vcell == SCM_BOOL_F)
+    return vcell;
+  answer = SCM_CAR (vcell);
+  if (SCM_TYP7 (s) == scm_tc7_msymbol)
+    {
+      if (SCM_REGULAR_STRINGP (s))
+	SCM_SYMBOL_MULTI_BYTE_SCM_STRINGP (answer) = SCM_BOOL_F;
+      else
+	SCM_SYMBOL_MULTI_BYTE_SCM_STRINGP (answer) = SCM_BOOL_T;
+    }
+  return answer;
+}
+
+SCM_PROC(s_intern_symbol, "intern-symbol", 2, 0, 0, scm_intern_symbol);
+#ifdef __STDC__
+SCM
+scm_intern_symbol(SCM o, SCM s)
+#else
+SCM
+scm_intern_symbol(o, s)
+     SCM o;
+     SCM s;
+#endif
+{
+        scm_sizet hval;
+	SCM_ASSERT(SCM_NIMP(s) && SCM_SYMBOLP(s), s, SCM_ARG2, s_intern_symbol);
+	if (o == SCM_BOOL_F)
+	  o = scm_symhash;
+	SCM_ASSERT(SCM_NIMP(o) && SCM_VECTORP(o), o, SCM_ARG1, s_intern_symbol);
+	hval = scm_strhash (SCM_UCHARS (s), SCM_LENGTH (s), SCM_LENGTH(o));
+	/* If the symbol is already interned, simply return. */
+	SCM_REDEFER_INTS;
+	{
+	  SCM lsym;
+	  SCM sym;
+	  for (lsym = SCM_VELTS (o)[hval];
+	       SCM_NIMP (lsym);
+	       lsym = SCM_CDR (lsym))
+	    {
+	      sym = SCM_CAR (lsym);
+	      if (SCM_CAR (sym) == s)
+		{
+		  SCM_REALLOW_INTS;
+		  return SCM_UNSPECIFIED;
+		}
+	    }
+	  SCM_VELTS (o)[hval] =
+	    scm_acons (s, SCM_UNDEFINED, SCM_VELTS (o)[hval]);
+	}
+	SCM_REALLOW_INTS;
+	return SCM_UNSPECIFIED;
+}
+
+SCM_PROC(s_unintern_symbol, "unintern-symbol", 2, 0, 0, scm_unintern_symbol);
+#ifdef __STDC__
+SCM
+scm_unintern_symbol(SCM o, SCM s)
+#else
+SCM
+scm_unintern_symbol(o, s)
+     SCM o;
+     SCM s;
+#endif
+{
+        scm_sizet hval;
+	SCM_ASSERT(SCM_NIMP(s) && SCM_SYMBOLP(s), s, SCM_ARG2, s_unintern_symbol);
+	if (o == SCM_BOOL_F)
+	  o = scm_symhash;
+	SCM_ASSERT(SCM_NIMP(o) && SCM_VECTORP(o), o, SCM_ARG1, s_unintern_symbol);
+	hval = scm_strhash (SCM_UCHARS (s), SCM_LENGTH (s), SCM_LENGTH(o));
+	SCM_DEFER_INTS;
+	{
+	  SCM lsym_follow;
+	  SCM lsym;
+	  SCM sym;
+	  for (lsym = SCM_VELTS (o)[hval], lsym_follow = SCM_BOOL_F;
+	       SCM_NIMP (lsym);
+	       lsym_follow = lsym, lsym = SCM_CDR (lsym))
+	    {
+	      sym = SCM_CAR (lsym);
+	      if (SCM_CAR (sym) == s)
+		{
+		  /* Found the symbol to unintern. */
+		  if (lsym_follow == SCM_BOOL_F)
+		    SCM_VELTS(o)[hval] = lsym;
+		  else
+		    SCM_CDR(lsym_follow) = SCM_CDR(lsym);
+		  SCM_ALLOW_INTS;
+		  return SCM_BOOL_T;
+		}
+	    }
+	}
+	SCM_ALLOW_INTS;
+	return SCM_BOOL_F;
+}
+
+SCM_PROC(s_symbol_binding, "symbol-binding", 2, 0, 0, scm_symbol_binding);
+#ifdef __STDC__
+SCM
+scm_symbol_binding (SCM o, SCM s)
+#else
+SCM
+scm_symbol_binding (o, s)
+     SCM o;
+     SCM s;
+#endif
+{
+  SCM vcell;
+  SCM_ASSERT(SCM_NIMP(s) && SCM_SYMBOLP(s), s, SCM_ARG2, s_symbol_binding);
+  if (o == SCM_BOOL_F)
+    o = scm_symhash;
+  SCM_ASSERT(SCM_NIMP(o) && SCM_VECTORP(o), o, SCM_ARG1, s_symbol_binding);
+  vcell = scm_sym2ovcell (s, o);
+  return SCM_CDR(vcell);
+}
+
+
+SCM_PROC(s_symbol_interned_p, "symbol-interned?", 2, 0, 0, scm_symbol_interned_p);
+#ifdef __STDC__
+SCM
+scm_symbol_interned_p (SCM o, SCM s)
+#else
+SCM
+scm_symbol_interned_p (o, s)
+     SCM o;
+     SCM s;
+#endif
+{
+  SCM vcell;
+  SCM_ASSERT(SCM_NIMP(s) && SCM_SYMBOLP(s), s, SCM_ARG2, s_symbol_interned_p);
+  if (o == SCM_BOOL_F)
+    o = scm_symhash;
+  SCM_ASSERT(SCM_NIMP(o) && SCM_VECTORP(o), o, SCM_ARG1, s_symbol_interned_p);
+  vcell = scm_sym2ovcell_soft (s, o);
+  if (SCM_IMP(vcell) && (o == scm_symhash))
+    vcell = scm_sym2ovcell_soft (s, scm_weak_symhash);
+  return (SCM_NIMP(vcell)
+	  ? SCM_BOOL_T
+	  : SCM_BOOL_F);
+}
+
+
+SCM_PROC(s_symbol_bound_p, "symbol-bound?", 2, 0, 0, scm_symbol_bound_p);
+#ifdef __STDC__
+SCM 
+scm_symbol_bound_p (SCM o, SCM s)
+#else
+SCM 
+scm_symbol_bound_p (o, s)
+     SCM o;
+     SCM s;
+#endif
+{
+  SCM vcell;
+  SCM_ASSERT(SCM_NIMP(s) && SCM_SYMBOLP(s), s, SCM_ARG2, s_symbol_bound_p);
+  if (o == SCM_BOOL_F)
+    o = scm_symhash;
+  SCM_ASSERT(SCM_NIMP(o) && SCM_VECTORP(o), o, SCM_ARG1, s_symbol_bound_p);
+  vcell = scm_sym2ovcell_soft (s, o);
+  return ((  SCM_NIMP(vcell)
+	   && (SCM_CDR(vcell) != SCM_UNDEFINED))
+	  ? SCM_BOOL_T
+	  : SCM_BOOL_F);
+}
+
+
+SCM_PROC(s_symbol_set_x, "symbol-set!", 3, 0, 0, scm_symbol_set_x);
+#ifdef __STDC__
+SCM 
+scm_symbol_set_x (SCM o, SCM s, SCM v)
+#else
+SCM 
+scm_symbol_set_x (o, s, v)
+     SCM o;
+     SCM s;
+     SCM v;
+#endif
+{
+  SCM vcell;
+  SCM_ASSERT(SCM_NIMP(s) && SCM_SYMBOLP(s), s, SCM_ARG2, s_symbol_set_x);
+  if (o == SCM_BOOL_F)
+    o = scm_symhash;
+  SCM_ASSERT(SCM_NIMP(o) && SCM_VECTORP(o), o, SCM_ARG1, s_symbol_set_x);
+  vcell = scm_sym2ovcell (s, o);
+  SCM_CDR(vcell) = v;
+  return SCM_UNSPECIFIED;
+}
+
+static void
+msymbolize (s)
+     SCM s;
+{
+  SCM string;
+  string = scm_makfromstr (SCM_CHARS (s), SCM_LENGTH (s), SCM_SYMBOL_SLOTS);
+  SCM_SETCHARS (s, SCM_CHARS (string));
+  SCM_SETLENGTH (s, SCM_LENGTH (s), scm_tc7_msymbol);
+  SCM_SYMBOL_MULTI_BYTE_SCM_STRINGP (s) = SCM_BOOL_F;
+  SCM_CDR (string) = SCM_EOL;
+  SCM_CAR (string) = SCM_EOL;
+}
+
+
+SCM_PROC(s_symbol_fref, "symbol-fref", 1, 0, 0, scm_symbol_fref);
+#ifdef __STDC__
+SCM
+scm_symbol_fref (SCM s)
+#else
+SCM
+scm_symbol_fref (s)
+     SCM s;
+#endif
+{
+  SCM_ASSERT(SCM_NIMP(s) && SCM_SYMBOLP(s), s, SCM_ARG1, s_symbol_fref);
+  SCM_DEFER_INTS;
+  if (SCM_TYP7(s) == scm_tc7_ssymbol)
+    msymbolize (s);
+  SCM_ALLOW_INTS;
+  return SCM_SYMBOL_FUNC (s);
+}
+
+
+SCM_PROC(s_symbol_pref, "symbol-pref", 1, 0, 0, scm_symbol_pref);
+#ifdef __STDC__
+SCM
+scm_symbol_pref (SCM s)
+#else
+SCM
+scm_symbol_pref (s)
+     SCM s;
+#endif
+{
+  SCM_ASSERT(SCM_NIMP(s) && SCM_SYMBOLP(s), s, SCM_ARG1, s_symbol_pref);
+  SCM_DEFER_INTS;
+  if (SCM_TYP7(s) == scm_tc7_ssymbol)
+    msymbolize (s);
+  SCM_ALLOW_INTS;
+  return SCM_SYMBOL_PROPS (s);
+}
+
+
+SCM_PROC(s_symbol_fset_x, "symbol-fset!", 2, 0, 0, scm_symbol_fset_x);
+#ifdef __STDC__
+SCM
+scm_symbol_fset_x (SCM s, SCM val)
+#else
+SCM
+scm_symbol_fset_x (s, val)
+     SCM s;
+     SCM val;
+#endif
+{
+  SCM_ASSERT(SCM_NIMP(s) && SCM_SYMBOLP(s), s, SCM_ARG1, s_symbol_fset_x);
+  SCM_DEFER_INTS;
+  if (SCM_TYP7(s) == scm_tc7_ssymbol)
+    msymbolize (s);
+  SCM_ALLOW_INTS;
+  SCM_SYMBOL_FUNC (s) = val;
+  return SCM_UNSPECIFIED;
+}
+
+
+SCM_PROC(s_symbol_pset_x, "symbol-pset!", 2, 0, 0, scm_symbol_pset_x);
+#ifdef __STDC__
+SCM
+scm_symbol_pset_x (SCM s, SCM val)
+#else
+SCM
+scm_symbol_pset_x (s, val)
+     SCM s;
+     SCM val;
+#endif
+{
+  SCM_ASSERT(SCM_NIMP(s) && SCM_SYMBOLP(s), s, SCM_ARG1, s_symbol_pset_x);
+  SCM_DEFER_INTS;
+  if (SCM_TYP7(s) == scm_tc7_ssymbol)
+    msymbolize (s);
+  SCM_SYMBOL_PROPS (s) = val;
+  SCM_ALLOW_INTS;
+  return SCM_UNSPECIFIED;
+}
+
+
+SCM_PROC(s_symbol_hash, "symbol-hash", 1, 0, 0, scm_symbol_hash);
+#ifdef __STDC__
+SCM
+scm_symbol_hash (SCM s)
+#else
+SCM
+scm_symbol_hash (s)
+     SCM s;
+#endif
+{
+  SCM_ASSERT(SCM_NIMP(s) && SCM_SYMBOLP(s), s, SCM_ARG1, s_symbol_hash);
+  return SCM_MAKINUM ((unsigned long)s ^ SCM_SYMBOL_HASH (s));
+}
+
+
+#ifdef __STDC__
+void
+scm_init_symbols (void)
+#else
+void
+scm_init_symbols ()
+#endif
+{
+#include "symbols.x"
+}
+
diff --git a/libguile/symbols.h b/libguile/symbols.h
new file mode 100644
index 000000000..b1486ce7a
--- /dev/null
+++ b/libguile/symbols.h
@@ -0,0 +1,141 @@
+/* classes: h_files */
+
+#ifndef SYMBOLSH
+#define SYMBOLSH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+
+
+extern int scm_symhash_dim;
+
+#define SCM_SYMBOLP(x) (SCM_TYP7S(x)==scm_tc7_ssymbol)
+#define SCM_LENGTH(x) (((unsigned long)SCM_CAR(x))>>8)
+#define SCM_LENGTH_MAX (0xffffffL)
+#define SCM_SETLENGTH(x, v, t) SCM_CAR(x) = ((v)<<8)+(t)
+#define SCM_SETCHARS SCM_SETCDR
+#define SCM_CHARS(x) ((char *)(SCM_CDR(x)))
+#define SCM_UCHARS(x) ((unsigned char *)(SCM_CDR(x)))
+#define SCM_SLOTS(x) ((SCM *) (* ((SCM *)SCM_CHARS(x) - 1)))
+#define SCM_SYMBOL_SLOTS 5
+#define SCM_SYMBOL_FUNC(X) (SCM_SLOTS(X)[0])
+#define SCM_SYMBOL_PROPS(X) (SCM_SLOTS(X)[1])
+#define SCM_SYMBOL_HASH(X) (*(unsigned long*)(&SCM_SLOTS(X)[2]))
+#define SCM_SYMBOL_MULTI_BYTE_SCM_STRINGP(X) (*(unsigned long*)(&SCM_SLOTS(X)[3]))
+
+#define SCM_ROSTRINGP(x) ((SCM_TYP7SD(x)==scm_tc7_string) || (SCM_TYP7S(x) == scm_tc7_ssymbol))
+#define SCM_ROCHARS(x) ((SCM_TYP7(x) == scm_tc7_substring) \
+			? SCM_INUM (SCM_CADR (x)) + SCM_CHARS (SCM_CDDR (x))  \
+			: SCM_CHARS (x))
+#define SCM_ROUCHARS(x) ((SCM_TYP7(x) == scm_tc7_substring) \
+			 ? SCM_INUM (SCM_CADR (x)) + SCM_UCHARS (SCM_CDDR (x))  \
+			 : SCM_UCHARS (x))
+#define SCM_ROLENGTH(x) SCM_LENGTH (x)
+#define SCM_SUBSTRP(x) ((SCM_TYP7S(x) == scm_tc7_substring))
+#define SCM_SUBSTR_STR(x) (SCM_CDDR (x))
+#define SCM_SUBSTR_OFFSET(x) (SCM_CADR (x))
+
+
+
+#ifdef __STDC__
+extern unsigned long scm_strhash (unsigned char *str, scm_sizet len, unsigned long n);
+extern SCM scm_sym2vcell (SCM sym, SCM thunk, SCM definep);
+extern SCM scm_sym2ovcell_soft (SCM sym, SCM obarray);
+extern SCM scm_sym2ovcell (SCM sym, SCM obarray);
+extern SCM scm_intern_obarray_soft (char *name, scm_sizet len, SCM obarray, int softness);
+extern SCM scm_intern_obarray (char *name, scm_sizet len, SCM obarray);
+extern SCM scm_intern (char *name, scm_sizet len);
+extern SCM scm_intern0 (char * name);
+extern SCM scm_sysintern (char *name, SCM val);
+extern SCM scm_symbol_p(SCM x);
+extern SCM scm_symbol_to_string(SCM s);
+extern SCM scm_string_to_symbol(SCM s);
+extern SCM scm_string_to_obarray_symbol(SCM o, SCM s, SCM softp);
+extern SCM scm_intern_symbol(SCM o, SCM s);
+extern SCM scm_unintern_symbol(SCM o, SCM s);
+extern SCM scm_symbol_binding (SCM o, SCM s);
+extern SCM scm_symbol_interned_p (SCM o, SCM s);
+extern SCM scm_symbol_bound_p (SCM o, SCM s);
+extern SCM scm_symbol_set_x (SCM o, SCM s, SCM v);
+extern SCM scm_symbol_fref (SCM s);
+extern SCM scm_symbol_pref (SCM s);
+extern SCM scm_symbol_fset_x (SCM s, SCM val);
+extern SCM scm_symbol_pset_x (SCM s, SCM val);
+extern SCM scm_symbol_hash (SCM s);
+extern void scm_init_symbols (void);
+
+#else /* STDC */
+extern unsigned long scm_strhash ();
+extern SCM scm_sym2vcell ();
+extern SCM scm_sym2ovcell_soft ();
+extern SCM scm_sym2ovcell ();
+extern SCM scm_intern_obarray_soft ();
+extern SCM scm_intern_obarray ();
+extern SCM scm_intern ();
+extern SCM scm_intern0 ();
+extern SCM scm_sysintern ();
+extern SCM scm_symbol_p();
+extern SCM scm_symbol_to_string();
+extern SCM scm_string_to_symbol();
+extern SCM scm_string_to_obarray_symbol();
+extern SCM scm_intern_symbol();
+extern SCM scm_unintern_symbol();
+extern SCM scm_symbol_binding ();
+extern SCM scm_symbol_interned_p ();
+extern SCM scm_symbol_bound_p ();
+extern SCM scm_symbol_set_x ();
+extern SCM scm_symbol_fref ();
+extern SCM scm_symbol_pref ();
+extern SCM scm_symbol_fset_x ();
+extern SCM scm_symbol_pset_x ();
+extern SCM scm_symbol_hash ();
+extern void scm_init_symbols ();
+
+#endif /* STDC */
+
+
+
+
+
+
+#endif  /* SYMBOLSH */
diff --git a/libguile/tag.c b/libguile/tag.c
new file mode 100644
index 000000000..a305d70b2
--- /dev/null
+++ b/libguile/tag.c
@@ -0,0 +1,220 @@
+/*	Copyright (C) 1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+
+SCM_CONST_LONG (scm_utag_immediate_integer, "utag_immediate_integer", 0);
+SCM_CONST_LONG (scm_utag_immediate_char, "utag_immediate_char", 1);
+SCM_CONST_LONG (scm_utag_pair, "utag_pair", 2);
+SCM_CONST_LONG (scm_utag_closure, "utag_closure", 3);
+SCM_CONST_LONG (scm_utag_symbol, "utag_symbol", 4);
+SCM_CONST_LONG (scm_utag_vector, "utag_vector", 5);
+SCM_CONST_LONG (scm_utag_wvect, "utag_wvect", 6);
+SCM_CONST_LONG (scm_utag_bvect, "utag_bvect", 7);
+SCM_CONST_LONG (scm_utag_byvect, "utag_byvect", 8);
+SCM_CONST_LONG (scm_utag_svect, "utag_svect", 9);
+SCM_CONST_LONG (scm_utag_ivect, "utag_ivect", 10);
+SCM_CONST_LONG (scm_utag_uvect, "utag_uvect", 11);
+SCM_CONST_LONG (scm_utag_fvect, "utag_fvect", 12);
+SCM_CONST_LONG (scm_utag_dvect, "utag_dvect", 13);
+SCM_CONST_LONG (scm_utag_cvect, "utag_cvect", 14);
+SCM_CONST_LONG (scm_utag_string, "utag_string", 15);
+SCM_CONST_LONG (scm_utag_mb_string, "utag_mb_string", 16);
+SCM_CONST_LONG (scm_utag_substring, "utag_substring", 17);
+SCM_CONST_LONG (scm_utag_mb_substring, "utag_mb_substring", 18);
+SCM_CONST_LONG (scm_utag_asubr, "utag_asubr", 19);
+SCM_CONST_LONG (scm_utag_subr_0, "utag_subr_0", 20);
+SCM_CONST_LONG (scm_utag_subr_1, "utag_subr_1", 21);
+SCM_CONST_LONG (scm_utag_cxr, "utag_cxr", 22);
+SCM_CONST_LONG (scm_utag_subr_3, "utag_subr_3", 23);
+SCM_CONST_LONG (scm_utag_subr_2, "utag_subr_2", 24);
+SCM_CONST_LONG (scm_utag_rpsubr, "utag_rpsubr", 25);
+SCM_CONST_LONG (scm_utag_subr_1o, "utag_subr_1o", 26);
+SCM_CONST_LONG (scm_utag_subr_2o, "utag_subr_2o", 27);
+SCM_CONST_LONG (scm_utag_lsubr_2, "utag_lsubr_2", 28);
+SCM_CONST_LONG (scm_utag_lsubr, "utag_lsubr", 29);
+SCM_CONST_LONG (scm_utag_smob_base, "utag_smob_base", 252);
+SCM_CONST_LONG (scm_utag_port_base, "utag_port_base", 253);
+SCM_CONST_LONG (scm_utag_flag_base, "utag_flag_base", 254);
+SCM_CONST_LONG (scm_utag_struct_base, "utag_struct_base", 255);
+
+
+SCM_PROC (s_tag, "tag", 1, 0, 0, scm_tag);
+#ifdef __STDC__
+SCM
+scm_tag (SCM x)
+#else
+SCM
+scm_tag (x)
+     SCM x;
+#endif
+{
+  switch (SCM_ITAG3 (x))
+    {
+    case scm_tc3_int_1:
+    case scm_tc3_int_2:
+      return SCM_CDR (scm_utag_immediate_integer) ;
+
+    case scm_tc3_imm24:
+      if (SCM_ICHRP (x))
+	return SCM_CDR (scm_utag_immediate_char) ;
+      else
+	{
+	  int tag;
+	  tag = SCM_MAKINUM ((x >> 8) & 0xff);
+	  return SCM_MAKINUM (SCM_INUM (SCM_CDR (scm_utag_flag_base) ) | (tag << 8));
+	}
+
+    case scm_tc3_cons:
+      switch (SCM_TYP7 (x))
+	{
+	case scm_tcs_cons_nimcar:
+	  return SCM_CDR (scm_utag_pair) ;
+	case scm_tcs_closures:
+	  return SCM_CDR (scm_utag_closure) ;
+	case scm_tcs_symbols:
+	  return SCM_CDR (scm_utag_symbol) ;
+	case scm_tc7_vector:
+	  return SCM_CDR (scm_utag_vector) ;
+	case scm_tc7_wvect:
+	  return SCM_CDR (scm_utag_wvect) ;
+	case scm_tc7_bvect:
+	  return SCM_CDR (scm_utag_bvect) ;
+	case scm_tc7_byvect:
+	  return SCM_CDR (scm_utag_byvect) ;
+	case scm_tc7_svect:
+	  return SCM_CDR (scm_utag_svect) ;
+	case scm_tc7_ivect:
+	  return SCM_CDR (scm_utag_ivect) ;
+	case scm_tc7_uvect:
+	  return SCM_CDR (scm_utag_uvect) ;
+	case scm_tc7_fvect:
+	  return SCM_CDR (scm_utag_fvect) ;
+	case scm_tc7_dvect:
+	  return SCM_CDR (scm_utag_dvect) ;
+	case scm_tc7_cvect:
+	  return SCM_CDR (scm_utag_cvect) ;
+	case scm_tc7_string:
+	  return SCM_CDR (scm_utag_string) ;
+	case scm_tc7_mb_string:
+	  return SCM_CDR (scm_utag_mb_string) ;
+	case scm_tc7_substring:
+	  return SCM_CDR (scm_utag_substring) ;
+	case scm_tc7_mb_substring:
+	  return SCM_CDR (scm_utag_mb_substring) ;
+	case scm_tc7_asubr:
+	  return SCM_CDR (scm_utag_asubr) ;
+	case scm_tc7_subr_0:
+	  return SCM_CDR (scm_utag_subr_0) ;
+	case scm_tc7_subr_1:
+	  return SCM_CDR (scm_utag_subr_1) ;
+	case scm_tc7_cxr:
+	  return SCM_CDR (scm_utag_cxr) ;
+	case scm_tc7_subr_3:
+	  return SCM_CDR (scm_utag_subr_3) ;
+	case scm_tc7_subr_2:
+	  return SCM_CDR (scm_utag_subr_2) ;
+	case scm_tc7_rpsubr:
+	  return SCM_CDR (scm_utag_rpsubr) ;
+	case scm_tc7_subr_1o:
+	  return SCM_CDR (scm_utag_subr_1o) ;
+	case scm_tc7_subr_2o:
+	  return SCM_CDR (scm_utag_subr_2o) ;
+	case scm_tc7_lsubr_2:
+	  return SCM_CDR (scm_utag_lsubr_2) ;
+	case scm_tc7_lsubr:
+	  return SCM_CDR (scm_utag_lsubr) ;
+
+	case scm_tc7_port:
+	  {
+	    int tag;
+	    tag = (SCM_TYP16 (x) >> 8) & 0xff;
+	    return SCM_MAKINUM (SCM_INUM (SCM_CDR (scm_utag_port_base)) | (tag << 8));
+	  }
+	case scm_tc7_smob:
+	  {
+	    int tag;
+	    tag = (SCM_TYP16 (x) >> 8) & 0xff;
+	    return SCM_MAKINUM (SCM_INUM (SCM_CDR (scm_utag_smob_base)) | (tag << 8));
+	  }
+	case scm_tcs_cons_gloc:
+	  /* must be a struct */
+	  {
+	    int tag;
+	    tag = SCM_STRUCT_VTABLE_DATA (x)[scm_struct_i_tag];
+	    return SCM_MAKINUM (SCM_INUM (SCM_CDR (scm_utag_struct_base)) | (tag << 8));
+	  }
+	  return SCM_CDR (scm_utag_struct_base) ;
+
+	default:
+	  if (SCM_CONSP (x))
+	    return SCM_CDR (scm_utag_pair);
+	  else
+	    return SCM_MAKINUM (-1);
+	}
+
+    case scm_tc3_cons_gloc:
+    case scm_tc3_tc7_1:
+    case scm_tc3_tc7_2:
+    case scm_tc3_closure:
+      /* Never reached */
+      break;
+    }
+  return SCM_MAKINUM (-1);
+}
+
+
+
+
+#ifdef __STDC__
+void
+scm_init_tag (void)
+#else
+void
+scm_init_tag ()
+#endif
+{
+#include "tag.x"
+}
+
diff --git a/libguile/tag.h b/libguile/tag.h
new file mode 100644
index 000000000..a7d1ab761
--- /dev/null
+++ b/libguile/tag.h
@@ -0,0 +1,63 @@
+/* classes: h_files */
+
+#ifndef TAGH
+#define TAGH
+/*	Copyright (C) 1995 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+
+
+
+
+
+
+#ifdef __STDC__
+extern SCM scm_tag (SCM x);
+extern void scm_init_tag (void);
+
+#else /* STDC */
+extern SCM scm_tag ();
+extern void scm_init_tag ();
+
+#endif /* STDC */
+#endif  /* TAGH */
diff --git a/libguile/tags.h b/libguile/tags.h
new file mode 100644
index 000000000..1469a90f6
--- /dev/null
+++ b/libguile/tags.h
@@ -0,0 +1,532 @@
+/* classes: h_files */
+
+#ifndef TAGSH
+#define TAGSH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+/** This file defines the format of SCM values and cons pairs.  
+ ** It is here that tag bits are assigned for various purposes.
+ **/
+
+
+
+/* In the beginning was the Word:
+ */
+typedef long SCM;
+
+
+
+/* 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 scm_cell, pointers
+ * to scm_vector elts, functions, &c are not munged.
+ */
+#ifdef _UNICOS
+# define SCM2PTR(x) ((int)(x) >> 3)
+# define PTR2SCM(x) (((SCM)(x)) << 3)
+# define SCM_POINTERS_MUNGED
+#else
+# define SCM2PTR(x) (x)
+# define PTR2SCM(x) ((SCM)(x))
+#endif /* def _UNICOS */
+
+
+/* SCM variables can contain:
+ *
+ * Non-objects -- meaning that the tag-related macros don't apply to them
+ * in the usual way.
+ *
+ * Immediates -- meaning that the variable contains an entire Scheme object.
+ *
+ * Non-immediates -- meaning that the variable holds a (possibly tagged) pointer
+ * into the cons pair heap.
+ *
+ * Non-objects are distinguished from other values by careful coding only (i.e.,
+ * programmers must keep track of any SCM variables they create that don't contain
+ * ordinary scheme values).
+ *
+ * All immediates and non-immediates must have a 0 in bit 0.  Only non-object
+ * values can have a 1 in bit 0.   In some cases, bit 0 of a word in the heap
+ * is used for the GC tag so during garbage collection, that bit might be 1
+ * even in an immediate or non-immediate value.  In other cases, bit 0 of a word
+ * in the heap is used to tag a pointer to a GLOC (VM global variable address)
+ * or the header of a struct.   But whenever an SCM variable holds a normal Scheme
+ * value, bit 0 is 0.
+ *
+ * Immediates and non-immediates are distinguished by bits two and four.
+ * Immediate values must have a 1 in at least one of those bits.  Does
+ * this (or any other detail of tagging) seem arbitrary?  Try chaning it!
+ * (Not always impossible but it is fair to say that many details of tags
+ * are mutually dependent).
+ */
+
+#define SCM_IMP(x) 		(6 & (int)(x))
+#define SCM_NIMP(x) 		(!SCM_IMP(x))
+
+/* Here is a summary of tagging in SCM values as they might occur in
+ * SCM variables or in the heap. 
+ *
+ * low bits    meaning
+ *
+ * 
+ * 0		Most objects except...
+ * 1 		...glocs and structs (this tag valid only in a SCM_CAR or
+ *		in the header of a struct's data).
+ *
+ * 00		heap addresses and many immediates (not integers)
+ * 01		glocs/structs, some tc7_ codes
+ * 10		immediate integers
+ * 11		various tc7_ codes including, tc16_ codes.
+ *
+ *
+ * 000		heap address
+ * 001		glocs/structs
+ * 010		integer
+ * 011		closure
+ * 100		immediates
+ * 101		tc7_
+ * 110 		integer
+ * 111		tc7_
+ *
+ *
+ * 100 --- IMMEDIATES
+ *
+ * Looking at the seven final bits of an immediate:
+ * 
+ * 0000-100	short instruction
+ * 0001-100	short instruction
+ * 0010-100	short instruction
+ * 0011-100	short instruction
+ * 0100-100	short instruction
+ * 0101-100	short instruction
+ * 0110-100	various immediates and long instructions
+ * 0111-100	short instruction
+ * 1000-100	short instruction
+ * 1001-100	short instruction
+ * 1010-100	short instruction
+ * 1011-100	short instruction
+ * 1100-100	short instruction
+ * 1101-100	short instruction
+ * 1110-100	immediate characters
+ * 1111-100	ilocs
+ *
+ * Some of the 0110100 immediates are long instructions (they dispatch 
+ * in two steps compared to one step for a short instruction).
+ * The two steps are, (1) dispatch on 7 bits to the long instruction
+ * handler, (2) dispatch on 7 additional bits.
+ *
+ * One way to think of it is that there are 128 short instructions,
+ * with the 13 immediates above being some of the most interesting.
+ *
+ * Also noteworthy are the groups of 16 7-bit instructions implied by
+ * some of the 3-bit tags.   For example, closure references consist
+ * of an 8-bit aligned address tagged with 011.  There are 16 identical 7-bit
+ * instructions, all ending 011, which are invoked by evaluating closures.
+ *
+ * In other words, if you hand the evaluator a closure, the evaluator
+ * treats the closure as a graph of virtual machine instructions.
+ * A closure is a pair with a pointer to the body of the procedure
+ * in the CDR and a pointer to the environment of the closure in the CAR.
+ * The environment pointer is tagged 011 which implies that the least
+ * significant 7 bits of the environment pointer also happen to be
+ * a virtual machine instruction we could call "SELF" (for self-evaluating
+ * object).
+ *
+ * A less trivial example are the 16 instructions ending 000.  If those
+ * bits tag the CAR of a pair, then evidently the pair is an ordinary
+ * cons pair and should be evaluated as a procedure application.  The sixteen,
+ * 7-bit 000 instructions are all "NORMAL-APPLY"  (Things get trickier.
+ * For example, if the CAR of a procedure application is a symbol, the NORMAL-APPLY
+ * instruction will, as a side effect, overwrite that CAR with a new instruction
+ * that contains a cached address for the variable named by the symbol.)
+ *
+ * Here is a summary of tags in the CAR of a non-immediate:
+ *
+ *   HEAP CELL:	G=gc_mark; 1 during mark, 0 other times.
+ *
+ * cons	   ..........SCM car..............0  ...........SCM cdr.............G
+ * gloc    ..........SCM vcell..........001  ...........SCM cdr.............G
+ * struct  ..........void * type........001  ...........void * data.........G
+ * closure ..........SCM code...........011  ...........SCM env.............G
+ * tc7	   .........long length....GxxxD1S1  ..........void *data............
+ *
+ *
+ *
+ * 101 & 111 --- tc7_ types
+ *
+ *		tc7_tags are 7 bit tags ending in 1x1.  These tags occur
+ *		only in the CAR of heap cells.
+ *
+ *		SCM_LENGTH returns the bits in "length" (see the diagram).
+ *		SCM_CHARS returns the data cast to "char *"
+ *		SCM_CDR returns the data cast to "SCM"
+ *		TYP7(X) returns bits 0...6 of SCM_CAR (X)
+ *
+ *		For the interpretation of SCM_LENGTH and SCM_CHARS
+ *		that applies to a particular type, see the header file
+ *		for that type.
+ *
+ *		TYP7S(X) returns TYP7, but masking out the option bit S.
+ *		TYP7D(X) returns TYP7, but masking out the option bit D.
+ *		TYP7SD(X) masks out both option bits.
+ *
+ *		for example:
+ *						      D S
+ *			scm_tc7_string    	= Gxxx0101
+ *			scm_tc7_mb_string 	= Gxxx0111
+ *			scm_tc7_substring	= Gxxx1101
+ *			scm_tc7_mb_substring	= Gxxx1111
+ *
+ *		TYP7S turns tc7_mb_string into tc7_string and 
+ *		tc7_mb_substring into tc7_substring.
+ *
+ *		TYP7D turns tc7_mb_substring into tc7_mb_string and 
+ *		tc7_substring into tc7_string.
+ *
+ *		TYP7DS turns all string tags into tc7_string.
+ *
+ *		Some TC7 types are subdivided into 256 subtypes giving
+ *		rise to the macros:
+ *
+ *		TYP16
+ *		TYP16S
+ *		GCTYP16
+ *
+ *		TYP16S functions similarly wrt to TYP16 as TYP7S to TYP7,
+ *		but a different option bit is used (bit 2 for TYP7S,
+ *		bit 8 for TYP16S).
+ *
+ */
+
+
+
+
+/* {Non-immediate values.}
+ *
+ * If X is non-immediate, it is necessary to look at SCM_CAR (X) to
+ * figure out Xs type.   X may be a cons pair, in which case the
+ * value SCM_CAR (x) will be either an immediate or non-immediate value.
+ * X may be something other than a cons pair, in which case the value SCM_CAR (x)
+ * will be a non-object value.  
+ *
+ * All immediates and non-immediates have a 0 in bit 0.  We additionally preserve
+ * the invariant that all non-object values stored in the SCM_CAR of a non-immediate
+ * object have a 1 in bit 1:
+ */
+
+#define SCM_NCONSP(x) (1 & (int)SCM_CAR(x))
+#define SCM_CONSP(x) (!SCM_NCONSP(x))
+
+
+/* ECONSP is historical and, in fact, slightly buggy.
+ * There are two places to fix where structures and glocs can be confused.
+ * !!!
+ */
+#define SCM_ECONSP(x) (SCM_CONSP(x) || (1==SCM_TYP3(x)))
+#define SCM_NECONSP(x) (SCM_NCONSP(x) && (1 != SCM_TYP3(x)))
+
+
+
+#define SCM_CELLP(x) 	(!SCM_NCELLP(x))
+#define SCM_NCELLP(x) 	((sizeof(scm_cell)-1) & (int)(x))
+
+/* See numbers.h for macros relating to immediate integers. 
+ */
+
+#define SCM_ITAG3(x) 		(7 & (int)x)
+#define SCM_TYP3(x) 		(7 & (int)SCM_CAR(x))
+#define scm_tc3_cons		0
+#define scm_tc3_cons_gloc	1
+#define scm_tc3_int_1		2
+#define scm_tc3_closure		3
+#define scm_tc3_imm24		4
+#define scm_tc3_tc7_1		5
+#define scm_tc3_int_2		6
+#define scm_tc3_tc7_2		7
+
+
+/*
+ * Do not change the three bit tags.
+ */
+
+
+#define SCM_TYP7(x) 		(0x7f & (int)SCM_CAR(x))
+#define SCM_TYP7S(x) 		(0x7d & (int)SCM_CAR(x))
+#define SCM_TYP7SD(x) 		(0x75 & (int)SCM_CAR(x))
+#define SCM_TYP7D(x) 		(0x77 & (int)SCM_CAR(x))
+
+
+#define SCM_TYP16(x) 		(0xffff & (int)SCM_CAR(x))
+#define SCM_TYP16S(x) 		(0xfeff & (int)SCM_CAR(x))
+#define SCM_GCTYP16(x) 		(0xff7f & (int)SCM_CAR(x))
+
+
+
+/* Testing and Changing GC Marks in Various Standard Positions
+ */
+#define SCM_GCMARKP(x) 		(1 & (int)SCM_CDR(x))
+#define SCM_GC8MARKP(x) 	(0x80 & (int)SCM_CAR(x))
+#define SCM_SETGCMARK(x) 	(SCM_CDR(x) |= 1)
+#define SCM_CLRGCMARK(x) 	(SCM_CDR(x) &= ~1L)
+#define SCM_SETGC8MARK(x) 	(SCM_CAR(x) |= 0x80)
+#define SCM_CLRGC8MARK(x) 	(SCM_CAR(x) &= ~0x80L)
+
+
+
+
+/* couple */
+#define scm_tc7_ssymbol		5
+#define scm_tc7_msymbol		7
+
+/* couple */
+#define scm_tc7_vector		13
+#define scm_tc7_wvect		15
+
+/* a quad, two couples, two trists */
+#define scm_tc7_string		21
+#define scm_tc7_mb_string	23
+#define scm_tc7_substring	29
+#define scm_tc7_mb_substring	31
+
+/* Many of the following should be turned
+ * into structs or smobs.  We need back some
+ * of these 7 bit tags!
+ */
+#define scm_tc7_uvect		37
+#define scm_tc7_lvector		39
+#define scm_tc7_fvect		45
+#define scm_tc7_dvect		47
+#define scm_tc7_cvect		53
+#define scm_tc7_svect		55
+#define scm_tc7_contin		61
+#define scm_tc7_cclo		63
+#define scm_tc7_rpsubr		69
+#define scm_tc7_bvect		71
+#define scm_tc7_byvect		77
+#define scm_tc7_ivect		79
+#define scm_tc7_subr_0		85
+#define scm_tc7_subr_1		87
+#define scm_tc7_cxr		93
+#define scm_tc7_subr_3		95
+#define scm_tc7_subr_2		101
+#define scm_tc7_asubr		103
+#define scm_tc7_subr_1o		109
+#define scm_tc7_subr_2o		111
+#define scm_tc7_lsubr_2		117
+#define scm_tc7_lsubr		119
+
+
+/* There are 256 port subtypes.  Here are the first four.
+ * These must agree with the init function in ports.c
+ */
+#define scm_tc7_port		125
+
+/* fports and pipes form an intended TYP16S equivelancy
+ * group (similar to a tc7 "couple".
+ */
+#define scm_tc16_fport 		(scm_tc7_port + 0*256L)
+#define scm_tc16_pipe 		(scm_tc7_port + 1*256L)
+
+#define scm_tc16_strport	(scm_tc7_port + 2*256L)
+#define scm_tc16_sfport 	(scm_tc7_port + 3*256L)
+
+
+/* There are 256 smob subtypes.  Here are the first four.
+ */
+
+#define scm_tc7_smob		127 /* DO NOT CHANGE [**] */
+
+/* [**] If you change scm_tc7_smob, you must also change
+ * the places it is hard coded in this file and possibly others.
+ */
+
+
+/* scm_tc_free_cell is also the 0th smob type.
+ */
+#define scm_tc_free_cell	127
+
+/* The 1st smob type:
+ */
+#define scm_tc16_flo		0x017f
+#define scm_tc_flo		0x017fL
+
+/* Some option bits begeinning at bit 16 of scm_tc16_flo:
+ */
+#define SCM_REAL_PART		(1L<<16)
+#define SCM_IMAG_PART		(2L<<16)
+#define scm_tc_dblr		(scm_tc16_flo|SCM_REAL_PART)
+#define scm_tc_dblc		(scm_tc16_flo|SCM_REAL_PART|SCM_IMAG_PART)
+
+
+/* Smob types 2 and 3: 
+ */
+#define scm_tc16_bigpos		0x027f
+#define scm_tc16_bigneg		0x037f
+
+
+
+/* {Immediate Values} 
+ */
+
+enum scm_tags
+{
+  scm_tc8_char = 0xf4,
+  scm_tc8_iloc = 0xfc,
+};
+
+#define SCM_ITAG8(X)		((int)(X) & 0xff)
+#define SCM_MAKE_ITAG8(X, TAG)	(((X)<<8) + TAG)
+#define SCM_ITAG8_DATA(X)	((X)>>8)
+
+
+
+/* Immediate Symbols, Special Symbols, Flags (various constants).
+ */
+
+/* SCM_ISYMP tests for ISPCSYM and ISYM */
+#define SCM_ISYMP(n) 		((0x187 & (int)(n))==4)
+
+/* SCM_IFLAGP tests for ISPCSYM, ISYM and IFLAG */
+#define SCM_IFLAGP(n) 		((0x87 & (int)(n))==4)
+#define SCM_ISYMNUM(n) 		((int)((n)>>9))
+#define SCM_ISYMSCM_CHARS(n) 	(scm_isymnames[SCM_ISYMNUM(n)])
+#define SCM_MAKSPCSYM(n) 	(((n)<<9)+((n)<<3)+4L)
+#define SCM_MAKISYM(n) 		(((n)<<9)+0x74L)
+#define SCM_MAKIFLAG(n) 	(((n)<<9)+0x174L)
+
+/* This table must agree with the declarations 
+ * in repl.c: {Names of immediate symbols}.
+ *
+ * These are used only in eval but their values
+ * have to be allocated here.
+ *
+ */
+
+#define SCM_IM_AND		SCM_MAKSPCSYM(0)
+#define SCM_IM_BEGIN		SCM_MAKSPCSYM(1)
+#define SCM_IM_CASE		SCM_MAKSPCSYM(2)
+#define SCM_IM_COND		SCM_MAKSPCSYM(3)
+#define SCM_IM_DO		SCM_MAKSPCSYM(4)
+#define SCM_IM_IF		SCM_MAKSPCSYM(5)
+#define SCM_IM_LAMBDA		SCM_MAKSPCSYM(6)
+#define SCM_IM_LET		SCM_MAKSPCSYM(7)
+#define SCM_IM_LETSTAR		SCM_MAKSPCSYM(8)
+#define SCM_IM_LETREC		SCM_MAKSPCSYM(9)
+#define SCM_IM_OR		SCM_MAKSPCSYM(10)
+#define SCM_IM_QUOTE		SCM_MAKSPCSYM(11)
+#define SCM_IM_SET		SCM_MAKSPCSYM(12)
+#define SCM_IM_DEFINE		SCM_MAKSPCSYM(13)
+#define SCM_IM_APPLY		SCM_MAKISYM(14)
+#define SCM_IM_CONT		SCM_MAKISYM(15)
+#define SCM_BOOL_F		SCM_MAKIFLAG(16)
+#define SCM_BOOL_T 		SCM_MAKIFLAG(17)
+#define SCM_UNDEFINED	 	SCM_MAKIFLAG(18)
+#define SCM_EOF_VAL 		SCM_MAKIFLAG(19)
+#define SCM_UNUSED_NIL_VALUE	SCM_MAKIFLAG(20)
+#define SCM_UNSPECIFIED		SCM_MAKIFLAG(21)
+
+
+#define SCM_UNBNDP(x) 	(SCM_UNDEFINED==(x))
+
+
+
+/* Dispatching aids:
+ */
+
+
+/* For cons pairs with immediate values in the CAR 
+ */
+
+#define scm_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
+
+/* For cons pairs with non-immediate values in the SCM_CAR
+ */
+#define scm_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
+
+/* A CONS_GLOC occurs in code.  It's CAR is a pointer to the
+ * CDR of a variable.  The low order bits of the CAR are 001.
+ * The CDR of the gloc is the code continuation.
+ */
+#define scm_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 scm_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 scm_tcs_subrs scm_tc7_asubr:case scm_tc7_subr_0:case scm_tc7_subr_1:case scm_tc7_cxr:\
+ case scm_tc7_subr_3:case scm_tc7_subr_2:case scm_tc7_rpsubr:case scm_tc7_subr_1o:\
+ case scm_tc7_subr_2o:case scm_tc7_lsubr_2:case scm_tc7_lsubr
+
+#define scm_tcs_symbols scm_tc7_ssymbol:case scm_tc7_msymbol
+
+#define scm_tcs_bignums scm_tc16_bigpos:case scm_tc16_bigneg
+
+
+#ifdef __STDC__
+
+#else /* STDC */
+
+#endif /* STDC */
+
+
+#endif  /* TAGSH */
diff --git a/libguile/throw.c b/libguile/throw.c
new file mode 100644
index 000000000..a84d7e92e
--- /dev/null
+++ b/libguile/throw.c
@@ -0,0 +1,291 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+
+
+/* {Catch and Throw} 
+ */
+static int scm_tc16_jmpbuffer;
+
+SCM scm_bad_throw_vcell;
+
+#define SCM_JMPBUFP(O) (SCM_TYP16(O) == scm_tc16_jmpbuffer)
+#define JBACTIVE(O) (SCM_CAR (O) & (1L << 16L))
+#define ACTIVATEJB(O)  (SCM_CAR (O) |= (1L << 16L))
+#define DEACTIVATEJB(O)  (SCM_CAR (O) &= ~(1L << 16L))
+
+#ifdef DEBUG_EXTENSIONS
+#define JBSCM_DFRAME(O) ((debug_frame*)SCM_CAR (SCM_CDR (O)) )
+#define JBJMPBUF(O) ((jmp_buf*)SCM_CDR (SCM_CDR (O)) )
+#define SETJBSCM_DFRAME(O,X) SCM_CAR(SCM_CDR (O)) = (SCM)(X)
+#define SETJBJMPBUF(O,X) SCM_SETCDR(SCM_CDR (O), X)
+#else
+#define JBJMPBUF(O) ((jmp_buf*)SCM_CDR (O) )
+#define SETJBJMPBUF SCM_SETCDR
+#endif
+
+#ifdef __STDC__
+static int
+printjb (SCM exp, SCM port, int writing)
+#else
+static int
+printjb (exp, port, writing)
+     SCM exp;
+     SCM port;
+     int writing;
+#endif
+{
+  scm_gen_puts (scm_regular_string, "#<jmpbuffer ", port);
+  scm_gen_puts (scm_regular_string, JBACTIVE(exp) ? "(active) " : "(inactive) ", port);
+  scm_intprint((SCM) JBJMPBUF(exp), 16, port);
+  scm_gen_putc ('>', port);
+  return 1 ;
+}
+
+/* !!! The mark function needs to be different for
+ * debugging support.		A. Green
+ */
+static scm_smobfuns jbsmob = {scm_mark0, scm_free0, printjb, 0};
+
+#ifdef __STDC__
+static SCM
+make_jmpbuf (void)
+#else
+static SCM
+make_jmpbuf ()
+#endif
+{
+  SCM answer;
+  SCM_NEWCELL (answer);
+#ifdef DEBUG_EXTENSIONS
+  SCM_NEWCELL (SCM_CDR (answer));
+#endif
+  SCM_DEFER_INTS;
+  {
+    SCM_CAR(answer) = scm_tc16_jmpbuffer;
+    SETJBJMPBUF(answer, (jmp_buf *)0);
+    DEACTIVATEJB(answer);
+  }
+  SCM_ALLOW_INTS;
+  return answer;
+}
+
+
+struct jmp_buf_and_retval	/* use only on the stack, in scm_catch */
+{
+  jmp_buf buf;			/* must be first */
+  SCM throw_tag;
+  SCM retval;
+};
+
+SCM_PROC(s_catch, "catch", 3, 0, 0, scm_catch);
+#ifdef __STDC__
+SCM
+scm_catch (SCM tag, SCM thunk, SCM handler)
+#else
+SCM
+scm_catch (tag, thunk, handler)
+     SCM tag;
+     SCM thunk;
+     SCM handler;
+#endif
+{
+  struct jmp_buf_and_retval jbr;
+  SCM jmpbuf;
+  SCM answer;
+
+  SCM_ASSERT ((tag == SCM_BOOL_F) || (SCM_NIMP(tag) && SCM_SYMBOLP(tag)) || (tag == SCM_BOOL_T),
+	  tag, SCM_ARG1, s_catch);
+  jmpbuf = make_jmpbuf ();
+  answer = SCM_EOL;
+  scm_dynwinds = scm_acons (tag, jmpbuf, scm_dynwinds);
+  SETJBJMPBUF(jmpbuf, &jbr.buf);
+#ifdef DEBUG_EXTENSIONS
+  SETJBSCM_DFRAME(jmpbuf, last_debug_info_frame);
+#endif
+  if (setjmp (jbr.buf))
+    {
+      SCM throw_tag;
+      SCM throw_args;
+
+      SCM_DEFER_INTS;
+      DEACTIVATEJB (jmpbuf);
+      scm_dynwinds = SCM_CDR (scm_dynwinds);
+      SCM_ALLOW_INTS;
+      throw_args = jbr.retval;
+      throw_tag = jbr.throw_tag;
+      jbr.throw_tag = SCM_EOL;
+      jbr.retval = SCM_EOL;
+      answer = scm_apply (handler, scm_cons (throw_tag, throw_args), SCM_EOL);
+    }
+  else
+    {
+      ACTIVATEJB (jmpbuf);
+      answer = scm_apply (thunk,
+			  ((tag == SCM_BOOL_F) ? scm_cons (jmpbuf, SCM_EOL) : SCM_EOL),
+			  SCM_EOL);
+      SCM_DEFER_INTS;
+      DEACTIVATEJB (jmpbuf);
+      scm_dynwinds = SCM_CDR (scm_dynwinds);
+      SCM_ALLOW_INTS;
+    }
+  return answer;
+}
+
+
+static char s_throw[];
+#ifdef __STDC__
+SCM
+scm_ithrow (SCM key, SCM args, int noreturn)
+#else
+SCM
+scm_ithrow (key, args, noreturn)
+     SCM key;
+     SCM args;
+     int noreturn;
+#endif
+{
+  SCM jmpbuf;
+  SCM wind_goal;
+
+  if (SCM_NIMP (key) && SCM_JMPBUFP (key))
+    {
+      jmpbuf = key;
+      if (noreturn)
+	{
+	  SCM_ASSERT (JBACTIVE (jmpbuf), jmpbuf,
+		  "throw to dynamically inactive catch",
+		  s_throw);
+	}
+      else if (!JBACTIVE (jmpbuf))
+	return SCM_UNSPECIFIED;
+    }
+  else
+    {
+      SCM dynpair;
+      SCM hook;
+
+      if (noreturn)
+	{
+	  SCM_ASSERT (SCM_NIMP (key) && SCM_SYMBOLP (key), key, SCM_ARG1, s_throw);
+	}
+      else if (!(SCM_NIMP (key) && SCM_SYMBOLP (key)))
+	return SCM_UNSPECIFIED;
+
+      dynpair = scm_sloppy_assq (key, scm_dynwinds);
+
+      if (dynpair == SCM_BOOL_F)
+	dynpair = scm_sloppy_assq (SCM_BOOL_T, scm_dynwinds);
+
+      hook = SCM_CDR (scm_bad_throw_vcell);
+      if ((dynpair == SCM_BOOL_F)
+	  && (SCM_BOOL_T == scm_procedure_p (hook)))
+	{
+	  SCM answer;
+	  answer = scm_apply (hook, scm_cons (key, args), SCM_EOL);
+	}
+      
+      if (dynpair != SCM_BOOL_F)
+	jmpbuf = SCM_CDR (dynpair);
+      else
+	{
+	  if (!noreturn)
+	    return SCM_UNSPECIFIED;
+	  else
+	    {
+	      scm_exitval = scm_cons (key, args);
+	      scm_dowinds (SCM_EOL, scm_ilength (scm_dynwinds));
+	      longjmp (SCM_JMPBUF (scm_rootcont), 1);
+	    }
+	}
+    }
+#ifdef DEBUG_EXTENSIONS
+  last_debug_info_frame = JBSCM_DFRAME (jmpbuf);
+#endif
+  for (wind_goal = scm_dynwinds;
+       SCM_CDAR (wind_goal) != jmpbuf;
+       wind_goal = SCM_CDR (wind_goal))
+    ;
+  {
+    struct jmp_buf_and_retval * jbr;
+    jbr = (struct jmp_buf_and_retval *)JBJMPBUF (jmpbuf);
+    jbr->throw_tag = key;
+    jbr->retval = args;
+  }
+  scm_dowinds (wind_goal, scm_ilength (scm_dynwinds) - scm_ilength (wind_goal));
+  longjmp (*JBJMPBUF (jmpbuf), 1);
+}
+
+
+SCM_PROC(s_throw, "throw", 1, 0, 1, scm_throw);
+#ifdef __STDC__
+SCM
+scm_throw (SCM key, SCM args)
+#else
+SCM
+scm_throw (key, args)
+     SCM key;
+     SCM args;
+#endif
+{
+  scm_ithrow (key, args, 1);
+  return SCM_BOOL_F;  /* never really returns */
+}
+
+
+#ifdef __STDC__
+void
+scm_init_throw (void)
+#else
+void
+scm_init_throw ()
+#endif
+{
+  scm_tc16_jmpbuffer = scm_newsmob (&jbsmob);
+  scm_bad_throw_vcell = scm_sysintern ("%%bad-throw", SCM_BOOL_F);
+#include "throw.x"
+}
+
diff --git a/libguile/throw.h b/libguile/throw.h
new file mode 100644
index 000000000..f6aca5b24
--- /dev/null
+++ b/libguile/throw.h
@@ -0,0 +1,67 @@
+/* classes: h_files */
+
+#ifndef THROWH
+#define THROWH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+
+
+
+
+#ifdef __STDC__
+extern SCM scm_catch (SCM tag, SCM thunk, SCM handler);
+extern SCM scm_ithrow (SCM key, SCM args, int noreturn);
+extern SCM scm_throw (SCM key, SCM args);
+extern void scm_init_throw (void);
+
+#else /* STDC */
+extern SCM scm_catch ();
+extern SCM scm_ithrow ();
+extern SCM scm_throw ();
+extern void scm_init_throw ();
+
+#endif /* STDC */
+
+
+#endif  /* THROWH */
diff --git a/libguile/unif.c b/libguile/unif.c
new file mode 100644
index 000000000..ed0e17c5c
--- /dev/null
+++ b/libguile/unif.c
@@ -0,0 +1,2687 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+/* The set of uniform scm_vector types is:
+ *  Vector of:		 Called:
+ * unsigned char	string
+ * char			byvect
+ * boolean		bvect
+ * signed int		ivect
+ * unsigned int		uvect
+ * float		fvect
+ * double		dvect
+ * complex double	cvect
+ * short		svect
+ * long_long		llvect
+ */
+
+long scm_tc16_array;
+
+/* 
+ * This complicates things too much if allowed on any array.
+ * C code can safely call it on arrays known to be used in a single
+ * threaded manner.
+ *
+ * SCM_PROC(s_vector_set_length_x, "vector-set-length!", 2, 0, 0, scm_vector_set_length_x); 
+ */
+static char s_vector_set_length_x[] = "vector-set-length!";
+
+#ifdef __STDC__
+SCM 
+scm_vector_set_length_x (SCM vect, SCM len)
+#else
+SCM 
+scm_vector_set_length_x (vect, len)
+     SCM vect;
+     SCM len;
+#endif
+{
+  long l;
+  scm_sizet siz;
+  scm_sizet sz;
+
+  l = SCM_INUM (len);
+  SCM_ASRTGO (SCM_NIMP (vect), badarg1);
+  switch (SCM_TYP7 (vect))
+    {
+    default:
+    badarg1: scm_wta (vect, (char *) SCM_ARG1, s_vector_set_length_x);
+    case scm_tc7_string:
+    case scm_tc7_mb_string:
+      SCM_ASRTGO (vect != scm_nullstr, badarg1);
+      sz = sizeof (char);
+      l++;
+      break;
+    case scm_tc7_vector:
+      SCM_ASRTGO (vect != scm_nullvect, badarg1);
+      sz = sizeof (SCM);
+      break;
+#ifdef ARRAYS
+    case scm_tc7_bvect:
+      l = (l + SCM_LONG_BIT - 1) / SCM_LONG_BIT;
+    case scm_tc7_uvect:
+    case scm_tc7_ivect:
+      sz = sizeof (long);
+      break;
+    case scm_tc7_byvect:
+      sz = sizeof (char);
+      break;
+
+    case scm_tc7_svect:
+      sz = sizeof (short);
+      break;
+#ifdef LONGLONGS
+    case scm_tc7_llvect:
+      sz = sizeof (long_long);
+      break;
+#endif 
+
+#ifdef SCM_FLOATS
+#ifdef SCM_SINGLES
+    case scm_tc7_fvect:
+      sz = sizeof (float);
+      break;
+#endif
+    case scm_tc7_dvect:
+      sz = sizeof (double);
+      break;
+    case scm_tc7_cvect:
+      sz = 2 * sizeof (double);
+      break;
+#endif
+#endif
+    }
+  SCM_ASSERT (SCM_INUMP (len), len, SCM_ARG2, s_vector_set_length_x);
+  if (!l)
+    l = 1L;
+  siz = l * sz;
+  if (siz != l * sz)
+    scm_wta (SCM_MAKINUM (l * sz), (char *) SCM_NALLOC, s_vector_set_length_x);
+  SCM_REDEFER_INTS;
+  SCM_SETCHARS (vect,
+	    ((char *)
+	     scm_must_realloc (SCM_CHARS (vect),
+			       (long) SCM_LENGTH (vect) * sz,
+			       (long) siz,
+			       s_vector_set_length_x)));
+  if (SCM_VECTORP (vect))
+    {
+      sz = SCM_LENGTH (vect);
+      while (l > sz)
+	SCM_VELTS (vect)[--l] = SCM_UNSPECIFIED;
+    }
+  else if (SCM_STRINGP (vect))
+    SCM_CHARS (vect)[l - 1] = 0;
+  SCM_SETLENGTH (vect, SCM_INUM (len), SCM_TYP7 (vect));
+  SCM_REALLOW_INTS;
+  return vect;
+}
+
+
+#ifdef ARRAYS
+
+#ifdef SCM_FLOATS
+#ifdef SCM_SINGLES
+
+#ifdef __STDC__
+SCM 
+scm_makflo (float x)
+#else
+SCM 
+scm_makflo (x)
+     float x;
+#endif
+{
+  SCM z;
+  if (x == 0.0)
+    return scm_flo0;
+  SCM_NEWCELL (z);
+  SCM_DEFER_INTS;
+  SCM_CAR (z) = scm_tc_flo;
+  SCM_FLO (z) = x;
+  SCM_ALLOW_INTS;
+  return z;
+}
+#endif
+#endif
+
+#ifdef __STDC__
+SCM 
+scm_make_uve (long k, SCM prot)
+#else
+SCM 
+scm_make_uve (k, prot)
+     long k;
+     SCM prot;
+#endif
+{
+  SCM v;
+  long i, type;
+  if (SCM_BOOL_T == prot)
+    {
+      i = sizeof (long) * ((k + SCM_LONG_BIT - 1) / SCM_LONG_BIT);
+      type = scm_tc7_bvect;
+    }
+  else if (SCM_ICHRP (prot) && (prot == SCM_MAKICHR ('\0')))
+    {
+      i = sizeof (char) * k;
+      type = scm_tc7_byvect;
+    }    
+  else if (SCM_ICHRP (prot))
+    {
+      i = sizeof (char) * k;
+      type = scm_tc7_string;
+    }
+  else if (SCM_INUMP (prot))
+    {
+      i = sizeof (long) * k;
+      if (SCM_INUM (prot) > 0)
+	type = scm_tc7_uvect;
+      else
+	type = scm_tc7_ivect;
+    }
+  else if (SCM_NIMP (prot) && SCM_SYMBOLP (prot) && (1 == SCM_LENGTH (prot)))
+    {
+      char s;
+
+      s = SCM_CHARS (prot)[0];
+      if (s == 's')
+	{
+	  i = sizeof (short) * k;
+	  type = scm_tc7_svect;
+	}
+#ifdef LONGLONGS
+      else if (s == 'l')
+	{
+	  i = sizeof (long_long) * k;
+	  type = scm_tc7_llvect;
+	}
+#endif
+      else
+	{
+	  return scm_make_vector (SCM_MAKINUM (k), SCM_UNDEFINED, SCM_UNDEFINED);
+	}
+    }
+  else
+#ifdef SCM_FLOATS
+  if (SCM_IMP (prot) || !SCM_INEXP (prot))
+#endif
+    /* Huge non-unif vectors are NOT supported. */
+    return scm_make_vector (SCM_MAKINUM (k), SCM_UNDEFINED, SCM_UNDEFINED);	/* no special scm_vector */
+#ifdef SCM_FLOATS
+#ifdef SCM_SINGLES
+  else if (SCM_SINGP (prot))
+
+    {
+      i = sizeof (float) * k;
+      type = scm_tc7_fvect;
+    }
+#endif
+  else if (SCM_CPLXP (prot))
+    {
+      i = 2 * sizeof (double) * k;
+      type = scm_tc7_cvect;
+    }
+  else
+    {
+      i = sizeof (double) * k;
+      type = scm_tc7_dvect;
+    }
+#endif
+
+  SCM_NEWCELL (v);
+  SCM_DEFER_INTS;
+  {
+    char *m;
+    m = scm_must_malloc ((i ? i : 1L), "vector");
+    SCM_SETCHARS (v, (char *) m);
+  }
+  SCM_SETLENGTH (v, (k < SCM_LENGTH_MAX ? k : SCM_LENGTH_MAX), type);
+  SCM_ALLOW_INTS;
+  return v;
+}
+
+SCM_PROC(s_uniform_vector_length, "uniform-vector-length", 1, 0, 0, scm_uniform_vector_length);
+#ifdef __STDC__
+SCM 
+scm_uniform_vector_length (SCM v)
+#else
+SCM 
+scm_uniform_vector_length (v)
+     SCM v;
+#endif
+{
+  SCM_ASRTGO (SCM_NIMP (v), badarg1);
+  switch SCM_TYP7
+    (v)
+    {
+    default:
+    badarg1:scm_wta (v, (char *) SCM_ARG1, s_uniform_vector_length);
+    case scm_tc7_bvect:
+    case scm_tc7_string:
+    case scm_tc7_byvect:
+    case scm_tc7_uvect:
+    case scm_tc7_ivect:
+    case scm_tc7_fvect:
+    case scm_tc7_dvect:
+    case scm_tc7_cvect:
+    case scm_tc7_vector:
+    case scm_tc7_svect:
+#ifdef LONGLONGS
+    case scm_tc7_llvect:
+#endif
+      return SCM_MAKINUM (SCM_LENGTH (v));
+    }
+}
+
+SCM_PROC(s_array_p, "array?", 1, 1, 0, scm_array_p);
+#ifdef __STDC__
+SCM 
+scm_array_p (SCM v, SCM prot)
+#else
+SCM 
+scm_array_p (v, prot)
+     SCM v;
+     SCM prot;
+#endif
+{
+  int nprot;
+  int enclosed;
+  nprot = SCM_UNBNDP (prot);
+  enclosed = 0;
+  if (SCM_IMP (v))
+    return SCM_BOOL_F;
+loop:
+  switch (SCM_TYP7 (v))
+    {
+    case scm_tc7_smob:
+      if (!SCM_ARRAYP (v))
+	return SCM_BOOL_F;
+      if (nprot)
+	return SCM_BOOL_T;
+      if (enclosed++)
+	return SCM_BOOL_F;
+      v = SCM_ARRAY_V (v);
+      goto loop;
+    case scm_tc7_bvect:
+      return nprot || SCM_BOOL_T==prot ? SCM_BOOL_T : SCM_BOOL_F;
+    case scm_tc7_string:
+      return nprot || (SCM_ICHRP(prot) && (prot != SCM_MAKICHR('\0'))) ? SCM_BOOL_T : SCM_BOOL_F;
+    case scm_tc7_byvect:
+      return nprot || (prot == SCM_MAKICHR('\0')) ? SCM_BOOL_T : SCM_BOOL_F;
+    case scm_tc7_uvect:
+      return nprot || (SCM_INUMP(prot) && SCM_INUM(prot)>0) ? SCM_BOOL_T : SCM_BOOL_F;
+    case scm_tc7_ivect:
+      return nprot || (SCM_INUMP(prot) && SCM_INUM(prot)<=0) ? SCM_BOOL_T : SCM_BOOL_F;
+    case scm_tc7_svect:
+      return (   nprot
+	      || (SCM_NIMP (prot)
+		  && SCM_SYMBOLP (prot)
+		  && (1 == SCM_LENGTH (prot))
+		  && ('s' == SCM_CHARS (prot)[0])));
+#ifdef LONGLONGS
+    case scm_tc7_llvect:
+      return (   nprot
+	      || (SCM_NIMP (prot)
+		  && SCM_SYMBOLP (prot)
+		  && (1 == SCM_LENGTH (prot))
+		  && ('s' == SCM_CHARS (prot)[0])));
+#endif
+# ifdef SCM_FLOATS
+#  ifdef SCM_SINGLES
+    case scm_tc7_fvect:
+      return nprot || (SCM_NIMP(prot) && SCM_SINGP(prot)) ? SCM_BOOL_T : SCM_BOOL_F;
+#  endif
+    case scm_tc7_dvect:
+      return nprot || (SCM_NIMP(prot) && SCM_REALP(prot)) ? SCM_BOOL_T : SCM_BOOL_F;
+    case scm_tc7_cvect:
+      return nprot || (SCM_NIMP(prot) && SCM_CPLXP(prot)) ? SCM_BOOL_T : SCM_BOOL_F;
+# endif
+    case scm_tc7_vector:
+      return nprot || SCM_NULLP(prot) ? SCM_BOOL_T : SCM_BOOL_F;
+    default:;
+    }
+  return SCM_BOOL_F;
+}
+
+
+SCM_PROC(s_array_rank, "array-rank", 1, 0, 0, scm_array_rank);
+#ifdef __STDC__
+SCM 
+scm_array_rank (SCM ra)
+#else
+SCM 
+scm_array_rank (ra)
+     SCM ra;
+#endif
+{
+  if (SCM_IMP (ra))
+ return SCM_INUM0;
+  switch (SCM_TYP7 (ra))
+    {
+    default:
+      return SCM_INUM0;
+    case scm_tc7_string:
+    case scm_tc7_vector:
+    case scm_tc7_byvect:
+    case scm_tc7_uvect:
+    case scm_tc7_ivect:
+    case scm_tc7_fvect:
+    case scm_tc7_cvect:
+    case scm_tc7_dvect:
+#ifdef LONGLONGS
+    case scm_tc7_llvect:
+#endif
+    case scm_tc7_svect:
+      return SCM_MAKINUM (1L);
+    case scm_tc7_smob:
+      if (SCM_ARRAYP (ra))
+	return SCM_MAKINUM (SCM_ARRAY_NDIM (ra));
+      return SCM_INUM0;
+    }
+}
+
+
+SCM_PROC(s_array_dimensions, "array-dimensions", 1, 0, 0, scm_array_dimensions);
+#ifdef __STDC__
+SCM 
+scm_array_dimensions (SCM ra)
+#else
+SCM 
+scm_array_dimensions (ra)
+     SCM ra;
+#endif
+{
+  SCM res = SCM_EOL;
+  scm_sizet k;
+  scm_array_dim *s;
+  if (SCM_IMP (ra))
+ return SCM_BOOL_F;
+  switch (SCM_TYP7 (ra))
+    {
+    default:
+      return SCM_BOOL_F;
+    case scm_tc7_string:
+    case scm_tc7_vector:
+    case scm_tc7_bvect:
+    case scm_tc7_byvect:
+    case scm_tc7_uvect:
+    case scm_tc7_ivect:
+    case scm_tc7_fvect:
+    case scm_tc7_cvect:
+    case scm_tc7_dvect:
+    case scm_tc7_svect:
+#ifdef LONGLONGS
+    case scm_tc7_llvect:
+#endif
+      return scm_cons (SCM_MAKINUM (SCM_LENGTH (ra)), SCM_EOL);
+    case scm_tc7_smob:
+      if (!SCM_ARRAYP (ra))
+	return SCM_BOOL_F;
+      k = SCM_ARRAY_NDIM (ra);
+      s = SCM_ARRAY_DIMS (ra);
+      while (k--)
+	res = scm_cons (s[k].lbnd ? scm_cons2 (SCM_MAKINUM (s[k].lbnd), SCM_MAKINUM (s[k].ubnd), SCM_EOL) :
+			SCM_MAKINUM (1 + (s[k].ubnd))
+			, res);
+      return res;
+    }
+}
+
+
+static char s_bad_ind[] = "Bad scm_array index";
+
+#ifdef __STDC__
+long 
+scm_aind (SCM ra, SCM args, char *what)
+#else
+long 
+scm_aind (ra, args, what)
+     SCM ra,
+     SCM args;
+     char *what;
+#endif
+{
+  SCM ind;
+  register long j;
+  register scm_sizet pos = SCM_ARRAY_BASE (ra);
+  register scm_sizet k = SCM_ARRAY_NDIM (ra);
+  scm_array_dim *s = SCM_ARRAY_DIMS (ra);
+  if (SCM_INUMP (args))
+
+    {
+      SCM_ASSERT (1 == k, SCM_UNDEFINED, SCM_WNA, what);
+      return pos + (SCM_INUM (args) - s->lbnd) * (s->inc);
+    }
+  while (k && SCM_NIMP (args))
+    {
+      ind = SCM_CAR (args);
+      args = SCM_CDR (args);
+      SCM_ASSERT (SCM_INUMP (ind), ind, s_bad_ind, what);
+      j = SCM_INUM (ind);
+      SCM_ASSERT (j >= (s->lbnd) && j <= (s->ubnd), ind, SCM_OUTOFRANGE, what);
+      pos += (j - s->lbnd) * (s->inc);
+      k--;
+      s++;
+    }
+  SCM_ASSERT (0 == k && SCM_NULLP (args), SCM_UNDEFINED, SCM_WNA, what);
+  return pos;
+}
+
+
+#ifdef __STDC__
+SCM 
+scm_make_ra (int ndim)
+#else
+SCM 
+scm_make_ra (ndim)
+     int ndim;
+#endif
+{
+  SCM ra;
+  SCM_NEWCELL (ra);
+  SCM_DEFER_INTS;
+  SCM_SETCDR (ra, scm_must_malloc ((long) (sizeof (scm_array) + ndim * sizeof (scm_array_dim)),
+			       "array"));
+  SCM_CAR (ra) = ((long) ndim << 17) + scm_tc16_array;
+  SCM_ARRAY_V (ra) = scm_nullvect;
+  SCM_ALLOW_INTS;
+  return ra;
+}
+
+static char s_bad_spec[] = "Bad scm_array dimension";
+/* Increments will still need to be set. */
+
+#ifdef __STDC__
+SCM 
+scm_shap2ra (SCM args, char *what)
+#else
+SCM 
+scm_shap2ra (args, what)
+     SCM args;
+     char *what;
+#endif
+{
+  scm_array_dim *s;
+  SCM ra, spec, sp;
+  int ndim = scm_ilength (args);
+  SCM_ASSERT (0 <= ndim, args, s_bad_spec, what);
+  ra = scm_make_ra (ndim);
+  SCM_ARRAY_BASE (ra) = 0;
+  s = SCM_ARRAY_DIMS (ra);
+  for (; SCM_NIMP (args); s++, args = SCM_CDR (args))
+    {
+      spec = SCM_CAR (args);
+      if (SCM_IMP (spec))
+
+	{
+	  SCM_ASSERT (SCM_INUMP (spec) && SCM_INUM (spec) >= 0, spec, s_bad_spec, what);
+	  s->lbnd = 0;
+	  s->ubnd = SCM_INUM (spec) - 1;
+	  s->inc = 1;
+	}
+      else
+	{
+	  SCM_ASSERT (SCM_CONSP (spec) && SCM_INUMP (SCM_CAR (spec)), spec, s_bad_spec, what);
+	  s->lbnd = SCM_INUM (SCM_CAR (spec));
+	  sp = SCM_CDR (spec);
+	  SCM_ASSERT (SCM_INUMP (SCM_CAR (sp)) && SCM_NULLP (SCM_CDR (sp)),
+		  spec, s_bad_spec, what);
+	  s->ubnd = SCM_INUM (SCM_CAR (sp));
+	  s->inc = 1;
+	}
+    }
+  return ra;
+}
+
+SCM_PROC(s_dimensions_to_uniform_array, "dimensions->uniform-array", 2, 0, 1, scm_dimensions_to_uniform_array);
+#ifdef __STDC__
+SCM 
+scm_dimensions_to_uniform_array (SCM dims, SCM prot, SCM fill)
+#else
+SCM 
+scm_dimensions_to_uniform_array (dims, prot, fill)
+     SCM dims;
+     SCM prot;
+     SCM fill;
+#endif
+{
+  scm_sizet k, vlen = 1;
+  long rlen = 1;
+  scm_array_dim *s;
+  SCM ra;
+  if (SCM_INUMP (dims))
+      if (SCM_INUM (dims) < SCM_LENGTH_MAX)
+	{
+	  SCM answer;
+	  answer = scm_make_uve (SCM_INUM (dims), prot);
+	  if (SCM_NNULLP (fill))
+	    {
+	      SCM_ASSERT (1 == scm_ilength (fill), fill, SCM_WNA, s_dimensions_to_uniform_array);
+	      scm_array_fill_x (answer, SCM_CAR (fill));
+	    }
+	  else if (SCM_NIMP (prot) && SCM_SYMBOLP (prot))
+	    scm_array_fill_x (answer, SCM_MAKINUM (0));
+	  else
+	    scm_array_fill_x (answer, prot);
+	  return answer;
+	}
+    else
+      dims = scm_cons (dims, SCM_EOL);
+  SCM_ASSERT (SCM_NULLP (dims) || (SCM_NIMP (dims) && SCM_CONSP (dims)),
+	  dims, SCM_ARG1, s_dimensions_to_uniform_array);
+  ra = scm_shap2ra (dims, s_dimensions_to_uniform_array);
+  SCM_CAR (ra) |= SCM_ARRAY_CONTIGUOUS;
+  s = SCM_ARRAY_DIMS (ra);
+  k = SCM_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 < SCM_LENGTH_MAX)
+    SCM_ARRAY_V (ra) = scm_make_uve ((rlen > 0 ? rlen : 0L), prot);
+  else
+    {
+      scm_sizet bit;
+      switch (SCM_TYP7 (scm_make_uve (0L, prot)))
+	{
+	default:
+	  bit = SCM_LONG_BIT;
+	  break;
+	case scm_tc7_bvect:
+	  bit = 1;
+	  break;
+	case scm_tc7_string:
+	  bit = SCM_CHAR_BIT;
+	  break;
+	case scm_tc7_fvect:
+	  bit = sizeof (float) * SCM_CHAR_BIT / sizeof (char);
+	  break;
+	case scm_tc7_dvect:
+	  bit = sizeof (double) * SCM_CHAR_BIT / sizeof (char);
+	  break;
+	case scm_tc7_cvect:
+	  bit = 2 * sizeof (double) * SCM_CHAR_BIT / sizeof (char);
+	  break;
+	}
+      SCM_ARRAY_BASE (ra) = (SCM_LONG_BIT + bit - 1) / bit;
+      rlen += SCM_ARRAY_BASE (ra);
+      SCM_ARRAY_V (ra) = scm_make_uve (rlen, prot);
+      *((long *) SCM_VELTS (SCM_ARRAY_V (ra))) = rlen;
+    }
+  if (SCM_NNULLP (fill))
+    {
+      SCM_ASSERT (1 == scm_ilength (fill), fill, SCM_WNA, s_dimensions_to_uniform_array);
+      scm_array_fill_x (ra, SCM_CAR (fill));
+    }
+  else if (SCM_NIMP (prot) && SCM_SYMBOLP (prot))
+    scm_array_fill_x (ra, SCM_MAKINUM (0));
+  else
+    scm_array_fill_x (ra, prot);
+  if (1 == SCM_ARRAY_NDIM (ra) && 0 == SCM_ARRAY_BASE (ra))
+    if (s->ubnd < s->lbnd || (0 == s->lbnd && 1 == s->inc))
+      return SCM_ARRAY_V (ra);
+  return ra;
+}
+
+#ifdef __STDC__
+void 
+scm_ra_set_contp (SCM ra)
+#else
+void 
+scm_ra_set_contp (ra)
+     SCM ra;
+#endif
+{
+  scm_sizet k = SCM_ARRAY_NDIM (ra);
+  long inc;
+  if (k)
+    inc = SCM_ARRAY_DIMS (ra)[k - 1].inc;
+  while (k--)
+    {
+      if (inc != SCM_ARRAY_DIMS (ra)[k].inc)
+	{
+	  SCM_CAR (ra) &= ~SCM_ARRAY_CONTIGUOUS;
+	  return;
+	}
+      inc *= (SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd + 1);
+    }
+  SCM_CAR (ra) |= SCM_ARRAY_CONTIGUOUS;
+}
+
+
+SCM_PROC(s_make_shared_array, "make-shared-array", 2, 0, 1, scm_make_shared_array);
+#ifdef __STDC__
+SCM 
+scm_make_shared_array (SCM oldra, SCM mapfunc, SCM dims)
+#else
+SCM 
+scm_make_shared_array (oldra, mapfunc, dims)
+     SCM oldra;
+     SCM mapfunc;
+     SCM dims;
+#endif
+{
+  SCM ra;
+  SCM inds, indptr;
+  SCM imap;
+  scm_sizet i, k;
+  long old_min, new_min, old_max, new_max;
+  scm_array_dim *s;
+  SCM_ASSERT (SCM_BOOL_T == scm_procedure_p (mapfunc), mapfunc, SCM_ARG2, s_make_shared_array);
+  SCM_ASSERT (SCM_NIMP (oldra) && (SCM_BOOL_F != scm_array_p (oldra, SCM_UNDEFINED)), oldra, SCM_ARG1, s_make_shared_array);
+  ra = scm_shap2ra (dims, s_make_shared_array);
+  if (SCM_ARRAYP (oldra))
+    {
+      SCM_ARRAY_V (ra) = SCM_ARRAY_V (oldra);
+      old_min = old_max = SCM_ARRAY_BASE (oldra);
+      s = SCM_ARRAY_DIMS (oldra);
+      k = SCM_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
+    {
+      SCM_ARRAY_V (ra) = oldra;
+      old_min = 0;
+      old_max = (long) SCM_LENGTH (oldra) - 1;
+    }
+  inds = SCM_EOL;
+  s = SCM_ARRAY_DIMS (ra);
+  for (k = 0; k < SCM_ARRAY_NDIM (ra); k++)
+    {
+      inds = scm_cons (SCM_MAKINUM (s[k].lbnd), inds);
+      if (s[k].ubnd < s[k].lbnd)
+	{
+	  if (1 == SCM_ARRAY_NDIM (ra))
+	    ra = scm_make_uve (0L, scm_array_prototype (ra));
+	  else
+	    SCM_ARRAY_V (ra) = scm_make_uve (0L, scm_array_prototype (ra));
+	  return ra;
+	}
+    }
+  imap = scm_apply (mapfunc, scm_list_reverse (inds), SCM_EOL);
+  if (SCM_ARRAYP (oldra))
+      i = (scm_sizet) scm_aind (oldra, imap, s_make_shared_array);
+  else
+    {
+      if (SCM_NINUMP (imap))
+
+	{
+	  SCM_ASSERT (1 == scm_ilength (imap) && SCM_INUMP (SCM_CAR (imap)),
+		  imap, s_bad_ind, s_make_shared_array);
+	  imap = SCM_CAR (imap);
+	}
+      i = SCM_INUM (imap);
+    }
+  SCM_ARRAY_BASE (ra) = new_min = new_max = i;
+  indptr = inds;
+  k = SCM_ARRAY_NDIM (ra);
+  while (k--)
+    {
+      if (s[k].ubnd > s[k].lbnd)
+	{
+	  SCM_CAR (indptr) = SCM_MAKINUM (SCM_INUM (SCM_CAR (indptr)) + 1);
+	  imap = scm_apply (mapfunc, scm_reverse (inds), SCM_EOL);
+	  if (SCM_ARRAYP (oldra))
+
+	      s[k].inc = scm_aind (oldra, imap, s_make_shared_array) - i;
+	  else
+	    {
+	      if (SCM_NINUMP (imap))
+
+		{
+		  SCM_ASSERT (1 == scm_ilength (imap) && SCM_INUMP (SCM_CAR (imap)),
+			  imap, s_bad_ind, s_make_shared_array);
+		  imap = SCM_CAR (imap);
+		}
+	      s[k].inc = (long) SCM_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 = SCM_CDR (indptr);
+    }
+  SCM_ASSERT (old_min <= new_min && old_max >= new_max, SCM_UNDEFINED,
+	  "mapping out of range", s_make_shared_array);
+  if (1 == SCM_ARRAY_NDIM (ra) && 0 == SCM_ARRAY_BASE (ra))
+    {
+      if (1 == s->inc && 0 == s->lbnd
+	  && SCM_LENGTH (SCM_ARRAY_V (ra)) == 1 + s->ubnd)
+	return SCM_ARRAY_V (ra);
+      if (s->ubnd < s->lbnd)
+	return scm_make_uve (0L, scm_array_prototype (ra));
+    }
+  scm_ra_set_contp (ra);
+  return ra;
+}
+
+
+/* args are RA . DIMS */
+SCM_PROC(s_transpose_array, "transpose-array", 0, 0, 1, scm_transpose_array);
+#ifdef __STDC__
+SCM 
+scm_transpose_array (SCM args)
+#else
+SCM 
+scm_transpose_array (args)
+     SCM args;
+#endif
+{
+  SCM ra, res, vargs, *ve = &vargs;
+  scm_array_dim *s, *r;
+  int ndim, i, k;
+  SCM_ASSERT (SCM_NIMP (args), SCM_UNDEFINED, SCM_WNA, s_transpose_array);
+  ra = SCM_CAR (args);
+  args = SCM_CDR (args);
+  switch SCM_TYP7
+    (ra)
+    {
+    default:
+    badarg:scm_wta (ra, (char *) SCM_ARG1, s_transpose_array);
+    case scm_tc7_bvect:
+    case scm_tc7_string:
+    case scm_tc7_byvect:
+    case scm_tc7_uvect:
+    case scm_tc7_ivect:
+    case scm_tc7_fvect:
+    case scm_tc7_dvect:
+    case scm_tc7_cvect:
+    case scm_tc7_svect:
+#ifdef LONGLONGS
+    case scm_tc7_llvect:
+#endif
+      SCM_ASSERT (SCM_NIMP (args) && SCM_NULLP (SCM_CDR (args)), SCM_UNDEFINED, SCM_WNA, s_transpose_array);
+      SCM_ASSERT (SCM_INUM0 == SCM_CAR (args), SCM_CAR (args), SCM_ARG1, s_transpose_array);
+      return ra;
+    case scm_tc7_smob:
+      SCM_ASRTGO (SCM_ARRAYP (ra), badarg);
+      vargs = scm_vector (args);
+      SCM_ASSERT (SCM_LENGTH (vargs) == SCM_ARRAY_NDIM (ra), SCM_UNDEFINED, SCM_WNA, s_transpose_array);
+      ve = SCM_VELTS (vargs);
+      ndim = 0;
+      for (k = 0; k < SCM_ARRAY_NDIM (ra); k++)
+	{
+	  i = SCM_INUM (ve[k]);
+	  SCM_ASSERT (SCM_INUMP (ve[k]) && i >= 0 && i < SCM_ARRAY_NDIM (ra),
+		  ve[k], SCM_ARG2, s_transpose_array);
+	  if (ndim < i)
+	    ndim = i;
+	}
+      ndim++;
+      res = scm_make_ra (ndim);
+      SCM_ARRAY_V (res) = SCM_ARRAY_V (ra);
+      SCM_ARRAY_BASE (res) = SCM_ARRAY_BASE (ra);
+      for (k = ndim; k--;)
+	{
+	  SCM_ARRAY_DIMS (res)[k].lbnd = 0;
+	  SCM_ARRAY_DIMS (res)[k].ubnd = -1;
+	}
+      for (k = SCM_ARRAY_NDIM (ra); k--;)
+	{
+	  i = SCM_INUM (ve[k]);
+	  s = &(SCM_ARRAY_DIMS (ra)[k]);
+	  r = &(SCM_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)
+		{
+		  SCM_ARRAY_BASE (res) += (s->lbnd - r->lbnd) * r->inc;
+		  r->lbnd = s->lbnd;
+		}
+	      r->inc += s->inc;
+	    }
+	}
+      SCM_ASSERT (ndim <= 0, args, "bad argument scm_list", s_transpose_array);
+      scm_ra_set_contp (res);
+      return res;
+    }
+}
+
+/* args are RA . AXES */
+SCM_PROC(s_enclose_array, "enclose-array", 0, 0, 1, scm_enclose_array);
+#ifdef __STDC__
+SCM 
+scm_enclose_array (SCM axes)
+#else
+SCM 
+scm_enclose_array (axes)
+     SCM axes;
+#endif
+{
+  SCM axv, ra, res, ra_inr;
+  scm_array_dim vdim, *s = &vdim;
+  int ndim, j, k, ninr, noutr;
+  SCM_ASSERT (SCM_NIMP (axes), SCM_UNDEFINED, SCM_WNA, s_enclose_array);
+  ra = SCM_CAR (axes);
+  axes = SCM_CDR (axes);
+  if (SCM_NULLP (axes))
+
+      axes = scm_cons ((SCM_ARRAYP (ra) ? SCM_MAKINUM (SCM_ARRAY_NDIM (ra) - 1) : SCM_INUM0), SCM_EOL);
+  ninr = scm_ilength (axes);
+  ra_inr = scm_make_ra (ninr);
+  SCM_ASRTGO (SCM_NIMP (ra), badarg1);
+  switch SCM_TYP7
+    (ra)
+    {
+    default:
+    badarg1:scm_wta (ra, (char *) SCM_ARG1, s_enclose_array);
+    case scm_tc7_string:
+    case scm_tc7_bvect:
+    case scm_tc7_byvect:
+    case scm_tc7_uvect:
+    case scm_tc7_ivect:
+    case scm_tc7_fvect:
+    case scm_tc7_dvect:
+    case scm_tc7_cvect:
+    case scm_tc7_vector:
+    case scm_tc7_svect:
+#ifdef LONGLONGS
+    case scm_tc7_llvect:
+#endif
+      s->lbnd = 0;
+      s->ubnd = SCM_LENGTH (ra) - 1;
+      s->inc = 1;
+      SCM_ARRAY_V (ra_inr) = ra;
+      SCM_ARRAY_BASE (ra_inr) = 0;
+      ndim = 1;
+      break;
+    case scm_tc7_smob:
+      SCM_ASRTGO (SCM_ARRAYP (ra), badarg1);
+      s = SCM_ARRAY_DIMS (ra);
+      SCM_ARRAY_V (ra_inr) = SCM_ARRAY_V (ra);
+      SCM_ARRAY_BASE (ra_inr) = SCM_ARRAY_BASE (ra);
+      ndim = SCM_ARRAY_NDIM (ra);
+      break;
+    }
+  noutr = ndim - ninr;
+  axv = scm_make_string (SCM_MAKINUM (ndim), SCM_MAKICHR (0));
+  SCM_ASSERT (0 <= noutr && 0 <= ninr, SCM_UNDEFINED, SCM_WNA, s_enclose_array);
+  res = scm_make_ra (noutr);
+  SCM_ARRAY_BASE (res) = SCM_ARRAY_BASE (ra_inr);
+  SCM_ARRAY_V (res) = ra_inr;
+  for (k = 0; k < ninr; k++, axes = SCM_CDR (axes))
+    {
+      SCM_ASSERT (SCM_INUMP (SCM_CAR (axes)), SCM_CAR (axes), "bad axis", s_enclose_array);
+      j = SCM_INUM (SCM_CAR (axes));
+      SCM_ARRAY_DIMS (ra_inr)[k].lbnd = s[j].lbnd;
+      SCM_ARRAY_DIMS (ra_inr)[k].ubnd = s[j].ubnd;
+      SCM_ARRAY_DIMS (ra_inr)[k].inc = s[j].inc;
+      SCM_CHARS (axv)[j] = 1;
+    }
+  for (j = 0, k = 0; k < noutr; k++, j++)
+    {
+      while (SCM_CHARS (axv)[j])
+	j++;
+      SCM_ARRAY_DIMS (res)[k].lbnd = s[j].lbnd;
+      SCM_ARRAY_DIMS (res)[k].ubnd = s[j].ubnd;
+      SCM_ARRAY_DIMS (res)[k].inc = s[j].inc;
+    }
+  scm_ra_set_contp (ra_inr);
+  scm_ra_set_contp (res);
+  return res;
+}
+
+
+
+SCM_PROC(s_array_in_bounds_p, "array-in-bounds?", 0, 0, 1, scm_array_in_bounds_p);
+#ifdef __STDC__
+SCM 
+scm_array_in_bounds_p (SCM args)
+#else
+SCM 
+scm_array_in_bounds_p (args)
+     SCM args;
+#endif
+{
+  SCM v, ind = SCM_EOL;
+  long pos = 0;
+  register scm_sizet k;
+  register long j;
+  scm_array_dim *s;
+  SCM_ASSERT (SCM_NIMP (args), args, SCM_WNA, s_array_in_bounds_p);
+  v = SCM_CAR (args);
+  args = SCM_CDR (args);
+  SCM_ASRTGO (SCM_NIMP (v), badarg1);
+  if (SCM_NIMP (args))
+
+    {
+      ind = SCM_CAR (args);
+      args = SCM_CDR (args);
+      SCM_ASSERT (SCM_INUMP (ind), ind, SCM_ARG2, s_array_in_bounds_p);
+      pos = SCM_INUM (ind);
+    }
+tail:
+  switch SCM_TYP7
+    (v)
+    {
+    default:
+    badarg1:scm_wta (v, (char *) SCM_ARG1, s_array_in_bounds_p);
+    wna:scm_wta (args, (char *) SCM_WNA, s_array_in_bounds_p);
+    case scm_tc7_smob:
+      k = SCM_ARRAY_NDIM (v);
+      s = SCM_ARRAY_DIMS (v);
+      pos = SCM_ARRAY_BASE (v);
+      if (!k)
+	{
+	  SCM_ASRTGO (SCM_NULLP (ind), wna);
+	  ind = SCM_INUM0;
+	}
+      else
+	while (!0)
+	  {
+	    j = SCM_INUM (ind);
+	    if (!(j >= (s->lbnd) && j <= (s->ubnd)))
+	      {
+		SCM_ASRTGO (--k == scm_ilength (args), wna);
+		return SCM_BOOL_F;
+	      }
+	    pos += (j - s->lbnd) * (s->inc);
+	    if (!(--k && SCM_NIMP (args)))
+	      break;
+	    ind = SCM_CAR (args);
+	    args = SCM_CDR (args);
+	    s++;
+	    SCM_ASSERT (SCM_INUMP (ind), ind, s_bad_ind, s_array_in_bounds_p);
+	  }
+      SCM_ASRTGO (0 == k, wna);
+      v = SCM_ARRAY_V (v);
+      goto tail;
+    case scm_tc7_bvect:
+    case scm_tc7_string:
+    case scm_tc7_byvect:
+    case scm_tc7_uvect:
+    case scm_tc7_ivect:
+    case scm_tc7_fvect:
+    case scm_tc7_dvect:
+    case scm_tc7_cvect:
+    case scm_tc7_svect:
+#ifdef LONGLONGS
+    case scm_tc7_llvect:
+#endif
+    case scm_tc7_vector:
+      SCM_ASRTGO (SCM_NULLP (args) && SCM_INUMP (ind), wna);
+      return pos >= 0 && pos < SCM_LENGTH (v) ? SCM_BOOL_T : SCM_BOOL_F;
+    }
+}
+
+
+SCM_PROC(s_array_ref, "array-ref", 1, 0, 1, scm_uniform_vector_ref);
+SCM_PROC(s_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0, scm_uniform_vector_ref);
+#ifdef __STDC__
+SCM 
+scm_uniform_vector_ref (SCM v, SCM args)
+#else
+SCM 
+scm_uniform_vector_ref (v, args)
+     SCM v;
+     SCM args;
+#endif
+{
+  long pos;
+  if (SCM_IMP (v))
+
+    {
+      SCM_ASRTGO (SCM_NULLP (args), badarg);
+      return v;
+    }
+  else if (SCM_ARRAYP (v))
+
+    {
+      pos = scm_aind (v, args, s_uniform_vector_ref);
+      v = SCM_ARRAY_V (v);
+    }
+  else
+    {
+      if (SCM_NIMP (args))
+
+	{
+	  SCM_ASSERT (SCM_CONSP (args) && SCM_INUMP (SCM_CAR (args)), args, SCM_ARG2, s_uniform_vector_ref);
+	  pos = SCM_INUM (SCM_CAR (args));
+	  SCM_ASRTGO (SCM_NULLP (SCM_CDR (args)), wna);
+	}
+      else
+	{
+	  SCM_ASSERT (SCM_INUMP (args), args, SCM_ARG2, s_uniform_vector_ref);
+	  pos = SCM_INUM (args);
+	}
+      SCM_ASRTGO (pos >= 0 && pos < SCM_LENGTH (v), outrng);
+    }
+  switch SCM_TYP7
+    (v)
+    {
+    default:
+      if (SCM_NULLP (args))
+ return v;
+    badarg:scm_wta (v, (char *) SCM_ARG1, s_uniform_vector_ref);
+    outrng:scm_wta (SCM_MAKINUM (pos), (char *) SCM_OUTOFRANGE, s_uniform_vector_ref);
+    wna:scm_wta (SCM_UNDEFINED, (char *) SCM_WNA, s_uniform_vector_ref);
+    case scm_tc7_smob:
+      {				/* enclosed */
+	int k = SCM_ARRAY_NDIM (v);
+	SCM res = scm_make_ra (k);
+	SCM_ARRAY_V (res) = SCM_ARRAY_V (v);
+	SCM_ARRAY_BASE (res) = pos;
+	while (k--)
+	  {
+	    SCM_ARRAY_DIMS (res)[k].lbnd = SCM_ARRAY_DIMS (v)[k].lbnd;
+	    SCM_ARRAY_DIMS (res)[k].ubnd = SCM_ARRAY_DIMS (v)[k].ubnd;
+	    SCM_ARRAY_DIMS (res)[k].inc = SCM_ARRAY_DIMS (v)[k].inc;
+	  }
+	return res;
+      }
+    case scm_tc7_bvect:
+      if (SCM_VELTS (v)[pos / SCM_LONG_BIT] & (1L << (pos % SCM_LONG_BIT)))
+	return SCM_BOOL_T;
+      else
+	return SCM_BOOL_F;
+    case scm_tc7_string:
+      return SCM_MAKICHR (SCM_CHARS (v)[pos]);
+    case scm_tc7_byvect:
+      return SCM_MAKINUM (((char *)SCM_CHARS (v))[pos]);
+# ifdef SCM_INUMS_ONLY
+    case scm_tc7_uvect:
+    case scm_tc7_ivect:
+      return SCM_MAKINUM (SCM_VELTS (v)[pos]);
+# else
+  case scm_tc7_uvect:
+    return scm_ulong2num(SCM_VELTS(v)[pos]);
+  case scm_tc7_ivect:
+    return scm_long2num(SCM_VELTS(v)[pos]);
+# endif    
+
+    case scm_tc7_svect:
+      return SCM_MAKINUM (((short *) SCM_CDR (v))[pos]);
+#ifdef LONGLONGS
+    case scm_tc7_llvect:
+      return scm_long_long2num (((long_long *) SCM_CDR (v))[pos]);
+#endif
+
+#ifdef SCM_FLOATS
+#ifdef SCM_SINGLES
+    case scm_tc7_fvect:
+      return scm_makflo (((float *) SCM_CDR (v))[pos]);
+#endif
+    case scm_tc7_dvect:
+      return scm_makdbl (((double *) SCM_CDR (v))[pos], 0.0);
+    case scm_tc7_cvect:
+      return scm_makdbl (((double *) SCM_CDR (v))[2 * pos],
+			 ((double *) SCM_CDR (v))[2 * pos + 1]);
+#endif
+    case scm_tc7_vector:
+      return SCM_VELTS (v)[pos];
+    }
+}
+
+/* Internal version of scm_uniform_vector_ref for uves that does no error checking and
+   tries to recycle conses.  (Make *sure* you want them recycled.) */
+#ifdef __STDC__
+SCM 
+scm_cvref (SCM v, scm_sizet pos, SCM last)
+#else
+SCM 
+scm_cvref (v, pos, last)
+     SCM v;
+     scm_sizet pos;
+     SCM last;
+#endif
+{
+  switch SCM_TYP7
+    (v)
+    {
+    default:
+      scm_wta (v, (char *) SCM_ARG1, "PROGRAMMING ERROR: scm_cvref");
+    case scm_tc7_bvect:
+      if (SCM_VELTS (v)[pos / SCM_LONG_BIT] & (1L << (pos % SCM_LONG_BIT)))
+	return SCM_BOOL_T;
+      else
+	return SCM_BOOL_F;
+    case scm_tc7_string:
+      return SCM_MAKICHR (SCM_CHARS (v)[pos]);
+    case scm_tc7_byvect:
+      return SCM_MAKINUM (((char *)SCM_CHARS (v))[pos]);
+# ifdef SCM_INUMS_ONLY
+    case scm_tc7_uvect:
+    case scm_tc7_ivect:
+      return SCM_MAKINUM (SCM_VELTS (v)[pos]);
+# else
+    case scm_tc7_uvect:
+      return scm_ulong2num(SCM_VELTS(v)[pos]);
+    case scm_tc7_ivect:
+      return scm_long2num(SCM_VELTS(v)[pos]);
+# endif    
+    case scm_tc7_svect:
+      return SCM_MAKINUM (((short *) SCM_CDR (v))[pos]);
+#ifdef LONGLONGS
+    case scm_tc7_llvect:
+      return scm_long_long2num (((long_long *) SCM_CDR (v))[pos]);
+#endif
+#ifdef SCM_FLOATS
+#ifdef SCM_SINGLES
+    case scm_tc7_fvect:
+      if (SCM_NIMP (last) && (last != scm_flo0) && (scm_tc_flo == SCM_CAR (last)))
+	{
+	  SCM_FLO (last) = ((float *) SCM_CDR (v))[pos];
+	  return last;
+	}
+      return scm_makflo (((float *) SCM_CDR (v))[pos]);
+#endif
+    case scm_tc7_dvect:
+#ifdef SCM_SINGLES
+      if (SCM_NIMP (last) && scm_tc_dblr == SCM_CAR (last))
+#else
+      if (SCM_NIMP (last) && (last != scm_flo0) && (scm_tc_dblr == SCM_CAR (last)))
+#endif
+	{
+	  SCM_REAL (last) = ((double *) SCM_CDR (v))[pos];
+	  return last;
+	}
+      return scm_makdbl (((double *) SCM_CDR (v))[pos], 0.0);
+    case scm_tc7_cvect:
+      if (SCM_NIMP (last) && scm_tc_dblc == SCM_CAR (last))
+	{
+	  SCM_REAL (last) = ((double *) SCM_CDR (v))[2 * pos];
+	  SCM_IMAG (last) = ((double *) SCM_CDR (v))[2 * pos + 1];
+	  return last;
+	}
+      return scm_makdbl (((double *) SCM_CDR (v))[2 * pos],
+			 ((double *) SCM_CDR (v))[2 * pos + 1]);
+#endif
+    case scm_tc7_vector:
+      return SCM_VELTS (v)[pos];
+    case scm_tc7_smob:
+      {				/* enclosed scm_array */
+	int k = SCM_ARRAY_NDIM (v);
+	SCM res = scm_make_ra (k);
+	SCM_ARRAY_V (res) = SCM_ARRAY_V (v);
+	SCM_ARRAY_BASE (res) = pos;
+	while (k--)
+	  {
+	    SCM_ARRAY_DIMS (res)[k].ubnd = SCM_ARRAY_DIMS (v)[k].ubnd;
+	    SCM_ARRAY_DIMS (res)[k].lbnd = SCM_ARRAY_DIMS (v)[k].lbnd;
+	    SCM_ARRAY_DIMS (res)[k].inc = SCM_ARRAY_DIMS (v)[k].inc;
+	  }
+	return res;
+      }
+    }
+}
+
+SCM_PROC(s_uniform_array_set1_x, "uniform-array-set1!", 3, 0, 0, scm_array_set_x);
+SCM_PROC(s_array_set_x, "array-set!", 2, 0, 1, scm_array_set_x);
+#ifdef __STDC__
+SCM 
+scm_array_set_x (SCM v, SCM obj, SCM args)
+#else
+SCM 
+scm_array_set_x (v, obj, args)
+     SCM v;
+     SCM obj;
+     SCM args;
+#endif
+{
+  long pos;
+  SCM_ASRTGO (SCM_NIMP (v), badarg1);
+  if (SCM_ARRAYP (v))
+
+    {
+      pos = scm_aind (v, args, s_array_set_x);
+      v = SCM_ARRAY_V (v);
+    }
+  else
+    {
+      if (SCM_NIMP (args))
+
+	{
+	  SCM_ASSERT (SCM_CONSP (args) && SCM_INUMP (SCM_CAR (args)), args, SCM_ARG2, s_array_set_x);
+	  pos = SCM_INUM (SCM_CAR (args));
+	  SCM_ASRTGO (SCM_NULLP (SCM_CDR (args)), wna);
+	}
+      else
+	{
+	  SCM_ASSERT (SCM_INUMP (args), args, SCM_ARG2, s_array_set_x);
+	  pos = SCM_INUM (args);
+	}
+      SCM_ASRTGO (pos >= 0 && pos < SCM_LENGTH (v), outrng);
+    }
+  switch (SCM_TYP7 (v))
+    {
+    default:
+    badarg1:scm_wta (v, (char *) SCM_ARG1, s_array_set_x);
+    outrng:scm_wta (SCM_MAKINUM (pos), (char *) SCM_OUTOFRANGE, s_array_set_x);
+    wna:scm_wta (SCM_UNDEFINED, (char *) SCM_WNA, s_array_set_x);
+    case scm_tc7_smob:		/* enclosed */
+      goto badarg1;
+    case scm_tc7_bvect:
+      if (SCM_BOOL_F == obj)
+	SCM_VELTS (v)[pos / SCM_LONG_BIT] &= ~(1L << (pos % SCM_LONG_BIT));
+      else if (SCM_BOOL_T == obj)
+	SCM_VELTS (v)[pos / SCM_LONG_BIT] |= (1L << (pos % SCM_LONG_BIT));
+      else
+      badarg3:scm_wta (obj, (char *) SCM_ARG3, s_array_set_x);
+      break;
+    case scm_tc7_string:
+      SCM_ASRTGO (SCM_ICHRP (obj), badarg3);
+      SCM_CHARS (v)[pos] = SCM_ICHR (obj);
+      break;
+    case scm_tc7_byvect:
+      if (SCM_ICHRP (obj))
+	obj = SCM_MAKINUM (SCM_ICHR (obj));
+      SCM_ASRTGO (SCM_INUMP (obj), badarg3);
+      ((char *)SCM_CHARS (v))[pos] = SCM_INUM (obj);
+      break;
+# ifdef SCM_INUMS_ONLY
+    case scm_tc7_uvect:
+      SCM_ASRTGO (SCM_INUM (obj) >= 0, badarg3);
+    case scm_tc7_ivect:
+    SCM_ASRTGO(SCM_INUMP(obj), badarg3); SCM_VELTS(v)[pos] = SCM_INUM(obj); break;
+# else
+  case scm_tc7_uvect:
+    SCM_VELTS(v)[pos] = scm_num2ulong(obj, (char *)SCM_ARG3, s_array_set_x); break;
+  case scm_tc7_ivect:
+    SCM_VELTS(v)[pos] = num2long(obj, (char *)SCM_ARG3, s_array_set_x); break;
+# endif
+      break;
+
+    case scm_tc7_svect:
+      SCM_ASRTGO (SCM_INUMP (obj), badarg3);
+      ((short *) SCM_CDR (v))[pos] = SCM_INUM (obj);
+      break;
+#ifdef LONGLONGS
+    case scm_tc7_llvect:
+      ((long_long *) SCM_CDR (v))[pos] = scm_num2long_long (obj, (char *)SCM_ARG3, s_array_set_x);
+      break;
+#endif
+
+
+#ifdef SCM_FLOATS
+#ifdef SCM_SINGLES
+    case scm_tc7_fvect:
+      SCM_ASRTGO (SCM_NIMP (obj) && SCM_REALP (obj), badarg3);
+      ((float *) SCM_CDR (v))[pos] = SCM_REALPART (obj);
+      break;
+#endif
+    case scm_tc7_dvect:
+      SCM_ASRTGO (SCM_NIMP (obj) && SCM_REALP (obj), badarg3);
+      ((double *) SCM_CDR (v))[pos] = SCM_REALPART (obj);
+      break;
+    case scm_tc7_cvect:
+      SCM_ASRTGO (SCM_NIMP (obj) && SCM_INEXP (obj), badarg3);
+      ((double *) SCM_CDR (v))[2 * pos] = SCM_REALPART (obj);
+      ((double *) SCM_CDR (v))[2 * pos + 1] = SCM_CPLXP (obj) ? SCM_IMAG (obj) : 0.0;
+      break;
+#endif
+    case scm_tc7_vector:
+      SCM_VELTS (v)[pos] = obj;
+      break;
+    }
+  return SCM_UNSPECIFIED;
+}
+
+SCM_PROC(s_array_contents, "array-contents", 1, 1, 0, scm_array_contents);
+#ifdef __STDC__
+SCM 
+scm_array_contents (SCM ra, SCM strict)
+#else
+SCM 
+scm_array_contents (ra, strict)
+     SCM ra;
+     SCM strict;
+#endif
+{
+  SCM sra;
+  if (SCM_IMP (ra))
+ return SCM_BOOL_F;
+  switch SCM_TYP7
+    (ra)
+    {
+    default:
+      return SCM_BOOL_F;
+    case scm_tc7_vector:
+    case scm_tc7_string:
+    case scm_tc7_bvect:
+    case scm_tc7_byvect:
+    case scm_tc7_uvect:
+    case scm_tc7_ivect:
+    case scm_tc7_fvect:
+    case scm_tc7_dvect:
+    case scm_tc7_cvect:
+    case scm_tc7_svect:
+#ifdef LONGLONGS
+    case scm_tc7_llvect:
+#endif
+      return ra;
+    case scm_tc7_smob:
+      {
+	scm_sizet k, ndim = SCM_ARRAY_NDIM (ra), len = 1;
+	if (!SCM_ARRAYP (ra) || !SCM_ARRAY_CONTP (ra))
+	  return SCM_BOOL_F;
+	for (k = 0; k < ndim; k++)
+	  len *= SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd + 1;
+	if (!SCM_UNBNDP (strict))
+	  {
+	    if SCM_ARRAY_BASE
+	      (ra) return SCM_BOOL_F;
+	    if (ndim && (1 != SCM_ARRAY_DIMS (ra)[ndim - 1].inc))
+	      return SCM_BOOL_F;
+	    if (scm_tc7_bvect == SCM_TYP7 (SCM_ARRAY_V (ra)))
+	      {
+		if (len != SCM_LENGTH (SCM_ARRAY_V (ra)) ||
+		    SCM_ARRAY_BASE (ra) % SCM_LONG_BIT ||
+		    len % SCM_LONG_BIT)
+		  return SCM_BOOL_F;
+	      }
+	  }
+	if ((len == SCM_LENGTH (SCM_ARRAY_V (ra))) && 0 == SCM_ARRAY_BASE (ra) && SCM_ARRAY_DIMS (ra)->inc)
+	  return SCM_ARRAY_V (ra);
+	sra = scm_make_ra (1);
+	SCM_ARRAY_DIMS (sra)->lbnd = 0;
+	SCM_ARRAY_DIMS (sra)->ubnd = len - 1;
+	SCM_ARRAY_V (sra) = SCM_ARRAY_V (ra);
+	SCM_ARRAY_BASE (sra) = SCM_ARRAY_BASE (ra);
+	SCM_ARRAY_DIMS (sra)->inc = (ndim ? SCM_ARRAY_DIMS (ra)[ndim - 1].inc : 1);
+	return sra;
+      }
+    }
+}
+
+#ifdef __STDC__
+SCM 
+scm_ra2contig (SCM ra, int copy)
+#else
+SCM 
+scm_ra2contig (ra, copy)
+     SCM ra;
+     int copy;
+#endif
+{
+  SCM ret;
+  long inc = 1;
+  scm_sizet k, len = 1;
+  for (k = SCM_ARRAY_NDIM (ra); k--;)
+    len *= SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd + 1;
+  k = SCM_ARRAY_NDIM (ra);
+  if (SCM_ARRAY_CONTP (ra) && ((0 == k) || (1 == SCM_ARRAY_DIMS (ra)[k - 1].inc)))
+    {
+      if (scm_tc7_bvect != SCM_TYP7 (ra))
+	return ra;
+      if ((len == SCM_LENGTH (SCM_ARRAY_V (ra)) &&
+	   0 == SCM_ARRAY_BASE (ra) % SCM_LONG_BIT &&
+	   0 == len % SCM_LONG_BIT))
+	return ra;
+    }
+  ret = scm_make_ra (k);
+  SCM_ARRAY_BASE (ret) = 0;
+  while (k--)
+    {
+      SCM_ARRAY_DIMS (ret)[k].lbnd = SCM_ARRAY_DIMS (ra)[k].lbnd;
+      SCM_ARRAY_DIMS (ret)[k].ubnd = SCM_ARRAY_DIMS (ra)[k].ubnd;
+      SCM_ARRAY_DIMS (ret)[k].inc = inc;
+      inc *= SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd + 1;
+    }
+  SCM_ARRAY_V (ret) = scm_make_uve ((inc - 1), scm_array_prototype (ra));
+  if (copy)
+    scm_array_copy_x (ra, ret);
+  return ret;
+}
+
+
+
+SCM_PROC(s_uniform_array_read_x, "uniform-array-read!", 1, 1, 0, scm_uniform_array_read_x);
+#ifdef __STDC__
+SCM 
+scm_uniform_array_read_x (SCM ra, SCM port)
+#else
+SCM 
+scm_uniform_array_read_x (ra, port)
+     SCM ra;
+     SCM port;
+#endif
+{
+  SCM cra, v = ra;
+  long sz, len, ans;
+  long start = 0;
+  if (SCM_UNBNDP (port))
+ port = scm_cur_inp;
+  else
+    SCM_ASSERT (SCM_NIMP (port) && SCM_OPINFPORTP (port), port, SCM_ARG2, s_uniform_array_read_x);
+  SCM_ASRTGO (SCM_NIMP (v), badarg1);
+  len = SCM_LENGTH (v);
+loop:
+  switch SCM_TYP7
+    (v)
+    {
+    default:
+    badarg1:scm_wta (v, (char *) SCM_ARG1, s_uniform_array_read_x);
+    case scm_tc7_smob:
+      SCM_ASRTGO (SCM_ARRAYP (v), badarg1);
+      cra = scm_ra2contig (ra, 0);
+      start = SCM_ARRAY_BASE (cra);
+      len = SCM_ARRAY_DIMS (cra)->inc *
+	(SCM_ARRAY_DIMS (cra)->ubnd - SCM_ARRAY_DIMS (cra)->lbnd + 1);
+      v = SCM_ARRAY_V (cra);
+      goto loop;
+    case scm_tc7_string:
+    case scm_tc7_byvect:
+      sz = sizeof (char);
+      break;
+    case scm_tc7_bvect:
+      len = (len + SCM_LONG_BIT - 1) / SCM_LONG_BIT;
+      start /= SCM_LONG_BIT;
+    case scm_tc7_uvect:
+    case scm_tc7_ivect:
+      sz = sizeof (long);
+      break;
+    case scm_tc7_svect:
+      sz = sizeof (short);
+      break;
+#ifdef LONGLONGS
+    case scm_tc7_llvect:
+      sz = sizeof (long_long);
+      break;
+#endif
+#ifdef SCM_FLOATS
+#ifdef SCM_SINGLES
+    case scm_tc7_fvect:
+      sz = sizeof (float);
+      break;
+#endif
+    case scm_tc7_dvect:
+      sz = sizeof (double);
+      break;
+    case scm_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 (SCM_CRDYP (port))
+
+    {				/* UGGH!!! */
+      ungetc (SCM_CGETUN (port), (FILE *)SCM_STREAM (port));
+      SCM_CLRDY (port);		/* Clear ungetted char */
+    }
+  SCM_SYSCALL (ans = fread (SCM_CHARS (v) + start * sz, (scm_sizet) sz, (scm_sizet) len, (FILE *)SCM_STREAM (port)));
+  if (SCM_TYP7 (v) == scm_tc7_bvect)
+    ans *= SCM_LONG_BIT;
+  if (v != ra && cra != ra)
+    scm_array_copy_x (cra, ra);
+  return SCM_MAKINUM (ans);
+}
+
+SCM_PROC(s_uniform_array_write, "uniform-array-write", 1, 1, 0, scm_uniform_array_write);
+#ifdef __STDC__
+SCM 
+scm_uniform_array_write (SCM v, SCM port)
+#else
+SCM 
+scm_uniform_array_write (v, port)
+     SCM v;
+     SCM port;
+#endif
+{
+  long sz, len, ans;
+  long start = 0;
+  if (SCM_UNBNDP (port))
+ port = scm_cur_outp;
+  else
+    SCM_ASSERT (SCM_NIMP (port) && SCM_OPOUTFPORTP (port), port, SCM_ARG2, s_uniform_array_write);
+  SCM_ASRTGO (SCM_NIMP (v), badarg1);
+  len = SCM_LENGTH (v);
+loop:
+  switch SCM_TYP7
+    (v)
+    {
+    default:
+    badarg1:scm_wta (v, (char *) SCM_ARG1, s_uniform_array_write);
+    case scm_tc7_smob:
+      SCM_ASRTGO (SCM_ARRAYP (v), badarg1);
+      v = scm_ra2contig (v, 1);
+      start = SCM_ARRAY_BASE (v);
+      len = SCM_ARRAY_DIMS (v)->inc * (SCM_ARRAY_DIMS (v)->ubnd - SCM_ARRAY_DIMS (v)->lbnd + 1);
+      v = SCM_ARRAY_V (v);
+      goto loop;
+    case scm_tc7_byvect:
+    case scm_tc7_string:
+      sz = sizeof (char);
+      break;
+    case scm_tc7_bvect:
+      len = (len + SCM_LONG_BIT - 1) / SCM_LONG_BIT;
+      start /= SCM_LONG_BIT;
+    case scm_tc7_uvect:
+    case scm_tc7_ivect:
+      sz = sizeof (long);
+      break;
+    case scm_tc7_svect:
+      sz = sizeof (short);
+      break;
+#ifdef LONGLONGS
+    case scm_tc7_llvect:
+      sz = sizeof (long_long);
+      break;
+#endif
+#ifdef SCM_FLOATS
+#ifdef SCM_SINGLES
+    case scm_tc7_fvect:
+      sz = sizeof (float);
+      break;
+#endif
+    case scm_tc7_dvect:
+      sz = sizeof (double);
+      break;
+    case scm_tc7_cvect:
+      sz = 2 * sizeof (double);
+      break;
+#endif
+    }
+  SCM_SYSCALL (ans = fwrite (SCM_CHARS (v) + start * sz, (scm_sizet) sz, (scm_sizet) len, (FILE *)SCM_STREAM (port)));
+  if (SCM_TYP7 (v) == scm_tc7_bvect)
+    ans *= SCM_LONG_BIT;
+  return SCM_MAKINUM (ans);
+}
+
+
+static char cnt_tab[16] =
+{0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4};
+
+SCM_PROC(s_bit_count, "bit-count", 2, 0, 0, scm_bit_count);
+#ifdef __STDC__
+SCM 
+scm_bit_count (SCM item, SCM seq)
+#else
+SCM 
+scm_bit_count (item, seq)
+     SCM item;
+     SCM seq;
+#endif
+{
+  long i;
+  register unsigned long cnt = 0, w;
+  SCM_ASSERT (SCM_NIMP (seq), seq, SCM_ARG2, s_bit_count);
+  switch SCM_TYP7
+    (seq)
+    {
+    default:
+      scm_wta (seq, (char *) SCM_ARG2, s_bit_count);
+    case scm_tc7_bvect:
+      if (0 == SCM_LENGTH (seq))
+	return SCM_INUM0;
+      i = (SCM_LENGTH (seq) - 1) / SCM_LONG_BIT;
+      w = SCM_VELTS (seq)[i];
+      if (SCM_FALSEP (item))
+	w = ~w;
+      w <<= SCM_LONG_BIT - 1 - ((SCM_LENGTH (seq) - 1) % SCM_LONG_BIT);
+      while (!0)
+	{
+	  for (; w; w >>= 4)
+	    cnt += cnt_tab[w & 0x0f];
+	  if (0 == i--)
+	    return SCM_MAKINUM (cnt);
+	  w = SCM_VELTS (seq)[i];
+	  if (SCM_FALSEP (item))
+	    w = ~w;
+	}
+    }
+}
+
+
+SCM_PROC(s_bit_position, "bit-position", 3, 0, 0, scm_bit_position);
+#ifdef __STDC__
+SCM 
+scm_bit_position (SCM item, SCM v, SCM k)
+#else
+SCM 
+scm_bit_position (item, v, k)
+     SCM item;
+     SCM v;
+     SCM k;
+#endif
+{
+  long i, lenw, xbits, pos = SCM_INUM (k);
+  register unsigned long w;
+  SCM_ASSERT (SCM_NIMP (v), v, SCM_ARG2, s_bit_position);
+  SCM_ASSERT (SCM_INUMP (k), k, SCM_ARG3, s_bit_position);
+  SCM_ASSERT ((pos <= SCM_LENGTH (v)) && (pos >= 0),
+	  k, SCM_OUTOFRANGE, s_bit_position);
+  if (pos == SCM_LENGTH (v))
+    return SCM_BOOL_F;
+  switch SCM_TYP7
+    (v)
+    {
+    default:
+      scm_wta (v, (char *) SCM_ARG2, s_bit_position);
+    case scm_tc7_bvect:
+      if (0 == SCM_LENGTH (v))
+	return SCM_MAKINUM (-1L);
+      lenw = (SCM_LENGTH (v) - 1) / SCM_LONG_BIT;	/* watch for part words */
+      i = pos / SCM_LONG_BIT;
+      w = SCM_VELTS (v)[i];
+      if (SCM_FALSEP (item))
+	w = ~w;
+      xbits = (pos % SCM_LONG_BIT);
+      pos -= xbits;
+      w = ((w >> xbits) << xbits);
+      xbits = SCM_LONG_BIT - 1 - (SCM_LENGTH (v) - 1) % SCM_LONG_BIT;
+      while (!0)
+	{
+	  if (w && (i == lenw))
+	    w = ((w << xbits) >> xbits);
+	  if (w)
+	    while (w)
+	      switch (w & 0x0f)
+		{
+		default:
+		  return SCM_MAKINUM (pos);
+		case 2:
+		case 6:
+		case 10:
+		case 14:
+		  return SCM_MAKINUM (pos + 1);
+		case 4:
+		case 12:
+		  return SCM_MAKINUM (pos + 2);
+		case 8:
+		  return SCM_MAKINUM (pos + 3);
+		case 0:
+		  pos += 4;
+		  w >>= 4;
+		}
+	  if (++i > lenw)
+	    break;
+	  pos += SCM_LONG_BIT;
+	  w = SCM_VELTS (v)[i];
+	  if (SCM_FALSEP (item))
+	    w = ~w;
+	}
+      return SCM_BOOL_F;
+    }
+}
+
+
+SCM_PROC(s_bit_set_star_x, "bit-set*!", 3, 0, 0, scm_bit_set_star_x);
+#ifdef __STDC__
+SCM 
+scm_bit_set_star_x (SCM v, SCM kv, SCM obj)
+#else
+SCM 
+scm_bit_set_star_x (v, kv, obj)
+     SCM v;
+     SCM kv;
+     SCM obj;
+#endif
+{
+  register long i, k, vlen;
+  SCM_ASRTGO (SCM_NIMP (v), badarg1);
+  SCM_ASRTGO (SCM_NIMP (kv), badarg2);
+  switch SCM_TYP7
+    (kv)
+    {
+    default:
+    badarg2:scm_wta (kv, (char *) SCM_ARG2, s_bit_set_star_x);
+    case scm_tc7_uvect:
+      switch SCM_TYP7
+	(v)
+	{
+	default:
+	badarg1:scm_wta (v, (char *) SCM_ARG1, s_bit_set_star_x);
+	case scm_tc7_bvect:
+	  vlen = SCM_LENGTH (v);
+	  if (SCM_BOOL_F == obj)
+	    for (i = SCM_LENGTH (kv); i;)
+	      {
+		k = SCM_VELTS (kv)[--i];
+		SCM_ASSERT ((k < vlen), SCM_MAKINUM (k), SCM_OUTOFRANGE, s_bit_set_star_x);
+		SCM_VELTS (v)[k / SCM_LONG_BIT] &= ~(1L << (k % SCM_LONG_BIT));
+	      }
+	  else if (SCM_BOOL_T == obj)
+	    for (i = SCM_LENGTH (kv); i;)
+	      {
+		k = SCM_VELTS (kv)[--i];
+		SCM_ASSERT ((k < vlen), SCM_MAKINUM (k), SCM_OUTOFRANGE, s_bit_set_star_x);
+		SCM_VELTS (v)[k / SCM_LONG_BIT] |= (1L << (k % SCM_LONG_BIT));
+	      }
+	  else
+	  badarg3:scm_wta (obj, (char *) SCM_ARG3, s_bit_set_star_x);
+	}
+      break;
+    case scm_tc7_bvect:
+      SCM_ASRTGO (SCM_TYP7 (v) == scm_tc7_bvect && SCM_LENGTH (v) == SCM_LENGTH (kv), badarg1);
+      if (SCM_BOOL_F == obj)
+	for (k = (SCM_LENGTH (v) + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k--;)
+	  SCM_VELTS (v)[k] &= ~(SCM_VELTS (kv)[k]);
+      else if (SCM_BOOL_T == obj)
+	for (k = (SCM_LENGTH (v) + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k--;)
+	  SCM_VELTS (v)[k] |= SCM_VELTS (kv)[k];
+      else
+	goto badarg3;
+      break;
+    }
+  return SCM_UNSPECIFIED;
+}
+
+
+SCM_PROC(s_bit_count_star, "bit-count*", 3, 0, 0, scm_bit_count_star);
+#ifdef __STDC__
+SCM 
+scm_bit_count_star (SCM v, SCM kv, SCM obj)
+#else
+SCM 
+scm_bit_count_star (v, kv, obj)
+     SCM v;
+     SCM kv;
+     SCM obj;
+#endif
+{
+  register long i, vlen, count = 0;
+  register unsigned long k;
+  SCM_ASRTGO (SCM_NIMP (v), badarg1);
+  SCM_ASRTGO (SCM_NIMP (kv), badarg2);
+  switch SCM_TYP7
+    (kv)
+    {
+    default:
+    badarg2:scm_wta (kv, (char *) SCM_ARG2, s_bit_count_star);
+    case scm_tc7_uvect:
+      switch SCM_TYP7
+	(v)
+	{
+	default:
+	badarg1:scm_wta (v, (char *) SCM_ARG1, s_bit_count_star);
+	case scm_tc7_bvect:
+	  vlen = SCM_LENGTH (v);
+	  if (SCM_BOOL_F == obj)
+	    for (i = SCM_LENGTH (kv); i;)
+	      {
+		k = SCM_VELTS (kv)[--i];
+		SCM_ASSERT ((k < vlen), SCM_MAKINUM (k), SCM_OUTOFRANGE, s_bit_count_star);
+		if (!(SCM_VELTS (v)[k / SCM_LONG_BIT] & (1L << (k % SCM_LONG_BIT))))
+		  count++;
+	      }
+	  else if (SCM_BOOL_T == obj)
+	    for (i = SCM_LENGTH (kv); i;)
+	      {
+		k = SCM_VELTS (kv)[--i];
+		SCM_ASSERT ((k < vlen), SCM_MAKINUM (k), SCM_OUTOFRANGE, s_bit_count_star);
+		if (SCM_VELTS (v)[k / SCM_LONG_BIT] & (1L << (k % SCM_LONG_BIT)))
+		  count++;
+	      }
+	  else
+	  badarg3:scm_wta (obj, (char *) SCM_ARG3, s_bit_count_star);
+	}
+      break;
+    case scm_tc7_bvect:
+      SCM_ASRTGO (SCM_TYP7 (v) == scm_tc7_bvect && SCM_LENGTH (v) == SCM_LENGTH (kv), badarg1);
+      if (0 == SCM_LENGTH (v))
+	return SCM_INUM0;
+      SCM_ASRTGO (SCM_BOOL_T == obj || SCM_BOOL_F == obj, badarg3);
+      obj = (SCM_BOOL_T == obj);
+      i = (SCM_LENGTH (v) - 1) / SCM_LONG_BIT;
+      k = SCM_VELTS (kv)[i] & (obj ? SCM_VELTS (v)[i] : ~SCM_VELTS (v)[i]);
+      k <<= SCM_LONG_BIT - 1 - ((SCM_LENGTH (v) - 1) % SCM_LONG_BIT);
+      while (!0)
+	{
+	  for (; k; k >>= 4)
+	    count += cnt_tab[k & 0x0f];
+	  if (0 == i--)
+	    return SCM_MAKINUM (count);
+	  k = SCM_VELTS (kv)[i] & (obj ? SCM_VELTS (v)[i] : ~SCM_VELTS (v)[i]);
+	}
+    }
+  return SCM_MAKINUM (count);
+}
+
+
+SCM_PROC(s_bit_invert_x, "bit-invert!", 1, 0, 0, scm_bit_invert_x);
+#ifdef __STDC__
+SCM 
+scm_bit_invert_x (SCM v)
+#else
+SCM 
+scm_bit_invert_x (v)
+     SCM v;
+#endif
+{
+  register long k;
+  SCM_ASRTGO (SCM_NIMP (v), badarg1);
+  k = SCM_LENGTH (v);
+  switch SCM_TYP7
+    (v)
+    {
+    case scm_tc7_bvect:
+      for (k = (k + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k--;)
+	SCM_VELTS (v)[k] = ~SCM_VELTS (v)[k];
+      break;
+    default:
+    badarg1:scm_wta (v, (char *) SCM_ARG1, s_bit_invert_x);
+    }
+  return SCM_UNSPECIFIED;
+}
+
+
+SCM_PROC(s_string_upcase_x, "string-upcase!", 1, 0, 0, scm_string_upcase_x);
+#ifdef __STDC__
+SCM 
+scm_string_upcase_x (SCM v)
+#else
+SCM 
+scm_string_upcase_x (v)
+     SCM v;
+#endif
+{
+  register long k;
+  register unsigned char *cs;
+  SCM_ASRTGO (SCM_NIMP (v), badarg1);
+  k = SCM_LENGTH (v);
+  switch SCM_TYP7
+    (v)
+    {
+    case scm_tc7_string:
+      cs = SCM_UCHARS (v);
+      while (k--)
+	cs[k] = scm_upcase(cs[k]);
+      break;
+    default:
+    badarg1:scm_wta (v, (char *) SCM_ARG1, s_string_upcase_x);
+    }
+  return v;
+}
+
+SCM_PROC(s_string_downcase_x, "string-downcase!", 1, 0, 0, scm_string_downcase_x);
+#ifdef __STDC__
+SCM 
+scm_string_downcase_x (SCM v)
+#else
+SCM 
+scm_string_downcase_x (v)
+     SCM v;
+#endif
+{
+  register long k;
+  register unsigned char *cs;
+  SCM_ASRTGO (SCM_NIMP (v), badarg1);
+  k = SCM_LENGTH (v);
+  switch SCM_TYP7
+    (v)
+    {
+    case scm_tc7_string:
+      cs = SCM_UCHARS (v);
+      while (k--)
+	cs[k] = scm_downcase(cs[k]);
+      break;
+    default:
+    badarg1:scm_wta (v, (char *) SCM_ARG1, s_string_downcase_x);
+    }
+  return v;
+}
+
+
+#ifdef __STDC__
+SCM 
+scm_istr2bve (char *str, long len)
+#else
+SCM 
+scm_istr2bve (str, len)
+     char *str;
+     long len;
+#endif
+{
+  SCM v = scm_make_uve (len, SCM_BOOL_T);
+  long *data = (long *) SCM_VELTS (v);
+  register unsigned long mask;
+  register long k;
+  register long j;
+  for (k = 0; k < (len + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k++)
+    {
+      data[k] = 0L;
+      j = len - k * SCM_LONG_BIT;
+      if (j > SCM_LONG_BIT)
+	j = SCM_LONG_BIT;
+      for (mask = 1L; j--; mask <<= 1)
+	switch (*str++)
+	  {
+	  case '0':
+	    break;
+	  case '1':
+	    data[k] |= mask;
+	    break;
+	  default:
+	    return SCM_BOOL_F;
+	  }
+    }
+  return v;
+}
+
+
+#ifdef __STDC__
+static SCM 
+ra2l (SCM ra, scm_sizet base, scm_sizet k)
+#else
+static SCM 
+ra2l (ra, base, k)
+     SCM ra;
+     scm_sizet base;
+     scm_sizet k;
+#endif
+{
+  register SCM res = SCM_EOL;
+  register long inc = SCM_ARRAY_DIMS (ra)[k].inc;
+  register scm_sizet i;
+  if (SCM_ARRAY_DIMS (ra)[k].ubnd < SCM_ARRAY_DIMS (ra)[k].lbnd)
+    return SCM_EOL;
+  i = base + (1 + SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd) * inc;
+  if (k < SCM_ARRAY_NDIM (ra) - 1)
+    {
+      do
+	{
+	  i -= inc;
+	  res = scm_cons (ra2l (ra, i, k + 1), res);
+	}
+      while (i != base);
+    }
+  else
+    do
+      {
+	i -= inc;
+	res = scm_cons (scm_uniform_vector_ref (SCM_ARRAY_V (ra), SCM_MAKINUM (i)), res);
+      }
+    while (i != base);
+  return res;
+}
+
+
+SCM_PROC(s_array_to_list, "array->list", 1, 0, 0, scm_array_to_list);
+#ifdef __STDC__
+SCM 
+scm_array_to_list (SCM v)
+#else
+SCM 
+scm_array_to_list (v)
+     SCM v;
+#endif
+{
+  SCM res = SCM_EOL;
+  register long k;
+  SCM_ASRTGO (SCM_NIMP (v), badarg1);
+  switch SCM_TYP7
+    (v)
+    {
+    default:
+    badarg1:scm_wta (v, (char *) SCM_ARG1, s_array_to_list);
+    case scm_tc7_smob:
+      SCM_ASRTGO (SCM_ARRAYP (v), badarg1);
+      return ra2l (v, SCM_ARRAY_BASE (v), 0);
+    case scm_tc7_vector:
+      return scm_vector_to_list (v);
+    case scm_tc7_string:
+      return scm_string_to_list (v);
+    case scm_tc7_bvect:
+      {
+	long *data = (long *) SCM_VELTS (v);
+	register unsigned long mask;
+	for (k = (SCM_LENGTH (v) - 1) / SCM_LONG_BIT; k > 0; k--)
+	  for (mask = 1L << (SCM_LONG_BIT - 1); mask; mask >>= 1)
+	    res = scm_cons (((long *) data)[k] & mask ? SCM_BOOL_T : SCM_BOOL_F, res);
+	for (mask = 1L << ((SCM_LENGTH (v) % SCM_LONG_BIT) - 1); mask; mask >>= 1)
+	  res = scm_cons (((long *) data)[k] & mask ? SCM_BOOL_T : SCM_BOOL_F, res);
+	return res;
+      }
+# ifdef SCM_INUMS_ONLY
+    case scm_tc7_uvect:
+    case scm_tc7_ivect:
+      {
+	long *data = (long *) SCM_VELTS (v);
+	for (k = SCM_LENGTH (v) - 1; k >= 0; k--)
+	  res = scm_cons (SCM_MAKINUM (data[k]), res);
+	return res;
+      }
+# else
+  case scm_tc7_uvect: {
+    long *data = (long *)SCM_VELTS(v);
+    for (k = SCM_LENGTH(v) - 1; k >= 0; k--)
+      res = scm_cons(scm_ulong2num(data[k]), res);
+    return res;
+  }
+  case scm_tc7_ivect: {
+    long *data = (long *)SCM_VELTS(v);
+    for (k = SCM_LENGTH(v) - 1; k >= 0; k--)
+      res = scm_cons(scm_long2num(data[k]), res);
+    return res;
+  }
+# endif
+    case scm_tc7_svect: {
+      short *data;
+      data = (short *)SCM_VELTS(v);
+      for (k = SCM_LENGTH(v) - 1; k >= 0; k--)
+	res = scm_cons(SCM_MAKINUM (data[k]), res);
+      return res;
+    }
+#ifdef LONGLONGS
+    case scm_tc7_llvect: {
+      long_long *data;
+      data = (long_long *)SCM_VELTS(v);
+      for (k = SCM_LENGTH(v) - 1; k >= 0; k--)
+	res = scm_cons(scm_long_long2num(data[k]), res);
+      return res;
+    }
+#endif
+
+
+#ifdef SCM_FLOATS
+#ifdef SCM_SINGLES
+    case scm_tc7_fvect:
+      {
+	float *data = (float *) SCM_VELTS (v);
+	for (k = SCM_LENGTH (v) - 1; k >= 0; k--)
+	  res = scm_cons (scm_makflo (data[k]), res);
+	return res;
+      }
+#endif /*SCM_SINGLES*/
+    case scm_tc7_dvect:
+      {
+	double *data = (double *) SCM_VELTS (v);
+	for (k = SCM_LENGTH (v) - 1; k >= 0; k--)
+	  res = scm_cons (scm_makdbl (data[k], 0.0), res);
+	return res;
+      }
+    case scm_tc7_cvect:
+      {
+	double (*data)[2] = (double (*)[2]) SCM_VELTS (v);
+	for (k = SCM_LENGTH (v) - 1; k >= 0; k--)
+	  res = scm_cons (scm_makdbl (data[k][0], data[k][1]), res);
+	return res;
+      }
+#endif /*SCM_FLOATS*/
+    }
+}
+
+
+static char s_bad_ralst[] = "Bad scm_array contents scm_list";
+static int l2ra ();
+
+SCM_PROC(s_list_to_uniform_array, "list->uniform-array", 3, 0, 0, scm_list_to_uniform_array);
+#ifdef __STDC__
+SCM 
+scm_list_to_uniform_array (SCM ndim, SCM prot, SCM lst)
+#else
+SCM 
+scm_list_to_uniform_array (ndim, prot, lst)
+     SCM ndim;
+     SCM prot;
+     SCM lst;
+#endif
+{
+  SCM shp = SCM_EOL;
+  SCM row = lst;
+  SCM ra;
+  scm_sizet k;
+  long n;
+  SCM_ASSERT (SCM_INUMP (ndim), ndim, SCM_ARG1, s_list_to_uniform_array);
+  k = SCM_INUM (ndim);
+  while (k--)
+    {
+      n = scm_ilength (row);
+      SCM_ASSERT (n >= 0, lst, SCM_ARG2, s_list_to_uniform_array);
+      shp = scm_cons (SCM_MAKINUM (n), shp);
+      if (SCM_NIMP (row))
+	row = SCM_CAR (row);
+    }
+  ra = scm_dimensions_to_uniform_array (scm_reverse (shp), prot, SCM_EOL);
+  if (SCM_NULLP (shp))
+
+    {
+      SCM_ASRTGO (1 == scm_ilength (lst), badlst);
+      scm_array_set_x (ra, SCM_CAR (lst), SCM_EOL);
+      return ra;
+    }
+  if (!SCM_ARRAYP (ra))
+    {
+      for (k = 0; k < SCM_LENGTH (ra); k++, lst = SCM_CDR (lst))
+	scm_array_set_x (ra, SCM_CAR (lst), SCM_MAKINUM (k));
+      return ra;
+    }
+  if (l2ra (lst, ra, SCM_ARRAY_BASE (ra), 0))
+    return ra;
+  else
+  badlst:scm_wta (lst, s_bad_ralst, s_list_to_uniform_array);
+  return SCM_BOOL_F;
+}
+
+
+#ifdef __STDC__
+static int 
+l2ra (SCM lst, SCM ra, scm_sizet base, scm_sizet k)
+#else
+static int 
+l2ra (lst, ra, base, k)
+     SCM lst;
+     SCM ra;
+     scm_sizet base;
+     scm_sizet k;
+#endif
+{
+  register long inc = SCM_ARRAY_DIMS (ra)[k].inc;
+  register long n = (1 + SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd);
+  int ok = 1;
+  if (n <= 0)
+    return (SCM_EOL == lst);
+  if (k < SCM_ARRAY_NDIM (ra) - 1)
+    {
+      while (n--)
+	{
+	  if (SCM_IMP (lst) || SCM_NCONSP (lst))
+	    return 0;
+	  ok = ok && l2ra (SCM_CAR (lst), ra, base, k + 1);
+	  base += inc;
+	  lst = SCM_CDR (lst);
+	}
+      if (SCM_NNULLP (lst))
+ return 0;
+    }
+  else
+    {
+      while (n--)
+	{
+	  if (SCM_IMP (lst) || SCM_NCONSP (lst))
+	    return 0;
+	  ok = ok && scm_array_set_x (SCM_ARRAY_V (ra), SCM_CAR (lst), SCM_MAKINUM (base));
+	  base += inc;
+	  lst = SCM_CDR (lst);
+	}
+      if (SCM_NNULLP (lst))
+ return 0;
+    }
+  return ok;
+}
+
+#ifdef __STDC__
+static void 
+rapr1 (SCM ra, scm_sizet j, scm_sizet k, SCM port, int writing)
+#else
+static void 
+rapr1 (ra, j, k, port, writing)
+     SCM ra;
+     scm_sizet j;
+     scm_sizet k;
+     SCM port;
+     int writing;
+#endif
+{
+  long inc = 1;
+  long n = SCM_LENGTH (ra);
+  int enclosed = 0;
+tail:
+  switch SCM_TYP7
+    (ra)
+    {
+    case scm_tc7_smob:
+      if (enclosed++)
+	{
+	  SCM_ARRAY_BASE (ra) = j;
+	  if (n-- > 0)
+	    scm_iprin1 (ra, port, writing);
+	  for (j += inc; n-- > 0; j += inc)
+	    {
+	      scm_gen_putc (' ', port);
+	      SCM_ARRAY_BASE (ra) = j;
+	      scm_iprin1 (ra, port, writing);
+	    }
+	  break;
+	}
+      if (k + 1 < SCM_ARRAY_NDIM (ra))
+	{
+	  long i;
+	  inc = SCM_ARRAY_DIMS (ra)[k].inc;
+	  for (i = SCM_ARRAY_DIMS (ra)[k].lbnd; i < SCM_ARRAY_DIMS (ra)[k].ubnd; i++)
+	    {
+	      scm_gen_putc ('(', port);
+	      rapr1 (ra, j, k + 1, port, writing);
+	      scm_gen_puts (scm_regular_string, ") ", port);
+	      j += inc;
+	    }
+	  if (i == SCM_ARRAY_DIMS (ra)[k].ubnd)
+	    {			/* could be zero size. */
+	      scm_gen_putc ('(', port);
+	      rapr1 (ra, j, k + 1, port, writing);
+	      scm_gen_putc (')', port);
+	    }
+	  break;
+	}
+      if SCM_ARRAY_NDIM
+	(ra)
+	{			/* Could be zero-dimensional */
+	  inc = SCM_ARRAY_DIMS (ra)[k].inc;
+	  n = (SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd + 1);
+	}
+      else
+	n = 1;
+      ra = SCM_ARRAY_V (ra);
+      goto tail;
+    default:
+      if (n-- > 0)
+	scm_iprin1 (scm_uniform_vector_ref (ra, SCM_MAKINUM (j)), port, writing);
+      for (j += inc; n-- > 0; j += inc)
+	{
+	  scm_gen_putc (' ', port);
+	  scm_iprin1 (scm_cvref (ra, j, SCM_UNDEFINED), port, writing);
+	}
+      break;
+    case scm_tc7_string:
+      if (n-- > 0)
+	scm_iprin1 (SCM_MAKICHR (SCM_CHARS (ra)[j]), port, writing);
+      if (writing)
+	for (j += inc; n-- > 0; j += inc)
+	  {
+	    scm_gen_putc (' ', port);
+	    scm_iprin1 (SCM_MAKICHR (SCM_CHARS (ra)[j]), port, writing);
+	  }
+      else
+	for (j += inc; n-- > 0; j += inc)
+	  scm_gen_putc (SCM_CHARS (ra)[j], port);
+      break;
+    case scm_tc7_byvect:
+      if (n-- > 0)
+	scm_intprint (((char *)SCM_CDR (ra))[j], 10, port);
+      for (j += inc; n-- > 0; j += inc)
+	{
+	  scm_gen_putc (' ', port);
+	  scm_intprint (((char *)SCM_CDR (ra))[j], 10, port);
+	}
+      break;
+
+    case scm_tc7_uvect:
+    case scm_tc7_ivect:
+      if (n-- > 0)
+	scm_intprint (SCM_VELTS (ra)[j], 10, port);
+      for (j += inc; n-- > 0; j += inc)
+	{
+	  scm_gen_putc (' ', port);
+	  scm_intprint (SCM_VELTS (ra)[j], 10, port);
+	}
+      break;
+
+    case scm_tc7_svect:
+      if (n-- > 0)
+	scm_intprint (((short *)SCM_CDR (ra))[j], 10, port);
+      for (j += inc; n-- > 0; j += inc)
+	{
+	  scm_gen_putc (' ', port);
+	  scm_intprint (((short *)SCM_CDR (ra))[j], 10, port);
+	}
+      break;
+
+#ifdef SCM_FLOATS
+#ifdef SCM_SINGLES
+    case scm_tc7_fvect:
+      if (n-- > 0)
+	{
+	  SCM z = scm_makflo (1.0);
+	  SCM_FLO (z) = ((float *) SCM_VELTS (ra))[j];
+	  scm_floprint (z, port, writing);
+	  for (j += inc; n-- > 0; j += inc)
+	    {
+	      scm_gen_putc (' ', port);
+	      SCM_FLO (z) = ((float *) SCM_VELTS (ra))[j];
+	      scm_floprint (z, port, writing);
+	    }
+	}
+      break;
+#endif /*SCM_SINGLES*/
+    case scm_tc7_dvect:
+      if (n-- > 0)
+	{
+	  SCM z = scm_makdbl (1.0 / 3.0, 0.0);
+	  SCM_REAL (z) = ((double *) SCM_VELTS (ra))[j];
+	  scm_floprint (z, port, writing);
+	  for (j += inc; n-- > 0; j += inc)
+	    {
+	      scm_gen_putc (' ', port);
+	      SCM_REAL (z) = ((double *) SCM_VELTS (ra))[j];
+	      scm_floprint (z, port, writing);
+	    }
+	}
+      break;
+    case scm_tc7_cvect:
+      if (n-- > 0)
+	{
+	  SCM cz = scm_makdbl (0.0, 1.0), z = scm_makdbl (1.0 / 3.0, 0.0);
+	  SCM_REAL (z) = SCM_REAL (cz) = (((double *) SCM_VELTS (ra))[2 * j]);
+	  SCM_IMAG (cz) = ((double *) SCM_VELTS (ra))[2 * j + 1];
+	  scm_floprint ((0.0 == SCM_IMAG (cz) ? z : cz), port, writing);
+	  for (j += inc; n-- > 0; j += inc)
+	    {
+	      scm_gen_putc (' ', port);
+	      SCM_REAL (z) = SCM_REAL (cz) = ((double *) SCM_VELTS (ra))[2 * j];
+	      SCM_IMAG (cz) = ((double *) SCM_VELTS (ra))[2 * j + 1];
+	      scm_floprint ((0.0 == SCM_IMAG (cz) ? z : cz), port, writing);
+	    }
+	}
+      break;
+#endif /*SCM_FLOATS*/
+    }
+}
+
+
+#ifdef __STDC__
+int 
+scm_raprin1 (SCM exp, SCM port, int writing)
+#else
+int 
+scm_raprin1 (exp, port, writing)
+     SCM exp;
+     SCM port;
+     int writing;
+#endif
+{
+  SCM v = exp;
+  scm_sizet base = 0;
+  scm_gen_putc ('#', port);
+tail:
+  switch SCM_TYP7
+    (v)
+    {
+    case scm_tc7_smob:
+      {
+	long ndim = SCM_ARRAY_NDIM (v);
+	base = SCM_ARRAY_BASE (v);
+	v = SCM_ARRAY_V (v);
+	if (SCM_ARRAYP (v))
+
+	  {
+	    scm_gen_puts (scm_regular_string, "<enclosed-array ", port);
+	    rapr1 (exp, base, 0, port, writing);
+	    scm_gen_putc ('>', port);
+	    return 1;
+	  }
+	else
+	  {
+	    scm_intprint (ndim, 10, port);
+	    goto tail;
+	  }
+      }
+    case scm_tc7_bvect:
+      if (exp == v)
+	{			/* a uve, not an scm_array */
+	  register long i, j, w;
+	  scm_gen_putc ('*', port);
+	  for (i = 0; i < (SCM_LENGTH (exp)) / SCM_LONG_BIT; i++)
+	    {
+	      w = SCM_VELTS (exp)[i];
+	      for (j = SCM_LONG_BIT; j; j--)
+		{
+		  scm_gen_putc (w & 1 ? '1' : '0', port);
+		  w >>= 1;
+		}
+	    }
+	  j = SCM_LENGTH (exp) % SCM_LONG_BIT;
+	  if (j)
+	    {
+	      w = SCM_VELTS (exp)[SCM_LENGTH (exp) / SCM_LONG_BIT];
+	      for (; j; j--)
+		{
+		  scm_gen_putc (w & 1 ? '1' : '0', port);
+		  w >>= 1;
+		}
+	    }
+	  return 1;
+	}
+      else
+	scm_gen_putc ('b', port);
+      break;
+    case scm_tc7_string:
+      scm_gen_putc ('a', port);
+      break;
+    case scm_tc7_byvect:
+      scm_gen_puts (scm_regular_string, "bytes", port);
+      break;
+    case scm_tc7_uvect:
+      scm_gen_putc ('u', port);
+      break;
+    case scm_tc7_ivect:
+      scm_gen_putc ('e', port);
+      break;
+    case scm_tc7_svect:
+      scm_gen_puts (scm_regular_string, "short", port);
+      break;
+#ifdef LONGLONGS
+    case scm_tc7_llvect:
+      scm_gen_puts (scm_regular_string, "long_long", port);
+      break;
+#endif
+#ifdef SCM_FLOATS
+#ifdef SCM_SINGLES
+    case scm_tc7_fvect:
+      scm_gen_putc ('s', port);
+      break;
+#endif /*SCM_SINGLES*/
+    case scm_tc7_dvect:
+      scm_gen_putc ('i', port);
+      break;
+    case scm_tc7_cvect:
+      scm_gen_putc ('c', port);
+      break;
+#endif /*SCM_FLOATS*/
+    }
+  scm_gen_putc ('(', port);
+  rapr1 (exp, base, 0, port, writing);
+  scm_gen_putc (')', port);
+  return 1;
+}
+
+SCM_PROC(s_array_prototype, "array-prototype", 1, 0, 0, scm_array_prototype);
+#ifdef __STDC__
+SCM 
+scm_array_prototype (SCM ra)
+#else
+SCM 
+scm_array_prototype (ra)
+     SCM ra;
+#endif
+{
+  int enclosed = 0;
+  SCM_ASRTGO (SCM_NIMP (ra), badarg);
+loop:
+  switch SCM_TYP7
+    (ra)
+    {
+    default:
+    badarg:scm_wta (ra, (char *) SCM_ARG1, s_array_prototype);
+    case scm_tc7_smob:
+      SCM_ASRTGO (SCM_ARRAYP (ra), badarg);
+      if (enclosed++)
+	return SCM_UNSPECIFIED;
+      ra = SCM_ARRAY_V (ra);
+      goto loop;
+    case scm_tc7_vector:
+      return SCM_EOL;
+    case scm_tc7_bvect:
+      return SCM_BOOL_T;
+    case scm_tc7_string:
+      return SCM_MAKICHR ('a');
+    case scm_tc7_byvect:
+      return SCM_MAKICHR ('\0');
+    case scm_tc7_uvect:
+      return SCM_MAKINUM (1L);
+    case scm_tc7_ivect:
+      return SCM_MAKINUM (-1L);
+    case scm_tc7_svect:
+      return SCM_CDR (scm_intern ("s", 1));
+#ifdef LONGLONGS
+    case scm_tc7_llvect:
+      return SCM_CDR (scm_intern ("l", 1));
+#endif
+#ifdef SCM_FLOATS
+#ifdef SCM_SINGLES
+    case scm_tc7_fvect:
+      return scm_makflo (1.0);
+#endif
+    case scm_tc7_dvect:
+      return scm_makdbl (1.0 / 3.0, 0.0);
+    case scm_tc7_cvect:
+      return scm_makdbl (0.0, 1.0);
+#endif
+    }
+}
+
+#ifdef __STDC__
+static SCM
+markra (SCM ptr)
+#else
+static SCM
+markra (ptr)
+     SCM ptr;
+#endif
+{
+  if SCM_GC8MARKP
+    (ptr) return SCM_BOOL_F;
+  SCM_SETGC8MARK (ptr);
+  return SCM_ARRAY_V (ptr);
+}
+
+#ifdef __STDC__
+static scm_sizet
+freera (SCM ptr)
+#else
+static scm_sizet
+freera (ptr)
+     SCM ptr;
+#endif
+{
+  scm_must_free (SCM_CHARS (ptr));
+  return sizeof (scm_array) + SCM_ARRAY_NDIM (ptr) * sizeof (scm_array_dim);
+}
+
+static scm_smobfuns rasmob =
+{markra, freera, scm_raprin1, scm_array_equal_p};
+
+
+/* This must be done after scm_init_scl() */
+#ifdef __STDC__
+void
+scm_init_unif (void)
+#else
+void
+scm_init_unif ()
+#endif
+{
+#include "unif.x"
+  scm_tc16_array = scm_newsmob (&rasmob);
+  scm_add_feature ("array");
+}
+
+#else /* ARRAYS */
+
+#ifdef __STDC__
+int 
+scm_raprin1 (SCM exp, SCM port, int writing)
+#else
+int 
+scm_raprin1 (exp, port, writing)
+     SCM exp;
+     SCM port;
+     int writing;
+#endif
+{
+  return 0;
+}
+
+#ifdef __STDC__
+SCM 
+scm_istr2bve (char *str, long len)
+#else
+SCM 
+scm_istr2bve (str, len)
+     char *str;
+     long len;
+#endif
+{
+  return SCM_BOOL_F;
+}
+
+#ifdef __STDC__
+SCM 
+scm_array_equal_p (SCM ra0, SCM ra1)
+#else
+SCM 
+scm_array_equal_p (ra0, ra1)
+     SCM ra0;
+     SCM ra1;
+#endif
+{
+  return SCM_BOOL_F;
+}
+
+void 
+scm_init_unif ()
+{
+  scm_make_subr (s_resizuve, scm_tc7_subr_2, scm_vector_set_length_x);
+}
+
+#endif /* ARRAYS */
+
+
+
+
diff --git a/libguile/unif.h b/libguile/unif.h
new file mode 100644
index 000000000..077621c6f
--- /dev/null
+++ b/libguile/unif.h
@@ -0,0 +1,164 @@
+/* classes: h_files */
+
+#ifndef UNIFH
+#define UNIFH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+
+
+typedef struct scm_array
+{
+  SCM v;
+  scm_sizet base;
+} scm_array;
+
+typedef struct scm_array_dim
+{
+  long lbnd;
+  long ubnd;
+  long inc;
+} scm_array_dim;
+
+
+extern long scm_tc16_array;
+#define SCM_ARRAYP(a) 		(scm_tc16_array==SCM_TYP16(a))
+#define SCM_ARRAY_V(a) 		(((scm_array *)SCM_CDR(a))->v)
+#define SCM_ARRAY_NDIM(x) 	((scm_sizet)(SCM_CAR(x)>>17))
+#define SCM_ARRAY_CONTIGUOUS 	0x10000
+#define SCM_ARRAY_CONTP(x) 	(SCM_ARRAY_CONTIGUOUS & (int)SCM_CAR(x))
+#define SCM_ARRAY_BASE(a) 	(((scm_array *)SCM_CDR(a))->base)
+#define SCM_ARRAY_DIMS(a) 	((scm_array_dim *)(SCM_CHARS(a)+sizeof(scm_array))) 
+
+#define SCM_HUGE_LENGTH(x) (SCM_LENGTH_MAX==SCM_LENGTH(x) ? *((long *)SCM_VELTS(x)) : SCM_LENGTH(x))
+
+
+#ifdef __STDC__
+extern SCM scm_vector_set_length_x (SCM vect, SCM len);
+extern SCM scm_makflo (float x);
+extern SCM scm_make_uve (long k, SCM prot);
+extern SCM scm_uniform_vector_length (SCM v);
+extern SCM scm_array_p (SCM v, SCM prot);
+extern SCM scm_array_rank (SCM ra);
+extern SCM scm_array_dimensions (SCM ra);
+extern long scm_aind (SCM ra, SCM args, char *what);
+extern SCM scm_make_ra (int ndim);
+extern SCM scm_shap2ra (SCM args, char *what);
+extern SCM scm_dimensions_to_uniform_array (SCM dims, SCM prot, SCM fill);
+extern void scm_ra_set_contp (SCM ra);
+extern SCM scm_make_shared_array (SCM oldra, SCM mapfunc, SCM dims);
+extern SCM scm_transpose_array (SCM args);
+extern SCM scm_enclose_array (SCM axes);
+extern SCM scm_array_in_bounds_p (SCM args);
+extern SCM scm_uniform_vector_ref (SCM v, SCM args);
+extern SCM scm_cvref (SCM v, scm_sizet pos, SCM last);
+extern SCM scm_array_set_x (SCM v, SCM obj, SCM args);
+extern SCM scm_array_contents (SCM ra, SCM strict);
+extern SCM scm_ra2contig (SCM ra, int copy);
+extern SCM scm_uniform_array_read_x (SCM ra, SCM port);
+extern SCM scm_uniform_array_write (SCM v, SCM port);
+extern SCM scm_bit_count (SCM item, SCM seq);
+extern SCM scm_bit_position (SCM item, SCM v, SCM k);
+extern SCM scm_bit_set_star_x (SCM v, SCM kv, SCM obj);
+extern SCM scm_bit_count_star (SCM v, SCM kv, SCM obj);
+extern SCM scm_bit_invert_x (SCM v);
+extern SCM scm_string_upcase_x (SCM v);
+extern SCM scm_string_downcase_x (SCM v);
+extern SCM scm_istr2bve (char *str, long len);
+extern SCM scm_array_to_list (SCM v);
+extern SCM scm_list_to_uniform_array (SCM ndim, SCM prot, SCM lst);
+extern int scm_raprin1 (SCM exp, SCM port, int writing);
+extern SCM scm_array_prototype (SCM ra);
+extern void scm_init_unif (void);
+extern int scm_raprin1 (SCM exp, SCM port, int writing);
+extern SCM scm_istr2bve (char *str, long len);
+extern SCM scm_array_equal_p (SCM ra0, SCM ra1);
+
+#else /* STDC */
+extern SCM scm_vector_set_length_x ();
+extern SCM scm_makflo ();
+extern SCM scm_make_uve ();
+extern SCM scm_uniform_vector_length ();
+extern SCM scm_array_p ();
+extern SCM scm_array_rank ();
+extern SCM scm_array_dimensions ();
+extern long scm_aind ();
+extern SCM scm_make_ra ();
+extern SCM scm_shap2ra ();
+extern SCM scm_dimensions_to_uniform_array ();
+extern void scm_ra_set_contp ();
+extern SCM scm_make_shared_array ();
+extern SCM scm_transpose_array ();
+extern SCM scm_enclose_array ();
+extern SCM scm_array_in_bounds_p ();
+extern SCM scm_uniform_vector_ref ();
+extern SCM scm_cvref ();
+extern SCM scm_array_set_x ();
+extern SCM scm_array_contents ();
+extern SCM scm_ra2contig ();
+extern SCM scm_uniform_array_read_x ();
+extern SCM scm_uniform_array_write ();
+extern SCM scm_bit_count ();
+extern SCM scm_bit_position ();
+extern SCM scm_bit_set_star_x ();
+extern SCM scm_bit_count_star ();
+extern SCM scm_bit_invert_x ();
+extern SCM scm_string_upcase_x ();
+extern SCM scm_string_downcase_x ();
+extern SCM scm_istr2bve ();
+extern SCM scm_array_to_list ();
+extern SCM scm_list_to_uniform_array ();
+extern int scm_raprin1 ();
+extern SCM scm_array_prototype ();
+extern void scm_init_unif ();
+extern int scm_raprin1 ();
+extern SCM scm_istr2bve ();
+extern SCM scm_array_equal_p ();
+
+#endif /* STDC */
+
+
+
+
+
+#endif  /* UNIFH */
diff --git a/libguile/variable.c b/libguile/variable.c
new file mode 100644
index 000000000..984de26db
--- /dev/null
+++ b/libguile/variable.c
@@ -0,0 +1,282 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+#ifdef __STDC__
+static scm_sizet
+free_var (SCM obj)
+#else
+static scm_sizet
+free_var (obj)
+     SCM obj;
+#endif
+{
+  return 0;
+}
+
+
+#ifdef __STDC__
+static int
+prin_var (SCM exp, SCM port, int writing)
+#else
+static int
+prin_var (exp, port, writing)
+     SCM exp;
+     SCM port;
+     int writing;
+#endif
+{
+  scm_gen_puts (scm_regular_string, "#<variable ", port);
+  scm_intprint(exp, 16, port);
+  {
+    SCM val_cell;
+    val_cell = SCM_CDR(exp);
+    if (SCM_CAR (val_cell) != SCM_UNDEFINED)
+      {
+	scm_gen_puts (scm_regular_string, " name: ", port);
+	scm_iprin1 (SCM_CAR (val_cell), port, writing);
+      }
+    scm_gen_puts (scm_regular_string, " binding: ", port);
+    scm_iprin1 (SCM_CDR (val_cell), port, writing);
+  }
+  scm_gen_putc('>', port);
+  return 1;
+}
+
+#ifdef __STDC__
+static SCM 
+scm_markvar (SCM ptr)
+#else
+static SCM 
+scm_markvar (ptr)
+     SCM ptr;
+#endif
+{
+  if (SCM_GC8MARKP (ptr))
+    return SCM_BOOL_F;
+  SCM_SETGC8MARK (ptr);
+  return SCM_CDR (ptr);
+}
+
+int scm_tc16_variable;
+static scm_smobfuns variable_smob = {scm_markvar, free_var, prin_var, 0};
+
+
+static SCM variable_sym;
+
+#ifdef __STDC__
+static SCM
+make_vcell_variable (SCM vcell)
+#else
+static SCM
+make_vcell_variable (vcell)
+     SCM vcell;
+#endif
+{
+  SCM answer;
+  SCM_NEWCELL(answer);
+  SCM_REDEFER_INTS;
+  SCM_CAR(answer) = scm_tc16_variable;
+  SCM_CDR(answer) = vcell;
+  SCM_REALLOW_INTS;
+  return answer;
+}
+
+SCM_PROC(s_make_variable, "make-variable", 2, 0, 0, scm_make_variable);
+#ifdef __STDC__
+SCM
+scm_make_variable (SCM init, SCM name_hint)
+#else
+SCM
+scm_make_variable (init, name_hint)
+     SCM init;
+     SCM name_hint;
+#endif
+{
+  SCM val_cell;
+  SCM_NEWCELL(val_cell);
+  SCM_DEFER_INTS;
+  SCM_CAR(val_cell) = name_hint;
+  SCM_CDR(val_cell) = init;
+  SCM_ALLOW_INTS;
+  return make_vcell_variable (val_cell);
+}
+
+
+SCM_PROC(s_make_undefined_variable, "make-undefined-variable", 0, 1, 0, scm_make_undefined_variable);
+#ifdef __STDC__
+SCM
+scm_make_undefined_variable (SCM name_hint)
+#else
+SCM
+scm_make_undefined_variable (name_hint)
+     SCM name_hint;
+#endif
+{
+  SCM vcell;
+
+  if (name_hint == SCM_UNDEFINED)
+    name_hint = variable_sym;
+
+  SCM_NEWCELL (vcell);
+  SCM_DEFER_INTS;
+  SCM_CAR (vcell) = name_hint;
+  SCM_CDR (vcell) = SCM_UNDEFINED;
+  SCM_ALLOW_INTS;
+  return make_vcell_variable (vcell);
+}
+
+
+SCM_PROC(s_variable_p, "variable?", 1, 0, 0, scm_variable_p);
+#ifdef __STDC__
+SCM
+scm_variable_p (SCM obj)
+#else
+SCM
+scm_variable_p (obj)
+     SCM obj;
+#endif
+{
+  return ( (SCM_NIMP(obj) && SCM_VARIABLEP (obj))
+	  ? SCM_BOOL_T
+	  : SCM_BOOL_F);
+}
+
+
+SCM_PROC(s_variable_ref, "variable-ref", 1, 0, 0, scm_variable_ref);
+#ifdef __STDC__
+SCM
+scm_variable_ref (SCM var)
+#else
+SCM
+scm_variable_ref (var)
+     SCM var;
+#endif
+{
+  SCM_ASSERT (SCM_NIMP(var) && SCM_VARIABLEP(var), var, SCM_ARG1, s_variable_ref);
+  return SCM_CDR (SCM_CDR (var));
+}
+
+
+
+SCM_PROC(s_variable_set_x, "variable-set!", 2, 0, 0, scm_variable_set_x);
+#ifdef __STDC__
+SCM
+scm_variable_set_x (SCM var, SCM val)
+#else
+SCM
+scm_variable_set_x (var, val)
+     SCM var;
+     SCM val;
+#endif
+{
+  SCM_ASSERT (SCM_NIMP(var) && SCM_VARIABLEP (var), var, SCM_ARG1, s_variable_set_x);
+  SCM_CDR (SCM_CDR (var)) = val;
+  return SCM_UNSPECIFIED;
+}
+
+
+SCM_PROC(s_builtin_variable, "builtin-variable", 1, 0, 0, scm_builtin_variable);
+#ifdef __STDC__
+SCM
+scm_builtin_variable (SCM name)
+#else
+SCM
+scm_builtin_variable (name)
+     SCM name;
+#endif
+{
+  SCM vcell;
+  SCM var_slot;
+
+  SCM_ASSERT (SCM_NIMP (name) && SCM_SYMBOLP (name), name, SCM_ARG1, s_builtin_variable);
+  vcell = scm_sym2vcell (name, SCM_BOOL_F, SCM_BOOL_T);
+  if (vcell == SCM_BOOL_F)
+    return SCM_BOOL_F;
+
+  scm_intern_symbol (scm_symhash_vars, name);
+  var_slot = scm_sym2ovcell (name, scm_symhash_vars);
+
+  SCM_DEFER_INTS;
+  if (   SCM_IMP (SCM_CDR (var_slot))
+      || (SCM_VARVCELL (var_slot) != vcell))
+    SCM_CDR (var_slot) = make_vcell_variable (vcell);
+  SCM_ALLOW_INTS;
+
+  return SCM_CDR (var_slot);
+}
+
+
+SCM_PROC(s_variable_bound_p, "variable-bound?", 1, 0, 0, scm_variable_bound_p);
+#ifdef __STDC__
+SCM 
+scm_variable_bound_p (SCM var)
+#else
+SCM 
+scm_variable_bound_p (var)
+     SCM var;
+#endif
+{
+  SCM_ASSERT (SCM_NIMP(var) && SCM_VARIABLEP (var), var, SCM_ARG1, s_variable_bound_p);
+  return (SCM_UNBNDP (SCM_CDR (SCM_VARVCELL (var)))
+	  ? SCM_BOOL_F
+	  : SCM_BOOL_T);
+}
+
+
+
+#ifdef __STDC__
+void
+scm_init_variable (void)
+#else
+void
+scm_init_variable ()
+#endif
+{
+  scm_tc16_variable = scm_newsmob (&variable_smob);
+  variable_sym = SCM_CAR (scm_sysintern ("anonymous-variable", SCM_UNDEFINED));
+#include "variable.x"
+}
+
diff --git a/libguile/variable.h b/libguile/variable.h
new file mode 100644
index 000000000..b9d84fd8c
--- /dev/null
+++ b/libguile/variable.h
@@ -0,0 +1,87 @@
+/* classes: h_files */
+
+#ifndef VARIABLEH
+#define VARIABLEH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+#include "__scm.h"
+
+
+
+
+/* Variables 
+ */
+extern int scm_tc16_variable;
+
+#define SCM_VARVCELL(V) 	SCM_CDR(V)
+#define SCM_VARIABLEP(X)   	(scm_tc16_variable == SCM_CAR(X))
+#define SCM_UDSCM_VARIABLEP(X) 	(SCM_VARIABLEP(X) && SCM_UNBNDP (SCM_CDR (SCM_VARVCELL (X))))
+#define SCM_DEFSCM_VARIABLEP(X) 	(SCM_VARIABLEP(X) && !SCM_UNBNDP (SCM_CDR (SCM_VARVCELL (X))))
+
+
+#ifdef __STDC__
+extern SCM scm_make_variable (SCM init, SCM name_hint);
+extern SCM scm_make_udvariable (SCM name_hint);
+extern SCM scm_variable_p (SCM obj);
+extern SCM scm_variable_ref (SCM var);
+extern SCM scm_variable_set_x (SCM var, SCM val);
+extern SCM scm_builtin_variable (SCM name);
+extern SCM scm_variable_bound_p (SCM var);
+extern void scm_init_variable (void);
+
+#else /* STDC */
+extern SCM scm_make_variable ();
+extern SCM scm_make_udvariable ();
+extern SCM scm_variable_p ();
+extern SCM scm_variable_ref ();
+extern SCM scm_variable_set_x ();
+extern SCM scm_builtin_variable ();
+extern SCM scm_variable_bound_p ();
+extern void scm_init_variable ();
+
+#endif /* STDC */
+
+
+
+
+
+#endif  /* VARIABLEH */
diff --git a/libguile/vectors.c b/libguile/vectors.c
new file mode 100644
index 000000000..c30a8590a
--- /dev/null
+++ b/libguile/vectors.c
@@ -0,0 +1,317 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+
+
+SCM_PROC(s_vector_p, "vector?", 1, 0, 0, scm_vector_p);
+#ifdef __STDC__
+SCM
+scm_vector_p(SCM x)
+#else
+SCM
+scm_vector_p(x)
+     SCM x;
+#endif
+{
+  if SCM_IMP(x) return SCM_BOOL_F;
+  return SCM_VECTORP(x) ? SCM_BOOL_T : SCM_BOOL_F;
+}
+
+SCM_PROC(s_vector_length, "vector-length", 1, 0, 0, scm_vector_length);
+#ifdef __STDC__
+SCM
+scm_vector_length(SCM v)
+#else
+SCM
+scm_vector_length(v)
+     SCM v;
+#endif
+{
+  SCM_ASSERT(SCM_NIMP(v) && SCM_VECTORP(v), v, SCM_ARG1, s_vector_length);
+  return SCM_MAKINUM(SCM_LENGTH(v));
+}
+
+SCM_PROC(s_list_to_vector, "list->vector", 1, 0, 0, scm_vector);
+SCM_PROC(s_vector, "vector", 0, 0, 1, scm_vector);
+#ifdef __STDC__
+SCM
+scm_vector(SCM l)
+#else
+SCM
+scm_vector(l)
+     SCM l;
+#endif
+{
+  SCM res;
+  register SCM *data;
+  long i = scm_ilength(l);
+  SCM_ASSERT(i >= 0, l, SCM_ARG1, s_vector);
+  res = scm_make_vector(SCM_MAKINUM(i), SCM_UNSPECIFIED, SCM_UNDEFINED);
+  data = SCM_VELTS(res);
+  for(;i && SCM_NIMP(l);--i, l = SCM_CDR(l))
+    *data++ = SCM_CAR(l);
+  return res;
+}
+
+SCM_PROC(s_vector_ref, "vector-ref", 2, 0, 0, scm_vector_ref);
+#ifdef __STDC__
+SCM
+scm_vector_ref(SCM v, SCM k)
+#else
+SCM
+scm_vector_ref(v, k)
+     SCM v;
+     SCM k;
+#endif
+{
+  SCM_ASSERT(SCM_NIMP(v) && SCM_VECTORP(v), v, SCM_ARG1, s_vector_ref);
+  SCM_ASSERT(SCM_INUMP(k), k, SCM_ARG2, s_vector_ref);
+  SCM_ASSERT((SCM_INUM(k) < SCM_LENGTH(v)) && (SCM_INUM(k) >= 0), k, SCM_OUTOFRANGE, s_vector_ref);
+  return SCM_VELTS(v)[((long) SCM_INUM(k))];
+}
+
+
+SCM_PROC(s_vector_set_x, "vector-set!", 3, 0, 0, scm_vector_set_x);
+#ifdef __STDC__
+SCM
+scm_vector_set_x(SCM v, SCM k, SCM obj)
+#else
+SCM
+scm_vector_set_x(v, k, obj)
+     SCM v;
+     SCM k;
+     SCM obj;
+#endif
+{
+  SCM_ASSERT(SCM_NIMP(v) && SCM_VECTORP(v), v, SCM_ARG1, s_vector_set_x);
+  SCM_ASSERT(SCM_INUMP(k), k, SCM_ARG2, s_vector_set_x);
+  SCM_ASSERT((SCM_INUM(k) < SCM_LENGTH(v)) && (SCM_INUM(k) >= 0), k, SCM_OUTOFRANGE, s_vector_set_x);
+  SCM_VELTS(v)[((long) SCM_INUM(k))] = obj;
+  return obj;
+}
+
+
+SCM_PROC(s_make_vector, "make-vector", 1, 2, 0, scm_make_vector);
+#ifdef __STDC__
+SCM
+scm_make_vector(SCM k, SCM fill, SCM multip)
+#else
+SCM
+scm_make_vector(k, fill, multip)
+     SCM k;
+     SCM fill;
+     SCM multip;
+#endif
+{
+  SCM v;
+  int multi;
+  register long i;
+  register long j;
+  register SCM *velts;
+
+  SCM_ASSERT(SCM_INUMP(k) && (0 <= SCM_INUM (k)), k, SCM_ARG1, s_make_vector);
+  if (SCM_UNBNDP(fill))
+    fill = SCM_EOL;
+  multi = !(SCM_UNBNDP(multip) || SCM_FALSEP(multip));
+  i = SCM_INUM(k);
+  SCM_NEWCELL(v);
+  SCM_DEFER_INTS;
+  SCM_SETCHARS(v, scm_must_malloc(i?(long)(i*sizeof(SCM)):1L, s_vector));
+  SCM_SETLENGTH(v, i, scm_tc7_vector);
+  velts = SCM_VELTS(v);
+  j = 0;
+  if (multi)
+    {
+      while ((fill != SCM_EOL) && (j < i))
+	{
+	  (velts)[j++] = SCM_CAR (fill);
+	  fill = SCM_CDR (fill);
+	}
+    }
+  while(--i >= j) (velts)[i] = fill;
+  SCM_ALLOW_INTS;
+  return v;
+}
+
+
+SCM_PROC(s_vector_to_list, "vector->list", 1, 0, 0, scm_vector_to_list);
+#ifdef __STDC__
+SCM
+scm_vector_to_list(SCM v)
+#else
+SCM
+scm_vector_to_list(v)
+     SCM v;
+#endif
+{
+  SCM res = SCM_EOL;
+  long i;
+  SCM *data;
+  SCM_ASSERT(SCM_NIMP(v) && SCM_VECTORP(v), v, SCM_ARG1, s_vector_to_list);
+  data = SCM_VELTS(v);
+  for(i = SCM_LENGTH(v)-1;i >= 0;i--) res = scm_cons(data[i], res);
+  return res;
+}
+
+
+SCM_PROC(s_vector_fill_x, "vector-fill!", 2, 0, 0, scm_vector_fill_x);
+#ifdef __STDC__
+SCM
+scm_vector_fill_x(SCM v, SCM fill_x)
+#else
+SCM
+scm_vector_fill_x(v, fill_x)
+     SCM v;
+     SCM fill_x;
+#endif
+{
+  register long i;
+  register SCM *data;
+  SCM_ASSERT(SCM_NIMP(v) && SCM_VECTORP(v), v, SCM_ARG1, s_vector_fill_x);
+  data = SCM_VELTS(v);
+  for(i = SCM_LENGTH(v)-1;i >= 0;i--) data[i] = fill_x;
+  return SCM_UNSPECIFIED;
+}
+
+
+#ifdef __STDC__
+SCM
+scm_vector_equal_p(SCM x, SCM y)
+#else
+SCM
+scm_vector_equal_p(x, y)
+     SCM x;
+     SCM y;
+#endif
+{
+  long i;
+  for(i = SCM_LENGTH(x)-1;i >= 0;i--)
+    if (SCM_FALSEP(scm_equal_p(SCM_VELTS(x)[i], SCM_VELTS(y)[i])))
+      return SCM_BOOL_F;
+  return SCM_BOOL_T;
+}
+
+
+SCM_PROC (s_vector_move_left_x, "vector-move-left!", 5, 0, 0, scm_vector_move_left_x);
+#ifdef __STDC__
+SCM
+scm_vector_move_left_x (SCM vec1, SCM start1, SCM end1, SCM vec2, SCM start2)
+#else
+SCM
+scm_vector_move_left_x (vec1, start1, end1, vec2, start2)
+     SCM vec1;
+     SCM start1;
+     SCM end1;
+     SCM vec2;
+     SCM start2;
+#endif
+{
+  long i;
+  long j;
+  long e;
+  
+  SCM_ASSERT (SCM_NIMP (vec1) && SCM_VECTORP (vec1), vec1, SCM_ARG1, s_vector_move_left_x);
+  SCM_ASSERT (SCM_INUMP (start1), start1, SCM_ARG2, s_vector_move_left_x);
+  SCM_ASSERT (SCM_INUMP (end1), end1, SCM_ARG3, s_vector_move_left_x);
+  SCM_ASSERT (SCM_NIMP (vec2) && SCM_VECTORP (vec2), vec2, SCM_ARG4, s_vector_move_left_x);
+  SCM_ASSERT (SCM_INUMP (start2), start2, SCM_ARG5, s_vector_move_left_x);
+  i = SCM_INUM (start1);
+  j = SCM_INUM (start2);
+  e = SCM_INUM (end1);
+  SCM_ASSERT (i <= SCM_LENGTH (vec1) && i >= 0, start1, SCM_OUTOFRANGE, s_vector_move_left_x);
+  SCM_ASSERT (j <= SCM_LENGTH (vec2) && j >= 0, start2, SCM_OUTOFRANGE, s_vector_move_left_x);
+  SCM_ASSERT (e <= SCM_LENGTH (vec1) && e >= 0, end1, SCM_OUTOFRANGE, s_vector_move_left_x);
+  SCM_ASSERT (e-i+j <= SCM_LENGTH (vec2), start2, SCM_OUTOFRANGE, s_vector_move_left_x);
+  while (i<e) SCM_VELTS (vec2)[j++] = SCM_VELTS (vec1)[i++];
+  return SCM_UNSPECIFIED;
+}
+
+SCM_PROC (s_vector_move_right_x, "vector-move-right!", 5, 0, 0, scm_vector_move_right_x);
+#ifdef __STDC__
+SCM
+scm_vector_move_right_x (SCM vec1, SCM start1, SCM end1, SCM vec2, SCM start2)
+#else
+SCM
+scm_vector_move_right_x (vec1, start1, end1, vec2, start2)
+     SCM vec1;
+     SCM start1;
+     SCM end1;
+     SCM vec2;
+     SCM start2;
+#endif
+{
+  long i;
+  long j;
+  long e;
+
+  SCM_ASSERT (SCM_NIMP (vec1) && SCM_VECTORP (vec1), vec1, SCM_ARG1, s_vector_move_right_x);
+  SCM_ASSERT (SCM_INUMP (start1), start1, SCM_ARG2, s_vector_move_right_x);
+  SCM_ASSERT (SCM_INUMP (end1), end1, SCM_ARG3, s_vector_move_right_x);
+  SCM_ASSERT (SCM_NIMP (vec2) && SCM_VECTORP (vec2), vec2, SCM_ARG4, s_vector_move_right_x);
+  SCM_ASSERT (SCM_INUMP (start2), start2, SCM_ARG5, s_vector_move_right_x);
+  i = SCM_INUM (start1);
+  j = SCM_INUM (start2);
+  e = SCM_INUM (end1);
+  SCM_ASSERT (i <= SCM_LENGTH (vec1) && i >= 0, start1, SCM_OUTOFRANGE, s_vector_move_right_x);
+  SCM_ASSERT (j <= SCM_LENGTH (vec2) && j >= 0, start2, SCM_OUTOFRANGE, s_vector_move_right_x);
+  SCM_ASSERT (e <= SCM_LENGTH (vec1) && e >= 0, end1, SCM_OUTOFRANGE, s_vector_move_right_x);
+  SCM_ASSERT ((j = e-i+j) <= SCM_LENGTH (vec2), start2, SCM_OUTOFRANGE, s_vector_move_right_x);
+  while (i<e) SCM_VELTS (vec2)[--j] = SCM_VELTS (vec1)[--e];
+  return SCM_UNSPECIFIED;
+}
+
+
+#ifdef __STDC__
+void
+scm_init_vectors (void)
+#else
+void
+scm_init_vectors ()
+#endif
+{
+#include "vectors.x"
+}
+
diff --git a/libguile/vectors.h b/libguile/vectors.h
new file mode 100644
index 000000000..3cf5c6478
--- /dev/null
+++ b/libguile/vectors.h
@@ -0,0 +1,82 @@
+/* classes: h_files */
+
+#ifndef VECTORSH
+#define VECTORSH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+
+
+
+#define SCM_VECTORP(x) (SCM_TYP7S(x)==scm_tc7_vector)
+#define SCM_NVECTORP(x) (!SCM_VECTORP(x))
+#define SCM_VELTS(x) ((SCM *)SCM_CDR(x))
+#define SCM_SETVELTS SCM_SETCDR
+
+
+#ifdef __STDC__
+extern SCM scm_vector_p(SCM x);
+extern SCM scm_vector_length(SCM v);
+extern SCM scm_vector(SCM l);
+extern SCM scm_vector_ref(SCM v, SCM k);
+extern SCM scm_vector_set_x(SCM v, SCM k, SCM obj);
+extern SCM scm_make_vector(SCM k, SCM fill, SCM multi);
+extern SCM scm_vector_to_list(SCM v);
+extern SCM scm_vector_fill_x(SCM v, SCM fill_x);
+extern SCM scm_vector_equal_p(SCM x, SCM y);
+extern void scm_init_vectors (void);
+
+#else /* STDC */
+extern SCM scm_vector_p();
+extern SCM scm_vector_length();
+extern SCM scm_vector();
+extern SCM scm_vector_ref();
+extern SCM scm_vector_set_x();
+extern SCM scm_make_vector();
+extern SCM scm_vector_to_list();
+extern SCM scm_vector_fill_x();
+extern SCM scm_vector_equal_p();
+extern void scm_init_vectors ();
+
+#endif /* STDC */
+#endif  /* VECTORSH */
diff --git a/libguile/vports.c b/libguile/vports.c
new file mode 100644
index 000000000..dbb67cbfe
--- /dev/null
+++ b/libguile/vports.c
@@ -0,0 +1,241 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+
+/* {Ports - soft ports}
+ * 
+ */
+
+
+#ifdef __STDC__
+static int 
+prinsfpt (SCM exp, SCM port, int writing)
+#else
+static int 
+prinsfpt (exp, port, writing)
+     SCM exp;
+     SCM port;
+     int writing;
+#endif
+{
+  scm_prinport (exp, port, "soft");
+  return !0;
+}
+
+/* sfputc sfwrite sfputs sfclose 
+ * are called within a SCM_SYSCALL.  
+ *
+ * So we need to set errno to 0 before returning.  sfflush
+ * may be called within a SCM_SYSCALL.  So we need to set errno to 0
+ * before returning.
+ */
+
+#ifdef __STDC__
+static int 
+sfputc (int c, SCM p)
+#else
+static int 
+sfputc (c, p)
+     int c;
+     SCM p;
+#endif
+{
+  scm_apply (SCM_VELTS (p)[0], SCM_MAKICHR (c), scm_listofnull);
+  errno = 0;
+  return c;
+}
+
+#ifdef __STDC__
+static scm_sizet 
+sfwrite (char *str, scm_sizet siz, scm_sizet num, SCM p)
+#else
+static scm_sizet 
+sfwrite (str, siz, num, p)
+     char *str;
+     scm_sizet siz;
+     scm_sizet num;
+     SCM p;
+#endif
+{
+  SCM sstr;
+  sstr = scm_makfromstr (str, siz * num, 0);
+  scm_apply (SCM_VELTS (p)[1], sstr, scm_listofnull);
+  errno = 0;
+  return num;
+}
+
+#ifdef __STDC__
+static int 
+sfputs (char *s, SCM p)
+#else
+static int 
+sfputs (s, p)
+     char *s;
+     SCM p;
+#endif
+{
+  sfwrite (s, 1, strlen (s), p);
+  return 0;
+}
+
+#ifdef __STDC__
+static int 
+sfflush (SCM stream)
+#else
+static int 
+sfflush (stream)
+     SCM stream;
+#endif
+{
+  SCM f = SCM_VELTS (stream)[2];
+  if (SCM_BOOL_F == f)
+    return 0;
+  f = scm_apply (f, SCM_EOL, SCM_EOL);
+  errno = 0;
+  return SCM_BOOL_F == f ? EOF : 0;
+}
+
+#ifdef __STDC__
+static int 
+sfgetc (SCM p)
+#else
+static int 
+sfgetc (p)
+     SCM p;
+#endif
+{
+  SCM ans;
+  ans = scm_apply (SCM_VELTS (p)[3], SCM_EOL, SCM_EOL);
+  errno = 0;
+  if (SCM_FALSEP (ans) || SCM_EOF_VAL == ans)
+    return EOF;
+  SCM_ASSERT (SCM_ICHRP (ans), ans, SCM_ARG1, "getc");
+  return SCM_ICHR (ans);
+}
+
+#ifdef __STDC__
+static int 
+sfclose (SCM p)
+#else
+static int 
+sfclose (p)
+     SCM p;
+#endif
+{
+  SCM f = SCM_VELTS (p)[4];
+  if (SCM_BOOL_F == f)
+    return 0;
+  f = scm_apply (f, SCM_EOL, SCM_EOL);
+  errno = 0;
+  return SCM_BOOL_F == f ? EOF : 0;
+}
+
+
+
+SCM_PROC(s_make_soft_port, "make-soft-port", 2, 0, 0, scm_make_soft_port);
+#ifdef __STDC__
+SCM 
+scm_make_soft_port (SCM pv, SCM modes)
+#else
+SCM 
+scm_make_soft_port (pv, modes)
+     SCM pv;
+     SCM modes;
+#endif
+{
+  struct scm_port_table * pt;
+  SCM z;
+  SCM_ASSERT (SCM_NIMP (pv) && SCM_VECTORP (pv) && 5 == SCM_LENGTH (pv), pv, SCM_ARG1, s_make_soft_port);
+  SCM_ASSERT (SCM_NIMP (modes) && SCM_STRINGP (modes), modes, SCM_ARG2, s_make_soft_port);
+  SCM_NEWCELL (z);
+  SCM_DEFER_INTS;
+  pt = scm_add_to_port_table (z);
+  SCM_CAR (z) = scm_tc16_sfport | scm_mode_bits (SCM_CHARS (modes));
+  SCM_SETPTAB_ENTRY (z, pt);
+  SCM_SETSTREAM (z, pv);
+  SCM_ALLOW_INTS;
+  return z;
+}
+
+#ifdef __STDC__
+static int 
+noop0 (FILE *stream)
+#else
+static int 
+noop0 (stream)
+     FILE *stream;
+#endif
+{
+  return 0;
+}
+
+
+scm_ptobfuns scm_sfptob =
+{
+  scm_markstream,
+  noop0,
+  prinsfpt,
+  0,
+  sfputc,
+  sfputs,
+  sfwrite,
+  sfflush,
+  sfgetc,
+  sfclose
+};
+
+
+#ifdef __STDC__
+void
+scm_init_vports (void)
+#else
+void
+scm_init_vports ()
+#endif
+{
+#include "vports.x"
+}
+
diff --git a/libguile/vports.h b/libguile/vports.h
new file mode 100644
index 000000000..17a50fa57
--- /dev/null
+++ b/libguile/vports.h
@@ -0,0 +1,70 @@
+/* classes: h_files */
+
+#ifndef VPORTSH
+#define VPORTSH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+
+extern scm_ptobfuns scm_sfptob;
+
+
+
+
+
+#ifdef __STDC__
+extern SCM scm_make_soft_port (SCM pv, SCM modes);
+extern void scm_init_vports (void);
+
+#else /* STDC */
+extern SCM scm_make_soft_port ();
+extern void scm_init_vports ();
+
+#endif /* STDC */
+
+
+
+
+
+
+#endif  /* VPORTSH */
diff --git a/libguile/weaks.c b/libguile/weaks.c
new file mode 100644
index 000000000..8479d76f5
--- /dev/null
+++ b/libguile/weaks.c
@@ -0,0 +1,242 @@
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * As a special exception, Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of this library.
+ *
+ * The exception is that, if you link this library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking this library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by 
+ * Free Software Foundation as part of this library.  If you copy
+ * code from other releases distributed under the terms of the GPL into a copy of
+ * this library, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from such code.
+ *
+ * If you write modifications of your own for this library, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  
+ */
+
+#include <stdio.h>
+#include "_scm.h"
+
+
+
+
+/* {Weak Vectors}
+ */
+
+
+SCM_PROC(s_make_weak_vector, "make-weak-vector", 1, 1, 0, scm_make_weak_vector);
+#ifdef __STDC__
+SCM
+scm_make_weak_vector (SCM k, SCM fill)
+#else
+SCM
+scm_make_weak_vector (k, fill)
+     SCM k;
+     SCM fill;
+#endif
+{
+  SCM v;
+  v = scm_make_vector (scm_sum (k, SCM_MAKINUM (1)), fill, SCM_UNDEFINED);
+  SCM_DEFER_INTS;
+  SCM_SETLENGTH(v, SCM_INUM (k), scm_tc7_wvect);
+  SCM_VELTS(v)[0] = (SCM)0;
+  SCM_SETVELTS(v, SCM_VELTS(v) + 1);
+  SCM_ALLOW_INTS;
+  return v;
+}
+
+
+SCM_PROC(s_weak_vector, "weak-vector", 0, 0, 1, scm_weak_vector);
+SCM_PROC(s_list_to_weak_vector, "list->weak-vector", 1, 0, 0, scm_weak_vector);
+#ifdef __STDC__
+SCM
+scm_weak_vector (SCM l)
+#else
+SCM
+scm_weak_vector (l)
+     SCM l;
+#endif
+{
+  SCM res;
+  register SCM *data;
+  long i;
+
+  i = scm_ilength (l);
+  SCM_ASSERT (i >= 0, l, SCM_ARG1, s_weak_vector);
+  res = scm_make_weak_vector (SCM_MAKINUM (i), SCM_UNSPECIFIED);
+  data = SCM_VELTS (res);
+  for (;
+       i && SCM_NIMP (l) && SCM_CONSP (l);
+       --i, l = SCM_CDR (l))
+    *data++ = SCM_CAR (l);
+  return res;
+}
+
+
+SCM_PROC(s_weak_vector_p, "weak-vector?", 1, 0, 0, scm_weak_vector_p);
+#ifdef __STDC__
+SCM
+scm_weak_vector_p (SCM x)
+#else
+SCM
+scm_weak_vector_p (x)
+     SCM x;
+#endif
+{
+  return ((SCM_NIMP (x) && SCM_WVECTP (x) && !SCM_IS_WHVEC (x))
+	  ? SCM_BOOL_T
+	  : SCM_BOOL_F);
+}
+
+
+
+
+
+
+
+SCM_PROC(s_make_weak_hash_table, "make-weak-hash-table", 1, 0, 0, scm_make_weak_hash_table);
+#ifdef __STDC__
+SCM
+scm_make_weak_hash_table (SCM k)
+#else
+SCM
+scm_make_weak_hash_table (k)
+     SCM k;
+#endif
+{
+  SCM v;
+  SCM_ASSERT (SCM_INUMP (k), k, SCM_ARG1, s_make_weak_hash_table);
+  v = scm_make_weak_vector (k, SCM_EOL);
+  SCM_ALLOW_INTS;
+  SCM_VELTS (v)[-1] = 1;
+  SCM_ALLOW_INTS;
+  return v;
+}
+
+
+SCM_PROC (s_make_weak_value_hash_table, "make-weak-value-hash-table", 1, 0, 0, scm_make_weak_value_hash_table);
+#ifdef __STDC__
+SCM
+scm_make_weak_value_hash_table (SCM k)
+#else
+SCM
+scm_make_weak_value_hash_table (k)
+     SCM k;
+#endif
+{
+  SCM v;
+  SCM_ASSERT (SCM_INUMP (k), k, SCM_ARG1, s_make_weak_value_hash_table);
+  v = scm_make_weak_vector (k, SCM_EOL);
+  SCM_ALLOW_INTS;
+  SCM_VELTS (v)[-1] = 2;
+  SCM_ALLOW_INTS;
+  return v;
+}
+
+
+
+SCM_PROC (s_make_doubly_weak_hash_table, "make-doubly-weak-hash-table", 1, 0, 0, scm_make_doubly_weak_hash_table);
+#ifdef __STDC__
+SCM
+scm_make_doubly_weak_hash_table (SCM k)
+#else
+SCM
+scm_make_doubly_weak_hash_table (k)
+     SCM k;
+#endif
+{
+  SCM v;
+  SCM_ASSERT (SCM_INUMP (k), k, SCM_ARG1, s_make_weak_value_hash_table);
+  v = scm_make_weak_vector (k, SCM_EOL);
+  SCM_ALLOW_INTS;
+  SCM_VELTS (v)[-1] = 3;
+  SCM_ALLOW_INTS;
+  return v;
+}
+
+SCM_PROC(s_weak_hash_table_p, "weak-hash-table?", 1, 0, 0, scm_weak_hash_table_p);
+#ifdef __STDC__
+SCM
+scm_weak_hash_table_p (SCM x)
+#else
+SCM
+scm_weak_hash_table_p (x)
+     SCM x;
+#endif
+{
+  return ((SCM_NIMP (x) && SCM_WVECTP (x) && SCM_IS_WHVEC(x))
+	  ? SCM_BOOL_T
+	  : SCM_BOOL_F);
+}
+
+
+SCM_PROC (s_weak_value_hash_table_p, "weak-value-hash-table?", 1, 0, 0, scm_weak_value_hash_table_p);
+#ifdef __STDC__
+SCM
+scm_weak_value_hash_table_p (SCM x)
+#else
+SCM
+scm_weak_value_hash_table_p (x)
+     SCM x;
+#endif
+{
+  return ((SCM_NIMP (x) && SCM_WVECTP (x) && SCM_IS_WHVEC_V(x))
+	  ? SCM_BOOL_T
+	  : SCM_BOOL_F);
+}
+
+
+SCM_PROC (s_doubly_weak_hash_table_p, "doubly-weak-hash-table?", 1, 0, 0, scm_doubly_weak_hash_table_p);
+#ifdef __STDC__
+SCM
+scm_doubly_weak_hash_table_p (SCM x)
+#else
+SCM
+scm_doubly_weak_hash_table_p (x)
+     SCM x;
+#endif
+{
+  return ((SCM_NIMP (x) && SCM_WVECTP (x) && SCM_IS_WHVEC_B (x))
+	  ? SCM_BOOL_T
+	  : SCM_BOOL_F);
+}
+
+
+
+
+#ifdef __STDC__
+void
+scm_init_weaks (void)
+#else
+void
+scm_init_weaks ()
+#endif
+{
+#include "weaks.x"
+}
+
diff --git a/libguile/weaks.h b/libguile/weaks.h
new file mode 100644
index 000000000..98e1cb698
--- /dev/null
+++ b/libguile/weaks.h
@@ -0,0 +1,86 @@
+/* classes: h_files */
+
+#ifndef WEAKSH
+#define WEAKSH
+/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.   
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 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.  
+ */
+
+
+#include "__scm.h"
+
+
+
+
+#define SCM_WVECTP(x) (SCM_TYP7(x)==scm_tc7_wvect)
+#define SCM_IS_WHVEC(X) (SCM_VELTS(X)[-1] == 1)
+#define SCM_IS_WHVEC_V(X) (SCM_VELTS(X)[-1] == 2)
+#define SCM_IS_WHVEC_B(X) (SCM_VELTS(X)[-1] == 3)
+#define SCM_IS_WHVEC_ANY(X) (SCM_VELTS(X)[-1])
+
+
+#ifdef __STDC__
+extern SCM scm_make_weak_vector (SCM k, SCM fill);
+extern SCM scm_weak_vector (SCM l);
+extern SCM scm_weak_vector_p (SCM x);
+extern SCM scm_make_weak_hash_table (SCM k);
+extern SCM scm_make_weak_value_hash_table (SCM k);
+extern SCM scm_make_doubly_weak_hash_table (SCM k);
+extern SCM scm_weak_hash_table_p (SCM x);
+extern SCM scm_weak_value_hash_table_p (SCM x);
+extern SCM scm_doubly_weak_hash_table_p (SCM x);
+extern void scm_init_weaks (void);
+
+#else /* STDC */
+extern SCM scm_make_weak_vector ();
+extern SCM scm_weak_vector ();
+extern SCM scm_weak_vector_p ();
+extern SCM scm_make_weak_hash_table ();
+extern SCM scm_make_weak_value_hash_table ();
+extern SCM scm_make_doubly_weak_hash_table ();
+extern SCM scm_weak_hash_table_p ();
+extern SCM scm_weak_value_hash_table_p ();
+extern SCM scm_doubly_weak_hash_table_p ();
+extern void scm_init_weaks ();
+
+#endif /* STDC */
+
+
+#endif  /* WEAKSH */