Merge branch 'boehm-demers-weiser-gc' into bdw-gc-static-allocbdw-gc-static-alloc

Conflicts:
	acinclude.m4
	libguile/strings.c

932 files changed, 123684 insertions, 18371 deletions

diff --git a/.gitignore b/.gitignore
index 7644deacd..8754b488a 100644
--- a/.gitignore
+++ b/.gitignore
@@ -12,7 +12,6 @@ config.guess
 config.status
 config.log
 config.h
-guile-readline-config.h
 *.doc
 *.x
 *.lo
@@ -37,7 +36,7 @@ autom4te.cache
 benchmark-guile
 check-guile
 check-guile.log
-compile
+build-aux/compile
 confdefs.h
 config.build-subdirs
 config.cache
@@ -53,7 +52,6 @@ conftest.c
 depcomp
 elisp-comp
 guile-*.tar.gz
-guile-tools
 install-sh
 libtool
 ltconfig
@@ -66,12 +64,52 @@ pre-inst-guile-env
 stamp-h1
 guile-procedures.txt
 guile-config/guile-config
-guile-readline/guile-readline-config.h
-guile-readline/guile-readline-config.h.in
+*.go
 TAGS
-guile-1.8.pc
-libguile/stack-limit-calibration.scm
+/meta/guile-2.0.pc
+/meta/guile-2.0-uninstalled.pc
+gdb-pre-inst-guile
 cscope.out
 cscope.files
 *.log
+gds-test.debug
+gds-test.transcript
 INSTALL
+*.aux
+*.cp
+*.cps
+*.dvi
+*.fn
+*.fns
+*.ky
+*.pg
+*.toc
+*.tp
+*.vr
+*.tps
+*.vrs
+*.pgs
+*.rn
+*.rns
+/meta/gdb-uninstalled-guile
+/meta/guile
+/meta/uninstalled-env
+/examples/box-module/box
+/examples/box/box
+/lib/alloca.h
+/lib/charset.alias
+/lib/configmake.h
+/lib/ref-add.sed
+/lib/ref-del.sed
+/lib/stdlib.h
+/lib/string.h
+/lib/strings.h
+/lib/sys/file.h
+/lib/time.h
+/lib/unistd.h
+/lib/unistr/.dirstamp
+/GPATH
+/GRTAGS
+/GSYMS
+/GTAGS
+/meta/guile-tools
diff --git a/ANNOUNCE b/ANNOUNCE
index 89d8cbde4..bfbda7316 100644
--- a/ANNOUNCE
+++ b/ANNOUNCE
@@ -30,7 +30,7 @@ The NEWS file is quite long.  Here are the most interesting entries:
     from threads that have not been created by Guile.
 
   * Mutexes and condition variables are now always fair.  A recursive
-    mutex must be requested explicitely.
+    mutex must be requested explicitly.
 
   * The low-level thread API has been removed.
 
diff --git a/AUTHORS b/AUTHORS
index ed2adbab7..b8f605efa 100644
--- a/AUTHORS
+++ b/AUTHORS
@@ -206,8 +206,34 @@ In the subdirectory doc, changes to:
 Many changes throughout.
 
 Neil Jerram:
+In the subdirectory emacs, wrote:
+    gds.el              gds-scheme.el           gds-server.el
+    gds-test.el         gds-test.sh		gds-test.stdin
+    gds-tutorial.txt	gds-faq.txt
 In the subdirectory ice-9, wrote:
-    buffered-input.scm
+    buffered-input.scm	gds-client.scm      gds-server.scm
+In the subdirectory ice-9/debugging, wrote:
+    example-fns.scm     ice-9-debugger-extensions.scm
+    steps.scm         	trace.scm	    traps.scm
+    trc.scm
+In the subdirectory lang/elisp, wrote:
+    base.scm	        example.el	    interface.scm
+    transform.scm	variables.scm
+In the subdirectory lang/elisp/internals, wrote:
+    evaluation.scm      format.scm	    fset.scm
+    lambda.scm		load.scm	    null.scm
+    set.scm		signal.scm	    time.scm
+    trace.scm
+In the subdirectory lang/elisp/primitives, wrote:
+    buffers.scm	        char-table.scm      features.scm
+    fns.scm		format.scm	    guile.scm
+    keymaps.scm		lists.scm	    load.scm
+    match.scm		numbers.scm	    pure.scm
+    read.scm		signal.scm	    strings.scm
+    symprop.scm		syntax.scm	    system.scm
+    time.scm
+In the subdirectory srfi, wrote:
+    srfi-34.scm
 In the subdirectory doc, wrote:
     deprecated.texi   goops.texi    scheme-ideas.texi
     scheme-reading.texi
@@ -227,6 +253,7 @@ In the subdirectory doc, changes to:
     scm.texi        scripts.texi    script-getopt.texi
 In the subdirectory doc/maint, wrote:
     docstring.el
+Many other changes throughout.
 
 Thien-Thi Nguyen:
 In the top-level directory, wrote:
diff --git a/COPYING b/COPYING
new file mode 100644
index 000000000..94a9ed024
--- /dev/null
+++ b/COPYING
@@ -0,0 +1,674 @@
+                    GNU GENERAL PUBLIC LICENSE
+                       Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+                            Preamble
+
+  The GNU General Public License is a free, copyleft license for
+software and other kinds of works.
+
+  The licenses for most software and other practical works are designed
+to take away your freedom to share and change the works.  By contrast,
+the GNU General Public License is intended to guarantee your freedom to
+share and change all versions of a program--to make sure it remains free
+software for all its users.  We, the Free Software Foundation, use the
+GNU General Public License for most of our software; it applies also to
+any other work released this way by its authors.  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
+them 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 prevent others from denying you
+these rights or asking you to surrender the rights.  Therefore, you have
+certain responsibilities if you distribute copies of the software, or if
+you modify it: responsibilities to respect the freedom of others.
+
+  For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must pass on to the recipients the same
+freedoms that you received.  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.
+
+  Developers that use the GNU GPL protect your rights with two steps:
+(1) assert copyright on the software, and (2) offer you this License
+giving you legal permission to copy, distribute and/or modify it.
+
+  For the developers' and authors' protection, the GPL clearly explains
+that there is no warranty for this free software.  For both users' and
+authors' sake, the GPL requires that modified versions be marked as
+changed, so that their problems will not be attributed erroneously to
+authors of previous versions.
+
+  Some devices are designed to deny users access to install or run
+modified versions of the software inside them, although the manufacturer
+can do so.  This is fundamentally incompatible with the aim of
+protecting users' freedom to change the software.  The systematic
+pattern of such abuse occurs in the area of products for individuals to
+use, which is precisely where it is most unacceptable.  Therefore, we
+have designed this version of the GPL to prohibit the practice for those
+products.  If such problems arise substantially in other domains, we
+stand ready to extend this provision to those domains in future versions
+of the GPL, as needed to protect the freedom of users.
+
+  Finally, every program is threatened constantly by software patents.
+States should not allow patents to restrict development and use of
+software on general-purpose computers, but in those that do, we wish to
+avoid the special danger that patents applied to a free program could
+make it effectively proprietary.  To prevent this, the GPL assures that
+patents cannot be used to render the program non-free.
+
+  The precise terms and conditions for copying, distribution and
+modification follow.
+
+                       TERMS AND CONDITIONS
+
+  0. Definitions.
+
+  "This License" refers to version 3 of the GNU General Public License.
+
+  "Copyright" also means copyright-like laws that apply to other kinds of
+works, such as semiconductor masks.
+
+  "The Program" refers to any copyrightable work licensed under this
+License.  Each licensee is addressed as "you".  "Licensees" and
+"recipients" may be individuals or organizations.
+
+  To "modify" a work means to copy from or adapt all or part of the work
+in a fashion requiring copyright permission, other than the making of an
+exact copy.  The resulting work is called a "modified version" of the
+earlier work or a work "based on" the earlier work.
+
+  A "covered work" means either the unmodified Program or a work based
+on the Program.
+
+  To "propagate" a work means to do anything with it that, without
+permission, would make you directly or secondarily liable for
+infringement under applicable copyright law, except executing it on a
+computer or modifying a private copy.  Propagation includes copying,
+distribution (with or without modification), making available to the
+public, and in some countries other activities as well.
+
+  To "convey" a work means any kind of propagation that enables other
+parties to make or receive copies.  Mere interaction with a user through
+a computer network, with no transfer of a copy, is not conveying.
+
+  An interactive user interface displays "Appropriate Legal Notices"
+to the extent that it includes a convenient and prominently visible
+feature that (1) displays an appropriate copyright notice, and (2)
+tells the user that there is no warranty for the work (except to the
+extent that warranties are provided), that licensees may convey the
+work under this License, and how to view a copy of this License.  If
+the interface presents a list of user commands or options, such as a
+menu, a prominent item in the list meets this criterion.
+
+  1. Source Code.
+
+  The "source code" for a work means the preferred form of the work
+for making modifications to it.  "Object code" means any non-source
+form of a work.
+
+  A "Standard Interface" means an interface that either is an official
+standard defined by a recognized standards body, or, in the case of
+interfaces specified for a particular programming language, one that
+is widely used among developers working in that language.
+
+  The "System Libraries" of an executable work include anything, other
+than the work as a whole, that (a) is included in the normal form of
+packaging a Major Component, but which is not part of that Major
+Component, and (b) serves only to enable use of the work with that
+Major Component, or to implement a Standard Interface for which an
+implementation is available to the public in source code form.  A
+"Major Component", in this context, means a major essential component
+(kernel, window system, and so on) of the specific operating system
+(if any) on which the executable work runs, or a compiler used to
+produce the work, or an object code interpreter used to run it.
+
+  The "Corresponding Source" for a work in object code form means all
+the source code needed to generate, install, and (for an executable
+work) run the object code and to modify the work, including scripts to
+control those activities.  However, it does not include the work's
+System Libraries, or general-purpose tools or generally available free
+programs which are used unmodified in performing those activities but
+which are not part of the work.  For example, Corresponding Source
+includes interface definition files associated with source files for
+the work, and the source code for shared libraries and dynamically
+linked subprograms that the work is specifically designed to require,
+such as by intimate data communication or control flow between those
+subprograms and other parts of the work.
+
+  The Corresponding Source need not include anything that users
+can regenerate automatically from other parts of the Corresponding
+Source.
+
+  The Corresponding Source for a work in source code form is that
+same work.
+
+  2. Basic Permissions.
+
+  All rights granted under this License are granted for the term of
+copyright on the Program, and are irrevocable provided the stated
+conditions are met.  This License explicitly affirms your unlimited
+permission to run the unmodified Program.  The output from running a
+covered work is covered by this License only if the output, given its
+content, constitutes a covered work.  This License acknowledges your
+rights of fair use or other equivalent, as provided by copyright law.
+
+  You may make, run and propagate covered works that you do not
+convey, without conditions so long as your license otherwise remains
+in force.  You may convey covered works to others for the sole purpose
+of having them make modifications exclusively for you, or provide you
+with facilities for running those works, provided that you comply with
+the terms of this License in conveying all material for which you do
+not control copyright.  Those thus making or running the covered works
+for you must do so exclusively on your behalf, under your direction
+and control, on terms that prohibit them from making any copies of
+your copyrighted material outside their relationship with you.
+
+  Conveying under any other circumstances is permitted solely under
+the conditions stated below.  Sublicensing is not allowed; section 10
+makes it unnecessary.
+
+  3. Protecting Users' Legal Rights From Anti-Circumvention Law.
+
+  No covered work shall be deemed part of an effective technological
+measure under any applicable law fulfilling obligations under article
+11 of the WIPO copyright treaty adopted on 20 December 1996, or
+similar laws prohibiting or restricting circumvention of such
+measures.
+
+  When you convey a covered work, you waive any legal power to forbid
+circumvention of technological measures to the extent such circumvention
+is effected by exercising rights under this License with respect to
+the covered work, and you disclaim any intention to limit operation or
+modification of the work as a means of enforcing, against the work's
+users, your or third parties' legal rights to forbid circumvention of
+technological measures.
+
+  4. Conveying Verbatim Copies.
+
+  You may convey 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;
+keep intact all notices stating that this License and any
+non-permissive terms added in accord with section 7 apply to the code;
+keep intact all notices of the absence of any warranty; and give all
+recipients a copy of this License along with the Program.
+
+  You may charge any price or no price for each copy that you convey,
+and you may offer support or warranty protection for a fee.
+
+  5. Conveying Modified Source Versions.
+
+  You may convey a work based on the Program, or the modifications to
+produce it from the Program, in the form of source code under the
+terms of section 4, provided that you also meet all of these conditions:
+
+    a) The work must carry prominent notices stating that you modified
+    it, and giving a relevant date.
+
+    b) The work must carry prominent notices stating that it is
+    released under this License and any conditions added under section
+    7.  This requirement modifies the requirement in section 4 to
+    "keep intact all notices".
+
+    c) You must license the entire work, as a whole, under this
+    License to anyone who comes into possession of a copy.  This
+    License will therefore apply, along with any applicable section 7
+    additional terms, to the whole of the work, and all its parts,
+    regardless of how they are packaged.  This License gives no
+    permission to license the work in any other way, but it does not
+    invalidate such permission if you have separately received it.
+
+    d) If the work has interactive user interfaces, each must display
+    Appropriate Legal Notices; however, if the Program has interactive
+    interfaces that do not display Appropriate Legal Notices, your
+    work need not make them do so.
+
+  A compilation of a covered work with other separate and independent
+works, which are not by their nature extensions of the covered work,
+and which are not combined with it such as to form a larger program,
+in or on a volume of a storage or distribution medium, is called an
+"aggregate" if the compilation and its resulting copyright are not
+used to limit the access or legal rights of the compilation's users
+beyond what the individual works permit.  Inclusion of a covered work
+in an aggregate does not cause this License to apply to the other
+parts of the aggregate.
+
+  6. Conveying Non-Source Forms.
+
+  You may convey a covered work in object code form under the terms
+of sections 4 and 5, provided that you also convey the
+machine-readable Corresponding Source under the terms of this License,
+in one of these ways:
+
+    a) Convey the object code in, or embodied in, a physical product
+    (including a physical distribution medium), accompanied by the
+    Corresponding Source fixed on a durable physical medium
+    customarily used for software interchange.
+
+    b) Convey the object code in, or embodied in, a physical product
+    (including a physical distribution medium), accompanied by a
+    written offer, valid for at least three years and valid for as
+    long as you offer spare parts or customer support for that product
+    model, to give anyone who possesses the object code either (1) a
+    copy of the Corresponding Source for all the software in the
+    product that is covered by this License, on a durable physical
+    medium customarily used for software interchange, for a price no
+    more than your reasonable cost of physically performing this
+    conveying of source, or (2) access to copy the
+    Corresponding Source from a network server at no charge.
+
+    c) Convey individual copies of the object code with a copy of the
+    written offer to provide the Corresponding Source.  This
+    alternative is allowed only occasionally and noncommercially, and
+    only if you received the object code with such an offer, in accord
+    with subsection 6b.
+
+    d) Convey the object code by offering access from a designated
+    place (gratis or for a charge), and offer equivalent access to the
+    Corresponding Source in the same way through the same place at no
+    further charge.  You need not require recipients to copy the
+    Corresponding Source along with the object code.  If the place to
+    copy the object code is a network server, the Corresponding Source
+    may be on a different server (operated by you or a third party)
+    that supports equivalent copying facilities, provided you maintain
+    clear directions next to the object code saying where to find the
+    Corresponding Source.  Regardless of what server hosts the
+    Corresponding Source, you remain obligated to ensure that it is
+    available for as long as needed to satisfy these requirements.
+
+    e) Convey the object code using peer-to-peer transmission, provided
+    you inform other peers where the object code and Corresponding
+    Source of the work are being offered to the general public at no
+    charge under subsection 6d.
+
+  A separable portion of the object code, whose source code is excluded
+from the Corresponding Source as a System Library, need not be
+included in conveying the object code work.
+
+  A "User Product" is either (1) a "consumer product", which means any
+tangible personal property which is normally used for personal, family,
+or household purposes, or (2) anything designed or sold for incorporation
+into a dwelling.  In determining whether a product is a consumer product,
+doubtful cases shall be resolved in favor of coverage.  For a particular
+product received by a particular user, "normally used" refers to a
+typical or common use of that class of product, regardless of the status
+of the particular user or of the way in which the particular user
+actually uses, or expects or is expected to use, the product.  A product
+is a consumer product regardless of whether the product has substantial
+commercial, industrial or non-consumer uses, unless such uses represent
+the only significant mode of use of the product.
+
+  "Installation Information" for a User Product means any methods,
+procedures, authorization keys, or other information required to install
+and execute modified versions of a covered work in that User Product from
+a modified version of its Corresponding Source.  The information must
+suffice to ensure that the continued functioning of the modified object
+code is in no case prevented or interfered with solely because
+modification has been made.
+
+  If you convey an object code work under this section in, or with, or
+specifically for use in, a User Product, and the conveying occurs as
+part of a transaction in which the right of possession and use of the
+User Product is transferred to the recipient in perpetuity or for a
+fixed term (regardless of how the transaction is characterized), the
+Corresponding Source conveyed under this section must be accompanied
+by the Installation Information.  But this requirement does not apply
+if neither you nor any third party retains the ability to install
+modified object code on the User Product (for example, the work has
+been installed in ROM).
+
+  The requirement to provide Installation Information does not include a
+requirement to continue to provide support service, warranty, or updates
+for a work that has been modified or installed by the recipient, or for
+the User Product in which it has been modified or installed.  Access to a
+network may be denied when the modification itself materially and
+adversely affects the operation of the network or violates the rules and
+protocols for communication across the network.
+
+  Corresponding Source conveyed, and Installation Information provided,
+in accord with this section must be in a format that is publicly
+documented (and with an implementation available to the public in
+source code form), and must require no special password or key for
+unpacking, reading or copying.
+
+  7. Additional Terms.
+
+  "Additional permissions" are terms that supplement the terms of this
+License by making exceptions from one or more of its conditions.
+Additional permissions that are applicable to the entire Program shall
+be treated as though they were included in this License, to the extent
+that they are valid under applicable law.  If additional permissions
+apply only to part of the Program, that part may be used separately
+under those permissions, but the entire Program remains governed by
+this License without regard to the additional permissions.
+
+  When you convey a copy of a covered work, you may at your option
+remove any additional permissions from that copy, or from any part of
+it.  (Additional permissions may be written to require their own
+removal in certain cases when you modify the work.)  You may place
+additional permissions on material, added by you to a covered work,
+for which you have or can give appropriate copyright permission.
+
+  Notwithstanding any other provision of this License, for material you
+add to a covered work, you may (if authorized by the copyright holders of
+that material) supplement the terms of this License with terms:
+
+    a) Disclaiming warranty or limiting liability differently from the
+    terms of sections 15 and 16 of this License; or
+
+    b) Requiring preservation of specified reasonable legal notices or
+    author attributions in that material or in the Appropriate Legal
+    Notices displayed by works containing it; or
+
+    c) Prohibiting misrepresentation of the origin of that material, or
+    requiring that modified versions of such material be marked in
+    reasonable ways as different from the original version; or
+
+    d) Limiting the use for publicity purposes of names of licensors or
+    authors of the material; or
+
+    e) Declining to grant rights under trademark law for use of some
+    trade names, trademarks, or service marks; or
+
+    f) Requiring indemnification of licensors and authors of that
+    material by anyone who conveys the material (or modified versions of
+    it) with contractual assumptions of liability to the recipient, for
+    any liability that these contractual assumptions directly impose on
+    those licensors and authors.
+
+  All other non-permissive additional terms are considered "further
+restrictions" within the meaning of section 10.  If the Program as you
+received it, or any part of it, contains a notice stating that it is
+governed by this License along with a term that is a further
+restriction, you may remove that term.  If a license document contains
+a further restriction but permits relicensing or conveying under this
+License, you may add to a covered work material governed by the terms
+of that license document, provided that the further restriction does
+not survive such relicensing or conveying.
+
+  If you add terms to a covered work in accord with this section, you
+must place, in the relevant source files, a statement of the
+additional terms that apply to those files, or a notice indicating
+where to find the applicable terms.
+
+  Additional terms, permissive or non-permissive, may be stated in the
+form of a separately written license, or stated as exceptions;
+the above requirements apply either way.
+
+  8. Termination.
+
+  You may not propagate or modify a covered work except as expressly
+provided under this License.  Any attempt otherwise to propagate or
+modify it is void, and will automatically terminate your rights under
+this License (including any patent licenses granted under the third
+paragraph of section 11).
+
+  However, if you cease all violation of this License, then your
+license from a particular copyright holder is reinstated (a)
+provisionally, unless and until the copyright holder explicitly and
+finally terminates your license, and (b) permanently, if the copyright
+holder fails to notify you of the violation by some reasonable means
+prior to 60 days after the cessation.
+
+  Moreover, your license from a particular copyright holder is
+reinstated permanently if the copyright holder notifies you of the
+violation by some reasonable means, this is the first time you have
+received notice of violation of this License (for any work) from that
+copyright holder, and you cure the violation prior to 30 days after
+your receipt of the notice.
+
+  Termination of your rights under this section does not terminate the
+licenses of parties who have received copies or rights from you under
+this License.  If your rights have been terminated and not permanently
+reinstated, you do not qualify to receive new licenses for the same
+material under section 10.
+
+  9. Acceptance Not Required for Having Copies.
+
+  You are not required to accept this License in order to receive or
+run a copy of the Program.  Ancillary propagation of a covered work
+occurring solely as a consequence of using peer-to-peer transmission
+to receive a copy likewise does not require acceptance.  However,
+nothing other than this License grants you permission to propagate or
+modify any covered work.  These actions infringe copyright if you do
+not accept this License.  Therefore, by modifying or propagating a
+covered work, you indicate your acceptance of this License to do so.
+
+  10. Automatic Licensing of Downstream Recipients.
+
+  Each time you convey a covered work, the recipient automatically
+receives a license from the original licensors, to run, modify and
+propagate that work, subject to this License.  You are not responsible
+for enforcing compliance by third parties with this License.
+
+  An "entity transaction" is a transaction transferring control of an
+organization, or substantially all assets of one, or subdividing an
+organization, or merging organizations.  If propagation of a covered
+work results from an entity transaction, each party to that
+transaction who receives a copy of the work also receives whatever
+licenses to the work the party's predecessor in interest had or could
+give under the previous paragraph, plus a right to possession of the
+Corresponding Source of the work from the predecessor in interest, if
+the predecessor has it or can get it with reasonable efforts.
+
+  You may not impose any further restrictions on the exercise of the
+rights granted or affirmed under this License.  For example, you may
+not impose a license fee, royalty, or other charge for exercise of
+rights granted under this License, and you may not initiate litigation
+(including a cross-claim or counterclaim in a lawsuit) alleging that
+any patent claim is infringed by making, using, selling, offering for
+sale, or importing the Program or any portion of it.
+
+  11. Patents.
+
+  A "contributor" is a copyright holder who authorizes use under this
+License of the Program or a work on which the Program is based.  The
+work thus licensed is called the contributor's "contributor version".
+
+  A contributor's "essential patent claims" are all patent claims
+owned or controlled by the contributor, whether already acquired or
+hereafter acquired, that would be infringed by some manner, permitted
+by this License, of making, using, or selling its contributor version,
+but do not include claims that would be infringed only as a
+consequence of further modification of the contributor version.  For
+purposes of this definition, "control" includes the right to grant
+patent sublicenses in a manner consistent with the requirements of
+this License.
+
+  Each contributor grants you a non-exclusive, worldwide, royalty-free
+patent license under the contributor's essential patent claims, to
+make, use, sell, offer for sale, import and otherwise run, modify and
+propagate the contents of its contributor version.
+
+  In the following three paragraphs, a "patent license" is any express
+agreement or commitment, however denominated, not to enforce a patent
+(such as an express permission to practice a patent or covenant not to
+sue for patent infringement).  To "grant" such a patent license to a
+party means to make such an agreement or commitment not to enforce a
+patent against the party.
+
+  If you convey a covered work, knowingly relying on a patent license,
+and the Corresponding Source of the work is not available for anyone
+to copy, free of charge and under the terms of this License, through a
+publicly available network server or other readily accessible means,
+then you must either (1) cause the Corresponding Source to be so
+available, or (2) arrange to deprive yourself of the benefit of the
+patent license for this particular work, or (3) arrange, in a manner
+consistent with the requirements of this License, to extend the patent
+license to downstream recipients.  "Knowingly relying" means you have
+actual knowledge that, but for the patent license, your conveying the
+covered work in a country, or your recipient's use of the covered work
+in a country, would infringe one or more identifiable patents in that
+country that you have reason to believe are valid.
+
+  If, pursuant to or in connection with a single transaction or
+arrangement, you convey, or propagate by procuring conveyance of, a
+covered work, and grant a patent license to some of the parties
+receiving the covered work authorizing them to use, propagate, modify
+or convey a specific copy of the covered work, then the patent license
+you grant is automatically extended to all recipients of the covered
+work and works based on it.
+
+  A patent license is "discriminatory" if it does not include within
+the scope of its coverage, prohibits the exercise of, or is
+conditioned on the non-exercise of one or more of the rights that are
+specifically granted under this License.  You may not convey a covered
+work if you are a party to an arrangement with a third party that is
+in the business of distributing software, under which you make payment
+to the third party based on the extent of your activity of conveying
+the work, and under which the third party grants, to any of the
+parties who would receive the covered work from you, a discriminatory
+patent license (a) in connection with copies of the covered work
+conveyed by you (or copies made from those copies), or (b) primarily
+for and in connection with specific products or compilations that
+contain the covered work, unless you entered into that arrangement,
+or that patent license was granted, prior to 28 March 2007.
+
+  Nothing in this License shall be construed as excluding or limiting
+any implied license or other defenses to infringement that may
+otherwise be available to you under applicable patent law.
+
+  12. No Surrender of Others' Freedom.
+
+  If 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 convey a
+covered work so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you may
+not convey it at all.  For example, if you agree to terms that obligate you
+to collect a royalty for further conveying from those to whom you convey
+the Program, the only way you could satisfy both those terms and this
+License would be to refrain entirely from conveying the Program.
+
+  13. Use with the GNU Affero General Public License.
+
+  Notwithstanding any other provision of this License, you have
+permission to link or combine any covered work with a work licensed
+under version 3 of the GNU Affero General Public License into a single
+combined work, and to convey the resulting work.  The terms of this
+License will continue to apply to the part which is the covered work,
+but the special requirements of the GNU Affero General Public License,
+section 13, concerning interaction through a network will apply to the
+combination as such.
+
+  14. Revised Versions of this License.
+
+  The Free Software Foundation may publish revised and/or new versions of
+the GNU 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 that a certain numbered version of the GNU General
+Public License "or any later version" applies to it, you have the
+option of following the terms and conditions either of that numbered
+version or of any later version published by the Free Software
+Foundation.  If the Program does not specify a version number of the
+GNU General Public License, you may choose any version ever published
+by the Free Software Foundation.
+
+  If the Program specifies that a proxy can decide which future
+versions of the GNU General Public License can be used, that proxy's
+public statement of acceptance of a version permanently authorizes you
+to choose that version for the Program.
+
+  Later license versions may give you additional or different
+permissions.  However, no additional obligations are imposed on any
+author or copyright holder as a result of your choosing to follow a
+later version.
+
+  15. Disclaimer of Warranty.
+
+  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.
+
+  16. Limitation of Liability.
+
+  IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
+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.
+
+  17. Interpretation of Sections 15 and 16.
+
+  If the disclaimer of warranty and limitation of liability provided
+above cannot be given local legal effect according to their terms,
+reviewing courts shall apply local law that most closely approximates
+an absolute waiver of all civil liability in connection with the
+Program, unless a warranty or assumption of liability accompanies a
+copy of the Program in return for a fee.
+
+                     END OF TERMS AND CONDITIONS
+
+            How to Apply These Terms to Your New Programs
+
+  If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+  To do so, attach the following notices to the program.  It is safest
+to attach them to the start of each source file to most effectively
+state the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+    <one line to give the program's name and a brief idea of what it does.>
+    Copyright (C) <year>  <name of author>
+
+    This program is free software: you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation, either version 3 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+Also add information on how to contact you by electronic and paper mail.
+
+  If the program does terminal interaction, make it output a short
+notice like this when it starts in an interactive mode:
+
+    <program>  Copyright (C) <year>  <name of author>
+    This program 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, your program's commands
+might be different; for a GUI interface, you would use an "about box".
+
+  You should also get your employer (if you work as a programmer) or school,
+if any, to sign a "copyright disclaimer" for the program, if necessary.
+For more information on this, and how to apply and follow the GNU GPL, see
+<http://www.gnu.org/licenses/>.
+
+  The GNU 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 Lesser General
+Public License instead of this License.  But first, please read
+<http://www.gnu.org/philosophy/why-not-lgpl.html>.
diff --git a/COPYING.LESSER b/COPYING.LESSER
index 8add30ad5..cca7fc278 100644
--- a/COPYING.LESSER
+++ b/COPYING.LESSER
@@ -1,504 +1,165 @@
-		  GNU LESSER GENERAL PUBLIC LICENSE
-		       Version 2.1, February 1999
+		   GNU LESSER GENERAL PUBLIC LICENSE
+                       Version 3, 29 June 2007
 
- Copyright (C) 1991, 1999 Free Software Foundation, Inc.
-     51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
  Everyone is permitted to copy and distribute verbatim copies
  of this license document, but changing it is not allowed.
 
-[This is the first released version of the Lesser GPL.  It also counts
- as the successor of the GNU Library Public License, version 2, hence
- the version number 2.1.]
-
-			    Preamble
-
-  The licenses for most software are designed to take away your
-freedom to share and change it.  By contrast, the GNU General Public
-Licenses are intended to guarantee your freedom to share and change
-free software--to make sure the software is free for all its users.
-
-  This license, the Lesser General Public License, applies to some
-specially designated software packages--typically libraries--of the
-Free Software Foundation and other authors who decide to use it.  You
-can use it too, but we suggest you first think carefully about whether
-this license or the ordinary General Public License is the better
-strategy to use in any particular case, based on the explanations below.
-
-  When we speak of free software, we are referring to freedom of use,
-not price.  Our General Public Licenses are designed to make sure that
-you have the freedom to distribute copies of free software (and charge
-for this service if you wish); that you receive source code or can get
-it if you want it; that you can change the software and use pieces of
-it in new free programs; and that you are informed that you can do
-these things.
-
-  To protect your rights, we need to make restrictions that forbid
-distributors to deny you these rights or to ask you to surrender these
-rights.  These restrictions translate to certain responsibilities for
-you if you distribute copies of the library or if you modify it.
-
-  For example, if you distribute copies of the library, whether gratis
-or for a fee, you must give the recipients all the rights that we gave
-you.  You must make sure that they, too, receive or can get the source
-code.  If you link other code with the library, you must provide
-complete object files to the recipients, so that they can relink them
-with the library after making changes to the library and recompiling
-it.  And you must show them these terms so they know their rights.
-
-  We protect your rights with a two-step method: (1) we copyright the
-library, and (2) we offer you this license, which gives you legal
-permission to copy, distribute and/or modify the library.
-
-  To protect each distributor, we want to make it very clear that
-there is no warranty for the free library.  Also, if the library is
-modified by someone else and passed on, the recipients should know
-that what they have is not the original version, so that the original
-author's reputation will not be affected by problems that might be
-introduced by others.
-
-  Finally, software patents pose a constant threat to the existence of
-any free program.  We wish to make sure that a company cannot
-effectively restrict the users of a free program by obtaining a
-restrictive license from a patent holder.  Therefore, we insist that
-any patent license obtained for a version of the library must be
-consistent with the full freedom of use specified in this license.
-
-  Most GNU software, including some libraries, is covered by the
-ordinary GNU General Public License.  This license, the GNU Lesser
-General Public License, applies to certain designated libraries, and
-is quite different from the ordinary General Public License.  We use
-this license for certain libraries in order to permit linking those
-libraries into non-free programs.
-
-  When a program is linked with a library, whether statically or using
-a shared library, the combination of the two is legally speaking a
-combined work, a derivative of the original library.  The ordinary
-General Public License therefore permits such linking only if the
-entire combination fits its criteria of freedom.  The Lesser General
-Public License permits more lax criteria for linking other code with
-the library.
-
-  We call this license the "Lesser" General Public License because it
-does Less to protect the user's freedom than the ordinary General
-Public License.  It also provides other free software developers Less
-of an advantage over competing non-free programs.  These disadvantages
-are the reason we use the ordinary General Public License for many
-libraries.  However, the Lesser license provides advantages in certain
-special circumstances.
-
-  For example, on rare occasions, there may be a special need to
-encourage the widest possible use of a certain library, so that it becomes
-a de-facto standard.  To achieve this, non-free programs must be
-allowed to use the library.  A more frequent case is that a free
-library does the same job as widely used non-free libraries.  In this
-case, there is little to gain by limiting the free library to free
-software only, so we use the Lesser General Public License.
-
-  In other cases, permission to use a particular library in non-free
-programs enables a greater number of people to use a large body of
-free software.  For example, permission to use the GNU C Library in
-non-free programs enables many more people to use the whole GNU
-operating system, as well as its variant, the GNU/Linux operating
-system.
-
-  Although the Lesser General Public License is Less protective of the
-users' freedom, it does ensure that the user of a program that is
-linked with the Library has the freedom and the wherewithal to run
-that program using a modified version of the Library.
-
-  The precise terms and conditions for copying, distribution and
-modification follow.  Pay close attention to the difference between a
-"work based on the library" and a "work that uses the library".  The
-former contains code derived from the library, whereas the latter must
-be combined with the library in order to run.
-
-		  GNU LESSER GENERAL PUBLIC LICENSE
-   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
-
-  0. This License Agreement applies to any software library or other
-program which contains a notice placed by the copyright holder or
-other authorized party saying it may be distributed under the terms of
-this Lesser General Public License (also called "this License").
-Each licensee is addressed as "you".
-
-  A "library" means a collection of software functions and/or data
-prepared so as to be conveniently linked with application programs
-(which use some of those functions and data) to form executables.
-
-  The "Library", below, refers to any such software library or work
-which has been distributed under these terms.  A "work based on the
-Library" means either the Library or any derivative work under
-copyright law: that is to say, a work containing the Library or a
-portion of it, either verbatim or with modifications and/or translated
-straightforwardly into another language.  (Hereinafter, translation is
-included without limitation in the term "modification".)
-
-  "Source code" for a work means the preferred form of the work for
-making modifications to it.  For a library, complete source code means
-all the source code for all modules it contains, plus any associated
-interface definition files, plus the scripts used to control compilation
-and installation of the library.
-
-  Activities other than copying, distribution and modification are not
-covered by this License; they are outside its scope.  The act of
-running a program using the Library is not restricted, and output from
-such a program is covered only if its contents constitute a work based
-on the Library (independent of the use of the Library in a tool for
-writing it).  Whether that is true depends on what the Library does
-and what the program that uses the Library does.
-  
-  1. You may copy and distribute verbatim copies of the Library's
-complete source code as you receive it, in any medium, provided that
-you conspicuously and appropriately publish on each copy an
-appropriate copyright notice and disclaimer of warranty; keep intact
-all the notices that refer to this License and to the absence of any
-warranty; and distribute a copy of this License along with the
-Library.
 
-  You may charge a fee for the physical act of transferring a copy,
-and you may at your option offer warranty protection in exchange for a
-fee.
-
-  2. You may modify your copy or copies of the Library or any portion
-of it, thus forming a work based on the Library, and copy and
-distribute such modifications or work under the terms of Section 1
-above, provided that you also meet all of these conditions:
-
-    a) The modified work must itself be a software library.
-
-    b) You must cause the files modified to carry prominent notices
-    stating that you changed the files and the date of any change.
-
-    c) You must cause the whole of the work to be licensed at no
-    charge to all third parties under the terms of this License.
-
-    d) If a facility in the modified Library refers to a function or a
-    table of data to be supplied by an application program that uses
-    the facility, other than as an argument passed when the facility
-    is invoked, then you must make a good faith effort to ensure that,
-    in the event an application does not supply such function or
-    table, the facility still operates, and performs whatever part of
-    its purpose remains meaningful.
-
-    (For example, a function in a library to compute square roots has
-    a purpose that is entirely well-defined independent of the
-    application.  Therefore, Subsection 2d requires that any
-    application-supplied function or table used by this function must
-    be optional: if the application does not supply it, the square
-    root function must still compute square roots.)
-
-These requirements apply to the modified work as a whole.  If
-identifiable sections of that work are not derived from the Library,
-and can be reasonably considered independent and separate works in
-themselves, then this License, and its terms, do not apply to those
-sections when you distribute them as separate works.  But when you
-distribute the same sections as part of a whole which is a work based
-on the Library, the distribution of the whole must be on the terms of
-this License, whose permissions for other licensees extend to the
-entire whole, and thus to each and every part regardless of who wrote
-it.
-
-Thus, it is not the intent of this section to claim rights or contest
-your rights to work written entirely by you; rather, the intent is to
-exercise the right to control the distribution of derivative or
-collective works based on the Library.
-
-In addition, mere aggregation of another work not based on the Library
-with the Library (or with a work based on the Library) on a volume of
-a storage or distribution medium does not bring the other work under
-the scope of this License.
-
-  3. You may opt to apply the terms of the ordinary GNU General Public
-License instead of this License to a given copy of the Library.  To do
-this, you must alter all the notices that refer to this License, so
-that they refer to the ordinary GNU General Public License, version 2,
-instead of to this License.  (If a newer version than version 2 of the
-ordinary GNU General Public License has appeared, then you can specify
-that version instead if you wish.)  Do not make any other change in
-these notices.
-
-  Once this change is made in a given copy, it is irreversible for
-that copy, so the ordinary GNU General Public License applies to all
-subsequent copies and derivative works made from that copy.
-
-  This option is useful when you wish to copy part of the code of
-the Library into a program that is not a library.
-
-  4. You may copy and distribute the Library (or a portion or
-derivative of it, under Section 2) in object code or executable form
-under the terms of Sections 1 and 2 above provided that you accompany
-it with the complete corresponding machine-readable source code, which
-must be distributed under the terms of Sections 1 and 2 above on a
-medium customarily used for software interchange.
-
-  If distribution of object code is made by offering access to copy
-from a designated place, then offering equivalent access to copy the
-source code from the same place satisfies the requirement to
-distribute the source code, even though third parties are not
-compelled to copy the source along with the object code.
-
-  5. A program that contains no derivative of any portion of the
-Library, but is designed to work with the Library by being compiled or
-linked with it, is called a "work that uses the Library".  Such a
-work, in isolation, is not a derivative work of the Library, and
-therefore falls outside the scope of this License.
-
-  However, linking a "work that uses the Library" with the Library
-creates an executable that is a derivative of the Library (because it
-contains portions of the Library), rather than a "work that uses the
-library".  The executable is therefore covered by this License.
-Section 6 states terms for distribution of such executables.
-
-  When a "work that uses the Library" uses material from a header file
-that is part of the Library, the object code for the work may be a
-derivative work of the Library even though the source code is not.
-Whether this is true is especially significant if the work can be
-linked without the Library, or if the work is itself a library.  The
-threshold for this to be true is not precisely defined by law.
-
-  If such an object file uses only numerical parameters, data
-structure layouts and accessors, and small macros and small inline
-functions (ten lines or less in length), then the use of the object
-file is unrestricted, regardless of whether it is legally a derivative
-work.  (Executables containing this object code plus portions of the
-Library will still fall under Section 6.)
-
-  Otherwise, if the work is a derivative of the Library, you may
-distribute the object code for the work under the terms of Section 6.
-Any executables containing that work also fall under Section 6,
-whether or not they are linked directly with the Library itself.
-
-  6. As an exception to the Sections above, you may also combine or
-link a "work that uses the Library" with the Library to produce a
-work containing portions of the Library, and distribute that work
-under terms of your choice, provided that the terms permit
-modification of the work for the customer's own use and reverse
-engineering for debugging such modifications.
-
-  You must give prominent notice with each copy of the work that the
-Library is used in it and that the Library and its use are covered by
-this License.  You must supply a copy of this License.  If the work
-during execution displays copyright notices, you must include the
-copyright notice for the Library among them, as well as a reference
-directing the user to the copy of this License.  Also, you must do one
-of these things:
-
-    a) Accompany the work with the complete corresponding
-    machine-readable source code for the Library including whatever
-    changes were used in the work (which must be distributed under
-    Sections 1 and 2 above); and, if the work is an executable linked
-    with the Library, with the complete machine-readable "work that
-    uses the Library", as object code and/or source code, so that the
-    user can modify the Library and then relink to produce a modified
-    executable containing the modified Library.  (It is understood
-    that the user who changes the contents of definitions files in the
-    Library will not necessarily be able to recompile the application
-    to use the modified definitions.)
-
-    b) Use a suitable shared library mechanism for linking with the
-    Library.  A suitable mechanism is one that (1) uses at run time a
-    copy of the library already present on the user's computer system,
-    rather than copying library functions into the executable, and (2)
-    will operate properly with a modified version of the library, if
-    the user installs one, as long as the modified version is
-    interface-compatible with the version that the work was made with.
-
-    c) Accompany the work with a written offer, valid for at
-    least three years, to give the same user the materials
-    specified in Subsection 6a, above, for a charge no more
-    than the cost of performing this distribution.
-
-    d) If distribution of the work is made by offering access to copy
-    from a designated place, offer equivalent access to copy the above
-    specified materials from the same place.
-
-    e) Verify that the user has already received a copy of these
-    materials or that you have already sent this user a copy.
-
-  For an executable, the required form of the "work that uses the
-Library" must include any data and utility programs needed for
-reproducing the executable from it.  However, as a special exception,
-the materials to be distributed need not include anything that is
-normally distributed (in either source or binary form) with the major
-components (compiler, kernel, and so on) of the operating system on
-which the executable runs, unless that component itself accompanies
-the executable.
-
-  It may happen that this requirement contradicts the license
-restrictions of other proprietary libraries that do not normally
-accompany the operating system.  Such a contradiction means you cannot
-use both them and the Library together in an executable that you
-distribute.
-
-  7. You may place library facilities that are a work based on the
-Library side-by-side in a single library together with other library
-facilities not covered by this License, and distribute such a combined
-library, provided that the separate distribution of the work based on
-the Library and of the other library facilities is otherwise
-permitted, and provided that you do these two things:
-
-    a) Accompany the combined library with a copy of the same work
-    based on the Library, uncombined with any other library
-    facilities.  This must be distributed under the terms of the
-    Sections above.
-
-    b) Give prominent notice with the combined library of the fact
-    that part of it is a work based on the Library, and explaining
-    where to find the accompanying uncombined form of the same work.
-
-  8. You may not copy, modify, sublicense, link with, or distribute
-the Library except as expressly provided under this License.  Any
-attempt otherwise to copy, modify, sublicense, link with, or
-distribute the Library is void, and will automatically terminate your
-rights under this License.  However, parties who have received copies,
-or rights, from you under this License will not have their licenses
-terminated so long as such parties remain in full compliance.
-
-  9. You are not required to accept this License, since you have not
-signed it.  However, nothing else grants you permission to modify or
-distribute the Library or its derivative works.  These actions are
-prohibited by law if you do not accept this License.  Therefore, by
-modifying or distributing the Library (or any work based on the
-Library), you indicate your acceptance of this License to do so, and
-all its terms and conditions for copying, distributing or modifying
-the Library or works based on it.
-
-  10. Each time you redistribute the Library (or any work based on the
-Library), the recipient automatically receives a license from the
-original licensor to copy, distribute, link with or modify the Library
-subject to these terms and conditions.  You may not impose any further
-restrictions on the recipients' exercise of the rights granted herein.
-You are not responsible for enforcing compliance by third parties with
-this License.
-
-  11. If, as a consequence of a court judgment or allegation of patent
-infringement or for any other reason (not limited to patent issues),
-conditions are imposed on you (whether by court order, agreement or
-otherwise) that contradict the conditions of this License, they do not
-excuse you from the conditions of this License.  If you cannot
-distribute so as to satisfy simultaneously your obligations under this
-License and any other pertinent obligations, then as a consequence you
-may not distribute the Library at all.  For example, if a patent
-license would not permit royalty-free redistribution of the Library by
-all those who receive copies directly or indirectly through you, then
-the only way you could satisfy both it and this License would be to
-refrain entirely from distribution of the Library.
-
-If any portion of this section is held invalid or unenforceable under any
-particular circumstance, the balance of the section is intended to apply,
-and the section as a whole is intended to apply in other circumstances.
-
-It is not the purpose of this section to induce you to infringe any
-patents or other property right claims or to contest validity of any
-such claims; this section has the sole purpose of protecting the
-integrity of the free software distribution system which is
-implemented by public license practices.  Many people have made
-generous contributions to the wide range of software distributed
-through that system in reliance on consistent application of that
-system; it is up to the author/donor to decide if he or she is willing
-to distribute software through any other system and a licensee cannot
-impose that choice.
-
-This section is intended to make thoroughly clear what is believed to
-be a consequence of the rest of this License.
-
-  12. If the distribution and/or use of the Library is restricted in
-certain countries either by patents or by copyrighted interfaces, the
-original copyright holder who places the Library under this License may add
-an explicit geographical distribution limitation excluding those countries,
-so that distribution is permitted only in or among countries not thus
-excluded.  In such case, this License incorporates the limitation as if
-written in the body of this License.
-
-  13. The Free Software Foundation may publish revised and/or new
-versions of the Lesser General Public License from time to time.
-Such new versions will be similar in spirit to the present version,
-but may differ in detail to address new problems or concerns.
-
-Each version is given a distinguishing version number.  If the Library
-specifies a version number of this License which applies to it and
-"any later version", you have the option of following the terms and
-conditions either of that version or of any later version published by
-the Free Software Foundation.  If the Library does not specify a
-license version number, you may choose any version ever published by
-the Free Software Foundation.
-
-  14. If you wish to incorporate parts of the Library into other free
-programs whose distribution conditions are incompatible with these,
-write to the author to ask for permission.  For software which is
-copyrighted by the Free Software Foundation, write to the Free
-Software Foundation; we sometimes make exceptions for this.  Our
-decision will be guided by the two goals of preserving the free status
-of all derivatives of our free software and of promoting the sharing
-and reuse of software generally.
-
-			    NO WARRANTY
-
-  15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO
-WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
-EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
-OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY
-KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE
-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
-LIBRARY IS WITH YOU.  SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME
-THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
-
-  16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
-WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY
-AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU
-FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
-CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
-LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
-RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
-FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
-SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
-DAMAGES.
-
-		     END OF TERMS AND CONDITIONS
-
-           How to Apply These Terms to Your New Libraries
-
-  If you develop a new library, and you want it to be of the greatest
-possible use to the public, we recommend making it free software that
-everyone can redistribute and change.  You can do so by permitting
-redistribution under these terms (or, alternatively, under the terms of the
-ordinary General Public License).
-
-  To apply these terms, attach the following notices to the library.  It is
-safest to attach them to the start of each source file to most effectively
-convey the exclusion of warranty; and each file should have at least the
-"copyright" line and a pointer to where the full notice is found.
-
-    <one line to give the library's name and a brief idea of what it does.>
-    Copyright (C) <year>  <name of author>
-
-    This library is free software; you can redistribute it and/or
-    modify it under the terms of the GNU Lesser General Public
-    License as published by the Free Software Foundation; either
-    version 2.1 of the License, or (at your option) any later version.
-
-    This library is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-    Lesser General Public License for more details.
-
-    You should have received a copy of the GNU Lesser General Public
-    License along with this library; if not, write to the Free Software
-    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
-
-Also add information on how to contact you by electronic and paper mail.
-
-You should also get your employer (if you work as a programmer) or your
-school, if any, to sign a "copyright disclaimer" for the library, if
-necessary.  Here is a sample; alter the names:
-
-  Yoyodyne, Inc., hereby disclaims all copyright interest in the
-  library `Frob' (a library for tweaking knobs) written by James Random Hacker.
-
-  <signature of Ty Coon>, 1 April 1990
-  Ty Coon, President of Vice
-
-That's all there is to it!
+  This version of the GNU Lesser General Public License incorporates
+the terms and conditions of version 3 of the GNU General Public
+License, supplemented by the additional permissions listed below.
+
+  0. Additional Definitions.
 
+  As used herein, "this License" refers to version 3 of the GNU Lesser
+General Public License, and the "GNU GPL" refers to version 3 of the GNU
+General Public License.
 
+  "The Library" refers to a covered work governed by this License,
+other than an Application or a Combined Work as defined below.
+
+  An "Application" is any work that makes use of an interface provided
+by the Library, but which is not otherwise based on the Library.
+Defining a subclass of a class defined by the Library is deemed a mode
+of using an interface provided by the Library.
+
+  A "Combined Work" is a work produced by combining or linking an
+Application with the Library.  The particular version of the Library
+with which the Combined Work was made is also called the "Linked
+Version".
+
+  The "Minimal Corresponding Source" for a Combined Work means the
+Corresponding Source for the Combined Work, excluding any source code
+for portions of the Combined Work that, considered in isolation, are
+based on the Application, and not on the Linked Version.
+
+  The "Corresponding Application Code" for a Combined Work means the
+object code and/or source code for the Application, including any data
+and utility programs needed for reproducing the Combined Work from the
+Application, but excluding the System Libraries of the Combined Work.
+
+  1. Exception to Section 3 of the GNU GPL.
+
+  You may convey a covered work under sections 3 and 4 of this License
+without being bound by section 3 of the GNU GPL.
+
+  2. Conveying Modified Versions.
+
+  If you modify a copy of the Library, and, in your modifications, a
+facility refers to a function or data to be supplied by an Application
+that uses the facility (other than as an argument passed when the
+facility is invoked), then you may convey a copy of the modified
+version:
+
+   a) under this License, provided that you make a good faith effort to
+   ensure that, in the event an Application does not supply the
+   function or data, the facility still operates, and performs
+   whatever part of its purpose remains meaningful, or
+
+   b) under the GNU GPL, with none of the additional permissions of
+   this License applicable to that copy.
+
+  3. Object Code Incorporating Material from Library Header Files.
+
+  The object code form of an Application may incorporate material from
+a header file that is part of the Library.  You may convey such object
+code under terms of your choice, provided that, if the incorporated
+material is not limited to numerical parameters, data structure
+layouts and accessors, or small macros, inline functions and templates
+(ten or fewer lines in length), you do both of the following:
+
+   a) Give prominent notice with each copy of the object code that the
+   Library is used in it and that the Library and its use are
+   covered by this License.
+
+   b) Accompany the object code with a copy of the GNU GPL and this license
+   document.
+
+  4. Combined Works.
+
+  You may convey a Combined Work under terms of your choice that,
+taken together, effectively do not restrict modification of the
+portions of the Library contained in the Combined Work and reverse
+engineering for debugging such modifications, if you also do each of
+the following:
+
+   a) Give prominent notice with each copy of the Combined Work that
+   the Library is used in it and that the Library and its use are
+   covered by this License.
+
+   b) Accompany the Combined Work with a copy of the GNU GPL and this license
+   document.
+
+   c) For a Combined Work that displays copyright notices during
+   execution, include the copyright notice for the Library among
+   these notices, as well as a reference directing the user to the
+   copies of the GNU GPL and this license document.
+
+   d) Do one of the following:
+
+       0) Convey the Minimal Corresponding Source under the terms of this
+       License, and the Corresponding Application Code in a form
+       suitable for, and under terms that permit, the user to
+       recombine or relink the Application with a modified version of
+       the Linked Version to produce a modified Combined Work, in the
+       manner specified by section 6 of the GNU GPL for conveying
+       Corresponding Source.
+
+       1) Use a suitable shared library mechanism for linking with the
+       Library.  A suitable mechanism is one that (a) uses at run time
+       a copy of the Library already present on the user's computer
+       system, and (b) will operate properly with a modified version
+       of the Library that is interface-compatible with the Linked
+       Version.
+
+   e) Provide Installation Information, but only if you would otherwise
+   be required to provide such information under section 6 of the
+   GNU GPL, and only to the extent that such information is
+   necessary to install and execute a modified version of the
+   Combined Work produced by recombining or relinking the
+   Application with a modified version of the Linked Version. (If
+   you use option 4d0, the Installation Information must accompany
+   the Minimal Corresponding Source and Corresponding Application
+   Code. If you use option 4d1, you must provide the Installation
+   Information in the manner specified by section 6 of the GNU GPL
+   for conveying Corresponding Source.)
+
+  5. Combined Libraries.
+
+  You may place library facilities that are a work based on the
+Library side by side in a single library together with other library
+facilities that are not Applications and are not covered by this
+License, and convey such a combined library under terms of your
+choice, if you do both of the following:
+
+   a) Accompany the combined library with a copy of the same work based
+   on the Library, uncombined with any other library facilities,
+   conveyed under the terms of this License.
+
+   b) Give prominent notice with the combined library that part of it
+   is a work based on the Library, and explaining where to find the
+   accompanying uncombined form of the same work.
+
+  6. Revised Versions of the GNU Lesser General Public License.
+
+  The Free Software Foundation may publish revised and/or new versions
+of the GNU Lesser General Public License from time to time. Such new
+versions will be similar in spirit to the present version, but may
+differ in detail to address new problems or concerns.
+
+  Each version is given a distinguishing version number. If the
+Library as you received it specifies that a certain numbered version
+of the GNU Lesser General Public License "or any later version"
+applies to it, you have the option of following the terms and
+conditions either of that published version or of any later version
+published by the Free Software Foundation. If the Library as you
+received it does not specify a version number of the GNU Lesser
+General Public License, you may choose any version of the GNU Lesser
+General Public License ever published by the Free Software Foundation.
+
+  If the Library as you received it specifies that a proxy can decide
+whether future versions of the GNU Lesser General Public License shall
+apply, that proxy's public statement of acceptance of any version is
+permanent authorization for you to choose that version for the
+Library.
diff --git a/FAQ b/FAQ
deleted file mode 100644
index 2ff6cad50..000000000
--- a/FAQ
+++ /dev/null
@@ -1,19 +0,0 @@
-Guile FAQ                       -*- outline -*-
-
-* Build problems
-
-** readline.c: error: `rl_pending_input' undeclared
-
-This occurs if the Readline library detected by Guile's configure
-script is actually the BSD Editline project's supposedly
-Readline-compatible library.  The immediate fix is to uninstall
-Editline and install the real GNU Readline instead.  When you do this,
-please note that it probably won't work to keep Editline in /usr and
-install GNU Readline in /usr/local (or some similar arrangement),
-because the Editline library will then still be picked up at link and
-run time; it's best (subject to other constraints) to remove Editline
-completely.
-
-For the longer term, please also report this problem to the Editline
-project, to encourage them to fix it in the next release of their
-Readline compatibility library.
diff --git a/GUILE-VERSION b/GUILE-VERSION
index 9d9539a5c..580a1f506 100644
--- a/GUILE-VERSION
+++ b/GUILE-VERSION
@@ -2,7 +2,7 @@
 
 GUILE_MAJOR_VERSION=1
 GUILE_MINOR_VERSION=9
-GUILE_MICRO_VERSION=0
+GUILE_MICRO_VERSION=2
 
 GUILE_EFFECTIVE_VERSION=${GUILE_MAJOR_VERSION}.${GUILE_MINOR_VERSION}
 GUILE_VERSION=${GUILE_EFFECTIVE_VERSION}.${GUILE_MICRO_VERSION}-bdwgc
diff --git a/HACKING b/HACKING
index f6d518531..ffe04a80d 100644
--- a/HACKING
+++ b/HACKING
@@ -59,8 +59,9 @@ Automake --- a system for automatically generating Makefiles that
 
 libtool --- a system for managing the zillion hairy options needed
 	on various systems to produce shared libraries.  Available in
-	"ftp://ftp.gnu.org/pub/gnu/libtool".  Version 1.5.26 (or
-	later) is needed for correct AIX support.
+	"ftp://ftp.gnu.org/pub/gnu/libtool".  Version 2.2 (or
+	later) is recommended (for correct AIX support, and correct
+	interaction with the Gnulib module for using libunistring).
 
 gettext --- a system for rigging a program so that it can output its
         messages in the local tongue.  Guile presently only exports
@@ -88,6 +89,10 @@ have been known to cause problems, and a short description of the problem.
 - autoreconf from autoconf prior to 2.59 will run gettextize, which
   will mess up the Guile tree.
 
+- libtool 1.5.26 does not know that it should remove the -R options
+  that the Gnulib libunistring and havelib modules generate (because
+  gcc doesn't actually support -R).
+
 - (add here.)
 
 
diff --git a/LICENSE b/LICENSE
index 213e34ae8..3961579b8 100644
--- a/LICENSE
+++ b/LICENSE
@@ -1,2 +1,2 @@
 Guile is covered under the terms of the GNU Lesser General Public
-License, version 2.1.  See COPYING.LESSER.
+License, version 3 or later.  See COPYING.LESSER and COPYING.
diff --git a/Makefile.am b/Makefile.am
index b7de162ce..80231bb37 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -1,38 +1,37 @@
 ## Process this file with automake to produce Makefile.in.
 ##
-##  	Copyright (C) 1998, 1999, 2000, 2001, 2002, 2006, 2007, 2008 Free Software Foundation, Inc.
+##  	Copyright (C) 1998, 1999, 2000, 2001, 2002, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
 ##
 ##   This file is part of GUILE.
 ##
-##   GUILE 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
+##   GUILE is free software; you can redistribute it and/or modify it
+##   under the terms of the GNU Lesser General Public License as
+##   published by the Free Software Foundation; either version 3, or
 ##   (at your option) any later version.
 ##
 ##   GUILE is distributed in the hope that 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.
+##   GNU Lesser General Public License for more details.
 ##
-##   You should have received a copy of the GNU General Public
-##   License along with GUILE; see the file COPYING.  If not, write
-##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-##   Floor, Boston, MA 02110-1301 USA
+##   You should have received a copy of the GNU Lesser General Public
+##   License along with GUILE; see the file COPYING.LESSER.  If not,
+##   write to the Free Software Foundation, Inc., 51 Franklin Street,
+##   Fifth Floor, Boston, MA 02110-1301 USA
 
 # want automake 1.10 or higher so that AM_GNU_GETTEXT can tell automake that
 # config.rpath is needed
 #
 AUTOMAKE_OPTIONS = 1.10
 
-SUBDIRS = lib oop libguile ice-9 guile-config guile-readline emacs \
-	  scripts srfi doc examples test-suite benchmark-suite lang am
-
-bin_SCRIPTS = guile-tools
+SUBDIRS = lib meta libguile guile-readline emacs \
+	  srfi doc examples test-suite benchmark-suite lang am \
+	  module testsuite
 
 include_HEADERS = libguile.h
 
 EXTRA_DIST = LICENSE HACKING GUILE-VERSION		\
-	     m4/ChangeLog-2008 FAQ guile-1.8.pc.in	\
+	     m4/ChangeLog-2008 \
 	     m4/autobuild.m4 ChangeLog-2008
 
 TESTS = check-guile
@@ -41,7 +40,19 @@ ACLOCAL_AMFLAGS = -I m4
 
 DISTCLEANFILES = check-guile.log
 
-pkgconfigdir = $(libdir)/pkgconfig
-pkgconfig_DATA = guile-1.8.pc
+dist-hook: gen-ChangeLog
+
+clean-local:
+	rm -rf cache/
+
+gen_start_rev = 61db429e251bfd2f75cb4632972e0238056eb24b
+.PHONY: gen-ChangeLog
+gen-ChangeLog:
+	if test -d .git; then						\
+	  $(top_srcdir)/build-aux/gitlog-to-changelog			\
+	    $(gen_start_rev)..HEAD > $(distdir)/cl-t;			\
+	  rm -f $(distdir)/ChangeLog;					\
+	  mv $(distdir)/cl-t $(distdir)/ChangeLog;			\
+	fi
 
 # Makefile.am ends here
diff --git a/NEWS b/NEWS
index 5e3f7ae4f..0f2d6930d 100644
--- a/NEWS
+++ b/NEWS
@@ -5,29 +5,566 @@ See the end for copying conditions.
 Please send Guile bug reports to bug-guile@gnu.org.
 
 
-Changes in 1.9.0:
+(During the 1.9 series, we will keep an incremental NEWS for the latest
+prerelease, and a full NEWS corresponding to 1.8 -> 2.0.)
 
-* New modules (see the manual for details)
+Changes in 1.9.3 (since the 1.9.2 prerelease):
 
-** `(srfi srfi-18)', multithreading support
-** The `(ice-9 i18n)' module provides internationalization support
+** Removed deprecated uniform array procedures: scm_make_uve,
+   scm_array_prototype, scm_list_to_uniform_array,
+   scm_dimensions_to_uniform_array, scm_make_ra, scm_shap2ra, scm_cvref,
+   scm_ra_set_contp, scm_aind, scm_raprin1
+
+These functions have been deprecated since early 2005.
+
+** scm_array_p has one argument, not two
+
+Use of the second argument produced a deprecation warning, so it is
+unlikely that any code out there actually used this functionality.
+
+** Removed deprecated uniform array procedures:
+   dimensions->uniform-array, list->uniform-array, array-prototype
+
+Instead, use make-typed-array, list->typed-array, or array-type,
+respectively.
+
+** And of course, the usual collection of bugfixes
+ 
+Interested users should see the ChangeLog for more information.
 
-* Changes to the distribution
 
-** Guile now uses Gnulib as a portability aid
+Changes in 1.9.x (since the 1.8.x series):
+
+* New modules (see the manual for details)
+
+** `(srfi srfi-18)', more sophisticated multithreading support
+** `(ice-9 i18n)', internationalization support
+** `(rnrs bytevector)', the R6RS bytevector API
+** `(rnrs io ports)', a subset of the R6RS I/O port API
+** `(system xref)', a cross-referencing facility (FIXME undocumented)
 
 * Changes to the stand-alone interpreter
+
+** Guile now can compile Scheme to bytecode for a custom virtual machine.
+
+Compiled code loads much faster than Scheme source code, and runs around
+3 or 4 times as fast, generating much less garbage in the process.
+
+** The stack limit is now initialized from the environment.
+
+If getrlimit(2) is available and a stack limit is set, Guile will set
+its stack limit to 80% of the rlimit. Otherwise the limit is 160000
+words, a four-fold increase from the earlier default limit.
+
+** New environment variables: GUILE_LOAD_COMPILED_PATH,
+   GUILE_SYSTEM_LOAD_COMPILED_PATH
+
+GUILE_LOAD_COMPILED_PATH is for compiled files what GUILE_LOAD_PATH is
+for source files. It is a different path, however, because compiled
+files are architecture-specific. GUILE_SYSTEM_LOAD_COMPILED_PATH is like
+GUILE_SYSTEM_PATH.
+
+** New read-eval-print loop (REPL) implementation
+
+Running Guile with no arguments drops the user into the new REPL. While
+it is self-documenting to an extent, the new REPL has not yet been
+documented in the manual. This will be fixed before 2.0.
+
+** New `guile-tools' commands: `compile', `disassemble'
+
+Pass the `--help' command-line option to these commands for more
+information.
+
 * Changes to Scheme functions and syntax
 
-** A new 'memoize-symbol evaluator trap has been added.  This trap can
-be used for efficiently implementing a Scheme code coverage.
+** Procedure removed: `the-environment'
+
+This procedure was part of the interpreter's execution model, and does
+not apply to the compiler.
+
+** Files loaded with `primitive-load-path' will now be compiled
+   automatically.
+
+If a compiled .go file corresponding to a .scm file is not found or is
+not fresh, the .scm file will be compiled on the fly, and the resulting
+.go file stored away. An advisory note will be printed on the console.
+
+Note that this mechanism depends on preservation of the .scm and .go
+modification times; if the .scm or .go files are moved after
+installation, care should be taken to preserve their original
+timestamps.
+
+Autocompiled files will be stored in the $XDG_CACHE_HOME/guile/ccache
+directory, where $XDG_CACHE_HOME defaults to ~/.cache. This directory
+will be created if needed.
+
+To inhibit autocompilation, set the GUILE_AUTO_COMPILE environment
+variable to 0, or pass --no-autocompile on the Guile command line.
+
+Note that there is currently a bug here: automatic compilation will
+sometimes be attempted when it shouldn't.
+
+For example, the old (lang elisp) modules are meant to be interpreted,
+not compiled. This bug will be fixed before 2.0. FIXME 2.0: Should say
+something here about module-transformer called for compile.
+
+** New POSIX procedures: `getrlimit' and `setrlimit'
+
+Note however that the interface of these functions is likely to change
+in the next prerelease.
+
+** New procedure in `(oops goops)': `method-formals'
+
+** BUG: (procedure-property func 'arity) does not work on compiled
+   procedures
+
+This will be fixed one way or another before 2.0.
+
+** New procedures in (ice-9 session): `add-value-help-handler!',
+   `remove-value-help-handler!', `add-name-help-handler!'
+   `remove-name-help-handler!', `procedure-arguments',
+
+The value and name help handlers provide some minimal extensibility to
+the help interface. Guile-lib's `(texinfo reflection)' uses them, for
+example, to make stexinfo help documentation available. See those
+procedures' docstrings for more information.
+
+`procedure-arguments' describes the arguments that a procedure can take,
+combining arity and formals. For example:
+
+  (procedure-arguments resolve-interface)
+  => ((required . (name)) (rest . args))
+
+Additionally, `module-commentary' is now publically exported from
+`(ice-9 session).
+
+** Deprecated: `procedure->memoizing-macro', `procedure->syntax'
+
+These procedures will not work with syncase expansion, and indeed are
+not used in the normal course of Guile. They are still used by the old
+Emacs Lisp support, however.
+
+** New language: ECMAScript
+
+Guile now ships with one other high-level language supported,
+ECMAScript. The goal is to support all of version 3.1 of the standard,
+but not all of the libraries are there yet. This support is not yet
+documented; ask on the mailing list if you are interested.
+
+** New language: Brainfuck
+
+Brainfuck is a toy language that closely models Turing machines. Guile's
+brainfuck compiler is meant to be an example of implementing other
+languages. See the manual for details, or
+http://en.wikipedia.org/wiki/Brainfuck for more information about the
+Brainfuck language itself.
+
+** Defmacros may now have docstrings.
+
+Indeed, any macro may have a docstring. `object-documentation' from
+`(ice-9 documentation)' may be used to retrieve the docstring, once you
+have a macro value -- but see the above note about first-class macros.
+Docstrings are associated with the syntax transformer procedures.
+
+** The psyntax expander now knows how to interpret the @ and @@ special
+   forms.
+
+** The psyntax expander is now hygienic with respect to modules.
+
+Free variables in a macro are scoped in the module that the macro was
+defined in, not in the module the macro is used in. For example, code
+like this works now:
+
+   (define-module (foo) #:export (bar))
+   (define (helper x) ...)
+   (define-syntax bar
+     (syntax-rules () ((_ x) (helper x))))
+
+   (define-module (baz) #:use-module (foo))
+   (bar qux)
+
+It used to be you had to export `helper' from `(foo)' as well.
+Thankfully, this has been fixed.
+
+** New function, `procedure-module'
+
+While useful on its own, `procedure-module' is used by psyntax on syntax
+transformers to determine the module in which to scope introduced
+identifiers.
+
+** `eval-case' has been deprecated, and replaced by `eval-when'.
+
+The semantics of `eval-when' are easier to understand. It is still
+missing documentation, however.
+
+** Guile is now more strict about prohibiting definitions in expression
+   contexts.
+
+Although previous versions of Guile accepted it, the following
+expression is not valid, in R5RS or R6RS:
+
+  (if test (define foo 'bar) (define foo 'baz))
+
+In this specific case, it would be better to do:
+
+  (define foo (if test 'bar 'baz))
+
+It is certainly possible to circumvent this resriction with e.g.
+`(module-define! (current-module) 'foo 'baz)'. We would appreciate
+feedback about this change (a consequence of using psyntax as the
+default expander), and may choose to revisit this situation before 2.0
+in response to user feedback.
+
+** Defmacros must now produce valid Scheme expressions.
+
+It used to be that defmacros could unquote in Scheme values, as a way of
+supporting partial evaluation, and avoiding some hygiene issues. For
+example:
+
+  (define (helper x) ...)
+  (define-macro (foo bar)
+    `(,helper ,bar))
+
+Assuming this macro is in the `(baz)' module, the direct translation of
+this code would be:
+
+  (define (helper x) ...)
+  (define-macro (foo bar)
+    `((@@ (baz) helper) ,bar))
+
+Of course, one could just use a hygienic macro instead:
+
+  (define-syntax foo
+    (syntax-rules ()
+      ((_ bar) (helper bar))))
+
+** Guile's psyntax now supports docstrings and internal definitions.
+
+The following Scheme is not strictly legal:
+
+  (define (foo)
+    "bar"
+    (define (baz) ...)
+    (baz))
+
+However its intent is fairly clear. Guile interprets "bar" to be the
+docstring of `foo', and the definition of `baz' is still in definition
+context.
+
+** Macros need to be defined before their first use.
+
+It used to be that with lazy memoization, this might work:
+
+  (define (foo x)
+    (ref x))
+  (define-macro (ref x) x)
+  (foo 1) => 1
+
+But now, the body of `foo' is interpreted to mean a call to the toplevel
+`ref' function, instead of a macro expansion. The solution is to define
+macros before code that uses them.
+
+** Functions needed by macros at expand-time need to be present at
+   expand-time.
+
+For example, this code will work at the REPL:
+
+  (define (double-helper x) (* x x))
+  (define-macro (double-literal x) (double-helper x))
+  (double-literal 2) => 4
+
+But it will not work when a file is compiled, because the definition of
+`double-helper' is not present at expand-time. The solution is to wrap
+the definition of `double-helper' in `eval-when':
+
+  (eval-when (load compile eval)
+    (define (double-helper x) (* x x)))
+  (define-macro (double-literal x) (double-helper x))
+  (double-literal 2) => 4
+
+See the (currently missing) documentation for eval-when for more
+information.
+
+** New variable, %pre-modules-transformer
+
+Need to document this one some more.
+
+** Temporarily removed functions: `macroexpand', `macroexpand-1'
+
+`macroexpand' will be added back before 2.0. It is unclear how to
+implement `macroexpand-1' with syntax-case, though PLT Scheme does prove
+that it is possible.
+
+** New reader macros: #' #` #, #,@
+
+These macros translate, respectively, to `syntax', `quasisyntax',
+`unsyntax', and `unsyntax-splicing'. See the R6RS for more information.
+These reader macros may be overridden by `read-hash-extend'.
+
+** Incompatible change to #'
+
+Guile did have a #' hash-extension, by default, which just returned the
+subsequent datum: #'foo => foo. In the unlikely event that anyone
+actually used this, this behavior may be reinstated via the
+`read-hash-extend' mechanism.
+
+** Scheme expresssions may be commented out with #;
+
+#; comments out an entire expression.  See SRFI-62 or the R6RS for more
+information.
+
+** `make-stack' with a tail-called procedural narrowing argument no longer
+   works (with compiled procedures)
+
+It used to be the case that a captured stack could be narrowed to select
+calls only up to or from a certain procedure, even if that procedure
+already tail-called another procedure. This was because the debug
+information from the original procedure was kept on the stack.
+
+Now with the new compiler, the stack only contains active frames from
+the current continuation. A narrow to a procedure that is not in the
+stack will result in an empty stack. To fix this, narrow to a procedure
+that is active in the current continuation, or narrow to a specific
+number of stack frames.
+
+** backtraces through compiled procedures only show procedures that are
+   active in the current continuation
+
+Similarly to the previous issue, backtraces in compiled code may be
+different from backtraces in interpreted code. There are no semantic
+differences, however. Please mail bug-guile@gnu.org if you see any
+deficiencies with Guile's backtraces.
+
+** syntax-rules and syntax-case macros now propagate source information
+   through to the expanded code
+
+This should result in better backtraces.
+
+** The currying behavior of `define' has been removed.
+
+Before, `(define ((f a) b) (* a b))' would translate to
+
+  (define f (lambda (a) (lambda (b) (* a b))))
+
+Now a syntax error is signaled, as this syntax is not supported by
+default. If there is sufficient demand, this syntax can be supported
+again by default.
+
+** All modules have names now
+
+Before, you could have anonymous modules: modules without names. Now,
+because of hygiene and macros, all modules have names. If a module was
+created without a name, the first time `module-name' is called on it, a
+fresh name will be lazily generated for it.
+
+** Many syntax errors have different texts now
+
+Syntax errors still throw to the `syntax-error' key, but the arguments
+are often different now. Perhaps in the future, Guile will switch to
+using standard SRFI-35 conditions.
+
+** Returning multiple values to compiled code will silently truncate the
+   values to the expected number
+
+For example, the interpreter would raise an error evaluating the form,
+`(+ (values 1 2) (values 3 4))', because it would see the operands as
+being two compound "values" objects, to which `+' does not apply.
+
+The compiler, on the other hand, receives multiple values on the stack,
+not as a compound object. Given that it must check the number of values
+anyway, if too many values are provided for a continuation, it chooses
+to truncate those values, effectively evaluating `(+ 1 3)' instead.
+
+The idea is that the semantics that the compiler implements is more
+intuitive, and the use of the interpreter will fade out with time.
+This behavior is allowed both by the R5RS and the R6RS.
+
+** Multiple values in compiled code are not represented by compound
+   objects
+
+This change may manifest itself in the following situation:
+
+  (let ((val (foo))) (do-something) val)
+
+In the interpreter, if `foo' returns multiple values, multiple values
+are produced from the `let' expression. In the compiler, those values
+are truncated to the first value, and that first value is returned. In
+the compiler, if `foo' returns no values, an error will be raised, while
+the interpreter would proceed.
+
+Both of these behaviors are allowed by R5RS and R6RS. The compiler's
+behavior is more correct, however. If you wish to preserve a potentially
+multiply-valued return, you will need to set up a multiple-value
+continuation, using `call-with-values'.
+
+** Defmacros are now implemented in terms of syntax-case.
+
+The practical ramification of this is that the `defmacro?' predicate has
+been removed, along with `defmacro-transformer', `macro-table',
+`xformer-table', `assert-defmacro?!', `set-defmacro-transformer!' and
+`defmacro:transformer'. This is because defmacros are simply macros. If
+any of these procedures provided useful facilities to you, we encourage
+you to contact the Guile developers.
+
+** psyntax is now the default expander
+
+Scheme code is now expanded by default by the psyntax hygienic macro
+expander. Expansion is performed completely before compilation or
+interpretation.
+
+Notably, syntax errors will be signalled before interpretation begins.
+In the past, many syntax errors were only detected at runtime if the
+code in question was memoized.
+
+As part of its expansion, psyntax renames all lexically-bound
+identifiers. Original identifier names are preserved and given to the
+compiler, but the interpreter will see the renamed variables, e.g.,
+`x432' instead of `x'.
+
+Note that the psyntax that Guile uses is a fork, as Guile already had
+modules before incompatible modules were added to psyntax -- about 10
+years ago! Thus there are surely a number of bugs that have been fixed
+in psyntax since then. If you find one, please notify bug-guile@gnu.org.
+
+** syntax-rules and syntax-case are available by default.
+
+There is no longer any need to import the `(ice-9 syncase)' module
+(which is now deprecated). The expander may be invoked directly via
+`sc-expand', though it is normally searched for via the current module
+transformer.
+
+Also, the helper routines for syntax-case are available in the default
+environment as well: `syntax->datum', `datum->syntax',
+`bound-identifier=?', `free-identifier=?', `generate-temporaries',
+`identifier?', and `syntax-violation'. See the R6RS for documentation.
+
+** Lexical bindings introduced by hygienic macros may not be referenced
+   by nonhygienic macros.
+
+If a lexical binding is introduced by a hygienic macro, it may not be
+referenced by a nonhygienic macro. For example, this works:
+
+  (let ()
+    (define-macro (bind-x val body)
+      `(let ((x ,val)) ,body))
+    (define-macro (ref x)
+      x)
+    (bind-x 10 (ref x)))
+
+But this does not:
+
+  (let ()
+    (define-syntax bind-x
+      (syntax-rules ()
+        ((_ val body) (let ((x val)) body))))
+    (define-macro (ref x)
+      x)
+    (bind-x 10 (ref x)))
+
+It is not normal to run into this situation with existing code. However,
+as code is ported over from defmacros to syntax-case, it is possible to
+run into situations like this. In the future, Guile will probably port
+its `while' macro to syntax-case, which makes this issue one to know
+about.
+
+** Macros may no longer be referenced as first-class values.
+
+In the past, you could evaluate e.g. `if', and get its macro value. Now,
+expanding this form raises a syntax error.
+
+Macros still /exist/ as first-class values, but they must be
+/referenced/ via the module system, e.g. `(module-ref (current-module)
+'if)'.
+
+This decision may be revisited before the 2.0 release. Feedback welcome
+to guile-devel@gnu.org (subscription required) or bug-guile@gnu.org (no
+subscription required).
+
+** Unicode characters
+
+Unicode characters may be entered in octal format via e.g. `#\454', or
+created via (integer->char 300). A hex external representation will
+probably be introduced at some point.
+
+** Unicode strings
+
+Internally, strings are now represented either in the `latin-1'
+encoding, one byte per character, or in UTF-32, with four bytes per
+character. Strings manage their own allocation, switching if needed.
+
+Currently no locale conversion is performed. Extended characters may be
+written in a string using the hexadecimal escapes `\xXX', `\uXXXX', or
+`\UXXXXXX', for 8-bit, 16-bit, or 24-bit codepoints, respectively.
+
+** Global variables `scm_charnames' and `scm_charnums' are removed
+
+These variables contained the names of control characters and were
+used when writing characters.  While these were global, they were
+never intended to be public API.  They have been replaced with private
+functions.
+
+** EBCDIC support is removed
+
+There was an EBCDIC compile flag that altered some of the character
+processing.  It appeared that full EBCDIC support was never completed
+and was unmaintained.
+
+** New macro type: syncase-macro
+
+XXX Need to decide whether to document this for 2.0, probably should:
+make-syncase-macro, make-extended-syncase-macro, macro-type,
+syncase-macro-type, syncase-macro-binding
+
+** A new `memoize-symbol' evaluator trap has been added.
+
+This trap can be used for efficiently implementing a Scheme code
+coverage.
 
 ** Duplicate bindings among used modules are resolved lazily.
+
 This slightly improves program startup times.
 
 ** New thread cancellation and thread cleanup API
+
 See `cancel-thread', `set-thread-cleanup!', and `thread-cleanup'.
 
+** Fix bad interaction between `false-if-exception' and stack-call.
+
+Exceptions thrown by `false-if-exception' were erronously causing the
+stack to be saved, causing later errors to show the incorrectly-saved
+backtrace. This has been fixed.
+
+** New global variables: %load-compiled-path, %load-compiled-extensions
+
+These are analogous to %load-path and %load-extensions.
+
+** New procedure, `make-promise'
+
+`(make-promise (lambda () foo))' is equivalent to `(delay foo)'.
+
+** `defined?' may accept a module as its second argument
+
+Previously it only accepted internal structures from the evaluator.
+
+** New entry into %guile-build-info: `ccachedir'
+
+** Fix bug in `module-bound?'.
+
+`module-bound?' was returning true if a module did have a local
+variable, but one that was unbound, but another imported module bound
+the variable. This was an error, and was fixed.
+
+** `(ice-9 syncase)' has been deprecated.
+
+As syntax-case is available by default, importing `(ice-9 syncase)' has
+no effect, and will trigger a deprecation warning.
+
+** Removed deprecated uniform array procedures:
+   dimensions->uniform-array, list->uniform-array, array-prototype
+
+Instead, use make-typed-array, list->typed-array, or array-type,
+respectively.
+
 * Changes to the C interface
 
 ** The GH interface (deprecated in version 1.6, 2001) was removed.
@@ -40,18 +577,93 @@ application code.
 ** Functions for handling `scm_option' now no longer require an argument
 indicating length of the `scm_t_option' array.
 
-** Primitive procedures (aka. "subrs") are now stored in double cells
-This removes the subr table and simplifies the code.
+** scm_primitive_load_path has additional argument, exception_on_error
+
+** New C function: scm_module_public_interface
+
+This procedure corresponds to Scheme's `module-public-interface'.
+
+** `scm_stat' has an additional argument, `exception_on_error'
+** `scm_primitive_load_path' has an additional argument `exception_on_not_found'
+
+** `scm_set_port_seek' and `scm_set_port_truncate' use the `scm_t_off' type
+
+Previously they would use the `off_t' type, which is fragile since its
+definition depends on the application's value for `_FILE_OFFSET_BITS'.
+
+** The `long_long' C type, deprecated in 1.8, has been removed
+
+** Removed deprecated uniform array procedures: scm_make_uve,
+   scm_array_prototype, scm_list_to_uniform_array,
+   scm_dimensions_to_uniform_array, scm_make_ra, scm_shap2ra, scm_cvref,
+   scm_ra_set_contp, scm_aind, scm_raprin1
+
+These functions have been deprecated since early 2005.
+
+** scm_array_p has one argument, not two
+
+Use of the second argument produced a deprecation warning, so it is
+unlikely that any code out there actually used this functionality.
+
+* Changes to the distribution
+
+** Guile's license is now LGPLv3+
+
+In other words the GNU Lesser General Public License, version 3 or
+later (at the discretion of each person that chooses to redistribute
+part of Guile).
+
+** `guile-config' will be deprecated in favor of `pkg-config'
+
+`guile-config' has been rewritten to get its information from
+`pkg-config', so this should be a transparent change.  Note however that
+guile.m4 has yet to be modified to call pkg-config instead of
+guile-config.
+
+** Guile now provides `guile-2.0.pc' instead of `guile-1.8.pc'
+
+Programs that use `pkg-config' to find Guile or one of its Autoconf
+macros should now require `guile-2.0' instead of `guile-1.8'.
+
+** New installation directory: $(pkglibdir)/1.9/ccache
+
+If $(libdir) is /usr/lib, for example, Guile will install its .go files
+to /usr/lib/guile/1.9/ccache. These files are architecture-specific.
+
+** New dependency: GNU libunistring.
+
+See http://www.gnu.org/software/libunistring/, for more information. Our
+unicode support uses routines from libunistring.
+
+
+
+Changes in 1.8.8 (since 1.8.7)
+
+* Bugs fixed
+
+** Fix possible buffer overruns when parsing numbers
+** Avoid clash with system setjmp/longjmp on IA64
 
 
 Changes in 1.8.7 (since 1.8.6)
 
+* New modules (see the manual for details)
+
+** `(srfi srfi-98)', an interface to access environment variables
+
 * Bugs fixed
 
+** Fix compilation with `--disable-deprecated'
 ** Fix %fast-slot-ref/set!, to avoid possible segmentation fault
 ** Fix MinGW build problem caused by HAVE_STRUCT_TIMESPEC confusion
 ** Fix build problem when scm_t_timespec is different from struct timespec
 ** Fix build when compiled with -Wundef -Werror
+** More build fixes for `alphaev56-dec-osf5.1b' (Tru64)
+** Build fixes for `powerpc-ibm-aix5.3.0.0' (AIX 5.3)
+** With GCC, always compile with `-mieee' on `alpha*' and `sh*'
+** Better diagnose broken `(strftime "%z" ...)' in `time.test' (bug #24130)
+** Fix parsing of SRFI-88/postfix keywords longer than 128 characters
+** Fix reading of complex numbers where both parts are inexact decimals
 
 ** Allow @ macro to work with (ice-9 syncase)
 
@@ -60,6 +672,8 @@ transformed by (ice-9 syncase) would cause an "Invalid syntax" error.
 Now it works as you would expect (giving the value of the specified
 module binding).
 
+** Have `scm_take_locale_symbol ()' return an interned symbol (bug #25865)
+
 
 Changes in 1.8.6 (since 1.8.5)
 
@@ -178,13 +792,6 @@ lead to a stack overflow.
 ** Fixed shadowing of libc's <random.h> on Tru64, which broke compilation
 ** Make sure all tests honor `$TMPDIR'
 
-* Changes to the distribution
-
-** New FAQ
-
-We've started collecting Frequently Asked Questions (FAQ), and will
-distribute these (with answers!) in future Guile releases.
-
 
 Changes in 1.8.4 (since 1.8.3)
 
diff --git a/NEWS.guile-vm b/NEWS.guile-vm
new file mode 100644
index 000000000..c82942f4f
--- /dev/null
+++ b/NEWS.guile-vm
@@ -0,0 +1,57 @@
+Guile-VM NEWS
+
+
+Guile-VM is a bytecode compiler and virtual machine for Guile.
+
+
+guile-vm 0.7 -- 2008-05-20
+==========================
+
+* Initial release with NEWS.
+
+* Revived from Keisuke Nishida's Guile-VM project from 2000-2001, with
+  the help of Ludovic Courtès.
+
+* Meta-level changes
+** Updated to compile with Guile 1.8.
+** Documentation updated, including documentation on the instructions.
+** Added benchmarking and a test harness.
+
+* Changes to the inventory
+** Renamed the library from libguilevm to libguile-vm.
+** Added new executable script, guile-disasm.
+
+* New features
+** Add support for compiling macros, both defmacros and syncase macros.
+Primitive macros produced with the procedure->macro family of procedures
+are not supported, however.
+** Improvements to the REPL
+Multiple values support, readline integration, ice-9 history integration
+** Add support for eval-case
+The compiler recognizes compile-toplevel in addition to load-toplevel
+** Completely self-compiling
+Almost, anyway: not (system repl describe), because it uses GOOPS
+
+* Internal cleanups
+** Internal objects are now based on Guile records.
+** Guile-VM's code doesn't use the dot-syntax any more.
+** Changed (ice-9 match) for Kiselyov's pmatch.scm
+** New instructions: define, link-later, link-now, late-variable-{ref,set}
+** Object code now represented as u8vectors instead of strings.
+** Remove local import of an old version of slib
+
+* Bugfixes
+** The `optimize' procedure is coming out of bitrot
+** The Scheme compiler is now more strict about placement of internal
+   defines
+** set! is now compiled differently from define
+** Module-level variables are now bound at first use instead of in the
+   program prolog
+** Bugfix to load-program (stack misinterpretation)
+
+
+Copyright (C) 2008 Free Software Foundation, Inc.
+
+Copying and distribution of this file, with or without modification, are
+permitted in any medium without royalty provided the copyright notice
+and this notice are preserved.
diff --git a/README b/README
index 3af511b38..bea40debc 100644
--- a/README
+++ b/README
@@ -14,7 +14,7 @@ Guile versions with an odd middle number, i.e. 1.9.* are unstable
 development versions.  Even middle numbers indicate stable versions.
 This has been the case since the 1.3.* series.
 
-The next stable release will likely be version 1.10.0.
+The next stable release will likely be version 2.0.0.
 
 Please send bug reports to bug-guile@gnu.org.
 
@@ -27,24 +27,38 @@ Generic instructions for configuring and compiling Guile can be found
 in the INSTALL file.  Guile specific information and configure options
 can be found below, including instructions for installing SLIB.
 
-Guile requires a few external packages and can optionally use a number
-of external packages such as `readline' when they are available.
-Guile expects to be able to find these packages in the default
-compiler setup, it does not try to make any special arrangements
-itself.  For example, for the `readline' package, Guile expects to be
-able to find the include file <readline/readline.h>, without passing
-any special `-I' options to the compiler.
-
-If you installed an external package, and you used the --prefix
-installation option to install it somewhere else than /usr/local, you
-must arrange for your compiler to find it by default.  If that
-compiler is gcc, one convenient way of making such arrangements is to
-use the --with-local-prefix option during installation, naming the
-same directory as you used in the --prefix option of the package.  In
-particular, it is not good enough to use the same --prefix option when
-you install gcc and the package; you need to use the
---with-local-prefix option as well.  See the gcc documentation for
-more details.
+Guile depends on the following external libraries.
+- libgmp
+- libiconv
+- libintl
+- libltdl
+- libunistring
+It will also use the libreadline library if it is available.  For each
+of these there is a corresponding --with-XXX-prefix option that you
+can use when invoking ./configure, if you have these libraries
+installed in a location other than the standard places (/usr and
+/usr/local).
+
+These options are provided by the Gnulib `havelib' module, and details
+of how they work are documented in `Searching for Libraries' in the
+Gnulib manual (http://www.gnu.org/software/gnulib/manual).  The extent
+to which they work on a given OS depends on whether that OS supports
+encoding full library path names in executables (aka `rpath').  Also
+note that using these options, and hence hardcoding full library path
+names (where that is supported), makes it impossible to later move the
+built executables and libraries to an installation location other than
+the one that was specified at build time.
+
+Another possible approach is to set CPPFLAGS and LDFLAGS before
+running configure, so that they include -I options for all the
+non-standard places where you have installed header files and -L
+options for all the non-standard places where you have installed
+libraries.  This will allow configure and make to find those headers
+and libraries during the build.  The locations found will not be
+hardcoded into the build executables and libraries, so with this
+approach you will probably also need to set LD_LIBRARY_PATH
+correspondingly, to allow Guile to find the necessary libraries again
+at runtime.
 
 
 Required External Packages ================================================
@@ -61,6 +75,12 @@ Guile requires the following external packages:
     libltdl is used for loading extensions at run-time.  It is
     available from http://www.gnu.org/software/libtool/
 
+  - GNU libunistring
+
+    libunistring is used for Unicode string operations, such as the
+    `utf*->string' procedures.  It is available from
+    http://www.gnu.org/software/libunistring/ .
+
 
 Special Instructions For Some Systems =====================================
 
@@ -223,9 +243,23 @@ GUILE_FOR_BUILD variable, it defaults to just "guile".
 
 Using Guile Without Installing It =========================================
 
-The top directory of the Guile sources contains a script called
-"pre-inst-guile" that can be used to run the Guile that has just been
-built.
+The "meta/" subdirectory of the Guile sources contains a script called
+"guile" that can be used to run the Guile that has just been built. Note
+that this is not the same "guile" as the one that is installed; this
+"guile" is a wrapper script that sets up the environment appropriately,
+then invokes the Guile binary.
+
+You may also build external packages against an uninstalled Guile build
+tree. The "uninstalled-env" script in the "meta/" subdirectory will set
+up an environment with a path including "meta/", a modified dynamic
+linker path, a modified PKG_CONFIG_PATH, etc.
+
+For example, you can enter this environment via invoking
+
+    meta/uninstalled-env bash
+
+Within that shell, other packages should be able to build against
+uninstalled Guile.
 
 
 Installing SLIB ===========================================================
@@ -265,9 +299,8 @@ Guile Documentation ==================================================
 
 If you've never used Scheme before, then the Guile Tutorial
 (guile-tut.info) is a good starting point.  The Guile Reference Manual
-(guile.info) is the primary documentation for Guile.  The Goops object
-system is documented separately (goops.info).  A copy of the R5RS
-Scheme specification is included too (r5rs.info).
+(guile.info) is the primary documentation for Guile.  A copy of the
+R5RS Scheme specification is included too (r5rs.info).
 
 Info format versions of this documentation are installed as part of
 the normal build process.  The texinfo sources are under the doc
@@ -289,6 +322,7 @@ About This Distribution ==============================================
 Interesting files include:
 
 - LICENSE, which contains the exact terms of the Guile license.
+- COPYING.LESSER, which contains the terms of the GNU Lesser General Public License.
 - COPYING, which contains the terms of the GNU General Public License.
 - INSTALL, which contains general instructions for building/installing Guile.
 - NEWS, which describes user-visible changes since the last release of Guile.
diff --git a/README.guile-vm b/README.guile-vm
new file mode 100644
index 000000000..72ab6c914
--- /dev/null
+++ b/README.guile-vm
@@ -0,0 +1,117 @@
+This is an attempt to revive the Guile-VM project by Keisuke Nishida
+written back in the years 2000 and 2001.  Below are a few pointers to
+relevant threads on Guile's development mailing list.
+
+Enjoy!
+
+Ludovic Court�s <ludovic.courtes@laas.fr>, Apr. 2005.
+
+
+Pointers
+--------
+
+Status of the last release, 0.5
+  http://lists.gnu.org/archive/html/guile-devel/2001-04/msg00266.html
+
+The very first release, 0.0
+  http://sources.redhat.com/ml/guile/2000-07/msg00418.html
+
+Simple benchmark
+  http://sources.redhat.com/ml/guile/2000-07/msg00425.html
+
+Performance, portability, GNU Lightning
+  http://lists.gnu.org/archive/html/guile-devel/2001-03/msg00132.html
+
+Playing with GNU Lightning
+  http://lists.gnu.org/archive/html/guile-devel/2001-03/msg00185.html
+
+On things left to be done
+  http://lists.gnu.org/archive/html/guile-devel/2001-03/msg00146.html
+
+
+---8<---  Original README below.  -----------------------------------------
+
+Installation
+------------
+
+1. Install the latest Guile from CVS.
+
+2. Install Guile VM:
+
+  % configure
+  % make install
+  % ln -s module/{guile,system,language} /usr/local/share/guile/
+
+3. Add the following lines to your ~/.guile:
+
+  (use-modules (system vm core)
+
+  (cond ((string=? (car (command-line)) "guile-vm")
+	 (use-modules (system repl repl))
+	 (start-repl 'scheme)
+	 (quit)))
+
+Example Session
+---------------
+
+  % guile-vm
+  Guile Scheme interpreter 0.5 on Guile 1.4.1
+  Copyright (C) 2001 Free Software Foundation, Inc.
+
+  Enter `,help' for help.
+  scheme@guile-user> (+ 1 2)
+  3
+  scheme@guile-user> ,c -c (+ 1 2)	;; Compile into GLIL
+  (@asm (0 1 0 0)
+    (module-ref #f +)
+    (const 1)
+    (const 2)
+    (tail-call 2))
+  scheme@guile-user> ,c (+ 1 2)		;; Compile into object code
+  Disassembly of #<objcode 403c5fb0>:
+
+  nlocs = 0  nexts = 0
+
+     0    link "+"                        ;; (+ . ???)
+     3    variable-ref
+     4    make-int8:1                     ;; 1
+     5    make-int8 2                     ;; 2
+     7    tail-call 2
+
+  scheme@guile-user> (define (add x y) (+ x y))
+  scheme@guile-user> (add 1 2)
+  3
+  scheme@guile-user> ,x add		;; Disassemble
+  Disassembly of #<program add>:
+
+  nargs = 2  nrest = 0  nlocs = 0  nexts = 0
+
+  Bytecode:
+
+     0    object-ref 0                    ;; (+ . #<primitive-procedure +>)
+     2    variable-ref
+     3    local-ref 0
+     5    local-ref 1
+     7    tail-call 2
+
+  Objects:
+
+     0    (+ . #<primitive-procedure +>)
+
+  scheme@guile-user> 
+
+Compile Modules
+---------------
+
+Use `guilec' to compile your modules:
+
+  % cat fib.scm
+  (define-module (fib) :export (fib))
+  (define (fib n) (if (< n 2) 1 (+ (fib (- n 1)) (fib (- n 2)))))
+
+  % guilec fib.scm
+  Wrote fib.go
+  % guile
+  guile> (use-modules (fib))
+  guile> (fib 8)
+  34
diff --git a/THANKS b/THANKS
index d93837d3b..90121094b 100644
--- a/THANKS
+++ b/THANKS
@@ -3,6 +3,7 @@ Contributors since the last release:
 	    Rob Browning
         Ludovic Courtès
          Julian Graham
+	   Mike Gran
          Stefan Jahn
            Neil Jerram
         Gregory Marton
@@ -13,6 +14,7 @@ Contributors since the last release:
 	  Kevin Ryde
 	   Bill Schottstaedt
         Richard Todd
+           Andy Wingo
 
 Sponsors since the last release:
 
@@ -23,10 +25,12 @@ For fixes or providing information which led to a fix:
           David Allouche
 	 Martin Baulig
         Fabrice Bauzac
+        Sylvain Beucler
           Carlo Bramini
             Rob Browning
          Adrian Bunk
         Michael Carmack
+              R Clayton
         Stephen Compall
           Brian Crowder
     Christopher Cramer
@@ -37,6 +41,7 @@ For fixes or providing information which led to a fix:
          John W Eaton
 	Clinton Ebadi
           David Fang
+          Barry Fishman
         Charles Gagnon
           Peter Gavin
            Eric Gillespie, Jr
@@ -48,6 +53,7 @@ For fixes or providing information which led to a fix:
          Roland Haeder
 	   Sven Hartrumpf
 	   Eric Hanchrow
+	   Judy Hawkins
             Sam Hocevar
 	Patrick Horgan
            Ales Hvezda
@@ -61,10 +67,12 @@ For fixes or providing information which led to a fix:
            René Köcher
        Matthias Köppe
            Matt Kraai
+         Daniel Kraft
        Miroslav Lichvar
            Jeff Long
 	  Marco Maggi
         Gregory Marton
+      Kjetil S. Matheussen
         Antoine Mathys
             Dan McMahill
           Roger Mc Murtrie
@@ -82,15 +90,18 @@ For fixes or providing information which led to a fix:
           David Pirotte
          Carlos Pita
             Ken Raeburn
+         Juhani Rantanen
         Andreas Rottmann
            Hugh Sasse
          Werner Scheinast
 	   Bill Schottstaedt
 	  Frank Schwidom
+    John Steele Scott
          Thiemo Seufer
           Scott Shedden
            Alex Shinn
          Daniel Skarda
+           Dale Smith
           Cesar Strauss
          Rainer Tammer
         Richard Todd
@@ -106,6 +117,8 @@ For fixes or providing information which led to a fix:
 	Andreas Vögele
         Michael Talbot-Wilson
         Michael Tuexen
+         Thomas Wawrzinek
+        Mark H. Weaver
             Jon Wilson
            Andy Wingo
           Keith Wright
diff --git a/THANKS.guile-vm b/THANKS.guile-vm
new file mode 100644
index 000000000..e3ea26ec5
--- /dev/null
+++ b/THANKS.guile-vm
@@ -0,0 +1 @@
+Guile VM was inspired by QScheme, librep, and Objective Caml.
diff --git a/acinclude.m4 b/acinclude.m4
index 3e1dbeb2a..680003309 100644
--- a/acinclude.m4
+++ b/acinclude.m4
@@ -311,7 +311,6 @@ fi
 AC_LANG_RESTORE
 ])dnl ACX_PTHREAD
 
-
 dnl Check whether GNU ld's read-only relocations (the `PT_GNU_RELRO'
 dnl ELF segment header) are supported.  This allows things like
 dnl statically allocated cells (1) to eventually be remapped read-only
@@ -327,3 +326,70 @@ AC_DEFUN([GUILE_GNU_LD_RELRO], [
     [AC_MSG_RESULT([no])
      LDFLAGS="$save_LDFLAGS"])
 ])
+
+dnl GUILE_READLINE
+dnl
+dnl Check all the things needed by `guile-readline', the Readline
+dnl bindings.
+AC_DEFUN([GUILE_READLINE], [
+  for termlib in ncurses curses termcap terminfo termlib ; do
+     AC_CHECK_LIB(${termlib}, [tgoto],
+       [READLINE_LIBS="-l${termlib} $READLINE_LIBS"; break])
+  done
+
+  AC_LIB_LINKFLAGS([readline])
+
+  if test "x$LTLIBREADLINE" = "x"; then
+    AC_MSG_WARN([GNU Readline was not found on your system.])
+  else
+    rl_save_LIBS="$LIBS"
+    LIBS="$LIBREADLINE $READLINE_LIBS $LIBS"
+
+    AC_CHECK_FUNCS([siginterrupt rl_clear_signals rl_cleanup_after_signal])
+
+    dnl Check for modern readline naming
+    AC_CHECK_FUNCS([rl_filename_completion_function])
+
+    dnl Check for rl_get_keymap.  We only use this for deciding whether to
+    dnl install paren matching on the Guile command line (when using
+    dnl readline for input), so it's completely optional.
+    AC_CHECK_FUNCS([rl_get_keymap])
+
+    AC_CACHE_CHECK([for rl_getc_function pointer in readline],
+		     ac_cv_var_rl_getc_function,
+		     [AC_TRY_LINK([
+    #include <stdio.h>
+    #include <readline/readline.h>],
+				  [printf ("%ld", (long) rl_getc_function)],
+				  [ac_cv_var_rl_getc_function=yes],
+				  [ac_cv_var_rl_getc_function=no])])
+    if test "${ac_cv_var_rl_getc_function}" = "yes"; then
+      AC_DEFINE([HAVE_RL_GETC_FUNCTION], 1,
+	[Define if your readline library has the rl_getc_function variable.])
+    fi
+
+    if test $ac_cv_var_rl_getc_function = no; then
+      AC_MSG_WARN([*** GNU Readline is too old on your system.])
+      AC_MSG_WARN([*** You need readline version 2.1 or later.])
+      LTLIBREADLINE=""
+      LIBREADLINE=""
+    fi
+
+    LIBS="$rl_save_LIBS"
+
+    READLINE_LIBS="$LTLIBREADLINE $READLINE_LIBS"
+  fi
+
+  AM_CONDITIONAL([HAVE_READLINE], [test "x$LTLIBREADLINE" != "x"])
+
+  AC_CHECK_FUNCS([strdup])
+
+  AC_SUBST([READLINE_LIBS])
+
+  . $srcdir/guile-readline/LIBGUILEREADLINE-VERSION
+  AC_SUBST(LIBGUILEREADLINE_MAJOR)
+  AC_SUBST(LIBGUILEREADLINE_INTERFACE_CURRENT)
+  AC_SUBST(LIBGUILEREADLINE_INTERFACE_REVISION)
+  AC_SUBST(LIBGUILEREADLINE_INTERFACE_AGE)
+  AC_SUBST(LIBGUILEREADLINE_INTERFACE)
+])
diff --git a/am/Makefile.am b/am/Makefile.am
index 8b49c2bca..d1b7eccc7 100644
--- a/am/Makefile.am
+++ b/am/Makefile.am
@@ -4,24 +4,24 @@
 ##
 ##   This file is part of GUILE.
 ##
-##   GUILE 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
+##   GUILE is free software; you can redistribute it and/or modify it
+##   under the terms of the GNU Lesser General Public License as
+##   published by the Free Software Foundation; either version 3, or
 ##   (at your option) any later version.
 ##
 ##   GUILE is distributed in the hope that 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.
+##   GNU Lesser General Public License for more details.
 ##
-##   You should have received a copy of the GNU General Public
-##   License along with GUILE; see the file COPYING.  If not, write
-##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-##   Floor, Boston, MA 02110-1301 USA
+##   You should have received a copy of the GNU Lesser General Public
+##   License along with GUILE; see the file COPYING.LESSER.  If not,
+##   write to the Free Software Foundation, Inc., 51 Franklin Street,
+##   Fifth Floor, Boston, MA 02110-1301 USA
 
 AUTOMAKE_OPTIONS = gnu
 
-am_frags = pre-inst-guile maintainer-dirs
+am_frags = pre-inst-guile maintainer-dirs guilec
 
 EXTRA_DIST = $(am_frags) ChangeLog-2008
 
diff --git a/am/guilec b/am/guilec
new file mode 100644
index 000000000..ce0711b74
--- /dev/null
+++ b/am/guilec
@@ -0,0 +1,33 @@
+# -*- makefile -*-
+GOBJECTS = $(SOURCES:%.scm=%.go)
+
+moddir = $(pkgdatadir)/$(GUILE_EFFECTIVE_VERSION)/$(modpath)
+nobase_mod_DATA = $(SOURCES) $(NOCOMP_SOURCES)
+ccachedir = $(pkglibdir)/$(GUILE_EFFECTIVE_VERSION)/ccache/$(modpath)
+nobase_ccache_DATA = $(GOBJECTS)
+EXTRA_DIST = $(SOURCES) $(NOCOMP_SOURCES)
+
+CLEANFILES = $(GOBJECTS)
+
+# Well, shit. We can't have install changing timestamps, can we? But
+# install_sh doesn't know how to preserve timestamps. Soooo, fondle
+# automake to make things happen.
+install-data-hook:
+	@$(am__vpath_adj_setup) \
+	list='$(nobase_mod_DATA)'; for p in $$list; do \
+	  if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \
+	  $(am__vpath_adj) \
+	  echo " touch -r '$$d$$p' '$(DESTDIR)$(moddir)/$$f'"; \
+	  touch -r "$$d$$p" "$(DESTDIR)$(moddir)/$$f"; \
+	done
+	@$(am__vpath_adj_setup) \
+	list='$(nobase_ccache_DATA)'; for p in $$list; do \
+	  if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \
+	  $(am__vpath_adj) \
+	  echo " touch -r '$$d$$p' '$(DESTDIR)$(ccachedir)/$$f'"; \
+	  touch -r "$$d$$p" "$(DESTDIR)$(ccachedir)/$$f"; \
+	done
+
+SUFFIXES = .scm .go
+.scm.go:
+	GUILE_AUTO_COMPILE=0 $(top_builddir)/meta/uninstalled-env guile-tools compile -o "$@" "$<"
diff --git a/am/maintainer-dirs b/am/maintainer-dirs
index c64268de9..f1b741be7 100644
--- a/am/maintainer-dirs
+++ b/am/maintainer-dirs
@@ -5,17 +5,17 @@
 ##   This file is part of GUILE.
 ##
 ##   GUILE 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
+##   it under the terms of the GNU Lesser General Public License as
+##   published by the Free Software Foundation; either version 3, or
 ##   (at your option) any later version.
 ##
 ##   GUILE is distributed in the hope that 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.
+##   GNU Lesser General Public License for more details.
 ##
-##   You should have received a copy of the GNU General Public
-##   License along with GUILE; see the file COPYING.  If not, write
+##   You should have received a copy of the GNU Lesser General Public
+##   License along with GUILE; see the file COPYING.LESSER.  If not, write
 ##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
 ##   Floor, Boston, MA 02110-1301 USA
 
diff --git a/am/pre-inst-guile b/am/pre-inst-guile
index c1a7407c9..7993d1531 100644
--- a/am/pre-inst-guile
+++ b/am/pre-inst-guile
@@ -5,17 +5,17 @@
 ##   This file is part of GUILE.
 ##
 ##   GUILE 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
+##   it under the terms of the GNU Lesser General Public License as
+##   published by the Free Software Foundation; either version 3, or
 ##   (at your option) any later version.
 ##
 ##   GUILE is distributed in the hope that 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.
+##   GNU Lesser General Public License for more details.
 ##
-##   You should have received a copy of the GNU General Public
-##   License along with GUILE; see the file COPYING.  If not, write
+##   You should have received a copy of the GNU Lesser General Public
+##   License along with GUILE; see the file COPYING.LESSER.  If not, write
 ##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
 ##   Floor, Boston, MA 02110-1301 USA
 
@@ -28,7 +28,7 @@
 
 ## Code:
 
-preinstguile     = $(top_builddir_absolute)/pre-inst-guile
+preinstguile     = $(top_builddir_absolute)/meta/guile
 preinstguiletool = GUILE="$(preinstguile)" $(top_srcdir)/scripts
 
 ## am/pre-inst-guile ends here
diff --git a/benchmark-guile.in b/benchmark-guile.in
index af1ade616..34f9c0646 100644
--- a/benchmark-guile.in
+++ b/benchmark-guile.in
@@ -1,6 +1,6 @@
 #! /bin/sh
 # Usage: benchmark-guile [-i GUILE-INTERPRETER] [GUILE-BENCHMARK-ARGS]
-# If `-i GUILE-INTERPRETER' is omitted, use ${top_builddir}/pre-inst-guile.
+# If `-i GUILE-INTERPRETER' is omitted, use ${top_builddir}/meta/guile.
 # See ${top_srcdir}/benchmark-suite/guile-benchmark for documentation on GUILE-BENCHMARK-ARGS.
 #
 # Example invocations:
@@ -21,7 +21,7 @@ if [ x"$1" = x-i ] ; then
     shift
     shift
 else
-    guile=${top_builddir}/pre-inst-guile
+    guile=${top_builddir}/meta/guile
 fi
 
 GUILE_LOAD_PATH=$BENCHMARK_SUITE_DIR
diff --git a/benchmark-suite/Makefile.am b/benchmark-suite/Makefile.am
index e65e8bcb2..dcadd5869 100644
--- a/benchmark-suite/Makefile.am
+++ b/benchmark-suite/Makefile.am
@@ -1,4 +1,5 @@
 SCM_BENCHMARKS = benchmarks/0-reference.bm		\
+		 benchmarks/bytevectors.bm		\
 	         benchmarks/continuations.bm		\
                  benchmarks/if.bm			\
                  benchmarks/logand.bm			\
diff --git a/benchmark-suite/benchmarks/bytevectors.bm b/benchmark-suite/benchmarks/bytevectors.bm
new file mode 100644
index 000000000..a686a08c9
--- /dev/null
+++ b/benchmark-suite/benchmarks/bytevectors.bm
@@ -0,0 +1,100 @@
+;;; -*- mode: scheme; coding: latin-1; -*-
+;;; R6RS Byte Vectors.
+;;;
+;;; Copyright 2009  Ludovic Court�s <ludo@gnu.org>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 3, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this software; see the file COPYING.LESSER.  If
+;;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (benchmarks bytevector)
+  :use-module (rnrs bytevector)
+  :use-module (srfi srfi-4)
+  :use-module (benchmark-suite lib))
+
+(define bv (make-bytevector 16384))
+
+(define %native-endianness
+  (native-endianness))
+
+(define %foreign-endianness
+  (if (eq? (native-endianness) (endianness little))
+      (endianness big)
+      (endianness little)))
+
+(define u8v  (make-u8vector 16384))
+(define u16v (make-u16vector 8192))
+(define u32v (make-u32vector 4196))
+(define u64v (make-u64vector 2048))
+
+
+(with-benchmark-prefix "ref/set!"
+
+  (benchmark "bytevector-u8-ref" 1000000
+    (bytevector-u8-ref bv 0))
+
+  (benchmark "bytevector-u16-ref (foreign)" 1000000
+    (bytevector-u16-ref bv 0 %foreign-endianness))
+
+  (benchmark "bytevector-u16-ref (native)" 1000000
+    (bytevector-u16-ref bv 0 %native-endianness))
+
+  (benchmark "bytevector-u16-native-ref" 1000000
+    (bytevector-u16-native-ref bv 0))
+
+  (benchmark "bytevector-u32-ref (foreign)" 1000000
+    (bytevector-u32-ref bv 0 %foreign-endianness))
+
+  (benchmark "bytevector-u32-ref (native)" 1000000
+    (bytevector-u32-ref bv 0 %native-endianness))
+
+  (benchmark "bytevector-u32-native-ref" 1000000
+    (bytevector-u32-native-ref bv 0))
+
+  (benchmark "bytevector-u64-ref (foreign)" 1000000
+    (bytevector-u64-ref bv 0 %foreign-endianness))
+
+  (benchmark "bytevector-u64-ref (native)" 1000000
+    (bytevector-u64-ref bv 0 %native-endianness))
+
+  (benchmark "bytevector-u64-native-ref" 1000000
+    (bytevector-u16-native-ref bv 0)))
+
+
+(with-benchmark-prefix "lists"
+
+  (benchmark "bytevector->u8-list" 2000
+    (bytevector->u8-list bv))
+
+  (benchmark "bytevector->uint-list 16-bit" 2000
+    (bytevector->uint-list bv (native-endianness) 2))
+
+  (benchmark "bytevector->uint-list 64-bit" 2000
+    (bytevector->uint-list bv (native-endianness) 8)))
+
+
+(with-benchmark-prefix "SRFI-4" ;; for comparison
+
+  (benchmark "u8vector-ref" 1000000
+    (u8vector-ref u8v 0))
+
+  (benchmark "u16vector-ref" 1000000
+    (u16vector-ref u16v 0))
+
+  (benchmark "u32vector-ref" 1000000
+    (u32vector-ref u32v 0))
+
+  (benchmark "u64vector-ref" 1000000
+    (u64vector-ref u64v 0)))
diff --git a/benchmark-suite/benchmarks/chars.bm b/benchmark-suite/benchmarks/chars.bm
new file mode 100644
index 000000000..dc6ad94aa
--- /dev/null
+++ b/benchmark-suite/benchmarks/chars.bm
@@ -0,0 +1,57 @@
+;;; -*- mode: scheme; coding: latin-1; -*-
+;;; chars.bm
+;;;
+;;; Copyright (C) 2009  Free Software Foundation, Inc.
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 3, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this software; see the file COPYING.LESSER.  If
+;;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (benchmarks chars)
+  :use-module (benchmark-suite lib))
+
+
+(with-benchmark-prefix "chars"
+                       
+  (benchmark "char" 1000000
+     #\a)
+
+  (benchmark "octal" 1000000
+     #\123)
+
+  (benchmark "char? eq" 1000000
+    (char? #\a))
+
+  (benchmark "char=?" 1000000
+    (char=? #\a #\a))
+
+  (benchmark "char<?" 1000000
+    (char=? #\a #\a))
+
+  (benchmark "char-ci=?" 1000000
+    (char=? #\a #\a))
+
+  (benchmark "char-ci<? " 1000000
+    (char=? #\a #\a))
+
+  (benchmark "char->integer" 1000000
+    (char->integer #\a))
+
+  (benchmark "char-alphabetic?" 1000000
+    (char-upcase #\a))
+
+  (benchmark "char-numeric?" 1000000
+    (char-upcase #\a)))
+
diff --git a/benchmark-suite/benchmarks/read.bm b/benchmark-suite/benchmarks/read.bm
index cb876b5ad..f11ca687a 100644
--- a/benchmark-suite/benchmarks/read.bm
+++ b/benchmark-suite/benchmarks/read.bm
@@ -2,20 +2,20 @@
 ;;;
 ;;; Copyright (C) 2008 Free Software Foundation, Inc.
 ;;;
-;;; This program is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 2, or (at your option)
-;;; any later version.
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 3, 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.
+;;; GNU Lesser General Public License for more details.
 ;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this software; see the file COPYING.  If not, write to
-;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;; Boston, MA 02110-1301 USA
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this software; see the file COPYING.LESSER.  If
+;;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (benchmarks read)
   :use-module (benchmark-suite lib))
diff --git a/benchmark-suite/benchmarks/srfi-13.bm b/benchmark-suite/benchmarks/srfi-13.bm
new file mode 100644
index 000000000..e648e2af9
--- /dev/null
+++ b/benchmark-suite/benchmarks/srfi-13.bm
@@ -0,0 +1,310 @@
+;;; -*- mode: scheme; coding: latin-1; -*-
+;;; srfi-13.bm
+;;;
+;;; Copyright (C) 2009  Free Software Foundation, Inc.
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 3, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this software; see the file COPYING.LESSER.  If
+;;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (benchmarks strings)
+  :use-module (benchmark-suite lib))
+
+(seed->random-state 1)
+
+(define short-string "Hi")
+(define medium-string 
+"ARMA virumque cano, Troiae qui primus ab oris
+Italiam, fato profugus, Laviniaque venit")
+(define long-string
+  (string-tabulate 
+   (lambda (n) (integer->char (+ 32 (random 90)))) 
+   1000))
+
+(define short-chlist (string->list short-string))
+(define medium-chlist (string->list medium-string))
+(define long-chlist (string->list long-string))
+
+(define str1 (string-copy short-string))
+(define str2 (string-copy medium-string))
+(define str3 (string-copy long-string))
+
+
+(with-benchmark-prefix "strings"
+
+  (with-benchmark-prefix "predicates"
+
+    (benchmark "string?" 1190000
+      (string? short-string)
+      (string? medium-string)
+      (string? long-string))
+
+    (benchmark "null?" 969000
+      (string-null? short-string)
+      (string-null? medium-string)
+      (string-null? long-string))
+    
+    (benchmark "any" 94000
+      (string-any #\a short-string)
+      (string-any #\a medium-string)
+      (string-any #\a long-string))
+
+    (benchmark "every" 94000
+      (string-every #\a short-string)
+      (string-every #\a medium-string)
+      (string-every #\a long-string)))
+
+  (with-benchmark-prefix "constructors"
+
+    (benchmark "string" 5000
+      (apply string short-chlist)         
+      (apply string medium-chlist)
+      (apply string long-chlist))
+
+    (benchmark "list->" 4500
+      (list->string short-chlist)
+      (list->string medium-chlist)
+      (list->string long-chlist))
+
+    (benchmark "reverse-list->" 5000
+      (reverse-list->string short-chlist)
+      (reverse-list->string medium-chlist)
+      (reverse-list->string long-chlist))
+
+    (benchmark "make" 22000
+      (make-string 250 #\x))
+
+    (benchmark "tabulate" 17000
+      (string-tabulate integer->char 250))
+
+    (benchmark "join" 5500
+      (string-join (list short-string medium-string long-string) "|" 'suffix)))
+
+  (with-benchmark-prefix "list/string"
+    (benchmark "->list" 7300
+      (string->list short-string)
+      (string->list medium-string)
+      (string->list long-string))
+
+    (benchmark "split" 60000
+      (string-split short-string #\a)
+      (string-split medium-string #\a)
+      (string-split long-string #\a)))
+
+  (with-benchmark-prefix "selection"
+
+    (benchmark "ref" 660
+      (let loop ((k 0))
+        (if (< k (string-length short-string))
+            (begin
+              (string-ref short-string k)
+              (loop (+ k 1)))))
+      (let loop ((k 0))
+        (if (< k (string-length medium-string))
+            (begin
+              (string-ref medium-string k)
+              (loop (+ k 1)))))
+      (let loop ((k 0))
+        (if (< k (string-length long-string))
+            (begin
+              (string-ref long-string k)
+              (loop (+ k 1))))))
+
+    (benchmark "copy" 1100
+      (string-copy short-string)
+      (string-copy medium-string)
+      (string-copy long-string)
+      (substring/copy short-string 0 1)
+      (substring/copy medium-string 10 20)
+      (substring/copy long-string 100 200))
+
+    (benchmark "pad" 6800
+      (string-pad short-string 100)
+      (string-pad medium-string 100)
+      (string-pad long-string 100))
+
+    (benchmark "trim trim-right trim-both" 60000
+      (string-trim short-string char-alphabetic?)
+      (string-trim medium-string char-alphabetic?)
+      (string-trim long-string char-alphabetic?)
+      (string-trim-right short-string char-alphabetic?)
+      (string-trim-right medium-string char-alphabetic?)
+      (string-trim-right long-string char-alphabetic?)
+      (string-trim-both short-string char-alphabetic?)
+      (string-trim-both medium-string char-alphabetic?)
+      (string-trim-both long-string char-alphabetic?)))
+
+  (with-benchmark-prefix "modification"
+
+    (set! str1 (string-copy short-string))                         
+    (set! str2 (string-copy medium-string))   
+    (set! str3 (string-copy long-string))
+
+    (benchmark "set!" 3000
+      (let loop ((k 1))
+        (if (< k (string-length short-string))
+            (begin
+              (string-set! str1 k #\x)
+              (loop (+ k 1)))))
+      (let loop ((k 20))
+        (if (< k (string-length medium-string))
+            (begin
+              (string-set! str2 k #\x)
+              (loop (+ k 1)))))
+      (let loop ((k 900))
+        (if (< k (string-length long-string))
+            (begin
+              (string-set! str3 k #\x)
+              (loop (+ k 1))))))
+
+    (set! str1 (string-copy short-string))                         
+    (set! str2 (string-copy medium-string))   
+    (set! str3 (string-copy long-string))
+
+    (benchmark "sub-move!" 230000
+      (substring-move! short-string 0 2 str2 10)
+      (substring-move! medium-string 10 20 str3 20))
+
+    (set! str1 (string-copy short-string))                         
+    (set! str2 (string-copy medium-string))   
+    (set! str3 (string-copy long-string))
+
+    (benchmark "fill!" 230000
+      (string-fill! str1 #\y 0 1)
+      (string-fill! str2 #\y 10 20)
+      (string-fill! str3 #\y 20 30))
+
+  (with-benchmark-prefix "comparison"
+
+    (benchmark "compare compare-ci" 140000
+      (string-compare short-string medium-string string<? string=? string>?)  
+      (string-compare long-string medium-string string<? string=? string>?)
+      (string-compare-ci short-string medium-string string<? string=? string>?)  
+      (string-compare-ci long-string medium-string string<? string=? string>?))
+  
+    (benchmark "hash hash-ci" 1000
+      (string-hash short-string)
+      (string-hash medium-string)
+      (string-hash long-string)
+      (string-hash-ci short-string)
+      (string-hash-ci medium-string)
+      (string-hash-ci long-string))))
+  
+  (with-benchmark-prefix "searching" 20000
+
+    (benchmark "prefix-length suffix-length" 270
+      (string-prefix-length short-string 
+                            (string-append short-string medium-string))
+      (string-prefix-length long-string 
+                            (string-append long-string medium-string))
+      (string-suffix-length short-string
+                            (string-append medium-string short-string))
+      (string-suffix-length long-string
+                            (string-append medium-string long-string))
+      (string-prefix-length-ci short-string 
+                            (string-append short-string medium-string))
+      (string-prefix-length-ci long-string 
+                            (string-append long-string medium-string))
+      (string-suffix-length-ci short-string
+                            (string-append medium-string short-string))
+      (string-suffix-length-ci long-string
+                            (string-append medium-string long-string)))
+
+    (benchmark "prefix? suffix?" 270
+      (string-prefix? short-string 
+                            (string-append short-string medium-string))
+      (string-prefix? long-string 
+                            (string-append long-string medium-string))
+      (string-suffix? short-string
+                            (string-append medium-string short-string))
+      (string-suffix? long-string
+                            (string-append medium-string long-string))
+      (string-prefix-ci? short-string 
+                            (string-append short-string medium-string))
+      (string-prefix-ci? long-string 
+                            (string-append long-string medium-string))
+      (string-suffix-ci? short-string
+                            (string-append medium-string short-string))
+      (string-suffix-ci? long-string
+                            (string-append medium-string long-string)))
+
+    (benchmark "index index-right rindex" 100000
+      (string-index short-string #\T)
+      (string-index medium-string #\T)
+      (string-index long-string #\T)
+      (string-index-right short-string #\T)
+      (string-index-right medium-string #\T)
+      (string-index-right long-string #\T)
+      (string-rindex short-string #\T)
+      (string-rindex medium-string #\T)
+      (string-rindex long-string #\T))
+
+    (benchmark "skip skip-right?" 100000
+      (string-skip short-string char-alphabetic?)
+      (string-skip medium-string char-alphabetic?)
+      (string-skip long-string char-alphabetic?)
+      (string-skip-right short-string char-alphabetic?)
+      (string-skip-right medium-string char-alphabetic?)
+      (string-skip-right long-string char-alphabetic?))
+
+    (benchmark "count" 10000
+      (string-count short-string char-alphabetic?)
+      (string-count medium-string char-alphabetic?)
+      (string-count long-string char-alphabetic?))
+    
+    (benchmark "contains contains-ci" 34000
+      (string-contains short-string short-string)
+      (string-contains medium-string (substring medium-string 10 15))
+      (string-contains long-string (substring long-string 100 130))
+      (string-contains-ci short-string short-string)
+      (string-contains-ci medium-string (substring medium-string 10 15))
+      (string-contains-ci long-string (substring long-string 100 130)))
+
+    (set! str1 (string-copy short-string))                         
+    (set! str2 (string-copy medium-string))   
+    (set! str3 (string-copy long-string))
+
+    (benchmark "upcase downcase upcase! downcase!" 600
+      (string-upcase short-string)
+      (string-upcase medium-string)
+      (string-upcase long-string)
+      (string-downcase short-string)
+      (string-downcase medium-string)
+      (string-downcase long-string)
+      (string-upcase! str1 0 1)
+      (string-upcase! str2 10 20)
+      (string-upcase! str3 100 130)
+      (string-downcase! str1 0 1)
+      (string-downcase! str2 10 20)
+      (string-downcase! str3 100 130)))
+
+  (with-benchmark-prefix "readers"
+
+    (benchmark "read token, method 1" 1200
+      (let ((buf (make-string 512)))
+        (let loop ((i 0))
+          (if (< i 512)
+              (begin 
+                (string-set! buf i #\x)
+                (loop (+ i 1)))
+              buf))))
+
+    (benchmark "read token, method 2" 1200
+      (let ((lst '()))   
+        (let loop ((i 0))
+          (set! lst (append! lst (list #\x)))
+          (if (< i 512)
+              (loop (+ i 1))
+              (list->string lst)))))))
diff --git a/benchmark-suite/benchmarks/subr.bm b/benchmark-suite/benchmarks/subr.bm
index 9c87a9921..ea0045650 100644
--- a/benchmark-suite/benchmarks/subr.bm
+++ b/benchmark-suite/benchmarks/subr.bm
@@ -2,20 +2,20 @@
 ;;;
 ;;; Copyright (C) 2009 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 free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 3, 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.
+;;; GNU Lesser General Public License for more details.
 ;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this software; see the file COPYING.  If not, write to
-;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;; Boston, MA 02110-1301 USA
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this software; see the file COPYING.LESSER.  If
+;;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (benchmarks subrs)
   :use-module (benchmark-suite lib))
diff --git a/benchmark-suite/benchmarks/uniform-vector-read.bm b/benchmark-suite/benchmarks/uniform-vector-read.bm
index d288f0b44..d188b2b86 100644
--- a/benchmark-suite/benchmarks/uniform-vector-read.bm
+++ b/benchmark-suite/benchmarks/uniform-vector-read.bm
@@ -2,20 +2,20 @@
 ;;;
 ;;; Copyright (C) 2008 Free Software Foundation, Inc.
 ;;;
-;;; This program is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 2, or (at your option)
-;;; any later version.
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 3, 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.
+;;; GNU Lesser General Public License for more details.
 ;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this software; see the file COPYING.  If not, write to
-;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;; Boston, MA 02110-1301 USA
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this software; see the file COPYING.LESSER.  If
+;;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (benchmarks uniform-vector-read)
   :use-module (benchmark-suite lib)
diff --git a/benchmark-suite/guile-benchmark b/benchmark-suite/guile-benchmark
index c4c6f23de..41cae06a1 100755
--- a/benchmark-suite/guile-benchmark
+++ b/benchmark-suite/guile-benchmark
@@ -7,20 +7,20 @@
 ;;;;
 ;;;; Copyright (C) 2002, 2006 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 free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3, 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.
+;;;; GNU Lesser General Public License for more details.
 ;;;;
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this software; see the file COPYING.LESSER.
+;;;; If not, write to the Free Software Foundation, Inc., 51 Franklin
+;;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 
 ;;;; Usage: [guile -e main -s] guile-benchmark [OPTIONS] [BENCHMARK ...]
diff --git a/benchmark-suite/lib.scm b/benchmark-suite/lib.scm
index 65491d735..65253c5ff 100644
--- a/benchmark-suite/lib.scm
+++ b/benchmark-suite/lib.scm
@@ -1,20 +1,20 @@
 ;;;; benchmark-suite/lib.scm --- generic support for benchmarking
 ;;;; Copyright (C) 2002, 2006 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 free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3, 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.
+;;;; GNU Lesser General Public License for more details.
 ;;;;
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this software; see the file COPYING.LESSER.
+;;;; If not, write to the Free Software Foundation, Inc., 51 Franklin
+;;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (benchmark-suite lib)
   :export (
diff --git a/benchmark/lib.scm b/benchmark/lib.scm
new file mode 100644
index 000000000..e6ffc7a55
--- /dev/null
+++ b/benchmark/lib.scm
@@ -0,0 +1,111 @@
+;; -*- Scheme -*-
+;;
+;; A library of dumb functions that may be used to benchmark Guile-VM.
+
+
+;; The comments are from Ludovic, a while ago. The speedups now are much
+;; more significant (all over 2x, sometimes 8x).
+
+(define (fibo x)
+  (if (or (= x 1) (= x 2))
+      1
+      (+ (fibo (- x 1))
+	 (fibo (- x 2)))))
+
+(define (g-c-d x y)
+  (if (= x y)
+      x
+      (if (< x y)
+	  (g-c-d x (- y x))
+	  (g-c-d (- x y) y))))
+
+(define (loop n)
+  ;; This one shows that procedure calls are no faster than within the
+  ;; interpreter: the VM yields no performance improvement.
+  (if (= 0 n)
+      0
+      (loop (1- n))))
+
+;; Disassembly of `loop'
+;;
+;; Disassembly of #<objcode b79bdf28>:
+
+;; nlocs = 0  nexts = 0
+
+;;    0    (make-int8 64)                  ;; 64
+;;    2    (load-symbol "guile-user")      ;; guile-user
+;;   14    (list 0 1)                      ;; 1 element
+;;   17    (load-symbol "loop")            ;; loop
+;;   23    (link-later)
+;;   24    (vector 0 1)                    ;; 1 element
+;;   27    (make-int8 0)                   ;; 0
+;;   29    (load-symbol "n")               ;; n
+;;   32    (make-false)                    ;; #f
+;;   33    (make-int8 0)                   ;; 0
+;;   35    (list 0 3)                      ;; 3 elements
+;;   38    (list 0 2)                      ;; 2 elements
+;;   41    (list 0 1)                      ;; 1 element
+;;   44    (make-int8 5)                   ;; 5
+;;   46    (make-false)                    ;; #f
+;;   47    (cons)
+;;   48    (make-int8 18)                  ;; 18
+;;   50    (make-false)                    ;; #f
+;;   51    (cons)
+;;   52    (make-int8 20)                  ;; 20
+;;   54    (make-false)                    ;; #f
+;;   55    (cons)
+;;   56    (list 0 4)                      ;; 4 elements
+;;   59    (load-program ##{66}#)
+;;   81    (define "loop")
+;;   87    (variable-set)
+;;   88    (void)
+;;   89    (return)
+
+;; Bytecode ##{66}#:
+
+;;    0    (make-int8 0)                   ;; 0
+;;    2    (local-ref 0)
+;;    4    (ee?)
+;;    5    (br-if-not 0 3)                 ;; -> 11
+;;    8    (make-int8 0)                   ;; 0
+;;   10    (return)
+;;   11    (toplevel-ref 0)
+;;   13    (local-ref 0)
+;;   15    (make-int8 1)                   ;; 1
+;;   17    (sub)
+;;   18    (tail-call 1)
+
+(define (loopi n)
+  ;; Same as `loop'.
+  (let loopi ((n n))
+    (if (= 0 n)
+	0
+	(loopi (1- n)))))
+
+(define (do-loop n)
+  ;; Same as `loop' using `do'.
+  (do ((i n (1- i)))
+      ((= 0 i))
+    ;; do nothing
+    ))
+
+
+(define (do-cons x)
+  ;; This one shows that the built-in `cons' instruction yields a significant
+  ;; improvement (speedup: 1.5).
+  (let loop ((x x)
+	     (result '()))
+    (if (<= x 0)
+	result
+	(loop (1- x) (cons x result)))))
+
+(define big-list (iota 500000))
+
+(define (copy-list lst)
+  ;; Speedup: 5.9.
+  (let loop ((lst lst)
+	     (result '()))
+    (if (null? lst)
+	result
+	(loop (cdr lst)
+	      (cons (car lst) result)))))
diff --git a/benchmark/measure.scm b/benchmark/measure.scm
new file mode 100755
index 000000000..517fb53ac
--- /dev/null
+++ b/benchmark/measure.scm
@@ -0,0 +1,64 @@
+#!/bin/sh
+# aside from this initial boilerplate, this is actually -*- scheme -*- code
+main='(module-ref (resolve-module '\''(measure)) '\'main')'
+exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
+!#
+
+;; A simple interpreter vs. VM performance comparison tool
+;;
+
+(define-module (measure)
+  :export (measure)
+  :use-module (system vm vm)
+  :use-module (system base compile)
+  :use-module (system base language))
+
+
+(define (time-for-eval sexp eval)
+  (let ((before (tms:utime (times))))
+    (eval sexp)
+    (let ((elapsed (- (tms:utime (times)) before)))
+      (format #t "elapsed time: ~a~%" elapsed)
+      elapsed)))
+
+(define *scheme* (lookup-language 'scheme))
+
+
+(define (measure . args)
+  (if (< (length args) 2)
+      (begin
+	(format #t "Usage: measure SEXP FILE-TO-LOAD...~%")
+	(format #t "~%")
+	(format #t "Example: measure '(loop 23424)' lib.scm~%~%")
+	(exit 1)))
+  (for-each load (cdr args))
+  (let* ((sexp (with-input-from-string (car args)
+		 (lambda ()
+		   (read))))
+	 (eval-here (lambda (sexp) (eval sexp (current-module))))
+	 (proc-name (car sexp))
+	 (proc-source (procedure-source (eval proc-name (current-module))))
+	 (% (format #t "proc: ~a~%source: ~a~%" proc-name proc-source))
+	 (time-interpreted (time-for-eval sexp eval-here))
+	 (& (if (defined? proc-name)
+		(eval `(set! ,proc-name #f) (current-module))
+		(format #t "unbound~%")))
+	 (the-program (compile proc-source))
+
+	 (time-compiled (time-for-eval `(,proc-name ,@(cdr sexp))
+				       (lambda (sexp)
+					 (eval `(begin
+						  (define ,proc-name
+						    ,the-program)
+						  ,sexp)
+					       (current-module))))))
+
+    (format #t "proc:        ~a => ~a~%"
+	    proc-name (eval proc-name (current-module)))
+    (format #t "interpreted: ~a~%" time-interpreted)
+    (format #t "compiled:    ~a~%" time-compiled)
+    (format #t "speedup:     ~a~%"
+	    (exact->inexact (/ time-interpreted time-compiled)))
+    0))
+
+(define main measure)
diff --git a/build-aux/config.rpath b/build-aux/config.rpath
index 35f959b87..85c2f209b 100755
--- a/build-aux/config.rpath
+++ b/build-aux/config.rpath
@@ -47,7 +47,7 @@ for cc_temp in $CC""; do
 done
 cc_basename=`echo "$cc_temp" | sed -e 's%^.*/%%'`
 
-# Code taken from libtool.m4's AC_LIBTOOL_PROG_COMPILER_PIC.
+# Code taken from libtool.m4's _LT_COMPILER_PIC.
 
 wl=
 if test "$GCC" = yes; then
@@ -64,7 +64,7 @@ else
           ;;
       esac
       ;;
-    mingw* | cygwin* | pw32* | os2*)
+    mingw* | cygwin* | pw32* | os2* | cegcc*)
       ;;
     hpux9* | hpux10* | hpux11*)
       wl='-Wl,'
@@ -76,7 +76,13 @@ else
       ;;
     linux* | k*bsd*-gnu)
       case $cc_basename in
-        icc* | ecc*)
+        ecc*)
+          wl='-Wl,'
+          ;;
+        icc* | ifort*)
+          wl='-Wl,'
+          ;;
+        lf95*)
           wl='-Wl,'
           ;;
         pgcc | pgf77 | pgf90)
@@ -124,7 +130,7 @@ else
   esac
 fi
 
-# Code taken from libtool.m4's AC_LIBTOOL_PROG_LD_SHLIBS.
+# Code taken from libtool.m4's _LT_LINKER_SHLIBS.
 
 hardcode_libdir_flag_spec=
 hardcode_libdir_separator=
@@ -132,7 +138,7 @@ hardcode_direct=no
 hardcode_minus_L=no
 
 case "$host_os" in
-  cygwin* | mingw* | pw32*)
+  cygwin* | mingw* | pw32* | cegcc*)
     # FIXME: the MSVC++ port hasn't been tested in a loooong time
     # When not using gcc, we currently assume that we are using
     # Microsoft Visual C++.
@@ -182,7 +188,7 @@ if test "$with_gnu_ld" = yes; then
         ld_shlibs=no
       fi
       ;;
-    cygwin* | mingw* | pw32*)
+    cygwin* | mingw* | pw32* | cegcc*)
       # hardcode_libdir_flag_spec is actually meaningless, as there is
       # no search path for DLLs.
       hardcode_libdir_flag_spec='-L$libdir'
@@ -326,7 +332,7 @@ else
       ;;
     bsdi[45]*)
       ;;
-    cygwin* | mingw* | pw32*)
+    cygwin* | mingw* | pw32* | cegcc*)
       # When not using gcc, we currently assume that we are using
       # Microsoft Visual C++.
       # hardcode_libdir_flag_spec is actually meaningless, as there is
@@ -494,7 +500,7 @@ else
 fi
 
 # Check dynamic linker characteristics
-# Code taken from libtool.m4's AC_LIBTOOL_SYS_DYNAMIC_LINKER.
+# Code taken from libtool.m4's _LT_SYS_DYNAMIC_LINKER.
 # Unlike libtool.m4, here we don't care about _all_ names of the library, but
 # only about the one the linker finds when passed -lNAME. This is the last
 # element of library_names_spec in libtool.m4, or possibly two of them if the
@@ -517,7 +523,7 @@ case "$host_os" in
   bsdi[45]*)
     library_names_spec='$libname$shrext'
     ;;
-  cygwin* | mingw* | pw32*)
+  cygwin* | mingw* | pw32* | cegcc*)
     shrext=.dll
     library_names_spec='$libname.dll.a $libname.lib'
     ;;
diff --git a/build-aux/gitlog-to-changelog b/build-aux/gitlog-to-changelog
new file mode 100755
index 000000000..1cc53eb7c
--- /dev/null
+++ b/build-aux/gitlog-to-changelog
@@ -0,0 +1,183 @@
+#!/usr/bin/perl
+# Convert git log output to ChangeLog format.
+
+my $VERSION = '2009-06-04 08:53'; # UTC
+# The definition above must lie within the first 8 lines in order
+# for the Emacs time-stamp write hook (at end) to update it.
+# If you change this file with Emacs, please let the write hook
+# do its job.  Otherwise, update this string manually.
+
+# Copyright (C) 2008, 2009 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 3 of the License, or
+# (at your option) any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+# Written by Jim Meyering
+
+use strict;
+use warnings;
+use Getopt::Long;
+use POSIX qw(strftime);
+
+(my $ME = $0) =~ s|.*/||;
+
+# use File::Coda; # http://meyering.net/code/Coda/
+END {
+  defined fileno STDOUT or return;
+  close STDOUT and return;
+  warn "$ME: failed to close standard output: $!\n";
+  $? ||= 1;
+}
+
+sub usage ($)
+{
+  my ($exit_code) = @_;
+  my $STREAM = ($exit_code == 0 ? *STDOUT : *STDERR);
+  if ($exit_code != 0)
+    {
+      print $STREAM "Try `$ME --help' for more information.\n";
+    }
+  else
+    {
+      print $STREAM <<EOF;
+Usage: $ME [OPTIONS] [ARGS]
+
+Convert git log output to ChangeLog format.  If present, any ARGS
+are passed to "git log".  To avoid ARGS being parsed as options to
+$ME, they may be preceded by '--'.
+
+OPTIONS:
+
+   --since=DATE convert only the logs since DATE;
+                  the default is to convert all log entries.
+
+   --help       display this help and exit
+   --version    output version information and exit
+
+EXAMPLE:
+
+  $ME --since=2008-01-01 > ChangeLog
+  $ME -- -n 5 foo > last-5-commits-to-branch-foo
+
+EOF
+    }
+  exit $exit_code;
+}
+
+# If the string $S is a well-behaved file name, simply return it.
+# If it contains white space, quotes, etc., quote it, and return the new string.
+sub shell_quote($)
+{
+  my ($s) = @_;
+  if ($s =~ m![^\w+/.,-]!)
+    {
+      # Convert each single quote to '\''
+      $s =~ s/\'/\'\\\'\'/g;
+      # Then single quote the string.
+      $s = "'$s'";
+    }
+  return $s;
+}
+
+sub quoted_cmd(@)
+{
+  return join (' ', map {shell_quote $_} @_);
+}
+
+{
+  my $since_date = '1970-01-01 UTC';
+  GetOptions
+    (
+     help => sub { usage 0 },
+     version => sub { print "$ME version $VERSION\n"; exit },
+     'since=s' => \$since_date,
+    ) or usage 1;
+
+  my @cmd = (qw (git log --log-size), "--since=$since_date",
+             '--pretty=format:%ct  %an  <%ae>%n%n%s%n%b%n', @ARGV);
+  open PIPE, '-|', @cmd
+    or die ("$ME: failed to run `". quoted_cmd (@cmd) ."': $!\n"
+            . "(Is your Git too old?  Version 1.5.1 or later is required.)\n");
+
+  my $prev_date_line = '';
+  while (1)
+    {
+      defined (my $in = <PIPE>)
+        or last;
+      $in =~ /^log size (\d+)$/
+        or die "$ME:$.: Invalid line (expected log size):\n$in";
+      my $log_nbytes = $1;
+
+      my $log;
+      my $n_read = read PIPE, $log, $log_nbytes;
+      $n_read == $log_nbytes
+        or die "$ME:$.: unexpected EOF\n";
+
+      my @line = split "\n", $log;
+      my $author_line = shift @line;
+      defined $author_line
+        or die "$ME:$.: unexpected EOF\n";
+      $author_line =~ /^(\d+)  (.*>)$/
+        or die "$ME:$.: Invalid line "
+          . "(expected date/author/email):\n$author_line\n";
+
+      my $date_line = sprintf "%s  $2\n", strftime ("%F", localtime ($1));
+      # If this line would be the same as the previous date/name/email
+      # line, then arrange not to print it.
+      if ($date_line ne $prev_date_line)
+        {
+          $prev_date_line eq ''
+            or print "\n";
+          print $date_line;
+        }
+      $prev_date_line = $date_line;
+
+      # Omit "Signed-off-by..." lines.
+      @line = grep !/^Signed-off-by: .*>$/, @line;
+
+      # If there were any lines
+      if (@line == 0)
+        {
+          warn "$ME: warning: empty commit message:\n  $date_line\n";
+        }
+      else
+        {
+          # Remove leading and trailing blank lines.
+          while ($line[0] =~ /^\s*$/) { shift @line; }
+          while ($line[$#line] =~ /^\s*$/) { pop @line; }
+
+          # Prefix each non-empty line with a TAB.
+          @line = map { length $_ ? "\t$_" : '' } @line;
+
+          print "\n", join ("\n", @line), "\n";
+        }
+
+      defined ($in = <PIPE>)
+        or last;
+      $in ne "\n"
+        and die "$ME:$.: unexpected line:\n$in";
+    }
+
+  close PIPE
+    or die "$ME: error closing pipe from " . quoted_cmd (@cmd) . "\n";
+  # FIXME-someday: include $PROCESS_STATUS in the diagnostic
+}
+
+# Local Variables:
+# indent-tabs-mode: nil
+# eval: (add-hook 'write-file-hooks 'time-stamp)
+# time-stamp-start: "my $VERSION = '"
+# time-stamp-format: "%:y-%02m-%02d %02H:%02M"
+# time-stamp-time-zone: "UTC"
+# time-stamp-end: "'; # UTC"
+# End:
diff --git a/check-guile.in b/check-guile.in
index 9ee2ea3f6..dde51b37d 100644
--- a/check-guile.in
+++ b/check-guile.in
@@ -1,6 +1,6 @@
 #! /bin/sh
 # Usage: check-guile [-i GUILE-INTERPRETER] [GUILE-TEST-ARGS]
-# If `-i GUILE-INTERPRETER' is omitted, use ${top_builddir}/pre-inst-guile.
+# If `-i GUILE-INTERPRETER' is omitted, use ${top_builddir}/meta/guile.
 # See ${top_srcdir}/test-suite/guile-test for documentation on GUILE-TEST-ARGS.
 #
 # Example invocations:
@@ -21,7 +21,7 @@ if [ x"$1" = x-i ] ; then
     shift
     shift
 else
-    guile=${top_builddir}/pre-inst-guile
+    guile=${top_builddir}/meta/guile
 fi
 
 GUILE_LOAD_PATH=$TEST_SUITE_DIR
@@ -41,8 +41,7 @@ if [ ! -f guile-procedures.txt ] ; then
 fi
 
 exec $guile \
-    -l ${top_builddir}/libguile/stack-limit-calibration.scm \
-    -e main -s "$TEST_SUITE_DIR/guile-test" \
+    --no-autocompile -e main -s "$TEST_SUITE_DIR/guile-test" \
     --test-suite "$TEST_SUITE_DIR/tests" \
     --log-file check-guile.log "$@"
 
diff --git a/configure.in b/configure.ac
index 8c48cb9cd..f10df101d 100644
--- a/configure.in
+++ b/configure.ac
@@ -8,20 +8,20 @@ Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
 
 This file is part of GUILE
 
-GUILE 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.
+GUILE is free software; you can redistribute it and/or modify it under
+the terms of the GNU Lesser General Public License as published by the
+Free Software Foundation; either version 3, or (at your option) any
+later version.
 
-GUILE is distributed in the hope that 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.
+GUILE is distributed in the hope that it will be useful, but WITHOUT
+ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+License for more details.
 
-You should have received a copy of the GNU General Public License
-along with GUILE; see the file COPYING.  If not, write to the
-Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA.
+You should have received a copy of the GNU Lesser General Public
+License along with GUILE; see the file COPYING.LESSER.  If not, write
+to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+Floor, Boston, MA 02110-1301, USA.
 
 ]])
 
@@ -52,14 +52,6 @@ AC_CONFIG_HEADERS([config.h])
 AH_TOP(/*GUILE_CONFIGURE_COPYRIGHT*/)
 
 #--------------------------------------------------------------------
-#
-# Independent Subdirectories
-#
-#--------------------------------------------------------------------
-
-AC_CONFIG_SUBDIRS(guile-readline)
-
-#--------------------------------------------------------------------
 
 AC_LANG([C])
 
@@ -159,6 +151,7 @@ AC_ARG_ENABLE([deprecated],
 
 if test "$enable_deprecated" = no; then
   SCM_I_GSC_ENABLE_DEPRECATED=0
+  warn_default=no
 else
   if test "$enable_deprecated" = yes || test "$enable_deprecated" = ""; then
     warn_default=summary
@@ -168,9 +161,9 @@ else
     warn_default=$enable_deprecated
   fi
   SCM_I_GSC_ENABLE_DEPRECATED=1
-  AC_DEFINE_UNQUOTED(SCM_WARN_DEPRECATED_DEFAULT, "$warn_default",
-  [Define this to control the default warning level for deprecated features.])
 fi
+AC_DEFINE_UNQUOTED(SCM_WARN_DEPRECATED_DEFAULT, "$warn_default",
+[Define this to control the default warning level for deprecated features.])
 
 AC_ARG_ENABLE(elisp,
   [  --disable-elisp         omit Emacs Lisp support],,
@@ -288,6 +281,8 @@ AC_CHECK_LIB(uca, __uc_get_ar_bsp)
 
 AC_C_BIGENDIAN
 
+AC_C_LABELS_AS_VALUES
+
 AC_CHECK_SIZEOF(char)
 AC_CHECK_SIZEOF(unsigned char)
 AC_CHECK_SIZEOF(short)
@@ -618,6 +613,8 @@ AC_SUBST([SCM_I_GSC_HAVE_STRUCT_DIRENT64])
 # Reasons for testing:
 #   complex.h - new in C99
 #   fenv.h - available in C99, but not older systems
+#   machine/fpu.h - on Tru64 5.1b, the declaration of fesetround(3) is in
+#     this file instead of <fenv.h>
 #   process.h - mingw specific
 #   langinfo.h, nl_types.h - SuS v2
 #
@@ -625,7 +622,7 @@ AC_CHECK_HEADERS([complex.h fenv.h io.h libc.h limits.h malloc.h memory.h proces
 regex.h rxposix.h rx/rxposix.h sys/dir.h sys/ioctl.h sys/select.h \
 sys/time.h sys/timeb.h sys/times.h sys/stdtypes.h sys/types.h \
 sys/utime.h time.h unistd.h utime.h pwd.h grp.h sys/utsname.h \
-direct.h langinfo.h nl_types.h])
+direct.h langinfo.h nl_types.h machine/fpu.h])
 
 # "complex double" is new in C99, and "complex" is only a keyword if
 # <complex.h> is included
@@ -731,10 +728,14 @@ AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid fesetround ftime
 #   sethostname - the function itself check because it's not in mingw,
 #       the DECL is checked because Solaris 10 doens't have in any header
 #   xlocale.h - needed on Darwin for the `locale_t' API
+#   hstrerror - on Tru64 5.1b the symbol is available in libc but the
+#       declaration isn't anywhere.
+#   cuserid - on Tru64 5.1b the declaration is documented to be available
+#       only with `_XOPEN_SOURCE' or some such.
 #
 AC_CHECK_HEADERS(crypt.h netdb.h pthread.h sys/param.h sys/resource.h sys/file.h xlocale.h)
 AC_CHECK_FUNCS(chroot flock getlogin cuserid getpriority setpriority getpass sethostname gethostname)
-AC_CHECK_DECLS([sethostname])
+AC_CHECK_DECLS([sethostname, hstrerror, cuserid])
 
 # crypt() may or may not be available, for instance in some countries there
 # are restrictions on cryptography.
@@ -818,14 +819,13 @@ fi
 
 
 dnl GMP tests
-AC_CHECK_LIB([gmp], [__gmpz_init], ,
-  [AC_MSG_ERROR([GNU MP not found, see README])])
-
-# mpz_import is a macro so we need to include <gmp.h>
-AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <gmp.h>]],
- 			        [[mpz_import (0, 0, 0, 0, 0, 0, 0); ]])],
+AC_LIB_HAVE_LINKFLAGS(gmp,
   [],
-  [AC_MSG_ERROR([At least GNU MP 4.1 is required, see README])])
+  [#include <gmp.h>],
+  [mpz_import (0, 0, 0, 0, 0, 0, 0);],
+  AC_MSG_ERROR([GNU MP 4.1 or greater not found, see README]))
+
+dnl GNU libunistring is checked for by Gnulib's `libunistring' module.
 
 dnl i18n tests
 #AC_CHECK_HEADERS([libintl.h])
@@ -881,6 +881,8 @@ if test -n "$have_sys_un_h" ; then
     [Define if the system supports Unix-domain (file-domain) sockets.])
 fi
 
+AC_CHECK_FUNCS(getrlimit setrlimit)
+
 AC_CHECK_FUNCS(socketpair getgroups setgroups setpwent pause tzset)
 
 AC_CHECK_FUNCS(sethostent   gethostent   endhostent   dnl
@@ -1035,18 +1037,6 @@ if test $guile_cv_localtime_cache = yes; then
   AC_DEFINE(LOCALTIME_CACHE, 1, [Define if localtime caches the TZ setting.])
 fi
 
-dnl Test whether system calls are restartable by default on the
-dnl current system.  If they are not, we put a loop around every system
-dnl call to check for EINTR (see SCM_SYSCALL) and do not attempt to
-dnl change from the default behaviour.  On the other hand, if signals
-dnl are restartable then the loop is not installed and when libguile
-dnl initialises it also resets the behaviour of each signal to cause a
-dnl restart (in case a different runtime had a different default
-dnl behaviour for some reason: e.g., different versions of linux seem
-dnl to behave differently.)
-
-AC_SYS_RESTARTABLE_SYSCALLS
-
 if test "$enable_regex" = yes; then
    if test "$ac_cv_header_regex_h" = yes ||
       test "$ac_cv_header_rxposix_h" = yes ||
@@ -1258,11 +1248,12 @@ case "$with_threads" in
 
     build_pthread_support="yes"
 
-    ACX_PTHREAD(CC="$PTHREAD_CC"
-      LIBS="$PTHREAD_LIBS $LIBS"
-      SCM_I_GSC_USE_PTHREAD_THREADS=1
-      with_threads="pthreads",
-      with_threads="null")
+    ACX_PTHREAD([CC="$PTHREAD_CC"
+       LIBS="$PTHREAD_LIBS $LIBS"
+       SCM_I_GSC_USE_PTHREAD_THREADS=1
+       with_threads="pthreads"],
+      [with_threads="null"
+       build_pthread_support="no"])
 
     old_CFLAGS="$CFLAGS"
     CFLAGS="$PTHREAD_CFLAGS $CFLAGS"
@@ -1461,6 +1452,9 @@ LIBLOBJS="`echo ${LIB@&t@OBJS} | sed 's,\.[[^.]]* ,.lo ,g;s,\.[[^.]]*$,.lo,'`"
 EXTRA_DOT_DOC_FILES="`echo ${LIB@&t@OBJS} | sed 's,\.[[^.]]* ,.doc ,g;s,\.[[^.]]*$,.doc,'`"
 EXTRA_DOT_X_FILES="`echo ${LIB@&t@OBJS} | sed 's,\.[[^.]]* ,.x ,g;s,\.[[^.]]*$,.x,'`"
 
+# GNU Readline bindings.
+GUILE_READLINE
+
 AC_SUBST(GUILE_MAJOR_VERSION)
 AC_SUBST(GUILE_MINOR_VERSION)
 AC_SUBST(GUILE_MICRO_VERSION)
@@ -1547,39 +1541,30 @@ AC_CONFIG_FILES([
   lib/Makefile
   benchmark-suite/Makefile
   doc/Makefile
-  doc/goops/Makefile
   doc/r5rs/Makefile
   doc/ref/Makefile
   doc/tutorial/Makefile
   emacs/Makefile
   examples/Makefile
-  examples/box-dynamic-module/Makefile
-  examples/box-dynamic/Makefile
-  examples/box-module/Makefile
-  examples/box/Makefile
-  examples/modules/Makefile
-  examples/safe/Makefile
-  examples/scripts/Makefile
-  guile-config/Makefile
-  ice-9/Makefile
-  ice-9/debugger/Makefile
-  ice-9/debugging/Makefile
   lang/Makefile
   libguile/Makefile
-  oop/Makefile
-  oop/goops/Makefile
-  scripts/Makefile
   srfi/Makefile
+  guile-readline/Makefile
   test-suite/Makefile
   test-suite/standalone/Makefile
+  meta/Makefile
+  module/Makefile
+  testsuite/Makefile
 ])
 
-AC_CONFIG_FILES([guile-1.8.pc])
+AC_CONFIG_FILES([meta/guile-2.0.pc])
+AC_CONFIG_FILES([meta/guile-2.0-uninstalled.pc])
 AC_CONFIG_FILES([check-guile], [chmod +x check-guile])
 AC_CONFIG_FILES([benchmark-guile], [chmod +x benchmark-guile])
-AC_CONFIG_FILES([guile-tools], [chmod +x guile-tools])
-AC_CONFIG_FILES([pre-inst-guile], [chmod +x pre-inst-guile])
-AC_CONFIG_FILES([pre-inst-guile-env], [chmod +x pre-inst-guile-env])
+AC_CONFIG_FILES([meta/guile], [chmod +x meta/guile])
+AC_CONFIG_FILES([meta/uninstalled-env], [chmod +x meta/uninstalled-env])
+AC_CONFIG_FILES([meta/gdb-uninstalled-guile], [chmod +x meta/gdb-uninstalled-guile])
+AC_CONFIG_FILES([meta/guile-tools], [chmod +x meta/guile-tools])
 AC_CONFIG_FILES([libguile/guile-snarf],
                 [chmod +x libguile/guile-snarf])
 AC_CONFIG_FILES([libguile/guile-doc-snarf],
@@ -1592,6 +1577,7 @@ AC_CONFIG_FILES([test-suite/standalone/test-use-srfi],
                 [chmod +x test-suite/standalone/test-use-srfi])
 AC_CONFIG_FILES([test-suite/standalone/test-fast-slot-ref],
                 [chmod +x test-suite/standalone/test-fast-slot-ref])
+AC_CONFIG_FILES([doc/ref/effective-version.texi])
 
 AC_OUTPUT
 
diff --git a/doc/Makefile.am b/doc/Makefile.am
index 4581a7291..06f55a7e3 100644
--- a/doc/Makefile.am
+++ b/doc/Makefile.am
@@ -1,27 +1,27 @@
 ## Process this file with Automake to create Makefile.in
 ##
-##  	Copyright (C) 1998, 2002, 2006, 2008 Free Software Foundation, Inc.
+##  	Copyright (C) 1998, 2002, 2006, 2008, 2009 Free Software Foundation, Inc.
 ##
 ##   This file is part of GUILE.
 ##
-##   GUILE 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
+##   GUILE is free software; you can redistribute it and/or modify it
+##   under the terms of the GNU Lesser General Public License as
+##   published by the Free Software Foundation; either version 3, or
 ##   (at your option) any later version.
 ##
 ##   GUILE is distributed in the hope that 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.
+##   GNU Lesser General Public License for more details.
 ##
-##   You should have received a copy of the GNU General Public
-##   License along with GUILE; see the file COPYING.  If not, write
-##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-##   Floor, Boston, MA 02110-1301 USA
+##   You should have received a copy of the GNU Lesser General Public
+##   License along with GUILE; see the file COPYING.LESSER.  If not,
+##   write to the Free Software Foundation, Inc., 51 Franklin Street,
+##   Fifth Floor, Boston, MA 02110-1301 USA
 
 AUTOMAKE_OPTIONS = gnu
 
-SUBDIRS = ref tutorial goops r5rs
+SUBDIRS = ref tutorial r5rs
 
 dist_man1_MANS = guile.1
 
@@ -43,4 +43,3 @@ include $(top_srcdir)/am/maintainer-dirs
 guile-api.alist: guile-api.alist-FORCE
 	( cd $(top_builddir) ; $(mscripts)/update-guile-api.alist )
 guile-api.alist-FORCE:
-
diff --git a/doc/README b/doc/README
index 3ecd329b4..18862a6b8 100644
--- a/doc/README
+++ b/doc/README
@@ -8,10 +8,6 @@ The documentation consists of the following manuals.
 - The Guile Reference Manual (guile.texi) contains (or is intended to
   contain) reference documentation on all aspects of Guile.
 
-- The GOOPS Manual (goops.texi) contains both tutorial-style and
-  reference documentation for using GOOPS, Guile's Object Oriented
-  Programming System.
-
 - The Revised^5 Report on the Algorithmic Language Scheme (r5rs.texi).
 
 Please be aware that this is all very much work in progress (apart
diff --git a/doc/example-smob/image-type.c b/doc/example-smob/image-type.c
index 68ecded9d..8dd998a50 100644
--- a/doc/example-smob/image-type.c
+++ b/doc/example-smob/image-type.c
@@ -2,20 +2,20 @@
  * 
  *	Copyright (C) 1998, 2000, 2004, 2006 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 free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3, 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.
+ * This program is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
  * 
- * You should have received a copy of the GNU General Public License
- * along with this software; see the file COPYING.  If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301 USA
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this software; see the file COPYING.LESSER.  If
+ * not, write to the Free Software Foundation, Inc., 51 Franklin
+ * Street, Fifth Floor, Boston, MA 02110-1301 USA
  */
 
 #include <stdlib.h>
diff --git a/doc/example-smob/myguile.c b/doc/example-smob/myguile.c
index 9df3cf31b..30200dd03 100644
--- a/doc/example-smob/myguile.c
+++ b/doc/example-smob/myguile.c
@@ -2,20 +2,20 @@
  * 
  *	Copyright (C) 1998, 2006 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 free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3, 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.
+ * This program is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
  * 
- * You should have received a copy of the GNU General Public License
- * along with this software; see the file COPYING.  If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301 USA
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this software; see the file COPYING.LESSER.  If
+ * not, write to the Free Software Foundation, Inc., 51 Franklin
+ * Street, Fifth Floor, Boston, MA 02110-1301 USA
  */
 
 #include <libguile.h>
diff --git a/doc/goops.mail b/doc/goops.mail
new file mode 100644
index 000000000..305e80403
--- /dev/null
+++ b/doc/goops.mail
@@ -0,0 +1,78 @@
+From: Mikael Djurfeldt <mdj@mdj.nada.kth.se>
+Subject: Re: After GOOPS integration: Computation with native types!
+To: Keisuke Nishida <kxn30@po.cwru.edu>
+Cc: djurfeldt@nada.kth.se, guile@sourceware.cygnus.com
+Cc: djurfeldt@nada.kth.se
+Date: 17 Aug 2000 03:01:13 +0200
+
+Keisuke Nishida <kxn30@po.cwru.edu> writes:
+
+> Do I need to include some special feature in my VM?  Hmm, but maybe
+> I shouldn't do that now...
+
+Probably not, so I probably shouldn't answer, but...  :)
+
+You'll need to include some extremely efficient mechanism to do
+multi-method dispatch.  The SCM_IM_DISPATCH form, with its
+implementation at line 2250 in eval.c, is the current basis for
+efficient dispatch in GOOPS.
+
+I think we should develop a new instruction for the VM which
+corresponds to the SCM_IM_DISPATCH form.
+
+This form serves both the purpose to map argument types to the correct
+code, and as a cache of compiled methods.
+
+Notice that I talk about cmethods below, not methods.  In GOOPS, the
+GF has a set of methods, but each method has a "code-table" mapping
+argument types to code compiled for those particular concrete types.
+(So, in essence, GOOPS methods abstractly do a deeper level of type
+dispatch.)
+
+The SCM_IM_DISPATCH form has two shapes, depending on whether we use
+sequential search (few cmethods) or hashed lookup (many cmethods).
+
+Shape 1:
+
+ (#@dispatch args N-SPECIALIZED #((TYPE1 ... ENV FORMALS FORM1 ...) ...) GF)
+
+Shape 2:
+
+ (#@dispatch args N-SPECIALIZED HASHSET MASK
+             #((TYPE1 ... ENV FORMALS FORM1 ...) ...)
+             GF)
+
+`args' is (I hope!) a now historic obscure optimization.
+
+N-SPECIALIZED is the maximum number of arguments t do type checking
+on.  This is used early termination of argument checking where the
+already checked arguments are enough to pick out the cmethod.
+
+The vector is the cache proper.
+
+During sequential search the argument types are simply checked against
+each entry.
+
+The method for hashed dispatch is described in:
+
+http://www.parc.xerox.com/csl/groups/sda/publications/papers/Kiczales-Andreas-PCL
+
+In this method, each class has a hash code.  Dispatch means summing
+the hash codes for all arguments (up til N-SPECIALIZED) and using the
+sum to pick a location in the cache.  The cache is sequentially
+searched for an argument type match from that point.
+
+Kiczales introduced a clever method to maximize the probability of a
+direct cache hit.  We actually have 8 separate sets of hash codes for
+all types.  The hash set to use is selected specifically per GF and is
+optimized to give fastest average hit.
+
+
+What we could try to do as soon as the VM is complete enough is to
+represent the cmethods as chunks of byte code.  In the current GOOPS
+code, the compilation step (which is currently empty) is situated in
+`compile-cmethod' in guile-oops/compile.scm.  [Apologies for the
+terrible code.  That particular part was written at Arlanda airport
+after a sleepless night (packing luggage, not coding), on my way to
+visit Marius (who, BTW, didn't take GOOPS seriously.  ;-)]
+
diff --git a/doc/goops/Makefile.am b/doc/goops/Makefile.am
deleted file mode 100644
index 03794c4de..000000000
--- a/doc/goops/Makefile.am
+++ /dev/null
@@ -1,29 +0,0 @@
-## Process this file with Automake to create Makefile.in
-##
-##  	Copyright (C) 1998, 2004, 2006, 2008 Free Software Foundation, Inc.
-##
-##   This file is part of GUILE.
-##   
-##   GUILE 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.
-##   
-##   GUILE is distributed in the hope that 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 GUILE; see the file COPYING.  If not, write
-##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-##   Floor, Boston, MA 02110-1301 USA
-
-AUTOMAKE_OPTIONS = gnu
-
-info_TEXINFOS = goops.texi
-
-goops_TEXINFOS = goops-tutorial.texi \
-  hierarchy.eps hierarchy.png hierarchy.txt hierarchy.pdf
-
-EXTRA_DIST = ChangeLog-2008
diff --git a/doc/groupings.alist b/doc/groupings.alist
index ed5bb1fca..a1748196f 100644
--- a/doc/groupings.alist
+++ b/doc/groupings.alist
@@ -3,19 +3,19 @@
 ;; 	Copyright (C) 2002, 2006 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
+;; modify it under the terms of the GNU Lesser General Public License
+;; as published by the Free Software Foundation; either version 3, 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
+;; 
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;; General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this software; see the file COPYING.  If not, write to
-;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301 USA
+;; Lesser General Public License for more details.
+;; 
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this software; see the file COPYING.LESSER.  If
+;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;; Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 ;;; Commentary:
 
diff --git a/doc/maint/docstring.el b/doc/maint/docstring.el
index 2b5639eb6..ef271930f 100644
--- a/doc/maint/docstring.el
+++ b/doc/maint/docstring.el
@@ -2,22 +2,22 @@
 ;;;
 ;;; Copyright (C) 2001, 2004 Neil Jerram
 ;;;
-;;; This file is not part of GNU Emacs, but the same permissions apply.
+;;; This file is not part of GUILE, but the same permissions apply.
 ;;;
-;;; GNU Emacs is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 2, or (at your option)
-;;; any later version.
+;;; GUILE is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU Lesser General Public License as
+;;; published by the Free Software Foundation; either version 3, or
+;;; (at your option) any later version.
 ;;;
-;;; GNU Emacs is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
+;;; GUILE is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
 ;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;; Boston, MA 02110-1301, USA.
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with GUILE; see the file COPYING.LESSER.  If not,
+;;; write to the Free Software Foundation, Inc., 51 Franklin Street,
+;;; Fifth Floor, Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
diff --git a/doc/maint/guile.texi b/doc/maint/guile.texi
index ac0833421..4ef4aab18 100644
--- a/doc/maint/guile.texi
+++ b/doc/maint/guile.texi
@@ -204,7 +204,7 @@ Execute all thunks from the asyncs of the list @var{list_of_a}.
 @deffn {Scheme Procedure} system-async thunk
 @deffnx {C Function} scm_system_async (thunk)
 This function is deprecated.  You can use @var{thunk} directly
-instead of explicitely creating an async object.
+instead of explicitly creating an async object.
 
 @end deffn
 
diff --git a/doc/oldfmt.c b/doc/oldfmt.c
index fc82ba92a..f60afeddd 100644
--- a/doc/oldfmt.c
+++ b/doc/oldfmt.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 2000,2001, 2006, 2008 Free Software Foundation, Inc.
  * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3, or
+ * (at your option) any later version.
+ * 
+ * This program is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
- *
+ * 
  * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * License along with this software; see the file COPYING.LESSER.  If
+ * not, write to the Free Software Foundation, Inc., 51 Franklin
+ * Street, Fifth Floor, Boston, MA 02110-1301 USA
  */
 
 
diff --git a/doc/r5rs/Makefile.am b/doc/r5rs/Makefile.am
index 4af0c951a..c64e4ffb1 100644
--- a/doc/r5rs/Makefile.am
+++ b/doc/r5rs/Makefile.am
@@ -4,20 +4,20 @@
 ##
 ##   This file is part of GUILE.
 ##   
-##   GUILE 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
+##   GUILE is free software; you can redistribute it and/or modify it
+##   under the terms of the GNU Lesser General Public License as
+##   published by the Free Software Foundation; either version 3, or
 ##   (at your option) any later version.
-##   
+##
 ##   GUILE is distributed in the hope that 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 GUILE; see the file COPYING.  If not, write
-##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-##   Floor, Boston, MA 02110-1301 USA
+##   GNU Lesser General Public License for more details.
+##
+##   You should have received a copy of the GNU Lesser General Public
+##   License along with GUILE; see the file COPYING.LESSER.  If not,
+##   write to the Free Software Foundation, Inc., 51 Franklin Street,
+##   Fifth Floor, Boston, MA 02110-1301 USA
 
 AUTOMAKE_OPTIONS = gnu
 
diff --git a/doc/ref/.gitignore b/doc/ref/.gitignore
index fc69e3188..c76e2e4af 100644
--- a/doc/ref/.gitignore
+++ b/doc/ref/.gitignore
@@ -1,2 +1,3 @@
 autoconf-macros.texi
 lib-version.texi
+effective-version.texi
diff --git a/doc/goops/ChangeLog-2008 b/doc/ref/ChangeLog-goops-2008
index a5a637d7b..a5a637d7b 100644
--- a/doc/goops/ChangeLog-2008
+++ b/doc/ref/ChangeLog-goops-2008
diff --git a/doc/ref/Makefile.am b/doc/ref/Makefile.am
index 2ca550ab3..2f218a565 100644
--- a/doc/ref/Makefile.am
+++ b/doc/ref/Makefile.am
@@ -4,20 +4,20 @@
 ##
 ##   This file is part of GUILE.
 ##
-##   GUILE 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
+##   GUILE is free software; you can redistribute it and/or modify it
+##   under the terms of the GNU Lesser General Public License as
+##   published by the Free Software Foundation; either version 3, or
 ##   (at your option) any later version.
 ##
 ##   GUILE is distributed in the hope that 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.
+##   GNU Lesser General Public License for more details.
 ##
-##   You should have received a copy of the GNU General Public
-##   License along with GUILE; see the file COPYING.  If not, write
-##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-##   Floor, Boston, MA 02110-1301 USA
+##   You should have received a copy of the GNU Lesser General Public
+##   License along with GUILE; see the file COPYING.LESSER.  If not,
+##   write to the Free Software Foundation, Inc., 51 Franklin Street,
+##   Fifth Floor, Boston, MA 02110-1301 USA
 
 AUTOMAKE_OPTIONS = gnu
 
@@ -68,6 +68,9 @@ guile_TEXINFOS = preface.texi			\
 		 autoconf.texi			\
 		 autoconf-macros.texi		\
 		 tools.texi			\
+		 history.texi			\
+		 vm.texi			\
+		 compiler.texi			\
 		 fdl.texi			\
 		 libguile-concepts.texi		\
 		 libguile-smobs.texi		\
@@ -75,19 +78,29 @@ guile_TEXINFOS = preface.texi			\
 		 libguile-linking.texi		\
 	 	 libguile-extensions.texi	\
 		 api-init.texi			\
-		 mod-getopt-long.texi
+		 mod-getopt-long.texi		\
+		 goops.texi			\
+		 goops-tutorial.texi		\
+		 effective-version.texi
 
 ETAGS_ARGS = $(info_TEXINFOS) $(guile_TEXINFOS)
 
-EXTRA_DIST = ChangeLog-2008
+PICTURES = hierarchy.eps \
+	   hierarchy.pdf \
+	   hierarchy.png \
+	   hierarchy.txt \
+	   mop.text
+
+EXTRA_DIST = ChangeLog-2008 $(PICTURES)
 
 include $(top_srcdir)/am/pre-inst-guile
 
 # Automated snarfing
 
 autoconf.texi: autoconf-macros.texi
-autoconf-macros.texi: $(top_srcdir)/guile-config/guile.m4
-	$(preinstguiletool)/snarf-guile-m4-docs $(top_srcdir)/guile-config/guile.m4 \
+autoconf-macros.texi: $(top_srcdir)/meta/guile.m4
+	GUILE_AUTO_COMPILE=0 $(top_builddir)/meta/uninstalled-env guile-tools \
+	  snarf-guile-m4-docs $(top_srcdir)/meta/guile.m4 \
 	  > $(srcdir)/$@
 
 lib-version.texi: $(top_srcdir)/GUILE-VERSION
diff --git a/doc/ref/api-binding.texi b/doc/ref/api-binding.texi
index b42f5567f..e53c48040 100644
--- a/doc/ref/api-binding.texi
+++ b/doc/ref/api-binding.texi
@@ -1,6 +1,6 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
-@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004
+@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2009
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
@@ -271,10 +271,16 @@ with duplicate bindings.
 Guile provides a procedure for checking whether a symbol is bound in the
 top level environment.
 
-@c NJFIXME explain [env]
-@deffn {Scheme Procedure} defined? sym [env]
-@deffnx {C Function} scm_defined_p (sym, env)
-Return @code{#t} if @var{sym} is defined in the lexical environment @var{env}.  When @var{env} is not specified, look in the top-level environment as defined by the current module.
+@deffn {Scheme Procedure} defined? sym [module]
+@deffnx {C Function} scm_defined_p (sym, module)
+Return @code{#t} if @var{sym} is defined in the module @var{module} or
+the current module when @var{module} is not specified; otherwise return
+@code{#f}.
+
+Up to Guile 1.8, the second optional argument had to be @dfn{lexical
+environment} as returned by @code{the-environment}, for example.  The
+behavior of this function remains unchanged when the second argument is
+omitted.
 @end deffn
 
 
diff --git a/doc/ref/api-compound.texi b/doc/ref/api-compound.texi
index c551c4d10..059390bb8 100644
--- a/doc/ref/api-compound.texi
+++ b/doc/ref/api-compound.texi
@@ -1,6 +1,6 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
-@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2009
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
@@ -1344,9 +1344,9 @@ otherwise.
 @deftypefn  {C Function} SCM scm_take_u8vector (const scm_t_uint8 *data, size_t len)
 @deftypefnx {C Function} SCM scm_take_s8vector (const scm_t_int8 *data, size_t len)
 @deftypefnx {C Function} SCM scm_take_u16vector (const scm_t_uint16 *data, size_t len)
-@deftypefnx {C Function} SCM scm_take_s168vector (const scm_t_int16 *data, size_t len)
+@deftypefnx {C Function} SCM scm_take_s16vector (const scm_t_int16 *data, size_t len)
 @deftypefnx {C Function} SCM scm_take_u32vector (const scm_t_uint32 *data, size_t len)
-@deftypefnx {C Function} SCM scm_take_s328vector (const scm_t_int32 *data, size_t len)
+@deftypefnx {C Function} SCM scm_take_s32vector (const scm_t_int32 *data, size_t len)
 @deftypefnx {C Function} SCM scm_take_u64vector (const scm_t_uint64 *data, size_t len)
 @deftypefnx {C Function} SCM scm_take_s64vector (const scm_t_int64 *data, size_t len)
 @deftypefnx {C Function} SCM scm_take_f32vector (const float *data, size_t len)
@@ -1405,6 +1405,12 @@ C}), but returns a pointer to the elements of a uniform numeric vector
 of the indicated kind.
 @end deftypefn
 
+Uniform numeric vectors can be written to and read from input/output
+ports using the procedures listed below.  However, bytevectors may often
+be more convenient for binary input/output since they provide more
+flexibility in the interpretation of raw byte sequences
+(@pxref{Bytevectors}).
+
 @deffn {Scheme Procedure} uniform-vector-read! uvec [port_or_fd [start [end]]]
 @deffnx {C Function} scm_uniform_vector_read_x (uvec, port_or_fd, start, end)
 Fill the elements of @var{uvec} by reading
@@ -1643,18 +1649,18 @@ and writing.
 @subsection Generalized Vectors
 
 Guile has a number of data types that are generally vector-like:
-strings, uniform numeric vectors, bitvectors, and of course ordinary
-vectors of arbitrary Scheme values.  These types are disjoint: a
-Scheme value belongs to at most one of the four types listed above.
+strings, uniform numeric vectors, bytevectors, bitvectors, and of course
+ordinary vectors of arbitrary Scheme values.  These types are disjoint:
+a Scheme value belongs to at most one of the five types listed above.
 
 If you want to gloss over this distinction and want to treat all four
 types with common code, you can use the procedures in this section.
 They work with the @emph{generalized vector} type, which is the union
-of the four vector-like types.
+of the five vector-like types.
 
 @deffn {Scheme Procedure} generalized-vector? obj
 @deffnx {C Function} scm_generalized_vector_p (obj)
-Return @code{#t} if @var{obj} is a vector, string,
+Return @code{#t} if @var{obj} is a vector, bytevector, string,
 bitvector, or uniform numeric vector.
 @end deffn
 
@@ -1743,9 +1749,9 @@ matrix with zero columns and 3 rows is different from a matrix with 3
 columns and zero rows, which again is different from a vector of
 length zero.
 
-Generalized vectors, such as strings, uniform numeric vectors, bit
-vectors and ordinary vectors, are the special case of one dimensional
-arrays.
+Generalized vectors, such as strings, uniform numeric vectors,
+bytevectors, bit vectors and ordinary vectors, are the special case of
+one dimensional arrays.
 
 @menu
 * Array Syntax::                
@@ -1828,6 +1834,16 @@ is a rank-zero array with contents 12.
 
 @end table
 
+In addition, bytevectors are also arrays, but use a different syntax
+(@pxref{Bytevectors}):
+
+@table @code
+
+@item #vu8(1 2 3)
+is a 3-byte long bytevector, with contents 1, 2, 3.
+
+@end table
+
 @node Array Procedures
 @subsubsection Array Procedures
 
@@ -1985,13 +2001,24 @@ enclosed array is unspecified.
 For example,
 
 @lisp
-(enclose-array '#3(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1)
+(enclose-array '#3(((a b c)
+                    (d e f))
+                   ((1 2 3)
+                    (4 5 6)))
+               1)
 @result{}
-#<enclosed-array (#1(a d) #1(b e) #1(c f)) (#1(1 4) #1(2 5) #1(3 6))>
-
-(enclose-array '#3(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1 0)
+#<enclosed-array (#1(a d) #1(b e) #1(c f))
+                 (#1(1 4) #1(2 5) #1(3 6))>
+
+(enclose-array '#3(((a b c)
+                    (d e f))
+                   ((1 2 3)
+                    (4 5 6)))
+               1 0)
 @result{}
-#<enclosed-array #2((a 1) (d 4)) #2((b 2) (e 5)) #2((c 3) (f 6))>
+#<enclosed-array #2((a 1) (d 4))
+                 #2((b 2) (e 5))
+                 #2((c 3) (f 6))>
 @end lisp
 @end deffn
 
@@ -2342,21 +2369,13 @@ the danger of a deadlock.  In a multi-threaded program, you will need
 additional synchronization to avoid modifying reserved arrays.)
 
 You must take care to always unreserve an array after reserving it,
-also in the presence of non-local exits.  To simplify this, reserving
-and unreserving work like a dynwind context (@pxref{Dynamic Wind}): a
-call to @code{scm_array_get_handle} can be thought of as beginning a
-dynwind context and @code{scm_array_handle_release} as ending it.
-When a non-local exit happens between these two calls, the array is
-implicitely unreserved.
-
-That is, you need to properly pair reserving and unreserving in your
-code, but you don't need to worry about non-local exits.
-
-These calls and other pairs of calls that establish dynwind contexts
-need to be properly nested.  If you begin a context prior to reserving
-an array, you need to unreserve the array before ending the context.
-Likewise, when reserving two or more arrays in a certain order, you
-need to unreserve them in the opposite order.
+even in the presence of non-local exits.  If a non-local exit can
+happen between these two calls, you should install a dynwind context
+that releases the array when it is left (@pxref{Dynamic Wind}).
+
+In addition, array reserving and unreserving must be properly
+paired.  For instance, when reserving two or more arrays in a certain
+order, you need to unreserve them in the opposite order.
 
 Once you have reserved an array and have retrieved the pointer to its
 elements, you must figure out the layout of the elements in memory.
@@ -2797,11 +2816,11 @@ structure.
 @example
 (make-vtable "prpw"
              (lambda (struct port)
-               (display "#<")
-               (display (struct-ref 0))
-               (display " and ")
-               (display (struct-ref 1))
-               (display ">")))
+               (display "#<" port)
+               (display (struct-ref struct 0) port)
+               (display " and " port)
+               (display (struct-ref struct 1) port)
+               (display ">" port)))
 @end example
 @end deffn
 
@@ -3075,8 +3094,10 @@ which can be changed.
                          (color ball)
                          (owner ball)))
                ball-color))
-(define (color ball) (struct-ref (struct-vtable ball) vtable-offset-user))
-(define (owner ball) (struct-ref ball 0))
+(define (color ball)
+  (struct-ref (struct-vtable ball) vtable-offset-user))
+(define (owner ball)
+  (struct-ref ball 0))
 
 (define red (make-ball-type 'red))
 (define green (make-ball-type 'green))
@@ -3452,7 +3473,8 @@ whole is not a proper list:
 (assoc "mary" '((1 . 2) ("key" . "door") . "open sesame"))
 @result{}
 ERROR: In procedure assoc in expression (assoc "mary" (quote #)):
-ERROR: Wrong type argument in position 2 (expecting association list): ((1 . 2) ("key" . "door") . "open sesame")
+ERROR: Wrong type argument in position 2 (expecting
+   association list): ((1 . 2) ("key" . "door") . "open sesame")
 
 (sloppy-assoc "mary" '((1 . 2) ("key" . "door") . "open sesame"))
 @result{}
@@ -3466,7 +3488,8 @@ Secondly, if one of the entries in the specified alist is not a pair:
 (assoc 2 '((1 . 1) 2 (3 . 9)))
 @result{}
 ERROR: In procedure assoc in expression (assoc 2 (quote #)):
-ERROR: Wrong type argument in position 2 (expecting association list): ((1 . 1) 2 (3 . 9))
+ERROR: Wrong type argument in position 2 (expecting
+   association list): ((1 . 1) 2 (3 . 9))
 
 (sloppy-assoc 2 '((1 . 1) 2 (3 . 9)))
 @result{}
diff --git a/doc/ref/api-control.texi b/doc/ref/api-control.texi
index ed6411f29..e7614d136 100644
--- a/doc/ref/api-control.texi
+++ b/doc/ref/api-control.texi
@@ -22,6 +22,7 @@ flow of Scheme affects C code.
 * Error Reporting::             Procedures for signaling errors.
 * Dynamic Wind::                Dealing with non-local entrance/exit.
 * Handling Errors::             How to handle errors in C code.
+* Continuation Barriers::       Protection from non-local control flow.
 @end menu
 
 @node begin
@@ -1501,6 +1502,33 @@ which is the name of the procedure incorrectly invoked.
 @end deftypefn
 
 
+@node Continuation Barriers
+@subsection Continuation Barriers
+
+The non-local flow of control caused by continuations might sometimes
+not be wanted.  You can use @code{with-continuation-barrier} etc to
+errect fences that continuations can not pass.
+
+@deffn {Scheme Procedure} with-continuation-barrier proc
+@deffnx {C Function} scm_with_continuation_barrier (proc)
+Call @var{proc} and return its result.  Do not allow the invocation of
+continuations that would leave or enter the dynamic extent of the call
+to @code{with-continuation-barrier}.  Such an attempt causes an error
+to be signaled.
+
+Throws (such as errors) that are not caught from within @var{proc} are
+caught by @code{with-continuation-barrier}.  In that case, a short
+message is printed to the current error port and @code{#f} is returned.
+
+Thus, @code{with-continuation-barrier} returns exactly once.
+@end deffn
+
+@deftypefn {C Function} {void *} scm_c_with_continuation_barrier (void *(*func) (void *), void *data)
+Like @code{scm_with_continuation_barrier} but call @var{func} on
+@var{data}.  When an error is caught, @code{NULL} is returned.
+@end deftypefn
+
+
 @c Local Variables:
 @c TeX-master: "guile.texi"
 @c End:
diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi
index e1db2a612..0fd4ee1cf 100755
--- a/doc/ref/api-data.texi
+++ b/doc/ref/api-data.texi
@@ -1,6 +1,6 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
-@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2007, 2008
+@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2007, 2008, 2009
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
@@ -45,6 +45,7 @@ For the documentation of such @dfn{compound} data types, see
 * Characters::                  Single characters.
 * Character Sets::              Sets of characters.
 * Strings::                     Sequences of characters.
+* Bytevectors::                 Sequences of bytes.
 * Regular Expressions::         Pattern matching and substitution.
 * Symbols::                     Symbols.
 * Keywords::                    Self-quoting, customizable display keywords.
@@ -331,7 +332,7 @@ integers.
 
 The motivation for this behavior is that the inexactness of a number
 should not be lost silently.  If you want to allow inexact integers,
-you can explicitely insert a call to @code{inexact->exact} or to its C
+you can explicitly insert a call to @code{inexact->exact} or to its C
 equivalent @code{scm_inexact_to_exact}.  (Only inexact integers will
 be converted by this call into exact integers; inexact non-integers
 will become exact fractions.)
@@ -3476,9 +3477,9 @@ allocated string.
 @deffnx {C Function} scm_string_concatenate_reverse (ls, final_string, end)
 Without optional arguments, this procedure is equivalent to
 
-@smalllisp
+@lisp
 (string-concatenate (reverse ls))
-@end smalllisp
+@end lisp
 
 If the optional argument @var{final_string} is specified, it is
 consed onto the beginning to @var{ls} before performing the
@@ -3534,11 +3535,12 @@ For example, to change characters to alternately upper and lower case,
 
 @example
 (define str (string-copy "studly"))
-(string-for-each-index (lambda (i)
-                         (string-set! str i
-                           ((if (even? i) char-upcase char-downcase)
-                            (string-ref str i))))
-                       str)
+(string-for-each-index
+    (lambda (i)
+      (string-set! str i
+        ((if (even? i) char-upcase char-downcase)
+         (string-ref str i))))
+    str)
 str @result{} "StUdLy"
 @end example
 @end deffn
@@ -3746,6 +3748,445 @@ is larger than @var{max_len}, only @var{max_len} bytes have been
 stored and you probably need to try again with a larger buffer.
 @end deftypefn
 
+@node Bytevectors
+@subsection Bytevectors
+
+@cindex bytevector
+@cindex R6RS
+
+A @dfn{bytevector} is a raw bit string.  The @code{(rnrs bytevector)}
+module provides the programming interface specified by the
+@uref{http://www.r6rs.org/, Revised^6 Report on the Algorithmic Language
+Scheme (R6RS)}.  It contains procedures to manipulate bytevectors and
+interpret their contents in a number of ways: bytevector contents can be
+accessed as signed or unsigned integer of various sizes and endianness,
+as IEEE-754 floating point numbers, or as strings.  It is a useful tool
+to encode and decode binary data.
+
+The R6RS (Section 4.3.4) specifies an external representation for
+bytevectors, whereby the octets (integers in the range 0--255) contained
+in the bytevector are represented as a list prefixed by @code{#vu8}:
+
+@lisp
+#vu8(1 53 204)
+@end lisp
+
+denotes a 3-byte bytevector containing the octets 1, 53, and 204.  Like
+string literals, booleans, etc., bytevectors are ``self-quoting'', i.e.,
+they do not need to be quoted:
+
+@lisp
+#vu8(1 53 204)
+@result{} #vu8(1 53 204)
+@end lisp
+
+Bytevectors can be used with the binary input/output primitives of the
+R6RS (@pxref{R6RS I/O Ports}).
+
+@menu
+* Bytevector Endianness::       Dealing with byte order.
+* Bytevector Manipulation::     Creating, copying, manipulating bytevectors.
+* Bytevectors as Integers::     Interpreting bytes as integers.
+* Bytevectors and Integer Lists::  Converting to/from an integer list.
+* Bytevectors as Floats::       Interpreting bytes as real numbers.
+* Bytevectors as Strings::      Interpreting bytes as Unicode strings.
+* Bytevectors as Generalized Vectors::  Guile extension to the bytevector API.
+@end menu
+
+@node Bytevector Endianness
+@subsubsection Endianness
+
+@cindex endianness
+@cindex byte order
+@cindex word order
+
+Some of the following procedures take an @var{endianness} parameter.
+The @dfn{endianness} is defined as the order of bytes in multi-byte
+numbers: numbers encoded in @dfn{big endian} have their most
+significant bytes written first, whereas numbers encoded in
+@dfn{little endian} have their least significant bytes
+first@footnote{Big-endian and little-endian are the most common
+``endiannesses'', but others do exist. For instance, the GNU MP
+library allows @dfn{word order} to be specified independently of
+@dfn{byte order} (@pxref{Integer Import and Export,,, gmp, The GNU
+Multiple Precision Arithmetic Library Manual}).}.
+
+Little-endian is the native endianness of the IA32 architecture and
+its derivatives, while big-endian is native to SPARC and PowerPC,
+among others. The @code{native-endianness} procedure returns the
+native endianness of the machine it runs on.
+
+@deffn {Scheme Procedure} native-endianness
+@deffnx {C Function} scm_native_endianness ()
+Return a value denoting the native endianness of the host machine.
+@end deffn
+
+@deffn {Scheme Macro} endianness symbol
+Return an object denoting the endianness specified by @var{symbol}.  If
+@var{symbol} is neither @code{big} nor @code{little} then an error is
+raised at expand-time.
+@end deffn
+
+@defvr {C Variable} scm_endianness_big
+@defvrx {C Variable} scm_endianness_little
+The objects denoting big- and little-endianness, respectively.
+@end defvr
+
+
+@node Bytevector Manipulation
+@subsubsection Manipulating Bytevectors
+
+Bytevectors can be created, copied, and analyzed with the following
+procedures and C functions.
+
+@deffn {Scheme Procedure} make-bytevector len [fill]
+@deffnx {C Function} scm_make_bytevector (len, fill)
+@deffnx {C Function} scm_c_make_bytevector (size_t len)
+Return a new bytevector of @var{len} bytes.  Optionally, if @var{fill}
+is given, fill it with @var{fill}; @var{fill} must be in the range
+[-128,255].
+@end deffn
+
+@deffn {Scheme Procedure} bytevector? obj
+@deffnx {C Function} scm_bytevector_p (obj)
+Return true if @var{obj} is a bytevector.
+@end deffn
+
+@deftypefn {C Function} int scm_is_bytevector (SCM obj)
+Equivalent to @code{scm_is_true (scm_bytevector_p (obj))}.
+@end deftypefn
+
+@deffn {Scheme Procedure} bytevector-length bv
+@deffnx {C Function} scm_bytevector_length (bv)
+Return the length in bytes of bytevector @var{bv}.
+@end deffn
+
+@deftypefn {C Function} size_t scm_c_bytevector_length (SCM bv)
+Likewise, return the length in bytes of bytevector @var{bv}.
+@end deftypefn
+
+@deffn {Scheme Procedure} bytevector=? bv1 bv2
+@deffnx {C Function} scm_bytevector_eq_p (bv1, bv2)
+Return is @var{bv1} equals to @var{bv2}---i.e., if they have the same
+length and contents.
+@end deffn
+
+@deffn {Scheme Procedure} bytevector-fill! bv fill
+@deffnx {C Function} scm_bytevector_fill_x (bv, fill)
+Fill bytevector @var{bv} with @var{fill}, a byte.
+@end deffn
+
+@deffn {Scheme Procedure} bytevector-copy! source source-start target target-start len
+@deffnx {C Function} scm_bytevector_copy_x (source, source_start, target, target_start, len)
+Copy @var{len} bytes from @var{source} into @var{target}, starting
+reading from @var{source-start} (a positive index within @var{source})
+and start writing at @var{target-start}.
+@end deffn
+
+@deffn {Scheme Procedure} bytevector-copy bv
+@deffnx {C Function} scm_bytevector_copy (bv)
+Return a newly allocated copy of @var{bv}.
+@end deffn
+
+@deftypefn {C Function} scm_t_uint8 scm_c_bytevector_ref (SCM bv, size_t index)
+Return the byte at @var{index} in bytevector @var{bv}.
+@end deftypefn
+
+@deftypefn {C Function} void scm_c_bytevector_set_x (SCM bv, size_t index, scm_t_uint8 value)
+Set the byte at @var{index} in @var{bv} to @var{value}.
+@end deftypefn
+
+Low-level C macros are available.  They do not perform any
+type-checking; as such they should be used with care.
+
+@deftypefn {C Macro} size_t SCM_BYTEVECTOR_LENGTH (bv)
+Return the length in bytes of bytevector @var{bv}.
+@end deftypefn
+
+@deftypefn {C Macro} {signed char *} SCM_BYTEVECTOR_CONTENTS (bv)
+Return a pointer to the contents of bytevector @var{bv}.
+@end deftypefn
+
+
+@node Bytevectors as Integers
+@subsubsection Interpreting Bytevector Contents as Integers
+
+The contents of a bytevector can be interpreted as a sequence of
+integers of any given size, sign, and endianness.
+
+@lisp
+(let ((bv (make-bytevector 4)))
+  (bytevector-u8-set! bv 0 #x12)
+  (bytevector-u8-set! bv 1 #x34)
+  (bytevector-u8-set! bv 2 #x56)
+  (bytevector-u8-set! bv 3 #x78)
+
+  (map (lambda (number)
+         (number->string number 16))
+       (list (bytevector-u8-ref bv 0)
+             (bytevector-u16-ref bv 0 (endianness big))
+             (bytevector-u32-ref bv 0 (endianness little)))))
+
+@result{} ("12" "1234" "78563412")
+@end lisp
+
+The most generic procedures to interpret bytevector contents as integers
+are described below.
+
+@deffn {Scheme Procedure} bytevector-uint-ref bv index endianness size
+@deffnx {Scheme Procedure} bytevector-sint-ref bv index endianness size
+@deffnx {C Function} scm_bytevector_uint_ref (bv, index, endianness, size)
+@deffnx {C Function} scm_bytevector_sint_ref (bv, index, endianness, size)
+Return the @var{size}-byte long unsigned (resp. signed) integer at
+index @var{index} in @var{bv}, decoded according to @var{endianness}.
+@end deffn
+
+@deffn {Scheme Procedure} bytevector-uint-set! bv index value endianness size
+@deffnx {Scheme Procedure} bytevector-sint-set! bv index value endianness size
+@deffnx {C Function} scm_bytevector_uint_set_x (bv, index, value, endianness, size)
+@deffnx {C Function} scm_bytevector_sint_set_x (bv, index, value, endianness, size)
+Set the @var{size}-byte long unsigned (resp. signed) integer at
+@var{index} to @var{value}, encoded according to @var{endianness}.
+@end deffn
+
+The following procedures are similar to the ones above, but specialized
+to a given integer size:
+
+@deffn {Scheme Procedure} bytevector-u8-ref bv index
+@deffnx {Scheme Procedure} bytevector-s8-ref bv index
+@deffnx {Scheme Procedure} bytevector-u16-ref bv index endianness
+@deffnx {Scheme Procedure} bytevector-s16-ref bv index endianness
+@deffnx {Scheme Procedure} bytevector-u32-ref bv index endianness
+@deffnx {Scheme Procedure} bytevector-s32-ref bv index endianness
+@deffnx {Scheme Procedure} bytevector-u64-ref bv index endianness
+@deffnx {Scheme Procedure} bytevector-s64-ref bv index endianness
+@deffnx {C Function} scm_bytevector_u8_ref (bv, index)
+@deffnx {C Function} scm_bytevector_s8_ref (bv, index)
+@deffnx {C Function} scm_bytevector_u16_ref (bv, index, endianness)
+@deffnx {C Function} scm_bytevector_s16_ref (bv, index, endianness)
+@deffnx {C Function} scm_bytevector_u32_ref (bv, index, endianness)
+@deffnx {C Function} scm_bytevector_s32_ref (bv, index, endianness)
+@deffnx {C Function} scm_bytevector_u64_ref (bv, index, endianness)
+@deffnx {C Function} scm_bytevector_s64_ref (bv, index, endianness)
+Return the unsigned @var{n}-bit (signed) integer (where @var{n} is 8,
+16, 32 or 64) from @var{bv} at @var{index}, decoded according to
+@var{endianness}.
+@end deffn
+
+@deffn {Scheme Procedure} bytevector-u8-set! bv index value
+@deffnx {Scheme Procedure} bytevector-s8-set! bv index value
+@deffnx {Scheme Procedure} bytevector-u16-set! bv index value endianness
+@deffnx {Scheme Procedure} bytevector-s16-set! bv index value endianness
+@deffnx {Scheme Procedure} bytevector-u32-set! bv index value endianness
+@deffnx {Scheme Procedure} bytevector-s32-set! bv index value endianness
+@deffnx {Scheme Procedure} bytevector-u64-set! bv index value endianness
+@deffnx {Scheme Procedure} bytevector-s64-set! bv index value endianness
+@deffnx {C Function} scm_bytevector_u8_set_x (bv, index, value)
+@deffnx {C Function} scm_bytevector_s8_set_x (bv, index, value)
+@deffnx {C Function} scm_bytevector_u16_set_x (bv, index, value, endianness)
+@deffnx {C Function} scm_bytevector_s16_set_x (bv, index, value, endianness)
+@deffnx {C Function} scm_bytevector_u32_set_x (bv, index, value, endianness)
+@deffnx {C Function} scm_bytevector_s32_set_x (bv, index, value, endianness)
+@deffnx {C Function} scm_bytevector_u64_set_x (bv, index, value, endianness)
+@deffnx {C Function} scm_bytevector_s64_set_x (bv, index, value, endianness)
+Store @var{value} as an @var{n}-bit (signed) integer (where @var{n} is
+8, 16, 32 or 64) in @var{bv} at @var{index}, encoded according to
+@var{endianness}.
+@end deffn
+
+Finally, a variant specialized for the host's endianness is available
+for each of these functions (with the exception of the @code{u8}
+accessors, for obvious reasons):
+
+@deffn {Scheme Procedure} bytevector-u16-native-ref bv index
+@deffnx {Scheme Procedure} bytevector-s16-native-ref bv index
+@deffnx {Scheme Procedure} bytevector-u32-native-ref bv index
+@deffnx {Scheme Procedure} bytevector-s32-native-ref bv index
+@deffnx {Scheme Procedure} bytevector-u64-native-ref bv index
+@deffnx {Scheme Procedure} bytevector-s64-native-ref bv index
+@deffnx {C Function} scm_bytevector_u16_native_ref (bv, index)
+@deffnx {C Function} scm_bytevector_s16_native_ref (bv, index)
+@deffnx {C Function} scm_bytevector_u32_native_ref (bv, index)
+@deffnx {C Function} scm_bytevector_s32_native_ref (bv, index)
+@deffnx {C Function} scm_bytevector_u64_native_ref (bv, index)
+@deffnx {C Function} scm_bytevector_s64_native_ref (bv, index)
+Return the unsigned @var{n}-bit (signed) integer (where @var{n} is 8,
+16, 32 or 64) from @var{bv} at @var{index}, decoded according to the
+host's native endianness.
+@end deffn
+
+@deffn {Scheme Procedure} bytevector-u16-native-set! bv index value
+@deffnx {Scheme Procedure} bytevector-s16-native-set! bv index value
+@deffnx {Scheme Procedure} bytevector-u32-native-set! bv index value
+@deffnx {Scheme Procedure} bytevector-s32-native-set! bv index value
+@deffnx {Scheme Procedure} bytevector-u64-native-set! bv index value
+@deffnx {Scheme Procedure} bytevector-s64-native-set! bv index value
+@deffnx {C Function} scm_bytevector_u16_native_set_x (bv, index, value)
+@deffnx {C Function} scm_bytevector_s16_native_set_x (bv, index, value)
+@deffnx {C Function} scm_bytevector_u32_native_set_x (bv, index, value)
+@deffnx {C Function} scm_bytevector_s32_native_set_x (bv, index, value)
+@deffnx {C Function} scm_bytevector_u64_native_set_x (bv, index, value)
+@deffnx {C Function} scm_bytevector_s64_native_set_x (bv, index, value)
+Store @var{value} as an @var{n}-bit (signed) integer (where @var{n} is
+8, 16, 32 or 64) in @var{bv} at @var{index}, encoded according to the
+host's native endianness.
+@end deffn
+
+
+@node Bytevectors and Integer Lists
+@subsubsection Converting Bytevectors to/from Integer Lists
+
+Bytevector contents can readily be converted to/from lists of signed or
+unsigned integers:
+
+@lisp
+(bytevector->sint-list (u8-list->bytevector (make-list 4 255))
+                       (endianness little) 2)
+@result{} (-1 -1)
+@end lisp
+
+@deffn {Scheme Procedure} bytevector->u8-list bv
+@deffnx {C Function} scm_bytevector_to_u8_list (bv)
+Return a newly allocated list of unsigned 8-bit integers from the
+contents of @var{bv}.
+@end deffn
+
+@deffn {Scheme Procedure} u8-list->bytevector lst
+@deffnx {C Function} scm_u8_list_to_bytevector (lst)
+Return a newly allocated bytevector consisting of the unsigned 8-bit
+integers listed in @var{lst}.
+@end deffn
+
+@deffn {Scheme Procedure} bytevector->uint-list bv endianness size
+@deffnx {Scheme Procedure} bytevector->sint-list bv endianness size
+@deffnx {C Function} scm_bytevector_to_uint_list (bv, endianness, size)
+@deffnx {C Function} scm_bytevector_to_sint_list (bv, endianness, size)
+Return a list of unsigned (resp. signed) integers of @var{size} bytes
+representing the contents of @var{bv}, decoded according to
+@var{endianness}.
+@end deffn
+
+@deffn {Scheme Procedure} uint-list->bytevector lst endianness size
+@deffnx {Scheme Procedure} sint-list->bytevector lst endianness size
+@deffnx {C Function} scm_uint_list_to_bytevector (lst, endianness, size)
+@deffnx {C Function} scm_sint_list_to_bytevector (lst, endianness, size)
+Return a new bytevector containing the unsigned (resp. signed) integers
+listed in @var{lst} and encoded on @var{size} bytes according to
+@var{endianness}.
+@end deffn
+
+@node Bytevectors as Floats
+@subsubsection Interpreting Bytevector Contents as Floating Point Numbers
+
+@cindex IEEE-754 floating point numbers
+
+Bytevector contents can also be accessed as IEEE-754 single- or
+double-precision floating point numbers (respectively 32 and 64-bit
+long) using the procedures described here.
+
+@deffn {Scheme Procedure} bytevector-ieee-single-ref bv index endianness
+@deffnx {Scheme Procedure} bytevector-ieee-double-ref bv index endianness
+@deffnx {C Function} scm_bytevector_ieee_single_ref (bv, index, endianness)
+@deffnx {C Function} scm_bytevector_ieee_double_ref (bv, index, endianness)
+Return the IEEE-754 single-precision floating point number from @var{bv}
+at @var{index} according to @var{endianness}.
+@end deffn
+
+@deffn {Scheme Procedure} bytevector-ieee-single-set! bv index value endianness
+@deffnx {Scheme Procedure} bytevector-ieee-double-set! bv index value endianness
+@deffnx {C Function} scm_bytevector_ieee_single_set_x (bv, index, value, endianness)
+@deffnx {C Function} scm_bytevector_ieee_double_set_x (bv, index, value, endianness)
+Store real number @var{value} in @var{bv} at @var{index} according to
+@var{endianness}.
+@end deffn
+
+Specialized procedures are also available:
+
+@deffn {Scheme Procedure} bytevector-ieee-single-native-ref bv index
+@deffnx {Scheme Procedure} bytevector-ieee-double-native-ref bv index
+@deffnx {C Function} scm_bytevector_ieee_single_native_ref (bv, index)
+@deffnx {C Function} scm_bytevector_ieee_double_native_ref (bv, index)
+Return the IEEE-754 single-precision floating point number from @var{bv}
+at @var{index} according to the host's native endianness.
+@end deffn
+
+@deffn {Scheme Procedure} bytevector-ieee-single-native-set! bv index value
+@deffnx {Scheme Procedure} bytevector-ieee-double-native-set! bv index value
+@deffnx {C Function} scm_bytevector_ieee_single_native_set_x (bv, index, value)
+@deffnx {C Function} scm_bytevector_ieee_double_native_set_x (bv, index, value)
+Store real number @var{value} in @var{bv} at @var{index} according to
+the host's native endianness.
+@end deffn
+
+
+@node Bytevectors as Strings
+@subsubsection Interpreting Bytevector Contents as Unicode Strings
+
+@cindex Unicode string encoding
+
+Bytevector contents can also be interpreted as Unicode strings encoded
+in one of the most commonly available encoding formats@footnote{Guile
+1.8 does @emph{not} support Unicode strings.  Therefore, the procedures
+described here assume that Guile strings are internally encoded
+according to the current locale.  For instance, if @code{$LC_CTYPE} is
+@code{fr_FR.ISO-8859-1}, then @code{string->utf-8} @i{et al.} will
+assume that Guile strings are Latin-1-encoded.}.
+
+@lisp
+(utf8->string (u8-list->bytevector '(99 97 102 101)))
+@result{} "cafe"
+
+(string->utf8 "caf@'e") ;; SMALL LATIN LETTER E WITH ACUTE ACCENT
+@result{} #vu8(99 97 102 195 169)
+@end lisp
+
+@deffn {Scheme Procedure} string->utf8 str
+@deffnx {Scheme Procedure} string->utf16 str
+@deffnx {Scheme Procedure} string->utf32 str
+@deffnx {C Function} scm_string_to_utf8 (str)
+@deffnx {C Function} scm_string_to_utf16 (str)
+@deffnx {C Function} scm_string_to_utf32 (str)
+Return a newly allocated bytevector that contains the UTF-8, UTF-16, or
+UTF-32 (aka. UCS-4) encoding of @var{str}.
+@end deffn
+
+@deffn {Scheme Procedure} utf8->string utf
+@deffnx {Scheme Procedure} utf16->string utf
+@deffnx {Scheme Procedure} utf32->string utf
+@deffnx {C Function} scm_utf8_to_string (utf)
+@deffnx {C Function} scm_utf16_to_string (utf)
+@deffnx {C Function} scm_utf32_to_string (utf)
+Return a newly allocated string that contains from the UTF-8-, UTF-16-,
+or UTF-32-decoded contents of bytevector @var{utf}.
+@end deffn
+
+@node Bytevectors as Generalized Vectors
+@subsubsection Accessing Bytevectors with the Generalized Vector API
+
+As an extension to the R6RS, Guile allows bytevectors to be manipulated
+with the @dfn{generalized vector} procedures (@pxref{Generalized
+Vectors}).  This also allows bytevectors to be accessed using the
+generic @dfn{array} procedures (@pxref{Array Procedures}).  When using
+these APIs, bytes are accessed one at a time as 8-bit unsigned integers:
+
+@example
+(define bv #vu8(0 1 2 3))
+
+(generalized-vector? bv)
+@result{} #t
+
+(generalized-vector-ref bv 2)
+@result{} 2
+
+(generalized-vector-set! bv 2 77)
+(array-ref bv 2)
+@result{} 77
+
+(array-type bv)
+@result{} vu8
+@end example
+
+
 @node Regular Expressions
 @subsection Regular Expressions
 @tpindex Regular expressions
@@ -4007,7 +4448,8 @@ Or matching a @sc{yyyymmdd} format date such as @samp{20020828} and
 re-ordering and hyphenating the fields.
 
 @lisp
-(define date-regex "([0-9][0-9][0-9][0-9])([0-9][0-9])([0-9][0-9])")
+(define date-regex
+   "([0-9][0-9][0-9][0-9])([0-9][0-9])([0-9][0-9])")
 (define s "Date 20020429 12am.")
 (regexp-substitute #f (string-match date-regex s)
                    'pre 2 "-" 3 "-" 1 'post " (" 0 ")")
@@ -4067,7 +4509,8 @@ example the following is the date example from
 @code{string-match} call.
 
 @lisp
-(define date-regex "([0-9][0-9][0-9][0-9])([0-9][0-9])([0-9][0-9])")
+(define date-regex 
+   "([0-9][0-9][0-9][0-9])([0-9][0-9])([0-9][0-9])")
 (define s "Date 20020429 12am.")
 (regexp-substitute/global #f date-regex s
                           'pre 2 "-" 3 "-" 1 'post " (" 0 ")")
@@ -5062,7 +5505,7 @@ the @code{read-set!} procedure documented in @ref{User level options
 interfaces} and @ref{Reader options}.  Note that the @code{prefix} and
 @code{postfix} syntax are mutually exclusive.
 
-@smalllisp
+@lisp
 (read-set! keywords 'prefix)
 
 #:type
@@ -5094,7 +5537,7 @@ type:
 ERROR: In expression :type:
 ERROR: Unbound variable: :type
 ABORT: (unbound-variable)
-@end smalllisp
+@end lisp
 
 @node Keyword Procedures
 @subsubsection Keyword Procedures
diff --git a/doc/ref/api-debug.texi b/doc/ref/api-debug.texi
index 0d4398015..c29bfdf12 100644
--- a/doc/ref/api-debug.texi
+++ b/doc/ref/api-debug.texi
@@ -283,9 +283,9 @@ runs a script non-interactively.
 The following procedures can be used to access and set the source
 properties of read expressions.
 
-@deffn {Scheme Procedure} set-source-properties! obj plist
-@deffnx {C Function} scm_set_source_properties_x (obj, plist)
-Install the association list @var{plist} as the source property
+@deffn {Scheme Procedure} set-source-properties! obj alist
+@deffnx {C Function} scm_set_source_properties_x (obj, alist)
+Install the association list @var{alist} as the source property
 list for @var{obj}.
 @end deffn
 
@@ -302,12 +302,12 @@ Return the source property association list of @var{obj}.
 
 @deffn {Scheme Procedure} source-property obj key
 @deffnx {C Function} scm_source_property (obj, key)
-Return the source property specified by @var{key} from
-@var{obj}'s source property list.
+Return the property specified by @var{key} from @var{obj}'s source
+properties.
 @end deffn
 
 In practice there are only two ways that you should use the ability to
-set an expression's source breakpoints.
+set an expression's source properties.
 
 @itemize
 @item
@@ -330,9 +330,9 @@ involved in a backtrace or error report.
 
 If you are looking for a way to attach arbitrary information to an
 expression other than these properties, you should use
-@code{make-object-property} instead (@pxref{Object Properties}), because
-that will avoid bloating the source property hash table, which is really
-only intended for the specific purposes described in this section.
+@code{make-object-property} instead (@pxref{Object Properties}).  That
+will avoid bloating the source property hash table, which is really
+only intended for the debugging purposes just described.
 
 
 @node Decoding Memoized Source Expressions
@@ -1708,7 +1708,7 @@ facilities just described.
 A good way to explore in detail what a Scheme procedure does is to set
 a trap on it and then single step through what it does.  To do this,
 make and install a @code{<procedure-trap>} with the @code{debug-trap}
-behaviour from @code{(ice-9 debugging ice-9-debugger-extensions)}.
+behaviour from @code{(ice-9 debugger)}.
 
 The following sample session illustrates this.  It assumes that the
 file @file{matrix.scm} defines a procedure @code{mkmatrix}, which is
@@ -1718,7 +1718,6 @@ calls @code{mkmatrix}.
 @lisp
 $ /usr/bin/guile -q
 guile> (use-modules (ice-9 debugger)
-                    (ice-9 debugging ice-9-debugger-extensions)
                     (ice-9 debugging traps))
 guile> (load "matrix.scm")
 guile> (install-trap (make <procedure-trap>
@@ -1732,16 +1731,16 @@ Frame 2 at matrix.scm:8:3
         [mkmatrix]
 debug> next
 Frame 3 at matrix.scm:4:3
-        (let ((x 1)) (quote this-is-a-matric))
+        (let ((x 1)) (quote hi!))
 debug> info frame
 Stack frame: 3
 This frame is an evaluation.
 The expression being evaluated is:
 matrix.scm:4:3:
-  (let ((x 1)) (quote this-is-a-matric))
+  (let ((x 1)) (quote hi!))
 debug> next
 Frame 3 at matrix.scm:5:21
-        (quote this-is-a-matric)
+        (quote hi!)
 debug> bt
 In unknown file:
    ?: 0* [primitive-eval (do-main 4)]
@@ -1750,18 +1749,17 @@ In standard input:
 In matrix.scm:
    8: 2  [mkmatrix]
    ...
-   5: 3  (quote this-is-a-matric)
+   5: 3  (quote hi!)
 debug> quit
-this-is-a-matric
+hi!
 guile> 
 @end lisp
 
 Or you can use Guile's Emacs interface (GDS), by using the module
 @code{(ice-9 gds-client)} instead of @code{(ice-9 debugger)} and
-@code{(ice-9 debugging ice-9-debugger-extensions)}, and changing
-@code{debug-trap} to @code{gds-debug-trap}.  Then the stack and
-corresponding source locations are displayed in Emacs instead of on
-the Guile command line.
+changing @code{debug-trap} to @code{gds-debug-trap}.  Then the stack and
+corresponding source locations are displayed in Emacs instead of on the
+Guile command line.
 
 
 @node Profiling or Tracing a Procedure's Code
@@ -1813,7 +1811,7 @@ guile> (do-main 4)
 |  5: (memq sym bindings)
 |  5: [memq let (debug)]
 |  5: =>#f
-|  2: (letrec ((yy 23)) (let ((x 1)) (quote this-is-a-matric)))
+|  2: (letrec ((yy 23)) (let ((x 1)) (quote hi!)))
 |  3: [#<procedure #f (a sym definep)> #<autoload # b7c93870> let #f]
 |  3: [#<procedure #f (a sym definep)> #<autoload # b7c93870> let #f]
 |  4: (and (memq sym bindings) (let ...))
@@ -1832,7 +1830,7 @@ guile> (do-main 4)
 |  5: (memq sym bindings)
 |  5: [memq let (debug)]
 |  5: =>#f
-|  2: (let ((x 1)) (quote this-is-a-matric))
+|  2: (let ((x 1)) (quote hi!))
 |  3: [#<procedure #f (a sym definep)> #<autoload # b7c93870> let #f]
 |  3: [#<procedure #f (a sym definep)> #<autoload # b7c93870> let #f]
 |  4: (and (memq sym bindings) (let ...))
@@ -1841,15 +1839,15 @@ guile> (do-main 4)
 |  5: =>#f
 |  2: [let (let # #) (# # #)]
 |  2: [let (let # #) (# # #)]
-|  2: =>(#@@let* (x 1) #@@let (quote this-is-a-matric))
-this-is-a-matric
+|  2: =>(#@@let* (x 1) #@@let (quote hi!))
+hi!
 guile> (do-main 4)
 |  2: [mkmatrix]
-|  2: (letrec ((yy 23)) (let* ((x 1)) (quote this-is-a-matric)))
-|  2: (let* ((x 1)) (quote this-is-a-matric))
-|  2: (quote this-is-a-matric)
-|  2: =>this-is-a-matric
-this-is-a-matric
+|  2: (letrec ((yy 23)) (let* ((x 1)) (quote hi!)))
+|  2: (let* ((x 1)) (quote hi!))
+|  2: (quote hi!)
+|  2: =>hi!
+hi!
 guile> 
 @end lisp
 
@@ -1881,14 +1879,16 @@ each trace line instead of the stack depth.
 guile> (set-trace-layout "|~16@@a: ~a\n" trace/source trace/info)
 guile> (do-main 4)
 |  matrix.scm:7:2: [mkmatrix]
-|                : (letrec ((yy 23)) (let* ((x 1)) (quote this-is-a-matric)))
-|  matrix.scm:3:2: (let* ((x 1)) (quote this-is-a-matric))
-|  matrix.scm:4:4: (quote this-is-a-matric)
-|  matrix.scm:4:4: =>this-is-a-matric
-this-is-a-matric
+|                : (letrec ((yy 23)) (let* ((x 1)) (quote hi!)))
+|  matrix.scm:3:2: (let* ((x 1)) (quote hi!))
+|  matrix.scm:4:4: (quote hi!)
+|  matrix.scm:4:4: =>hi!
+hi!
 guile> 
 @end lisp
 
+@anchor{Memoization}
+@cindex Memoization
 (For anyone wondering why the first @code{(do-main 4)} call above
 generates lots more trace lines than the subsequent calls: these
 examples also demonstrate how the Guile evaluator ``memoizes'' code.
diff --git a/doc/ref/api-evaluation.texi b/doc/ref/api-evaluation.texi
index 6fd363df2..d8412154c 100644
--- a/doc/ref/api-evaluation.texi
+++ b/doc/ref/api-evaluation.texi
@@ -5,20 +5,22 @@
 @c See the file guile.texi for copying conditions.
 
 @page
-@node Read/Load/Eval
+@node Read/Load/Eval/Compile
 @section Reading and Evaluating Scheme Code
 
 This chapter describes Guile functions that are concerned with reading,
-loading and evaluating Scheme code at run time.
+loading, evaluating, and compiling Scheme code at run time.
 
 @menu
 * Scheme Syntax::               Standard and extended Scheme syntax.
 * Scheme Read::                 Reading Scheme code.
 * Fly Evaluation::              Procedures for on the fly evaluation.
+* Compilation::                 How to compile Scheme files and procedures.
 * Loading::                     Loading Scheme code from file.
 * Delayed Evaluation::          Postponing evaluation until it is needed.
 * Local Evaluation::            Evaluation in a local environment.
 * Evaluator Behaviour::         Modifying Guile's evaluator.
+* VM Behaviour::                Modifying Guile's virtual machine.
 @end menu
 
 
@@ -411,6 +413,69 @@ the current module.
 @end deffn
 
 
+@node Compilation
+@subsection Compiling Scheme Code
+
+The @code{eval} procedure directly interprets the S-expression
+representation of Scheme. An alternate strategy for evaluation is to
+determine ahead of time what computations will be necessary to
+evaluate the expression, and then use that recipe to produce the
+desired results. This is known as @dfn{compilation}.
+
+While it is possible to compile simple Scheme expressions such as
+@code{(+ 2 2)} or even @code{"Hello world!"}, compilation is most
+interesting in the context of procedures. Compiling a lambda expression
+produces a compiled procedure, which is just like a normal procedure
+except typically much faster, because it can bypass the generic
+interpreter.
+
+Functions from system modules in a Guile installation are normally
+compiled already, so they load and run quickly.
+
+Note that well-written Scheme programs will not typically call the
+procedures in this section, for the same reason that it is often bad
+taste to use @code{eval}. The normal interface to the compiler is the
+command-line file compiler, which can be invoked from the shell as
+@code{guile-tools compile @var{foo.scm}}. This interface needs more
+documentation.
+
+(Why are calls to @code{eval} and @code{compile} usually in bad taste?
+Because they are limited, in that they can only really make sense for
+top-level expressions. Also, most needs for ``compile-time''
+computation are fulfilled by macros and closures. Of course one good
+counterexample is the REPL itself, or any code that reads expressions
+from a port.)
+
+For more information on the compiler itself, see @ref{Compiling to the
+Virtual Machine}. For information on the virtual machine, see @ref{A
+Virtual Machine for Guile}.
+
+@deffn {Scheme Procedure} compile exp [env=#f] [from=(current-language)] [to=value] [opts=()]
+Compile the expression @var{exp} in the environment @var{env}. If
+@var{exp} is a procedure, the result will be a compiled procedure;
+otherwise @code{compile} is mostly equivalent to @code{eval}.
+
+For a discussion of languages and compiler options, @xref{Compiling to
+the Virtual Machine}.
+@end deffn
+
+@deffn {Scheme Procedure} compile-file file [to=objcode] [opts='()]
+Compile the file named @var{file}.
+
+Output will be written to a file in the current directory whose name
+is computed as @code{(compiled-file-name @var{file})}.
+@end deffn
+
+@deffn {Scheme Procedure} compiled-file-name file
+Compute an appropriate name for a compiled version of a Scheme file
+named @var{file}.
+
+Usually, the result will be the original file name with the
+@code{.scm} suffix replaced with @code{.go}, but the exact behavior
+depends on the contents of the @code{%load-extensions} and
+@code{%load-compiled-extensions} lists.
+@end deffn
+
 @node Loading
 @subsection Loading Scheme Code from File
 
@@ -435,9 +500,19 @@ procedure that will be called before any code is loaded.  See
 documentation for @code{%load-hook} later in this section.
 @end deffn
 
+@deffn {Scheme Procedure} load-compiled filename
+Load the compiled file named @var{filename}. The load paths are not
+searched.
+
+Compiling a source file (@pxref{Read/Load/Eval/Compile}) and then
+calling @code{load-compiled} on the resulting file is equivalent to
+calling @code{load} on the source file.
+@end deffn
+
 @deffn {Scheme Procedure} load-from-path filename
 Similar to @code{load}, but searches for @var{filename} in the load
-paths.
+paths. Preferentially loads a compiled version of the file, if it is
+available and up-to-date.
 @end deffn
 
 @deffn {Scheme Procedure} primitive-load filename
@@ -461,7 +536,8 @@ documentation for @code{%load-hook} later in this section.
 Search @code{%load-path} for the file named @var{filename} and
 load it into the top-level environment.  If @var{filename} is a
 relative pathname and is not found in the list of search paths,
-an error is signalled.
+an error is signalled. Preferentially loads a compiled version of the
+file, if it is available and up-to-date.
 @end deffn
 
 @deffn {Scheme Procedure} %search-load-path filename
@@ -639,6 +715,30 @@ trap handlers.
 Option interface for the evaluator trap options.
 @end deffn
 
+@node VM Behaviour
+@subsection VM Behaviour
+
+Like the procedures from the previous section that operate on the
+evaluator, there are also procedures to modify the behavior of a
+virtual machine.
+
+The most useful thing that a user can do is to add to one of the
+virtual machine's predefined hooks:
+
+@deffn {Scheme Procedure} vm-next-hook vm
+@deffnx {Scheme Procedure} vm-apply-hook vm
+@deffnx {Scheme Procedure} vm-boot-hook vm
+@deffnx {Scheme Procedure} vm-return-hook vm
+@deffnx {Scheme Procedure} vm-break-hook vm
+@deffnx {Scheme Procedure} vm-exit-hook vm
+@deffnx {Scheme Procedure} vm-halt-hook vm
+@deffnx {Scheme Procedure} vm-enter-hook vm
+Accessors to a virtual machine's hooks. Usually you pass
+@code{(the-vm)} as the @var{vm}.
+@end deffn
+
+@xref{A Virtual Machine for Guile}, for more information on Guile's
+virtual machine.
 
 @c Local Variables:
 @c TeX-master: "guile.texi"
diff --git a/doc/ref/api-init.texi b/doc/ref/api-init.texi
index 0e4e8b8b7..f9714c3b6 100644
--- a/doc/ref/api-init.texi
+++ b/doc/ref/api-init.texi
@@ -61,7 +61,7 @@ Arrange things so that all of the code in the current thread executes as
 if from within a call to @code{scm_with_guile}.  That is, all functions
 called by the current thread can assume that @code{SCM} values on their
 stack frames are protected from the garbage collector (except when the
-thread has explicitely left guile mode, of course).
+thread has explicitly left guile mode, of course).
 
 When @code{scm_init_guile} is called from a thread that already has been
 in guile mode once, nothing happens.  This behavior matters when you
diff --git a/doc/ref/api-io.texi b/doc/ref/api-io.texi
index f69d07ede..96cd147f3 100644
--- a/doc/ref/api-io.texi
+++ b/doc/ref/api-io.texi
@@ -1,6 +1,6 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
-@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007
+@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007, 2009
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
@@ -18,6 +18,7 @@
 * Block Reading and Writing::   Reading and writing blocks of text.
 * Default Ports::               Defaults for input, output and errors.
 * Port Types::                  Types of port and how to make them.
+* R6RS I/O Ports::              The R6RS port API.
 * I/O Extensions::              Using and extending ports in C.
 @end menu
 
@@ -423,9 +424,9 @@ the current size, but this is not mandatory in the POSIX standard.
 
 The delimited-I/O module can be accessed with:
 
-@smalllisp
+@lisp
 (use-modules (ice-9 rdelim))
-@end smalllisp
+@end lisp
 
 It can be used to read or write lines of text, or read text delimited by
 a specified set of characters.  It's similar to the @code{(scsh rdelim)}
@@ -535,9 +536,9 @@ delimiter may be either a newline or the @var{eof-object}; if
 
 The Block-string-I/O module can be accessed with:
 
-@smalllisp
+@lisp
 (use-modules (ice-9 rw))
-@end smalllisp
+@end lisp
 
 It currently contains procedures that help to implement the
 @code{(scsh rw)} module in guile-scsh.
@@ -794,17 +795,17 @@ current interfaces.
 @rnindex open-input-file
 @deffn {Scheme Procedure} open-input-file filename
 Open @var{filename} for input.  Equivalent to
-@smalllisp
+@lisp
 (open-file @var{filename} "r")
-@end smalllisp
+@end lisp
 @end deffn
 
 @rnindex open-output-file
 @deffn {Scheme Procedure} open-output-file filename
 Open @var{filename} for output.  Equivalent to
-@smalllisp
+@lisp
 (open-file @var{filename} "w")
-@end smalllisp
+@end lisp
 @end deffn
 
 @deffn {Scheme Procedure} call-with-input-file filename proc
@@ -1023,6 +1024,269 @@ documentation for @code{open-file} in @ref{File Ports}.
 @end deffn
 
 
+@node R6RS I/O Ports
+@subsection R6RS I/O Ports
+
+@cindex R6RS
+@cindex R6RS ports
+
+The I/O port API of the @uref{http://www.r6rs.org/, Revised Report^6 on
+the Algorithmic Language Scheme (R6RS)} is provided by the @code{(rnrs
+io ports)} module.  It provides features, such as binary I/O and Unicode
+string I/O, that complement or refine Guile's historical port API
+presented above (@pxref{Input and Output}).
+
+@c FIXME: Update description when implemented.
+@emph{Note}: The implementation of this R6RS API is currently far from
+complete, notably due to the lack of support for Unicode I/O and strings.
+
+@menu
+* R6RS End-of-File::            The end-of-file object.
+* R6RS Port Manipulation::      Manipulating R6RS ports.
+* R6RS Binary Input::           Binary input.
+* R6RS Binary Output::          Binary output.
+@end menu
+
+@node R6RS End-of-File
+@subsubsection The End-of-File Object
+
+@cindex EOF
+@cindex end-of-file
+
+R5RS' @code{eof-object?} procedure is provided by the @code{(rnrs io
+ports)} module:
+
+@deffn {Scheme Procedure} eof-object? obj
+@deffnx {C Function} scm_eof_object_p (obj)
+Return true if @var{obj} is the end-of-file (EOF) object.
+@end deffn
+
+In addition, the following procedure is provided:
+
+@deffn {Scheme Procedure} eof-object
+@deffnx {C Function} scm_eof_object ()
+Return the end-of-file (EOF) object.
+
+@lisp
+(eof-object? (eof-object))
+@result{} #t
+@end lisp
+@end deffn
+
+
+@node R6RS Port Manipulation
+@subsubsection Port Manipulation
+
+The procedures listed below operate on any kind of R6RS I/O port.
+
+@deffn {Scheme Procedure} port-position port
+If @var{port} supports it (see below), return the offset (an integer)
+indicating where the next octet will be read from/written to in
+@var{port}.  If @var{port} does not support this operation, an error
+condition is raised.
+
+This is similar to Guile's @code{seek} procedure with the
+@code{SEEK_CUR} argument (@pxref{Random Access}).
+@end deffn
+
+@deffn {Scheme Procedure} port-has-port-position? port
+Return @code{#t} is @var{port} supports @code{port-position}.
+@end deffn
+
+@deffn {Scheme Procedure} set-port-position! port offset
+If @var{port} supports it (see below), set the position where the next
+octet will be read from/written to @var{port} to @var{offset} (an
+integer).  If @var{port} does not support this operation, an error
+condition is raised.
+
+This is similar to Guile's @code{seek} procedure with the
+@code{SEEK_SET} argument (@pxref{Random Access}).
+@end deffn
+
+@deffn {Scheme Procedure} port-has-set-port-position!? port
+Return @code{#t} is @var{port} supports @code{set-port-position!}.
+@end deffn
+
+@deffn {Scheme Procedure} call-with-port port proc
+Call @var{proc}, passing it @var{port} and closing @var{port} upon exit
+of @var{proc}.  Return the return values of @var{proc}.
+@end deffn
+
+
+@node R6RS Binary Input
+@subsubsection Binary Input
+
+@cindex binary input
+
+R6RS binary input ports can be created with the procedures described
+below.
+
+@deffn {Scheme Procedure} open-bytevector-input-port bv [transcoder]
+@deffnx {C Function} scm_open_bytevector_input_port (bv, transcoder)
+Return an input port whose contents are drawn from bytevector @var{bv}
+(@pxref{Bytevectors}).
+
+@c FIXME: Update description when implemented.
+The @var{transcoder} argument is currently not supported.
+@end deffn
+
+@cindex custom binary input ports
+
+@deffn {Scheme Procedure} make-custom-binary-input-port id read! get-position set-position! close
+@deffnx {C Function} scm_make_custom_binary_input_port (id, read!, get-position, set-position!, close)
+Return a new custom binary input port@footnote{This is similar in spirit
+to Guile's @dfn{soft ports} (@pxref{Soft Ports}).} named @var{id} (a
+string) whose input is drained by invoking @var{read!} and passing it a
+bytevector, an index where bytes should be written, and the number of
+bytes to read.  The @code{read!}  procedure must return an integer
+indicating the number of bytes read, or @code{0} to indicate the
+end-of-file.
+
+Optionally, if @var{get-position} is not @code{#f}, it must be a thunk
+that will be called when @var{port-position} is invoked on the custom
+binary port and should return an integer indicating the position within
+the underlying data stream; if @var{get-position} was not supplied, the
+returned port does not support @var{port-position}.
+
+Likewise, if @var{set-position!} is not @code{#f}, it should be a
+one-argument procedure.  When @var{set-port-position!} is invoked on the
+custom binary input port, @var{set-position!} is passed an integer
+indicating the position of the next byte is to read.
+
+Finally, if @var{close} is not @code{#f}, it must be a thunk.  It is
+invoked when the custom binary input port is closed.
+
+Using a custom binary input port, the @code{open-bytevector-input-port}
+procedure could be implemented as follows:
+
+@lisp
+(define (open-bytevector-input-port source)
+  (define position 0)
+  (define length (bytevector-length source))
+
+  (define (read! bv start count)
+    (let ((count (min count (- length position))))
+      (bytevector-copy! source position
+                        bv start count)
+      (set! position (+ position count))
+      count))
+
+  (define (get-position) position)
+
+  (define (set-position! new-position)
+    (set! position new-position))
+
+  (make-custom-binary-input-port "the port" read!
+                                  get-position
+                                  set-position!))
+
+(read (open-bytevector-input-port (string->utf8 "hello")))
+@result{} hello
+@end lisp
+@end deffn
+
+@cindex binary input
+Binary input is achieved using the procedures below:
+
+@deffn {Scheme Procedure} get-u8 port
+@deffnx {C Function} scm_get_u8 (port)
+Return an octet read from @var{port}, a binary input port, blocking as
+necessary, or the end-of-file object.
+@end deffn
+
+@deffn {Scheme Procedure} lookahead-u8 port
+@deffnx {C Function} scm_lookahead_u8 (port)
+Like @code{get-u8} but does not update @var{port}'s position to point
+past the octet.
+@end deffn
+
+@deffn {Scheme Procedure} get-bytevector-n port count
+@deffnx {C Function} scm_get_bytevector_n (port, count)
+Read @var{count} octets from @var{port}, blocking as necessary and
+return a bytevector containing the octets read.  If fewer bytes are
+available, a bytevector smaller than @var{count} is returned.
+@end deffn
+
+@deffn {Scheme Procedure} get-bytevector-n! port bv start count
+@deffnx {C Function} scm_get_bytevector_n_x (port, bv, start, count)
+Read @var{count} bytes from @var{port} and store them in @var{bv}
+starting at index @var{start}.  Return either the number of bytes
+actually read or the end-of-file object.
+@end deffn
+
+@deffn {Scheme Procedure} get-bytevector-some port
+@deffnx {C Function} scm_get_bytevector_some (port)
+Read from @var{port}, blocking as necessary, until data are available or
+and end-of-file is reached.  Return either a new bytevector containing
+the data read or the end-of-file object.
+@end deffn
+
+@deffn {Scheme Procedure} get-bytevector-all port
+@deffnx {C Function} scm_get_bytevector_all (port)
+Read from @var{port}, blocking as necessary, until the end-of-file is
+reached.  Return either a new bytevector containing the data read or the
+end-of-file object (if no data were available).
+@end deffn
+
+@node R6RS Binary Output
+@subsubsection Binary Output
+
+Binary output ports can be created with the procedures below.
+
+@deffn {Scheme Procedure} open-bytevector-output-port [transcoder]
+@deffnx {C Function} scm_open_bytevector_output_port (transcoder)
+Return two values: a binary output port and a procedure.  The latter
+should be called with zero arguments to obtain a bytevector containing
+the data accumulated by the port, as illustrated below.
+
+@lisp
+(call-with-values
+  (lambda ()
+    (open-bytevector-output-port))
+  (lambda (port get-bytevector)
+    (display "hello" port)
+    (get-bytevector)))
+
+@result{} #vu8(104 101 108 108 111)
+@end lisp
+
+@c FIXME: Update description when implemented.
+The @var{transcoder} argument is currently not supported.
+@end deffn
+
+@cindex custom binary output ports
+
+@deffn {Scheme Procedure} make-custom-binary-output-port id write! get-position set-position! close
+@deffnx {C Function} scm_make_custom_binary_output_port (id, write!, get-position, set-position!, close)
+Return a new custom binary output port named @var{id} (a string) whose
+output is sunk by invoking @var{write!} and passing it a bytevector, an
+index where bytes should be read from this bytevector, and the number of
+bytes to be ``written''.  The @code{write!}  procedure must return an
+integer indicating the number of bytes actually written; when it is
+passed @code{0} as the number of bytes to write, it should behave as
+though an end-of-file was sent to the byte sink.
+
+The other arguments are as for @code{make-custom-binary-input-port}
+(@pxref{R6RS Binary Input, @code{make-custom-binary-input-port}}).
+@end deffn
+
+@cindex binary output
+Writing to a binary output port can be done using the following
+procedures:
+
+@deffn {Scheme Procedure} put-u8 port octet
+@deffnx {C Function} scm_put_u8 (port, octet)
+Write @var{octet}, an integer in the 0--255 range, to @var{port}, a
+binary output port.
+@end deffn
+
+@deffn {Scheme Procedure} put-bytevector port bv [start [count]]
+@deffnx {C Function} scm_put_bytevector (port, bv, start, count)
+Write the contents of @var{bv} to @var{port}, optionally starting at
+index @var{start} and limiting to @var{count} octets.
+@end deffn
+
+
 @node I/O Extensions
 @subsection Using and Extending Ports in C
 
@@ -1267,7 +1531,7 @@ implementations take care to avoid this problem.
 
 The procedure is set using
 
-@deftypefun void scm_set_port_seek (scm_t_bits tc, off_t (*seek) (SCM port, off_t offset, int whence))
+@deftypefun void scm_set_port_seek (scm_t_bits tc, scm_t_off (*seek) (SCM port, scm_t_off offset, int whence))
 @end deftypefun
 
 @item truncate
@@ -1275,7 +1539,7 @@ Truncate the port data to be specified length.  It can be assumed that the
 current state of @code{rw_active} is @code{SCM_PORT_NEITHER}.
 Set using
 
-@deftypefun void scm_set_port_truncate (scm_t_bits tc, void (*truncate) (SCM port, off_t length))
+@deftypefun void scm_set_port_truncate (scm_t_bits tc, void (*truncate) (SCM port, scm_t_off length))
 @end deftypefun
 
 @end table
diff --git a/doc/ref/api-memory.texi b/doc/ref/api-memory.texi
index 32d39982c..f492203f7 100644
--- a/doc/ref/api-memory.texi
+++ b/doc/ref/api-memory.texi
@@ -10,7 +10,7 @@
 
 Guile uses a @emph{garbage collector} to manage most of its objects.
 While the garbage collector is designed to be mostly invisible, you 
-sometimes need to interact with it explicitely.
+sometimes need to interact with it explicitly.
 
 See @ref{Garbage Collection} for a general discussion of how garbage
 collection relates to using Guile from C.
@@ -201,7 +201,7 @@ below for a motivation.
 @deftypefn {C Function} void scm_gc_free (void *@var{mem}, size_t @var{size}, const char *@var{what})
 Like @code{free}, but also call @code{scm_gc_unregister_collectable_memory}.
 
-Note that you need to explicitely pass the @var{size} parameter.  This
+Note that you need to explicitly pass the @var{size} parameter.  This
 is done since it should normally be easy to provide this parameter
 (for memory that is associated with GC controlled objects) and this
 frees us from tracking this value in the GC itself, which will keep
diff --git a/doc/ref/api-modules.texi b/doc/ref/api-modules.texi
index 9aeb08a44..1c9ab23ab 100644
--- a/doc/ref/api-modules.texi
+++ b/doc/ref/api-modules.texi
@@ -60,15 +60,15 @@ Library files in SLIB @emph{provide} a feature, and when user programs
 For example, the file @file{random.scm} in the SLIB package contains the
 line
 
-@smalllisp
+@lisp
 (provide 'random)
-@end smalllisp
+@end lisp
 
 so to use its procedures, a user would type
 
-@smalllisp
+@lisp
 (require 'random)
-@end smalllisp
+@end lisp
 
 and they would magically become available, @emph{but still have the same
 names!}  So this method is nice, but not as good as a full-featured
@@ -99,9 +99,9 @@ i.e., passed as the second argument to @code{eval}.
 Note: the following two procedures are available only when the 
 @code{(ice-9 r5rs)} module is loaded:
 
-@smalllisp
+@lisp
 (use-modules (ice-9 r5rs))
-@end smalllisp
+@end lisp
 
 @deffn {Scheme Procedure} scheme-report-environment version
 @deffnx {Scheme Procedure} null-environment version
@@ -224,9 +224,9 @@ An @dfn{interface specification} has one of two forms.  The first
 variation is simply to name the module, in which case its public
 interface is the one accessed.  For example:
 
-@smalllisp
+@lisp
 (use-modules (ice-9 popen))
-@end smalllisp
+@end lisp
 
 Here, the interface specification is @code{(ice-9 popen)}, and the
 result is that the current module now has access to @code{open-pipe},
@@ -241,11 +241,11 @@ module to be accessed, but also selects bindings from it and renames
 them to suit the current module's needs.  For example:
 
 @cindex binding renamer
-@smalllisp
+@lisp
 (use-modules ((ice-9 popen)
-              :select ((open-pipe . pipe-open) close-pipe)
-              :renamer (symbol-prefix-proc 'unixy:)))
-@end smalllisp
+              #:select ((open-pipe . pipe-open) close-pipe)
+              #:renamer (symbol-prefix-proc 'unixy:)))
+@end lisp
 
 Here, the interface specification is more complex than before, and the
 result is that a custom interface with only two bindings is created and
@@ -270,10 +270,10 @@ You can also directly refer to bindings in a module by using the
 open-pipe)}.  Thus an alternative to the complete @code{use-modules}
 statement would be
 
-@smalllisp
+@lisp
 (define unixy:pipe-open (@@ (ice-9 popen) open-pipe))
 (define unixy:close-pipe (@@ (ice-9 popen) close-pipe))
-@end smalllisp
+@end lisp
 
 There is also @code{@@@@}, which can be used like @code{@@}, but does
 not check whether the variable that is being accessed is actually
@@ -307,9 +307,9 @@ whose public interface is found and used.
 @var{spec} can also be of the form:
 
 @cindex binding renamer
-@smalllisp
+@lisp
  (MODULE-NAME [:select SELECTION] [:renamer RENAMER])
-@end smalllisp
+@end lisp
 
 in which case a custom interface is newly created and used.
 @var{module-name} is a list of symbols, as above; @var{selection} is a
@@ -373,9 +373,9 @@ by using @code{define-public} or @code{export} (both documented below).
 @var{module-name} is of the form @code{(hierarchy file)}.  One
 example of this is
 
-@smalllisp
+@lisp
 (define-module (ice-9 popen))
-@end smalllisp
+@end lisp
 
 @code{define-module} makes this module available to Guile programs under
 the given @var{module-name}.
@@ -541,9 +541,9 @@ duplication to the next handler in @var{list}.
 The default duplicate binding resolution policy is given by the
 @code{default-duplicate-binding-handler} procedure, and is
 
-@smalllisp
+@lisp
 (replace warn-override-core warn last)
-@end smalllisp
+@end lisp
 
 @item #:no-backtrace
 @cindex no backtrace
@@ -758,7 +758,7 @@ Record definition with @code{define-record-type} (@pxref{SRFI-9}).
 Read hash extension @code{#,()} (@pxref{SRFI-10}).
 
 @item (srfi srfi-11)
-Multiple-value handling with @code{let-values} and @code{let-values*}
+Multiple-value handling with @code{let-values} and @code{let*-values}
 (@pxref{SRFI-11}).
 
 @item (srfi srfi-13)
@@ -1138,12 +1138,12 @@ gcc -shared -o libbessel.so -fPIC bessel.c
 
 Now fire up Guile:
 
-@smalllisp
+@lisp
 (define bessel-lib (dynamic-link "./libbessel.so"))
 (dynamic-call "init_math_bessel" bessel-lib)
 (j0 2)
 @result{} 0.223890779141236
-@end smalllisp
+@end lisp
 
 The filename @file{./libbessel.so} should be pointing to the shared
 library produced with the @code{gcc} command above, of course.  The
diff --git a/doc/ref/api-options.texi b/doc/ref/api-options.texi
index 20e32c51c..f7d0962df 100644
--- a/doc/ref/api-options.texi
+++ b/doc/ref/api-options.texi
@@ -82,10 +82,11 @@ general are stored.  On Unix-like systems, this is usually
 @deffnx {C Function} scm_sys_library_dir ()
 Return the name of the directory where the Guile Scheme files that
 belong to the core Guile installation (as opposed to files from a 3rd
-party package) are installed.  On Unix-like systems, this is usually
+party package) are installed.  On Unix-like systems this is usually
 @file{/usr/local/share/guile/<GUILE_EFFECTIVE_VERSION>} or
-@file{/usr/share/guile/<GUILE_EFFECTIVE_VERSION>}, for example:
-@file{/usr/local/share/guile/1.6}.
+@file{/usr/share/guile/<GUILE_EFFECTIVE_VERSION>};
+
+@noindent for example @file{/usr/local/share/guile/1.6}.
 @end deffn
 
 @deffn {Scheme Procedure} %site-dir
@@ -503,9 +504,9 @@ Guile is case-sensitive by default.
 
 To make Guile case insensitive, you can type
 
-@smalllisp
+@lisp
 (read-enable 'case-insensitive)
-@end smalllisp
+@end lisp
 
 @node Printing options
 @subsubsection Printing options
@@ -680,7 +681,8 @@ the maximum stack size, use @code{debug-set!}, for example:
 @lisp
 (debug-set! stack 200000)
 @result{}
-(show-file-name #t stack 200000 debug backtrace depth 20 maxdepth 1000 frames 3 indent 10 width 79 procnames cheap)
+(show-file-name #t stack 200000 debug backtrace depth 20
+   maxdepth 1000 frames 3 indent 10 width 79 procnames cheap)
 
 (non-tail-recursive-factorial 500)
 @result{}
@@ -717,7 +719,6 @@ backtrace.  Need to give a better example, possibly putting debugging
 option examples in a separate session.]
 @end enumerate
 
-
 @smalllisp
 guile> (define abc "hello")
 guile> abc
diff --git a/doc/ref/api-procedures.texi b/doc/ref/api-procedures.texi
index 7fd0f4fa4..8098b4ffb 100644
--- a/doc/ref/api-procedures.texi
+++ b/doc/ref/api-procedures.texi
@@ -11,6 +11,7 @@
 @menu
 * Lambda::                      Basic procedure creation using lambda.
 * Primitive Procedures::        Procedures defined in C.
+* Compiled Procedures::         Scheme procedures can be compiled.
 * Optional Arguments::          Handling keyword, optional and rest arguments.
 * Procedure Properties::        Procedure properties and meta-information.
 * Procedures with Setters::     Procedures with setters.
@@ -131,6 +132,156 @@ use @code{scm_c_make_subr} and also @code{scm_makcclo} if necessary.
 It is advisable to use the gsubr variants since they provide a
 slightly higher-level abstraction of the Guile implementation.
 
+@node Compiled Procedures
+@subsection Compiled Procedures
+
+Procedures that were created when loading a compiled file are
+themselves compiled. (In contrast, procedures that are defined by
+loading a Scheme source file are interpreted, and often not as fast as
+compiled procedures.)
+
+Loading compiled files is the normal way that compiled procedures come
+to being, though procedures can be compiled at runtime as well.
+@xref{Read/Load/Eval/Compile}, for more information on runtime
+compilation.
+
+Compiled procedures, also known as @dfn{programs}, respond all
+procedures that operate on procedures. In addition, there are a few
+more accessors for low-level details on programs.
+
+Most people won't need to use the routines described in this section,
+but it's good to have them documented. You'll have to include the
+appropriate module first, though:
+
+@example
+(use-modules (system vm program))
+@end example
+
+@deffn {Scheme Procedure} program? obj
+@deffnx {C Function} scm_program_p (obj)
+Returns @code{#t} iff @var{obj} is a compiled procedure.
+@end deffn
+
+@deffn {Scheme Procedure} program-objcode program
+@deffnx {C Function} scm_program_objcode (program)
+Returns the object code associated with this program. @xref{Bytecode
+and Objcode}, for more information.
+@end deffn
+
+@deffn {Scheme Procedure} program-objects program
+@deffnx {C Function} scm_program_objects (program)
+Returns the ``object table'' associated with this program, as a
+vector. @xref{VM Programs}, for more information.
+@end deffn
+
+@deffn {Scheme Procedure} program-module program
+@deffnx {C Function} scm_program_module (program)
+Returns the module that was current when this program was created. Can
+return @code{#f} if the compiler could determine that this information
+was unnecessary.
+@end deffn
+
+@deffn {Scheme Procedure} program-external program
+@deffnx {C Function} scm_program_external (program)
+Returns the set of heap-allocated variables that this program captures
+in its closure, as a list. If a closure is code with data, you can get
+the code from @code{program-bytecode}, and the data via
+@code{program-external}.
+
+Users must not modify the returned value unless they think they're
+really clever.
+@end deffn
+
+@deffn {Scheme Procedure} program-external-set! program external
+@deffnx {C Function} scm_program_external_set_x (program, external)
+Set @var{external} as the set of closure variables on @var{program}.
+
+The Guile maintainers will not be held responsible for side effects of
+calling this function, including but not limited to replacement of
+shampoo with hair dye, and a slight salty taste in tomorrow's dinner.
+@end deffn
+
+@deffn {Scheme Procedure} program-arity program
+@deffnx {C Function} scm_program_arity (program)
+@deffnx {Scheme Procedure} arity:nargs arity
+@deffnx {Scheme Procedure} arity:nrest arity
+@deffnx {Scheme Procedure} arity:nlocs arity
+@deffnx {Scheme Procedure} arity:nexts arity
+Accessors for a representation of the ``arity'' of a program.
+
+@code{nargs} is the number of arguments to the procedure, and
+@code{nrest} will be non-zero if the last argument is a rest argument.
+
+The other two accessors determine the number of local and external
+(heap-allocated) variables that this procedure will need to have
+allocated.
+@end deffn
+
+@deffn {Scheme Procedure} program-meta program
+@deffnx scm_program_meta (program)
+Return the metadata thunk of @var{program}, or @code{#f} if it has no
+metadata.
+
+When called, a metadata thunk returns a list of the following form:
+@code{(@var{bindings} @var{sources} . @var{properties})}. The format
+of each of these elements is discussed below.
+@end deffn
+
+@deffn {Scheme Procedure} program-bindings program
+@deffnx {Scheme Procedure} make-binding name extp index start end
+@deffnx {Scheme Procedure} binding:name binding
+@deffnx {Scheme Procedure} binding:extp binding
+@deffnx {Scheme Procedure} binding:index binding
+@deffnx {Scheme Procedure} binding:start binding
+@deffnx {Scheme Procedure} binding:end binding
+Bindings annotations for programs, along with their accessors.
+
+Bindings declare names and liveness extents for block-local variables.
+The best way to see what these are is to play around with them at a
+REPL. The only tricky bit is that @var{extp} is a boolean, declaring
+whether the binding is heap-allocated or not. @xref{VM Concepts}, for
+more information.
+
+Note that bindings information is stored in a program as part of its
+metadata thunk, so including it in the generated object code does not
+impose a runtime performance penalty.
+@end deffn
+
+@deffn {Scheme Procedure} program-sources program
+@deffnx {Scheme Procedure} source:addr source
+@deffnx {Scheme Procedure} source:line source
+@deffnx {Scheme Procedure} source:column source
+@deffnx {Scheme Procedure} source:file source
+Source location annotations for programs, along with their accessors.
+
+Source location information propagates through the compiler and ends
+up being serialized to the program's metadata. This information is
+keyed by the offset of the instruction pointer within the object code
+of the program. Specifically, it is keyed on the @code{ip} @emph{just
+following} an instruction, so that backtraces can find the source
+location of a call that is in progress.
+@end deffn
+
+@deffn {Scheme Procedure} program-properties program
+Return the properties of a @code{program} as an association list,
+keyed by property name (a symbol). 
+
+Some interesting properties include:
+@itemize
+@item @code{name}, the name of the procedure
+@item @code{documentation}, the procedure's docstring
+@end itemize
+@end deffn
+
+@deffn {Scheme Procedure} program-property program name
+Access a program's property by name, returning @code{#f} if not found.
+@end deffn
+
+@deffn {Scheme Procedure} program-documentation program
+@deffnx {Scheme Procedure} program-name program
+Accessors for specific properties.
+@end deffn
+
 @node Optional Arguments
 @subsection Optional Arguments
 
diff --git a/doc/ref/api-scheduling.texi b/doc/ref/api-scheduling.texi
index 3b622868c..521369619 100644
--- a/doc/ref/api-scheduling.texi
+++ b/doc/ref/api-scheduling.texi
@@ -8,14 +8,9 @@
 @node Scheduling
 @section Threads, Mutexes, Asyncs and Dynamic Roots
 
-[FIXME: This is pasted in from Tom Lord's original guile.texi chapter
-plus the Cygnus programmer's manual; it should be *very* carefully
-reviewed and largely reorganized.]
-
 @menu
 * Arbiters::                    Synchronization primitives.
 * Asyncs::                      Asynchronous procedure invocation.
-* Continuation Barriers::       Protection from non-local control flow.
 * Threads::                     Multiple threads of execution.
 * Mutexes and Condition Variables:: Synchronization primitives.
 * Blocking::                    How to block properly in guile mode.
@@ -47,7 +42,6 @@ process synchronization.
 
 @deffn {Scheme Procedure} try-arbiter arb
 @deffnx {C Function} scm_try_arbiter (arb)
-@deffnx {C Function} scm_try_arbiter (arb)
 If @var{arb} is unlocked, then lock it and return @code{#t}.
 If @var{arb} is already locked, then do nothing and return
 @code{#f}.
@@ -70,7 +64,7 @@ release it, but that's not required, any thread can release it.
 @cindex user asyncs
 @cindex system asyncs
 
-Asyncs are a means of deferring the excution of Scheme code until it is
+Asyncs are a means of deferring the execution of Scheme code until it is
 safe to do so.
 
 Guile provides two kinds of asyncs that share the basic concept but are
@@ -132,43 +126,42 @@ This procedure is not safe to be called from signal handlers.  Use
 signal handlers.
 @end deffn
 
-@c  FIXME: The use of @deffnx for scm_c_call_with_blocked_asyncs and
-@c  scm_c_call_with_unblocked_asyncs puts "void" into the function
-@c  index.  Would prefer to use @deftypefnx if makeinfo allowed that,
-@c  or a @deftypefn with an empty return type argument if it didn't
-@c  introduce an extra space.
-
 @deffn {Scheme Procedure} call-with-blocked-asyncs proc
 @deffnx {C Function} scm_call_with_blocked_asyncs (proc)
-@deffnx {C Function} {void *} scm_c_call_with_blocked_asyncs (void * (*proc) (void *data), void *data)
-@findex scm_c_call_with_blocked_asyncs
 Call @var{proc} and block the execution of system asyncs by one level
 for the current thread while it is running.  Return the value returned
 by @var{proc}.  For the first two variants, call @var{proc} with no
 arguments; for the third, call it with @var{data}.
 @end deffn
 
+@deftypefn {C Function} {void *} scm_c_call_with_blocked_asyncs (void * (*proc) (void *data), void *data)
+The same but with a C function @var{proc} instead of a Scheme thunk.
+@end deftypefn
+
 @deffn {Scheme Procedure} call-with-unblocked-asyncs proc
 @deffnx {C Function} scm_call_with_unblocked_asyncs (proc)
-@deffnx {C Function} {void *} scm_c_call_with_unblocked_asyncs (void *(*p) (void *d), void *d)
-@findex scm_c_call_with_unblocked_asyncs
 Call @var{proc} and unblock the execution of system asyncs by one
 level for the current thread while it is running.  Return the value
 returned by @var{proc}.  For the first two variants, call @var{proc}
 with no arguments; for the third, call it with @var{data}.
 @end deffn
 
+@deftypefn {C Function} {void *} scm_c_call_with_unblocked_asyncs (void *(*proc) (void *data), void *data)
+The same but with a C function @var{proc} instead of a Scheme thunk.
+@end deftypefn
+
 @deftypefn {C Function} void scm_dynwind_block_asyncs ()
-This function must be used inside a pair of calls to
+During the current dynwind context, increase the blocking of asyncs by
+one level.  This function must be used inside a pair of calls to
 @code{scm_dynwind_begin} and @code{scm_dynwind_end} (@pxref{Dynamic
-Wind}).  During the dynwind context, asyncs are blocked by one level.
+Wind}).
 @end deftypefn
 
 @deftypefn {C Function} void scm_dynwind_unblock_asyncs ()
-This function must be used inside a pair of calls to
+During the current dynwind context, decrease the blocking of asyncs by
+one level.  This function must be used inside a pair of calls to
 @code{scm_dynwind_begin} and @code{scm_dynwind_end} (@pxref{Dynamic
-Wind}).  During the dynwind context, asyncs are unblocked by one
-level.
+Wind}).
 @end deftypefn
 
 @node User asyncs
@@ -197,32 +190,6 @@ Mark the user async @var{a} for future execution.
 Execute all thunks from the marked asyncs of the list @var{list_of_a}.
 @end deffn
 
-@node Continuation Barriers
-@subsection Continuation Barriers
-
-The non-local flow of control caused by continuations might sometimes
-not be wanted.  You can use @code{with-continuation-barrier} etc to
-errect fences that continuations can not pass.
-
-@deffn {Scheme Procedure} with-continuation-barrier proc
-@deffnx {C Function} scm_with_continuation_barrier (proc)
-Call @var{proc} and return its result.  Do not allow the invocation of
-continuations that would leave or enter the dynamic extent of the call
-to @code{with-continuation-barrier}.  Such an attempt causes an error
-to be signaled.
-
-Throws (such as errors) that are not caught from within @var{proc} are
-caught by @code{with-continuation-barrier}.  In that case, a short
-message is printed to the current error port and @code{#f} is returned.
-
-Thus, @code{with-continuation-barrier} returns exactly once.
-@end deffn
-
-@deftypefn {C Function} {void *} scm_c_with_continuation_barrier (void *(*func) (void *), void *data)
-Like @code{scm_with_continuation_barrier} but call @var{func} on
-@var{data}.  When an error is caught, @code{NULL} is returned.
-@end deftypefn
-
 @node Threads
 @subsection Threads
 @cindex threads
diff --git a/doc/ref/api-undocumented.texi b/doc/ref/api-undocumented.texi
index 826b4d38b..ef1df19c5 100644
--- a/doc/ref/api-undocumented.texi
+++ b/doc/ref/api-undocumented.texi
@@ -257,7 +257,7 @@ otherwise return the first argument.
 @deffn {Scheme Procedure} system-async thunk
 @deffnx {C Function} scm_system_async (thunk)
 This function is deprecated.  You can use @var{thunk} directly
-instead of explicitely creating an async object.
+instead of explicitly creating an async object.
 
 @end deffn
 
diff --git a/doc/ref/autoconf.texi b/doc/ref/autoconf.texi
index 83686dada..ae807c276 100644
--- a/doc/ref/autoconf.texi
+++ b/doc/ref/autoconf.texi
@@ -1,6 +1,6 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
-@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004
+@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2009
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
@@ -48,19 +48,18 @@ checks.
 @cindex pkg-config
 @cindex autoconf
 
-GNU Guile provides a @dfn{pkg-config} description file, installed as
-@file{@var{prefix}/lib/pkgconfig/guile-1.8.pc}, which contains all the
-information necessary to compile and link C applications that use Guile.
-The @code{pkg-config} program is able to read this file and provide this
-information to application programmers; it can be obtained at
-@url{http://pkg-config.freedesktop.org/}.
+GNU Guile provides a @dfn{pkg-config} description file, which contains
+all the information necessary to compile and link C applications that
+use Guile.  The @code{pkg-config} program is able to read this file
+and provide this information to application programmers; it can be
+obtained at @url{http://pkg-config.freedesktop.org/}.
 
 The following command lines give respectively the C compilation and link
 flags needed to build Guile-using programs:
 
 @example
-pkg-config guile-1.8 --cflags
-pkg-config guile-1.8 --libs
+pkg-config guile-@value{EFFECTIVE-VERSION} --cflags
+pkg-config guile-@value{EFFECTIVE-VERSION} --libs
 @end example
 
 To ease use of pkg-config with Autoconf, pkg-config comes with a
@@ -71,7 +70,7 @@ accordingly, or prints an error and exits if Guile was not found:
 @findex PKG_CHECK_MODULES
 
 @example
-PKG_CHECK_MODULES([GUILE], [guile-1.8])
+PKG_CHECK_MODULES([GUILE], [guile-@value{EFFECTIVE-VERSION}])
 @end example
 
 Guile comes with additional Autoconf macros providing more information,
diff --git a/doc/ref/compiler.texi b/doc/ref/compiler.texi
new file mode 100644
index 000000000..d749fc1f3
--- /dev/null
+++ b/doc/ref/compiler.texi
@@ -0,0 +1,785 @@
+@c -*-texinfo-*-
+@c This is part of the GNU Guile Reference Manual.
+@c Copyright (C)  2008, 2009
+@c   Free Software Foundation, Inc.
+@c See the file guile.texi for copying conditions.
+
+@node Compiling to the Virtual Machine
+@section Compiling to the Virtual Machine
+
+Compilers have a mystique about them that is attractive and
+off-putting at the same time. They are attractive because they are
+magical -- they transform inert text into live results, like throwing
+the switch on Frankenstein's monster. However, this magic is perceived
+by many to be impenetrable.
+
+This section aims to pay attention to the small man behind the
+curtain.
+
+@xref{Read/Load/Eval/Compile}, if you're lost and you just wanted to
+know how to compile your @code{.scm} file.
+
+@menu
+* Compiler Tower::                   
+* The Scheme Compiler::                   
+* Tree-IL::                 
+* GLIL::                
+* Assembly::                   
+* Bytecode and Objcode::                   
+* Writing New High-Level Languages::
+* Extending the Compiler::
+@end menu
+
+@node Compiler Tower
+@subsection Compiler Tower
+
+Guile's compiler is quite simple, actually -- its @emph{compilers}, to
+put it more accurately. Guile defines a tower of languages, starting
+at Scheme and progressively simplifying down to languages that
+resemble the VM instruction set (@pxref{Instruction Set}).
+
+Each language knows how to compile to the next, so each step is simple
+and understandable. Furthermore, this set of languages is not
+hardcoded into Guile, so it is possible for the user to add new
+high-level languages, new passes, or even different compilation
+targets.
+
+Languages are registered in the module, @code{(system base language)}:
+
+@example
+(use-modules (system base language))
+@end example
+
+They are registered with the @code{define-language} form.
+
+@deffn {Scheme Syntax} define-language @
+name title version reader printer @
+[parser=#f] [compilers='()] [decompilers='()] [evaluator=#f]
+Define a language.
+
+This syntax defines a @code{#<language>} object, bound to @var{name}
+in the current environment. In addition, the language will be added to
+the global language set. For example, this is the language definition
+for Scheme:
+
+@example
+(define-language scheme
+  #:title       "Guile Scheme"
+  #:version     "0.5"
+  #:reader      read
+  #:compilers   `((tree-il . ,compile-tree-il))
+  #:decompilers `((tree-il . ,decompile-tree-il))
+  #:evaluator   (lambda (x module) (primitive-eval x))
+  #:printer     write)
+@end example
+@end deffn
+
+The interesting thing about having languages defined this way is that
+they present a uniform interface to the read-eval-print loop. This
+allows the user to change the current language of the REPL:
+
+@example
+$ guile
+Guile Scheme interpreter 0.5 on Guile 1.9.0
+Copyright (C) 2001-2008 Free Software Foundation, Inc.
+
+Enter `,help' for help.
+scheme@@(guile-user)> ,language tree-il
+Tree Intermediate Language interpreter 1.0 on Guile 1.9.0
+Copyright (C) 2001-2008 Free Software Foundation, Inc.
+
+Enter `,help' for help.
+tree-il@@(guile-user)> 
+@end example
+
+Languages can be looked up by name, as they were above.
+
+@deffn {Scheme Procedure} lookup-language name
+Looks up a language named @var{name}, autoloading it if necessary.
+
+Languages are autoloaded by looking for a variable named @var{name} in
+a module named @code{(language @var{name} spec)}.
+
+The language object will be returned, or @code{#f} if there does not
+exist a language with that name.
+@end deffn
+
+Defining languages this way allows us to programmatically determine
+the necessary steps for compiling code from one language to another.
+
+@deffn {Scheme Procedure} lookup-compilation-order from to
+Recursively traverses the set of languages to which @var{from} can
+compile, depth-first, and return the first path that can transform
+@var{from} to @var{to}. Returns @code{#f} if no path is found.
+
+This function memoizes its results in a cache that is invalidated by
+subsequent calls to @code{define-language}, so it should be quite
+fast.
+@end deffn
+
+There is a notion of a ``current language'', which is maintained in
+the @code{*current-language*} fluid. This language is normally Scheme,
+and may be rebound by the user. The run-time compilation interfaces
+(@pxref{Read/Load/Eval/Compile}) also allow you to choose other source
+and target languages.
+
+The normal tower of languages when compiling Scheme goes like this:
+
+@itemize
+@item Scheme, which we know and love
+@item Tree Intermediate Language (Tree-IL)
+@item Guile Low Intermediate Language (GLIL)
+@item Assembly
+@item Bytecode
+@item Objcode
+@end itemize
+
+Object code may be serialized to disk directly, though it has a cookie
+and version prepended to the front. But when compiling Scheme at run
+time, you want a Scheme value: for example, a compiled procedure. For
+this reason, so as not to break the abstraction, Guile defines a fake
+language at the bottom of the tower:
+
+@itemize
+@item Value
+@end itemize
+
+Compiling to @code{value} loads the object code into a procedure, and
+wakes the sleeping giant.
+
+Perhaps this strangeness can be explained by example:
+@code{compile-file} defaults to compiling to object code, because it
+produces object code that has to live in the barren world outside the
+Guile runtime; but @code{compile} defaults to compiling to
+@code{value}, as its product re-enters the Guile world.
+
+Indeed, the process of compilation can circulate through these
+different worlds indefinitely, as shown by the following quine:
+
+@example
+((lambda (x) ((compile x) x)) '(lambda (x) ((compile x) x)))
+@end example
+
+@node The Scheme Compiler
+@subsection The Scheme Compiler
+
+The job of the Scheme compiler is to expand all macros and all of
+Scheme to its most primitive expressions. The definition of
+``primitive'' is given by the inventory of constructs provided by
+Tree-IL, the target language of the Scheme compiler: procedure
+applications, conditionals, lexical references, etc. This is described
+more fully in the next section.
+
+The tricky and amusing thing about the Scheme-to-Tree-IL compiler is
+that it is completely implemented by the macro expander. Since the
+macro expander has to run over all of the source code already in order
+to expand macros, it might as well do the analysis at the same time,
+producing Tree-IL expressions directly.
+
+Because this compiler is actually the macro expander, it is
+extensible. Any macro which the user writes becomes part of the
+compiler.
+
+The Scheme-to-Tree-IL expander may be invoked using the generic
+@code{compile} procedure:
+
+@lisp
+(compile '(+ 1 2) #:from 'scheme #:to 'tree-il)
+@result{}
+ #<<application> src: #f
+                 proc: #<<toplevel-ref> src: #f name: +>
+                 args: (#<<const> src: #f exp: 1>
+                        #<<const> src: #f exp: 2>)>
+@end lisp
+
+Or, since Tree-IL is so close to Scheme, it is often useful to expand
+Scheme to Tree-IL, then translate back to Scheme. For that reason the
+expander provides two interfaces. The former is equivalent to calling
+@code{(sc-expand '(+ 1 2) 'c)}, where the @code{'c} is for
+``compile''. With @code{'e} (the default), the result is translated
+back to Scheme:
+
+@lisp
+(sc-expand '(+ 1 2))
+@result{} (+ 1 2)
+(sc-expand '(let ((x 10)) (* x x)))
+@result{} (let ((x84 10)) (* x84 x84))
+@end lisp
+
+The second example shows that as part of its job, the macro expander
+renames lexically-bound variables. The original names are preserved
+when compiling to Tree-IL, but can't be represented in Scheme: a
+lexical binding only has one name. It is for this reason that the
+@emph{native} output of the expander is @emph{not} Scheme. There's too
+much information we would lose if we translated to Scheme directly:
+lexical variable names, source locations, and module hygiene.
+
+Note however that @code{sc-expand} does not have the same signature as
+@code{compile-tree-il}. @code{compile-tree-il} is a small wrapper
+around @code{sc-expand}, to make it conform to the general form of
+compiler procedures in Guile's language tower.
+
+Compiler procedures take three arguments: an expression, an
+environment, and a keyword list of options. They return three values:
+the compiled expression, the corresponding environment for the target
+language, and a ``continuation environment''. The compiled expression
+and environment will serve as input to the next language's compiler.
+The ``continuation environment'' can be used to compile another
+expression from the same source language within the same module.
+
+For example, you might compile the expression, @code{(define-module
+(foo))}. This will result in a Tree-IL expression and environment. But
+if you compiled a second expression, you would want to take into
+account the compile-time effect of compiling the previous expression,
+which puts the user in the @code{(foo)} module. That is purpose of the
+``continuation environment''; you would pass it as the environment
+when compiling the subsequent expression.
+
+For Scheme, an environment may be one of two things:
+@itemize
+@item @code{#f}, in which case compilation is performed in the context
+of the current module; or
+@item a module, which specifies the context of the compilation.
+@end itemize
+
+@node Tree-IL
+@subsection Tree-IL
+
+Tree Intermediate Language (Tree-IL) is a structured intermediate
+language that is close in expressive power to Scheme. It is an
+expanded, pre-analyzed Scheme.
+
+Tree-IL is ``structured'' in the sense that its representation is
+based on records, not S-expressions. This gives a rigidity to the
+language that ensures that compiling to a lower-level language only
+requires a limited set of transformations. Practically speaking,
+consider the Tree-IL type, @code{<const>}, which has two fields,
+@code{src} and @code{exp}. Instances of this type are records created
+via @code{make-const}, and whose fields are accessed as
+@code{const-src}, and @code{const-exp}. There is also a predicate,
+@code{const?}. @xref{Records}, for more information on records.
+
+@c alpha renaming
+
+All Tree-IL types have a @code{src} slot, which holds source location
+information for the expression. This information, if present, will be
+residualized into the compiled object code, allowing backtraces to
+show source information. The format of @code{src} is the same as that
+returned by Guile's @code{source-properties} function. @xref{Source
+Properties}, for more information.
+
+Although Tree-IL objects are represented internally using records,
+there is also an equivalent S-expression external representation for
+each kind of Tree-IL. For example, an the S-expression representation
+of @code{#<const src: #f exp: 3>} expression would be:
+
+@example
+(const 3)
+@end example
+
+Users may program with this format directly at the REPL:
+
+@example
+scheme@@(guile-user)> ,language tree-il
+Tree Intermediate Language interpreter 1.0 on Guile 1.9.0
+Copyright (C) 2001-2008 Free Software Foundation, Inc.
+
+Enter `,help' for help.
+tree-il@@(guile-user)> (apply (primitive +) (const 32) (const 10))
+@result{} 42
+@end example
+
+The @code{src} fields are left out of the external representation.
+
+One may create Tree-IL objects from their external representations via
+calling @code{parse-tree-il}, the reader for Tree-IL. If any source
+information is attached to the input S-expression, it will be
+propagated to the resulting Tree-IL expressions. This is probably the
+easiest way to compile to Tree-IL: just make the appropriate external
+representations in S-expression format, and let @code{parse-tree-il}
+take care of the rest.
+
+@deftp {Scheme Variable} <void> src
+@deftpx {External Representation} (void)
+An empty expression. In practice, equivalent to Scheme's @code{(if #f
+#f)}.
+@end deftp
+@deftp {Scheme Variable} <const> src exp
+@deftpx {External Representation} (const @var{exp})
+A constant.
+@end deftp
+@deftp {Scheme Variable} <primitive-ref> src name
+@deftpx {External Representation} (primitive @var{name})
+A reference to a ``primitive''. A primitive is a procedure that, when
+compiled, may be open-coded. For example, @code{cons} is usually
+recognized as a primitive, so that it compiles down to a single
+instruction.
+
+Compilation of Tree-IL usually begins with a pass that resolves some
+@code{<module-ref>} and @code{<toplevel-ref>} expressions to
+@code{<primitive-ref>} expressions. The actual compilation pass
+has special cases for applications of certain primitives, like
+@code{apply} or @code{cons}.
+@end deftp
+@deftp {Scheme Variable} <lexical-ref> src name gensym
+@deftpx {External Representation} (lexical @var{name} @var{gensym})
+A reference to a lexically-bound variable. The @var{name} is the
+original name of the variable in the source program. @var{gensym} is a
+unique identifier for this variable.
+@end deftp
+@deftp {Scheme Variable} <lexical-set> src name gensym exp
+@deftpx {External Representation} (set! (lexical @var{name} @var{gensym}) @var{exp})
+Sets a lexically-bound variable.
+@end deftp
+@deftp {Scheme Variable} <module-ref> src mod name public?
+@deftpx {External Representation} (@@ @var{mod} @var{name})
+@deftpx {External Representation} (@@@@ @var{mod} @var{name})
+A reference to a variable in a specific module. @var{mod} should be
+the name of the module, e.g. @code{(guile-user)}.
+
+If @var{public?} is true, the variable named @var{name} will be looked
+up in @var{mod}'s public interface, and serialized with @code{@@};
+otherwise it will be looked up among the module's private bindings,
+and is serialized with @code{@@@@}.
+@end deftp
+@deftp {Scheme Variable} <module-set> src mod name public? exp
+@deftpx {External Representation} (set! (@@ @var{mod} @var{name}) @var{exp})
+@deftpx {External Representation} (set! (@@@@ @var{mod} @var{name}) @var{exp})
+Sets a variable in a specific module.
+@end deftp
+@deftp {Scheme Variable} <toplevel-ref> src name
+@deftpx {External Representation} (toplevel @var{name})
+References a variable from the current procedure's module.
+@end deftp
+@deftp {Scheme Variable} <toplevel-set> src name exp
+@deftpx {External Representation} (set! (toplevel @var{name}) @var{exp})
+Sets a variable in the current procedure's module.
+@end deftp
+@deftp {Scheme Variable} <toplevel-define> src name exp
+@deftpx {External Representation} (define (toplevel @var{name}) @var{exp})
+Defines a new top-level variable in the current procedure's module.
+@end deftp
+@deftp {Scheme Variable} <conditional> src test then else
+@deftpx {External Representation} (if @var{test} @var{then} @var{else})
+A conditional. Note that @var{else} is not optional.
+@end deftp
+@deftp {Scheme Variable} <application> src proc args
+@deftpx {External Representation} (apply @var{proc} . @var{args})
+A procedure call.
+@end deftp
+@deftp {Scheme Variable} <sequence> src exps
+@deftpx {External Representation} (begin . @var{exps})
+Like Scheme's @code{begin}.
+@end deftp
+@deftp {Scheme Variable} <lambda> src names vars meta body
+@deftpx {External Representation} (lambda @var{names} @var{vars} @var{meta} @var{body})
+A closure. @var{names} is original binding form, as given in the
+source code, which may be an improper list. @var{vars} are gensyms
+corresponding to the @var{names}. @var{meta} is an association list of
+properties. The actual @var{body} is a single Tree-IL expression.
+@end deftp
+@deftp {Scheme Variable} <let> src names vars vals exp
+@deftpx {External Representation} (let @var{names} @var{vars} @var{vals} @var{exp})
+Lexical binding, like Scheme's @code{let}. @var{names} are the
+original binding names, @var{vars} are gensyms corresponding to the
+@var{names}, and @var{vals} are Tree-IL expressions for the values.
+@var{exp} is a single Tree-IL expression.
+@end deftp
+@deftp {Scheme Variable} <letrec> src names vars vals exp
+@deftpx {External Representation} (letrec @var{names} @var{vars} @var{vals} @var{exp})
+A version of @code{<let>} that creates recursive bindings, like
+Scheme's @code{letrec}.
+@end deftp
+
+There are two Tree-IL constructs that are not normally produced by
+higher-level compilers, but instead are generated during the
+source-to-source optimization and analysis passes that the Tree-IL
+compiler does. Users should not generate these expressions directly,
+unless they feel very clever, as the default analysis pass will
+generate them as necessary.
+
+@deftp {Scheme Variable} <let-values> src names vars exp body
+@deftpx {External Representation} (let-values @var{names} @var{vars} @var{exp} @var{body})
+Like Scheme's @code{receive} -- binds the values returned by
+evaluating @code{exp} to the @code{lambda}-like bindings described by
+@var{vars}. That is to say, @var{vars} may be an improper list.
+
+@code{<let-values>} is an optimization of @code{<application>} of the
+primitive, @code{call-with-values}.
+@end deftp
+@deftp {Scheme Variable} <fix> src names vars vals body
+@deftpx {External Representation} (fix @var{names} @var{vars} @var{vals} @var{body})
+Like @code{<letrec>}, but only for @var{vals} that are unset
+@code{lambda} expressions.
+
+@code{fix} is an optimization of @code{letrec} (and @code{let}).
+@end deftp
+
+Tree-IL implements a compiler to GLIL that recursively traverses
+Tree-IL expressions, writing out GLIL expressions into a linear list.
+The compiler also keeps some state as to whether the current
+expression is in tail context, and whether its value will be used in
+future computations. This state allows the compiler not to emit code
+for constant expressions that will not be used (e.g. docstrings), and
+to perform tail calls when in tail position.
+
+Most optimization, such as it currently is, is performed on Tree-IL
+expressions as source-to-source transformations. There will be more
+optimizations added in the future.
+
+Interested readers are encouraged to read the implementation in
+@code{(language tree-il compile-glil)} for more details.
+
+@node GLIL
+@subsection GLIL
+
+Guile Low Intermediate Language (GLIL) is a structured intermediate
+language whose expressions more closely approximate Guile's VM
+instruction set. Its expression types are defined in @code{(language
+glil)}.
+
+@deftp {Scheme Variable} <glil-program> nargs nrest nlocs meta . body
+A unit of code that at run-time will correspond to a compiled
+procedure. @var{nargs} @var{nrest} and @var{nlocs} collectively define
+the program's arity; see @ref{Compiled Procedures}, for more
+information. @var{meta} should be an alist of properties, as in
+Tree-IL's @code{<lambda>}. @var{body} is an ordered list of GLIL
+expressions.
+@end deftp
+@deftp {Scheme Variable} <glil-bind> . vars
+An advisory expression that notes a liveness extent for a set of
+variables. @var{vars} is a list of @code{(@var{name} @var{type}
+@var{index})}, where @var{type} should be either @code{argument},
+@code{local}, or @code{external}.
+
+@code{<glil-bind>} expressions end up being serialized as part of a
+program's metadata and do not form part of a program's code path.
+@end deftp
+@deftp {Scheme Variable} <glil-mv-bind> vars rest
+A multiple-value binding of the values on the stack to @var{vars}. Iff
+@var{rest} is true, the last element of @var{vars} will be treated as
+a rest argument.
+
+In addition to pushing a binding annotation on the stack, like
+@code{<glil-bind>}, an expression is emitted at compilation time to
+make sure that there are enough values available to bind. See the
+notes on @code{truncate-values} in @ref{Procedural Instructions}, for
+more information.
+@end deftp
+@deftp {Scheme Variable} <glil-unbind>
+Closes the liveness extent of the most recently encountered
+@code{<glil-bind>} or @code{<glil-mv-bind>} expression. As GLIL
+expressions are compiled, a parallel stack of live bindings is
+maintained; this expression pops off the top element from that stack.
+
+Bindings are written into the program's metadata so that debuggers and
+other tools can determine the set of live local variables at a given
+offset within a VM program.
+@end deftp
+@deftp {Scheme Variable} <glil-source> loc
+Records source information for the preceding expression. @var{loc}
+should be an association list of containing @code{line} @code{column},
+and @code{filename} keys, e.g. as returned by
+@code{source-properties}.
+@end deftp
+@deftp {Scheme Variable} <glil-void>
+Pushes ``the unspecified value'' on the stack.
+@end deftp
+@deftp {Scheme Variable} <glil-const> obj
+Pushes a constant value onto the stack. @var{obj} must be a number,
+string, symbol, keyword, boolean, character, uniform array, the empty
+list, or a pair or vector of constants.
+@end deftp
+@deftp {Scheme Variable} <glil-lexical> local? boxed? op index
+Accesses a lexically bound variable. If the variable is not
+@var{local?} it is free. All variables may have @code{ref} and
+@code{set} as their @var{op}. Boxed variables may also have the
+@var{op}s @code{box}, @code{empty-box}, and @code{fix}, which
+correspond in semantics to the VM instructions @code{box},
+@code{empty-box}, and @code{fix-closure}. @xref{Stack Layout}, for
+more information.
+@end deftp
+@deftp {Scheme Variable} <glil-toplevel> op name
+Accesses a toplevel variable. @var{op} may be @code{ref}, @code{set},
+or @code{define}.
+@end deftp
+@deftp {Scheme Variable} <glil-module> op mod name public?
+Accesses a variable within a specific module. See Tree-IL's
+@code{<module-ref>}, for more information.
+@end deftp
+@deftp {Scheme Variable} <glil-label> label
+Creates a new label. @var{label} can be any Scheme value, and should
+be unique.
+@end deftp
+@deftp {Scheme Variable} <glil-branch> inst label
+Branch to a label. @var{label} should be a @code{<ghil-label>}.
+@code{inst} is a branching instruction: @code{br-if}, @code{br}, etc.
+@end deftp
+@deftp {Scheme Variable} <glil-call> inst nargs
+This expression is probably misnamed, as it does not correspond to
+function calls. @code{<glil-call>} invokes the VM instruction named
+@var{inst}, noting that it is called with @var{nargs} stack arguments.
+The arguments should be pushed on the stack already. What happens to
+the stack afterwards depends on the instruction.
+@end deftp
+@deftp {Scheme Variable} <glil-mv-call> nargs ra
+Performs a multiple-value call. @var{ra} is a @code{<glil-label>}
+corresponding to the multiple-value return address for the call. See
+the notes on @code{mv-call} in @ref{Procedural Instructions}, for more
+information.
+@end deftp
+
+Users may enter in GLIL at the REPL as well, though there is a bit
+more bookkeeping to do. Since GLIL needs the set of variables to be
+declared explicitly in a @code{<glil-program>}, GLIL expressions must
+be wrapped in a thunk that declares the arity of the expression:
+
+@example
+scheme@@(guile-user)> ,language glil
+Guile Lowlevel Intermediate Language (GLIL) interpreter 0.3 on
+   Guile 1.9.0
+Copyright (C) 2001-2008 Free Software Foundation, Inc.
+
+Enter `,help' for help.
+glil@@(guile-user)> (program 0 0 0 () (const 3) (call return 1))
+@result{} 3
+@end example
+
+Just as in all of Guile's compilers, an environment is passed to the
+GLIL-to-object code compiler, and one is returned as well, along with
+the object code.
+
+@node Assembly
+@subsection Assembly
+
+Assembly is an S-expression-based, human-readable representation of
+the actual bytecodes that will be emitted for the VM. As such, it is a
+useful intermediate language both for compilation and for
+decompilation.
+
+Besides the fact that it is not a record-based language, assembly
+differs from GLIL in four main ways:
+
+@itemize
+@item Labels have been resolved to byte offsets in the program.
+@item Constants inside procedures have either been expressed as inline
+instructions or cached in object arrays.
+@item Procedures with metadata (source location information, liveness
+extents, procedure names, generic properties, etc) have had their
+metadata serialized out to thunks.
+@item All expressions correspond directly to VM instructions -- i.e.,
+there is no @code{<glil-lexical>} which can be a ref or a set.
+@end itemize
+
+Assembly is isomorphic to the bytecode that it compiles to. You can
+compile to bytecode, then decompile back to assembly, and you have the
+same assembly code.
+
+The general form of assembly instructions is the following:
+
+@lisp
+(@var{inst} @var{arg} ...)
+@end lisp
+
+The @var{inst} names a VM instruction, and its @var{arg}s will be
+embedded in the instruction stream. The easiest way to see assembly is
+to play around with it at the REPL, as can be seen in this annotated
+example:
+
+@example
+scheme@@(guile-user)> (compile '(lambda (x) (+ x x)) #:to 'assembly)
+(load-program 0 0 0
+  () ; Labels
+  70 ; Length
+  #f ; Metadata
+  (make-false)
+  (make-false) ; object table for the returned lambda
+  (nop)
+  (nop) ; Alignment. Since assembly has already resolved its labels
+  (nop) ; to offsets, and programs must be 8-byte aligned since their
+  (nop) ; object code is mmap'd directly to structures, assembly
+  (nop) ; has to have the alignment embedded in it.
+  (nop) 
+  (load-program
+    1
+    0
+    ()
+    8
+    (load-program 0 0 0 () 21 #f
+      (load-symbol "x")  ; Name and liveness extent for @code{x}.
+      (make-false)
+      (make-int8:0) ; Some instruction+arg combinations
+      (make-int8:0) ; have abbreviations.
+      (make-int8 6)
+      (list 0 5)
+      (list 0 1)
+      (make-eol)
+      (list 0 2)
+      (return))
+    ; And here, the actual code.
+    (local-ref 0)
+    (local-ref 0)
+    (add)
+    (return)
+    (nop)
+    (nop))
+  ; Return our new procedure.
+  (return))
+@end example
+
+Of course you can switch the REPL to assembly and enter in assembly
+S-expressions directly, like with other languages, though it is more
+difficult, given that the length fields have to be correct.
+
+@node Bytecode and Objcode
+@subsection Bytecode and Objcode
+
+Finally, the raw bytes. There are actually two different ``languages''
+here, corresponding to two different ways to represent the bytes.
+
+``Bytecode'' represents code as uniform byte vectors, useful for
+structuring and destructuring code on the Scheme level. Bytecode is
+the next step down from assembly:
+
+@example
+scheme@@(guile-user)> (compile '(+ 32 10) #:to 'assembly)
+@result{} (load-program 0 0 0 () 6 #f
+       (make-int8 32) (make-int8 10) (add) (return))
+scheme@@(guile-user)> (compile '(+ 32 10) #:to 'bytecode)
+@result{} #u8(0 0 0 0 6 0 0 0 0 0 0 0 0 0 0 0 10 32 10 10 120 52)
+@end example
+
+``Objcode'' is bytecode, but mapped directly to a C structure,
+@code{struct scm_objcode}:
+
+@example
+struct scm_objcode @{
+  scm_t_uint8 nargs;
+  scm_t_uint8 nrest;
+  scm_t_uint16 nlocs;
+  scm_t_uint32 len;
+  scm_t_uint32 metalen;
+  scm_t_uint8 base[0];
+@};
+@end example
+
+As one might imagine, objcode imposes a minimum length on the
+bytecode. Also, the multibyte fields are in native endianness, which
+makes objcode (and bytecode) system-dependent. Indeed, in the short
+example above, all but the last 6 bytes were the program's header.
+
+Objcode also has a couple of important efficiency hacks. First,
+objcode may be mapped directly from disk, allowing compiled code to be
+loaded quickly, often from the system's disk cache, and shared among
+multiple processes. Secondly, objcode may be embedded in other
+objcode, allowing procedures to have the text of other procedures
+inlined into their bodies, without the need for separate allocation of
+the code. Of course, the objcode object itself does need to be
+allocated.
+
+Procedures related to objcode are defined in the @code{(system vm
+objcode)} module.
+
+@deffn {Scheme Procedure} objcode? obj
+@deffnx {C Function} scm_objcode_p (obj)
+Returns @code{#f} iff @var{obj} is object code, @code{#f} otherwise.
+@end deffn
+
+@deffn {Scheme Procedure} bytecode->objcode bytecode
+@deffnx {C Function} scm_bytecode_to_objcode (bytecode,)
+Makes a bytecode object from @var{bytecode}, which should be a
+@code{u8vector}.
+@end deffn
+
+@deffn {Scheme Variable} load-objcode file
+@deffnx {C Function} scm_load_objcode (file)
+Load object code from a file named @var{file}. The file will be mapped
+into memory via @code{mmap}, so this is a very fast operation.
+
+On disk, object code has an sixteen-byte cookie prepended to it, to
+prevent accidental loading of arbitrary garbage.
+@end deffn
+
+@deffn {Scheme Variable} write-objcode objcode file
+@deffnx {C Function} scm_write_objcode (objcode)
+Write object code out to a file, prepending the eight-byte cookie.
+@end deffn
+
+@deffn {Scheme Variable} objcode->u8vector objcode
+@deffnx {C Function} scm_objcode_to_u8vector (objcode)
+Copy object code out to a @code{u8vector} for analysis by Scheme.
+@end deffn
+
+The following procedure is actually in @code{(system vm program)}, but
+we'll mention it here:
+
+@deffn {Scheme Variable} make-program objcode objtable [free-vars=#f]
+@deffnx {C Function} scm_make_program (objcode, objtable, free_vars)
+Load up object code into a Scheme program. The resulting program will
+have @var{objtable} as its object table, which should be a vector or
+@code{#f}, and will capture the free variables from @var{free-vars}.
+@end deffn
+
+Object code from a file may be disassembled at the REPL via the
+meta-command @code{,disassemble-file}, abbreviated as @code{,xx}.
+Programs may be disassembled via @code{,disassemble}, abbreviated as
+@code{,x}.
+
+Compiling object code to the fake language, @code{value}, is performed
+via loading objcode into a program, then executing that thunk with
+respect to the compilation environment. Normally the environment
+propagates through the compiler transparently, but users may specify
+the compilation environment manually as well:
+
+@deffn {Scheme Procedure} make-objcode-env module free-vars
+Make an object code environment. @var{module} should be a Scheme
+module, and @var{free-vars} should be a vector of free variables.
+@code{#f} is also a valid object code environment.
+@end deffn
+
+@node Writing New High-Level Languages
+@subsection Writing New High-Level Languages
+
+In order to integrate a new language @var{lang} into Guile's compiler
+system, one has to create the module @code{(language @var{lang} spec)}
+containing the language definition and referencing the parser,
+compiler and other routines processing it. The module hierarchy in
+@code{(language brainfuck)} defines a very basic Brainfuck
+implementation meant to serve as easy-to-understand example on how to
+do this. See for instance @url{http://en.wikipedia.org/wiki/Brainfuck}
+for more information about the Brainfuck language itself.
+
+
+@node Extending the Compiler
+@subsection Extending the Compiler
+
+At this point, we break with the impersonal tone of the rest of the
+manual, and make an intervention. Admit it: if you've read this far
+into the compiler internals manual, you are a junkie. Perhaps a course
+at your university left you unsated, or perhaps you've always harbored
+a sublimated desire to hack the holy of computer science holies: a
+compiler. Well you're in good company, and in a good position. Guile's
+compiler needs your help.
+
+There are many possible avenues for improving Guile's compiler.
+Probably the most important improvement, speed-wise, will be some form
+of native compilation, both just-in-time and ahead-of-time. This could
+be done in many ways. Probably the easiest strategy would be to extend
+the compiled procedure structure to include a pointer to a native code
+vector, and compile from bytecode to native code at run-time after a
+procedure is called a certain number of times.
+
+The name of the game is a profiling-based harvest of the low-hanging
+fruit, running programs of interest under a system-level profiler and
+determining which improvements would give the most bang for the buck.
+It's really getting to the point though that native compilation is the
+next step.
+
+The compiler also needs help at the top end, enhancing the Scheme that
+it knows to also understand R6RS, and adding new high-level compilers.
+We have JavaScript and Emacs Lisp mostly complete, but they could use
+some love; Lua would be nice as well, butq whatever language it is
+that strikes your fancy would be welcome too.
+
+Compilers are for hacking, not for admiring or for complaining about.
+Get to it!
diff --git a/doc/ref/data-rep.texi b/doc/ref/data-rep.texi
index 5b76263b3..5f2a22b07 100644
--- a/doc/ref/data-rep.texi
+++ b/doc/ref/data-rep.texi
@@ -4,135 +4,6 @@
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
-@c essay \input texinfo
-@c essay @c -*-texinfo-*-
-@c essay @c %**start of header
-@c essay @setfilename data-rep.info
-@c essay @settitle Data Representation in Guile
-@c essay @c %**end of header
-
-@c essay @include version.texi
-
-@c essay @dircategory The Algorithmic Language Scheme
-@c essay @direntry
-@c essay * data-rep: (data-rep).  Data Representation in Guile --- how to use
-@c essay                 Guile objects in your C code.
-@c essay @end direntry
-
-@c essay @setchapternewpage off
-
-@c essay @ifinfo
-@c essay Data Representation in Guile
-
-@c essay Copyright (C) 1998, 1999, 2000, 2003, 2006 Free Software Foundation
-
-@c essay Permission is granted to make and distribute verbatim copies of
-@c essay this manual provided the copyright notice and this permission notice
-@c essay are preserved on all copies.
-
-@c essay @ignore
-@c essay Permission is granted to process this file through TeX and print the
-@c essay results, provided the printed document carries copying permission
-@c essay notice identical to this one except for the removal of this paragraph
-@c essay (this paragraph not being relevant to the printed manual).
-@c essay @end ignore
-
-@c essay Permission is granted to copy and distribute modified versions of this
-@c essay manual under the conditions for verbatim copying, provided that the entire
-@c essay resulting derived work is distributed under the terms of a permission
-@c essay notice identical to this one.
-
-@c essay Permission is granted to copy and distribute translations of this manual
-@c essay into another language, under the above conditions for modified versions,
-@c essay except that this permission notice may be stated in a translation approved
-@c essay by the Free Software Foundation.
-@c essay @end ifinfo
-
-@c essay @titlepage
-@c essay @sp 10
-@c essay @comment The title is printed in a large font.
-@c essay @title Data Representation in Guile
-@c essay @subtitle $Id: data-rep.texi,v 1.20 2006-04-16 23:11:15 kryde Exp $
-@c essay @subtitle For use with Guile @value{VERSION}
-@c essay @author Jim Blandy
-@c essay @author Free Software Foundation
-@c essay @author @email{jimb@@red-bean.com}
-@c essay @c The following two commands start the copyright page.
-@c essay @page
-@c essay @vskip 0pt plus 1filll
-@c essay @vskip 0pt plus 1filll
-@c essay Copyright @copyright{} 1998, 2006 Free Software Foundation
-
-@c essay Permission is granted to make and distribute verbatim copies of
-@c essay this manual provided the copyright notice and this permission notice
-@c essay are preserved on all copies.
-
-@c essay Permission is granted to copy and distribute modified versions of this
-@c essay manual under the conditions for verbatim copying, provided that the entire
-@c essay resulting derived work is distributed under the terms of a permission
-@c essay notice identical to this one.
-
-@c essay Permission is granted to copy and distribute translations of this manual
-@c essay into another language, under the above conditions for modified versions,
-@c essay except that this permission notice may be stated in a translation approved
-@c essay by Free Software Foundation.
-@c essay @end titlepage
-
-@c essay @c @smallbook
-@c essay @c @finalout
-@c essay @headings double
-
-
-@c essay @node Top, Data Representation in Scheme, (dir), (dir)
-@c essay @top Data Representation in Guile
-
-@c essay @ifinfo
-@c essay This essay is meant to provide the background necessary to read and
-@c essay write C code that manipulates Scheme values in a way that conforms to
-@c essay libguile's interface.  If you would like to write or maintain a
-@c essay Guile-based application in C or C++, this is the first information you
-@c essay need.
-
-@c essay In order to make sense of Guile's @code{SCM_} functions, or read
-@c essay libguile's source code, it's essential to have a good grasp of how Guile
-@c essay actually represents Scheme values.  Otherwise, a lot of the code, and
-@c essay the conventions it follows, won't make very much sense.
-
-@c essay We assume you know both C and Scheme, but we do not assume you are
-@c essay familiar with Guile's C interface.
-@c essay @end ifinfo
-
-
-@node Data Representation
-@appendix Data Representation in Guile
-
-@strong{by Jim Blandy}
-
-[Due to the rather non-orthogonal and performance-oriented nature of the
-SCM interface, you need to understand SCM internals *before* you can use
-the SCM API.  That's why this chapter comes first.]
-
-[NOTE: this is Jim Blandy's essay almost entirely unmodified.  It has to
-be adapted to fit this manual smoothly.]
-
-In order to make sense of Guile's SCM_ functions, or read libguile's
-source code, it's essential to have a good grasp of how Guile actually
-represents Scheme values.  Otherwise, a lot of the code, and the
-conventions it follows, won't make very much sense.  This essay is meant
-to provide the background necessary to read and write C code that
-manipulates Scheme values in a way that is compatible with libguile.
-
-We assume you know both C and Scheme, but we do not assume you are
-familiar with Guile's implementation.
-
-@menu
-* Data Representation in Scheme::       Why things aren't just totally
-                                        straightforward, in general terms.
-* How Guile does it::                   How to write C code that manipulates
-                                        Guile values, with an explanation
-                                        of Guile's garbage collector.
-@end menu
-
 @node Data Representation in Scheme
 @section Data Representation in Scheme
 
@@ -159,8 +30,8 @@ The following sections will present a simple typing system, and then
 make some refinements to correct its major weaknesses.  However, this is
 not a description of the system Guile actually uses.  It is only an
 illustration of the issues Guile's system must address.  We provide all
-the information one needs to work with Guile's data in @ref{How Guile
-does it}.
+the information one needs to work with Guile's data in @ref{The
+Libguile Runtime Environment}.
 
 
 @menu
@@ -423,22 +294,21 @@ significant loss of efficiency, but the simplified system would still be
 more complex than what we've presented above.
 
 
-@node How Guile does it
-@section How Guile does it
+@node The Libguile Runtime Environment
+@section The Libguile Runtime Environment
 
 Here we present the specifics of how Guile represents its data.  We
 don't go into complete detail; an exhaustive description of Guile's
 system would be boring, and we do not wish to encourage people to write
 code which depends on its details anyway.  We do, however, present
-everything one need know to use Guile's data.
-
-This section is in limbo.  It used to document the 'low-level' C API
-of Guile that was used both by clients of libguile and by libguile
-itself.
+everything one need know to use Guile's data. It is assumed that the
+reader understands the concepts laid out in @ref{Data Representation
+in Scheme}.
 
-In the future, clients should only need to look into the sections
-@ref{Programming in C} and @ref{API Reference}.  This section will in
-the end only contain stuff about the internals of Guile.
+FIXME: much of this is outdated as of 1.8, we don't provide many of
+these macros any more. Also here we're missing sections about the
+evaluator implementation, which is interesting, and notes about tail
+recursion between scheme and c.
 
 @menu
 * General Rules::               
@@ -1127,7 +997,7 @@ This reference can be decoded to a C pointer to a heap cell using the
 @code{SCM} value is done using the @code{PTR2SCM} macro.
 
 @c (FIXME:: this name should be changed)
-@deftypefn Macro (scm_t_cell *) SCM2PTR (SCM @var{x})
+@deftypefn Macro {scm_t_cell *} SCM2PTR (SCM @var{x})
 Extract and return the heap cell pointer from a non-immediate @code{SCM}
 object @var{x}.
 @end deftypefn
diff --git a/doc/ref/effective-version.texi.in b/doc/ref/effective-version.texi.in
new file mode 100644
index 000000000..80b56b751
--- /dev/null
+++ b/doc/ref/effective-version.texi.in
@@ -0,0 +1 @@
+@set EFFECTIVE-VERSION @GUILE_EFFECTIVE_VERSION@
diff --git a/doc/ref/expect.texi b/doc/ref/expect.texi
index 05c766999..71e9a385b 100644
--- a/doc/ref/expect.texi
+++ b/doc/ref/expect.texi
@@ -10,9 +10,9 @@
 
 The macros in this section are made available with:
 
-@smalllisp
+@lisp
 (use-modules (ice-9 expect))
-@end smalllisp
+@end lisp
 
 @code{expect} is a macro for selecting actions based on the output from
 a port.  The name comes from a tool of similar functionality by Don Libes.
@@ -30,14 +30,14 @@ which is matched against each of the patterns.  When a
 pattern matches, the remaining expression(s) in
 the clause are evaluated and the value of the last is returned.  For example:
 
-@smalllisp
+@lisp
 (with-input-from-file "/etc/passwd"
   (lambda ()
     (expect-strings
       ("^nobody" (display "Got a nobody user.\n")
                  (display "That's no problem.\n"))
       ("^daemon" (display "Got a daemon user.\n")))))
-@end smalllisp
+@end lisp
 
 The regular expression is compiled with the @code{REG_NEWLINE} flag, so
 that the ^ and $ anchors will match at any newline, not just at the start
@@ -54,13 +54,13 @@ The symbol @code{=>} can be used to indicate that the expression is a
 procedure which will accept the result of a successful regular expression
 match.  E.g.,
 
-@smalllisp
+@lisp
 ("^daemon" => write)
 ("^d(aemon)" => (lambda args (for-each write args)))
 ("^da(em)on" => (lambda (all sub)
                   (write all) (newline)
                   (write sub) (newline)))
-@end smalllisp
+@end lisp
 
 The order of the substrings corresponds to the order in which the
 opening brackets occur.
@@ -135,12 +135,12 @@ expression.
 In the following example, a string will only be matched at the beginning
 of the file:
 
-@smalllisp
+@lisp
 (let ((expect-port (open-input-file "/etc/passwd")))
   (expect
      ((lambda (s eof?) (string=? s "fnord!"))
         (display "Got a nobody user!\n"))))
-@end smalllisp
+@end lisp
 
 The control variables described for @code{expect-strings} also
 influence the behaviour of @code{expect}, with the exception of 
diff --git a/doc/goops/goops-tutorial.texi b/doc/ref/goops-tutorial.texi
index 11155dfae..600be7730 100644
--- a/doc/goops/goops-tutorial.texi
+++ b/doc/ref/goops-tutorial.texi
@@ -1,3 +1,9 @@
+@c -*-texinfo-*-
+@c This is part of the GNU Guile Reference Manual.
+@c Copyright (C)  2008, 2009
+@c   Free Software Foundation, Inc.
+@c See the file guile.texi for copying conditions.
+
 @c Original attribution:
 
 @c
@@ -24,19 +30,33 @@
 @c Guile
 @c @end macro
 
-This is chapter was originally written by Erick Gallesio as an appendix
-for the STk reference manual, and subsequently adapted to @goops{}.
+This section introduces the @goops{} package in more detail.  It was
+originally written by Erick Gallesio as an appendix for the STk
+reference manual, and subsequently adapted to @goops{}.
+
+The procedures and syntax described in this tutorial are provided by
+Guile modules that may need to be imported before being available.
+The main @goops{} module is imported by evaluating:
+
+@lisp
+(use-modules (oop goops))
+@end lisp
+@findex (oop goops)
+@cindex main module
+@cindex loading
+@cindex preparing
 
 @menu
 * Copyright::
-* Intro::                
-* Class definition and instantiation::  
+* Class definition::  
+* Instance creation and slot access::  
+* Slot description::            
 * Inheritance::                 
 * Generic functions::           
 @end menu
 
-@node Copyright, Intro, Tutorial, Tutorial
-@section Copyright
+@node Copyright
+@subsection Copyright
 
 Original attribution:
 
@@ -52,52 +72,13 @@ required for any of the authorized uses.
 This software is provided ``AS IS'' without express or implied
 warranty.
 
-Adapted for use in Guile with the authors permission
-
-@node Intro, Class definition and instantiation, Copyright, Tutorial
-@section Introduction
-
-@goops{} is the object oriented extension to @guile{}. Its
-implementation is derived from @w{STk-3.99.3} by Erick Gallesio and
-version 1.3 of the Gregor Kiczales @cite{Tiny-Clos}.  It is very close
-to CLOS, the Common Lisp Object System (@cite{CLtL2}) but is adapted for
-the Scheme language.
-
-Briefly stated, the @goops{} extension gives the user a full object
-oriented system with multiple inheritance and generic functions with
-multi-method dispatch.  Furthermore, the implementation relies on a true
-meta object protocol, in the spirit of the one defined for CLOS
-(@cite{Gregor Kiczales: A Metaobject Protocol}).
-
-The purpose of this tutorial is to introduce briefly the @goops{}
-package and in no case will it replace the @goops{} reference manual
-(which needs to be urgently written now@ @dots{}).
+Adapted for use in Guile with the author's permission
 
-Note that the operations described in this tutorial resides in modules
-that may need to be imported before being available.  The main module is
-imported by evaluating:
-
-@lisp
-(use-modules (oop goops))
-@end lisp
-@findex (oop goops)
-@cindex main module
-@cindex loading
-@cindex preparing
-
-@node Class definition and instantiation, Inheritance, Intro, Tutorial
-@section Class definition and instantiation
-
-@menu
-* Class definition::            
-@end menu
-
-@node Class definition,  , Class definition and instantiation, Class definition and instantiation
+@node Class definition
 @subsection Class definition
 
-A new class is defined with the @code{define-class}@footnote{Don't
-forget to import the @code{(oop goops)} module} macro. The syntax of
-@code{define-class} is close to CLOS @code{defclass}:
+A new class is defined with the @code{define-class} macro. The syntax
+of @code{define-class} is close to CLOS @code{defclass}:
 
 @findex define-class
 @cindex class
@@ -107,105 +88,36 @@ forget to import the @code{(oop goops)} module} macro. The syntax of
    @var{class-option} @dots{})
 @end lisp
 
-Class options will not be discussed in this tutorial.  The list of
-@var{superclass}es specifies which classes to inherit properties from
-@var{class} (see @ref{Inheritance} for more details).  A
-@var{slot-description} gives the name of a slot and, eventually, some
-``properties'' of this slot (such as its initial value, the function
-which permit to access its value, @dots{}). Slot descriptions will be
-discussed in @ref{Slot description}.
+@var{class} is the class being defined.  The list of
+@var{superclass}es specifies which existing classes, if any, to
+inherit slots and properties from.  Each @var{slot-description} gives
+the name of a slot and optionally some ``properties'' of this slot;
+for example its initial value, the name of a function which will
+access its value, and so on.  Slot descriptions and inheritance are
+discussed more below.  For class options, see @ref{Class Options}.
 @cindex slot
 
-As an example, let us define a type for representation of complex
-numbers in terms of real numbers. This can be done with the following
-class definition:
+As an example, let us define a type for representing a complex number
+in terms of two real numbers.@footnote{Of course Guile already
+provides complex numbers, and @code{<complex>} is in fact a predefined
+class in GOOPS; but the definition here is still useful as an
+example.}  This can be done with the following class definition:
 
 @lisp
-(define-class  <complex> (<number>)
+(define-class <my-complex> (<number>)
    r i)
 @end lisp
 
-This binds the variable @code{<complex>}@footnote{@code{<complex>} is in
-fact a builtin class in GOOPS.  Because of this, GOOPS will create a new
-class.  The old class will still serve as the type for Guile's native
-complex numbers.} to a new class whose instances contain two
-slots. These slots are called @code{r} an @code{i} and we suppose here
-that they contain respectively the real part and the imaginary part of a
-complex number. Note that this class inherits from @code{<number>} which
-is a pre-defined class.  (@code{<number>} is the direct super class of
-the pre-defined class @code{<complex>} which, in turn, is the super
-class of @code{<real>} which is the super of
-@code{<integer>}.)@footnote{With the new definition of @code{<complex>},
-a @code{<real>} is not a @code{<complex>} since @code{<real>} inherits
-from @code{ <number>} rather than @code{<complex>}. In practice,
-inheritance could be modified @emph{a posteriori}, if needed. However,
-this necessitates some knowledge of the meta object protocol and it will
-not be shown in this document}.
-
-@node Inheritance, Generic functions, Class definition and instantiation, Tutorial
-@section Inheritance
-@c \label{inheritance}
-
-@menu
-* Class hierarchy and inheritance of slots::  
-* Instance creation and slot access::  
-* Slot description::            
-* Class precedence list::       
-@end menu
-
-@node Class hierarchy and inheritance of slots, Instance creation and slot access, Inheritance, Inheritance
-@subsection Class hierarchy and inheritance of slots
-Inheritance is specified upon class definition. As said in the
-introduction, @goops{} supports multiple inheritance.  Here are some
-class definitions:
-
-@lisp
-(define-class A () a)
-(define-class B () b)
-(define-class C () c)
-(define-class D (A B) d a)
-(define-class E (A C) e c)
-(define-class F (D E) f)
-@end lisp
-
-@code{A}, @code{B}, @code{C} have a null list of super classes. In this
-case, the system will replace it by the list which only contains
-@code{<object>}, the root of all the classes defined by
-@code{define-class}. @code{D}, @code{E}, @code{F} use multiple
-inheritance: each class inherits from two previously defined classes.
-Those class definitions define a hierarchy which is shown in Figure@ 1.
-In this figure, the class @code{<top>} is also shown; this class is the
-super class of all Scheme objects. In particular, @code{<top>} is the
-super class of all standard Scheme types.
-
-@example
-@group
-@image{hierarchy}
-@center @emph{Fig 1: A class hierarchy}
-@iftex
-@emph{(@code{<complex>} which is the direct subclass of @code{<number>}
-and the direct superclass of @code{<real>} has been omitted in this
-figure.)}
-@end iftex
-@end group
-@end example
-
-The set of slots of a given class is calculated by taking the union of the
-slots of all its super class. For instance, each instance of the class
-D, defined before will have three slots (@code{a}, @code{b} and
-@code{d}). The slots of a class can be obtained by the @code{class-slots}
-primitive.  For instance,
-
-@lisp
-(class-slots A) @result{} ((a))
-(class-slots E) @result{} ((a) (e) (c))
-(class-slots F) @result{} ((e) (c) (b) (d) (a) (f))
-@c used to be ((d) (a) (b) (c) (f))
-@end lisp
-
-@emph{Note: } The order of slots is not significant.
+This binds the variable @code{<my-complex>} to a new class whose
+instances will contain two slots.  These slots are called @code{r} and
+@code{i} and will hold the real and imaginary parts of a complex
+number. Note that this class inherits from @code{<number>}, which is a
+predefined class.@footnote{@code{<number>} is the direct superclass of
+the predefined class @code{<complex>}; @code{<complex>} is the
+superclass of @code{<real>}, and @code{<real>} is the superclass of
+@code{<integer>}.}
 
-@node Instance creation and slot access, Slot description, Class hierarchy and inheritance of slots, Inheritance
+@node Instance creation and slot access
 @subsection Instance creation and slot access
 
 Creation of an instance of a previously defined
@@ -218,16 +130,16 @@ slots of the newly created instance. For instance, the following form
 @findex make
 @cindex instance
 @lisp
-(define c (make <complex>))
+(define c (make <my-complex>))
 @end lisp
 
-will create a new @code{<complex>} object and will bind it to the @code{c}
+@noindent
+will create a new @code{<my-complex>} object and will bind it to the @code{c}
 Scheme variable.
 
 Accessing the slots of the new complex number can be done with the
-@code{slot-ref} and the @code{slot-set!}  primitives. @code{Slot-set!}
-primitive permits to set the value of an object slot and @code{slot-ref}
-permits to get its value.
+@code{slot-ref} and the @code{slot-set!}  primitives. @code{slot-set!}
+sets the value of an object slot and @code{slot-ref} retrieves it.
 
 @findex slot-set!
 @findex slot-ref
@@ -250,52 +162,60 @@ First load the module @code{(oop goops describe)}:
 @code{(use-modules (oop goops describe))}
 @end example
 
-The expression
+@noindent
+Then the expression
 
-@smalllisp
+@lisp
 (describe c)
-@end smalllisp
+@end lisp
 
-will now print the following information on the standard output:
+@noindent
+will print the following information on the standard output:
 
-@lisp
-#<<complex> 401d8638> is an instance of class <complex>
+@smalllisp
+#<<my-complex> 401d8638> is an instance of class <my-complex>
 Slots are: 
      r = 10
      i = 3
-@end lisp
+@end smalllisp
 
-@node Slot description, Class precedence list, Instance creation and slot access, Inheritance
+@node Slot description
 @subsection Slot description
 @c \label{slot-description}
 
-When specifying a slot, a set of options can be given to the
-system. Each option is specified with a keyword. The list of authorized
-keywords is given below:
+When specifying a slot (in a @code{(define-class @dots{})} form),
+various options can be specified in addition to the slot's name.  Each
+option is specified by a keyword.  The list of authorized keywords is
+given below:
 
 @cindex keyword
 @itemize @bullet
 @item
-@code{#:init-value} permits to supply a default value for the slot. This
-default value is obtained by evaluating the form given after the
-@code{#:init-form} in the global environment, at class definition time.
+@code{#:init-value} permits to supply a constant default value for the
+slot.  The value is obtained by evaluating the form given after the
+@code{#:init-value} at class definition time.
 @cindex default slot value
 @findex #:init-value
-@cindex top level environment
+
+@item
+@code{#:init-form} specifies a form that, when evaluated, will return
+an initial value for the slot.  The form is evaluated each time that
+an instance of the class is created, in the lexical environment of the
+containing @code{define-class} expression.
+@cindex default slot value
+@findex #:init-form
 
 @item
 @code{#:init-thunk} permits to supply a thunk that will provide a
-default value for the slot. The value is obtained by evaluating the
-thunk a instance creation time.
-@c CHECKME: in the global environment?
+default value for the slot.  The value is obtained by invoking the
+thunk at instance creation time.
 @findex default slot value
 @findex #:init-thunk
-@cindex top level environment
 
 @item
-@code{#:init-keyword} permits to specify the keyword for initializing a
-slot. The init-keyword may be provided during instance creation (i.e. in
-the @code{make} optional parameter list). Specifying such a keyword
+@code{#:init-keyword} permits to specify a keyword for initializing the
+slot.  The init-keyword may be provided during instance creation (i.e. in
+the @code{make} optional parameter list).  Specifying such a keyword
 during instance initialization will supersede the default slot
 initialization possibly given with @code{#:init-form}.
 @findex #:init-keyword
@@ -361,11 +281,11 @@ and @code{#:slot-set!} options. See the example below.
 @end itemize
 @end itemize
 
-To illustrate slot description, we shall redefine the @code{<complex>} class 
+To illustrate slot description, we shall redefine the @code{<my-complex>} class 
 seen before. A definition could be:
 
 @lisp
-(define-class <complex> (<number>) 
+(define-class <my-complex> (<number>) 
    (r #:init-value 0 #:getter get-r #:setter set-r! #:init-keyword #:r)
    (i #:init-value 0 #:getter get-i #:setter set-i! #:init-keyword #:i))
 @end lisp
@@ -378,11 +298,11 @@ functions @code{get-r} and @code{set-r!} (resp. @code{get-i} and
 the @code{r} (resp. @code{i}) slot.
 
 @lisp
-(define c1 (make <complex> #:r 1 #:i 2))
+(define c1 (make <my-complex> #:r 1 #:i 2))
 (get-r c1) @result{} 1
 (set-r! c1 12)
 (get-r c1) @result{} 12
-(define c2 (make <complex> #:r 2))
+(define c2 (make <my-complex> #:r 2))
 (get-r c2) @result{} 2
 (get-i c2) @result{} 0
 @end lisp
@@ -390,12 +310,12 @@ the @code{r} (resp. @code{i}) slot.
 Accessors provide an uniform access for reading and writing an object
 slot.  Writing a slot is done with an extended form of @code{set!}
 which is close to the Common Lisp @code{setf} macro. So, another
-definition of the previous @code{<complex>} class, using the
+definition of the previous @code{<my-complex>} class, using the
 @code{#:accessor} option, could be:
 
 @findex set!
 @lisp
-(define-class <complex> (<number>) 
+(define-class <my-complex> (<number>) 
    (r #:init-value 0 #:accessor real-part #:init-keyword #:r)
    (i #:init-value 0 #:accessor imag-part #:init-keyword #:i))
 @end lisp
@@ -416,13 +336,13 @@ coordinates as well as with polar coordinates. One solution could be to
 have a definition of complex numbers which uses one particular
 representation and some conversion functions to pass from one
 representation to the other.  A better solution uses virtual slots. A
-complete definition of the @code{<complex>} class using virtual slots is
+complete definition of the @code{<my-complex>} class using virtual slots is
 given in Figure@ 2.
 
 @example
 @group
 @lisp
-(define-class <complex> (<number>)
+(define-class <my-complex> (<number>)
    ;; True slots use rectangular coordinates
    (r #:init-value 0 #:accessor real-part #:init-keyword #:r)
    (i #:init-value 0 #:accessor imag-part #:init-keyword #:i)
@@ -446,7 +366,7 @@ given in Figure@ 2.
                       (slot-set! o 'i (* m (sin a)))))))
 
 @end lisp
-@center @emph{Fig 2: A @code{<complex>} number class definition using virtual slots}
+@center @emph{Fig 2: A @code{<my-complex>} number class definition using virtual slots}
 @end group
 @end example
 
@@ -480,20 +400,21 @@ A more complete example is given below:
 
 @example
 @group
-@lisp
-(define c (make <complex> #:r 12 #:i 20))
+@smalllisp
+(define c (make <my-complex> #:r 12 #:i 20))
 (real-part c) @result{} 12
 (angle c) @result{} 1.03037682652431
 (slot-set! c 'i 10)
 (set! (real-part c) 1)
-(describe c) @result{}
-          #<<complex> 401e9b58> is an instance of class <complex>
-          Slots are: 
-               r = 1
-               i = 10
-               m = 10.0498756211209
-               a = 1.47112767430373
-@end lisp
+(describe c)
+@print{}
+#<<my-complex> 401e9b58> is an instance of class <my-complex>
+Slots are: 
+     r = 1
+     i = 10
+     m = 10.0498756211209
+     a = 1.47112767430373
+@end smalllisp
 @end group
 @end example
 
@@ -503,14 +424,75 @@ Scheme primitives.
 
 @lisp
 (define make-rectangular 
-   (lambda (x y) (make <complex> #:r x #:i y)))
+   (lambda (x y) (make <my-complex> #:r x #:i y)))
 
 (define make-polar
-   (lambda (x y) (make <complex> #:magn x #:angle y)))
+   (lambda (x y) (make <my-complex> #:magn x #:angle y)))
+@end lisp
+
+@node Inheritance
+@subsection Inheritance
+@c \label{inheritance}
+
+@menu
+* Class hierarchy and inheritance of slots::  
+* Class precedence list::       
+@end menu
+
+@node Class hierarchy and inheritance of slots
+@subsubsection Class hierarchy and inheritance of slots
+Inheritance is specified upon class definition. As said in the
+introduction, @goops{} supports multiple inheritance.  Here are some
+class definitions:
+
+@lisp
+(define-class A () a)
+(define-class B () b)
+(define-class C () c)
+(define-class D (A B) d a)
+(define-class E (A C) e c)
+(define-class F (D E) f)
 @end lisp
 
-@node Class precedence list,  , Slot description, Inheritance
-@subsection Class precedence list
+@code{A}, @code{B}, @code{C} have a null list of super classes. In this
+case, the system will replace it by the list which only contains
+@code{<object>}, the root of all the classes defined by
+@code{define-class}. @code{D}, @code{E}, @code{F} use multiple
+inheritance: each class inherits from two previously defined classes.
+Those class definitions define a hierarchy which is shown in Figure@ 1.
+In this figure, the class @code{<top>} is also shown; this class is the
+super class of all Scheme objects. In particular, @code{<top>} is the
+super class of all standard Scheme types.
+
+@example
+@group
+@image{hierarchy}
+@center @emph{Fig 1: A class hierarchy}
+@iftex
+@emph{(@code{<complex>} which is the direct subclass of @code{<number>}
+and the direct superclass of @code{<real>} has been omitted in this
+figure.)}
+@end iftex
+@end group
+@end example
+
+The set of slots of a given class is calculated by taking the union of the
+slots of all its super class. For instance, each instance of the class
+D, defined before will have three slots (@code{a}, @code{b} and
+@code{d}). The slots of a class can be obtained by the @code{class-slots}
+primitive.  For instance,
+
+@lisp
+(class-slots A) @result{} ((a))
+(class-slots E) @result{} ((a) (e) (c))
+(class-slots F) @result{} ((e) (c) (b) (d) (a) (f))
+@c used to be ((d) (a) (b) (c) (f))
+@end lisp
+
+@emph{Note: } The order of slots is not significant.
+
+@node Class precedence list
+@subsubsection Class precedence list
 
 A class may have more than one superclass.  @footnote{This section is an
 adaptation of Jeff Dalton's (J.Dalton@@ed.ac.uk) @cite{Brief
@@ -587,8 +569,8 @@ However, this result is not too much readable; using the function
 (map class-name (class-precedence-list B)) @result{} (B <object> <top>) 
 @end lisp
 
-@node Generic functions,  , Inheritance, Tutorial
-@section Generic functions
+@node Generic functions
+@subsection Generic functions
 
 @menu
 * Generic functions and methods::  
@@ -596,8 +578,8 @@ However, this result is not too much readable; using the function
 * Example::                     
 @end menu
 
-@node Generic functions and methods, Next-method, Generic functions, Generic functions
-@subsection Generic functions and methods
+@node Generic functions and methods
+@subsubsection Generic functions and methods
 
 @c \label{gf-n-methods}
 Neither @goops{} nor CLOS use the message mechanism for methods as most
@@ -687,8 +669,8 @@ In this case,
 (G 'a 1)  @result{} top-number
 @end lisp
 
-@node Next-method, Example, Generic functions and methods, Generic functions
-@subsection Next-method
+@node Next-method
+@subsubsection Next-method
 
 When you call a generic function, with a particular set of arguments,
 GOOPS builds a list of all the methods that are applicable to those
@@ -737,16 +719,16 @@ Number is in range
 lead to an infinite recursion, but this consideration is just the same
 as in Scheme code in general.)
 
-@node Example,  , Next-method, Generic functions
-@subsection Example
+@node Example
+@subsubsection Example
 
-In this section we shall continue to define operations on the @code{<complex>}
+In this section we shall continue to define operations on the @code{<my-complex>}
 class defined in Figure@ 2. Suppose that we want to use it to implement 
 complex numbers completely. For instance a definition for the addition of 
 two complexes could be
 
 @lisp
-(define-method (new-+ (a <complex>) (b <complex>))
+(define-method (new-+ (a <my-complex>) (b <my-complex>))
   (make-rectangular (+ (real-part a) (real-part b))
                     (+ (imag-part a) (imag-part b))))
 @end lisp
@@ -758,7 +740,7 @@ addition we can do:
 (define-generic new-+)
 
 (let ((+ +))
-  (define-method (new-+ (a <complex>) (b <complex>))
+  (define-method (new-+ (a <my-complex>) (b <my-complex>))
     (make-rectangular (+ (real-part a) (real-part b))
                       (+ (imag-part a) (imag-part b)))))
 @end lisp
@@ -778,13 +760,13 @@ Figure@ 3.
 
   (define-method (new-+ (a <real>) (b <real>)) (+ a b))
 
-  (define-method (new-+ (a <real>) (b <complex>)) 
+  (define-method (new-+ (a <real>) (b <my-complex>)) 
     (make-rectangular (+ a (real-part b)) (imag-part b)))
 
-  (define-method (new-+ (a <complex>) (b <real>))
+  (define-method (new-+ (a <my-complex>) (b <real>))
     (make-rectangular (+ (real-part a) b) (imag-part a)))
 
-  (define-method (new-+ (a <complex>) (b <complex>))
+  (define-method (new-+ (a <my-complex>) (b <my-complex>))
     (make-rectangular (+ (real-part a) (real-part b))
                       (+ (imag-part a) (imag-part b))))
 
@@ -823,7 +805,7 @@ To terminate our implementation (integration?) of  complex numbers, we can
 redefine standard Scheme predicates in the following manner:
 
 @lisp
-(define-method (complex? c <complex>) #t)
+(define-method (complex? c <my-complex>) #t)
 (define-method (complex? c)           #f)
 
 (define-method (number? n <number>) #t)
diff --git a/doc/goops/goops.texi b/doc/ref/goops.texi
index d6d8e595d..c0a828f71 100644
--- a/doc/goops/goops.texi
+++ b/doc/ref/goops.texi
@@ -1,19 +1,8 @@
-\input texinfo
 @c -*-texinfo-*-
-@c %**start of header
-@setfilename goops.info
-@settitle Goops Manual
-@set goops
-@setchapternewpage odd
-@paragraphindent 0
-@c %**end of header
-
-@set VERSION 0.3
-
-@dircategory The Algorithmic Language Scheme
-@direntry
-* GOOPS: (goops).               The GOOPS reference manual.
-@end direntry
+@c This is part of the GNU Guile Reference Manual.
+@c Copyright (C)  2008, 2009
+@c   Free Software Foundation, Inc.
+@c See the file guile.texi for copying conditions.
 
 @macro goops
 GOOPS
@@ -23,77 +12,8 @@ GOOPS
 Guile
 @end macro
 
-@ifinfo
-This file documents GOOPS, an object oriented extension for Guile.
-
-Copyright (C) 1999, 2000, 2001, 2003, 2006 Free Software Foundation
-
-Permission is granted to make and distribute verbatim copies of
-this manual provided the copyright notice and this permission notice
-are preserved on all copies.
-
-@end ifinfo
-
-@c  This title page illustrates only one of the
-@c  two methods of forming a title page.
-
-@titlepage
-@title Goops Manual
-@subtitle For use with GOOPS @value{VERSION}
-
-@c AUTHORS
-
-@c The GOOPS tutorial was written by Christian Lynbech and Mikael
-@c Djurfeldt, who also wrote GOOPS itself.  The GOOPS reference manual
-@c and MOP documentation were written by Neil Jerram and reviewed by
-@c Mikael Djurfeldt.
-
-@author Christian Lynbech
-@author @email{chl@@tbit.dk}
-@author
-@author Mikael Djurfeldt
-@author @email{djurfeldt@@nada.kth.se}
-@author
-@author Neil Jerram
-@author @email{neil@@ossau.uklinux.net}
-
-@c  The following two commands
-@c  start the copyright page.
-@page
-@vskip 0pt plus 1filll
-Copyright @copyright{} 1999, 2006 Free Software Foundation
-
-Permission is granted to make and distribute verbatim copies of
-this manual provided the copyright notice and this permission notice
-are preserved on all copies.
-
-@end titlepage
-
-@node Top, Introduction, (dir), (dir)
-
-@menu
-* Introduction::
-* Getting Started::
-* Reference Manual::
-* MOP Specification::
-
-* Tutorial::
-
-* Concept Index::
-* Function and Variable Index::
-@end menu
-
-@iftex
-@chapter Preliminaries
-@end iftex
-
-@node Introduction, Getting Started, Top, Top
-@iftex
-@section Introduction
-@end iftex
-@ifnottex
-@chapter Introduction
-@end ifnottex
+@node GOOPS
+@chapter GOOPS
 
 @goops{} is the object oriented extension to @guile{}. Its
 implementation is derived from @w{STk-3.99.3} by Erick Gallesio and
@@ -109,71 +29,58 @@ multi-method dispatch.  Furthermore, the implementation relies on a true
 meta object protocol, in the spirit of the one defined for CLOS
 (@cite{Gregor Kiczales: A Metaobject Protocol}).
 
-@node Getting Started, Reference Manual, Introduction, Top
-@iftex
-@section Getting Started
-@end iftex
-@ifnottex
-@chapter Getting Started
-@end ifnottex
-
 @menu
-* Running GOOPS::
-
-Examples of some basic GOOPS functionality.
-
-* Methods::
-* User-defined types::
-* Asking for the type of an object::
-
-See further in the GOOPS tutorial available in this distribution in
-info (goops.info) and texinfo format.
+* Quick Start::
+* Tutorial::
+* Reference Manual::
+* MOP Specification::
 @end menu
 
-@node Running GOOPS, Methods, Getting Started, Getting Started
-@subsection Running GOOPS
-
-@enumerate
-@item
-Type
-
-@smalllisp
-guile-oops
-@end smalllisp
+@node Quick Start
+@section Quick Start
 
-You should now be at the Guile prompt ("guile> ").
+To give an immediate flavour of what GOOPS can do, here is a very
+brief introduction to its main operations.
 
-@item
-Type
+To start using GOOPS, load the @code{(oop goops)} module:
 
-@smalllisp
+@lisp
 (use-modules (oop goops))
-@end smalllisp
-
-to load GOOPS.  (If your system supports dynamic loading, you
-should be able to do this not only from `guile-oops' but from an
-arbitrary Guile interpreter.)
-@end enumerate
+@end lisp
 
 We're now ready to try some basic GOOPS functionality.
 
-@node Methods, User-defined types, Running GOOPS, Getting Started
+@menu
+* Methods::
+* User-defined types::
+* Asking for the type of an object::
+@end menu
+
+@node Methods
 @subsection Methods
 
-@smalllisp
-@group
+A GOOPS method is like a Scheme procedure except that it is
+specialized for a particular set of argument types.
+
+@lisp
 (define-method (+ (x <string>) (y <string>))
   (string-append x y))
 
-(+ 1 2) --> 3
-(+ "abc" "de") --> "abcde"
-@end group
-@end smalllisp
+(+ "abc" "de") @result{} "abcde"
+@end lisp
 
-@node User-defined types, Asking for the type of an object, Methods, Getting Started
+If @code{+} is used with arguments that do not match the method's
+types, Guile falls back to using the normal Scheme @code{+} procedure.
+
+@lisp
+(+ 1 2) @result{} 3
+@end lisp
+
+
+@node User-defined types
 @subsection User-defined types
 
-@smalllisp
+@lisp
 (define-class <2D-vector> ()
   (x #:init-value 0 #:accessor x-component #:init-keyword #:x)
   (y #:init-value 0 #:accessor y-component #:init-keyword #:y))
@@ -182,12 +89,11 @@ We're now ready to try some basic GOOPS functionality.
 (use-modules (ice-9 format))
 
 (define-method (write (obj <2D-vector>) port)
-  (display (format #f "<~S, ~S>" (x-component obj) (y-component obj))
-           port))
+  (format port "<~S, ~S>" (x-component obj) (y-component obj)))
 
 (define v (make <2D-vector> #:x 3 #:y 4))
 
-v --> <3, 4>
+v @result{} <3, 4>
 @end group
 
 @group
@@ -196,24 +102,28 @@ v --> <3, 4>
         #:x (+ (x-component x) (x-component y))
         #:y (+ (y-component x) (y-component y))))
 
-(+ v v) --> <6, 8>
+(+ v v) @result{} <6, 8>
 @end group
-@end smalllisp
+@end lisp
 
-@node Asking for the type of an object, , User-defined types, Getting Started
+@node Asking for the type of an object
 @subsection Types
 
 @example
-(class-of v) --> #<<class> <2D-vector> 40241ac0>
-<2D-vector>  --> #<<class> <2D-vector> 40241ac0>
-(class-of 1) --> #<<class> <integer> 401b2a98>
-<integer>    --> #<<class> <integer> 401b2a98>
+(class-of v) @result{} #<<class> <2D-vector> 40241ac0>
+<2D-vector>  @result{} #<<class> <2D-vector> 40241ac0>
+(class-of 1) @result{} #<<class> <integer> 401b2a98>
+<integer>    @result{} #<<class> <integer> 401b2a98>
 
-(is-a? v <2D-vector>) --> #t
+(is-a? v <2D-vector>) @result{} #t
 @end example
 
-@node Reference Manual, MOP Specification, Getting Started, Top
-@chapter Reference Manual
+@node Tutorial
+@section Tutorial
+@include goops-tutorial.texi
+
+@node Reference Manual
+@section Reference Manual
 
 This chapter is the GOOPS reference manual.  It aims to describe all the
 syntax, procedures, options and associated concepts that a typical
@@ -241,7 +151,7 @@ For a detailed specification of the GOOPS metaobject protocol, see
 @end menu
 
 @node Introductory Remarks
-@section Introductory Remarks
+@subsection Introductory Remarks
 
 GOOPS is an object-oriented programming system based on a ``metaobject
 protocol'' derived from the ones used in CLOS (the Common Lisp Object
@@ -261,19 +171,19 @@ GOOPS' power, by customizing the behaviour of GOOPS itself.
 
 Each of the following sections of the reference manual is arranged
 such that the most basic usage is introduced first, and then subsequent
-subsections discuss the related internal functions and metaobject
+subsubsections discuss the related internal functions and metaobject
 protocols, finishing with a description of how to customize that area of
 functionality.
 
 These introductory remarks continue with a few words about metaobjects
 and the MOP.  Readers who do not want to be bothered yet with the MOP
-and customization could safely skip this subsection on a first reading,
-and should correspondingly skip subsequent subsections that are
+and customization could safely skip this subsubsection on a first reading,
+and should correspondingly skip subsequent subsubsections that are
 concerned with internals and customization.
 
 In general, this reference manual assumes familiarity with standard
 object oriented concepts and terminology.  However, some of the terms
-used in GOOPS are less well known, so the Terminology subsection
+used in GOOPS are less well known, so the Terminology subsubsection
 provides definitions for these terms.
 
 @menu
@@ -282,7 +192,7 @@ provides definitions for these terms.
 @end menu
 
 @node Metaobjects and the Metaobject Protocol
-@subsection Metaobjects and the Metaobject Protocol
+@subsubsection Metaobjects and the Metaobject Protocol
 
 The conceptual building blocks of GOOPS are classes, slot definitions,
 instances, generic functions and methods.  A class is a grouping of
@@ -377,7 +287,7 @@ Each subsequent section of the reference manual covers a particular area
 of GOOPS functionality, and describes the generic functions that are
 relevant for customization of that area.
 
-We conclude this subsection by emphasizing a point that may seem
+We conclude this subsubsection by emphasizing a point that may seem
 obvious, but contrasts with the corresponding situation in some other
 MOP implementations, such as CLOS.  The point is simply that an
 identifier which represents a GOOPS class or generic function is a
@@ -392,7 +302,7 @@ class names), but it is worth noting that GOOPS conforms fully to this
 Schemely principle.
 
 @node Terminology
-@subsection Terminology
+@subsubsection Terminology
 
 It is assumed that the reader is already familiar with standard object
 orientation concepts such as classes, objects/instances,
@@ -403,14 +313,7 @@ This section explains some of the less well known concepts and
 terminology that GOOPS uses, which are assumed by the following sections
 of the reference manual.
 
-@menu
-* Metaclass::
-* Class Precedence List::
-* Accessor::
-@end menu
-
-@node Metaclass
-@subsubsection Metaclass
+@subsubheading Metaclass
 
 A @dfn{metaclass} is the class of an object which represents a GOOPS
 class.  Put more succinctly, a metaclass is a class's class.
@@ -517,8 +420,7 @@ The metaclass of @code{<my-metaclass>} is @code{<class>}.
 @code{<class>}.
 @end itemize
 
-@node Class Precedence List
-@subsubsection Class Precedence List
+@subsubheading Class Precedence List
 
 The @dfn{class precedence list} of a class is the list of all direct and
 indirect superclasses of that class, including the class itself.
@@ -548,8 +450,7 @@ precedence list}.
 ``Class precedence list'' is often abbreviated, in documentation and
 Scheme variable names, to @dfn{cpl}.
 
-@node Accessor
-@subsubsection Accessor
+@subsubheading Accessor
 
 An @dfn{accessor} is a generic function with both reference and setter
 methods.
@@ -583,7 +484,7 @@ be invoked using the generalized @code{set!} syntax, as in:
 @end example
 
 @node Defining New Classes
-@section Defining New Classes
+@subsection Defining New Classes
 
 [ *fixme* Somewhere in this manual there needs to be an introductory
 discussion about GOOPS classes, generic functions and methods, covering
@@ -622,7 +523,7 @@ the discussion there. ]
 @end menu
 
 @node Basic Class Definition
-@subsection Basic Class Definition
+@subsubsection Basic Class Definition
 
 New classes are defined using the @code{define-class} syntax, with
 arguments that specify the classes that the new class should inherit
@@ -651,7 +552,7 @@ keywords and corresponding values.
 @end deffn
 
 The standard GOOPS class and slot options are described in the following
-subsections: see @ref{Class Options} and @ref{Slot Options}.
+subsubsections: see @ref{Class Options} and @ref{Slot Options}.
 
 Example 1.  Define a class that combines two pre-existing classes by
 inheritance but adds no new slots.
@@ -681,13 +582,13 @@ customized via an application-defined metaclass.
 @end example
 
 @node Class Options
-@subsection Class Options
+@subsubsection Class Options
 
 @deffn {class option} #:metaclass metaclass
 The @code{#:metaclass} class option specifies the metaclass of the class
 being defined.  @var{metaclass} must be a class that inherits from
 @code{<class>}.  For an introduction to the use of metaclasses, see
-@ref{Metaobjects and the Metaobject Protocol} and @ref{Metaclass}.
+@ref{Metaobjects and the Metaobject Protocol} and @ref{Terminology}.
 
 If the @code{#:metaclass} option is absent, GOOPS reuses or constructs a
 metaclass for the new class by calling @code{ensure-metaclass}
@@ -714,7 +615,7 @@ environment defaults to the top-level environment in which the
 @end deffn
 
 @node Slot Options
-@subsection Slot Options
+@subsubsection Slot Options
 
 @deffn {slot option} #:allocation allocation
 The @code{#:allocation} option tells GOOPS how to allocate storage for
@@ -917,7 +818,7 @@ classes.
 @end deffn
 
 @node Class Definition Internals
-@subsection Class Definition Internals
+@subsubsection Class Definition Internals
 
 Implementation notes: @code{define-class} expands to an expression which
 
@@ -1030,7 +931,7 @@ class object, are described in @ref{Customizing Instance Creation},
 which covers the creation and initialization of instances in general.
 
 @node Customizing Class Definition
-@subsection Customizing Class Definition
+@subsubsection Customizing Class Definition
 
 During the initialization of a new class, GOOPS calls a number of generic
 functions with the newly allocated class instance as the first
@@ -1124,7 +1025,8 @@ allocation to do this.
 
 (let ((batch-allocation-count 0)
       (batch-get-n-set #f))
-  (define-method (compute-get-n-set (class <batched-allocation-metaclass>) s)
+  (define-method (compute-get-n-set
+                     (class <batched-allocation-metaclass>) s)
     (case (slot-definition-allocation s)
       ((#:batched)
        ;; If we've already used the same slot storage for 10 instances,
@@ -1165,7 +1067,7 @@ typically it would perform additional class initialization steps before
 and/or after calling @code{(next-method)} for the standard behaviour.
 
 @node STKlos Compatibility
-@subsection STKlos Compatibility
+@subsubsection STKlos Compatibility
 
 If the STKlos compatibility module is loaded, @code{define-class} is
 overwritten by a STKlos-specific definition; the standard GOOPS
@@ -1178,7 +1080,7 @@ definition of @code{define-class} remains available in
 @end deffn
 
 @node Creating Instances
-@section Creating Instances
+@subsection Creating Instances
 
 @menu
 * Basic Instance Creation::
@@ -1186,7 +1088,7 @@ definition of @code{define-class} remains available in
 @end menu
 
 @node Basic Instance Creation
-@subsection Basic Instance Creation
+@subsubsection Basic Instance Creation
 
 To create a new instance of any GOOPS class, use the generic function
 @code{make} or @code{make-instance}, passing the required class and any
@@ -1223,7 +1125,7 @@ instance's class.  Any unprocessed keyword value pairs are ignored.
 @end deffn
 
 @node Customizing Instance Creation
-@subsection Customizing Instance Creation
+@subsubsection Customizing Instance Creation
 
 @code{make} itself is a generic function.  Hence the @code{make}
 invocation itself can be customized in the case where the new instance's
@@ -1290,7 +1192,7 @@ and closures in the slot definitions, it is neater to write an
 and initializes all the dependent slot values according to the results.
 
 @node Accessing Slots
-@section Accessing Slots
+@subsection Accessing Slots
 
 The definition of a slot contains at the very least a slot name, and may
 also contain various slot options, including getter, setter and/or
@@ -1298,7 +1200,7 @@ accessor functions for the slot.
 
 It is always possible to access slots by name, using the various
 ``slot-ref'' and ``slot-set!'' procedures described in the following
-subsections.  For example,
+subsubsections.  For example,
 
 @example
 (define-class <my-class> ()      ;; Define a class with slots
@@ -1354,7 +1256,7 @@ closures, see @ref{Customizing Class Definition,, compute-get-n-set}.)
 @end menu
 
 @node Instance Slots
-@subsection Instance Slots
+@subsubsection Instance Slots
 
 Any slot, regardless of its allocation, can be queried, referenced and
 set using the following four primitive procedures.
@@ -1451,7 +1353,7 @@ slot-missing}).
 @end deffn
 
 @node Class Slots
-@subsection Class Slots
+@subsubsection Class Slots
 
 Slots whose allocation is per-class rather than per-instance can be
 referenced and set without needing to specify any particular instance.
@@ -1479,7 +1381,7 @@ function with arguments @var{class} and @var{slot-name}.
 @end deffn
 
 @node Handling Slot Access Errors
-@subsection Handling Slot Access Errors
+@subsubsection Handling Slot Access Errors
 
 GOOPS calls one of the following generic functions when a ``slot-ref''
 or ``slot-set!'' call specifies a non-existent slot name, or tries to
@@ -1510,7 +1412,7 @@ message.
 @end deffn
 
 @node Creating Generic Functions
-@section Creating Generic Functions
+@subsection Creating Generic Functions
 
 A generic function is a collection of methods, with rules for
 determining which of the methods should be applied for any given
@@ -1526,7 +1428,7 @@ GOOPS represents generic functions as metaobjects of the class
 @end menu
 
 @node Basic Generic Function Creation
-@subsection Basic Generic Function Creation
+@subsubsection Basic Generic Function Creation
 
 The following forms may be used to bind a variable to a generic
 function.  Depending on that variable's pre-existing value, the generic
@@ -1586,20 +1488,20 @@ This can be resolved automagically with the duplicates handler
 @code{merge-generics} which gives the module system license to merge
 all generic functions sharing a common name:
 
-@smalllisp
+@lisp
 (define-module (math 2D-vectors)
-  :use-module (oop goops)
-  :export (x y ...))
+  #:use-module (oop goops)
+  #:export (x y ...))
 		  
 (define-module (math 3D-vectors)
-  :use-module (oop goops)
-  :export (x y z ...))
+  #:use-module (oop goops)
+  #:export (x y z ...))
 
 (define-module (my-module)
-  :use-module (math 2D-vectors)
-  :use-module (math 3D-vectors)
-  :duplicates merge-generics)
-@end smalllisp
+  #:use-module (math 2D-vectors)
+  #:use-module (math 3D-vectors)
+  #:duplicates merge-generics)
+@end lisp
 
 The generic function @code{x} in @code{(my-module)} will now share
 methods with @code{x} in both imported modules.
@@ -1629,14 +1531,14 @@ Sharing is dynamic, so that adding new methods to a descendant implies
 adding it to the ancestor.
 
 If duplicates checking is desired in the above example, the following
-form of the @code{:duplicates} option can be used instead:
+form of the @code{#:duplicates} option can be used instead:
 
-@smalllisp
-  :duplicates (merge-generics check)
-@end smalllisp
+@lisp
+  #:duplicates (merge-generics check)
+@end lisp
 
 @node Generic Function Internals
-@subsection Generic Function Internals
+@subsubsection Generic Function Internals
 
 @code{define-generic} calls @code{ensure-generic} to upgrade a
 pre-existing procedure value, or @code{make} with metaclass
@@ -1705,7 +1607,7 @@ accessor, passing the setter generic function as the value of the
 @code{#:setter} keyword.
 
 @node Extending Guiles Primitives
-@subsection Extending Guile's Primitives
+@subsubsection Extending Guile's Primitives
 
 When GOOPS is loaded, many of Guile's primitive procedures can be
 extended by giving them a generic function definition that operates
@@ -1752,7 +1654,7 @@ integrated into the core of Guile.  Consequently, the
 procedures described in this section may disappear as well.
 
 @node Adding Methods to Generic Functions
-@section Adding Methods to Generic Functions
+@subsection Adding Methods to Generic Functions
 
 @menu
 * Basic Method Definition::
@@ -1760,7 +1662,7 @@ procedures described in this section may disappear as well.
 @end menu
 
 @node Basic Method Definition
-@subsection Basic Method Definition
+@subsubsection Basic Method Definition
 
 To add a method to a generic function, use the @code{define-method} form.
 
@@ -1819,7 +1721,7 @@ invocation error handling, and generic function invocation in general,
 see @ref{Invoking Generic Functions}.
 
 @node Method Definition Internals
-@subsection Method Definition Internals
+@subsubsection Method Definition Internals
 
 @code{define-method}
 
@@ -1906,7 +1808,7 @@ function.
 @end deffn
 
 @node Invoking Generic Functions
-@section Invoking Generic Functions
+@subsection Invoking Generic Functions
 
 When a variable with a generic function definition appears as the first
 element of a list that is being evaluated, the Guile evaluator tries
@@ -1928,7 +1830,7 @@ may be applied subsequently if a method that is being applied calls
 @end menu
 
 @node Determining Which Methods to Apply
-@subsection Determining Which Methods to Apply
+@subsubsection Determining Which Methods to Apply
 
 [ *fixme*  Sorry - this is the area of GOOPS that I understand least of
 all, so I'm afraid I have to pass on this section.  Would some other
@@ -1959,7 +1861,7 @@ kind person consider filling it in? ]
 @end deffn
 
 @node Handling Invocation Errors
-@subsection Handling Invocation Errors
+@subsubsection Handling Invocation Errors
 
 @deffn generic no-method
 @deffnx method no-method (gf <generic>) args
@@ -1987,7 +1889,7 @@ default method calls @code{goops-error} with an appropriate message.
 @end deffn
 
 @node Redefining a Class
-@section Redefining a Class
+@subsection Redefining a Class
 
 Suppose that a class @code{<my-class>} is defined using @code{define-class}
 (@pxref{Basic Class Definition,, define-class}), with slots that have
@@ -2002,7 +1904,7 @@ make}).  What then happens if @code{<my-class>} is redefined by calling
 @end menu
 
 @node Default Class Redefinition Behaviour
-@subsection Default Class Redefinition Behaviour
+@subsubsection Default Class Redefinition Behaviour
 
 GOOPS' default answer to this question is as follows.
 
@@ -2055,7 +1957,7 @@ Also bear in mind that, like most of GOOPS' default behaviour, it can
 be customized@dots{}
 
 @node Customizing Class Redefinition
-@subsection Customizing Class Redefinition
+@subsubsection Customizing Class Redefinition
 
 When @code{define-class} notices that a class is being redefined,
 it constructs the new class metaobject as usual, and then invokes the
@@ -2092,7 +1994,8 @@ is specialized for this metaclass:
 @example
 (define-class <can-be-nameless> (<class>))
 
-(define-method (class-redefinition (old <can-be-nameless>) (new <class>))
+(define-method (class-redefinition (old <can-be-nameless>)
+                                   (new <class>))
   new)
 @end example
 
@@ -2119,7 +2022,7 @@ generic functions, and so on@dots{}  The detailed protocol for all of these
 is described in @ref{MOP Specification}.
 
 @node Changing the Class of an Instance
-@section Changing the Class of an Instance
+@subsection Changing the Class of an Instance
 
 You can change the class of an existing instance by invoking the
 generic function @code{change-class} with two arguments: the instance
@@ -2158,7 +2061,7 @@ invokes the @code{change-class} generic function for each existing
 instance of the redefined class.
 
 @node Introspection
-@section Introspection
+@subsection Introspection
 
 @dfn{Introspection}, also known as @dfn{reflection}, is the name given
 to the ability to obtain information dynamically about GOOPS metaobjects.
@@ -2197,7 +2100,7 @@ GOOPS equivalents --- to be obtained dynamically, at run time.
 @end menu
 
 @node Classes
-@subsection Classes
+@subsubsection Classes
 
 @deffn {primitive procedure} class-name class
 Return the name of class @var{class}.
@@ -2257,7 +2160,7 @@ Return a list of all methods that use @var{class} or a subclass of
 @end deffn
 
 @node Slots
-@subsection Slots
+@subsubsection Slots
 
 @deffn procedure class-slot-definition class slot-name
 Return the slot definition for the slot named @var{slot-name} in class
@@ -2338,7 +2241,7 @@ see @ref{Slot Options,, init-value}.
 @end deffn
 
 @node Instances
-@subsection Instances
+@subsubsection Instances
 
 @deffn {primitive procedure} class-of value
 Return the GOOPS class of any Scheme @var{value}.
@@ -2359,7 +2262,7 @@ Implementation notes: @code{is-a?} uses @code{class-of} and
 @var{object}.
 
 @node Generic Functions
-@subsection Generic Functions
+@subsubsection Generic Functions
 
 @deffn {primitive procedure} generic-function-name gf
 Return the name of generic function @var{gf}.
@@ -2371,7 +2274,7 @@ This is the value of the @var{gf} metaobject's @code{methods} slot.
 @end deffn
 
 @node Generic Function Methods
-@subsection Generic Function Methods
+@subsubsection Generic Function Methods
 
 @deffn {primitive procedure} method-generic-function method
 Return the generic function that @var{method} belongs to.
@@ -2409,18 +2312,18 @@ Return an expression that prints to show the definition of method
 @end deffn
 
 @node Miscellaneous Functions
-@section Miscellaneous Functions
+@subsection Miscellaneous Functions
 
 @menu
 * Administrative Functions::
-* Error Handling::
+* GOOPS Error Handling::
 * Object Comparisons::
 * Cloning Objects::
 * Write and Display::
 @end menu
 
 @node Administrative Functions
-@subsection Administration Functions
+@subsubsection Administration Functions
 
 This section describes administrative, non-technical GOOPS functions.
 
@@ -2428,8 +2331,8 @@ This section describes administrative, non-technical GOOPS functions.
 Return the current GOOPS version as a string, for example ``0.2''.
 @end deffn
 
-@node Error Handling
-@subsection Error Handling
+@node GOOPS Error Handling
+@subsubsection Error Handling
 
 The procedure @code{goops-error} is called to raise an appropriate error
 by the default methods of the following generic functions:
@@ -2464,7 +2367,7 @@ as done by @code{scm-error}.
 @end deffn
 
 @node Object Comparisons
-@subsection Object Comparisons
+@subsubsection Object Comparisons
 
 @deffn generic eqv?
 @deffnx method eqv? ((x <top>) (y <top>))
@@ -2493,7 +2396,7 @@ and the Guile reference manual.
 @end deffn
 
 @node Cloning Objects
-@subsection Cloning Objects
+@subsubsection Cloning Objects
 
 @deffn generic shallow-clone
 @deffnx method shallow-clone (self <object>)
@@ -2514,7 +2417,7 @@ or by reference.
 @end deffn
 
 @node Write and Display
-@subsection Write and Display
+@subsubsection Write and Display
 
 @deffn {primitive generic} write object port
 @deffnx {primitive generic} display object port
@@ -2542,8 +2445,8 @@ methods - instances of the class @code{<method>}.
 as the Guile primitive @code{write} and @code{display} functions.
 @end deffn
 
-@node MOP Specification, Tutorial, Reference Manual, Top
-@chapter MOP Specification
+@node MOP Specification
+@section MOP Specification
 
 For an introduction to metaobjects and the metaobject protocol,
 see @ref{Metaobjects and the Metaobject Protocol}.
@@ -2598,7 +2501,7 @@ what the caller expects to get as the applied method's return value.
 @end menu
 
 @node Class Definition
-@section Class Definition
+@subsection Class Definition
 
 @code{define-class} (syntax)
 
@@ -2731,7 +2634,7 @@ or @code{#:accessor} option.
 @end itemize
 
 @node Instance Creation
-@section Instance Creation
+@subsection Instance Creation
 
 @code{make <class> . @var{initargs}} (method)
 
@@ -2752,13 +2655,13 @@ return value is ignored.
 @end itemize
 
 @node Class Redefinition
-@section Class Redefinition
+@subsection Class Redefinition
 
 The default @code{class-redefinition} method, specialized for classes
 with the default metaclass @code{<class>}, has the following internal
 protocol.
 
-@code{class-redefinition @var{(old <class>)} @var{(new <class>)}}
+@code{class-redefinition (@var{old <class>}) (@var{new <class>})}
 (method)
 
 @itemize @bullet
@@ -2797,7 +2700,7 @@ to the modified instance, and initializes new slots, as described in
 generic function invocation that can be used to customize the instance
 update algorithm.
 
-@code{change-class @var{(old-instance <object>)} @var{(new <class>)}} (method)
+@code{change-class (@var{old-instance <object>}) (@var{new <class>})} (method)
 
 @itemize @bullet
 @item
@@ -2814,7 +2717,7 @@ nothing.
 @end itemize
 
 @node Method Definition
-@section Method Definition
+@subsection Method Definition
 
 @code{define-method} (syntax)
 
@@ -2842,7 +2745,7 @@ theoretically handle adding methods to further types of target.
 @end itemize
 
 @node Generic Function Invocation
-@section Generic Function Invocation
+@subsection Generic Function Invocation
 
 [ *fixme* Description required here. ]
 
@@ -2885,21 +2788,3 @@ theoretically handle adding methods to further types of target.
 @item
 @code{no-next-method}
 @end itemize
-
-@node Tutorial, Concept Index, MOP Specification, Top
-@chapter Tutorial
-@include goops-tutorial.texi
-
-@node     Concept Index, Function and Variable Index, Tutorial, Top
-@unnumberedsec Concept Index
-
-@printindex cp
-
-@node Function and Variable Index,  , Concept Index, Top
-@unnumberedsec Function and Variable Index
-
-@printindex fn
-
-@summarycontents
-@contents
-@bye
diff --git a/doc/ref/guile.texi b/doc/ref/guile.texi
index 2ae3d6332..332be361b 100644
--- a/doc/ref/guile.texi
+++ b/doc/ref/guile.texi
@@ -4,22 +4,21 @@
 @setfilename guile.info
 @settitle Guile Reference Manual
 @set guile
-@set MANUAL-EDITION 1.1
+@set MANUAL-REVISION 1
 @c %**end of header
 @include version.texi
 @include lib-version.texi
+@include effective-version.texi
 
 @copying
-This reference manual documents Guile, GNU's Ubiquitous Intelligent
-Language for Extensions.  This is edition @value{MANUAL-EDITION}
-corresponding to Guile @value{VERSION}.
+This manual documents Guile version @value{VERSION}.
 
-Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005 Free
+Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2009 Free
 Software Foundation.
 
 Permission is granted to copy, distribute and/or modify this document
 under the terms of the GNU Free Documentation License, Version 1.2 or
-any later version published by the Free Software Foundation; with the
+any later version published by the Free Software Foundation; with
 no Invariant Sections, with the Front-Cover Texts being ``A GNU
 Manual,'' and with the Back-Cover Text ``You are free to copy and
 modify this GNU Manual.''.  A copy of the license is included in the
@@ -137,7 +136,7 @@ x
 @sp 10
 @comment The title is printed in a large font.
 @title Guile Reference Manual
-@subtitle Edition @value{MANUAL-EDITION}, for use with Guile @value{VERSION}
+@subtitle Edition @value{EDITION}, revision @value{MANUAL-REVISION}, for use with Guile @value{VERSION}
 @c @subtitle $Id: guile.texi,v 1.49 2008-03-19 22:51:23 ossau Exp $
 
 @c See preface.texi for the list of authors
@@ -177,11 +176,14 @@ x
 
 * Guile Modules::
 
+* GOOPS::
+
+* Guile Implementation::
+
 * Autoconf Support::
 
 Appendices
 
-* Data Representation::             All the details.
 * GNU Free Documentation License::  The license of this manual.
 
 Indices
@@ -252,7 +254,9 @@ different ways to design a program around Guile, or how to embed Guile
 into existing programs.
 
 There is also a pedagogical yet detailed explanation of how the data
-representation of Guile is implemented, @xref{Data Representation}.
+representation of Guile is implemented, see @ref{Data Representation in
+Scheme} and @ref{The Libguile Runtime Environment}.
+
 You don't need to know the details given there to use Guile from C,
 but they are useful when you want to modify Guile itself or when you
 are just curious about how it is all done.
@@ -298,7 +302,7 @@ available through both Scheme and C interfaces.
 * Binding Constructs::          Definitions and variable bindings.
 * Control Mechanisms::          Controlling the flow of program execution.
 * Input and Output::            Ports, reading and writing.
-* Read/Load/Eval::              Reading and evaluating Scheme code.
+* Read/Load/Eval/Compile::      Reading and evaluating Scheme code.
 * Memory Management::           Memory management and garbage collection.
 * Objects::                     Low level object orientation support.
 * Modules::                     Designing reusable code libraries.
@@ -362,9 +366,47 @@ available through both Scheme and C interfaces.
 @include scsh.texi
 @include scheme-debugging.texi
 
-@include autoconf.texi
+@include goops.texi
+
+@node Guile Implementation
+@chapter Guile Implementation
+
+At some point, after one has been programming in Scheme for some time,
+another level of Scheme comes into view: its implementation. Knowledge
+of how Scheme can be implemented turns out to be necessary to become
+an expert hacker. As Peter Norvig notes in his retrospective on
+PAIP@footnote{PAIP is the common abbreviation for @cite{Paradigms of
+Artificial Intelligence Programming}, an old but still useful text on
+Lisp. Norvig's retrospective sums up the lessons of PAIP, and can be
+found at @uref{http://norvig.com/Lisp-retro.html}.}, ``The expert Lisp
+programmer eventually develops a good `efficiency model'.''
+
+By this Norvig means that over time, the Lisp hacker eventually
+develops an understanding of how much her code ``costs'' in terms of
+space and time.
 
+This chapter describes Guile as an implementation of Scheme: its
+history, how it represents and evaluates its data, and its compiler.
+This knowledge can help you to make that step from being one who is
+merely familiar with Scheme to being a real hacker.
+
+@menu
+* History::                             A brief history of Guile.
+* Data Representation in Scheme::       Why things aren't just totally
+                                        straightforward, in general terms.
+* The Libguile Runtime Environment::    Low-level details on Guile's C
+                                        runtime library.
+* A Virtual Machine for Guile::         How compiled procedures work.
+* Compiling to the Virtual Machine::    Not as hard as you might think.
+@end menu
+
+@include history.texi
 @include data-rep.texi
+@include vm.texi
+@include compiler.texi
+
+@include autoconf.texi
+
 @include fdl.texi
 
 @iftex
diff --git a/doc/goops/hierarchy.eps b/doc/ref/hierarchy.eps
index 7b1a98605..7b1a98605 100644
--- a/doc/goops/hierarchy.eps
+++ b/doc/ref/hierarchy.eps
diff --git a/doc/goops/hierarchy.pdf b/doc/ref/hierarchy.pdf
index 3a19ba4eb..3a19ba4eb 100644
--- a/doc/goops/hierarchy.pdf
+++ b/doc/ref/hierarchy.pdf
diff --git a/doc/goops/hierarchy.png b/doc/ref/hierarchy.png
index 46f58b051..46f58b051 100644
--- a/doc/goops/hierarchy.png
+++ b/doc/ref/hierarchy.png
diff --git a/doc/goops/hierarchy.txt b/doc/ref/hierarchy.txt
index c7992df7b..c7992df7b 100644
--- a/doc/goops/hierarchy.txt
+++ b/doc/ref/hierarchy.txt
diff --git a/doc/ref/history.texi b/doc/ref/history.texi
new file mode 100644
index 000000000..b14b44923
--- /dev/null
+++ b/doc/ref/history.texi
@@ -0,0 +1,285 @@
+@c -*-texinfo-*-
+@c This is part of the GNU Guile Reference Manual.
+@c Copyright (C)  2008
+@c   Free Software Foundation, Inc.
+@c See the file guile.texi for copying conditions.
+
+@node History
+@section A Brief History of Guile
+
+Guile is an artifact of historical processes, both as code and as a
+community of hackers. It is sometimes useful to know this history when
+hacking the source code, to know about past decisions and future
+directions.
+
+Of course, the real history of Guile is written by the hackers hacking
+and not the writers writing, so we round up the section with a note on
+current status and future directions.
+
+@menu
+* The Emacs Thesis::  
+* Early Days::                  
+* A Scheme of Many Maintainers::  
+* A Timeline of Selected Guile Releases::  
+* Status::
+@end menu
+
+@node The Emacs Thesis
+@subsection The Emacs Thesis
+
+The story of Guile is the story of bringing the development experience
+of Emacs to the mass of programs on a GNU system.
+
+Emacs, when it was first created in its GNU form in 1984, was a new
+take on the problem of ``how to make a program''. The Emacs thesis is
+that it is delightful to create composite programs based on an
+orthogonal kernel written in a low-level language together with a
+powerful, high-level extension language.
+
+Extension languages foster extensible programs, programs which adapt
+readily to different users and to changing times. Proof of this can be
+seen in Emacs' current and continued existence, spanning more than a
+quarter-century.
+
+Besides providing for modification of a program by others, extension
+languages are good for @emph{intension} as well. Programs built in
+``the Emacs way'' are pleasurable and easy for their authors to flesh
+out with the features that they need.
+
+After the Emacs experience was appreciated more widely, a number of
+hackers started to consider how to spread this experience to the rest
+of the GNU system. It was clear that the easiest way to Emacsify a
+program would be to embed a shared language implementation into it.
+
+@node Early Days
+@subsection Early Days
+
+Tom Lord was the first to fully concentrate his efforts on an
+embeddable language runtime, which he named ``GEL'', the GNU Extension
+Language.
+
+GEL was the product of converting SCM, Aubrey Jaffer's implementation
+of Scheme, into something more appropriate to embedding as a library.
+(SCM was itself based on an implementation by George Carrette, SIOD.)
+
+Lord managed to convince Richard Stallman to dub GEL the official
+extension language for the GNU project. It was a natural fit, given
+that Scheme was a cleaner, more modern Lisp than Emacs Lisp. Part of
+the argument was that eventually when GEL became more capable, it
+could gain the ability to execute other languages, especially Emacs
+Lisp.
+
+Due to a naming conflict with another programming language, Jim Blandy
+suggested a new name for GEL: ``Guile''. Besides being a recursive
+acroymn, ``Guile'' craftily follows the naming of its ancestors,
+``Planner'', ``Conniver'', and ``Schemer''. (The latter was truncated
+to ``Scheme'' due to a 6-character file name limit on an old operating
+system.) Finally, ``Guile'' suggests ``guy-ell'', or ``Guy L.
+Steele'', who, together with Gerald Sussman, originally discovered
+Scheme.
+
+Around the same time that Guile (then GEL) was readying itself for
+public release, another extension language was gaining in popularity,
+Tcl. Many developers found advantages in Tcl because of its shell-like
+syntax and its well-developed graphical widgets library, Tk. Also, at
+the time there was a large marketing push promoting Tcl as a
+``universal extension language''.
+
+Richard Stallman, as the primary author of GNU Emacs, had a particular
+vision of what extension languages should be, and Tcl did not seem to
+him to be as capable as Emacs Lisp. He posted a criticism to the
+comp.lang.tcl newsgroup, sparking one of the internet's legendary
+flamewars. As part of these discussions, retrospectively dubbed the
+``Tcl Wars'', he announced the Free Software Foundation's intent to
+promote Guile as the extension language for the GNU project.
+
+It is a common misconception that Guile was created as a reaction to
+Tcl. While it is true that the public announcement of Guile happened
+at the same time as the ``Tcl wars'', Guile was created out of a
+condition that existed outside the polemic. Indeed, the need for a
+powerful language to bridge the gap between extension of existing
+applications and a more fully dynamic programming environment is still
+with us today.
+
+@node A Scheme of Many Maintainers
+@subsection A Scheme of Many Mantainers
+
+Surveying the field, it seems that Scheme implementations correspond
+with their maintainers on an N-to-1 relationship. That is to say, that
+those people that implement Schemes might do so on a number of
+occasions, but that the lifetime of a given Scheme is tied to the
+maintainership of one individual.
+
+Guile is atypical in this regard.
+
+Tom Lord maintaned Guile for its first year and a half or so,
+corresponding to the end of 1994 through the middle of 1996. The
+releases made in this time constitute an arc from SCM as a standalone
+program to Guile as a reusable, embeddable library, but passing
+through a explosion of features: embedded Tcl and Tk, a toolchain for
+compiling and disassembling Java, addition of a C-like syntax,
+creation of a module system, and a start at a rich POSIX interface.
+
+Only some of those features remain in Guile. There were ongoing
+tensions between providing a small, embeddable language, and one which
+had all of the features (e.g. a graphical toolkit) that a modern Emacs
+might need. In the end, as Guile gained in uptake, the development
+team decided to focus on depth, documentation and orthogonality rather
+than on breadth. This has been the focus of Guile ever since, although
+there is a wide range of third-party libraries for Guile.
+
+Jim Blandy presided over that period of stabilization, in the three
+years until the end of 1999, when he too moved on to other projects.
+Since then, Guile has had a group maintainership. The first group was
+Maciej Stachowiak, Mikael Djurfeldt, and Marius Vollmer, with Vollmer
+staying on the longest. By late 2007, Vollmer had mostly moved on to
+other things, so Neil Jerram and Ludovic Courtès stepped up to take on
+the primary maintenance responsibility.
+
+Of course, a large part of the actual work on Guile has come from
+other contributors too numerous to mention, but without whom the world
+would be a poorer place.
+
+@node A Timeline of Selected Guile Releases
+@subsection A Timeline of Selected Guile Releases
+
+@table @asis
+@item guile-i --- 4 February 1995
+SCM, turned into a library.
+
+@item guile-ii --- 6 April 1995
+A low-level module system was added. Tcl/Tk support was added,
+allowing extension of Scheme by Tcl or vice versa. POSIX support was
+improved, and there was an experimental stab at Java integration.
+
+@item guile-iii --- 18 August 1995
+The C-like syntax, ctax, was improved, but mostly this release
+featured a start at the task of breaking Guile into pieces.
+
+@item 1.0 --- 5 January 1997
+@code{#f} was distinguished from @code{'()}. User-level, cooperative
+multi-threading was added. Source-level debugging became more useful,
+and programmer's and user's manuals were begun. The module system
+gained a high-level interface, which is still used today in more or
+less the same form.
+
+@item 1.1 --- 16 May 1997
+@itemx 1.2 --- 24 June 1997
+Support for Tcl/Tk and ctax were split off as separate packages, and
+have remained there since. Guile became more compatible with SCSH, and
+more useful as a UNIX scripting language. Libguile can now be built as
+a shared library, and third-party extensions written in C became
+loadable via dynamic linking.
+
+@item 1.3.0 --- 19 October 1998
+Command-line editing became much more pleasant through the use of the
+readline library. The initial support for internationalization via
+multi-byte strings was removed, and has yet to be added back, though
+UTF-8 hacks are common. Modules gained the ability to have custom
+expanders, which is still used for syntax-case macros. Initial Emacs
+Lisp support landed, ports gained better support for file descriptors,
+and fluids were added.
+
+@item 1.3.2 --- 20 August 1999
+@itemx 1.3.4 --- 25 September 1999
+@itemx 1.4 --- 21 June 2000
+A long list of lispy features were added: hooks, Common Lisp's
+@code{format}, optional and keyword procedure arguments,
+@code{getopt-long}, sorting, random numbers, and many other fixes and
+enhancements. Guile now has an interactive debugger, interactive help,
+and gives better backtraces.
+
+@item 1.6 --- 6 September 2002
+Guile gained support for the R5RS standard, and added a number of SRFI
+modules. The module system was expanded with programmatic support for
+identifier selection and renaming. The GOOPS object system was merged
+into Guile core.
+
+@item 1.8 --- 20 February 2006
+Guile's arbitrary-precision arithmetic switched to use the GMP
+library, and added support for exact rationals. Guile's embedded
+user-space threading was removed in favor of POSIX pre-emptive
+threads, providing true multiprocessing. Gettext support was added,
+and Guile's C API was cleaned up and orthogonalized in a massive way.
+
+@item 2.0 --- thus far, only unstable snapshots available
+A virtual machine was added to Guile, along with the associated
+compiler and toolchain. Support for internationalization was added.
+Running Guile instances became controllable and debuggable from within
+Emacs, via GDS, which was also backported to 1.8.5. An SRFI-18
+interface to multithreading was added, including thread cancellation.
+@end table
+
+@node Status
+@subsection Status, or: Your Help Needed
+
+Guile has achieved much of what it set out to achieve, but there is
+much remaining to do.
+
+There is still the old problem of bringing existing applications into
+a more Emacs-like experience. Guile has had some successes in this
+respect, but still most applications in the GNU system are without
+Guile integration.
+
+Getting Guile to those applications takes an investment, the
+``hacktivation energy'' needed to wire Guile into a program that only
+pays off once it is good enough to enable new kinds of behavior. This
+would be a great way for new hackers to contribute: take an
+application that you use and that you know well, think of something
+that it can't yet do, and figure out a way to integrate Guile and
+implement that task in Guile.
+
+With time, perhaps this exposure can reverse itself, whereby programs
+can run under Guile instead of vice versa, eventually resulting in the
+Emacsification of the entire GNU system. Indeed, this is the reason
+for the naming of the many Guile modules that live in the @code{ice-9}
+namespace, a nod to the fictional substance in Kurt Vonnegut's
+novel, Cat's Cradle, capable of acting as a seed crystal to
+crystallize the mass of software.
+
+Implicit to this whole discussion is the idea that dynamic languages
+are somehow better than languages like C. While languages like C have
+their place, Guile's take on this question is that yes, Scheme is more
+expressive than C, and more fun to write. This realization carries an
+imperative with it to write as much code in Scheme as possible rather
+than in other languages.
+
+These days it is possible to write extensible applications almost
+entirely from high-level languages, through byte-code and native
+compilation, speed gains in the underlying hardware, and foreign call
+interfaces in the high-level language. Smalltalk systems are like
+this, as are Common Lisp-based systems. While there already are a
+number of pure-Guile applications out there, users still need to drop
+down to C for some tasks: interfacing to system libraries that don't
+have prebuilt Guile interfaces, and for some tasks requiring high
+performance.
+
+The addition of the virtual machine in Guile 2.0, together with the
+compiler infrastructure, should go a long way to addressing the speed
+issues. But there is much optimization to be done. Interested
+contributors will find lots of delightful low-hanging fruit, from
+simple profile-driven optimization to hacking a just-in-time compiler
+from VM bytecode to native code.
+
+Still, even with an all-Guile application, sometimes you want to
+provide an opportunity for users to extend your program from a
+language with a syntax that is closer to C, or to Python. Another
+interesting idea to consider is compiling e.g. Python to Guile. It's
+not that far-fetched of an idea: see for example IronPython or JRuby.
+
+And then there's Emacs itself. Though there is a somewhat-working
+Emacs Lisp translator for Guile, it cannot yet execute all of Emacs
+Lisp. A serious integration of Guile with Emacs would replace the
+Elisp virtual machine with Guile, and provide the necessary C shims so
+that Guile could emulate Emacs' C API. This would give lots of
+exciting things to Emacs: native threads, a real object system, more
+sophisticated types, cleaner syntax, and access to all of the Guile
+extensions.
+
+Finally, there is another axis of crystallization, the axis between
+different Scheme implementations. Guile does not yet support the
+latest Scheme standard, R6RS, and should do so. Like all standards,
+R6RS is imperfect, but supporting it will allow more code to run on
+Guile without modification, and will allow Guile hackers to produce
+code compatible with other schemes. Help in this regard would be much
+appreciated.
diff --git a/doc/ref/intro.texi b/doc/ref/intro.texi
index a31fe30f8..7e248e0e8 100644
--- a/doc/ref/intro.texi
+++ b/doc/ref/intro.texi
@@ -80,6 +80,7 @@ To unbundle Guile use the instruction
 zcat guile-@value{VERSION}.tar.gz | tar xvf -
 @end example
 
+@noindent
 which will create a directory called @file{guile-@value{VERSION}} with
 all the sources.  You can look at the file @file{INSTALL} for detailed
 instructions on how to build and install Guile, but you should be able
@@ -93,7 +94,7 @@ make install
 @end example
 
 This will install the Guile executable @file{guile}, the Guile library
-@file{-lguile} and various associated header files and support
+@file{libguile} and various associated header files and support
 libraries. It will also install the Guile tutorial and reference
 manual.
 
@@ -101,14 +102,14 @@ manual.
 
 Since this manual frequently refers to the Scheme ``standard'', also
 known as R5RS, or the
-@iftex
+@tex
 ``Revised$^5$ Report on the Algorithmic Language Scheme'',
-@end iftex
+@end tex
 @ifnottex
 ``Revised^5 Report on the Algorithmic Language Scheme'',
 @end ifnottex
-we have included the report in the Guile distribution;
-@xref{Top, , Introduction, r5rs, Revised(5) Report on the Algorithmic
+we have included the report in the Guile distribution; see
+@ref{Top, , Introduction, r5rs, Revised(5) Report on the Algorithmic
 Language Scheme}.
 This will also be installed in your info directory.
 
@@ -470,12 +471,13 @@ You can get the version number by invoking the command
 
 @example
 $ guile --version
-Guile 1.4.1
-Copyright (c) 1995, 1996, 1997, 2000, 2006 Free Software Foundation
-Guile may be distributed under the terms of the GNU General Public License;
-certain other uses are permitted as well.  For details, see the file
-`COPYING', which is included in the Guile distribution.
-There is no warranty, to the extent permitted by law.
+Guile 1.9.0
+Copyright (c) 1995, 1996, 1997, 2000, 2001, 2002, 2003, 2004,
+2005, 2006, 2007, 2008, 2009 Free Software Foundation
+Guile may be distributed under the terms of the GNU Lesser General
+Public Licence.  For details, see the files `COPYING.LESSER' and
+`COPYING', which are included in the Guile distribution.  There is
+no warranty, to the extent permitted by law.
 @end example
 
 @item
diff --git a/doc/ref/libguile-concepts.texi b/doc/ref/libguile-concepts.texi
index 20c0f72ca..15d54f531 100644
--- a/doc/ref/libguile-concepts.texi
+++ b/doc/ref/libguile-concepts.texi
@@ -153,8 +153,8 @@ that have been added to Guile by third-party libraries.
 
 Also, computing with @code{SCM} is not necessarily inefficient.  Small
 integers will be encoded directly in the @code{SCM} value, for example,
-and do not need any additional memory on the heap.  See @ref{Data
-Representation} to find out the details.
+and do not need any additional memory on the heap.  See @ref{The
+Libguile Runtime Environment} to find out the details.
 
 Some special @code{SCM} values are available to C code without needing
 to convert them from C values:
@@ -170,8 +170,8 @@ In addition to @code{SCM}, Guile also defines the related type
 @code{scm_t_bits}.  This is an unsigned integral type of sufficient
 size to hold all information that is directly contained in a
 @code{SCM} value.  The @code{scm_t_bits} type is used internally by
-Guile to do all the bit twiddling explained in @ref{Data
-Representation}, but you will encounter it occasionally in low-level
+Guile to do all the bit twiddling explained in @ref{The Libguile
+Runtime Environment}, but you will encounter it occasionally in low-level
 user code as well.
 
 
@@ -182,7 +182,7 @@ As explained above, the @code{SCM} type can represent all Scheme values.
 Some values fit entirely into a @code{SCM} value (such as small
 integers), but other values require additional storage in the heap (such
 as strings and vectors).  This additional storage is managed
-automatically by Guile.  You don't need to explicitely deallocate it
+automatically by Guile.  You don't need to explicitly deallocate it
 when a @code{SCM} value is no longer used.
 
 Two things must be guaranteed so that Guile is able to manage the
diff --git a/doc/ref/libguile-extensions.texi b/doc/ref/libguile-extensions.texi
index 77762b5c5..78871c6ca 100644
--- a/doc/ref/libguile-extensions.texi
+++ b/doc/ref/libguile-extensions.texi
@@ -94,11 +94,11 @@ we are going to call the function @code{init_bessel} which will make
 @file{.so} when invoking @code{load-extension}.  The right extension for
 the host platform will be provided automatically.
 
-@smalllisp
+@lisp
 (load-extension "libguile-bessel" "init_bessel")
 (j0 2)
 @result{} 0.223890779141236
-@end smalllisp
+@end lisp
 
 For this to work, @code{load-extension} must be able to find
 @file{libguile-bessel}, of course.  It will look in the places that
diff --git a/doc/ref/libguile-linking.texi b/doc/ref/libguile-linking.texi
index 8869c46d5..72b59bbba 100644
--- a/doc/ref/libguile-linking.texi
+++ b/doc/ref/libguile-linking.texi
@@ -173,7 +173,8 @@ creating ./config.status
 creating Makefile
 $ make
 gcc -c -I/usr/local/include simple-guile.c
-gcc simple-guile.o -L/usr/local/lib -lguile -lqthreads -lpthread -lm -o simple-guile
+gcc simple-guile.o -L/usr/local/lib -lguile -lqthreads -lpthread -lm
+  -o simple-guile
 $ ./simple-guile
 guile> (+ 1 2 3)
 6
diff --git a/doc/ref/libguile-smobs.texi b/doc/ref/libguile-smobs.texi
index 59bb98ffb..738809d7a 100644
--- a/doc/ref/libguile-smobs.texi
+++ b/doc/ref/libguile-smobs.texi
@@ -28,7 +28,7 @@ datatypes described here.)
 
 @menu
 * Describing a New Type::       
-* Creating Instances::          
+* Creating Smob Instances::          
 * Type checking::                
 * Garbage Collecting Smobs::    
 * Garbage Collecting Simple Smobs::  
@@ -132,8 +132,8 @@ init_image_type (void)
 @end example
 
 
-@node Creating Instances
-@subsection Creating Instances
+@node Creating Smob Instances
+@subsection Creating Smob Instances
 
 Normally, smobs can have one @emph{immediate} word of data.  This word
 stores either a pointer to an additional memory block that holds the
@@ -211,7 +211,8 @@ make_image (SCM name, SCM s_width, SCM s_height)
 
   /* Step 1: Allocate the memory block.
    */
-  image = (struct image *) scm_gc_malloc (sizeof (struct image), "image");
+  image = (struct image *)
+     scm_gc_malloc (sizeof (struct image), "image");
 
   /* Step 2: Initialize it with straight code.
    */
@@ -228,7 +229,8 @@ make_image (SCM name, SCM s_width, SCM s_height)
   /* Step 4: Finish the initialization.
    */
   image->name = name;
-  image->pixels = scm_gc_malloc (width * height, "image pixels");
+  image->pixels =
+     scm_gc_malloc (width * height, "image pixels");
 
   return smob;
 @}
@@ -404,7 +406,9 @@ free_image (SCM image_smob)
 @{
   struct image *image = (struct image *) SCM_SMOB_DATA (image_smob);
 
-  scm_gc_free (image->pixels, image->width * image->height, "image pixels");
+  scm_gc_free (image->pixels,
+               image->width * image->height,
+               "image pixels");
   scm_gc_free (image, sizeof (struct image), "image");
 
   return 0;
@@ -517,10 +521,10 @@ Smobs are called smob because they are small: they normally have only
 room for one @code{void*} or @code{SCM} value plus 16 bits.  The
 reason for this is that smobs are directly implemented by using the
 low-level, two-word cells of Guile that are also used to implement
-pairs, for example.  (@pxref{Data Representation} for the details.)
-One word of the two-word cells is used for @code{SCM_SMOB_DATA} (or
-@code{SCM_SMOB_OBJECT}), the other contains the 16-bit type tag and
-the 16 extra bits.
+pairs, for example.  (@pxref{The Libguile Runtime Environment} for the
+details.)  One word of the two-word cells is used for
+@code{SCM_SMOB_DATA} (or @code{SCM_SMOB_OBJECT}), the other contains
+the 16-bit type tag and the 16 extra bits.
 
 In addition to the fundamental two-word cells, Guile also has
 four-word cells, which are appropriately called @dfn{double cells}.
@@ -583,7 +587,8 @@ make_image (SCM name, SCM s_width, SCM s_height)
 
   /* Step 1: Allocate the memory block.
    */
-  image = (struct image *) scm_gc_malloc (sizeof (struct image), "image");
+  image = (struct image *)
+     scm_gc_malloc (sizeof (struct image), "image");
 
   /* Step 2: Initialize it with straight code.
    */
@@ -600,7 +605,8 @@ make_image (SCM name, SCM s_width, SCM s_height)
   /* Step 4: Finish the initialization.
    */
   image->name = name;
-  image->pixels = scm_gc_malloc (width * height, "image pixels");
+  image->pixels =
+     scm_gc_malloc (width * height, "image pixels");
 
   return smob;
 @}
@@ -642,7 +648,9 @@ free_image (SCM image_smob)
 @{
   struct image *image = (struct image *) SCM_SMOB_DATA (image_smob);
 
-  scm_gc_free (image->pixels, image->width * image->height, "image pixels");
+  scm_gc_free (image->pixels,
+               image->width * image->height,
+               "image pixels");
   scm_gc_free (image, sizeof (struct image), "image");
 
   return 0;
diff --git a/doc/goops/mop.text b/doc/ref/mop.text
index 0180f2c1e..0180f2c1e 100644
--- a/doc/goops/mop.text
+++ b/doc/ref/mop.text
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index cb19a7af8..d568af23d 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -1909,10 +1909,6 @@ for termination, not stopping.
 If a signal occurs while in a system call, deliver the signal then
 restart the system call (as opposed to returning an @code{EINTR} error
 from that call).
-
-Guile always enables this flag where available, no matter what
-@var{flags} are specified.  This avoids spurious error returns in low
-level operations.
 @end defvar
 
 The return value is a pair with information about the old handler as
@@ -2076,9 +2072,9 @@ The following procedures are similar to the @code{popen} and
 @code{pclose} system routines.  The code is in a separate ``popen''
 module:
 
-@smalllisp
+@lisp
 (use-modules (ice-9 popen))
-@end smalllisp
+@end lisp
 
 @findex popen
 @deffn {Scheme Procedure} open-pipe command mode
diff --git a/doc/ref/preface.texi b/doc/ref/preface.texi
index d6de77440..8552d388b 100644
--- a/doc/ref/preface.texi
+++ b/doc/ref/preface.texi
@@ -7,12 +7,9 @@
 @node Preface
 @chapter Preface
 
-This reference manual documents Guile, GNU's Ubiquitous Intelligent
-Language for Extensions.  It describes how to use Guile in many useful
-and interesting ways.
-
-This is edition @value{MANUAL-EDITION} of the reference manual, and
-corresponds to Guile version @value{VERSION}.
+This manual documents version @value{VERSION} of Guile, GNU's
+Ubiquitous Intelligent Language for Extensions.  It describes how to
+use Guile in many useful and interesting ways.
 
 @menu
 * Manual Layout::               
@@ -25,7 +22,7 @@ corresponds to Guile version @value{VERSION}.
 @node Manual Layout
 @section Layout of this Manual
 
-The manual is divided into five chapters.
+The manual is divided into the following chapters.
 
 @table @strong
 @item Chapter 1: Introduction to Guile
@@ -38,7 +35,7 @@ the later parts of the manual.  This part also explains how to obtain
 and install new versions of Guile, and how to report bugs effectively.
 
 @item Chapter 2: Programming in Scheme
-This part provides an overview over programming in Scheme with Guile.
+This part provides an overview of programming in Scheme with Guile.
 It covers how to invoke the @code{guile} program from the command-line
 and how to write scripts in Scheme.  It also gives an introduction
 into the basic ideas of Scheme itself and to the various extensions
@@ -61,6 +58,10 @@ Describes some important modules, distributed as part of the Guile
 distribution, that extend the functionality provided by the Guile
 Scheme core.
 
+@item Chapter 6: GOOPS
+Describes GOOPS, an object oriented extension to Guile that provides
+classes, multiple inheritance and generic functions.
+
 @end table
 
 
@@ -72,7 +73,7 @@ We use some conventions in this manual.
 @itemize @bullet
 
 @item
-For some procedures, notably type predicates, we use @dfn{iff} to mean
+For some procedures, notably type predicates, we use ``iff'' to mean
 ``if and only if''.  The construct is usually something like: `Return
 @var{val} iff @var{condition}', where @var{val} is usually
 ``@nicode{#t}'' or ``non-@nicode{#f}''.  This typically means that
@@ -144,6 +145,9 @@ filling out a lot of the documentation of Scheme data types, control
 mechanisms and procedures.  In addition, he wrote the documentation
 for Guile's SRFI modules and modules associated with the Guile REPL.
 
+The chapter on GOOPS was written by Christian Lynbech, Mikael
+Djurfeldt and Neil Jerram.
+
 @node Guile License
 @section The Guile License
 @cindex copying
@@ -159,12 +163,12 @@ person would want to do.
 @itemize @bullet
 @item
 The Guile library (libguile) and supporting files are published under
-the terms of the GNU Lesser General Public License version 2.1.  See
-the file @file{COPYING.LIB}.
+the terms of the GNU Lesser General Public License version 3 or later.
+See the files @file{COPYING.LESSER} and @file{COPYING}.
 
 @item
 The Guile readline module is published under the terms of the GNU
-General Public License version 2.  See the file @file{COPYING}.
+General Public License version 3 or later.  See the file @file{COPYING}.
 
 @item
 The manual you're now reading is published under the terms of the GNU
@@ -179,7 +183,7 @@ C code linking to the Guile readline module is subject to the terms of
 that module.  Basically such code must be published on Free terms.
 
 Scheme level code written to be run by Guile (but not derived from
-Guile itself) is not resticted in any way, and may be published on any
+Guile itself) is not restricted in any way, and may be published on any
 terms.  We encourage authors to publish on Free terms.
 
 You must be aware there is no warranty whatsoever for Guile.  This is
diff --git a/doc/ref/scheme-debugging.texi b/doc/ref/scheme-debugging.texi
index 07511263b..bcd9f2df3 100644
--- a/doc/ref/scheme-debugging.texi
+++ b/doc/ref/scheme-debugging.texi
@@ -14,9 +14,9 @@ call to that procedure is reported to the user during a program run.
 The idea is that you can mark a collection of procedures for tracing,
 and Guile will subsequently print out a line of the form
 
-@smalllisp
+@lisp
 |  |  [@var{procedure} @var{args} @dots{}]
-@end smalllisp
+@end lisp
 
 whenever a marked procedure is about to be applied to its arguments.
 This can help a programmer determine whether a function is being called
@@ -27,7 +27,7 @@ how the traced applications are or are not tail recursive with respect
 to each other.  Thus, a trace of a non-tail recursive factorial
 implementation looks like this:
 
-@smalllisp
+@lisp
 [fact1 4]
 |  [fact1 3]
 |  |  [fact1 2]
@@ -38,11 +38,11 @@ implementation looks like this:
 |  |  2
 |  6
 24
-@end smalllisp
+@end lisp
 
 While a typical tail recursive implementation would look more like this:
 
-@smalllisp
+@lisp
 [fact2 4]
 [facti 1 4]
 [facti 4 3]
@@ -50,7 +50,7 @@ While a typical tail recursive implementation would look more like this:
 [facti 24 1]
 [facti 24 0]
 24
-@end smalllisp
+@end lisp
 
 @deffn {Scheme Procedure} trace procedure
 Enable tracing for @code{procedure}.  While a program is being run,
diff --git a/doc/ref/scheme-ideas.texi b/doc/ref/scheme-ideas.texi
index 38b105b94..55093cf92 100644
--- a/doc/ref/scheme-ideas.texi
+++ b/doc/ref/scheme-ideas.texi
@@ -390,7 +390,11 @@ this:
 
 @noindent
 This is a valid procedure invocation expression, and its result is the
-string @code{"Name=FSF:Address=Cambridge"}.
+string:
+
+@lisp
+"Name=FSF:Address=Cambridge"
+@end lisp
 
 It is more common, though, to store the procedure value in a variable ---
 
diff --git a/doc/ref/scsh.texi b/doc/ref/scsh.texi
index 0f869ecd7..b1af1a443 100644
--- a/doc/ref/scsh.texi
+++ b/doc/ref/scsh.texi
@@ -19,8 +19,8 @@ For information about scsh see
 
 The closest emulation of scsh can be obtained by running:
 
-@smalllisp
+@lisp
 (load-from-path "scsh/init")
-@end smalllisp
+@end lisp
 
 See the USAGE file supplied with guile-scsh for more details.
diff --git a/doc/ref/slib.texi b/doc/ref/slib.texi
index fc8f91933..d3357c97f 100644
--- a/doc/ref/slib.texi
+++ b/doc/ref/slib.texi
@@ -4,7 +4,6 @@
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
-@page
 @node SLIB
 @section SLIB
 @cindex SLIB
@@ -12,9 +11,9 @@
 Before the SLIB facilities can be used, the following Scheme expression
 must be executed:
 
-@smalllisp
+@lisp
 (use-modules (ice-9 slib))
-@end smalllisp
+@end lisp
 
 @findex require
 @code{require} can then be used in the usual way (@pxref{Require,,,
@@ -64,7 +63,7 @@ Alternatively, you can create a symlink in the Guile directory to SLIB,
 e.g.:
 
 @example
-ln -s /usr/local/lib/slib /usr/local/share/guile/1.8/slib
+ln -s /usr/local/lib/slib /usr/local/share/guile/@value{EFFECTIVE-VERSION}/slib
 @end example
 
 @item
@@ -78,7 +77,7 @@ guile> (quit)
 @end example
 
 The catalog data should now be in
-@file{/usr/local/share/guile/1.8/slibcat}.
+@file{/usr/local/share/guile/@value{EFFECTIVE-VERSION}/slibcat}.
 
 If instead you get an error such as:
 
@@ -104,11 +103,11 @@ It is usually installed as an extra package in SLIB.
 
 You can use Guile's interface to SLIB to invoke Jacal:
 
-@smalllisp
+@lisp
 (use-modules (ice-9 slib))
 (slib:load "math")
 (math)
-@end smalllisp
+@end lisp
 
 @noindent
 For complete documentation on Jacal, please read the Jacal manual.  If
diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi
index 1fa50b209..7c107e710 100644
--- a/doc/ref/srfi-modules.texi
+++ b/doc/ref/srfi-modules.texi
@@ -47,6 +47,7 @@ get the relevant SRFI documents from the SRFI home page
 * SRFI-61::                     A more general `cond' clause
 * SRFI-69::                     Basic hash tables.
 * SRFI-88::                     Keyword objects.
+* SRFI-98::                     Accessing environment variables.
 @end menu
 
 
@@ -3608,6 +3609,25 @@ Return the keyword object whose name is @var{str}.
 @end example
 @end deffn
 
+@node SRFI-98
+@subsection SRFI-98 Accessing environment variables.
+@cindex SRFI-98
+@cindex environment variables
+
+This is a portable wrapper around Guile's built-in support for 
+interacting with the current environment, @xref{Runtime Environment}.
+
+@deffn {Scheme Procedure} get-environment-variable name
+Returns a string containing the value of the environment variable 
+given by the string @code{name}, or @code{#f} if the named 
+environment variable is not found.  This is equivalent to 
+@code{(getenv name)}.
+@end deffn
+
+@deffn {Scheme Procedure} get-environment-variables
+Returns the names and values of all the environment variables as an
+association list in which both the keys and the values are strings.
+@end deffn
 
 @c srfi-modules.texi ends here
 
diff --git a/doc/ref/tools.texi b/doc/ref/tools.texi
index f2116dd71..8b0d3a3bb 100644
--- a/doc/ref/tools.texi
+++ b/doc/ref/tools.texi
@@ -232,8 +232,8 @@ is a expression suitable for initializing a new variable.
 For procedures, you can use @code{SCM_DEFINE} for most purposes.  Use
 @code{SCM_PROC} along with @code{SCM_REGISTER_PROC} when you don't
 want to be bothered with docstrings.  Use @code{SCM_GPROC} for generic
-functions (@pxref{Creating Generic Functions,,, goops, GOOPS}).  All
-procedures are declared with return type @code{SCM}.
+functions (@pxref{Creating Generic Functions}).  All procedures are
+declared with return type @code{SCM}.
 
 For everything else, use the appropriate macro (@code{SCM_SYMBOL} for
 symbols, and so on).  Without "_GLOBAL_", the declarations are
@@ -364,7 +364,7 @@ of the form:
 
 @example
 (define-module (scripts PROGRAM)
-  :export (PROGRAM))
+  #:export (PROGRAM))
 @end example
 
 Feel free to export other definitions useful in the module context.
diff --git a/doc/ref/vm.texi b/doc/ref/vm.texi
new file mode 100644
index 000000000..43b265596
--- /dev/null
+++ b/doc/ref/vm.texi
@@ -0,0 +1,1019 @@
+@c -*-texinfo-*-
+@c This is part of the GNU Guile Reference Manual.
+@c Copyright (C)  2008,2009
+@c   Free Software Foundation, Inc.
+@c See the file guile.texi for copying conditions.
+
+@node A Virtual Machine for Guile
+@section A Virtual Machine for Guile
+
+Guile has both an interpreter and a compiler. To a user, the
+difference is largely transparent---interpreted and compiled
+procedures can call each other as they please.
+
+The difference is that the compiler creates and interprets bytecode
+for a custom virtual machine, instead of interpreting the
+S-expressions directly. Loading and running compiled code is faster
+than loading and running source code.
+
+The virtual machine that does the bytecode interpretation is a part of
+Guile itself. This section describes the nature of Guile's virtual
+machine.
+
+@menu
+* Why a VM?::                   
+* VM Concepts::                 
+* Stack Layout::                
+* Variables and the VM::                   
+* VM Programs::         
+* Instruction Set::
+@end menu
+
+@node Why a VM?
+@subsection Why a VM?
+
+@cindex interpreter
+@cindex evaluator
+For a long time, Guile only had an interpreter, called the
+@dfn{evaluator}. Guile's evaluator operates directly on the
+S-expression representation of Scheme source code.
+
+But while the evaluator is highly optimized and hand-tuned, and
+contains some extensive speed trickery (@pxref{Memoization}), it still
+performs many needless computations during the course of evaluating an
+expression. For example, application of a function to arguments
+needlessly conses up the arguments in a list. Evaluation of an
+expression always has to figure out what the car of the expression is
+-- a procedure, a memoized form, or something else. All values have to
+be allocated on the heap. Et cetera.
+
+The solution to this problem is to compile the higher-level language,
+Scheme, into a lower-level language for which all of the checks and
+dispatching have already been done---the code is instead stripped to
+the bare minimum needed to ``do the job''.
+
+The question becomes then, what low-level language to choose? There
+are many options. We could compile to native code directly, but that
+poses portability problems for Guile, as it is a highly cross-platform
+project.
+
+So we want the performance gains that compilation provides, but we
+also want to maintain the portability benefits of a single code path.
+The obvious solution is to compile to a virtual machine that is
+present on all Guile installations.
+
+The easiest (and most fun) way to depend on a virtual machine is to
+implement the virtual machine within Guile itself. This way the
+virtual machine provides what Scheme needs (tail calls, multiple
+values, @code{call/cc}) and can provide optimized inline instructions
+for Guile (@code{cons}, @code{struct-ref}, etc.).
+
+So this is what Guile does. The rest of this section describes that VM
+that Guile implements, and the compiled procedures that run on it.
+
+Note that this decision to implement a bytecode compiler does not
+preclude native compilation. We can compile from bytecode to native
+code at runtime, or even do ahead of time compilation. More
+possibilities are discussed in @ref{Extending the Compiler}.
+
+@node VM Concepts
+@subsection VM Concepts
+
+A virtual machine (VM) is a Scheme object. Users may create virtual
+machines using the standard procedures described later in this manual,
+but that is usually unnecessary, as Guile ensures that there is one
+virtual machine per thread. When a VM-compiled procedure is run, Guile
+looks up the virtual machine for the current thread and executes the
+procedure using that VM.
+
+Guile's virtual machine is a stack machine---that is, it has few
+registers, and the instructions defined in the VM operate by pushing
+and popping values from a stack.
+
+Stack memory is exclusive to the virtual machine that owns it. In
+addition to their stacks, virtual machines also have access to the
+global memory (modules, global bindings, etc) that is shared among
+other parts of Guile, including other VMs.
+
+A VM has generic instructions, such as those to reference local
+variables, and instructions designed to support Guile's languages --
+mathematical instructions that support the entire numerical tower, an
+inlined implementation of @code{cons}, etc.
+
+The registers that a VM has are as follows:
+
+@itemize
+@item ip - Instruction pointer
+@item sp - Stack pointer
+@item fp - Frame pointer
+@end itemize
+
+In other architectures, the instruction pointer is sometimes called
+the ``program counter'' (pc). This set of registers is pretty typical
+for stack machines; their exact meanings in the context of Guile's VM
+are described in the next section.
+
+A virtual machine executes by loading a compiled procedure, and
+executing the object code associated with that procedure. Of course,
+that procedure may call other procedures, tail-call others, ad
+infinitum---indeed, within a guile whose modules have all been
+compiled to object code, one might never leave the virtual machine.
+
+@c wingo: The following is true, but I don't know in what context to
+@c describe it. A documentation FIXME.
+
+@c A VM may have one of three engines: reckless, regular, or debugging.
+@c Reckless engine is fastest but dangerous.  Regular engine is normally
+@c fail-safe and reasonably fast.  Debugging engine is safest and
+@c functional but very slow.
+
+@c (Actually we have just a regular and a debugging engine; normally
+@c we use the latter, it's almost as fast as the ``regular'' engine.)
+
+@node Stack Layout
+@subsection Stack Layout
+
+While not strictly necessary to understand how to work with the VM, it
+is instructive and sometimes entertaining to consider the structure of
+the VM stack.
+
+Logically speaking, a VM stack is composed of ``frames''. Each frame
+corresponds to the application of one compiled procedure, and contains
+storage space for arguments, local variables, intermediate values, and
+some bookkeeping information (such as what to do after the frame
+computes its value).
+
+While the compiler is free to do whatever it wants to, as long as the
+semantics of a computation are preserved, in practice every time you
+call a function, a new frame is created. (The notable exception of
+course is the tail call case, @pxref{Tail Calls}.)
+
+Within a frame, you have the data associated with the function
+application itself, which is of a fixed size, and the stack space for
+intermediate values. Sometimes only the former is referred to as the
+``frame'', and the latter is the ``stack'', although all pending
+application frames can have some intermediate computations interleaved
+on the stack.
+
+The structure of the fixed part of an application frame is as follows:
+
+@example
+             Stack
+   | ...              |
+   | Intermed. val. 0 | <- fp + bp->nargs + bp->nlocs = SCM_FRAME_UPPER_ADDRESS (fp)
+   +==================+
+   | Local variable 1 |
+   | Local variable 0 | <- fp + bp->nargs
+   | Argument 1       |
+   | Argument 0       | <- fp
+   | Program          | <- fp - 1
+   +------------------+    
+   | Return address   |
+   | MV return address|
+   | Dynamic link     | <- fp - 4 = SCM_FRAME_DATA_ADDRESS (fp) = SCM_FRAME_LOWER_ADDRESS (fp)
+   +==================+
+   |                  |
+@end example
+
+In the above drawing, the stack grows upward. The intermediate values
+stored in the application of this frame are stored above
+@code{SCM_FRAME_UPPER_ADDRESS (fp)}. @code{bp} refers to the
+@code{struct scm_objcode} data associated with the program at
+@code{fp - 1}. @code{nargs} and @code{nlocs} are properties of the
+compiled procedure, which will be discussed later.
+
+The individual fields of the frame are as follows:
+
+@table @asis
+@item Return address
+The @code{ip} that was in effect before this program was applied. When
+we return from this activation frame, we will jump back to this
+@code{ip}.
+
+@item MV return address
+The @code{ip} to return to if this application returns multiple
+values. For continuations that only accept one value, this value will
+be @code{NULL}; for others, it will be an @code{ip} that points to a
+multiple-value return address in the calling code. That code will
+expect the top value on the stack to be an integer---the number of
+values being returned---and that below that integer there are the
+values being returned.
+
+@item Dynamic link
+This is the @code{fp} in effect before this program was applied. In
+effect, this and the return address are the registers that are always
+``saved''. The dynamic link links the current frame to the previous
+frame; computing a stack trace involves traversing these frames.
+
+@item Local variable @var{n}
+Lambda-local variables that are all allocated as part of the frame.
+This makes access to variables very cheap.
+
+@item Argument @var{n}
+The calling convention of the VM requires arguments of a function
+application to be pushed on the stack, and here they are. References
+to arguments dispatch to these locations on the stack.
+
+@item Program
+This is the program being applied. For more information on how
+programs are implemented, @xref{VM Programs}.
+@end table
+
+@node Variables and the VM
+@subsection Variables and the VM
+
+Consider the following Scheme code as an example:
+
+@example
+  (define (foo a)
+    (lambda (b) (list foo a b)))
+@end example
+
+Within the lambda expression, @code{foo} is a top-level variable, @code{a} is a
+lexically captured variable, and @code{b} is a local variable.
+
+Another way to refer to @code{a} and @code{b} is to say that @code{a}
+is a ``free'' variable, since it is not defined within the lambda, and
+@code{b} is a ``bound'' variable. These are the terms used in the
+@dfn{lambda calculus}, a mathematical notation for describing
+functions. The lambda calculus is useful because it allows one to
+prove statements about functions. It is especially good at describing
+scope relations, and it is for that reason that we mention it here.
+
+Guile allocates all variables on the stack. When a lexically enclosed
+procedure with free variables---a @dfn{closure}---is created, it
+copies those variables its free variable vector. References to free
+variables are then redirected through the free variable vector.
+
+If a variable is ever @code{set!}, however, it will need to be
+heap-allocated instead of stack-allocated, so that different closures
+that capture the same variable can see the same value. Also, this
+allows continuations to capture a reference to the variable, instead
+of to its value at one point in time. For these reasons, @code{set!}
+variables are allocated in ``boxes''---actually, in variable cells.
+@xref{Variables}, for more information. References to @code{set!}
+variables are indirected through the boxes.
+
+Thus perhaps counterintuitively, what would seem ``closer to the
+metal'', viz @code{set!}, actually forces an extra memory allocation
+and indirection.
+
+Going back to our example, @code{b} may be allocated on the stack, as
+it is never mutated.
+
+@code{a} may also be allocated on the stack, as it too is never
+mutated. Within the enclosed lambda, its value will be copied into
+(and referenced from) the free variables vector.
+
+@code{foo} is a top-level variable, because @code{foo} is not
+lexically bound in this example.
+
+@node VM Programs
+@subsection Compiled Procedures are VM Programs
+
+By default, when you enter in expressions at Guile's REPL, they are
+first compiled to VM object code, then that VM object code is executed
+to produce a value. If the expression evaluates to a procedure, the
+result of this process is a compiled procedure.
+
+A compiled procedure is a compound object, consisting of its bytecode,
+a reference to any captured lexical variables, an object array, and
+some metadata such as the procedure's arity, name, and documentation.
+You can pick apart these pieces with the accessors in @code{(system vm
+program)}. @xref{Compiled Procedures}, for a full API reference.
+
+@cindex object table
+@cindex object array
+The object array of a compiled procedure, also known as the
+@dfn{object table}, holds all Scheme objects whose values are known
+not to change across invocations of the procedure: constant strings,
+symbols, etc. The object table of a program is initialized right
+before a program is loaded with @code{load-program}.
+@xref{Loading Instructions}, for more information.
+
+Variable objects are one such type of constant object: when a global
+binding is defined, a variable object is associated to it and that
+object will remain constant over time, even if the value bound to it
+changes. Therefore, toplevel bindings only need to be looked up once.
+Thereafter, references to the corresponding toplevel variables from
+within the program are then performed via the @code{toplevel-ref}
+instruction, which uses the object vector, and are almost as fast as
+local variable references.
+
+We can see how these concepts tie together by disassembling the
+@code{foo} function we defined earlier to see what is going on:
+
+@smallexample
+scheme@@(guile-user)> (define (foo a) (lambda (b) (list foo a b)))
+scheme@@(guile-user)> ,x foo
+Disassembly of #<program foo (a)>:
+
+   0    (object-ref 1)          ;; #<program b7e478b0 at <unknown port>:0:16 (b)>
+   2    (local-ref 0)           ;; `a' (arg)
+   4    (vector 0 1)            ;; 1 element
+   7    (make-closure)                  
+   8    (return)                        
+
+----------------------------------------
+Disassembly of #<program b7e478b0 at <unknown port>:0:16 (b)>:
+
+   0    (toplevel-ref 1)        ;; `foo'
+   2    (free-ref 0)            ;; (closure variable)
+   4    (local-ref 0)           ;; `b' (arg)
+   6    (list 0 3)              ;; 3 elements         at (unknown file):0:28
+   9    (return)                        
+@end smallexample
+
+At @code{ip} 0, we load up the compiled lambda. @code{Ip} 2 and 4
+create the free variables vector, and @code{ip} 7 makes the
+closure---binding code (from the compiled lambda) with data (the
+free-variable vector). Finally we return the closure.
+
+The second stanza disassembles the compiled lambda. Toplevel variables
+are resolved relative to the module that was current when the
+procedure was created. This lookup occurs lazily, at the first time
+the variable is actually referenced, and the location of the lookup is
+cached so that future references are very cheap. @xref{Environment
+Control Instructions}, for more details.
+
+Then we see a reference to an external variable, corresponding to
+@code{a}. The disassembler doesn't have enough information to give a
+name to that variable, so it just marks it as being a ``closure
+variable''. Finally we see the reference to @code{b}, then the
+@code{list} opcode, an inline implementation of the @code{list} scheme
+routine.
+
+@node Instruction Set
+@subsection Instruction Set
+
+There are about 150 instructions in Guile's virtual machine. These
+instructions represent atomic units of a program's execution. Ideally,
+they perform one task without conditional branches, then dispatch to
+the next instruction in the stream.
+
+Instructions themselves are one byte long. Some instructions take
+parameters, which follow the instruction byte in the instruction
+stream.
+
+Sometimes the compiler can figure out that it is compiling a special
+case that can be run more efficiently. So, for example, while Guile
+offers a generic test-and-branch instruction, it also offers specific
+instructions for special cases, so that the following cases all have
+their own test-and-branch instructions:
+
+@example
+(if pred then else)
+(if (not pred) then else)
+(if (null? l) then else)
+(if (not (null? l)) then else)
+@end example
+
+In addition, some Scheme primitives have their own inline
+implementations, e.g. @code{cons}, and @code{list}, as we saw in the
+previous section.
+
+So Guile's instruction set is a @emph{complete} instruction set, in
+that it provides the instructions that are suited to the problem, and
+is not concerned with making a minimal, orthogonal set of
+instructions. More instructions may be added over time.
+
+@menu
+* Environment Control Instructions::  
+* Branch Instructions::         
+* Loading Instructions::  
+* Procedural Instructions::  
+* Data Control Instructions::   
+* Miscellaneous Instructions::  
+* Inlined Scheme Instructions::  
+* Inlined Mathematical Instructions::  
+* Inlined Bytevector Instructions::  
+@end menu
+
+@node Environment Control Instructions
+@subsubsection Environment Control Instructions
+
+These instructions access and mutate the environment of a compiled
+procedure---the local bindings, the free (captured) bindings, and the
+toplevel bindings.
+
+Some of these instructions have @code{long-} variants, the difference
+being that they take 16-bit arguments, encoded in big-endianness,
+instead of the normal 8-bit range.
+
+@deffn Instruction local-ref index
+@deffnx Instruction long-local-ref index
+Push onto the stack the value of the local variable located at
+@var{index} within the current stack frame.
+
+Note that arguments and local variables are all in one block. Thus the
+first argument, if any, is at index 0, and local bindings follow the
+arguments.
+@end deffn
+
+@deffn Instruction local-set index
+@deffnx Instruction long-local-ref index
+Pop the Scheme object located on top of the stack and make it the new
+value of the local variable located at @var{index} within the current
+stack frame.
+@end deffn
+
+@deffn Instruction free-ref index
+Push the value of the captured variable located at position
+@var{index} within the program's vector of captured variables.
+@end deffn
+
+@deffn Instruction free-boxed-ref index
+@deffnx Instruction free-boxed-set index
+Get or set a boxed free variable. Note that there is no free-set
+instruction, as variables that are @code{set!} must be boxed.
+
+These instructions assume that the value at position @var{index} in
+the free variables vector is a variable.
+@end deffn
+
+@deffn Instruction make-closure
+Pop a vector and a program object off the stack, in that order, and
+push a new program object with the given free variables vector. The
+new program object shares state with the original program.
+
+At the time of this writing, the space overhead of closures is 4 words
+per closure.
+@end deffn
+
+@deffn Instruction fix-closure index
+Pop a vector off the stack, and set it as the @var{index}th local
+variable's free variable vector. The @var{index}th local variable is
+assumed to be a procedure.
+
+This instruction is part of a hack for allocating mutually recursive
+procedures. The hack is to first perform a @code{local-set} for all of
+the recursive procedures, then fix up the procedures' free variable
+bindings in place. This allows most @code{letrec}-bound procedures to
+be allocated unboxed on the stack.
+
+One could of course do a @code{local-ref}, then @code{make-closure},
+then @code{local-set}, but this macroinstruction helps to speed up the
+common case.
+@end deffn
+
+@deffn Instruction box index
+Pop a value off the stack, and set the @var{index}nth local variable
+to a box containing that value. A shortcut for @code{make-variable}
+then @code{local-set}, used when binding boxed variables.
+@end deffn
+
+@deffn Instruction empty-box index
+Set the @var{indext}h local variable to a box containing a variable
+whose value is unbound. Used when compiling some @code{letrec}
+expressions.
+@end deffn
+
+@deffn Instruction toplevel-ref index
+@deffnx Instruction long-toplevel-ref index
+Push the value of the toplevel binding whose location is stored in at
+position @var{index} in the object table.
+
+Initially, a cell in the object table that is used by
+@code{toplevel-ref} is initialized to one of two forms. The normal
+case is that the cell holds a symbol, whose binding will be looked up
+relative to the module that was current when the current program was
+created.
+
+Alternately, the lookup may be performed relative to a particular
+module, determined at compile-time (e.g. via @code{@@} or
+@code{@@@@}). In that case, the cell in the object table holds a list:
+@code{(@var{modname} @var{sym} @var{public?})}. The symbol @var{sym}
+will be looked up in the module named @var{modname} (a list of
+symbols). The lookup will be performed against the module's public
+interface, unless @var{public?} is @code{#f}, which it is for example
+when compiling @code{@@@@}.
+
+In any case, if the symbol is unbound, an error is signalled.
+Otherwise the initial form is replaced with the looked-up variable, an
+in-place mutation of the object table. This mechanism provides for
+lazy variable resolution, and an important cached fast-path once the
+variable has been successfully resolved.
+
+This instruction pushes the value of the variable onto the stack.
+@end deffn
+
+@deffn Instruction toplevel-set index
+@deffnx Instruction long-toplevel-set index
+Pop a value off the stack, and set it as the value of the toplevel
+variable stored at @var{index} in the object table. If the variable
+has not yet been looked up, we do the lookup as in
+@code{toplevel-ref}.
+@end deffn
+
+@deffn Instruction define
+Pop a symbol and a value from the stack, in that order. Look up its
+binding in the current toplevel environment, creating the binding if
+necessary. Set the variable to the value.
+@end deffn
+
+@deffn Instruction link-now
+Pop a value, @var{x}, from the stack. Look up the binding for @var{x},
+according to the rules for @code{toplevel-ref}, and push that variable
+on the stack. If the lookup fails, an error will be signalled.
+
+This instruction is mostly used when loading programs, because it can
+do toplevel variable lookups without an object vector.
+@end deffn
+
+@deffn Instruction variable-ref
+Dereference the variable object which is on top of the stack and
+replace it by the value of the variable it represents.
+@end deffn
+
+@deffn Instruction variable-set
+Pop off two objects from the stack, a variable and a value, and set
+the variable to the value.
+@end deffn
+
+@deffn Instruction make-variable
+Replace the top object on the stack with a variable containing it.
+Used in some circumstances when compiling @code{letrec} expressions.
+@end deffn
+
+@deffn Instruction object-ref n
+@deffnx Instruction long-object-ref n
+Push @var{n}th value from the current program's object vector. The
+``long'' variant has a 16-bit index instead of an 8-bit index.
+@end deffn
+
+@node Branch Instructions
+@subsubsection Branch Instructions
+
+All the conditional branch instructions described below work in the
+same way:
+
+@itemize
+@item They pop off the Scheme object located on the stack and use it as
+the branch condition;
+@item If the condition is true, then the instruction pointer is
+increased by the offset passed as an argument to the branch
+instruction;
+@item Program execution proceeds with the next instruction (that is,
+the one to which the instruction pointer points).
+@end itemize
+
+Note that the offset passed to the instruction is encoded on two 8-bit
+integers which are then combined by the VM as one 16-bit integer. Note
+also that jump targets in Guile are aligned on 8-byte boundaries, and
+that the offset refers to the @var{n}th 8-byte boundary, effectively
+giving Guile a 19-bit relative address space.
+
+@deffn Instruction br offset
+Jump to @var{offset}.
+@end deffn
+
+@deffn Instruction br-if offset
+Jump to @var{offset} if the condition on the stack is not false.
+@end deffn
+
+@deffn Instruction br-if-not offset
+Jump to @var{offset} if the condition on the stack is false.
+@end deffn
+
+@deffn Instruction br-if-eq offset
+Jump to @var{offset} if the two objects located on the stack are
+equal in the sense of @var{eq?}.  Note that, for this instruction, the
+stack pointer is decremented by two Scheme objects instead of only
+one.
+@end deffn
+
+@deffn Instruction br-if-not-eq offset
+Same as @var{br-if-eq} for non-@code{eq?} objects.
+@end deffn
+
+@deffn Instruction br-if-null offset
+Jump to @var{offset} if the object on the stack is @code{'()}.
+@end deffn
+
+@deffn Instruction br-if-not-null offset
+Jump to @var{offset} if the object on the stack is not @code{'()}.
+@end deffn
+
+
+@node Loading Instructions
+@subsubsection Loading Instructions
+
+In addition to VM instructions, an instruction stream may contain
+variable-length data embedded within it. This data is always preceded
+by special loading instructions, which interpret the data and advance
+the instruction pointer to the next VM instruction.
+
+All of these loading instructions have a @code{length} parameter,
+indicating the size of the embedded data, in bytes. The length itself
+is encoded in 3 bytes.
+
+@deffn Instruction load-number length
+Load an arbitrary number from the instruction stream. The number is
+embedded in the stream as a string.
+@end deffn
+@deffn Instruction load-string length
+Load a string from the instruction stream. The string is assumed to be
+encoded in the ``latin1'' locale.
+@end deffn
+@deffn Instruction load-wide-string length
+Load a UTF-32 string from the instruction stream. @var{length} is the
+length in bytes, not in codepoints
+@end deffn
+@deffn Instruction load-symbol length
+Load a symbol from the instruction stream. The symbol is assumed to be
+encoded in the ``latin1'' locale. Symbols backed by wide strings may
+be loaded via @code{load-wide-string} then @code{make-symbol}.
+@end deffn
+@deffn Instruction load-array length
+Load a uniform array from the instruction stream. The shape and type
+of the array are popped off the stack, in that order.
+@end deffn
+
+@deffn Instruction load-program
+Load bytecode from the instruction stream, and push a compiled
+procedure.
+
+This instruction pops one value from the stack: the program's object
+table, as a vector, or @code{#f} in the case that the program has no
+object table. A program that does not reference toplevel bindings and
+does not use @code{object-ref} does not need an object table.
+
+This instruction is unlike the rest of the loading instructions,
+because instead of parsing its data, it directly maps the instruction
+stream onto a C structure, @code{struct scm_objcode}. @xref{Bytecode
+and Objcode}, for more information.
+
+The resulting compiled procedure will not have any free variables
+captured, so it may be loaded only once but used many times to create
+closures.
+@end deffn
+
+@node Procedural Instructions
+@subsubsection Procedural Instructions
+
+@deffn Instructions new-frame
+Push a new frame on the stack, reserving space for the dynamic link,
+return address, and the multiple-values return address. The frame
+pointer is not yet updated, because the frame is not yet active -- it
+has to be patched by a @code{call} instruction to get the return
+address.
+@end deffn
+
+@deffn Instruction call nargs
+Call the procedure located at @code{sp[-nargs]} with the @var{nargs}
+arguments located from @code{sp[-nargs + 1]} to @code{sp[0]}.
+
+This instruction requires that a new frame be pushed on the stack
+before the procedure, via @code{new-frame}. @xref{Stack Layout}, for
+more information. It patches up that frame with the current @code{ip}
+as the return address, then dispatches to the first instruction in the
+called procedure, relying on the called procedure to return one value
+to the newly-created continuation. Because the new frame pointer will
+point to sp[-nargs + 1], the arguments don't have to be shuffled
+around -- they are already in place.
+
+For non-compiled procedures (continuations, primitives, and
+interpreted procedures), @code{call} will pop the frame, procedure,
+and arguments off the stack, and push the result of calling
+@code{scm_apply}.
+@end deffn
+
+@deffn Instruction goto/args nargs
+Like @code{call}, but reusing the current continuation. This
+instruction implements tail calls as required by RnRS.
+
+For compiled procedures, that means that @code{goto/args} simply
+shuffles down the procedure and arguments to the current stack frame.
+The @code{goto/*} instruction family is named as it is because tail
+calls are equivalent to @code{goto}, along with relabeled variables.
+
+For non-VM procedures, the result is the same, but the current VM
+invocation remains on the C stack. True tail calls are not currently
+possible between compiled and non-compiled procedures.
+@end deffn
+
+@deffn Instruction apply nargs
+@deffnx Instruction goto/apply nargs
+Like @code{call} and @code{goto/args}, except that the top item on the
+stack must be a list. The elements of that list are then pushed on the
+stack and treated as additional arguments, replacing the list itself,
+then the procedure is invoked as usual.
+@end deffn
+
+@deffn Instruction call/nargs
+@deffnx Instruction goto/nargs
+These are like @code{call} and @code{goto/args}, except they take the
+number of arguments from the stack instead of the instruction stream.
+These instructions are used in the implementation of multiple value
+returns, where the actual number of values is pushed on the stack.
+@end deffn
+
+@deffn Instruction mv-call nargs offset
+Like @code{call}, except that a multiple-value continuation is created
+in addition to a single-value continuation.
+
+The offset (a two-byte value) is an offset within the instruction
+stream; the multiple-value return address in the new frame
+(@pxref{Stack Layout}) will be set to the normal return address plus
+this offset. Instructions at that offset will expect the top value of
+the stack to be the number of values, and below that values
+themselves, pushed separately.
+@end deffn
+
+@deffn Instruction return
+Free the program's frame, returning the top value from the stack to
+the current continuation. (The stack should have exactly one value on
+it.)
+
+Specifically, the @code{sp} is decremented to one below the current
+@code{fp}, the @code{ip} is reset to the current return address, the
+@code{fp} is reset to the value of the current dynamic link, and then
+the top item on the stack (formerly the procedure being applied) is
+set to the returned value.
+@end deffn
+
+@deffn Instruction return/values nvalues
+Return the top @var{nvalues} to the current continuation.
+
+If the current continuation is a multiple-value continuation,
+@code{return/values} pushes the number of values on the stack, then
+returns as in @code{return}, but to the multiple-value return address.
+
+Otherwise if the current continuation accepts only one value, i.e. the
+multiple-value return address is @code{NULL}, then we assume the user
+only wants one value, and we give them the first one. If there are no
+values, an error is signaled.
+@end deffn
+
+@deffn Instruction return/values* nvalues
+Like a combination of @code{apply} and @code{return/values}, in which
+the top value on the stack is interpreted as a list of additional
+values. This is an optimization for the common @code{(apply values
+...)} case.
+@end deffn
+
+@deffn Instruction truncate-values nbinds nrest
+Used in multiple-value continuations, this instruction takes the
+values that are on the stack (including the number-of-values marker)
+and truncates them for a binding construct.
+
+For example, a call to @code{(receive (x y . z) (foo) ...)} would,
+logically speaking, pop off the values returned from @code{(foo)} and
+push them as three values, corresponding to @code{x}, @code{y}, and
+@code{z}. In that case, @var{nbinds} would be 3, and @var{nrest} would
+be 1 (to indicate that one of the bindings was a rest argument).
+
+Signals an error if there is an insufficient number of values.
+@end deffn
+
+@deffn Instruction call/cc
+@deffnx Instruction goto/cc
+Capture the current continuation, and then call (or tail-call) the
+procedure on the top of the stack, with the continuation as the
+argument.
+
+@code{call/cc} does not require a @code{new-frame} to be pushed on the
+stack, as @code{call} does, because it needs to capture the stack
+before the frame is pushed.
+
+Both the VM continuation and the C continuation are captured.
+@end deffn
+
+@node Data Control Instructions
+@subsubsection Data Control Instructions
+
+These instructions push simple immediate values onto the stack, or
+manipulate lists and vectors on the stack.
+
+@deffn Instruction make-int8 value
+Push @var{value}, an 8-bit integer, onto the stack.
+@end deffn
+
+@deffn Instruction make-int8:0
+Push the immediate value @code{0} onto the stack.
+@end deffn
+
+@deffn Instruction make-int8:1
+Push the immediate value @code{1} onto the stack.
+@end deffn
+
+@deffn Instruction make-int16 value
+Push @var{value}, a 16-bit integer, onto the stack.
+@end deffn
+
+@deffn Instruction make-uint64 value
+Push @var{value}, an unsigned 64-bit integer, onto the stack. The
+value is encoded in 8 bytes, most significant byte first (big-endian).
+@end deffn
+
+@deffn Instruction make-int64 value
+Push @var{value}, a signed 64-bit integer, onto the stack. The value
+is encoded in 8 bytes, most significant byte first (big-endian), in
+twos-complement arithmetic.
+@end deffn
+
+@deffn Instruction make-false
+Push @code{#f} onto the stack.
+@end deffn
+
+@deffn Instruction make-true
+Push @code{#t} onto the stack.
+@end deffn
+
+@deffn Instruction make-eol
+Push @code{'()} onto the stack.
+@end deffn
+
+@deffn Instruction make-char8 value
+Push @var{value}, an 8-bit character, onto the stack.
+@end deffn
+
+@deffn Instruction make-char32 value
+Push @var{value}, an 32-bit character, onto the stack. The value is
+encoded in big-endian order.
+@end deffn
+
+@deffn Instruction make-symbol
+Pops a string off the stack, and pushes a symbol.
+@end deffn
+
+@deffn Instruction make-keyword value
+Pops a symbol off the stack, and pushes a keyword.
+@end deffn
+
+@deffn Instruction list n
+Pops off the top @var{n} values off of the stack, consing them up into
+a list, then pushes that list on the stack. What was the topmost value
+will be the last element in the list. @var{n} is a two-byte value,
+most significant byte first.
+@end deffn
+
+@deffn Instruction vector n
+Create and fill a vector with the top @var{n} values from the stack,
+popping off those values and pushing on the resulting vector. @var{n}
+is a two-byte value, like in @code{vector}.
+@end deffn
+
+@node Miscellaneous Instructions
+@subsubsection Miscellaneous Instructions
+
+@deffn Instruction nop
+Does nothing! Used for padding other instructions to certain
+alignments.
+@end deffn
+
+@deffn Instruction halt
+Exits the VM, returning a SCM value. Normally, this instruction is
+only part of the ``bootstrap program'', a program run when a virtual
+machine is first entered; compiled Scheme procedures will not contain
+this instruction.
+
+If multiple values have been returned, the SCM value will be a
+multiple-values object (@pxref{Multiple Values}).
+@end deffn
+
+@deffn Instruction break
+Does nothing, but invokes the break hook.
+@end deffn
+
+@deffn Instruction drop
+Pops off the top value from the stack, throwing it away.
+@end deffn
+
+@deffn Instruction dup
+Re-pushes the top value onto the stack.
+@end deffn
+
+@deffn Instruction void
+Pushes ``the unspecified value'' onto the stack.
+@end deffn
+
+@node Inlined Scheme Instructions
+@subsubsection Inlined Scheme Instructions
+
+The Scheme compiler can recognize the application of standard Scheme
+procedures. It tries to inline these small operations to avoid the
+overhead of creating new stack frames.
+
+Since most of these operations are historically implemented as C
+primitives, not inlining them would entail constantly calling out from
+the VM to the interpreter, which has some costs---registers must be
+saved, the interpreter has to dispatch, called procedures have to do
+much typechecking, etc. It's much more efficient to inline these
+operations in the virtual machine itself.
+
+All of these instructions pop their arguments from the stack and push
+their results, and take no parameters from the instruction stream.
+Thus, unlike in the previous sections, these instruction definitions
+show stack parameters instead of parameters from the instruction
+stream.
+
+@deffn Instruction not x
+@deffnx Instruction not-not x
+@deffnx Instruction eq? x y
+@deffnx Instruction not-eq? x y
+@deffnx Instruction null?
+@deffnx Instruction not-null?
+@deffnx Instruction eqv? x y
+@deffnx Instruction equal? x y
+@deffnx Instruction pair? x y
+@deffnx Instruction list? x
+@deffnx Instruction set-car! pair x
+@deffnx Instruction set-cdr! pair x
+@deffnx Instruction slot-ref struct n
+@deffnx Instruction slot-set struct n x
+@deffnx Instruction cons x y
+@deffnx Instruction car x
+@deffnx Instruction cdr x
+@deffnx Instruction vector-ref x y
+@deffnx Instruction vector-set x n y
+Inlined implementations of their Scheme equivalents.
+@end deffn
+
+Note that @code{caddr} and friends compile to a series of @code{car}
+and @code{cdr} instructions.
+
+@node Inlined Mathematical Instructions
+@subsubsection Inlined Mathematical Instructions
+
+Inlining mathematical operations has the obvious advantage of handling
+fixnums without function calls or allocations. The trick, of course,
+is knowing when the result of an operation will be a fixnum, and there
+might be a couple bugs here.
+
+More instructions could be added here over time.
+
+As in the previous section, the definitions below show stack
+parameters instead of instruction stream parameters.
+
+@deffn Instruction add x y
+@deffnx Instruction add1 x
+@deffnx Instruction sub x y
+@deffnx Instruction sub1 x
+@deffnx Instruction mul x y
+@deffnx Instruction div x y
+@deffnx Instruction quo x y
+@deffnx Instruction rem x y
+@deffnx Instruction mod x y
+@deffnx Instruction ee? x y
+@deffnx Instruction lt? x y
+@deffnx Instruction gt? x y
+@deffnx Instruction le? x y
+@deffnx Instruction ge? x y
+Inlined implementations of the corresponding mathematical operations.
+@end deffn
+
+@node Inlined Bytevector Instructions
+@subsubsection Inlined Bytevector Instructions
+
+Bytevector operations correspond closely to what the current hardware
+can do, so it makes sense to inline them to VM instructions, providing
+a clear path for eventual native compilation. Without this, Scheme
+programs would need other primitives for accessing raw bytes -- but
+these primitives are as good as any.
+
+As in the previous section, the definitions below show stack
+parameters instead of instruction stream parameters.
+
+The multibyte formats (@code{u16}, @code{f64}, etc) take an extra
+endianness argument. Only aligned native accesses are currently
+fast-pathed in Guile's VM.
+
+@deffn Instruction bv-u8-ref bv n
+@deffnx Instruction bv-s8-ref bv n
+@deffnx Instruction bv-u16-native-ref bv n
+@deffnx Instruction bv-s16-native-ref bv n
+@deffnx Instruction bv-u32-native-ref bv n
+@deffnx Instruction bv-s32-native-ref bv n
+@deffnx Instruction bv-u64-native-ref bv n
+@deffnx Instruction bv-s64-native-ref bv n
+@deffnx Instruction bv-f32-native-ref bv n
+@deffnx Instruction bv-f64-native-ref bv n
+@deffnx Instruction bv-u16-ref bv n endianness
+@deffnx Instruction bv-s16-ref bv n endianness
+@deffnx Instruction bv-u32-ref bv n endianness
+@deffnx Instruction bv-s32-ref bv n endianness
+@deffnx Instruction bv-u64-ref bv n endianness
+@deffnx Instruction bv-s64-ref bv n endianness
+@deffnx Instruction bv-f32-ref bv n endianness
+@deffnx Instruction bv-f64-ref bv n endianness
+@deffnx Instruction bv-u8-set bv n val
+@deffnx Instruction bv-s8-set bv n val
+@deffnx Instruction bv-u16-native-set bv n val
+@deffnx Instruction bv-s16-native-set bv n val
+@deffnx Instruction bv-u32-native-set bv n val
+@deffnx Instruction bv-s32-native-set bv n val
+@deffnx Instruction bv-u64-native-set bv n val
+@deffnx Instruction bv-s64-native-set bv n val
+@deffnx Instruction bv-f32-native-set bv n val
+@deffnx Instruction bv-f64-native-set bv n val
+@deffnx Instruction bv-u16-set bv n val endianness
+@deffnx Instruction bv-s16-set bv n val endianness
+@deffnx Instruction bv-u32-set bv n val endianness
+@deffnx Instruction bv-s32-set bv n val endianness
+@deffnx Instruction bv-u64-set bv n val endianness
+@deffnx Instruction bv-s64-set bv n val endianness
+@deffnx Instruction bv-f32-set bv n val endianness
+@deffnx Instruction bv-f64-set bv n val endianness
+Inlined implementations of the corresponding bytevector operations.
+@end deffn
diff --git a/doc/texinfo.tex b/doc/texinfo.tex
new file mode 100644
index 000000000..d2b264dd9
--- /dev/null
+++ b/doc/texinfo.tex
@@ -0,0 +1,8962 @@
+% texinfo.tex -- TeX macros to handle Texinfo files.
+%
+% Load plain if necessary, i.e., if running under initex.
+\expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi
+%
+\def\texinfoversion{2007-12-02.17}
+%
+% Copyright (C) 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995, 2007,
+% 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
+% 2007 Free Software Foundation, Inc.
+%
+% This texinfo.tex file is free software: you can redistribute it and/or
+% modify it under the terms of the GNU General Public License as
+% published by the Free Software Foundation, either version 3 of the
+% License, or (at your option) any later version.
+%
+% This texinfo.tex file is distributed in the hope that it will be
+% useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+% of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+% General Public License for more details.
+%
+% You should have received a copy of the GNU General Public License
+% along with this program.  If not, see <http://www.gnu.org/licenses/>.
+%
+% As a special exception, when this file is read by TeX when processing
+% a Texinfo source document, you may use the result without
+% restriction.  (This has been our intent since Texinfo was invented.)
+%
+% Please try the latest version of texinfo.tex before submitting bug
+% reports; you can get the latest version from:
+%   http://www.gnu.org/software/texinfo/ (the Texinfo home page), or
+%   ftp://tug.org/tex/texinfo.tex
+%     (and all CTAN mirrors, see http://www.ctan.org).
+% The texinfo.tex in any given distribution could well be out
+% of date, so if that's what you're using, please check.
+%
+% Send bug reports to bug-texinfo@gnu.org.  Please include including a
+% complete document in each bug report with which we can reproduce the
+% problem.  Patches are, of course, greatly appreciated.
+%
+% To process a Texinfo manual with TeX, it's most reliable to use the
+% texi2dvi shell script that comes with the distribution.  For a simple
+% manual foo.texi, however, you can get away with this:
+%   tex foo.texi
+%   texindex foo.??
+%   tex foo.texi
+%   tex foo.texi
+%   dvips foo.dvi -o  # or whatever; this makes foo.ps.
+% The extra TeX runs get the cross-reference information correct.
+% Sometimes one run after texindex suffices, and sometimes you need more
+% than two; texi2dvi does it as many times as necessary.
+%
+% It is possible to adapt texinfo.tex for other languages, to some
+% extent.  You can get the existing language-specific files from the
+% full Texinfo distribution.
+%
+% The GNU Texinfo home page is http://www.gnu.org/software/texinfo.
+
+
+\message{Loading texinfo [version \texinfoversion]:}
+
+% If in a .fmt file, print the version number
+% and turn on active characters that we couldn't do earlier because
+% they might have appeared in the input file name.
+\everyjob{\message{[Texinfo version \texinfoversion]}%
+  \catcode`+=\active \catcode`\_=\active}
+
+
+\chardef\other=12
+
+% We never want plain's \outer definition of \+ in Texinfo.
+% For @tex, we can use \tabalign.
+\let\+ = \relax
+
+% Save some plain tex macros whose names we will redefine.
+\let\ptexb=\b
+\let\ptexbullet=\bullet
+\let\ptexc=\c
+\let\ptexcomma=\,
+\let\ptexdot=\.
+\let\ptexdots=\dots
+\let\ptexend=\end
+\let\ptexequiv=\equiv
+\let\ptexexclam=\!
+\let\ptexfootnote=\footnote
+\let\ptexgtr=>
+\let\ptexhat=^
+\let\ptexi=\i
+\let\ptexindent=\indent
+\let\ptexinsert=\insert
+\let\ptexlbrace=\{
+\let\ptexless=<
+\let\ptexnewwrite\newwrite
+\let\ptexnoindent=\noindent
+\let\ptexplus=+
+\let\ptexrbrace=\}
+\let\ptexslash=\/
+\let\ptexstar=\*
+\let\ptext=\t
+
+% If this character appears in an error message or help string, it
+% starts a new line in the output.
+\newlinechar = `^^J
+
+% Use TeX 3.0's \inputlineno to get the line number, for better error
+% messages, but if we're using an old version of TeX, don't do anything.
+%
+\ifx\inputlineno\thisisundefined
+  \let\linenumber = \empty % Pre-3.0.
+\else
+  \def\linenumber{l.\the\inputlineno:\space}
+\fi
+
+% Set up fixed words for English if not already set.
+\ifx\putwordAppendix\undefined  \gdef\putwordAppendix{Appendix}\fi
+\ifx\putwordChapter\undefined   \gdef\putwordChapter{Chapter}\fi
+\ifx\putwordfile\undefined      \gdef\putwordfile{file}\fi
+\ifx\putwordin\undefined        \gdef\putwordin{in}\fi
+\ifx\putwordIndexIsEmpty\undefined     \gdef\putwordIndexIsEmpty{(Index is empty)}\fi
+\ifx\putwordIndexNonexistent\undefined \gdef\putwordIndexNonexistent{(Index is nonexistent)}\fi
+\ifx\putwordInfo\undefined      \gdef\putwordInfo{Info}\fi
+\ifx\putwordInstanceVariableof\undefined \gdef\putwordInstanceVariableof{Instance Variable of}\fi
+\ifx\putwordMethodon\undefined  \gdef\putwordMethodon{Method on}\fi
+\ifx\putwordNoTitle\undefined   \gdef\putwordNoTitle{No Title}\fi
+\ifx\putwordof\undefined        \gdef\putwordof{of}\fi
+\ifx\putwordon\undefined        \gdef\putwordon{on}\fi
+\ifx\putwordpage\undefined      \gdef\putwordpage{page}\fi
+\ifx\putwordsection\undefined   \gdef\putwordsection{section}\fi
+\ifx\putwordSection\undefined   \gdef\putwordSection{Section}\fi
+\ifx\putwordsee\undefined       \gdef\putwordsee{see}\fi
+\ifx\putwordSee\undefined       \gdef\putwordSee{See}\fi
+\ifx\putwordShortTOC\undefined  \gdef\putwordShortTOC{Short Contents}\fi
+\ifx\putwordTOC\undefined       \gdef\putwordTOC{Table of Contents}\fi
+%
+\ifx\putwordMJan\undefined \gdef\putwordMJan{January}\fi
+\ifx\putwordMFeb\undefined \gdef\putwordMFeb{February}\fi
+\ifx\putwordMMar\undefined \gdef\putwordMMar{March}\fi
+\ifx\putwordMApr\undefined \gdef\putwordMApr{April}\fi
+\ifx\putwordMMay\undefined \gdef\putwordMMay{May}\fi
+\ifx\putwordMJun\undefined \gdef\putwordMJun{June}\fi
+\ifx\putwordMJul\undefined \gdef\putwordMJul{July}\fi
+\ifx\putwordMAug\undefined \gdef\putwordMAug{August}\fi
+\ifx\putwordMSep\undefined \gdef\putwordMSep{September}\fi
+\ifx\putwordMOct\undefined \gdef\putwordMOct{October}\fi
+\ifx\putwordMNov\undefined \gdef\putwordMNov{November}\fi
+\ifx\putwordMDec\undefined \gdef\putwordMDec{December}\fi
+%
+\ifx\putwordDefmac\undefined    \gdef\putwordDefmac{Macro}\fi
+\ifx\putwordDefspec\undefined   \gdef\putwordDefspec{Special Form}\fi
+\ifx\putwordDefvar\undefined    \gdef\putwordDefvar{Variable}\fi
+\ifx\putwordDefopt\undefined    \gdef\putwordDefopt{User Option}\fi
+\ifx\putwordDeffunc\undefined   \gdef\putwordDeffunc{Function}\fi
+
+% Since the category of space is not known, we have to be careful.
+\chardef\spacecat = 10
+\def\spaceisspace{\catcode`\ =\spacecat}
+
+% sometimes characters are active, so we need control sequences.
+\chardef\colonChar = `\:
+\chardef\commaChar = `\,
+\chardef\dashChar  = `\-
+\chardef\dotChar   = `\.
+\chardef\exclamChar= `\!
+\chardef\lquoteChar= `\`
+\chardef\questChar = `\?
+\chardef\rquoteChar= `\'
+\chardef\semiChar  = `\;
+\chardef\underChar = `\_
+
+% Ignore a token.
+%
+\def\gobble#1{}
+
+% The following is used inside several \edef's.
+\def\makecsname#1{\expandafter\noexpand\csname#1\endcsname}
+
+% Hyphenation fixes.
+\hyphenation{
+  Flor-i-da Ghost-script Ghost-view Mac-OS Post-Script
+  ap-pen-dix bit-map bit-maps
+  data-base data-bases eshell fall-ing half-way long-est man-u-script
+  man-u-scripts mini-buf-fer mini-buf-fers over-view par-a-digm
+  par-a-digms rath-er rec-tan-gu-lar ro-bot-ics se-vere-ly set-up spa-ces
+  spell-ing spell-ings
+  stand-alone strong-est time-stamp time-stamps which-ever white-space
+  wide-spread wrap-around
+}
+
+% Margin to add to right of even pages, to left of odd pages.
+\newdimen\bindingoffset
+\newdimen\normaloffset
+\newdimen\pagewidth \newdimen\pageheight
+
+% For a final copy, take out the rectangles
+% that mark overfull boxes (in case you have decided
+% that the text looks ok even though it passes the margin).
+%
+\def\finalout{\overfullrule=0pt}
+
+% @| inserts a changebar to the left of the current line.  It should
+% surround any changed text.  This approach does *not* work if the
+% change spans more than two lines of output.  To handle that, we would
+% have adopt a much more difficult approach (putting marks into the main
+% vertical list for the beginning and end of each change).
+%
+\def\|{%
+  % \vadjust can only be used in horizontal mode.
+  \leavevmode
+  %
+  % Append this vertical mode material after the current line in the output.
+  \vadjust{%
+    % We want to insert a rule with the height and depth of the current
+    % leading; that is exactly what \strutbox is supposed to record.
+    \vskip-\baselineskip
+    %
+    % \vadjust-items are inserted at the left edge of the type.  So
+    % the \llap here moves out into the left-hand margin.
+    \llap{%
+      %
+      % For a thicker or thinner bar, change the `1pt'.
+      \vrule height\baselineskip width1pt
+      %
+      % This is the space between the bar and the text.
+      \hskip 12pt
+    }%
+  }%
+}
+
+% Sometimes it is convenient to have everything in the transcript file
+% and nothing on the terminal.  We don't just call \tracingall here,
+% since that produces some useless output on the terminal.  We also make
+% some effort to order the tracing commands to reduce output in the log
+% file; cf. trace.sty in LaTeX.
+%
+\def\gloggingall{\begingroup \globaldefs = 1 \loggingall \endgroup}%
+\def\loggingall{%
+  \tracingstats2
+  \tracingpages1
+  \tracinglostchars2  % 2 gives us more in etex
+  \tracingparagraphs1
+  \tracingoutput1
+  \tracingmacros2
+  \tracingrestores1
+  \showboxbreadth\maxdimen \showboxdepth\maxdimen
+  \ifx\eTeXversion\undefined\else % etex gives us more logging
+    \tracingscantokens1
+    \tracingifs1
+    \tracinggroups1
+    \tracingnesting2
+    \tracingassigns1
+  \fi
+  \tracingcommands3  % 3 gives us more in etex
+  \errorcontextlines16
+}%
+
+% add check for \lastpenalty to plain's definitions.  If the last thing
+% we did was a \nobreak, we don't want to insert more space.
+%
+\def\smallbreak{\ifnum\lastpenalty<10000\par\ifdim\lastskip<\smallskipamount
+  \removelastskip\penalty-50\smallskip\fi\fi}
+\def\medbreak{\ifnum\lastpenalty<10000\par\ifdim\lastskip<\medskipamount
+  \removelastskip\penalty-100\medskip\fi\fi}
+\def\bigbreak{\ifnum\lastpenalty<10000\par\ifdim\lastskip<\bigskipamount
+  \removelastskip\penalty-200\bigskip\fi\fi}
+
+% For @cropmarks command.
+% Do @cropmarks to get crop marks.
+%
+\newif\ifcropmarks
+\let\cropmarks = \cropmarkstrue
+%
+% Dimensions to add cropmarks at corners.
+% Added by P. A. MacKay, 12 Nov. 1986
+%
+\newdimen\outerhsize \newdimen\outervsize % set by the paper size routines
+\newdimen\cornerlong  \cornerlong=1pc
+\newdimen\cornerthick \cornerthick=.3pt
+\newdimen\topandbottommargin \topandbottommargin=.75in
+
+% Output a mark which sets \thischapter, \thissection and \thiscolor.
+% We dump everything together because we only have one kind of mark.
+% This works because we only use \botmark / \topmark, not \firstmark.
+%
+% A mark contains a subexpression of the \ifcase ... \fi construct.
+% \get*marks macros below extract the needed part using \ifcase.
+%
+% Another complication is to let the user choose whether \thischapter
+% (\thissection) refers to the chapter (section) in effect at the top
+% of a page, or that at the bottom of a page.  The solution is
+% described on page 260 of The TeXbook.  It involves outputting two
+% marks for the sectioning macros, one before the section break, and
+% one after.  I won't pretend I can describe this better than DEK...
+\def\domark{%
+  \toks0=\expandafter{\lastchapterdefs}%
+  \toks2=\expandafter{\lastsectiondefs}%
+  \toks4=\expandafter{\prevchapterdefs}%
+  \toks6=\expandafter{\prevsectiondefs}%
+  \toks8=\expandafter{\lastcolordefs}%
+  \mark{%
+                   \the\toks0 \the\toks2
+      \noexpand\or \the\toks4 \the\toks6
+    \noexpand\else \the\toks8
+  }%
+}
+% \topmark doesn't work for the very first chapter (after the title
+% page or the contents), so we use \firstmark there -- this gets us
+% the mark with the chapter defs, unless the user sneaks in, e.g.,
+% @setcolor (or @url, or @link, etc.) between @contents and the very
+% first @chapter.
+\def\gettopheadingmarks{%
+  \ifcase0\topmark\fi
+  \ifx\thischapter\empty \ifcase0\firstmark\fi \fi
+}
+\def\getbottomheadingmarks{\ifcase1\botmark\fi}
+\def\getcolormarks{\ifcase2\topmark\fi}
+
+% Avoid "undefined control sequence" errors.
+\def\lastchapterdefs{}
+\def\lastsectiondefs{}
+\def\prevchapterdefs{}
+\def\prevsectiondefs{}
+\def\lastcolordefs{}
+
+% Main output routine.
+\chardef\PAGE = 255
+\output = {\onepageout{\pagecontents\PAGE}}
+
+\newbox\headlinebox
+\newbox\footlinebox
+
+% \onepageout takes a vbox as an argument.  Note that \pagecontents
+% does insertions, but you have to call it yourself.
+\def\onepageout#1{%
+  \ifcropmarks \hoffset=0pt \else \hoffset=\normaloffset \fi
+  %
+  \ifodd\pageno  \advance\hoffset by \bindingoffset
+  \else \advance\hoffset by -\bindingoffset\fi
+  %
+  % Do this outside of the \shipout so @code etc. will be expanded in
+  % the headline as they should be, not taken literally (outputting ''code).
+  \ifodd\pageno \getoddheadingmarks \else \getevenheadingmarks \fi
+  \setbox\headlinebox = \vbox{\let\hsize=\pagewidth \makeheadline}%
+  \ifodd\pageno \getoddfootingmarks \else \getevenfootingmarks \fi
+  \setbox\footlinebox = \vbox{\let\hsize=\pagewidth \makefootline}%
+  %
+  {%
+    % Have to do this stuff outside the \shipout because we want it to
+    % take effect in \write's, yet the group defined by the \vbox ends
+    % before the \shipout runs.
+    %
+    \indexdummies         % don't expand commands in the output.
+    \normalturnoffactive  % \ in index entries must not stay \, e.g., if
+               % the page break happens to be in the middle of an example.
+               % We don't want .vr (or whatever) entries like this:
+               % \entry{{\tt \indexbackslash }acronym}{32}{\code {\acronym}}
+               % "\acronym" won't work when it's read back in;
+               % it needs to be 
+               % {\code {{\tt \backslashcurfont }acronym}
+    \shipout\vbox{%
+      % Do this early so pdf references go to the beginning of the page.
+      \ifpdfmakepagedest \pdfdest name{\the\pageno} xyz\fi
+      %
+      \ifcropmarks \vbox to \outervsize\bgroup
+        \hsize = \outerhsize
+        \vskip-\topandbottommargin
+        \vtop to0pt{%
+          \line{\ewtop\hfil\ewtop}%
+          \nointerlineskip
+          \line{%
+            \vbox{\moveleft\cornerthick\nstop}%
+            \hfill
+            \vbox{\moveright\cornerthick\nstop}%
+          }%
+          \vss}%
+        \vskip\topandbottommargin
+        \line\bgroup
+          \hfil % center the page within the outer (page) hsize.
+          \ifodd\pageno\hskip\bindingoffset\fi
+          \vbox\bgroup
+      \fi
+      %
+      \unvbox\headlinebox
+      \pagebody{#1}%
+      \ifdim\ht\footlinebox > 0pt
+        % Only leave this space if the footline is nonempty.
+        % (We lessened \vsize for it in \oddfootingyyy.)
+        % The \baselineskip=24pt in plain's \makefootline has no effect.
+        \vskip 24pt
+        \unvbox\footlinebox
+      \fi
+      %
+      \ifcropmarks
+          \egroup % end of \vbox\bgroup
+        \hfil\egroup % end of (centering) \line\bgroup
+        \vskip\topandbottommargin plus1fill minus1fill
+        \boxmaxdepth = \cornerthick
+        \vbox to0pt{\vss
+          \line{%
+            \vbox{\moveleft\cornerthick\nsbot}%
+            \hfill
+            \vbox{\moveright\cornerthick\nsbot}%
+          }%
+          \nointerlineskip
+          \line{\ewbot\hfil\ewbot}%
+        }%
+      \egroup % \vbox from first cropmarks clause
+      \fi
+    }% end of \shipout\vbox
+  }% end of group with \indexdummies
+  \advancepageno
+  \ifnum\outputpenalty>-20000 \else\dosupereject\fi
+}
+
+\newinsert\margin \dimen\margin=\maxdimen
+
+\def\pagebody#1{\vbox to\pageheight{\boxmaxdepth=\maxdepth #1}}
+{\catcode`\@ =11
+\gdef\pagecontents#1{\ifvoid\topins\else\unvbox\topins\fi
+% marginal hacks, juha@viisa.uucp (Juha Takala)
+\ifvoid\margin\else % marginal info is present
+  \rlap{\kern\hsize\vbox to\z@{\kern1pt\box\margin \vss}}\fi
+\dimen@=\dp#1\relax \unvbox#1\relax
+\ifvoid\footins\else\vskip\skip\footins\footnoterule \unvbox\footins\fi
+\ifr@ggedbottom \kern-\dimen@ \vfil \fi}
+}
+
+% Here are the rules for the cropmarks.  Note that they are
+% offset so that the space between them is truly \outerhsize or \outervsize
+% (P. A. MacKay, 12 November, 1986)
+%
+\def\ewtop{\vrule height\cornerthick depth0pt width\cornerlong}
+\def\nstop{\vbox
+  {\hrule height\cornerthick depth\cornerlong width\cornerthick}}
+\def\ewbot{\vrule height0pt depth\cornerthick width\cornerlong}
+\def\nsbot{\vbox
+  {\hrule height\cornerlong depth\cornerthick width\cornerthick}}
+
+% Parse an argument, then pass it to #1.  The argument is the rest of
+% the input line (except we remove a trailing comment).  #1 should be a
+% macro which expects an ordinary undelimited TeX argument.
+%
+\def\parsearg{\parseargusing{}}
+\def\parseargusing#1#2{%
+  \def\argtorun{#2}%
+  \begingroup
+    \obeylines
+    \spaceisspace
+    #1%
+    \parseargline\empty% Insert the \empty token, see \finishparsearg below.
+}
+
+{\obeylines %
+  \gdef\parseargline#1^^M{%
+    \endgroup % End of the group started in \parsearg.
+    \argremovecomment #1\comment\ArgTerm%
+  }%
+}
+
+% First remove any @comment, then any @c comment.
+\def\argremovecomment#1\comment#2\ArgTerm{\argremovec #1\c\ArgTerm}
+\def\argremovec#1\c#2\ArgTerm{\argcheckspaces#1\^^M\ArgTerm}
+
+% Each occurence of `\^^M' or `<space>\^^M' is replaced by a single space.
+%
+% \argremovec might leave us with trailing space, e.g.,
+%    @end itemize  @c foo
+% This space token undergoes the same procedure and is eventually removed
+% by \finishparsearg.
+%
+\def\argcheckspaces#1\^^M{\argcheckspacesX#1\^^M \^^M}
+\def\argcheckspacesX#1 \^^M{\argcheckspacesY#1\^^M}
+\def\argcheckspacesY#1\^^M#2\^^M#3\ArgTerm{%
+  \def\temp{#3}%
+  \ifx\temp\empty
+    % Do not use \next, perhaps the caller of \parsearg uses it; reuse \temp:
+    \let\temp\finishparsearg
+  \else
+    \let\temp\argcheckspaces
+  \fi
+  % Put the space token in:
+  \temp#1 #3\ArgTerm
+}
+
+% If a _delimited_ argument is enclosed in braces, they get stripped; so
+% to get _exactly_ the rest of the line, we had to prevent such situation.
+% We prepended an \empty token at the very beginning and we expand it now,
+% just before passing the control to \argtorun.
+% (Similarily, we have to think about #3 of \argcheckspacesY above: it is
+% either the null string, or it ends with \^^M---thus there is no danger
+% that a pair of braces would be stripped.
+%
+% But first, we have to remove the trailing space token.
+%
+\def\finishparsearg#1 \ArgTerm{\expandafter\argtorun\expandafter{#1}}
+
+% \parseargdef\foo{...}
+%	is roughly equivalent to
+% \def\foo{\parsearg\Xfoo}
+% \def\Xfoo#1{...}
+%
+% Actually, I use \csname\string\foo\endcsname, ie. \\foo, as it is my
+% favourite TeX trick.  --kasal, 16nov03
+
+\def\parseargdef#1{%
+  \expandafter \doparseargdef \csname\string#1\endcsname #1%
+}
+\def\doparseargdef#1#2{%
+  \def#2{\parsearg#1}%
+  \def#1##1%
+}
+
+% Several utility definitions with active space:
+{
+  \obeyspaces
+  \gdef\obeyedspace{ }
+
+  % Make each space character in the input produce a normal interword
+  % space in the output.  Don't allow a line break at this space, as this
+  % is used only in environments like @example, where each line of input
+  % should produce a line of output anyway.
+  %
+  \gdef\sepspaces{\obeyspaces\let =\tie}
+
+  % If an index command is used in an @example environment, any spaces
+  % therein should become regular spaces in the raw index file, not the
+  % expansion of \tie (\leavevmode \penalty \@M \ ).
+  \gdef\unsepspaces{\let =\space}
+}
+
+
+\def\flushcr{\ifx\par\lisppar \def\next##1{}\else \let\next=\relax \fi \next}
+
+% Define the framework for environments in texinfo.tex.  It's used like this:
+%
+%   \envdef\foo{...}
+%   \def\Efoo{...}
+%
+% It's the responsibility of \envdef to insert \begingroup before the
+% actual body; @end closes the group after calling \Efoo.  \envdef also
+% defines \thisenv, so the current environment is known; @end checks
+% whether the environment name matches.  The \checkenv macro can also be
+% used to check whether the current environment is the one expected.
+%
+% Non-false conditionals (@iftex, @ifset) don't fit into this, so they
+% are not treated as enviroments; they don't open a group.  (The
+% implementation of @end takes care not to call \endgroup in this
+% special case.)
+
+
+% At runtime, environments start with this:
+\def\startenvironment#1{\begingroup\def\thisenv{#1}}
+% initialize
+\let\thisenv\empty
+
+% ... but they get defined via ``\envdef\foo{...}'':
+\long\def\envdef#1#2{\def#1{\startenvironment#1#2}}
+\def\envparseargdef#1#2{\parseargdef#1{\startenvironment#1#2}}
+
+% Check whether we're in the right environment:
+\def\checkenv#1{%
+  \def\temp{#1}%
+  \ifx\thisenv\temp
+  \else
+    \badenverr
+  \fi
+}
+
+% Evironment mismatch, #1 expected:
+\def\badenverr{%
+  \errhelp = \EMsimple
+  \errmessage{This command can appear only \inenvironment\temp,
+    not \inenvironment\thisenv}%
+}
+\def\inenvironment#1{%
+  \ifx#1\empty
+    out of any environment%
+  \else
+    in environment \expandafter\string#1%
+  \fi
+}
+
+% @end foo executes the definition of \Efoo.
+% But first, it executes a specialized version of \checkenv
+%
+\parseargdef\end{%
+  \if 1\csname iscond.#1\endcsname
+  \else
+    % The general wording of \badenverr may not be ideal, but... --kasal, 06nov03
+    \expandafter\checkenv\csname#1\endcsname
+    \csname E#1\endcsname
+    \endgroup
+  \fi
+}
+
+\newhelp\EMsimple{Press RETURN to continue.}
+
+
+%% Simple single-character @ commands
+
+% @@ prints an @
+% Kludge this until the fonts are right (grr).
+\def\@{{\tt\char64}}
+
+% This is turned off because it was never documented
+% and you can use @w{...} around a quote to suppress ligatures.
+%% Define @` and @' to be the same as ` and '
+%% but suppressing ligatures.
+%\def\`{{`}}
+%\def\'{{'}}
+
+% Used to generate quoted braces.
+\def\mylbrace {{\tt\char123}}
+\def\myrbrace {{\tt\char125}}
+\let\{=\mylbrace
+\let\}=\myrbrace
+\begingroup
+  % Definitions to produce \{ and \} commands for indices,
+  % and @{ and @} for the aux/toc files.
+  \catcode`\{ = \other \catcode`\} = \other
+  \catcode`\[ = 1 \catcode`\] = 2
+  \catcode`\! = 0 \catcode`\\ = \other
+  !gdef!lbracecmd[\{]%
+  !gdef!rbracecmd[\}]%
+  !gdef!lbraceatcmd[@{]%
+  !gdef!rbraceatcmd[@}]%
+!endgroup
+
+% @comma{} to avoid , parsing problems.
+\let\comma = ,
+
+% Accents: @, @dotaccent @ringaccent @ubaraccent @udotaccent
+% Others are defined by plain TeX: @` @' @" @^ @~ @= @u @v @H.
+\let\, = \c
+\let\dotaccent = \.
+\def\ringaccent#1{{\accent23 #1}}
+\let\tieaccent = \t
+\let\ubaraccent = \b
+\let\udotaccent = \d
+
+% Other special characters: @questiondown @exclamdown @ordf @ordm
+% Plain TeX defines: @AA @AE @O @OE @L (plus lowercase versions) @ss.
+\def\questiondown{?`}
+\def\exclamdown{!`}
+\def\ordf{\leavevmode\raise1ex\hbox{\selectfonts\lllsize \underbar{a}}}
+\def\ordm{\leavevmode\raise1ex\hbox{\selectfonts\lllsize \underbar{o}}}
+
+% Dotless i and dotless j, used for accents.
+\def\imacro{i}
+\def\jmacro{j}
+\def\dotless#1{%
+  \def\temp{#1}%
+  \ifx\temp\imacro \ptexi
+  \else\ifx\temp\jmacro \j
+  \else \errmessage{@dotless can be used only with i or j}%
+  \fi\fi
+}
+
+% The \TeX{} logo, as in plain, but resetting the spacing so that a
+% period following counts as ending a sentence.  (Idea found in latex.)
+%
+\edef\TeX{\TeX \spacefactor=1000 }
+
+% @LaTeX{} logo.  Not quite the same results as the definition in
+% latex.ltx, since we use a different font for the raised A; it's most
+% convenient for us to use an explicitly smaller font, rather than using
+% the \scriptstyle font (since we don't reset \scriptstyle and
+% \scriptscriptstyle).
+%
+\def\LaTeX{%
+  L\kern-.36em
+  {\setbox0=\hbox{T}%
+   \vbox to \ht0{\hbox{\selectfonts\lllsize A}\vss}}%
+  \kern-.15em
+  \TeX
+}
+
+% Be sure we're in horizontal mode when doing a tie, since we make space
+% equivalent to this in @example-like environments. Otherwise, a space
+% at the beginning of a line will start with \penalty -- and
+% since \penalty is valid in vertical mode, we'd end up putting the
+% penalty on the vertical list instead of in the new paragraph.
+{\catcode`@ = 11
+ % Avoid using \@M directly, because that causes trouble
+ % if the definition is written into an index file.
+ \global\let\tiepenalty = \@M
+ \gdef\tie{\leavevmode\penalty\tiepenalty\ }
+}
+
+% @: forces normal size whitespace following.
+\def\:{\spacefactor=1000 }
+
+% @* forces a line break.
+\def\*{\hfil\break\hbox{}\ignorespaces}
+
+% @/ allows a line break.
+\let\/=\allowbreak
+
+% @. is an end-of-sentence period.
+\def\.{.\spacefactor=\endofsentencespacefactor\space}
+
+% @! is an end-of-sentence bang.
+\def\!{!\spacefactor=\endofsentencespacefactor\space}
+
+% @? is an end-of-sentence query.
+\def\?{?\spacefactor=\endofsentencespacefactor\space}
+
+% @frenchspacing on|off  says whether to put extra space after punctuation.
+% 
+\def\onword{on}
+\def\offword{off}
+%
+\parseargdef\frenchspacing{%
+  \def\temp{#1}%
+  \ifx\temp\onword \plainfrenchspacing
+  \else\ifx\temp\offword \plainnonfrenchspacing
+  \else
+    \errhelp = \EMsimple
+    \errmessage{Unknown @frenchspacing option `\temp', must be on/off}%
+  \fi\fi
+}
+
+% @w prevents a word break.  Without the \leavevmode, @w at the
+% beginning of a paragraph, when TeX is still in vertical mode, would
+% produce a whole line of output instead of starting the paragraph.
+\def\w#1{\leavevmode\hbox{#1}}
+
+% @group ... @end group forces ... to be all on one page, by enclosing
+% it in a TeX vbox.  We use \vtop instead of \vbox to construct the box
+% to keep its height that of a normal line.  According to the rules for
+% \topskip (p.114 of the TeXbook), the glue inserted is
+% max (\topskip - \ht (first item), 0).  If that height is large,
+% therefore, no glue is inserted, and the space between the headline and
+% the text is small, which looks bad.
+%
+% Another complication is that the group might be very large.  This can
+% cause the glue on the previous page to be unduly stretched, because it
+% does not have much material.  In this case, it's better to add an
+% explicit \vfill so that the extra space is at the bottom.  The
+% threshold for doing this is if the group is more than \vfilllimit
+% percent of a page (\vfilllimit can be changed inside of @tex).
+%
+\newbox\groupbox
+\def\vfilllimit{0.7}
+%
+\envdef\group{%
+  \ifnum\catcode`\^^M=\active \else
+    \errhelp = \groupinvalidhelp
+    \errmessage{@group invalid in context where filling is enabled}%
+  \fi
+  \startsavinginserts
+  %
+  \setbox\groupbox = \vtop\bgroup
+    % Do @comment since we are called inside an environment such as
+    % @example, where each end-of-line in the input causes an
+    % end-of-line in the output.  We don't want the end-of-line after
+    % the `@group' to put extra space in the output.  Since @group
+    % should appear on a line by itself (according to the Texinfo
+    % manual), we don't worry about eating any user text.
+    \comment
+}
+%
+% The \vtop produces a box with normal height and large depth; thus, TeX puts
+% \baselineskip glue before it, and (when the next line of text is done)
+% \lineskip glue after it.  Thus, space below is not quite equal to space
+% above.  But it's pretty close.
+\def\Egroup{%
+    % To get correct interline space between the last line of the group
+    % and the first line afterwards, we have to propagate \prevdepth.
+    \endgraf % Not \par, as it may have been set to \lisppar.
+    \global\dimen1 = \prevdepth
+  \egroup           % End the \vtop.
+  % \dimen0 is the vertical size of the group's box.
+  \dimen0 = \ht\groupbox  \advance\dimen0 by \dp\groupbox
+  % \dimen2 is how much space is left on the page (more or less).
+  \dimen2 = \pageheight   \advance\dimen2 by -\pagetotal
+  % if the group doesn't fit on the current page, and it's a big big
+  % group, force a page break.
+  \ifdim \dimen0 > \dimen2
+    \ifdim \pagetotal < \vfilllimit\pageheight
+      \page
+    \fi
+  \fi
+  \box\groupbox
+  \prevdepth = \dimen1
+  \checkinserts
+}
+%
+% TeX puts in an \escapechar (i.e., `@') at the beginning of the help
+% message, so this ends up printing `@group can only ...'.
+%
+\newhelp\groupinvalidhelp{%
+group can only be used in environments such as @example,^^J%
+where each line of input produces a line of output.}
+
+% @need space-in-mils
+% forces a page break if there is not space-in-mils remaining.
+
+\newdimen\mil  \mil=0.001in
+
+% Old definition--didn't work.
+%\parseargdef\need{\par %
+%% This method tries to make TeX break the page naturally
+%% if the depth of the box does not fit.
+%{\baselineskip=0pt%
+%\vtop to #1\mil{\vfil}\kern -#1\mil\nobreak
+%\prevdepth=-1000pt
+%}}
+
+\parseargdef\need{%
+  % Ensure vertical mode, so we don't make a big box in the middle of a
+  % paragraph.
+  \par
+  %
+  % If the @need value is less than one line space, it's useless.
+  \dimen0 = #1\mil
+  \dimen2 = \ht\strutbox
+  \advance\dimen2 by \dp\strutbox
+  \ifdim\dimen0 > \dimen2
+    %
+    % Do a \strut just to make the height of this box be normal, so the
+    % normal leading is inserted relative to the preceding line.
+    % And a page break here is fine.
+    \vtop to #1\mil{\strut\vfil}%
+    %
+    % TeX does not even consider page breaks if a penalty added to the
+    % main vertical list is 10000 or more.  But in order to see if the
+    % empty box we just added fits on the page, we must make it consider
+    % page breaks.  On the other hand, we don't want to actually break the
+    % page after the empty box.  So we use a penalty of 9999.
+    %
+    % There is an extremely small chance that TeX will actually break the
+    % page at this \penalty, if there are no other feasible breakpoints in
+    % sight.  (If the user is using lots of big @group commands, which
+    % almost-but-not-quite fill up a page, TeX will have a hard time doing
+    % good page breaking, for example.)  However, I could not construct an
+    % example where a page broke at this \penalty; if it happens in a real
+    % document, then we can reconsider our strategy.
+    \penalty9999
+    %
+    % Back up by the size of the box, whether we did a page break or not.
+    \kern -#1\mil
+    %
+    % Do not allow a page break right after this kern.
+    \nobreak
+  \fi
+}
+
+% @br   forces paragraph break (and is undocumented).
+
+\let\br = \par
+
+% @page forces the start of a new page.
+%
+\def\page{\par\vfill\supereject}
+
+% @exdent text....
+% outputs text on separate line in roman font, starting at standard page margin
+
+% This records the amount of indent in the innermost environment.
+% That's how much \exdent should take out.
+\newskip\exdentamount
+
+% This defn is used inside fill environments such as @defun.
+\parseargdef\exdent{\hfil\break\hbox{\kern -\exdentamount{\rm#1}}\hfil\break}
+
+% This defn is used inside nofill environments such as @example.
+\parseargdef\nofillexdent{{\advance \leftskip by -\exdentamount
+  \leftline{\hskip\leftskip{\rm#1}}}}
+
+% @inmargin{WHICH}{TEXT} puts TEXT in the WHICH margin next to the current
+% paragraph.  For more general purposes, use the \margin insertion
+% class.  WHICH is `l' or `r'.
+%
+\newskip\inmarginspacing \inmarginspacing=1cm
+\def\strutdepth{\dp\strutbox}
+%
+\def\doinmargin#1#2{\strut\vadjust{%
+  \nobreak
+  \kern-\strutdepth
+  \vtop to \strutdepth{%
+    \baselineskip=\strutdepth
+    \vss
+    % if you have multiple lines of stuff to put here, you'll need to
+    % make the vbox yourself of the appropriate size.
+    \ifx#1l%
+      \llap{\ignorespaces #2\hskip\inmarginspacing}%
+    \else
+      \rlap{\hskip\hsize \hskip\inmarginspacing \ignorespaces #2}%
+    \fi
+    \null
+  }%
+}}
+\def\inleftmargin{\doinmargin l}
+\def\inrightmargin{\doinmargin r}
+%
+% @inmargin{TEXT [, RIGHT-TEXT]}
+% (if RIGHT-TEXT is given, use TEXT for left page, RIGHT-TEXT for right;
+% else use TEXT for both).
+%
+\def\inmargin#1{\parseinmargin #1,,\finish}
+\def\parseinmargin#1,#2,#3\finish{% not perfect, but better than nothing.
+  \setbox0 = \hbox{\ignorespaces #2}%
+  \ifdim\wd0 > 0pt
+    \def\lefttext{#1}%  have both texts
+    \def\righttext{#2}%
+  \else
+    \def\lefttext{#1}%  have only one text
+    \def\righttext{#1}%
+  \fi
+  %
+  \ifodd\pageno
+    \def\temp{\inrightmargin\righttext}% odd page -> outside is right margin
+  \else
+    \def\temp{\inleftmargin\lefttext}%
+  \fi
+  \temp
+}
+
+% @include file    insert text of that file as input.
+%
+\def\include{\parseargusing\filenamecatcodes\includezzz}
+\def\includezzz#1{%
+  \pushthisfilestack
+  \def\thisfile{#1}%
+  {%
+    \makevalueexpandable
+    \def\temp{\input #1 }%
+    \expandafter
+  }\temp
+  \popthisfilestack
+}
+\def\filenamecatcodes{%
+  \catcode`\\=\other
+  \catcode`~=\other
+  \catcode`^=\other
+  \catcode`_=\other
+  \catcode`|=\other
+  \catcode`<=\other
+  \catcode`>=\other
+  \catcode`+=\other
+  \catcode`-=\other
+}
+
+\def\pushthisfilestack{%
+  \expandafter\pushthisfilestackX\popthisfilestack\StackTerm
+}
+\def\pushthisfilestackX{%
+  \expandafter\pushthisfilestackY\thisfile\StackTerm
+}
+\def\pushthisfilestackY #1\StackTerm #2\StackTerm {%
+  \gdef\popthisfilestack{\gdef\thisfile{#1}\gdef\popthisfilestack{#2}}%
+}
+
+\def\popthisfilestack{\errthisfilestackempty}
+\def\errthisfilestackempty{\errmessage{Internal error:
+  the stack of filenames is empty.}}
+
+\def\thisfile{}
+
+% @center line
+% outputs that line, centered.
+%
+\parseargdef\center{%
+  \ifhmode
+    \let\next\centerH
+  \else
+    \let\next\centerV
+  \fi
+  \next{\hfil \ignorespaces#1\unskip \hfil}%
+}
+\def\centerH#1{%
+  {%
+    \hfil\break
+    \advance\hsize by -\leftskip
+    \advance\hsize by -\rightskip
+    \line{#1}%
+    \break
+  }%
+}
+\def\centerV#1{\line{\kern\leftskip #1\kern\rightskip}}
+
+% @sp n   outputs n lines of vertical space
+
+\parseargdef\sp{\vskip #1\baselineskip}
+
+% @comment ...line which is ignored...
+% @c is the same as @comment
+% @ignore ... @end ignore  is another way to write a comment
+
+\def\comment{\begingroup \catcode`\^^M=\other%
+\catcode`\@=\other \catcode`\{=\other \catcode`\}=\other%
+\commentxxx}
+{\catcode`\^^M=\other \gdef\commentxxx#1^^M{\endgroup}}
+
+\let\c=\comment
+
+% @paragraphindent NCHARS
+% We'll use ems for NCHARS, close enough.
+% NCHARS can also be the word `asis' or `none'.
+% We cannot feasibly implement @paragraphindent asis, though.
+%
+\def\asisword{asis} % no translation, these are keywords
+\def\noneword{none}
+%
+\parseargdef\paragraphindent{%
+  \def\temp{#1}%
+  \ifx\temp\asisword
+  \else
+    \ifx\temp\noneword
+      \defaultparindent = 0pt
+    \else
+      \defaultparindent = #1em
+    \fi
+  \fi
+  \parindent = \defaultparindent
+}
+
+% @exampleindent NCHARS
+% We'll use ems for NCHARS like @paragraphindent.
+% It seems @exampleindent asis isn't necessary, but
+% I preserve it to make it similar to @paragraphindent.
+\parseargdef\exampleindent{%
+  \def\temp{#1}%
+  \ifx\temp\asisword
+  \else
+    \ifx\temp\noneword
+      \lispnarrowing = 0pt
+    \else
+      \lispnarrowing = #1em
+    \fi
+  \fi
+}
+
+% @firstparagraphindent WORD
+% If WORD is `none', then suppress indentation of the first paragraph
+% after a section heading.  If WORD is `insert', then do indent at such
+% paragraphs.
+%
+% The paragraph indentation is suppressed or not by calling
+% \suppressfirstparagraphindent, which the sectioning commands do.
+% We switch the definition of this back and forth according to WORD.
+% By default, we suppress indentation.
+%
+\def\suppressfirstparagraphindent{\dosuppressfirstparagraphindent}
+\def\insertword{insert}
+%
+\parseargdef\firstparagraphindent{%
+  \def\temp{#1}%
+  \ifx\temp\noneword
+    \let\suppressfirstparagraphindent = \dosuppressfirstparagraphindent
+  \else\ifx\temp\insertword
+    \let\suppressfirstparagraphindent = \relax
+  \else
+    \errhelp = \EMsimple
+    \errmessage{Unknown @firstparagraphindent option `\temp'}%
+  \fi\fi
+}
+
+% Here is how we actually suppress indentation.  Redefine \everypar to
+% \kern backwards by \parindent, and then reset itself to empty.
+%
+% We also make \indent itself not actually do anything until the next
+% paragraph.
+%
+\gdef\dosuppressfirstparagraphindent{%
+  \gdef\indent{%
+    \restorefirstparagraphindent
+    \indent
+  }%
+  \gdef\noindent{%
+    \restorefirstparagraphindent
+    \noindent
+  }%
+  \global\everypar = {%
+    \kern -\parindent
+    \restorefirstparagraphindent
+  }%
+}
+
+\gdef\restorefirstparagraphindent{%
+  \global \let \indent = \ptexindent
+  \global \let \noindent = \ptexnoindent
+  \global \everypar = {}%
+}
+
+
+% @asis just yields its argument.  Used with @table, for example.
+%
+\def\asis#1{#1}
+
+% @math outputs its argument in math mode.
+%
+% One complication: _ usually means subscripts, but it could also mean
+% an actual _ character, as in @math{@var{some_variable} + 1}.  So make
+% _ active, and distinguish by seeing if the current family is \slfam,
+% which is what @var uses.
+{
+  \catcode`\_ = \active
+  \gdef\mathunderscore{%
+    \catcode`\_=\active
+    \def_{\ifnum\fam=\slfam \_\else\sb\fi}%
+  }
+}
+% Another complication: we want \\ (and @\) to output a \ character.
+% FYI, plain.tex uses \\ as a temporary control sequence (why?), but
+% this is not advertised and we don't care.  Texinfo does not
+% otherwise define @\.
+%
+% The \mathchar is class=0=ordinary, family=7=ttfam, position=5C=\.
+\def\mathbackslash{\ifnum\fam=\ttfam \mathchar"075C \else\backslash \fi}
+%
+\def\math{%
+  \tex
+  \mathunderscore
+  \let\\ = \mathbackslash
+  \mathactive
+  $\finishmath
+}
+\def\finishmath#1{#1$\endgroup}  % Close the group opened by \tex.
+
+% Some active characters (such as <) are spaced differently in math.
+% We have to reset their definitions in case the @math was an argument
+% to a command which sets the catcodes (such as @item or @section).
+%
+{
+  \catcode`^ = \active
+  \catcode`< = \active
+  \catcode`> = \active
+  \catcode`+ = \active
+  \gdef\mathactive{%
+    \let^ = \ptexhat
+    \let< = \ptexless
+    \let> = \ptexgtr
+    \let+ = \ptexplus
+  }
+}
+
+% @bullet and @minus need the same treatment as @math, just above.
+\def\bullet{$\ptexbullet$}
+\def\minus{$-$}
+
+% @dots{} outputs an ellipsis using the current font.
+% We do .5em per period so that it has the same spacing in the cm
+% typewriter fonts as three actual period characters; on the other hand,
+% in other typewriter fonts three periods are wider than 1.5em.  So do
+% whichever is larger.
+%
+\def\dots{%
+  \leavevmode
+  \setbox0=\hbox{...}% get width of three periods
+  \ifdim\wd0 > 1.5em
+    \dimen0 = \wd0
+  \else
+    \dimen0 = 1.5em
+  \fi
+  \hbox to \dimen0{%
+    \hskip 0pt plus.25fil
+    .\hskip 0pt plus1fil
+    .\hskip 0pt plus1fil
+    .\hskip 0pt plus.5fil
+  }%
+}
+
+% @enddots{} is an end-of-sentence ellipsis.
+%
+\def\enddots{%
+  \dots
+  \spacefactor=\endofsentencespacefactor
+}
+
+% @comma{} is so commas can be inserted into text without messing up
+% Texinfo's parsing.
+%
+\let\comma = ,
+
+% @refill is a no-op.
+\let\refill=\relax
+
+% If working on a large document in chapters, it is convenient to
+% be able to disable indexing, cross-referencing, and contents, for test runs.
+% This is done with @novalidate (before @setfilename).
+%
+\newif\iflinks \linkstrue % by default we want the aux files.
+\let\novalidate = \linksfalse
+
+% @setfilename is done at the beginning of every texinfo file.
+% So open here the files we need to have open while reading the input.
+% This makes it possible to make a .fmt file for texinfo.
+\def\setfilename{%
+   \fixbackslash  % Turn off hack to swallow `\input texinfo'.
+   \iflinks
+     \tryauxfile
+     % Open the new aux file.  TeX will close it automatically at exit.
+     \immediate\openout\auxfile=\jobname.aux
+   \fi % \openindices needs to do some work in any case.
+   \openindices
+   \let\setfilename=\comment % Ignore extra @setfilename cmds.
+   %
+   % If texinfo.cnf is present on the system, read it.
+   % Useful for site-wide @afourpaper, etc.
+   \openin 1 texinfo.cnf
+   \ifeof 1 \else \input texinfo.cnf \fi
+   \closein 1
+   %
+   \comment % Ignore the actual filename.
+}
+
+% Called from \setfilename.
+%
+\def\openindices{%
+  \newindex{cp}%
+  \newcodeindex{fn}%
+  \newcodeindex{vr}%
+  \newcodeindex{tp}%
+  \newcodeindex{ky}%
+  \newcodeindex{pg}%
+}
+
+% @bye.
+\outer\def\bye{\pagealignmacro\tracingstats=1\ptexend}
+
+
+\message{pdf,}
+% adobe `portable' document format
+\newcount\tempnum
+\newcount\lnkcount
+\newtoks\filename
+\newcount\filenamelength
+\newcount\pgn
+\newtoks\toksA
+\newtoks\toksB
+\newtoks\toksC
+\newtoks\toksD
+\newbox\boxA
+\newcount\countA
+\newif\ifpdf
+\newif\ifpdfmakepagedest
+
+% when pdftex is run in dvi mode, \pdfoutput is defined (so \pdfoutput=1
+% can be set).  So we test for \relax and 0 as well as \undefined,
+% borrowed from ifpdf.sty.
+\ifx\pdfoutput\undefined
+\else
+  \ifx\pdfoutput\relax
+  \else
+    \ifcase\pdfoutput
+    \else
+      \pdftrue
+    \fi
+  \fi
+\fi
+
+% PDF uses PostScript string constants for the names of xref targets,
+% for display in the outlines, and in other places.  Thus, we have to
+% double any backslashes.  Otherwise, a name like "\node" will be
+% interpreted as a newline (\n), followed by o, d, e.  Not good.
+% http://www.ntg.nl/pipermail/ntg-pdftex/2004-July/000654.html
+% (and related messages, the final outcome is that it is up to the TeX
+% user to double the backslashes and otherwise make the string valid, so
+% that's what we do).
+
+% double active backslashes.
+% 
+{\catcode`\@=0 \catcode`\\=\active
+ @gdef@activebackslashdouble{%
+   @catcode`@\=@active
+   @let\=@doublebackslash}
+}
+
+% To handle parens, we must adopt a different approach, since parens are
+% not active characters.  hyperref.dtx (which has the same problem as
+% us) handles it with this amazing macro to replace tokens, with minor
+% changes for Texinfo.  It is included here under the GPL by permission
+% from the author, Heiko Oberdiek.
+% 
+% #1 is the tokens to replace.
+% #2 is the replacement.
+% #3 is the control sequence with the string.
+% 
+\def\HyPsdSubst#1#2#3{%
+  \def\HyPsdReplace##1#1##2\END{%
+    ##1%
+    \ifx\\##2\\%
+    \else
+      #2%
+      \HyReturnAfterFi{%
+        \HyPsdReplace##2\END
+      }%
+    \fi
+  }%
+  \xdef#3{\expandafter\HyPsdReplace#3#1\END}%
+}
+\long\def\HyReturnAfterFi#1\fi{\fi#1}
+
+% #1 is a control sequence in which to do the replacements.
+\def\backslashparens#1{%
+  \xdef#1{#1}% redefine it as its expansion; the definition is simply
+             % \lastnode when called from \setref -> \pdfmkdest.
+  \HyPsdSubst{(}{\realbackslash(}{#1}%
+  \HyPsdSubst{)}{\realbackslash)}{#1}%
+}
+
+\newhelp\nopdfimagehelp{Texinfo supports .png, .jpg, .jpeg, and .pdf images
+with PDF output, and none of those formats could be found.  (.eps cannot
+be supported due to the design of the PDF format; use regular TeX (DVI
+output) for that.)}
+
+\ifpdf
+  %
+  % Color manipulation macros based on pdfcolor.tex.
+  \def\cmykDarkRed{0.28 1 1 0.35}
+  \def\cmykBlack{0 0 0 1}
+  %
+  \def\pdfsetcolor#1{\pdfliteral{#1 k}}
+  % Set color, and create a mark which defines \thiscolor accordingly,
+  % so that \makeheadline knows which color to restore.
+  \def\setcolor#1{%
+    \xdef\lastcolordefs{\gdef\noexpand\thiscolor{#1}}%
+    \domark
+    \pdfsetcolor{#1}%
+  }
+  %
+  \def\maincolor{\cmykBlack}
+  \pdfsetcolor{\maincolor}
+  \edef\thiscolor{\maincolor}
+  \def\lastcolordefs{}
+  %
+  \def\makefootline{%
+    \baselineskip24pt
+    \line{\pdfsetcolor{\maincolor}\the\footline}%
+  }
+  %
+  \def\makeheadline{%
+    \vbox to 0pt{%
+      \vskip-22.5pt
+      \line{%
+        \vbox to8.5pt{}%
+        % Extract \thiscolor definition from the marks.
+        \getcolormarks
+        % Typeset the headline with \maincolor, then restore the color.
+        \pdfsetcolor{\maincolor}\the\headline\pdfsetcolor{\thiscolor}%
+      }%
+      \vss
+    }%
+    \nointerlineskip
+  }
+  %
+  %
+  \pdfcatalog{/PageMode /UseOutlines}
+  %
+  % #1 is image name, #2 width (might be empty/whitespace), #3 height (ditto).
+  \def\dopdfimage#1#2#3{%
+    \def\imagewidth{#2}\setbox0 = \hbox{\ignorespaces #2}%
+    \def\imageheight{#3}\setbox2 = \hbox{\ignorespaces #3}%
+    %
+    % pdftex (and the PDF format) support .png, .jpg, .pdf (among
+    % others).  Let's try in that order.
+    \let\pdfimgext=\empty
+    \begingroup
+      \openin 1 #1.png \ifeof 1
+        \openin 1 #1.jpg \ifeof 1
+          \openin 1 #1.jpeg \ifeof 1
+            \openin 1 #1.JPG \ifeof 1
+              \openin 1 #1.pdf \ifeof 1
+                \errhelp = \nopdfimagehelp
+                \errmessage{Could not find image file #1 for pdf}%
+              \else \gdef\pdfimgext{pdf}%
+              \fi
+            \else \gdef\pdfimgext{JPG}%
+            \fi
+          \else \gdef\pdfimgext{jpeg}%
+          \fi
+        \else \gdef\pdfimgext{jpg}%
+        \fi
+      \else \gdef\pdfimgext{png}%
+      \fi
+      \closein 1
+    \endgroup
+    %
+    % without \immediate, pdftex seg faults when the same image is
+    % included twice.  (Version 3.14159-pre-1.0-unofficial-20010704.)
+    \ifnum\pdftexversion < 14
+      \immediate\pdfimage
+    \else
+      \immediate\pdfximage
+    \fi
+      \ifdim \wd0 >0pt width \imagewidth \fi
+      \ifdim \wd2 >0pt height \imageheight \fi
+      \ifnum\pdftexversion<13
+         #1.\pdfimgext
+       \else
+         {#1.\pdfimgext}%
+       \fi
+    \ifnum\pdftexversion < 14 \else
+      \pdfrefximage \pdflastximage
+    \fi}
+  %
+  \def\pdfmkdest#1{{%
+    % We have to set dummies so commands such as @code, and characters
+    % such as \, aren't expanded when present in a section title.
+    \indexnofonts
+    \turnoffactive
+    \activebackslashdouble
+    \makevalueexpandable
+    \def\pdfdestname{#1}%
+    \backslashparens\pdfdestname
+    \safewhatsit{\pdfdest name{\pdfdestname} xyz}%
+  }}
+  %
+  % used to mark target names; must be expandable.
+  \def\pdfmkpgn#1{#1}
+  %
+  % by default, use a color that is dark enough to print on paper as
+  % nearly black, but still distinguishable for online viewing.
+  \def\urlcolor{\cmykDarkRed}
+  \def\linkcolor{\cmykDarkRed}
+  \def\endlink{\setcolor{\maincolor}\pdfendlink}
+  %
+  % Adding outlines to PDF; macros for calculating structure of outlines
+  % come from Petr Olsak
+  \def\expnumber#1{\expandafter\ifx\csname#1\endcsname\relax 0%
+    \else \csname#1\endcsname \fi}
+  \def\advancenumber#1{\tempnum=\expnumber{#1}\relax
+    \advance\tempnum by 1
+    \expandafter\xdef\csname#1\endcsname{\the\tempnum}}
+  %
+  % #1 is the section text, which is what will be displayed in the
+  % outline by the pdf viewer.  #2 is the pdf expression for the number
+  % of subentries (or empty, for subsubsections).  #3 is the node text,
+  % which might be empty if this toc entry had no corresponding node.
+  % #4 is the page number
+  %
+  \def\dopdfoutline#1#2#3#4{%
+    % Generate a link to the node text if that exists; else, use the
+    % page number.  We could generate a destination for the section
+    % text in the case where a section has no node, but it doesn't
+    % seem worth the trouble, since most documents are normally structured.
+    \def\pdfoutlinedest{#3}%
+    \ifx\pdfoutlinedest\empty
+      \def\pdfoutlinedest{#4}%
+    \else
+      % Doubled backslashes in the name.
+      {\activebackslashdouble \xdef\pdfoutlinedest{#3}%
+       \backslashparens\pdfoutlinedest}%
+    \fi
+    %
+    % Also double the backslashes in the display string.
+    {\activebackslashdouble \xdef\pdfoutlinetext{#1}%
+     \backslashparens\pdfoutlinetext}%
+    %
+    \pdfoutline goto name{\pdfmkpgn{\pdfoutlinedest}}#2{\pdfoutlinetext}%
+  }
+  %
+  \def\pdfmakeoutlines{%
+    \begingroup
+      % Thanh's hack / proper braces in bookmarks
+      \edef\mylbrace{\iftrue \string{\else}\fi}\let\{=\mylbrace
+      \edef\myrbrace{\iffalse{\else\string}\fi}\let\}=\myrbrace
+      %
+      % Read toc silently, to get counts of subentries for \pdfoutline.
+      \def\numchapentry##1##2##3##4{%
+	\def\thischapnum{##2}%
+	\def\thissecnum{0}%
+	\def\thissubsecnum{0}%
+      }%
+      \def\numsecentry##1##2##3##4{%
+	\advancenumber{chap\thischapnum}%
+	\def\thissecnum{##2}%
+	\def\thissubsecnum{0}%
+      }%
+      \def\numsubsecentry##1##2##3##4{%
+	\advancenumber{sec\thissecnum}%
+	\def\thissubsecnum{##2}%
+      }%
+      \def\numsubsubsecentry##1##2##3##4{%
+	\advancenumber{subsec\thissubsecnum}%
+      }%
+      \def\thischapnum{0}%
+      \def\thissecnum{0}%
+      \def\thissubsecnum{0}%
+      %
+      % use \def rather than \let here because we redefine \chapentry et
+      % al. a second time, below.
+      \def\appentry{\numchapentry}%
+      \def\appsecentry{\numsecentry}%
+      \def\appsubsecentry{\numsubsecentry}%
+      \def\appsubsubsecentry{\numsubsubsecentry}%
+      \def\unnchapentry{\numchapentry}%
+      \def\unnsecentry{\numsecentry}%
+      \def\unnsubsecentry{\numsubsecentry}%
+      \def\unnsubsubsecentry{\numsubsubsecentry}%
+      \readdatafile{toc}%
+      %
+      % Read toc second time, this time actually producing the outlines.
+      % The `-' means take the \expnumber as the absolute number of
+      % subentries, which we calculated on our first read of the .toc above.
+      %
+      % We use the node names as the destinations.
+      \def\numchapentry##1##2##3##4{%
+        \dopdfoutline{##1}{count-\expnumber{chap##2}}{##3}{##4}}%
+      \def\numsecentry##1##2##3##4{%
+        \dopdfoutline{##1}{count-\expnumber{sec##2}}{##3}{##4}}%
+      \def\numsubsecentry##1##2##3##4{%
+        \dopdfoutline{##1}{count-\expnumber{subsec##2}}{##3}{##4}}%
+      \def\numsubsubsecentry##1##2##3##4{% count is always zero
+        \dopdfoutline{##1}{}{##3}{##4}}%
+      %
+      % PDF outlines are displayed using system fonts, instead of
+      % document fonts.  Therefore we cannot use special characters,
+      % since the encoding is unknown.  For example, the eogonek from
+      % Latin 2 (0xea) gets translated to a | character.  Info from
+      % Staszek Wawrykiewicz, 19 Jan 2004 04:09:24 +0100.
+      %
+      % xx to do this right, we have to translate 8-bit characters to
+      % their "best" equivalent, based on the @documentencoding.  Right
+      % now, I guess we'll just let the pdf reader have its way.
+      \indexnofonts
+      \setupdatafile
+      \catcode`\\=\active \otherbackslash
+      \input \tocreadfilename
+    \endgroup
+  }
+  %
+  \def\skipspaces#1{\def\PP{#1}\def\D{|}%
+    \ifx\PP\D\let\nextsp\relax
+    \else\let\nextsp\skipspaces
+      \ifx\p\space\else\addtokens{\filename}{\PP}%
+        \advance\filenamelength by 1
+      \fi
+    \fi
+    \nextsp}
+  \def\getfilename#1{\filenamelength=0\expandafter\skipspaces#1|\relax}
+  \ifnum\pdftexversion < 14
+    \let \startlink \pdfannotlink
+  \else
+    \let \startlink \pdfstartlink
+  \fi
+  % make a live url in pdf output.
+  \def\pdfurl#1{%
+    \begingroup
+      % it seems we really need yet another set of dummies; have not
+      % tried to figure out what each command should do in the context
+      % of @url.  for now, just make @/ a no-op, that's the only one
+      % people have actually reported a problem with.
+      % 
+      \normalturnoffactive
+      \def\@{@}%
+      \let\/=\empty
+      \makevalueexpandable
+      \leavevmode\setcolor{\urlcolor}%
+      \startlink attr{/Border [0 0 0]}%
+        user{/Subtype /Link /A << /S /URI /URI (#1) >>}%
+    \endgroup}
+  \def\pdfgettoks#1.{\setbox\boxA=\hbox{\toksA={#1.}\toksB={}\maketoks}}
+  \def\addtokens#1#2{\edef\addtoks{\noexpand#1={\the#1#2}}\addtoks}
+  \def\adn#1{\addtokens{\toksC}{#1}\global\countA=1\let\next=\maketoks}
+  \def\poptoks#1#2|ENDTOKS|{\let\first=#1\toksD={#1}\toksA={#2}}
+  \def\maketoks{%
+    \expandafter\poptoks\the\toksA|ENDTOKS|\relax
+    \ifx\first0\adn0
+    \else\ifx\first1\adn1 \else\ifx\first2\adn2 \else\ifx\first3\adn3
+    \else\ifx\first4\adn4 \else\ifx\first5\adn5 \else\ifx\first6\adn6
+    \else\ifx\first7\adn7 \else\ifx\first8\adn8 \else\ifx\first9\adn9
+    \else
+      \ifnum0=\countA\else\makelink\fi
+      \ifx\first.\let\next=\done\else
+        \let\next=\maketoks
+        \addtokens{\toksB}{\the\toksD}
+        \ifx\first,\addtokens{\toksB}{\space}\fi
+      \fi
+    \fi\fi\fi\fi\fi\fi\fi\fi\fi\fi
+    \next}
+  \def\makelink{\addtokens{\toksB}%
+    {\noexpand\pdflink{\the\toksC}}\toksC={}\global\countA=0}
+  \def\pdflink#1{%
+    \startlink attr{/Border [0 0 0]} goto name{\pdfmkpgn{#1}}
+    \setcolor{\linkcolor}#1\endlink}
+  \def\done{\edef\st{\global\noexpand\toksA={\the\toksB}}\st}
+\else
+  \let\pdfmkdest = \gobble
+  \let\pdfurl = \gobble
+  \let\endlink = \relax
+  \let\setcolor = \gobble
+  \let\pdfsetcolor = \gobble
+  \let\pdfmakeoutlines = \relax
+\fi  % \ifx\pdfoutput
+
+
+\message{fonts,}
+
+% Change the current font style to #1, remembering it in \curfontstyle.
+% For now, we do not accumulate font styles: @b{@i{foo}} prints foo in
+% italics, not bold italics.
+%
+\def\setfontstyle#1{%
+  \def\curfontstyle{#1}% not as a control sequence, because we are \edef'd.
+  \csname ten#1\endcsname  % change the current font
+}
+
+% Select #1 fonts with the current style.
+%
+\def\selectfonts#1{\csname #1fonts\endcsname \csname\curfontstyle\endcsname}
+
+\def\rm{\fam=0 \setfontstyle{rm}}
+\def\it{\fam=\itfam \setfontstyle{it}}
+\def\sl{\fam=\slfam \setfontstyle{sl}}
+\def\bf{\fam=\bffam \setfontstyle{bf}}\def\bfstylename{bf}
+\def\tt{\fam=\ttfam \setfontstyle{tt}}
+
+% Texinfo sort of supports the sans serif font style, which plain TeX does not.
+% So we set up a \sf.
+\newfam\sffam
+\def\sf{\fam=\sffam \setfontstyle{sf}}
+\let\li = \sf % Sometimes we call it \li, not \sf.
+
+% We don't need math for this font style.
+\def\ttsl{\setfontstyle{ttsl}}
+
+
+% Default leading.
+\newdimen\textleading  \textleading = 13.2pt
+
+% Set the baselineskip to #1, and the lineskip and strut size
+% correspondingly.  There is no deep meaning behind these magic numbers
+% used as factors; they just match (closely enough) what Knuth defined.
+%
+\def\lineskipfactor{.08333}
+\def\strutheightpercent{.70833}
+\def\strutdepthpercent {.29167}
+%
+% can get a sort of poor man's double spacing by redefining this.
+\def\baselinefactor{1}
+%
+\def\setleading#1{%
+  \dimen0 = #1\relax
+  \normalbaselineskip = \baselinefactor\dimen0
+  \normallineskip = \lineskipfactor\normalbaselineskip
+  \normalbaselines
+  \setbox\strutbox =\hbox{%
+    \vrule width0pt height\strutheightpercent\baselineskip
+                    depth \strutdepthpercent \baselineskip
+  }%
+}
+
+% PDF CMaps.  See also LaTeX's t1.cmap.
+%
+% do nothing with this by default.
+\expandafter\let\csname cmapOT1\endcsname\gobble
+\expandafter\let\csname cmapOT1IT\endcsname\gobble
+\expandafter\let\csname cmapOT1TT\endcsname\gobble
+
+% if we are producing pdf, and we have \pdffontattr, then define cmaps.
+% (\pdffontattr was introduced many years ago, but people still run
+% older pdftex's; it's easy to conditionalize, so we do.)
+\ifpdf \ifx\pdffontattr\undefined \else
+  \begingroup
+    \catcode`\^^M=\active \def^^M{^^J}% Output line endings as the ^^J char.
+    \catcode`\%=12 \immediate\pdfobj stream {%!PS-Adobe-3.0 Resource-CMap
+%%DocumentNeededResources: ProcSet (CIDInit)
+%%IncludeResource: ProcSet (CIDInit)
+%%BeginResource: CMap (TeX-OT1-0)
+%%Title: (TeX-OT1-0 TeX OT1 0)
+%%Version: 1.000
+%%EndComments
+/CIDInit /ProcSet findresource begin
+12 dict begin
+begincmap
+/CIDSystemInfo
+<< /Registry (TeX)
+/Ordering (OT1)
+/Supplement 0
+>> def
+/CMapName /TeX-OT1-0 def
+/CMapType 2 def
+1 begincodespacerange
+<00> <7F>
+endcodespacerange
+8 beginbfrange
+<00> <01> <0393>
+<09> <0A> <03A8>
+<23> <26> <0023>
+<28> <3B> <0028>
+<3F> <5B> <003F>
+<5D> <5E> <005D>
+<61> <7A> <0061>
+<7B> <7C> <2013>
+endbfrange
+40 beginbfchar
+<02> <0398>
+<03> <039B>
+<04> <039E>
+<05> <03A0>
+<06> <03A3>
+<07> <03D2>
+<08> <03A6>
+<0B> <00660066>
+<0C> <00660069>
+<0D> <0066006C>
+<0E> <006600660069>
+<0F> <00660066006C>
+<10> <0131>
+<11> <0237>
+<12> <0060>
+<13> <00B4>
+<14> <02C7>
+<15> <02D8>
+<16> <00AF>
+<17> <02DA>
+<18> <00B8>
+<19> <00DF>
+<1A> <00E6>
+<1B> <0153>
+<1C> <00F8>
+<1D> <00C6>
+<1E> <0152>
+<1F> <00D8>
+<21> <0021>
+<22> <201D>
+<27> <2019>
+<3C> <00A1>
+<3D> <003D>
+<3E> <00BF>
+<5C> <201C>
+<5F> <02D9>
+<60> <2018>
+<7D> <02DD>
+<7E> <007E>
+<7F> <00A8>
+endbfchar
+endcmap
+CMapName currentdict /CMap defineresource pop
+end
+end
+%%EndResource
+%%EOF
+    }\endgroup
+  \expandafter\edef\csname cmapOT1\endcsname#1{%
+    \pdffontattr#1{/ToUnicode \the\pdflastobj\space 0 R}%
+  }%
+%
+% \cmapOT1IT
+  \begingroup
+    \catcode`\^^M=\active \def^^M{^^J}% Output line endings as the ^^J char.
+    \catcode`\%=12 \immediate\pdfobj stream {%!PS-Adobe-3.0 Resource-CMap
+%%DocumentNeededResources: ProcSet (CIDInit)
+%%IncludeResource: ProcSet (CIDInit)
+%%BeginResource: CMap (TeX-OT1IT-0)
+%%Title: (TeX-OT1IT-0 TeX OT1IT 0)
+%%Version: 1.000
+%%EndComments
+/CIDInit /ProcSet findresource begin
+12 dict begin
+begincmap
+/CIDSystemInfo
+<< /Registry (TeX)
+/Ordering (OT1IT)
+/Supplement 0
+>> def
+/CMapName /TeX-OT1IT-0 def
+/CMapType 2 def
+1 begincodespacerange
+<00> <7F>
+endcodespacerange
+8 beginbfrange
+<00> <01> <0393>
+<09> <0A> <03A8>
+<25> <26> <0025>
+<28> <3B> <0028>
+<3F> <5B> <003F>
+<5D> <5E> <005D>
+<61> <7A> <0061>
+<7B> <7C> <2013>
+endbfrange
+42 beginbfchar
+<02> <0398>
+<03> <039B>
+<04> <039E>
+<05> <03A0>
+<06> <03A3>
+<07> <03D2>
+<08> <03A6>
+<0B> <00660066>
+<0C> <00660069>
+<0D> <0066006C>
+<0E> <006600660069>
+<0F> <00660066006C>
+<10> <0131>
+<11> <0237>
+<12> <0060>
+<13> <00B4>
+<14> <02C7>
+<15> <02D8>
+<16> <00AF>
+<17> <02DA>
+<18> <00B8>
+<19> <00DF>
+<1A> <00E6>
+<1B> <0153>
+<1C> <00F8>
+<1D> <00C6>
+<1E> <0152>
+<1F> <00D8>
+<21> <0021>
+<22> <201D>
+<23> <0023>
+<24> <00A3>
+<27> <2019>
+<3C> <00A1>
+<3D> <003D>
+<3E> <00BF>
+<5C> <201C>
+<5F> <02D9>
+<60> <2018>
+<7D> <02DD>
+<7E> <007E>
+<7F> <00A8>
+endbfchar
+endcmap
+CMapName currentdict /CMap defineresource pop
+end
+end
+%%EndResource
+%%EOF
+    }\endgroup
+  \expandafter\edef\csname cmapOT1IT\endcsname#1{%
+    \pdffontattr#1{/ToUnicode \the\pdflastobj\space 0 R}%
+  }%
+%
+% \cmapOT1TT
+  \begingroup
+    \catcode`\^^M=\active \def^^M{^^J}% Output line endings as the ^^J char.
+    \catcode`\%=12 \immediate\pdfobj stream {%!PS-Adobe-3.0 Resource-CMap
+%%DocumentNeededResources: ProcSet (CIDInit)
+%%IncludeResource: ProcSet (CIDInit)
+%%BeginResource: CMap (TeX-OT1TT-0)
+%%Title: (TeX-OT1TT-0 TeX OT1TT 0)
+%%Version: 1.000
+%%EndComments
+/CIDInit /ProcSet findresource begin
+12 dict begin
+begincmap
+/CIDSystemInfo
+<< /Registry (TeX)
+/Ordering (OT1TT)
+/Supplement 0
+>> def
+/CMapName /TeX-OT1TT-0 def
+/CMapType 2 def
+1 begincodespacerange
+<00> <7F>
+endcodespacerange
+5 beginbfrange
+<00> <01> <0393>
+<09> <0A> <03A8>
+<21> <26> <0021>
+<28> <5F> <0028>
+<61> <7E> <0061>
+endbfrange
+32 beginbfchar
+<02> <0398>
+<03> <039B>
+<04> <039E>
+<05> <03A0>
+<06> <03A3>
+<07> <03D2>
+<08> <03A6>
+<0B> <2191>
+<0C> <2193>
+<0D> <0027>
+<0E> <00A1>
+<0F> <00BF>
+<10> <0131>
+<11> <0237>
+<12> <0060>
+<13> <00B4>
+<14> <02C7>
+<15> <02D8>
+<16> <00AF>
+<17> <02DA>
+<18> <00B8>
+<19> <00DF>
+<1A> <00E6>
+<1B> <0153>
+<1C> <00F8>
+<1D> <00C6>
+<1E> <0152>
+<1F> <00D8>
+<20> <2423>
+<27> <2019>
+<60> <2018>
+<7F> <00A8>
+endbfchar
+endcmap
+CMapName currentdict /CMap defineresource pop
+end
+end
+%%EndResource
+%%EOF
+    }\endgroup
+  \expandafter\edef\csname cmapOT1TT\endcsname#1{%
+    \pdffontattr#1{/ToUnicode \the\pdflastobj\space 0 R}%
+  }%
+\fi\fi
+
+
+% Set the font macro #1 to the font named #2, adding on the
+% specified font prefix (normally `cm').
+% #3 is the font's design size, #4 is a scale factor, #5 is the CMap
+% encoding (currently only OT1, OT1IT and OT1TT are allowed, pass
+% empty to omit).
+\def\setfont#1#2#3#4#5{%
+  \font#1=\fontprefix#2#3 scaled #4
+  \csname cmap#5\endcsname#1%
+}
+% This is what gets called when #5 of \setfont is empty.
+\let\cmap\gobble
+% emacs-page end of cmaps
+
+% Use cm as the default font prefix.
+% To specify the font prefix, you must define \fontprefix
+% before you read in texinfo.tex.
+\ifx\fontprefix\undefined
+\def\fontprefix{cm}
+\fi
+% Support font families that don't use the same naming scheme as CM.
+\def\rmshape{r}
+\def\rmbshape{bx}               %where the normal face is bold
+\def\bfshape{b}
+\def\bxshape{bx}
+\def\ttshape{tt}
+\def\ttbshape{tt}
+\def\ttslshape{sltt}
+\def\itshape{ti}
+\def\itbshape{bxti}
+\def\slshape{sl}
+\def\slbshape{bxsl}
+\def\sfshape{ss}
+\def\sfbshape{ss}
+\def\scshape{csc}
+\def\scbshape{csc}
+
+% Definitions for a main text size of 11pt.  This is the default in
+% Texinfo.
+% 
+\def\definetextfontsizexi{%
+% Text fonts (11.2pt, magstep1).
+\def\textnominalsize{11pt}
+\edef\mainmagstep{\magstephalf}
+\setfont\textrm\rmshape{10}{\mainmagstep}{OT1}
+\setfont\texttt\ttshape{10}{\mainmagstep}{OT1TT}
+\setfont\textbf\bfshape{10}{\mainmagstep}{OT1}
+\setfont\textit\itshape{10}{\mainmagstep}{OT1IT}
+\setfont\textsl\slshape{10}{\mainmagstep}{OT1}
+\setfont\textsf\sfshape{10}{\mainmagstep}{OT1}
+\setfont\textsc\scshape{10}{\mainmagstep}{OT1}
+\setfont\textttsl\ttslshape{10}{\mainmagstep}{OT1TT}
+\font\texti=cmmi10 scaled \mainmagstep
+\font\textsy=cmsy10 scaled \mainmagstep
+\def\textecsize{1095}
+
+% A few fonts for @defun names and args.
+\setfont\defbf\bfshape{10}{\magstep1}{OT1}
+\setfont\deftt\ttshape{10}{\magstep1}{OT1TT}
+\setfont\defttsl\ttslshape{10}{\magstep1}{OT1TT}
+\def\df{\let\tentt=\deftt \let\tenbf = \defbf \let\tenttsl=\defttsl \bf}
+
+% Fonts for indices, footnotes, small examples (9pt).
+\def\smallnominalsize{9pt}
+\setfont\smallrm\rmshape{9}{1000}{OT1}
+\setfont\smalltt\ttshape{9}{1000}{OT1TT}
+\setfont\smallbf\bfshape{10}{900}{OT1}
+\setfont\smallit\itshape{9}{1000}{OT1IT}
+\setfont\smallsl\slshape{9}{1000}{OT1}
+\setfont\smallsf\sfshape{9}{1000}{OT1}
+\setfont\smallsc\scshape{10}{900}{OT1}
+\setfont\smallttsl\ttslshape{10}{900}{OT1TT}
+\font\smalli=cmmi9
+\font\smallsy=cmsy9
+\def\smallecsize{0900}
+
+% Fonts for small examples (8pt).
+\def\smallernominalsize{8pt}
+\setfont\smallerrm\rmshape{8}{1000}{OT1}
+\setfont\smallertt\ttshape{8}{1000}{OT1TT}
+\setfont\smallerbf\bfshape{10}{800}{OT1}
+\setfont\smallerit\itshape{8}{1000}{OT1IT}
+\setfont\smallersl\slshape{8}{1000}{OT1}
+\setfont\smallersf\sfshape{8}{1000}{OT1}
+\setfont\smallersc\scshape{10}{800}{OT1}
+\setfont\smallerttsl\ttslshape{10}{800}{OT1TT}
+\font\smalleri=cmmi8
+\font\smallersy=cmsy8
+\def\smallerecsize{0800}
+
+% Fonts for title page (20.4pt):
+\def\titlenominalsize{20pt}
+\setfont\titlerm\rmbshape{12}{\magstep3}{OT1}
+\setfont\titleit\itbshape{10}{\magstep4}{OT1IT}
+\setfont\titlesl\slbshape{10}{\magstep4}{OT1}
+\setfont\titlett\ttbshape{12}{\magstep3}{OT1TT}
+\setfont\titlettsl\ttslshape{10}{\magstep4}{OT1TT}
+\setfont\titlesf\sfbshape{17}{\magstep1}{OT1}
+\let\titlebf=\titlerm
+\setfont\titlesc\scbshape{10}{\magstep4}{OT1}
+\font\titlei=cmmi12 scaled \magstep3
+\font\titlesy=cmsy10 scaled \magstep4
+\def\authorrm{\secrm}
+\def\authortt{\sectt}
+\def\titleecsize{2074}
+
+% Chapter (and unnumbered) fonts (17.28pt).
+\def\chapnominalsize{17pt}
+\setfont\chaprm\rmbshape{12}{\magstep2}{OT1}
+\setfont\chapit\itbshape{10}{\magstep3}{OT1IT}
+\setfont\chapsl\slbshape{10}{\magstep3}{OT1}
+\setfont\chaptt\ttbshape{12}{\magstep2}{OT1TT}
+\setfont\chapttsl\ttslshape{10}{\magstep3}{OT1TT}
+\setfont\chapsf\sfbshape{17}{1000}{OT1}
+\let\chapbf=\chaprm
+\setfont\chapsc\scbshape{10}{\magstep3}{OT1}
+\font\chapi=cmmi12 scaled \magstep2
+\font\chapsy=cmsy10 scaled \magstep3
+\def\chapecsize{1728}
+
+% Section fonts (14.4pt).
+\def\secnominalsize{14pt}
+\setfont\secrm\rmbshape{12}{\magstep1}{OT1}
+\setfont\secit\itbshape{10}{\magstep2}{OT1IT}
+\setfont\secsl\slbshape{10}{\magstep2}{OT1}
+\setfont\sectt\ttbshape{12}{\magstep1}{OT1TT}
+\setfont\secttsl\ttslshape{10}{\magstep2}{OT1TT}
+\setfont\secsf\sfbshape{12}{\magstep1}{OT1}
+\let\secbf\secrm
+\setfont\secsc\scbshape{10}{\magstep2}{OT1}
+\font\seci=cmmi12 scaled \magstep1
+\font\secsy=cmsy10 scaled \magstep2
+\def\sececsize{1440}
+
+% Subsection fonts (13.15pt).
+\def\ssecnominalsize{13pt}
+\setfont\ssecrm\rmbshape{12}{\magstephalf}{OT1}
+\setfont\ssecit\itbshape{10}{1315}{OT1IT}
+\setfont\ssecsl\slbshape{10}{1315}{OT1}
+\setfont\ssectt\ttbshape{12}{\magstephalf}{OT1TT}
+\setfont\ssecttsl\ttslshape{10}{1315}{OT1TT}
+\setfont\ssecsf\sfbshape{12}{\magstephalf}{OT1}
+\let\ssecbf\ssecrm
+\setfont\ssecsc\scbshape{10}{1315}{OT1}
+\font\sseci=cmmi12 scaled \magstephalf
+\font\ssecsy=cmsy10 scaled 1315
+\def\ssececsize{1200}
+
+% Reduced fonts for @acro in text (10pt).
+\def\reducednominalsize{10pt}
+\setfont\reducedrm\rmshape{10}{1000}{OT1}
+\setfont\reducedtt\ttshape{10}{1000}{OT1TT}
+\setfont\reducedbf\bfshape{10}{1000}{OT1}
+\setfont\reducedit\itshape{10}{1000}{OT1IT}
+\setfont\reducedsl\slshape{10}{1000}{OT1}
+\setfont\reducedsf\sfshape{10}{1000}{OT1}
+\setfont\reducedsc\scshape{10}{1000}{OT1}
+\setfont\reducedttsl\ttslshape{10}{1000}{OT1TT}
+\font\reducedi=cmmi10
+\font\reducedsy=cmsy10
+\def\reducedecsize{1000}
+
+% reset the current fonts
+\textfonts
+\rm
+} % end of 11pt text font size definitions
+
+
+% Definitions to make the main text be 10pt Computer Modern, with
+% section, chapter, etc., sizes following suit.  This is for the GNU
+% Press printing of the Emacs 22 manual.  Maybe other manuals in the
+% future.  Used with @smallbook, which sets the leading to 12pt.
+% 
+\def\definetextfontsizex{%
+% Text fonts (10pt).
+\def\textnominalsize{10pt}
+\edef\mainmagstep{1000}
+\setfont\textrm\rmshape{10}{\mainmagstep}{OT1}
+\setfont\texttt\ttshape{10}{\mainmagstep}{OT1TT}
+\setfont\textbf\bfshape{10}{\mainmagstep}{OT1}
+\setfont\textit\itshape{10}{\mainmagstep}{OT1IT}
+\setfont\textsl\slshape{10}{\mainmagstep}{OT1}
+\setfont\textsf\sfshape{10}{\mainmagstep}{OT1}
+\setfont\textsc\scshape{10}{\mainmagstep}{OT1}
+\setfont\textttsl\ttslshape{10}{\mainmagstep}{OT1TT}
+\font\texti=cmmi10 scaled \mainmagstep
+\font\textsy=cmsy10 scaled \mainmagstep
+\def\textecsize{1000}
+
+% A few fonts for @defun names and args.
+\setfont\defbf\bfshape{10}{\magstephalf}{OT1}
+\setfont\deftt\ttshape{10}{\magstephalf}{OT1TT}
+\setfont\defttsl\ttslshape{10}{\magstephalf}{OT1TT}
+\def\df{\let\tentt=\deftt \let\tenbf = \defbf \let\tenttsl=\defttsl \bf}
+
+% Fonts for indices, footnotes, small examples (9pt).
+\def\smallnominalsize{9pt}
+\setfont\smallrm\rmshape{9}{1000}{OT1}
+\setfont\smalltt\ttshape{9}{1000}{OT1TT}
+\setfont\smallbf\bfshape{10}{900}{OT1}
+\setfont\smallit\itshape{9}{1000}{OT1IT}
+\setfont\smallsl\slshape{9}{1000}{OT1}
+\setfont\smallsf\sfshape{9}{1000}{OT1}
+\setfont\smallsc\scshape{10}{900}{OT1}
+\setfont\smallttsl\ttslshape{10}{900}{OT1TT}
+\font\smalli=cmmi9
+\font\smallsy=cmsy9
+\def\smallecsize{0900}
+
+% Fonts for small examples (8pt).
+\def\smallernominalsize{8pt}
+\setfont\smallerrm\rmshape{8}{1000}{OT1}
+\setfont\smallertt\ttshape{8}{1000}{OT1TT}
+\setfont\smallerbf\bfshape{10}{800}{OT1}
+\setfont\smallerit\itshape{8}{1000}{OT1IT}
+\setfont\smallersl\slshape{8}{1000}{OT1}
+\setfont\smallersf\sfshape{8}{1000}{OT1}
+\setfont\smallersc\scshape{10}{800}{OT1}
+\setfont\smallerttsl\ttslshape{10}{800}{OT1TT}
+\font\smalleri=cmmi8
+\font\smallersy=cmsy8
+\def\smallerecsize{0800}
+
+% Fonts for title page (20.4pt):
+\def\titlenominalsize{20pt}
+\setfont\titlerm\rmbshape{12}{\magstep3}{OT1}
+\setfont\titleit\itbshape{10}{\magstep4}{OT1IT}
+\setfont\titlesl\slbshape{10}{\magstep4}{OT1}
+\setfont\titlett\ttbshape{12}{\magstep3}{OT1TT}
+\setfont\titlettsl\ttslshape{10}{\magstep4}{OT1TT}
+\setfont\titlesf\sfbshape{17}{\magstep1}{OT1}
+\let\titlebf=\titlerm
+\setfont\titlesc\scbshape{10}{\magstep4}{OT1}
+\font\titlei=cmmi12 scaled \magstep3
+\font\titlesy=cmsy10 scaled \magstep4
+\def\authorrm{\secrm}
+\def\authortt{\sectt}
+\def\titleecsize{2074}
+
+% Chapter fonts (14.4pt).
+\def\chapnominalsize{14pt}
+\setfont\chaprm\rmbshape{12}{\magstep1}{OT1}
+\setfont\chapit\itbshape{10}{\magstep2}{OT1IT}
+\setfont\chapsl\slbshape{10}{\magstep2}{OT1}
+\setfont\chaptt\ttbshape{12}{\magstep1}{OT1TT}
+\setfont\chapttsl\ttslshape{10}{\magstep2}{OT1TT}
+\setfont\chapsf\sfbshape{12}{\magstep1}{OT1}
+\let\chapbf\chaprm
+\setfont\chapsc\scbshape{10}{\magstep2}{OT1}
+\font\chapi=cmmi12 scaled \magstep1
+\font\chapsy=cmsy10 scaled \magstep2
+\def\chapecsize{1440}
+
+% Section fonts (12pt).
+\def\secnominalsize{12pt}
+\setfont\secrm\rmbshape{12}{1000}{OT1}
+\setfont\secit\itbshape{10}{\magstep1}{OT1IT}
+\setfont\secsl\slbshape{10}{\magstep1}{OT1}
+\setfont\sectt\ttbshape{12}{1000}{OT1TT}
+\setfont\secttsl\ttslshape{10}{\magstep1}{OT1TT}
+\setfont\secsf\sfbshape{12}{1000}{OT1}
+\let\secbf\secrm
+\setfont\secsc\scbshape{10}{\magstep1}{OT1}
+\font\seci=cmmi12 
+\font\secsy=cmsy10 scaled \magstep1
+\def\sececsize{1200}
+
+% Subsection fonts (10pt).
+\def\ssecnominalsize{10pt}
+\setfont\ssecrm\rmbshape{10}{1000}{OT1}
+\setfont\ssecit\itbshape{10}{1000}{OT1IT}
+\setfont\ssecsl\slbshape{10}{1000}{OT1}
+\setfont\ssectt\ttbshape{10}{1000}{OT1TT}
+\setfont\ssecttsl\ttslshape{10}{1000}{OT1TT}
+\setfont\ssecsf\sfbshape{10}{1000}{OT1}
+\let\ssecbf\ssecrm
+\setfont\ssecsc\scbshape{10}{1000}{OT1}
+\font\sseci=cmmi10
+\font\ssecsy=cmsy10
+\def\ssececsize{1000}
+
+% Reduced fonts for @acro in text (9pt).
+\def\reducednominalsize{9pt}
+\setfont\reducedrm\rmshape{9}{1000}{OT1}
+\setfont\reducedtt\ttshape{9}{1000}{OT1TT}
+\setfont\reducedbf\bfshape{10}{900}{OT1}
+\setfont\reducedit\itshape{9}{1000}{OT1IT}
+\setfont\reducedsl\slshape{9}{1000}{OT1}
+\setfont\reducedsf\sfshape{9}{1000}{OT1}
+\setfont\reducedsc\scshape{10}{900}{OT1}
+\setfont\reducedttsl\ttslshape{10}{900}{OT1TT}
+\font\reducedi=cmmi9
+\font\reducedsy=cmsy9
+\def\reducedecsize{0900}
+
+% reduce space between paragraphs
+\divide\parskip by 2
+
+% reset the current fonts
+\textfonts
+\rm
+} % end of 10pt text font size definitions
+
+
+% We provide the user-level command
+%   @fonttextsize 10
+% (or 11) to redefine the text font size.  pt is assumed.
+% 
+\def\xword{10}
+\def\xiword{11}
+%
+\parseargdef\fonttextsize{%
+  \def\textsizearg{#1}%
+  \wlog{doing @fonttextsize \textsizearg}%
+  %
+  % Set \globaldefs so that documents can use this inside @tex, since
+  % makeinfo 4.8 does not support it, but we need it nonetheless.
+  % 
+ \begingroup \globaldefs=1
+  \ifx\textsizearg\xword \definetextfontsizex
+  \else \ifx\textsizearg\xiword \definetextfontsizexi
+  \else
+    \errhelp=\EMsimple
+    \errmessage{@fonttextsize only supports `10' or `11', not `\textsizearg'}
+  \fi\fi
+ \endgroup
+}
+
+
+% In order for the font changes to affect most math symbols and letters,
+% we have to define the \textfont of the standard families.  Since
+% texinfo doesn't allow for producing subscripts and superscripts except
+% in the main text, we don't bother to reset \scriptfont and
+% \scriptscriptfont (which would also require loading a lot more fonts).
+%
+\def\resetmathfonts{%
+  \textfont0=\tenrm \textfont1=\teni \textfont2=\tensy
+  \textfont\itfam=\tenit \textfont\slfam=\tensl \textfont\bffam=\tenbf
+  \textfont\ttfam=\tentt \textfont\sffam=\tensf
+}
+
+% The font-changing commands redefine the meanings of \tenSTYLE, instead
+% of just \STYLE.  We do this because \STYLE needs to also set the
+% current \fam for math mode.  Our \STYLE (e.g., \rm) commands hardwire
+% \tenSTYLE to set the current font.
+%
+% Each font-changing command also sets the names \lsize (one size lower)
+% and \lllsize (three sizes lower).  These relative commands are used in
+% the LaTeX logo and acronyms.
+%
+% This all needs generalizing, badly.
+%
+\def\textfonts{%
+  \let\tenrm=\textrm \let\tenit=\textit \let\tensl=\textsl
+  \let\tenbf=\textbf \let\tentt=\texttt \let\smallcaps=\textsc
+  \let\tensf=\textsf \let\teni=\texti \let\tensy=\textsy
+  \let\tenttsl=\textttsl
+  \def\curfontsize{text}%
+  \def\lsize{reduced}\def\lllsize{smaller}%
+  \resetmathfonts \setleading{\textleading}}
+\def\titlefonts{%
+  \let\tenrm=\titlerm \let\tenit=\titleit \let\tensl=\titlesl
+  \let\tenbf=\titlebf \let\tentt=\titlett \let\smallcaps=\titlesc
+  \let\tensf=\titlesf \let\teni=\titlei \let\tensy=\titlesy
+  \let\tenttsl=\titlettsl
+  \def\curfontsize{title}%
+  \def\lsize{chap}\def\lllsize{subsec}%
+  \resetmathfonts \setleading{25pt}}
+\def\titlefont#1{{\titlefonts\rm #1}}
+\def\chapfonts{%
+  \let\tenrm=\chaprm \let\tenit=\chapit \let\tensl=\chapsl
+  \let\tenbf=\chapbf \let\tentt=\chaptt \let\smallcaps=\chapsc
+  \let\tensf=\chapsf \let\teni=\chapi \let\tensy=\chapsy
+  \let\tenttsl=\chapttsl
+  \def\curfontsize{chap}%
+  \def\lsize{sec}\def\lllsize{text}%
+  \resetmathfonts \setleading{19pt}}
+\def\secfonts{%
+  \let\tenrm=\secrm \let\tenit=\secit \let\tensl=\secsl
+  \let\tenbf=\secbf \let\tentt=\sectt \let\smallcaps=\secsc
+  \let\tensf=\secsf \let\teni=\seci \let\tensy=\secsy
+  \let\tenttsl=\secttsl
+  \def\curfontsize{sec}%
+  \def\lsize{subsec}\def\lllsize{reduced}%
+  \resetmathfonts \setleading{16pt}}
+\def\subsecfonts{%
+  \let\tenrm=\ssecrm \let\tenit=\ssecit \let\tensl=\ssecsl
+  \let\tenbf=\ssecbf \let\tentt=\ssectt \let\smallcaps=\ssecsc
+  \let\tensf=\ssecsf \let\teni=\sseci \let\tensy=\ssecsy
+  \let\tenttsl=\ssecttsl
+  \def\curfontsize{ssec}%
+  \def\lsize{text}\def\lllsize{small}%
+  \resetmathfonts \setleading{15pt}}
+\let\subsubsecfonts = \subsecfonts
+\def\reducedfonts{%
+  \let\tenrm=\reducedrm \let\tenit=\reducedit \let\tensl=\reducedsl
+  \let\tenbf=\reducedbf \let\tentt=\reducedtt \let\reducedcaps=\reducedsc
+  \let\tensf=\reducedsf \let\teni=\reducedi \let\tensy=\reducedsy
+  \let\tenttsl=\reducedttsl
+  \def\curfontsize{reduced}%
+  \def\lsize{small}\def\lllsize{smaller}%
+  \resetmathfonts \setleading{10.5pt}}
+\def\smallfonts{%
+  \let\tenrm=\smallrm \let\tenit=\smallit \let\tensl=\smallsl
+  \let\tenbf=\smallbf \let\tentt=\smalltt \let\smallcaps=\smallsc
+  \let\tensf=\smallsf \let\teni=\smalli \let\tensy=\smallsy
+  \let\tenttsl=\smallttsl
+  \def\curfontsize{small}%
+  \def\lsize{smaller}\def\lllsize{smaller}%
+  \resetmathfonts \setleading{10.5pt}}
+\def\smallerfonts{%
+  \let\tenrm=\smallerrm \let\tenit=\smallerit \let\tensl=\smallersl
+  \let\tenbf=\smallerbf \let\tentt=\smallertt \let\smallcaps=\smallersc
+  \let\tensf=\smallersf \let\teni=\smalleri \let\tensy=\smallersy
+  \let\tenttsl=\smallerttsl
+  \def\curfontsize{smaller}%
+  \def\lsize{smaller}\def\lllsize{smaller}%
+  \resetmathfonts \setleading{9.5pt}}
+
+% Set the fonts to use with the @small... environments.
+\let\smallexamplefonts = \smallfonts
+
+% About \smallexamplefonts.  If we use \smallfonts (9pt), @smallexample
+% can fit this many characters:
+%   8.5x11=86   smallbook=72  a4=90  a5=69
+% If we use \scriptfonts (8pt), then we can fit this many characters:
+%   8.5x11=90+  smallbook=80  a4=90+  a5=77
+% For me, subjectively, the few extra characters that fit aren't worth
+% the additional smallness of 8pt.  So I'm making the default 9pt.
+%
+% By the way, for comparison, here's what fits with @example (10pt):
+%   8.5x11=71  smallbook=60  a4=75  a5=58
+%
+% I wish the USA used A4 paper.
+% --karl, 24jan03.
+
+
+% Set up the default fonts, so we can use them for creating boxes.
+%
+\definetextfontsizexi
+
+% Define these so they can be easily changed for other fonts.
+\def\angleleft{$\langle$}
+\def\angleright{$\rangle$}
+
+% Count depth in font-changes, for error checks
+\newcount\fontdepth \fontdepth=0
+
+% Fonts for short table of contents.
+\setfont\shortcontrm\rmshape{12}{1000}{OT1}
+\setfont\shortcontbf\bfshape{10}{\magstep1}{OT1}  % no cmb12
+\setfont\shortcontsl\slshape{12}{1000}{OT1}
+\setfont\shortconttt\ttshape{12}{1000}{OT1TT}
+
+%% Add scribe-like font environments, plus @l for inline lisp (usually sans
+%% serif) and @ii for TeX italic
+
+% \smartitalic{ARG} outputs arg in italics, followed by an italic correction
+% unless the following character is such as not to need one.
+\def\smartitalicx{\ifx\next,\else\ifx\next-\else\ifx\next.\else
+                    \ptexslash\fi\fi\fi}
+\def\smartslanted#1{{\ifusingtt\ttsl\sl #1}\futurelet\next\smartitalicx}
+\def\smartitalic#1{{\ifusingtt\ttsl\it #1}\futurelet\next\smartitalicx}
+
+% like \smartslanted except unconditionally uses \ttsl.
+% @var is set to this for defun arguments.
+\def\ttslanted#1{{\ttsl #1}\futurelet\next\smartitalicx}
+
+% like \smartslanted except unconditionally use \sl.  We never want
+% ttsl for book titles, do we?
+\def\cite#1{{\sl #1}\futurelet\next\smartitalicx}
+
+\let\i=\smartitalic
+\let\slanted=\smartslanted
+\let\var=\smartslanted
+\let\dfn=\smartslanted
+\let\emph=\smartitalic
+
+% @b, explicit bold.
+\def\b#1{{\bf #1}}
+\let\strong=\b
+
+% @sansserif, explicit sans.
+\def\sansserif#1{{\sf #1}}
+
+% We can't just use \exhyphenpenalty, because that only has effect at
+% the end of a paragraph.  Restore normal hyphenation at the end of the
+% group within which \nohyphenation is presumably called.
+%
+\def\nohyphenation{\hyphenchar\font = -1  \aftergroup\restorehyphenation}
+\def\restorehyphenation{\hyphenchar\font = `- }
+
+% Set sfcode to normal for the chars that usually have another value.
+% Can't use plain's \frenchspacing because it uses the `\x notation, and
+% sometimes \x has an active definition that messes things up.
+%
+\catcode`@=11
+  \def\plainfrenchspacing{%
+    \sfcode\dotChar  =\@m \sfcode\questChar=\@m \sfcode\exclamChar=\@m
+    \sfcode\colonChar=\@m \sfcode\semiChar =\@m \sfcode\commaChar =\@m
+    \def\endofsentencespacefactor{1000}% for @. and friends
+  }
+  \def\plainnonfrenchspacing{%
+    \sfcode`\.3000\sfcode`\?3000\sfcode`\!3000
+    \sfcode`\:2000\sfcode`\;1500\sfcode`\,1250
+    \def\endofsentencespacefactor{3000}% for @. and friends
+  }
+\catcode`@=\other
+\def\endofsentencespacefactor{3000}% default
+
+\def\t#1{%
+  {\tt \rawbackslash \plainfrenchspacing #1}%
+  \null
+}
+\def\samp#1{`\tclose{#1}'\null}
+\setfont\keyrm\rmshape{8}{1000}{OT1}
+\font\keysy=cmsy9
+\def\key#1{{\keyrm\textfont2=\keysy \leavevmode\hbox{%
+  \raise0.4pt\hbox{\angleleft}\kern-.08em\vtop{%
+    \vbox{\hrule\kern-0.4pt
+     \hbox{\raise0.4pt\hbox{\vphantom{\angleleft}}#1}}%
+    \kern-0.4pt\hrule}%
+  \kern-.06em\raise0.4pt\hbox{\angleright}}}}
+\def\key #1{{\nohyphenation \uppercase{#1}}\null}
+% The old definition, with no lozenge:
+%\def\key #1{{\ttsl \nohyphenation \uppercase{#1}}\null}
+\def\ctrl #1{{\tt \rawbackslash \hat}#1}
+
+% @file, @option are the same as @samp.
+\let\file=\samp
+\let\option=\samp
+
+% @code is a modification of @t,
+% which makes spaces the same size as normal in the surrounding text.
+\def\tclose#1{%
+  {%
+    % Change normal interword space to be same as for the current font.
+    \spaceskip = \fontdimen2\font
+    %
+    % Switch to typewriter.
+    \tt
+    %
+    % But `\ ' produces the large typewriter interword space.
+    \def\ {{\spaceskip = 0pt{} }}%
+    %
+    % Turn off hyphenation.
+    \nohyphenation
+    %
+    \rawbackslash
+    \plainfrenchspacing
+    #1%
+  }%
+  \null
+}
+
+% We *must* turn on hyphenation at `-' and `_' in @code.
+% Otherwise, it is too hard to avoid overfull hboxes
+% in the Emacs manual, the Library manual, etc.
+
+% Unfortunately, TeX uses one parameter (\hyphenchar) to control
+% both hyphenation at - and hyphenation within words.
+% We must therefore turn them both off (\tclose does that)
+% and arrange explicitly to hyphenate at a dash.
+%  -- rms.
+{
+  \catcode`\-=\active \catcode`\_=\active
+  \catcode`\'=\active \catcode`\`=\active
+  %
+  \global\def\code{\begingroup
+    \catcode\rquoteChar=\active \catcode\lquoteChar=\active
+    \let'\codequoteright \let`\codequoteleft
+    %
+    \catcode\dashChar=\active  \catcode\underChar=\active
+    \ifallowcodebreaks
+     \let-\codedash
+     \let_\codeunder
+    \else
+     \let-\realdash
+     \let_\realunder
+    \fi
+    \codex
+  }
+}
+
+\def\realdash{-}
+\def\codedash{-\discretionary{}{}{}}
+\def\codeunder{%
+  % this is all so @math{@code{var_name}+1} can work.  In math mode, _
+  % is "active" (mathcode"8000) and \normalunderscore (or \char95, etc.)
+  % will therefore expand the active definition of _, which is us
+  % (inside @code that is), therefore an endless loop.
+  \ifusingtt{\ifmmode
+               \mathchar"075F % class 0=ordinary, family 7=ttfam, pos 0x5F=_.
+             \else\normalunderscore \fi
+             \discretionary{}{}{}}%
+            {\_}%
+}
+\def\codex #1{\tclose{#1}\endgroup}
+
+% An additional complication: the above will allow breaks after, e.g.,
+% each of the four underscores in __typeof__.  This is undesirable in
+% some manuals, especially if they don't have long identifiers in
+% general.  @allowcodebreaks provides a way to control this.
+% 
+\newif\ifallowcodebreaks  \allowcodebreakstrue
+
+\def\keywordtrue{true}
+\def\keywordfalse{false}
+
+\parseargdef\allowcodebreaks{%
+  \def\txiarg{#1}%
+  \ifx\txiarg\keywordtrue
+    \allowcodebreakstrue
+  \else\ifx\txiarg\keywordfalse
+    \allowcodebreaksfalse
+  \else
+    \errhelp = \EMsimple
+    \errmessage{Unknown @allowcodebreaks option `\txiarg'}%
+  \fi\fi
+}
+
+% @kbd is like @code, except that if the argument is just one @key command,
+% then @kbd has no effect.
+
+% @kbdinputstyle -- arg is `distinct' (@kbd uses slanted tty font always),
+%   `example' (@kbd uses ttsl only inside of @example and friends),
+%   or `code' (@kbd uses normal tty font always).
+\parseargdef\kbdinputstyle{%
+  \def\txiarg{#1}%
+  \ifx\txiarg\worddistinct
+    \gdef\kbdexamplefont{\ttsl}\gdef\kbdfont{\ttsl}%
+  \else\ifx\txiarg\wordexample
+    \gdef\kbdexamplefont{\ttsl}\gdef\kbdfont{\tt}%
+  \else\ifx\txiarg\wordcode
+    \gdef\kbdexamplefont{\tt}\gdef\kbdfont{\tt}%
+  \else
+    \errhelp = \EMsimple
+    \errmessage{Unknown @kbdinputstyle option `\txiarg'}%
+  \fi\fi\fi
+}
+\def\worddistinct{distinct}
+\def\wordexample{example}
+\def\wordcode{code}
+
+% Default is `distinct.'
+\kbdinputstyle distinct
+
+\def\xkey{\key}
+\def\kbdfoo#1#2#3\par{\def\one{#1}\def\three{#3}\def\threex{??}%
+\ifx\one\xkey\ifx\threex\three \key{#2}%
+\else{\tclose{\kbdfont\look}}\fi
+\else{\tclose{\kbdfont\look}}\fi}
+
+% For @indicateurl, @env, @command quotes seem unnecessary, so use \code.
+\let\indicateurl=\code
+\let\env=\code
+\let\command=\code
+
+% @uref (abbreviation for `urlref') takes an optional (comma-separated)
+% second argument specifying the text to display and an optional third
+% arg as text to display instead of (rather than in addition to) the url
+% itself.  First (mandatory) arg is the url.  Perhaps eventually put in
+% a hypertex \special here.
+%
+\def\uref#1{\douref #1,,,\finish}
+\def\douref#1,#2,#3,#4\finish{\begingroup
+  \unsepspaces
+  \pdfurl{#1}%
+  \setbox0 = \hbox{\ignorespaces #3}%
+  \ifdim\wd0 > 0pt
+    \unhbox0 % third arg given, show only that
+  \else
+    \setbox0 = \hbox{\ignorespaces #2}%
+    \ifdim\wd0 > 0pt
+      \ifpdf
+        \unhbox0             % PDF: 2nd arg given, show only it
+      \else
+        \unhbox0\ (\code{#1})% DVI: 2nd arg given, show both it and url
+      \fi
+    \else
+      \code{#1}% only url given, so show it
+    \fi
+  \fi
+  \endlink
+\endgroup}
+
+% @url synonym for @uref, since that's how everyone uses it.
+%
+\let\url=\uref
+
+% rms does not like angle brackets --karl, 17may97.
+% So now @email is just like @uref, unless we are pdf.
+%
+%\def\email#1{\angleleft{\tt #1}\angleright}
+\ifpdf
+  \def\email#1{\doemail#1,,\finish}
+  \def\doemail#1,#2,#3\finish{\begingroup
+    \unsepspaces
+    \pdfurl{mailto:#1}%
+    \setbox0 = \hbox{\ignorespaces #2}%
+    \ifdim\wd0>0pt\unhbox0\else\code{#1}\fi
+    \endlink
+  \endgroup}
+\else
+  \let\email=\uref
+\fi
+
+% Check if we are currently using a typewriter font.  Since all the
+% Computer Modern typewriter fonts have zero interword stretch (and
+% shrink), and it is reasonable to expect all typewriter fonts to have
+% this property, we can check that font parameter.
+%
+\def\ifmonospace{\ifdim\fontdimen3\font=0pt }
+
+% Typeset a dimension, e.g., `in' or `pt'.  The only reason for the
+% argument is to make the input look right: @dmn{pt} instead of @dmn{}pt.
+%
+\def\dmn#1{\thinspace #1}
+
+\def\kbd#1{\def\look{#1}\expandafter\kbdfoo\look??\par}
+
+% @l was never documented to mean ``switch to the Lisp font'',
+% and it is not used as such in any manual I can find.  We need it for
+% Polish suppressed-l.  --karl, 22sep96.
+%\def\l#1{{\li #1}\null}
+
+% Explicit font changes: @r, @sc, undocumented @ii.
+\def\r#1{{\rm #1}}              % roman font
+\def\sc#1{{\smallcaps#1}}       % smallcaps font
+\def\ii#1{{\it #1}}             % italic font
+
+% @acronym for "FBI", "NATO", and the like.
+% We print this one point size smaller, since it's intended for
+% all-uppercase.
+% 
+\def\acronym#1{\doacronym #1,,\finish}
+\def\doacronym#1,#2,#3\finish{%
+  {\selectfonts\lsize #1}%
+  \def\temp{#2}%
+  \ifx\temp\empty \else
+    \space ({\unsepspaces \ignorespaces \temp \unskip})%
+  \fi
+}
+
+% @abbr for "Comput. J." and the like.
+% No font change, but don't do end-of-sentence spacing.
+% 
+\def\abbr#1{\doabbr #1,,\finish}
+\def\doabbr#1,#2,#3\finish{%
+  {\plainfrenchspacing #1}%
+  \def\temp{#2}%
+  \ifx\temp\empty \else
+    \space ({\unsepspaces \ignorespaces \temp \unskip})%
+  \fi
+}
+
+% @pounds{} is a sterling sign, which Knuth put in the CM italic font.
+%
+\def\pounds{{\it\$}}
+
+% @euro{} comes from a separate font, depending on the current style.
+% We use the free feym* fonts from the eurosym package by Henrik
+% Theiling, which support regular, slanted, bold and bold slanted (and
+% "outlined" (blackboard board, sort of) versions, which we don't need).
+% It is available from http://www.ctan.org/tex-archive/fonts/eurosym.
+% 
+% Although only regular is the truly official Euro symbol, we ignore
+% that.  The Euro is designed to be slightly taller than the regular
+% font height.
+% 
+% feymr - regular
+% feymo - slanted
+% feybr - bold
+% feybo - bold slanted
+% 
+% There is no good (free) typewriter version, to my knowledge.
+% A feymr10 euro is ~7.3pt wide, while a normal cmtt10 char is ~5.25pt wide.
+% Hmm.
+% 
+% Also doesn't work in math.  Do we need to do math with euro symbols?
+% Hope not.
+% 
+% 
+\def\euro{{\eurofont e}}
+\def\eurofont{%
+  % We set the font at each command, rather than predefining it in
+  % \textfonts and the other font-switching commands, so that
+  % installations which never need the symbol don't have to have the
+  % font installed.
+  % 
+  % There is only one designed size (nominal 10pt), so we always scale
+  % that to the current nominal size.
+  % 
+  % By the way, simply using "at 1em" works for cmr10 and the like, but
+  % does not work for cmbx10 and other extended/shrunken fonts.
+  % 
+  \def\eurosize{\csname\curfontsize nominalsize\endcsname}%
+  %
+  \ifx\curfontstyle\bfstylename 
+    % bold:
+    \font\thiseurofont = \ifusingit{feybo10}{feybr10} at \eurosize
+  \else 
+    % regular:
+    \font\thiseurofont = \ifusingit{feymo10}{feymr10} at \eurosize
+  \fi
+  \thiseurofont
+}
+
+% Hacks for glyphs from the EC fonts similar to \euro.  We don't
+% use \let for the aliases, because sometimes we redefine the original
+% macro, and the alias should reflect the redefinition.
+\def\guillemetleft{{\ecfont \char"13}}
+\def\guillemotleft{\guillemetleft}
+\def\guillemetright{{\ecfont \char"14}}
+\def\guillemotright{\guillemetright}
+\def\guilsinglleft{{\ecfont \char"0E}}
+\def\guilsinglright{{\ecfont \char"0F}}
+\def\quotedblbase{{\ecfont \char"12}}
+\def\quotesinglbase{{\ecfont \char"0D}}
+%
+\def\ecfont{%
+  % We can't distinguish serif/sanserif and italic/slanted, but this
+  % is used for crude hacks anyway (like adding French and German
+  % quotes to documents typeset with CM, where we lose kerning), so
+  % hopefully nobody will notice/care.
+  \edef\ecsize{\csname\curfontsize ecsize\endcsname}%
+  \edef\nominalsize{\csname\curfontsize nominalsize\endcsname}%
+  \ifx\curfontstyle\bfstylename
+    % bold:
+    \font\thisecfont = ecb\ifusingit{i}{x}\ecsize \space at \nominalsize
+  \else
+    % regular:
+    \font\thisecfont = ec\ifusingit{ti}{rm}\ecsize \space at \nominalsize
+  \fi
+  \thisecfont
+}
+
+% @registeredsymbol - R in a circle.  The font for the R should really
+% be smaller yet, but lllsize is the best we can do for now.
+% Adapted from the plain.tex definition of \copyright.
+%
+\def\registeredsymbol{%
+  $^{{\ooalign{\hfil\raise.07ex\hbox{\selectfonts\lllsize R}%
+               \hfil\crcr\Orb}}%
+    }$%
+}
+
+% @textdegree - the normal degrees sign.
+%
+\def\textdegree{$^\circ$}
+
+% Laurent Siebenmann reports \Orb undefined with:
+%  Textures 1.7.7 (preloaded format=plain 93.10.14)  (68K)  16 APR 2004 02:38
+% so we'll define it if necessary.
+% 
+\ifx\Orb\undefined
+\def\Orb{\mathhexbox20D}
+\fi
+
+% Quotes.
+\chardef\quotedblleft="5C
+\chardef\quotedblright=`\"
+\chardef\quoteleft=`\`
+\chardef\quoteright=`\'
+
+
+\message{page headings,}
+
+\newskip\titlepagetopglue \titlepagetopglue = 1.5in
+\newskip\titlepagebottomglue \titlepagebottomglue = 2pc
+
+% First the title page.  Must do @settitle before @titlepage.
+\newif\ifseenauthor
+\newif\iffinishedtitlepage
+
+% Do an implicit @contents or @shortcontents after @end titlepage if the
+% user says @setcontentsaftertitlepage or @setshortcontentsaftertitlepage.
+%
+\newif\ifsetcontentsaftertitlepage
+ \let\setcontentsaftertitlepage = \setcontentsaftertitlepagetrue
+\newif\ifsetshortcontentsaftertitlepage
+ \let\setshortcontentsaftertitlepage = \setshortcontentsaftertitlepagetrue
+
+\parseargdef\shorttitlepage{\begingroup\hbox{}\vskip 1.5in \chaprm \centerline{#1}%
+        \endgroup\page\hbox{}\page}
+
+\envdef\titlepage{%
+  % Open one extra group, as we want to close it in the middle of \Etitlepage.
+  \begingroup
+    \parindent=0pt \textfonts
+    % Leave some space at the very top of the page.
+    \vglue\titlepagetopglue
+    % No rule at page bottom unless we print one at the top with @title.
+    \finishedtitlepagetrue
+    %
+    % Most title ``pages'' are actually two pages long, with space
+    % at the top of the second.  We don't want the ragged left on the second.
+    \let\oldpage = \page
+    \def\page{%
+      \iffinishedtitlepage\else
+	 \finishtitlepage
+      \fi
+      \let\page = \oldpage
+      \page
+      \null
+    }%
+}
+
+\def\Etitlepage{%
+    \iffinishedtitlepage\else
+	\finishtitlepage
+    \fi
+    % It is important to do the page break before ending the group,
+    % because the headline and footline are only empty inside the group.
+    % If we use the new definition of \page, we always get a blank page
+    % after the title page, which we certainly don't want.
+    \oldpage
+  \endgroup
+  %
+  % Need this before the \...aftertitlepage checks so that if they are
+  % in effect the toc pages will come out with page numbers.
+  \HEADINGSon
+  %
+  % If they want short, they certainly want long too.
+  \ifsetshortcontentsaftertitlepage
+    \shortcontents
+    \contents
+    \global\let\shortcontents = \relax
+    \global\let\contents = \relax
+  \fi
+  %
+  \ifsetcontentsaftertitlepage
+    \contents
+    \global\let\contents = \relax
+    \global\let\shortcontents = \relax
+  \fi
+}
+
+\def\finishtitlepage{%
+  \vskip4pt \hrule height 2pt width \hsize
+  \vskip\titlepagebottomglue
+  \finishedtitlepagetrue
+}
+
+%%% Macros to be used within @titlepage:
+
+\let\subtitlerm=\tenrm
+\def\subtitlefont{\subtitlerm \normalbaselineskip = 13pt \normalbaselines}
+
+\def\authorfont{\authorrm \normalbaselineskip = 16pt \normalbaselines
+		\let\tt=\authortt}
+
+\parseargdef\title{%
+  \checkenv\titlepage
+  \leftline{\titlefonts\rm #1}
+  % print a rule at the page bottom also.
+  \finishedtitlepagefalse
+  \vskip4pt \hrule height 4pt width \hsize \vskip4pt
+}
+
+\parseargdef\subtitle{%
+  \checkenv\titlepage
+  {\subtitlefont \rightline{#1}}%
+}
+
+% @author should come last, but may come many times.
+% It can also be used inside @quotation.
+%
+\parseargdef\author{%
+  \def\temp{\quotation}%
+  \ifx\thisenv\temp
+    \def\quotationauthor{#1}% printed in \Equotation.
+  \else
+    \checkenv\titlepage
+    \ifseenauthor\else \vskip 0pt plus 1filll \seenauthortrue \fi
+    {\authorfont \leftline{#1}}%
+  \fi
+}
+
+
+%%% Set up page headings and footings.
+
+\let\thispage=\folio
+
+\newtoks\evenheadline    % headline on even pages
+\newtoks\oddheadline     % headline on odd pages
+\newtoks\evenfootline    % footline on even pages
+\newtoks\oddfootline     % footline on odd pages
+
+% Now make TeX use those variables
+\headline={{\textfonts\rm \ifodd\pageno \the\oddheadline
+                            \else \the\evenheadline \fi}}
+\footline={{\textfonts\rm \ifodd\pageno \the\oddfootline
+                            \else \the\evenfootline \fi}\HEADINGShook}
+\let\HEADINGShook=\relax
+
+% Commands to set those variables.
+% For example, this is what  @headings on  does
+% @evenheading @thistitle|@thispage|@thischapter
+% @oddheading @thischapter|@thispage|@thistitle
+% @evenfooting @thisfile||
+% @oddfooting ||@thisfile
+
+
+\def\evenheading{\parsearg\evenheadingxxx}
+\def\evenheadingxxx #1{\evenheadingyyy #1\|\|\|\|\finish}
+\def\evenheadingyyy #1\|#2\|#3\|#4\finish{%
+\global\evenheadline={\rlap{\centerline{#2}}\line{#1\hfil#3}}}
+
+\def\oddheading{\parsearg\oddheadingxxx}
+\def\oddheadingxxx #1{\oddheadingyyy #1\|\|\|\|\finish}
+\def\oddheadingyyy #1\|#2\|#3\|#4\finish{%
+\global\oddheadline={\rlap{\centerline{#2}}\line{#1\hfil#3}}}
+
+\parseargdef\everyheading{\oddheadingxxx{#1}\evenheadingxxx{#1}}%
+
+\def\evenfooting{\parsearg\evenfootingxxx}
+\def\evenfootingxxx #1{\evenfootingyyy #1\|\|\|\|\finish}
+\def\evenfootingyyy #1\|#2\|#3\|#4\finish{%
+\global\evenfootline={\rlap{\centerline{#2}}\line{#1\hfil#3}}}
+
+\def\oddfooting{\parsearg\oddfootingxxx}
+\def\oddfootingxxx #1{\oddfootingyyy #1\|\|\|\|\finish}
+\def\oddfootingyyy #1\|#2\|#3\|#4\finish{%
+  \global\oddfootline = {\rlap{\centerline{#2}}\line{#1\hfil#3}}%
+  %
+  % Leave some space for the footline.  Hopefully ok to assume
+  % @evenfooting will not be used by itself.
+  \global\advance\pageheight by -12pt
+  \global\advance\vsize by -12pt
+}
+
+\parseargdef\everyfooting{\oddfootingxxx{#1}\evenfootingxxx{#1}}
+
+% @evenheadingmarks top     \thischapter <- chapter at the top of a page
+% @evenheadingmarks bottom  \thischapter <- chapter at the bottom of a page
+%
+% The same set of arguments for:
+%
+% @oddheadingmarks
+% @evenfootingmarks
+% @oddfootingmarks
+% @everyheadingmarks
+% @everyfootingmarks
+
+\def\evenheadingmarks{\headingmarks{even}{heading}}
+\def\oddheadingmarks{\headingmarks{odd}{heading}}
+\def\evenfootingmarks{\headingmarks{even}{footing}}
+\def\oddfootingmarks{\headingmarks{odd}{footing}}
+\def\everyheadingmarks#1 {\headingmarks{even}{heading}{#1}
+                          \headingmarks{odd}{heading}{#1} }
+\def\everyfootingmarks#1 {\headingmarks{even}{footing}{#1}
+                          \headingmarks{odd}{footing}{#1} }
+% #1 = even/odd, #2 = heading/footing, #3 = top/bottom.
+\def\headingmarks#1#2#3 {%
+  \expandafter\let\expandafter\temp \csname get#3headingmarks\endcsname
+  \global\expandafter\let\csname get#1#2marks\endcsname \temp
+}
+
+\everyheadingmarks bottom
+\everyfootingmarks bottom
+
+% @headings double      turns headings on for double-sided printing.
+% @headings single      turns headings on for single-sided printing.
+% @headings off         turns them off.
+% @headings on          same as @headings double, retained for compatibility.
+% @headings after       turns on double-sided headings after this page.
+% @headings doubleafter turns on double-sided headings after this page.
+% @headings singleafter turns on single-sided headings after this page.
+% By default, they are off at the start of a document,
+% and turned `on' after @end titlepage.
+
+\def\headings #1 {\csname HEADINGS#1\endcsname}
+
+\def\HEADINGSoff{%
+\global\evenheadline={\hfil} \global\evenfootline={\hfil}
+\global\oddheadline={\hfil} \global\oddfootline={\hfil}}
+\HEADINGSoff
+% When we turn headings on, set the page number to 1.
+% For double-sided printing, put current file name in lower left corner,
+% chapter name on inside top of right hand pages, document
+% title on inside top of left hand pages, and page numbers on outside top
+% edge of all pages.
+\def\HEADINGSdouble{%
+\global\pageno=1
+\global\evenfootline={\hfil}
+\global\oddfootline={\hfil}
+\global\evenheadline={\line{\folio\hfil\thistitle}}
+\global\oddheadline={\line{\thischapter\hfil\folio}}
+\global\let\contentsalignmacro = \chapoddpage
+}
+\let\contentsalignmacro = \chappager
+
+% For single-sided printing, chapter title goes across top left of page,
+% page number on top right.
+\def\HEADINGSsingle{%
+\global\pageno=1
+\global\evenfootline={\hfil}
+\global\oddfootline={\hfil}
+\global\evenheadline={\line{\thischapter\hfil\folio}}
+\global\oddheadline={\line{\thischapter\hfil\folio}}
+\global\let\contentsalignmacro = \chappager
+}
+\def\HEADINGSon{\HEADINGSdouble}
+
+\def\HEADINGSafter{\let\HEADINGShook=\HEADINGSdoublex}
+\let\HEADINGSdoubleafter=\HEADINGSafter
+\def\HEADINGSdoublex{%
+\global\evenfootline={\hfil}
+\global\oddfootline={\hfil}
+\global\evenheadline={\line{\folio\hfil\thistitle}}
+\global\oddheadline={\line{\thischapter\hfil\folio}}
+\global\let\contentsalignmacro = \chapoddpage
+}
+
+\def\HEADINGSsingleafter{\let\HEADINGShook=\HEADINGSsinglex}
+\def\HEADINGSsinglex{%
+\global\evenfootline={\hfil}
+\global\oddfootline={\hfil}
+\global\evenheadline={\line{\thischapter\hfil\folio}}
+\global\oddheadline={\line{\thischapter\hfil\folio}}
+\global\let\contentsalignmacro = \chappager
+}
+
+% Subroutines used in generating headings
+% This produces Day Month Year style of output.
+% Only define if not already defined, in case a txi-??.tex file has set
+% up a different format (e.g., txi-cs.tex does this).
+\ifx\today\undefined
+\def\today{%
+  \number\day\space
+  \ifcase\month
+  \or\putwordMJan\or\putwordMFeb\or\putwordMMar\or\putwordMApr
+  \or\putwordMMay\or\putwordMJun\or\putwordMJul\or\putwordMAug
+  \or\putwordMSep\or\putwordMOct\or\putwordMNov\or\putwordMDec
+  \fi
+  \space\number\year}
+\fi
+
+% @settitle line...  specifies the title of the document, for headings.
+% It generates no output of its own.
+\def\thistitle{\putwordNoTitle}
+\def\settitle{\parsearg{\gdef\thistitle}}
+
+
+\message{tables,}
+% Tables -- @table, @ftable, @vtable, @item(x).
+
+% default indentation of table text
+\newdimen\tableindent \tableindent=.8in
+% default indentation of @itemize and @enumerate text
+\newdimen\itemindent  \itemindent=.3in
+% margin between end of table item and start of table text.
+\newdimen\itemmargin  \itemmargin=.1in
+
+% used internally for \itemindent minus \itemmargin
+\newdimen\itemmax
+
+% Note @table, @ftable, and @vtable define @item, @itemx, etc., with
+% these defs.
+% They also define \itemindex
+% to index the item name in whatever manner is desired (perhaps none).
+
+\newif\ifitemxneedsnegativevskip
+
+\def\itemxpar{\par\ifitemxneedsnegativevskip\nobreak\vskip-\parskip\nobreak\fi}
+
+\def\internalBitem{\smallbreak \parsearg\itemzzz}
+\def\internalBitemx{\itemxpar \parsearg\itemzzz}
+
+\def\itemzzz #1{\begingroup %
+  \advance\hsize by -\rightskip
+  \advance\hsize by -\tableindent
+  \setbox0=\hbox{\itemindicate{#1}}%
+  \itemindex{#1}%
+  \nobreak % This prevents a break before @itemx.
+  %
+  % If the item text does not fit in the space we have, put it on a line
+  % by itself, and do not allow a page break either before or after that
+  % line.  We do not start a paragraph here because then if the next
+  % command is, e.g., @kindex, the whatsit would get put into the
+  % horizontal list on a line by itself, resulting in extra blank space.
+  \ifdim \wd0>\itemmax
+    %
+    % Make this a paragraph so we get the \parskip glue and wrapping,
+    % but leave it ragged-right.
+    \begingroup
+      \advance\leftskip by-\tableindent
+      \advance\hsize by\tableindent
+      \advance\rightskip by0pt plus1fil
+      \leavevmode\unhbox0\par
+    \endgroup
+    %
+    % We're going to be starting a paragraph, but we don't want the
+    % \parskip glue -- logically it's part of the @item we just started.
+    \nobreak \vskip-\parskip
+    %
+    % Stop a page break at the \parskip glue coming up.  However, if
+    % what follows is an environment such as @example, there will be no
+    % \parskip glue; then the negative vskip we just inserted would
+    % cause the example and the item to crash together.  So we use this
+    % bizarre value of 10001 as a signal to \aboveenvbreak to insert
+    % \parskip glue after all.  Section titles are handled this way also.
+    % 
+    \penalty 10001
+    \endgroup
+    \itemxneedsnegativevskipfalse
+  \else
+    % The item text fits into the space.  Start a paragraph, so that the
+    % following text (if any) will end up on the same line.
+    \noindent
+    % Do this with kerns and \unhbox so that if there is a footnote in
+    % the item text, it can migrate to the main vertical list and
+    % eventually be printed.
+    \nobreak\kern-\tableindent
+    \dimen0 = \itemmax  \advance\dimen0 by \itemmargin \advance\dimen0 by -\wd0
+    \unhbox0
+    \nobreak\kern\dimen0
+    \endgroup
+    \itemxneedsnegativevskiptrue
+  \fi
+}
+
+\def\item{\errmessage{@item while not in a list environment}}
+\def\itemx{\errmessage{@itemx while not in a list environment}}
+
+% @table, @ftable, @vtable.
+\envdef\table{%
+  \let\itemindex\gobble
+  \tablecheck{table}%
+}
+\envdef\ftable{%
+  \def\itemindex ##1{\doind {fn}{\code{##1}}}%
+  \tablecheck{ftable}%
+}
+\envdef\vtable{%
+  \def\itemindex ##1{\doind {vr}{\code{##1}}}%
+  \tablecheck{vtable}%
+}
+\def\tablecheck#1{%
+  \ifnum \the\catcode`\^^M=\active
+    \endgroup
+    \errmessage{This command won't work in this context; perhaps the problem is
+      that we are \inenvironment\thisenv}%
+    \def\next{\doignore{#1}}%
+  \else
+    \let\next\tablex
+  \fi
+  \next
+}
+\def\tablex#1{%
+  \def\itemindicate{#1}%
+  \parsearg\tabley
+}
+\def\tabley#1{%
+  {%
+    \makevalueexpandable
+    \edef\temp{\noexpand\tablez #1\space\space\space}%
+    \expandafter
+  }\temp \endtablez
+}
+\def\tablez #1 #2 #3 #4\endtablez{%
+  \aboveenvbreak
+  \ifnum 0#1>0 \advance \leftskip by #1\mil \fi
+  \ifnum 0#2>0 \tableindent=#2\mil \fi
+  \ifnum 0#3>0 \advance \rightskip by #3\mil \fi
+  \itemmax=\tableindent
+  \advance \itemmax by -\itemmargin
+  \advance \leftskip by \tableindent
+  \exdentamount=\tableindent
+  \parindent = 0pt
+  \parskip = \smallskipamount
+  \ifdim \parskip=0pt \parskip=2pt \fi
+  \let\item = \internalBitem
+  \let\itemx = \internalBitemx
+}
+\def\Etable{\endgraf\afterenvbreak}
+\let\Eftable\Etable
+\let\Evtable\Etable
+\let\Eitemize\Etable
+\let\Eenumerate\Etable
+
+% This is the counter used by @enumerate, which is really @itemize
+
+\newcount \itemno
+
+\envdef\itemize{\parsearg\doitemize}
+
+\def\doitemize#1{%
+  \aboveenvbreak
+  \itemmax=\itemindent
+  \advance\itemmax by -\itemmargin
+  \advance\leftskip by \itemindent
+  \exdentamount=\itemindent
+  \parindent=0pt
+  \parskip=\smallskipamount
+  \ifdim\parskip=0pt \parskip=2pt \fi
+  \def\itemcontents{#1}%
+  % @itemize with no arg is equivalent to @itemize @bullet.
+  \ifx\itemcontents\empty\def\itemcontents{\bullet}\fi
+  \let\item=\itemizeitem
+}
+
+% Definition of @item while inside @itemize and @enumerate.
+%
+\def\itemizeitem{%
+  \advance\itemno by 1  % for enumerations
+  {\let\par=\endgraf \smallbreak}% reasonable place to break
+  {%
+   % If the document has an @itemize directly after a section title, a
+   % \nobreak will be last on the list, and \sectionheading will have
+   % done a \vskip-\parskip.  In that case, we don't want to zero
+   % parskip, or the item text will crash with the heading.  On the
+   % other hand, when there is normal text preceding the item (as there
+   % usually is), we do want to zero parskip, or there would be too much
+   % space.  In that case, we won't have a \nobreak before.  At least
+   % that's the theory.
+   \ifnum\lastpenalty<10000 \parskip=0in \fi
+   \noindent
+   \hbox to 0pt{\hss \itemcontents \kern\itemmargin}%
+   \vadjust{\penalty 1200}}% not good to break after first line of item.
+  \flushcr
+}
+
+% \splitoff TOKENS\endmark defines \first to be the first token in
+% TOKENS, and \rest to be the remainder.
+%
+\def\splitoff#1#2\endmark{\def\first{#1}\def\rest{#2}}%
+
+% Allow an optional argument of an uppercase letter, lowercase letter,
+% or number, to specify the first label in the enumerated list.  No
+% argument is the same as `1'.
+%
+\envparseargdef\enumerate{\enumeratey #1  \endenumeratey}
+\def\enumeratey #1 #2\endenumeratey{%
+  % If we were given no argument, pretend we were given `1'.
+  \def\thearg{#1}%
+  \ifx\thearg\empty \def\thearg{1}\fi
+  %
+  % Detect if the argument is a single token.  If so, it might be a
+  % letter.  Otherwise, the only valid thing it can be is a number.
+  % (We will always have one token, because of the test we just made.
+  % This is a good thing, since \splitoff doesn't work given nothing at
+  % all -- the first parameter is undelimited.)
+  \expandafter\splitoff\thearg\endmark
+  \ifx\rest\empty
+    % Only one token in the argument.  It could still be anything.
+    % A ``lowercase letter'' is one whose \lccode is nonzero.
+    % An ``uppercase letter'' is one whose \lccode is both nonzero, and
+    %   not equal to itself.
+    % Otherwise, we assume it's a number.
+    %
+    % We need the \relax at the end of the \ifnum lines to stop TeX from
+    % continuing to look for a <number>.
+    %
+    \ifnum\lccode\expandafter`\thearg=0\relax
+      \numericenumerate % a number (we hope)
+    \else
+      % It's a letter.
+      \ifnum\lccode\expandafter`\thearg=\expandafter`\thearg\relax
+        \lowercaseenumerate % lowercase letter
+      \else
+        \uppercaseenumerate % uppercase letter
+      \fi
+    \fi
+  \else
+    % Multiple tokens in the argument.  We hope it's a number.
+    \numericenumerate
+  \fi
+}
+
+% An @enumerate whose labels are integers.  The starting integer is
+% given in \thearg.
+%
+\def\numericenumerate{%
+  \itemno = \thearg
+  \startenumeration{\the\itemno}%
+}
+
+% The starting (lowercase) letter is in \thearg.
+\def\lowercaseenumerate{%
+  \itemno = \expandafter`\thearg
+  \startenumeration{%
+    % Be sure we're not beyond the end of the alphabet.
+    \ifnum\itemno=0
+      \errmessage{No more lowercase letters in @enumerate; get a bigger
+                  alphabet}%
+    \fi
+    \char\lccode\itemno
+  }%
+}
+
+% The starting (uppercase) letter is in \thearg.
+\def\uppercaseenumerate{%
+  \itemno = \expandafter`\thearg
+  \startenumeration{%
+    % Be sure we're not beyond the end of the alphabet.
+    \ifnum\itemno=0
+      \errmessage{No more uppercase letters in @enumerate; get a bigger
+                  alphabet}
+    \fi
+    \char\uccode\itemno
+  }%
+}
+
+% Call \doitemize, adding a period to the first argument and supplying the
+% common last two arguments.  Also subtract one from the initial value in
+% \itemno, since @item increments \itemno.
+%
+\def\startenumeration#1{%
+  \advance\itemno by -1
+  \doitemize{#1.}\flushcr
+}
+
+% @alphaenumerate and @capsenumerate are abbreviations for giving an arg
+% to @enumerate.
+%
+\def\alphaenumerate{\enumerate{a}}
+\def\capsenumerate{\enumerate{A}}
+\def\Ealphaenumerate{\Eenumerate}
+\def\Ecapsenumerate{\Eenumerate}
+
+
+% @multitable macros
+% Amy Hendrickson, 8/18/94, 3/6/96
+%
+% @multitable ... @end multitable will make as many columns as desired.
+% Contents of each column will wrap at width given in preamble.  Width
+% can be specified either with sample text given in a template line,
+% or in percent of \hsize, the current width of text on page.
+
+% Table can continue over pages but will only break between lines.
+
+% To make preamble:
+%
+% Either define widths of columns in terms of percent of \hsize:
+%   @multitable @columnfractions .25 .3 .45
+%   @item ...
+%
+%   Numbers following @columnfractions are the percent of the total
+%   current hsize to be used for each column. You may use as many
+%   columns as desired.
+
+
+% Or use a template:
+%   @multitable {Column 1 template} {Column 2 template} {Column 3 template}
+%   @item ...
+%   using the widest term desired in each column.
+
+% Each new table line starts with @item, each subsequent new column
+% starts with @tab. Empty columns may be produced by supplying @tab's
+% with nothing between them for as many times as empty columns are needed,
+% ie, @tab@tab@tab will produce two empty columns.
+
+% @item, @tab do not need to be on their own lines, but it will not hurt
+% if they are.
+
+% Sample multitable:
+
+%   @multitable {Column 1 template} {Column 2 template} {Column 3 template}
+%   @item first col stuff @tab second col stuff @tab third col
+%   @item
+%   first col stuff
+%   @tab
+%   second col stuff
+%   @tab
+%   third col
+%   @item first col stuff @tab second col stuff
+%   @tab Many paragraphs of text may be used in any column.
+%
+%         They will wrap at the width determined by the template.
+%   @item@tab@tab This will be in third column.
+%   @end multitable
+
+% Default dimensions may be reset by user.
+% @multitableparskip is vertical space between paragraphs in table.
+% @multitableparindent is paragraph indent in table.
+% @multitablecolmargin is horizontal space to be left between columns.
+% @multitablelinespace is space to leave between table items, baseline
+%                                                            to baseline.
+%   0pt means it depends on current normal line spacing.
+%
+\newskip\multitableparskip
+\newskip\multitableparindent
+\newdimen\multitablecolspace
+\newskip\multitablelinespace
+\multitableparskip=0pt
+\multitableparindent=6pt
+\multitablecolspace=12pt
+\multitablelinespace=0pt
+
+% Macros used to set up halign preamble:
+%
+\let\endsetuptable\relax
+\def\xendsetuptable{\endsetuptable}
+\let\columnfractions\relax
+\def\xcolumnfractions{\columnfractions}
+\newif\ifsetpercent
+
+% #1 is the @columnfraction, usually a decimal number like .5, but might
+% be just 1.  We just use it, whatever it is.
+%
+\def\pickupwholefraction#1 {%
+  \global\advance\colcount by 1
+  \expandafter\xdef\csname col\the\colcount\endcsname{#1\hsize}%
+  \setuptable
+}
+
+\newcount\colcount
+\def\setuptable#1{%
+  \def\firstarg{#1}%
+  \ifx\firstarg\xendsetuptable
+    \let\go = \relax
+  \else
+    \ifx\firstarg\xcolumnfractions
+      \global\setpercenttrue
+    \else
+      \ifsetpercent
+         \let\go\pickupwholefraction
+      \else
+         \global\advance\colcount by 1
+         \setbox0=\hbox{#1\unskip\space}% Add a normal word space as a
+                   % separator; typically that is always in the input, anyway.
+         \expandafter\xdef\csname col\the\colcount\endcsname{\the\wd0}%
+      \fi
+    \fi
+    \ifx\go\pickupwholefraction
+      % Put the argument back for the \pickupwholefraction call, so
+      % we'll always have a period there to be parsed.
+      \def\go{\pickupwholefraction#1}%
+    \else
+      \let\go = \setuptable
+    \fi%
+  \fi
+  \go
+}
+
+% multitable-only commands.
+%
+% @headitem starts a heading row, which we typeset in bold.
+% Assignments have to be global since we are inside the implicit group
+% of an alignment entry.  Note that \everycr resets \everytab.
+\def\headitem{\checkenv\multitable \crcr \global\everytab={\bf}\the\everytab}%
+%
+% A \tab used to include \hskip1sp.  But then the space in a template
+% line is not enough.  That is bad.  So let's go back to just `&' until
+% we encounter the problem it was intended to solve again.
+%					--karl, nathan@acm.org, 20apr99.
+\def\tab{\checkenv\multitable &\the\everytab}%
+
+% @multitable ... @end multitable definitions:
+%
+\newtoks\everytab  % insert after every tab.
+%
+\envdef\multitable{%
+  \vskip\parskip
+  \startsavinginserts
+  %
+  % @item within a multitable starts a normal row.
+  % We use \def instead of \let so that if one of the multitable entries
+  % contains an @itemize, we don't choke on the \item (seen as \crcr aka
+  % \endtemplate) expanding \doitemize.
+  \def\item{\crcr}%
+  %
+  \tolerance=9500
+  \hbadness=9500
+  \setmultitablespacing
+  \parskip=\multitableparskip
+  \parindent=\multitableparindent
+  \overfullrule=0pt
+  \global\colcount=0
+  %
+  \everycr = {%
+    \noalign{%
+      \global\everytab={}%
+      \global\colcount=0 % Reset the column counter.
+      % Check for saved footnotes, etc.
+      \checkinserts
+      % Keeps underfull box messages off when table breaks over pages.
+      %\filbreak
+	% Maybe so, but it also creates really weird page breaks when the
+	% table breaks over pages. Wouldn't \vfil be better?  Wait until the
+	% problem manifests itself, so it can be fixed for real --karl.
+    }%
+  }%
+  %
+  \parsearg\domultitable
+}
+\def\domultitable#1{%
+  % To parse everything between @multitable and @item:
+  \setuptable#1 \endsetuptable
+  %
+  % This preamble sets up a generic column definition, which will
+  % be used as many times as user calls for columns.
+  % \vtop will set a single line and will also let text wrap and
+  % continue for many paragraphs if desired.
+  \halign\bgroup &%
+    \global\advance\colcount by 1
+    \multistrut
+    \vtop{%
+      % Use the current \colcount to find the correct column width:
+      \hsize=\expandafter\csname col\the\colcount\endcsname
+      %
+      % In order to keep entries from bumping into each other
+      % we will add a \leftskip of \multitablecolspace to all columns after
+      % the first one.
+      %
+      % If a template has been used, we will add \multitablecolspace
+      % to the width of each template entry.
+      %
+      % If the user has set preamble in terms of percent of \hsize we will
+      % use that dimension as the width of the column, and the \leftskip
+      % will keep entries from bumping into each other.  Table will start at
+      % left margin and final column will justify at right margin.
+      %
+      % Make sure we don't inherit \rightskip from the outer environment.
+      \rightskip=0pt
+      \ifnum\colcount=1
+	% The first column will be indented with the surrounding text.
+	\advance\hsize by\leftskip
+      \else
+	\ifsetpercent \else
+	  % If user has not set preamble in terms of percent of \hsize
+	  % we will advance \hsize by \multitablecolspace.
+	  \advance\hsize by \multitablecolspace
+	\fi
+       % In either case we will make \leftskip=\multitablecolspace:
+      \leftskip=\multitablecolspace
+      \fi
+      % Ignoring space at the beginning and end avoids an occasional spurious
+      % blank line, when TeX decides to break the line at the space before the
+      % box from the multistrut, so the strut ends up on a line by itself.
+      % For example:
+      % @multitable @columnfractions .11 .89
+      % @item @code{#}
+      % @tab Legal holiday which is valid in major parts of the whole country.
+      % Is automatically provided with highlighting sequences respectively
+      % marking characters.
+      \noindent\ignorespaces##\unskip\multistrut
+    }\cr
+}
+\def\Emultitable{%
+  \crcr
+  \egroup % end the \halign
+  \global\setpercentfalse
+}
+
+\def\setmultitablespacing{%
+  \def\multistrut{\strut}% just use the standard line spacing
+  %
+  % Compute \multitablelinespace (if not defined by user) for use in
+  % \multitableparskip calculation.  We used define \multistrut based on
+  % this, but (ironically) that caused the spacing to be off.
+  % See bug-texinfo report from Werner Lemberg, 31 Oct 2004 12:52:20 +0100.
+\ifdim\multitablelinespace=0pt
+\setbox0=\vbox{X}\global\multitablelinespace=\the\baselineskip
+\global\advance\multitablelinespace by-\ht0
+\fi
+%% Test to see if parskip is larger than space between lines of
+%% table. If not, do nothing.
+%%        If so, set to same dimension as multitablelinespace.
+\ifdim\multitableparskip>\multitablelinespace
+\global\multitableparskip=\multitablelinespace
+\global\advance\multitableparskip-7pt %% to keep parskip somewhat smaller
+                                      %% than skip between lines in the table.
+\fi%
+\ifdim\multitableparskip=0pt
+\global\multitableparskip=\multitablelinespace
+\global\advance\multitableparskip-7pt %% to keep parskip somewhat smaller
+                                      %% than skip between lines in the table.
+\fi}
+
+
+\message{conditionals,}
+
+% @iftex, @ifnotdocbook, @ifnothtml, @ifnotinfo, @ifnotplaintext,
+% @ifnotxml always succeed.  They currently do nothing; we don't
+% attempt to check whether the conditionals are properly nested.  But we
+% have to remember that they are conditionals, so that @end doesn't
+% attempt to close an environment group.
+%
+\def\makecond#1{%
+  \expandafter\let\csname #1\endcsname = \relax
+  \expandafter\let\csname iscond.#1\endcsname = 1
+}
+\makecond{iftex}
+\makecond{ifnotdocbook}
+\makecond{ifnothtml}
+\makecond{ifnotinfo}
+\makecond{ifnotplaintext}
+\makecond{ifnotxml}
+
+% Ignore @ignore, @ifhtml, @ifinfo, and the like.
+%
+\def\direntry{\doignore{direntry}}
+\def\documentdescription{\doignore{documentdescription}}
+\def\docbook{\doignore{docbook}}
+\def\html{\doignore{html}}
+\def\ifdocbook{\doignore{ifdocbook}}
+\def\ifhtml{\doignore{ifhtml}}
+\def\ifinfo{\doignore{ifinfo}}
+\def\ifnottex{\doignore{ifnottex}}
+\def\ifplaintext{\doignore{ifplaintext}}
+\def\ifxml{\doignore{ifxml}}
+\def\ignore{\doignore{ignore}}
+\def\menu{\doignore{menu}}
+\def\xml{\doignore{xml}}
+
+% Ignore text until a line `@end #1', keeping track of nested conditionals.
+%
+% A count to remember the depth of nesting.
+\newcount\doignorecount
+
+\def\doignore#1{\begingroup
+  % Scan in ``verbatim'' mode:
+  \obeylines
+  \catcode`\@ = \other
+  \catcode`\{ = \other
+  \catcode`\} = \other
+  %
+  % Make sure that spaces turn into tokens that match what \doignoretext wants.
+  \spaceisspace
+  %
+  % Count number of #1's that we've seen.
+  \doignorecount = 0
+  %
+  % Swallow text until we reach the matching `@end #1'.
+  \dodoignore{#1}%
+}
+
+{ \catcode`_=11 % We want to use \_STOP_ which cannot appear in texinfo source.
+  \obeylines %
+  %
+  \gdef\dodoignore#1{%
+    % #1 contains the command name as a string, e.g., `ifinfo'.
+    %
+    % Define a command to find the next `@end #1'.
+    \long\def\doignoretext##1^^M@end #1{%
+      \doignoretextyyy##1^^M@#1\_STOP_}%
+    %
+    % And this command to find another #1 command, at the beginning of a
+    % line.  (Otherwise, we would consider a line `@c @ifset', for
+    % example, to count as an @ifset for nesting.)
+    \long\def\doignoretextyyy##1^^M@#1##2\_STOP_{\doignoreyyy{##2}\_STOP_}%
+    %
+    % And now expand that command.
+    \doignoretext ^^M%
+  }%
+}
+
+\def\doignoreyyy#1{%
+  \def\temp{#1}%
+  \ifx\temp\empty			% Nothing found.
+    \let\next\doignoretextzzz
+  \else					% Found a nested condition, ...
+    \advance\doignorecount by 1
+    \let\next\doignoretextyyy		% ..., look for another.
+    % If we're here, #1 ends with ^^M\ifinfo (for example).
+  \fi
+  \next #1% the token \_STOP_ is present just after this macro.
+}
+
+% We have to swallow the remaining "\_STOP_".
+%
+\def\doignoretextzzz#1{%
+  \ifnum\doignorecount = 0	% We have just found the outermost @end.
+    \let\next\enddoignore
+  \else				% Still inside a nested condition.
+    \advance\doignorecount by -1
+    \let\next\doignoretext      % Look for the next @end.
+  \fi
+  \next
+}
+
+% Finish off ignored text.
+{ \obeylines%
+  % Ignore anything after the last `@end #1'; this matters in verbatim
+  % environments, where otherwise the newline after an ignored conditional
+  % would result in a blank line in the output.
+  \gdef\enddoignore#1^^M{\endgroup\ignorespaces}%
+}
+
+
+% @set VAR sets the variable VAR to an empty value.
+% @set VAR REST-OF-LINE sets VAR to the value REST-OF-LINE.
+%
+% Since we want to separate VAR from REST-OF-LINE (which might be
+% empty), we can't just use \parsearg; we have to insert a space of our
+% own to delimit the rest of the line, and then take it out again if we
+% didn't need it.
+% We rely on the fact that \parsearg sets \catcode`\ =10.
+%
+\parseargdef\set{\setyyy#1 \endsetyyy}
+\def\setyyy#1 #2\endsetyyy{%
+  {%
+    \makevalueexpandable
+    \def\temp{#2}%
+    \edef\next{\gdef\makecsname{SET#1}}%
+    \ifx\temp\empty
+      \next{}%
+    \else
+      \setzzz#2\endsetzzz
+    \fi
+  }%
+}
+% Remove the trailing space \setxxx inserted.
+\def\setzzz#1 \endsetzzz{\next{#1}}
+
+% @clear VAR clears (i.e., unsets) the variable VAR.
+%
+\parseargdef\clear{%
+  {%
+    \makevalueexpandable
+    \global\expandafter\let\csname SET#1\endcsname=\relax
+  }%
+}
+
+% @value{foo} gets the text saved in variable foo.
+\def\value{\begingroup\makevalueexpandable\valuexxx}
+\def\valuexxx#1{\expandablevalue{#1}\endgroup}
+{
+  \catcode`\- = \active \catcode`\_ = \active
+  %
+  \gdef\makevalueexpandable{%
+    \let\value = \expandablevalue
+    % We don't want these characters active, ...
+    \catcode`\-=\other \catcode`\_=\other
+    % ..., but we might end up with active ones in the argument if
+    % we're called from @code, as @code{@value{foo-bar_}}, though.
+    % So \let them to their normal equivalents.
+    \let-\realdash \let_\normalunderscore
+  }
+}
+
+% We have this subroutine so that we can handle at least some @value's
+% properly in indexes (we call \makevalueexpandable in \indexdummies).
+% The command has to be fully expandable (if the variable is set), since
+% the result winds up in the index file.  This means that if the
+% variable's value contains other Texinfo commands, it's almost certain
+% it will fail (although perhaps we could fix that with sufficient work
+% to do a one-level expansion on the result, instead of complete).
+%
+\def\expandablevalue#1{%
+  \expandafter\ifx\csname SET#1\endcsname\relax
+    {[No value for ``#1'']}%
+    \message{Variable `#1', used in @value, is not set.}%
+  \else
+    \csname SET#1\endcsname
+  \fi
+}
+
+% @ifset VAR ... @end ifset reads the `...' iff VAR has been defined
+% with @set.
+%
+% To get special treatment of `@end ifset,' call \makeond and the redefine.
+%
+\makecond{ifset}
+\def\ifset{\parsearg{\doifset{\let\next=\ifsetfail}}}
+\def\doifset#1#2{%
+  {%
+    \makevalueexpandable
+    \let\next=\empty
+    \expandafter\ifx\csname SET#2\endcsname\relax
+      #1% If not set, redefine \next.
+    \fi
+    \expandafter
+  }\next
+}
+\def\ifsetfail{\doignore{ifset}}
+
+% @ifclear VAR ... @end ifclear reads the `...' iff VAR has never been
+% defined with @set, or has been undefined with @clear.
+%
+% The `\else' inside the `\doifset' parameter is a trick to reuse the
+% above code: if the variable is not set, do nothing, if it is set,
+% then redefine \next to \ifclearfail.
+%
+\makecond{ifclear}
+\def\ifclear{\parsearg{\doifset{\else \let\next=\ifclearfail}}}
+\def\ifclearfail{\doignore{ifclear}}
+
+% @dircategory CATEGORY  -- specify a category of the dir file
+% which this file should belong to.  Ignore this in TeX.
+\let\dircategory=\comment
+
+% @defininfoenclose.
+\let\definfoenclose=\comment
+
+
+\message{indexing,}
+% Index generation facilities
+
+% Define \newwrite to be identical to plain tex's \newwrite
+% except not \outer, so it can be used within macros and \if's.
+\edef\newwrite{\makecsname{ptexnewwrite}}
+
+% \newindex {foo} defines an index named foo.
+% It automatically defines \fooindex such that
+% \fooindex ...rest of line... puts an entry in the index foo.
+% It also defines \fooindfile to be the number of the output channel for
+% the file that accumulates this index.  The file's extension is foo.
+% The name of an index should be no more than 2 characters long
+% for the sake of vms.
+%
+\def\newindex#1{%
+  \iflinks
+    \expandafter\newwrite \csname#1indfile\endcsname
+    \openout \csname#1indfile\endcsname \jobname.#1 % Open the file
+  \fi
+  \expandafter\xdef\csname#1index\endcsname{%     % Define @#1index
+    \noexpand\doindex{#1}}
+}
+
+% @defindex foo  ==  \newindex{foo}
+%
+\def\defindex{\parsearg\newindex}
+
+% Define @defcodeindex, like @defindex except put all entries in @code.
+%
+\def\defcodeindex{\parsearg\newcodeindex}
+%
+\def\newcodeindex#1{%
+  \iflinks
+    \expandafter\newwrite \csname#1indfile\endcsname
+    \openout \csname#1indfile\endcsname \jobname.#1
+  \fi
+  \expandafter\xdef\csname#1index\endcsname{%
+    \noexpand\docodeindex{#1}}%
+}
+
+
+% @synindex foo bar    makes index foo feed into index bar.
+% Do this instead of @defindex foo if you don't want it as a separate index.
+%
+% @syncodeindex foo bar   similar, but put all entries made for index foo
+% inside @code.
+%
+\def\synindex#1 #2 {\dosynindex\doindex{#1}{#2}}
+\def\syncodeindex#1 #2 {\dosynindex\docodeindex{#1}{#2}}
+
+% #1 is \doindex or \docodeindex, #2 the index getting redefined (foo),
+% #3 the target index (bar).
+\def\dosynindex#1#2#3{%
+  % Only do \closeout if we haven't already done it, else we'll end up
+  % closing the target index.
+  \expandafter \ifx\csname donesynindex#2\endcsname \undefined
+    % The \closeout helps reduce unnecessary open files; the limit on the
+    % Acorn RISC OS is a mere 16 files.
+    \expandafter\closeout\csname#2indfile\endcsname
+    \expandafter\let\csname\donesynindex#2\endcsname = 1
+  \fi
+  % redefine \fooindfile:
+  \expandafter\let\expandafter\temp\expandafter=\csname#3indfile\endcsname
+  \expandafter\let\csname#2indfile\endcsname=\temp
+  % redefine \fooindex:
+  \expandafter\xdef\csname#2index\endcsname{\noexpand#1{#3}}%
+}
+
+% Define \doindex, the driver for all \fooindex macros.
+% Argument #1 is generated by the calling \fooindex macro,
+%  and it is "foo", the name of the index.
+
+% \doindex just uses \parsearg; it calls \doind for the actual work.
+% This is because \doind is more useful to call from other macros.
+
+% There is also \dosubind {index}{topic}{subtopic}
+% which makes an entry in a two-level index such as the operation index.
+
+\def\doindex#1{\edef\indexname{#1}\parsearg\singleindexer}
+\def\singleindexer #1{\doind{\indexname}{#1}}
+
+% like the previous two, but they put @code around the argument.
+\def\docodeindex#1{\edef\indexname{#1}\parsearg\singlecodeindexer}
+\def\singlecodeindexer #1{\doind{\indexname}{\code{#1}}}
+
+% Take care of Texinfo commands that can appear in an index entry.
+% Since there are some commands we want to expand, and others we don't,
+% we have to laboriously prevent expansion for those that we don't.
+%
+\def\indexdummies{%
+  \escapechar = `\\     % use backslash in output files.
+  \def\@{@}% change to @@ when we switch to @ as escape char in index files.
+  \def\ {\realbackslash\space }%
+  %
+  % Need these in case \tex is in effect and \{ is a \delimiter again.
+  % But can't use \lbracecmd and \rbracecmd because texindex assumes
+  % braces and backslashes are used only as delimiters.
+  \let\{ = \mylbrace
+  \let\} = \myrbrace
+  %
+  % I don't entirely understand this, but when an index entry is
+  % generated from a macro call, the \endinput which \scanmacro inserts
+  % causes processing to be prematurely terminated.  This is,
+  % apparently, because \indexsorttmp is fully expanded, and \endinput
+  % is an expandable command.  The redefinition below makes \endinput
+  % disappear altogether for that purpose -- although logging shows that
+  % processing continues to some further point.  On the other hand, it
+  % seems \endinput does not hurt in the printed index arg, since that
+  % is still getting written without apparent harm.
+  % 
+  % Sample source (mac-idx3.tex, reported by Graham Percival to
+  % help-texinfo, 22may06):
+  % @macro funindex {WORD}
+  % @findex xyz
+  % @end macro
+  % ...
+  % @funindex commtest
+  % 
+  % The above is not enough to reproduce the bug, but it gives the flavor.
+  % 
+  % Sample whatsit resulting:
+  % .@write3{\entry{xyz}{@folio }{@code {xyz@endinput }}}
+  % 
+  % So:
+  \let\endinput = \empty
+  %
+  % Do the redefinitions.
+  \commondummies
+}
+
+% For the aux and toc files, @ is the escape character.  So we want to
+% redefine everything using @ as the escape character (instead of
+% \realbackslash, still used for index files).  When everything uses @,
+% this will be simpler.
+%
+\def\atdummies{%
+  \def\@{@@}%
+  \def\ {@ }%
+  \let\{ = \lbraceatcmd
+  \let\} = \rbraceatcmd
+  %
+  % Do the redefinitions.
+  \commondummies
+  \otherbackslash
+}
+
+% Called from \indexdummies and \atdummies.
+%
+\def\commondummies{%
+  %
+  % \definedummyword defines \#1 as \string\#1\space, thus effectively
+  % preventing its expansion.  This is used only for control% words,
+  % not control letters, because the \space would be incorrect for
+  % control characters, but is needed to separate the control word
+  % from whatever follows.
+  %
+  % For control letters, we have \definedummyletter, which omits the
+  % space.
+  %
+  % These can be used both for control words that take an argument and
+  % those that do not.  If it is followed by {arg} in the input, then
+  % that will dutifully get written to the index (or wherever).
+  %
+  \def\definedummyword  ##1{\def##1{\string##1\space}}%
+  \def\definedummyletter##1{\def##1{\string##1}}%
+  \let\definedummyaccent\definedummyletter
+  %
+  \commondummiesnofonts
+  %
+  \definedummyletter\_%
+  %
+  % Non-English letters.
+  \definedummyword\AA
+  \definedummyword\AE
+  \definedummyword\L
+  \definedummyword\OE
+  \definedummyword\O
+  \definedummyword\aa
+  \definedummyword\ae
+  \definedummyword\l
+  \definedummyword\oe
+  \definedummyword\o
+  \definedummyword\ss
+  \definedummyword\exclamdown
+  \definedummyword\questiondown
+  \definedummyword\ordf
+  \definedummyword\ordm
+  %
+  % Although these internal commands shouldn't show up, sometimes they do.
+  \definedummyword\bf
+  \definedummyword\gtr
+  \definedummyword\hat
+  \definedummyword\less
+  \definedummyword\sf
+  \definedummyword\sl
+  \definedummyword\tclose
+  \definedummyword\tt
+  %
+  \definedummyword\LaTeX
+  \definedummyword\TeX
+  %
+  % Assorted special characters.
+  \definedummyword\bullet
+  \definedummyword\comma
+  \definedummyword\copyright
+  \definedummyword\registeredsymbol
+  \definedummyword\dots
+  \definedummyword\enddots
+  \definedummyword\equiv
+  \definedummyword\error
+  \definedummyword\euro
+  \definedummyword\guillemetleft
+  \definedummyword\guillemetright
+  \definedummyword\guilsinglleft
+  \definedummyword\guilsinglright
+  \definedummyword\expansion
+  \definedummyword\minus
+  \definedummyword\pounds
+  \definedummyword\point
+  \definedummyword\print
+  \definedummyword\quotedblbase
+  \definedummyword\quotedblleft
+  \definedummyword\quotedblright
+  \definedummyword\quoteleft
+  \definedummyword\quoteright
+  \definedummyword\quotesinglbase
+  \definedummyword\result
+  \definedummyword\textdegree
+  %
+  % We want to disable all macros so that they are not expanded by \write.
+  \macrolist
+  %
+  \normalturnoffactive
+  %
+  % Handle some cases of @value -- where it does not contain any
+  % (non-fully-expandable) commands.
+  \makevalueexpandable
+}
+
+% \commondummiesnofonts: common to \commondummies and \indexnofonts.
+%
+\def\commondummiesnofonts{%
+  % Control letters and accents.
+  \definedummyletter\!%
+  \definedummyaccent\"%
+  \definedummyaccent\'%
+  \definedummyletter\*%
+  \definedummyaccent\,%
+  \definedummyletter\.%
+  \definedummyletter\/%
+  \definedummyletter\:%
+  \definedummyaccent\=%
+  \definedummyletter\?%
+  \definedummyaccent\^%
+  \definedummyaccent\`%
+  \definedummyaccent\~%
+  \definedummyword\u
+  \definedummyword\v
+  \definedummyword\H
+  \definedummyword\dotaccent
+  \definedummyword\ringaccent
+  \definedummyword\tieaccent
+  \definedummyword\ubaraccent
+  \definedummyword\udotaccent
+  \definedummyword\dotless
+  %
+  % Texinfo font commands.
+  \definedummyword\b
+  \definedummyword\i
+  \definedummyword\r
+  \definedummyword\sc
+  \definedummyword\t
+  %
+  % Commands that take arguments.
+  \definedummyword\acronym
+  \definedummyword\cite
+  \definedummyword\code
+  \definedummyword\command
+  \definedummyword\dfn
+  \definedummyword\emph
+  \definedummyword\env
+  \definedummyword\file
+  \definedummyword\kbd
+  \definedummyword\key
+  \definedummyword\math
+  \definedummyword\option
+  \definedummyword\pxref
+  \definedummyword\ref
+  \definedummyword\samp
+  \definedummyword\strong
+  \definedummyword\tie
+  \definedummyword\uref
+  \definedummyword\url
+  \definedummyword\var
+  \definedummyword\verb
+  \definedummyword\w
+  \definedummyword\xref
+}
+
+% \indexnofonts is used when outputting the strings to sort the index
+% by, and when constructing control sequence names.  It eliminates all
+% control sequences and just writes whatever the best ASCII sort string
+% would be for a given command (usually its argument).
+%
+\def\indexnofonts{%
+  % Accent commands should become @asis.
+  \def\definedummyaccent##1{\let##1\asis}%
+  % We can just ignore other control letters.
+  \def\definedummyletter##1{\let##1\empty}%
+  % Hopefully, all control words can become @asis.
+  \let\definedummyword\definedummyaccent
+  %
+  \commondummiesnofonts
+  %
+  % Don't no-op \tt, since it isn't a user-level command
+  % and is used in the definitions of the active chars like <, >, |, etc.
+  % Likewise with the other plain tex font commands.
+  %\let\tt=\asis
+  %
+  \def\ { }%
+  \def\@{@}%
+  % how to handle braces?
+  \def\_{\normalunderscore}%
+  %
+  % Non-English letters.
+  \def\AA{AA}%
+  \def\AE{AE}%
+  \def\L{L}%
+  \def\OE{OE}%
+  \def\O{O}%
+  \def\aa{aa}%
+  \def\ae{ae}%
+  \def\l{l}%
+  \def\oe{oe}%
+  \def\o{o}%
+  \def\ss{ss}%
+  \def\exclamdown{!}%
+  \def\questiondown{?}%
+  \def\ordf{a}%
+  \def\ordm{o}%
+  %
+  \def\LaTeX{LaTeX}%
+  \def\TeX{TeX}%
+  %
+  % Assorted special characters.
+  % (The following {} will end up in the sort string, but that's ok.)
+  \def\bullet{bullet}%
+  \def\comma{,}%
+  \def\copyright{copyright}%
+  \def\registeredsymbol{R}%
+  \def\dots{...}%
+  \def\enddots{...}%
+  \def\equiv{==}%
+  \def\error{error}%
+  \def\euro{euro}%
+  \def\guillemetleft{<<}%
+  \def\guillemetright{>>}%
+  \def\guilsinglleft{<}%
+  \def\guilsinglright{>}%
+  \def\expansion{==>}%
+  \def\minus{-}%
+  \def\pounds{pounds}%
+  \def\point{.}%
+  \def\print{-|}%
+  \def\quotedblbase{"}%
+  \def\quotedblleft{"}%
+  \def\quotedblright{"}%
+  \def\quoteleft{`}%
+  \def\quoteright{'}%
+  \def\quotesinglbase{,}%
+  \def\result{=>}%
+  \def\textdegree{degrees}%
+  %
+  % We need to get rid of all macros, leaving only the arguments (if present).
+  % Of course this is not nearly correct, but it is the best we can do for now.
+  % makeinfo does not expand macros in the argument to @deffn, which ends up
+  % writing an index entry, and texindex isn't prepared for an index sort entry
+  % that starts with \.
+  % 
+  % Since macro invocations are followed by braces, we can just redefine them
+  % to take a single TeX argument.  The case of a macro invocation that
+  % goes to end-of-line is not handled.
+  % 
+  \macrolist
+}
+
+\let\indexbackslash=0  %overridden during \printindex.
+\let\SETmarginindex=\relax % put index entries in margin (undocumented)?
+
+% Most index entries go through here, but \dosubind is the general case.
+% #1 is the index name, #2 is the entry text.
+\def\doind#1#2{\dosubind{#1}{#2}{}}
+
+% Workhorse for all \fooindexes.
+% #1 is name of index, #2 is stuff to put there, #3 is subentry --
+% empty if called from \doind, as we usually are (the main exception
+% is with most defuns, which call us directly).
+%
+\def\dosubind#1#2#3{%
+  \iflinks
+  {%
+    % Store the main index entry text (including the third arg).
+    \toks0 = {#2}%
+    % If third arg is present, precede it with a space.
+    \def\thirdarg{#3}%
+    \ifx\thirdarg\empty \else
+      \toks0 = \expandafter{\the\toks0 \space #3}%
+    \fi
+    %
+    \edef\writeto{\csname#1indfile\endcsname}%
+    %
+    \safewhatsit\dosubindwrite
+  }%
+  \fi
+}
+
+% Write the entry in \toks0 to the index file:
+%
+\def\dosubindwrite{%
+  % Put the index entry in the margin if desired.
+  \ifx\SETmarginindex\relax\else
+    \insert\margin{\hbox{\vrule height8pt depth3pt width0pt \the\toks0}}%
+  \fi
+  %
+  % Remember, we are within a group.
+  \indexdummies % Must do this here, since \bf, etc expand at this stage
+  \def\backslashcurfont{\indexbackslash}% \indexbackslash isn't defined now
+      % so it will be output as is; and it will print as backslash.
+  %
+  % Process the index entry with all font commands turned off, to
+  % get the string to sort by.
+  {\indexnofonts
+   \edef\temp{\the\toks0}% need full expansion
+   \xdef\indexsorttmp{\temp}%
+  }%
+  %
+  % Set up the complete index entry, with both the sort key and
+  % the original text, including any font commands.  We write
+  % three arguments to \entry to the .?? file (four in the
+  % subentry case), texindex reduces to two when writing the .??s
+  % sorted result.
+  \edef\temp{%
+    \write\writeto{%
+      \string\entry{\indexsorttmp}{\noexpand\folio}{\the\toks0}}%
+  }%
+  \temp
+}
+
+% Take care of unwanted page breaks/skips around a whatsit:
+%
+% If a skip is the last thing on the list now, preserve it
+% by backing up by \lastskip, doing the \write, then inserting
+% the skip again.  Otherwise, the whatsit generated by the
+% \write or \pdfdest will make \lastskip zero.  The result is that
+% sequences like this:
+% @end defun
+% @tindex whatever
+% @defun ...
+% will have extra space inserted, because the \medbreak in the
+% start of the @defun won't see the skip inserted by the @end of
+% the previous defun.
+%
+% But don't do any of this if we're not in vertical mode.  We
+% don't want to do a \vskip and prematurely end a paragraph.
+%
+% Avoid page breaks due to these extra skips, too.
+%
+% But wait, there is a catch there:
+% We'll have to check whether \lastskip is zero skip.  \ifdim is not
+% sufficient for this purpose, as it ignores stretch and shrink parts
+% of the skip.  The only way seems to be to check the textual
+% representation of the skip.
+%
+% The following is almost like \def\zeroskipmacro{0.0pt} except that
+% the ``p'' and ``t'' characters have catcode \other, not 11 (letter).
+%
+\edef\zeroskipmacro{\expandafter\the\csname z@skip\endcsname}
+%
+\newskip\whatsitskip
+\newcount\whatsitpenalty
+%
+% ..., ready, GO:
+%
+\def\safewhatsit#1{%
+\ifhmode
+  #1%
+\else
+  % \lastskip and \lastpenalty cannot both be nonzero simultaneously.
+  \whatsitskip = \lastskip
+  \edef\lastskipmacro{\the\lastskip}%
+  \whatsitpenalty = \lastpenalty
+  %
+  % If \lastskip is nonzero, that means the last item was a
+  % skip.  And since a skip is discardable, that means this
+  % -\whatsitskip glue we're inserting is preceded by a
+  % non-discardable item, therefore it is not a potential
+  % breakpoint, therefore no \nobreak needed.
+  \ifx\lastskipmacro\zeroskipmacro
+  \else
+    \vskip-\whatsitskip
+  \fi
+  %
+  #1%
+  %
+  \ifx\lastskipmacro\zeroskipmacro
+    % If \lastskip was zero, perhaps the last item was a penalty, and
+    % perhaps it was >=10000, e.g., a \nobreak.  In that case, we want
+    % to re-insert the same penalty (values >10000 are used for various
+    % signals); since we just inserted a non-discardable item, any
+    % following glue (such as a \parskip) would be a breakpoint.  For example:
+    % 
+    %   @deffn deffn-whatever
+    %   @vindex index-whatever
+    %   Description.
+    % would allow a break between the index-whatever whatsit
+    % and the "Description." paragraph.
+    \ifnum\whatsitpenalty>9999 \penalty\whatsitpenalty \fi
+  \else
+    % On the other hand, if we had a nonzero \lastskip,
+    % this make-up glue would be preceded by a non-discardable item
+    % (the whatsit from the \write), so we must insert a \nobreak.
+    \nobreak\vskip\whatsitskip
+  \fi
+\fi
+}
+
+% The index entry written in the file actually looks like
+%  \entry {sortstring}{page}{topic}
+% or
+%  \entry {sortstring}{page}{topic}{subtopic}
+% The texindex program reads in these files and writes files
+% containing these kinds of lines:
+%  \initial {c}
+%     before the first topic whose initial is c
+%  \entry {topic}{pagelist}
+%     for a topic that is used without subtopics
+%  \primary {topic}
+%     for the beginning of a topic that is used with subtopics
+%  \secondary {subtopic}{pagelist}
+%     for each subtopic.
+
+% Define the user-accessible indexing commands
+% @findex, @vindex, @kindex, @cindex.
+
+\def\findex {\fnindex}
+\def\kindex {\kyindex}
+\def\cindex {\cpindex}
+\def\vindex {\vrindex}
+\def\tindex {\tpindex}
+\def\pindex {\pgindex}
+
+\def\cindexsub {\begingroup\obeylines\cindexsub}
+{\obeylines %
+\gdef\cindexsub "#1" #2^^M{\endgroup %
+\dosubind{cp}{#2}{#1}}}
+
+% Define the macros used in formatting output of the sorted index material.
+
+% @printindex causes a particular index (the ??s file) to get printed.
+% It does not print any chapter heading (usually an @unnumbered).
+%
+\parseargdef\printindex{\begingroup
+  \dobreak \chapheadingskip{10000}%
+  %
+  \smallfonts \rm
+  \tolerance = 9500
+  \plainfrenchspacing
+  \everypar = {}% don't want the \kern\-parindent from indentation suppression.
+  %
+  % See if the index file exists and is nonempty.
+  % Change catcode of @ here so that if the index file contains
+  % \initial {@}
+  % as its first line, TeX doesn't complain about mismatched braces
+  % (because it thinks @} is a control sequence).
+  \catcode`\@ = 11
+  \openin 1 \jobname.#1s
+  \ifeof 1
+    % \enddoublecolumns gets confused if there is no text in the index,
+    % and it loses the chapter title and the aux file entries for the
+    % index.  The easiest way to prevent this problem is to make sure
+    % there is some text.
+    \putwordIndexNonexistent
+  \else
+    %
+    % If the index file exists but is empty, then \openin leaves \ifeof
+    % false.  We have to make TeX try to read something from the file, so
+    % it can discover if there is anything in it.
+    \read 1 to \temp
+    \ifeof 1
+      \putwordIndexIsEmpty
+    \else
+      % Index files are almost Texinfo source, but we use \ as the escape
+      % character.  It would be better to use @, but that's too big a change
+      % to make right now.
+      \def\indexbackslash{\backslashcurfont}%
+      \catcode`\\ = 0
+      \escapechar = `\\
+      \begindoublecolumns
+      \input \jobname.#1s
+      \enddoublecolumns
+    \fi
+  \fi
+  \closein 1
+\endgroup}
+
+% These macros are used by the sorted index file itself.
+% Change them to control the appearance of the index.
+
+\def\initial#1{{%
+  % Some minor font changes for the special characters.
+  \let\tentt=\sectt \let\tt=\sectt \let\sf=\sectt
+  %
+  % Remove any glue we may have, we'll be inserting our own.
+  \removelastskip
+  %
+  % We like breaks before the index initials, so insert a bonus.
+  \nobreak
+  \vskip 0pt plus 3\baselineskip
+  \penalty 0
+  \vskip 0pt plus -3\baselineskip
+  %
+  % Typeset the initial.  Making this add up to a whole number of
+  % baselineskips increases the chance of the dots lining up from column
+  % to column.  It still won't often be perfect, because of the stretch
+  % we need before each entry, but it's better.
+  %
+  % No shrink because it confuses \balancecolumns.
+  \vskip 1.67\baselineskip plus .5\baselineskip
+  \leftline{\secbf #1}%
+  % Do our best not to break after the initial.
+  \nobreak
+  \vskip .33\baselineskip plus .1\baselineskip
+}}
+
+% \entry typesets a paragraph consisting of the text (#1), dot leaders, and
+% then page number (#2) flushed to the right margin.  It is used for index
+% and table of contents entries.  The paragraph is indented by \leftskip.
+%
+% A straightforward implementation would start like this:
+%	\def\entry#1#2{...
+% But this frozes the catcodes in the argument, and can cause problems to
+% @code, which sets - active.  This problem was fixed by a kludge---
+% ``-'' was active throughout whole index, but this isn't really right.
+%
+% The right solution is to prevent \entry from swallowing the whole text.
+%                                 --kasal, 21nov03
+\def\entry{%
+  \begingroup
+    %
+    % Start a new paragraph if necessary, so our assignments below can't
+    % affect previous text.
+    \par
+    %
+    % Do not fill out the last line with white space.
+    \parfillskip = 0in
+    %
+    % No extra space above this paragraph.
+    \parskip = 0in
+    %
+    % Do not prefer a separate line ending with a hyphen to fewer lines.
+    \finalhyphendemerits = 0
+    %
+    % \hangindent is only relevant when the entry text and page number
+    % don't both fit on one line.  In that case, bob suggests starting the
+    % dots pretty far over on the line.  Unfortunately, a large
+    % indentation looks wrong when the entry text itself is broken across
+    % lines.  So we use a small indentation and put up with long leaders.
+    %
+    % \hangafter is reset to 1 (which is the value we want) at the start
+    % of each paragraph, so we need not do anything with that.
+    \hangindent = 2em
+    %
+    % When the entry text needs to be broken, just fill out the first line
+    % with blank space.
+    \rightskip = 0pt plus1fil
+    %
+    % A bit of stretch before each entry for the benefit of balancing
+    % columns.
+    \vskip 0pt plus1pt
+    %
+    % Swallow the left brace of the text (first parameter):
+    \afterassignment\doentry
+    \let\temp =
+}
+\def\doentry{%
+    \bgroup % Instead of the swallowed brace.
+      \noindent
+      \aftergroup\finishentry
+      % And now comes the text of the entry.
+}
+\def\finishentry#1{%
+    % #1 is the page number.
+    %
+    % The following is kludged to not output a line of dots in the index if
+    % there are no page numbers.  The next person who breaks this will be
+    % cursed by a Unix daemon.
+    \setbox\boxA = \hbox{#1}%
+    \ifdim\wd\boxA = 0pt
+      \ %
+    \else
+      %
+      % If we must, put the page number on a line of its own, and fill out
+      % this line with blank space.  (The \hfil is overwhelmed with the
+      % fill leaders glue in \indexdotfill if the page number does fit.)
+      \hfil\penalty50
+      \null\nobreak\indexdotfill % Have leaders before the page number.
+      %
+      % The `\ ' here is removed by the implicit \unskip that TeX does as
+      % part of (the primitive) \par.  Without it, a spurious underfull
+      % \hbox ensues.
+      \ifpdf
+	\pdfgettoks#1.%
+	\ \the\toksA
+      \else
+	\ #1%
+      \fi
+    \fi
+    \par
+  \endgroup
+}
+
+% Like plain.tex's \dotfill, except uses up at least 1 em.
+\def\indexdotfill{\cleaders
+  \hbox{$\mathsurround=0pt \mkern1.5mu.\mkern1.5mu$}\hskip 1em plus 1fill}
+
+\def\primary #1{\line{#1\hfil}}
+
+\newskip\secondaryindent \secondaryindent=0.5cm
+\def\secondary#1#2{{%
+  \parfillskip=0in
+  \parskip=0in
+  \hangindent=1in
+  \hangafter=1
+  \noindent\hskip\secondaryindent\hbox{#1}\indexdotfill
+  \ifpdf
+    \pdfgettoks#2.\ \the\toksA % The page number ends the paragraph.
+  \else
+    #2
+  \fi
+  \par
+}}
+
+% Define two-column mode, which we use to typeset indexes.
+% Adapted from the TeXbook, page 416, which is to say,
+% the manmac.tex format used to print the TeXbook itself.
+\catcode`\@=11
+
+\newbox\partialpage
+\newdimen\doublecolumnhsize
+
+\def\begindoublecolumns{\begingroup % ended by \enddoublecolumns
+  % Grab any single-column material above us.
+  \output = {%
+    %
+    % Here is a possibility not foreseen in manmac: if we accumulate a
+    % whole lot of material, we might end up calling this \output
+    % routine twice in a row (see the doublecol-lose test, which is
+    % essentially a couple of indexes with @setchapternewpage off).  In
+    % that case we just ship out what is in \partialpage with the normal
+    % output routine.  Generally, \partialpage will be empty when this
+    % runs and this will be a no-op.  See the indexspread.tex test case.
+    \ifvoid\partialpage \else
+      \onepageout{\pagecontents\partialpage}%
+    \fi
+    %
+    \global\setbox\partialpage = \vbox{%
+      % Unvbox the main output page.
+      \unvbox\PAGE
+      \kern-\topskip \kern\baselineskip
+    }%
+  }%
+  \eject % run that output routine to set \partialpage
+  %
+  % Use the double-column output routine for subsequent pages.
+  \output = {\doublecolumnout}%
+  %
+  % Change the page size parameters.  We could do this once outside this
+  % routine, in each of @smallbook, @afourpaper, and the default 8.5x11
+  % format, but then we repeat the same computation.  Repeating a couple
+  % of assignments once per index is clearly meaningless for the
+  % execution time, so we may as well do it in one place.
+  %
+  % First we halve the line length, less a little for the gutter between
+  % the columns.  We compute the gutter based on the line length, so it
+  % changes automatically with the paper format.  The magic constant
+  % below is chosen so that the gutter has the same value (well, +-<1pt)
+  % as it did when we hard-coded it.
+  %
+  % We put the result in a separate register, \doublecolumhsize, so we
+  % can restore it in \pagesofar, after \hsize itself has (potentially)
+  % been clobbered.
+  %
+  \doublecolumnhsize = \hsize
+    \advance\doublecolumnhsize by -.04154\hsize
+    \divide\doublecolumnhsize by 2
+  \hsize = \doublecolumnhsize
+  %
+  % Double the \vsize as well.  (We don't need a separate register here,
+  % since nobody clobbers \vsize.)
+  \vsize = 2\vsize
+}
+
+% The double-column output routine for all double-column pages except
+% the last.
+%
+\def\doublecolumnout{%
+  \splittopskip=\topskip \splitmaxdepth=\maxdepth
+  % Get the available space for the double columns -- the normal
+  % (undoubled) page height minus any material left over from the
+  % previous page.
+  \dimen@ = \vsize
+  \divide\dimen@ by 2
+  \advance\dimen@ by -\ht\partialpage
+  %
+  % box0 will be the left-hand column, box2 the right.
+  \setbox0=\vsplit255 to\dimen@ \setbox2=\vsplit255 to\dimen@
+  \onepageout\pagesofar
+  \unvbox255
+  \penalty\outputpenalty
+}
+%
+% Re-output the contents of the output page -- any previous material,
+% followed by the two boxes we just split, in box0 and box2.
+\def\pagesofar{%
+  \unvbox\partialpage
+  %
+  \hsize = \doublecolumnhsize
+  \wd0=\hsize \wd2=\hsize
+  \hbox to\pagewidth{\box0\hfil\box2}%
+}
+%
+% All done with double columns.
+\def\enddoublecolumns{%
+  % The following penalty ensures that the page builder is exercised
+  % _before_ we change the output routine.  This is necessary in the
+  % following situation:
+  %
+  % The last section of the index consists only of a single entry.
+  % Before this section, \pagetotal is less than \pagegoal, so no
+  % break occurs before the last section starts.  However, the last
+  % section, consisting of \initial and the single \entry, does not
+  % fit on the page and has to be broken off.  Without the following
+  % penalty the page builder will not be exercised until \eject
+  % below, and by that time we'll already have changed the output
+  % routine to the \balancecolumns version, so the next-to-last
+  % double-column page will be processed with \balancecolumns, which
+  % is wrong:  The two columns will go to the main vertical list, with
+  % the broken-off section in the recent contributions.  As soon as
+  % the output routine finishes, TeX starts reconsidering the page
+  % break.  The two columns and the broken-off section both fit on the
+  % page, because the two columns now take up only half of the page
+  % goal.  When TeX sees \eject from below which follows the final
+  % section, it invokes the new output routine that we've set after
+  % \balancecolumns below; \onepageout will try to fit the two columns
+  % and the final section into the vbox of \pageheight (see
+  % \pagebody), causing an overfull box.
+  %
+  % Note that glue won't work here, because glue does not exercise the
+  % page builder, unlike penalties (see The TeXbook, pp. 280-281).
+  \penalty0
+  %
+  \output = {%
+    % Split the last of the double-column material.  Leave it on the
+    % current page, no automatic page break.
+    \balancecolumns
+    %
+    % If we end up splitting too much material for the current page,
+    % though, there will be another page break right after this \output
+    % invocation ends.  Having called \balancecolumns once, we do not
+    % want to call it again.  Therefore, reset \output to its normal
+    % definition right away.  (We hope \balancecolumns will never be
+    % called on to balance too much material, but if it is, this makes
+    % the output somewhat more palatable.)
+    \global\output = {\onepageout{\pagecontents\PAGE}}%
+  }%
+  \eject
+  \endgroup % started in \begindoublecolumns
+  %
+  % \pagegoal was set to the doubled \vsize above, since we restarted
+  % the current page.  We're now back to normal single-column
+  % typesetting, so reset \pagegoal to the normal \vsize (after the
+  % \endgroup where \vsize got restored).
+  \pagegoal = \vsize
+}
+%
+% Called at the end of the double column material.
+\def\balancecolumns{%
+  \setbox0 = \vbox{\unvbox255}% like \box255 but more efficient, see p.120.
+  \dimen@ = \ht0
+  \advance\dimen@ by \topskip
+  \advance\dimen@ by-\baselineskip
+  \divide\dimen@ by 2 % target to split to
+  %debug\message{final 2-column material height=\the\ht0, target=\the\dimen@.}%
+  \splittopskip = \topskip
+  % Loop until we get a decent breakpoint.
+  {%
+    \vbadness = 10000
+    \loop
+      \global\setbox3 = \copy0
+      \global\setbox1 = \vsplit3 to \dimen@
+    \ifdim\ht3>\dimen@
+      \global\advance\dimen@ by 1pt
+    \repeat
+  }%
+  %debug\message{split to \the\dimen@, column heights: \the\ht1, \the\ht3.}%
+  \setbox0=\vbox to\dimen@{\unvbox1}%
+  \setbox2=\vbox to\dimen@{\unvbox3}%
+  %
+  \pagesofar
+}
+\catcode`\@ = \other
+
+
+\message{sectioning,}
+% Chapters, sections, etc.
+
+% \unnumberedno is an oxymoron, of course.  But we count the unnumbered
+% sections so that we can refer to them unambiguously in the pdf
+% outlines by their "section number".  We avoid collisions with chapter
+% numbers by starting them at 10000.  (If a document ever has 10000
+% chapters, we're in trouble anyway, I'm sure.)
+\newcount\unnumberedno \unnumberedno = 10000
+\newcount\chapno
+\newcount\secno        \secno=0
+\newcount\subsecno     \subsecno=0
+\newcount\subsubsecno  \subsubsecno=0
+
+% This counter is funny since it counts through charcodes of letters A, B, ...
+\newcount\appendixno  \appendixno = `\@
+%
+% \def\appendixletter{\char\the\appendixno}
+% We do the following ugly conditional instead of the above simple
+% construct for the sake of pdftex, which needs the actual
+% letter in the expansion, not just typeset.
+%
+\def\appendixletter{%
+  \ifnum\appendixno=`A A%
+  \else\ifnum\appendixno=`B B%
+  \else\ifnum\appendixno=`C C%
+  \else\ifnum\appendixno=`D D%
+  \else\ifnum\appendixno=`E E%
+  \else\ifnum\appendixno=`F F%
+  \else\ifnum\appendixno=`G G%
+  \else\ifnum\appendixno=`H H%
+  \else\ifnum\appendixno=`I I%
+  \else\ifnum\appendixno=`J J%
+  \else\ifnum\appendixno=`K K%
+  \else\ifnum\appendixno=`L L%
+  \else\ifnum\appendixno=`M M%
+  \else\ifnum\appendixno=`N N%
+  \else\ifnum\appendixno=`O O%
+  \else\ifnum\appendixno=`P P%
+  \else\ifnum\appendixno=`Q Q%
+  \else\ifnum\appendixno=`R R%
+  \else\ifnum\appendixno=`S S%
+  \else\ifnum\appendixno=`T T%
+  \else\ifnum\appendixno=`U U%
+  \else\ifnum\appendixno=`V V%
+  \else\ifnum\appendixno=`W W%
+  \else\ifnum\appendixno=`X X%
+  \else\ifnum\appendixno=`Y Y%
+  \else\ifnum\appendixno=`Z Z%
+  % The \the is necessary, despite appearances, because \appendixletter is
+  % expanded while writing the .toc file.  \char\appendixno is not
+  % expandable, thus it is written literally, thus all appendixes come out
+  % with the same letter (or @) in the toc without it.
+  \else\char\the\appendixno
+  \fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi
+  \fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi}
+
+% Each @chapter defines these (using marks) as the number+name, number
+% and name of the chapter.  Page headings and footings can use
+% these.  @section does likewise.
+\def\thischapter{}
+\def\thischapternum{}
+\def\thischaptername{}
+\def\thissection{}
+\def\thissectionnum{}
+\def\thissectionname{}
+
+\newcount\absseclevel % used to calculate proper heading level
+\newcount\secbase\secbase=0 % @raisesections/@lowersections modify this count
+
+% @raisesections: treat @section as chapter, @subsection as section, etc.
+\def\raisesections{\global\advance\secbase by -1}
+\let\up=\raisesections % original BFox name
+
+% @lowersections: treat @chapter as section, @section as subsection, etc.
+\def\lowersections{\global\advance\secbase by 1}
+\let\down=\lowersections % original BFox name
+
+% we only have subsub.
+\chardef\maxseclevel = 3
+%
+% A numbered section within an unnumbered changes to unnumbered too.
+% To achive this, remember the "biggest" unnum. sec. we are currently in:
+\chardef\unmlevel = \maxseclevel
+%
+% Trace whether the current chapter is an appendix or not:
+% \chapheadtype is "N" or "A", unnumbered chapters are ignored.
+\def\chapheadtype{N}
+
+% Choose a heading macro
+% #1 is heading type
+% #2 is heading level
+% #3 is text for heading
+\def\genhead#1#2#3{%
+  % Compute the abs. sec. level:
+  \absseclevel=#2
+  \advance\absseclevel by \secbase
+  % Make sure \absseclevel doesn't fall outside the range:
+  \ifnum \absseclevel < 0
+    \absseclevel = 0
+  \else
+    \ifnum \absseclevel > 3
+      \absseclevel = 3
+    \fi
+  \fi
+  % The heading type:
+  \def\headtype{#1}%
+  \if \headtype U%
+    \ifnum \absseclevel < \unmlevel
+      \chardef\unmlevel = \absseclevel
+    \fi
+  \else
+    % Check for appendix sections:
+    \ifnum \absseclevel = 0
+      \edef\chapheadtype{\headtype}%
+    \else
+      \if \headtype A\if \chapheadtype N%
+	\errmessage{@appendix... within a non-appendix chapter}%
+      \fi\fi
+    \fi
+    % Check for numbered within unnumbered:
+    \ifnum \absseclevel > \unmlevel
+      \def\headtype{U}%
+    \else
+      \chardef\unmlevel = 3
+    \fi
+  \fi
+  % Now print the heading:
+  \if \headtype U%
+    \ifcase\absseclevel
+	\unnumberedzzz{#3}%
+    \or \unnumberedseczzz{#3}%
+    \or \unnumberedsubseczzz{#3}%
+    \or \unnumberedsubsubseczzz{#3}%
+    \fi
+  \else
+    \if \headtype A%
+      \ifcase\absseclevel
+	  \appendixzzz{#3}%
+      \or \appendixsectionzzz{#3}%
+      \or \appendixsubseczzz{#3}%
+      \or \appendixsubsubseczzz{#3}%
+      \fi
+    \else
+      \ifcase\absseclevel
+	  \chapterzzz{#3}%
+      \or \seczzz{#3}%
+      \or \numberedsubseczzz{#3}%
+      \or \numberedsubsubseczzz{#3}%
+      \fi
+    \fi
+  \fi
+  \suppressfirstparagraphindent
+}
+
+% an interface:
+\def\numhead{\genhead N}
+\def\apphead{\genhead A}
+\def\unnmhead{\genhead U}
+
+% @chapter, @appendix, @unnumbered.  Increment top-level counter, reset
+% all lower-level sectioning counters to zero.
+%
+% Also set \chaplevelprefix, which we prepend to @float sequence numbers
+% (e.g., figures), q.v.  By default (before any chapter), that is empty.
+\let\chaplevelprefix = \empty
+%
+\outer\parseargdef\chapter{\numhead0{#1}} % normally numhead0 calls chapterzzz
+\def\chapterzzz#1{%
+  % section resetting is \global in case the chapter is in a group, such
+  % as an @include file.
+  \global\secno=0 \global\subsecno=0 \global\subsubsecno=0
+    \global\advance\chapno by 1
+  %
+  % Used for \float.
+  \gdef\chaplevelprefix{\the\chapno.}%
+  \resetallfloatnos
+  %
+  \message{\putwordChapter\space \the\chapno}%
+  %
+  % Write the actual heading.
+  \chapmacro{#1}{Ynumbered}{\the\chapno}%
+  %
+  % So @section and the like are numbered underneath this chapter.
+  \global\let\section = \numberedsec
+  \global\let\subsection = \numberedsubsec
+  \global\let\subsubsection = \numberedsubsubsec
+}
+
+\outer\parseargdef\appendix{\apphead0{#1}} % normally apphead0 calls appendixzzz
+\def\appendixzzz#1{%
+  \global\secno=0 \global\subsecno=0 \global\subsubsecno=0
+    \global\advance\appendixno by 1
+  \gdef\chaplevelprefix{\appendixletter.}%
+  \resetallfloatnos
+  %
+  \def\appendixnum{\putwordAppendix\space \appendixletter}%
+  \message{\appendixnum}%
+  %
+  \chapmacro{#1}{Yappendix}{\appendixletter}%
+  %
+  \global\let\section = \appendixsec
+  \global\let\subsection = \appendixsubsec
+  \global\let\subsubsection = \appendixsubsubsec
+}
+
+\outer\parseargdef\unnumbered{\unnmhead0{#1}} % normally unnmhead0 calls unnumberedzzz
+\def\unnumberedzzz#1{%
+  \global\secno=0 \global\subsecno=0 \global\subsubsecno=0
+    \global\advance\unnumberedno by 1
+  %
+  % Since an unnumbered has no number, no prefix for figures.
+  \global\let\chaplevelprefix = \empty
+  \resetallfloatnos
+  %
+  % This used to be simply \message{#1}, but TeX fully expands the
+  % argument to \message.  Therefore, if #1 contained @-commands, TeX
+  % expanded them.  For example, in `@unnumbered The @cite{Book}', TeX
+  % expanded @cite (which turns out to cause errors because \cite is meant
+  % to be executed, not expanded).
+  %
+  % Anyway, we don't want the fully-expanded definition of @cite to appear
+  % as a result of the \message, we just want `@cite' itself.  We use
+  % \the<toks register> to achieve this: TeX expands \the<toks> only once,
+  % simply yielding the contents of <toks register>.  (We also do this for
+  % the toc entries.)
+  \toks0 = {#1}%
+  \message{(\the\toks0)}%
+  %
+  \chapmacro{#1}{Ynothing}{\the\unnumberedno}%
+  %
+  \global\let\section = \unnumberedsec
+  \global\let\subsection = \unnumberedsubsec
+  \global\let\subsubsection = \unnumberedsubsubsec
+}
+
+% @centerchap is like @unnumbered, but the heading is centered.
+\outer\parseargdef\centerchap{%
+  % Well, we could do the following in a group, but that would break
+  % an assumption that \chapmacro is called at the outermost level.
+  % Thus we are safer this way:		--kasal, 24feb04
+  \let\centerparametersmaybe = \centerparameters
+  \unnmhead0{#1}%
+  \let\centerparametersmaybe = \relax
+}
+
+% @top is like @unnumbered.
+\let\top\unnumbered
+
+% Sections.
+\outer\parseargdef\numberedsec{\numhead1{#1}} % normally calls seczzz
+\def\seczzz#1{%
+  \global\subsecno=0 \global\subsubsecno=0  \global\advance\secno by 1
+  \sectionheading{#1}{sec}{Ynumbered}{\the\chapno.\the\secno}%
+}
+
+\outer\parseargdef\appendixsection{\apphead1{#1}} % normally calls appendixsectionzzz
+\def\appendixsectionzzz#1{%
+  \global\subsecno=0 \global\subsubsecno=0  \global\advance\secno by 1
+  \sectionheading{#1}{sec}{Yappendix}{\appendixletter.\the\secno}%
+}
+\let\appendixsec\appendixsection
+
+\outer\parseargdef\unnumberedsec{\unnmhead1{#1}} % normally calls unnumberedseczzz
+\def\unnumberedseczzz#1{%
+  \global\subsecno=0 \global\subsubsecno=0  \global\advance\secno by 1
+  \sectionheading{#1}{sec}{Ynothing}{\the\unnumberedno.\the\secno}%
+}
+
+% Subsections.
+\outer\parseargdef\numberedsubsec{\numhead2{#1}} % normally calls numberedsubseczzz
+\def\numberedsubseczzz#1{%
+  \global\subsubsecno=0  \global\advance\subsecno by 1
+  \sectionheading{#1}{subsec}{Ynumbered}{\the\chapno.\the\secno.\the\subsecno}%
+}
+
+\outer\parseargdef\appendixsubsec{\apphead2{#1}} % normally calls appendixsubseczzz
+\def\appendixsubseczzz#1{%
+  \global\subsubsecno=0  \global\advance\subsecno by 1
+  \sectionheading{#1}{subsec}{Yappendix}%
+                 {\appendixletter.\the\secno.\the\subsecno}%
+}
+
+\outer\parseargdef\unnumberedsubsec{\unnmhead2{#1}} %normally calls unnumberedsubseczzz
+\def\unnumberedsubseczzz#1{%
+  \global\subsubsecno=0  \global\advance\subsecno by 1
+  \sectionheading{#1}{subsec}{Ynothing}%
+                 {\the\unnumberedno.\the\secno.\the\subsecno}%
+}
+
+% Subsubsections.
+\outer\parseargdef\numberedsubsubsec{\numhead3{#1}} % normally numberedsubsubseczzz
+\def\numberedsubsubseczzz#1{%
+  \global\advance\subsubsecno by 1
+  \sectionheading{#1}{subsubsec}{Ynumbered}%
+                 {\the\chapno.\the\secno.\the\subsecno.\the\subsubsecno}%
+}
+
+\outer\parseargdef\appendixsubsubsec{\apphead3{#1}} % normally appendixsubsubseczzz
+\def\appendixsubsubseczzz#1{%
+  \global\advance\subsubsecno by 1
+  \sectionheading{#1}{subsubsec}{Yappendix}%
+                 {\appendixletter.\the\secno.\the\subsecno.\the\subsubsecno}%
+}
+
+\outer\parseargdef\unnumberedsubsubsec{\unnmhead3{#1}} %normally unnumberedsubsubseczzz
+\def\unnumberedsubsubseczzz#1{%
+  \global\advance\subsubsecno by 1
+  \sectionheading{#1}{subsubsec}{Ynothing}%
+                 {\the\unnumberedno.\the\secno.\the\subsecno.\the\subsubsecno}%
+}
+
+% These macros control what the section commands do, according
+% to what kind of chapter we are in (ordinary, appendix, or unnumbered).
+% Define them by default for a numbered chapter.
+\let\section = \numberedsec
+\let\subsection = \numberedsubsec
+\let\subsubsection = \numberedsubsubsec
+
+% Define @majorheading, @heading and @subheading
+
+% NOTE on use of \vbox for chapter headings, section headings, and such:
+%       1) We use \vbox rather than the earlier \line to permit
+%          overlong headings to fold.
+%       2) \hyphenpenalty is set to 10000 because hyphenation in a
+%          heading is obnoxious; this forbids it.
+%       3) Likewise, headings look best if no \parindent is used, and
+%          if justification is not attempted.  Hence \raggedright.
+
+
+\def\majorheading{%
+  {\advance\chapheadingskip by 10pt \chapbreak }%
+  \parsearg\chapheadingzzz
+}
+
+\def\chapheading{\chapbreak \parsearg\chapheadingzzz}
+\def\chapheadingzzz#1{%
+  {\chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000
+                    \parindent=0pt\raggedright
+                    \rm #1\hfill}}%
+  \bigskip \par\penalty 200\relax
+  \suppressfirstparagraphindent
+}
+
+% @heading, @subheading, @subsubheading.
+\parseargdef\heading{\sectionheading{#1}{sec}{Yomitfromtoc}{}
+  \suppressfirstparagraphindent}
+\parseargdef\subheading{\sectionheading{#1}{subsec}{Yomitfromtoc}{}
+  \suppressfirstparagraphindent}
+\parseargdef\subsubheading{\sectionheading{#1}{subsubsec}{Yomitfromtoc}{}
+  \suppressfirstparagraphindent}
+
+% These macros generate a chapter, section, etc. heading only
+% (including whitespace, linebreaking, etc. around it),
+% given all the information in convenient, parsed form.
+
+%%% Args are the skip and penalty (usually negative)
+\def\dobreak#1#2{\par\ifdim\lastskip<#1\removelastskip\penalty#2\vskip#1\fi}
+
+%%% Define plain chapter starts, and page on/off switching for it
+% Parameter controlling skip before chapter headings (if needed)
+
+\newskip\chapheadingskip
+
+\def\chapbreak{\dobreak \chapheadingskip {-4000}}
+\def\chappager{\par\vfill\supereject}
+% Because \domark is called before \chapoddpage, the filler page will
+% get the headings for the next chapter, which is wrong.  But we don't
+% care -- we just disable all headings on the filler page.
+\def\chapoddpage{%
+  \chappager
+  \ifodd\pageno \else
+    \begingroup
+      \evenheadline={\hfil}\evenfootline={\hfil}%
+      \oddheadline={\hfil}\oddfootline={\hfil}%
+      \hbox to 0pt{}%
+      \chappager
+    \endgroup
+  \fi
+}
+
+\def\setchapternewpage #1 {\csname CHAPPAG#1\endcsname}
+
+\def\CHAPPAGoff{%
+\global\let\contentsalignmacro = \chappager
+\global\let\pchapsepmacro=\chapbreak
+\global\let\pagealignmacro=\chappager}
+
+\def\CHAPPAGon{%
+\global\let\contentsalignmacro = \chappager
+\global\let\pchapsepmacro=\chappager
+\global\let\pagealignmacro=\chappager
+\global\def\HEADINGSon{\HEADINGSsingle}}
+
+\def\CHAPPAGodd{%
+\global\let\contentsalignmacro = \chapoddpage
+\global\let\pchapsepmacro=\chapoddpage
+\global\let\pagealignmacro=\chapoddpage
+\global\def\HEADINGSon{\HEADINGSdouble}}
+
+\CHAPPAGon
+
+% Chapter opening.
+%
+% #1 is the text, #2 is the section type (Ynumbered, Ynothing,
+% Yappendix, Yomitfromtoc), #3 the chapter number.
+%
+% To test against our argument.
+\def\Ynothingkeyword{Ynothing}
+\def\Yomitfromtockeyword{Yomitfromtoc}
+\def\Yappendixkeyword{Yappendix}
+%
+\def\chapmacro#1#2#3{%
+  % Insert the first mark before the heading break (see notes for \domark).
+  \let\prevchapterdefs=\lastchapterdefs
+  \let\prevsectiondefs=\lastsectiondefs
+  \gdef\lastsectiondefs{\gdef\thissectionname{}\gdef\thissectionnum{}%
+                        \gdef\thissection{}}%
+  %
+  \def\temptype{#2}%
+  \ifx\temptype\Ynothingkeyword
+    \gdef\lastchapterdefs{\gdef\thischaptername{#1}\gdef\thischapternum{}%
+                          \gdef\thischapter{\thischaptername}}%
+  \else\ifx\temptype\Yomitfromtockeyword
+    \gdef\lastchapterdefs{\gdef\thischaptername{#1}\gdef\thischapternum{}%
+                          \gdef\thischapter{}}%
+  \else\ifx\temptype\Yappendixkeyword
+    \toks0={#1}%
+    \xdef\lastchapterdefs{%
+      \gdef\noexpand\thischaptername{\the\toks0}%
+      \gdef\noexpand\thischapternum{\appendixletter}%
+      \gdef\noexpand\thischapter{\putwordAppendix{} \noexpand\thischapternum:
+                                 \noexpand\thischaptername}%
+    }%
+  \else
+    \toks0={#1}%
+    \xdef\lastchapterdefs{%
+      \gdef\noexpand\thischaptername{\the\toks0}%
+      \gdef\noexpand\thischapternum{\the\chapno}%
+      \gdef\noexpand\thischapter{\putwordChapter{} \noexpand\thischapternum:
+                                 \noexpand\thischaptername}%
+    }%
+  \fi\fi\fi
+  %
+  % Output the mark.  Pass it through \safewhatsit, to take care of
+  % the preceding space.
+  \safewhatsit\domark
+  %
+  % Insert the chapter heading break.
+  \pchapsepmacro
+  %
+  % Now the second mark, after the heading break.  No break points
+  % between here and the heading.
+  \let\prevchapterdefs=\lastchapterdefs
+  \let\prevsectiondefs=\lastsectiondefs
+  \domark
+  %
+  {%
+    \chapfonts \rm
+    %
+    % Have to define \lastsection before calling \donoderef, because the
+    % xref code eventually uses it.  On the other hand, it has to be called
+    % after \pchapsepmacro, or the headline will change too soon.
+    \gdef\lastsection{#1}%
+    %
+    % Only insert the separating space if we have a chapter/appendix
+    % number, and don't print the unnumbered ``number''.
+    \ifx\temptype\Ynothingkeyword
+      \setbox0 = \hbox{}%
+      \def\toctype{unnchap}%
+    \else\ifx\temptype\Yomitfromtockeyword
+      \setbox0 = \hbox{}% contents like unnumbered, but no toc entry
+      \def\toctype{omit}%
+    \else\ifx\temptype\Yappendixkeyword
+      \setbox0 = \hbox{\putwordAppendix{} #3\enspace}%
+      \def\toctype{app}%
+    \else
+      \setbox0 = \hbox{#3\enspace}%
+      \def\toctype{numchap}%
+    \fi\fi\fi
+    %
+    % Write the toc entry for this chapter.  Must come before the
+    % \donoderef, because we include the current node name in the toc
+    % entry, and \donoderef resets it to empty.
+    \writetocentry{\toctype}{#1}{#3}%
+    %
+    % For pdftex, we have to write out the node definition (aka, make
+    % the pdfdest) after any page break, but before the actual text has
+    % been typeset.  If the destination for the pdf outline is after the
+    % text, then jumping from the outline may wind up with the text not
+    % being visible, for instance under high magnification.
+    \donoderef{#2}%
+    %
+    % Typeset the actual heading.
+    \nobreak % Avoid page breaks at the interline glue.
+    \vbox{\hyphenpenalty=10000 \tolerance=5000 \parindent=0pt \raggedright
+          \hangindent=\wd0 \centerparametersmaybe
+          \unhbox0 #1\par}%
+  }%
+  \nobreak\bigskip % no page break after a chapter title
+  \nobreak
+}
+
+% @centerchap -- centered and unnumbered.
+\let\centerparametersmaybe = \relax
+\def\centerparameters{%
+  \advance\rightskip by 3\rightskip
+  \leftskip = \rightskip
+  \parfillskip = 0pt
+}
+
+
+% I don't think this chapter style is supported any more, so I'm not
+% updating it with the new noderef stuff.  We'll see.  --karl, 11aug03.
+%
+\def\setchapterstyle #1 {\csname CHAPF#1\endcsname}
+%
+\def\unnchfopen #1{%
+\chapoddpage {\chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000
+                       \parindent=0pt\raggedright
+                       \rm #1\hfill}}\bigskip \par\nobreak
+}
+\def\chfopen #1#2{\chapoddpage {\chapfonts
+\vbox to 3in{\vfil \hbox to\hsize{\hfil #2} \hbox to\hsize{\hfil #1} \vfil}}%
+\par\penalty 5000 %
+}
+\def\centerchfopen #1{%
+\chapoddpage {\chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000
+                       \parindent=0pt
+                       \hfill {\rm #1}\hfill}}\bigskip \par\nobreak
+}
+\def\CHAPFopen{%
+  \global\let\chapmacro=\chfopen
+  \global\let\centerchapmacro=\centerchfopen}
+
+
+% Section titles.  These macros combine the section number parts and
+% call the generic \sectionheading to do the printing.
+%
+\newskip\secheadingskip
+\def\secheadingbreak{\dobreak \secheadingskip{-1000}}
+
+% Subsection titles.
+\newskip\subsecheadingskip
+\def\subsecheadingbreak{\dobreak \subsecheadingskip{-500}}
+
+% Subsubsection titles.
+\def\subsubsecheadingskip{\subsecheadingskip}
+\def\subsubsecheadingbreak{\subsecheadingbreak}
+
+
+% Print any size, any type, section title.
+%
+% #1 is the text, #2 is the section level (sec/subsec/subsubsec), #3 is
+% the section type for xrefs (Ynumbered, Ynothing, Yappendix), #4 is the
+% section number.
+%
+\def\seckeyword{sec}
+%
+\def\sectionheading#1#2#3#4{%
+  {%
+    % Switch to the right set of fonts.
+    \csname #2fonts\endcsname \rm
+    %
+    \def\sectionlevel{#2}%
+    \def\temptype{#3}%
+    %
+    % Insert first mark before the heading break (see notes for \domark).
+    \let\prevsectiondefs=\lastsectiondefs
+    \ifx\temptype\Ynothingkeyword
+      \ifx\sectionlevel\seckeyword
+        \gdef\lastsectiondefs{\gdef\thissectionname{#1}\gdef\thissectionnum{}%
+                              \gdef\thissection{\thissectionname}}%
+      \fi
+    \else\ifx\temptype\Yomitfromtockeyword
+      % Don't redefine \thissection.
+    \else\ifx\temptype\Yappendixkeyword
+      \ifx\sectionlevel\seckeyword
+        \toks0={#1}%
+        \xdef\lastsectiondefs{%
+          \gdef\noexpand\thissectionname{\the\toks0}%
+          \gdef\noexpand\thissectionnum{#4}%
+          \gdef\noexpand\thissection{\putwordSection{} \noexpand\thissectionnum:
+                                     \noexpand\thissectionname}%
+        }%
+      \fi
+    \else
+      \ifx\sectionlevel\seckeyword
+        \toks0={#1}%
+        \xdef\lastsectiondefs{%
+          \gdef\noexpand\thissectionname{\the\toks0}%
+          \gdef\noexpand\thissectionnum{#4}%
+          \gdef\noexpand\thissection{\putwordSection{} \noexpand\thissectionnum:
+                                     \noexpand\thissectionname}%
+        }%
+      \fi
+    \fi\fi\fi
+    %
+    % Output the mark.  Pass it through \safewhatsit, to take care of
+    % the preceding space.
+    \safewhatsit\domark
+    %
+    % Insert space above the heading.
+    \csname #2headingbreak\endcsname
+    %
+    % Now the second mark, after the heading break.  No break points
+    % between here and the heading.
+    \let\prevsectiondefs=\lastsectiondefs
+    \domark
+    %
+    % Only insert the space after the number if we have a section number.
+    \ifx\temptype\Ynothingkeyword
+      \setbox0 = \hbox{}%
+      \def\toctype{unn}%
+      \gdef\lastsection{#1}%
+    \else\ifx\temptype\Yomitfromtockeyword
+      % for @headings -- no section number, don't include in toc,
+      % and don't redefine \lastsection.
+      \setbox0 = \hbox{}%
+      \def\toctype{omit}%
+      \let\sectionlevel=\empty
+    \else\ifx\temptype\Yappendixkeyword
+      \setbox0 = \hbox{#4\enspace}%
+      \def\toctype{app}%
+      \gdef\lastsection{#1}%
+    \else
+      \setbox0 = \hbox{#4\enspace}%
+      \def\toctype{num}%
+      \gdef\lastsection{#1}%
+    \fi\fi\fi
+    %
+    % Write the toc entry (before \donoderef).  See comments in \chapmacro.
+    \writetocentry{\toctype\sectionlevel}{#1}{#4}%
+    %
+    % Write the node reference (= pdf destination for pdftex).
+    % Again, see comments in \chapmacro.
+    \donoderef{#3}%
+    %
+    % Interline glue will be inserted when the vbox is completed.
+    % That glue will be a valid breakpoint for the page, since it'll be
+    % preceded by a whatsit (usually from the \donoderef, or from the
+    % \writetocentry if there was no node).  We don't want to allow that
+    % break, since then the whatsits could end up on page n while the
+    % section is on page n+1, thus toc/etc. are wrong.  Debian bug 276000.
+    \nobreak
+    %
+    % Output the actual section heading.
+    \vbox{\hyphenpenalty=10000 \tolerance=5000 \parindent=0pt \raggedright
+          \hangindent=\wd0  % zero if no section number
+          \unhbox0 #1}%
+  }%
+  % Add extra space after the heading -- half of whatever came above it.
+  % Don't allow stretch, though.
+  \kern .5 \csname #2headingskip\endcsname
+  %
+  % Do not let the kern be a potential breakpoint, as it would be if it
+  % was followed by glue.
+  \nobreak
+  %
+  % We'll almost certainly start a paragraph next, so don't let that
+  % glue accumulate.  (Not a breakpoint because it's preceded by a
+  % discardable item.)
+  \vskip-\parskip
+  % 
+  % This is purely so the last item on the list is a known \penalty >
+  % 10000.  This is so \startdefun can avoid allowing breakpoints after
+  % section headings.  Otherwise, it would insert a valid breakpoint between:
+  % 
+  %   @section sec-whatever
+  %   @deffn def-whatever
+  \penalty 10001
+}
+
+
+\message{toc,}
+% Table of contents.
+\newwrite\tocfile
+
+% Write an entry to the toc file, opening it if necessary.
+% Called from @chapter, etc.
+%
+% Example usage: \writetocentry{sec}{Section Name}{\the\chapno.\the\secno}
+% We append the current node name (if any) and page number as additional
+% arguments for the \{chap,sec,...}entry macros which will eventually
+% read this.  The node name is used in the pdf outlines as the
+% destination to jump to.
+%
+% We open the .toc file for writing here instead of at @setfilename (or
+% any other fixed time) so that @contents can be anywhere in the document.
+% But if #1 is `omit', then we don't do anything.  This is used for the
+% table of contents chapter openings themselves.
+%
+\newif\iftocfileopened
+\def\omitkeyword{omit}%
+%
+\def\writetocentry#1#2#3{%
+  \edef\writetoctype{#1}%
+  \ifx\writetoctype\omitkeyword \else
+    \iftocfileopened\else
+      \immediate\openout\tocfile = \jobname.toc
+      \global\tocfileopenedtrue
+    \fi
+    %
+    \iflinks
+      {\atdummies
+       \edef\temp{%
+         \write\tocfile{@#1entry{#2}{#3}{\lastnode}{\noexpand\folio}}}%
+       \temp
+      }%
+    \fi
+  \fi
+  %
+  % Tell \shipout to create a pdf destination on each page, if we're
+  % writing pdf.  These are used in the table of contents.  We can't
+  % just write one on every page because the title pages are numbered
+  % 1 and 2 (the page numbers aren't printed), and so are the first
+  % two pages of the document.  Thus, we'd have two destinations named
+  % `1', and two named `2'.
+  \ifpdf \global\pdfmakepagedesttrue \fi
+}
+
+
+% These characters do not print properly in the Computer Modern roman
+% fonts, so we must take special care.  This is more or less redundant
+% with the Texinfo input format setup at the end of this file.
+% 
+\def\activecatcodes{%
+  \catcode`\"=\active
+  \catcode`\$=\active
+  \catcode`\<=\active
+  \catcode`\>=\active
+  \catcode`\\=\active
+  \catcode`\^=\active
+  \catcode`\_=\active
+  \catcode`\|=\active
+  \catcode`\~=\active
+}
+
+
+% Read the toc file, which is essentially Texinfo input.
+\def\readtocfile{%
+  \setupdatafile
+  \activecatcodes
+  \input \tocreadfilename
+}
+
+\newskip\contentsrightmargin \contentsrightmargin=1in
+\newcount\savepageno
+\newcount\lastnegativepageno \lastnegativepageno = -1
+
+% Prepare to read what we've written to \tocfile.
+%
+\def\startcontents#1{%
+  % If @setchapternewpage on, and @headings double, the contents should
+  % start on an odd page, unlike chapters.  Thus, we maintain
+  % \contentsalignmacro in parallel with \pagealignmacro.
+  % From: Torbjorn Granlund <tege@matematik.su.se>
+  \contentsalignmacro
+  \immediate\closeout\tocfile
+  %
+  % Don't need to put `Contents' or `Short Contents' in the headline.
+  % It is abundantly clear what they are.
+  \chapmacro{#1}{Yomitfromtoc}{}%
+  %
+  \savepageno = \pageno
+  \begingroup                  % Set up to handle contents files properly.
+    \raggedbottom              % Worry more about breakpoints than the bottom.
+    \advance\hsize by -\contentsrightmargin % Don't use the full line length.
+    %
+    % Roman numerals for page numbers.
+    \ifnum \pageno>0 \global\pageno = \lastnegativepageno \fi
+}
+
+% redefined for the two-volume lispref.  We always output on
+% \jobname.toc even if this is redefined.
+% 
+\def\tocreadfilename{\jobname.toc}
+
+% Normal (long) toc.
+%
+\def\contents{%
+  \startcontents{\putwordTOC}%
+    \openin 1 \tocreadfilename\space
+    \ifeof 1 \else
+      \readtocfile
+    \fi
+    \vfill \eject
+    \contentsalignmacro % in case @setchapternewpage odd is in effect
+    \ifeof 1 \else
+      \pdfmakeoutlines
+    \fi
+    \closein 1
+  \endgroup
+  \lastnegativepageno = \pageno
+  \global\pageno = \savepageno
+}
+
+% And just the chapters.
+\def\summarycontents{%
+  \startcontents{\putwordShortTOC}%
+    %
+    \let\numchapentry = \shortchapentry
+    \let\appentry = \shortchapentry
+    \let\unnchapentry = \shortunnchapentry
+    % We want a true roman here for the page numbers.
+    \secfonts
+    \let\rm=\shortcontrm \let\bf=\shortcontbf
+    \let\sl=\shortcontsl \let\tt=\shortconttt
+    \rm
+    \hyphenpenalty = 10000
+    \advance\baselineskip by 1pt % Open it up a little.
+    \def\numsecentry##1##2##3##4{}
+    \let\appsecentry = \numsecentry
+    \let\unnsecentry = \numsecentry
+    \let\numsubsecentry = \numsecentry
+    \let\appsubsecentry = \numsecentry
+    \let\unnsubsecentry = \numsecentry
+    \let\numsubsubsecentry = \numsecentry
+    \let\appsubsubsecentry = \numsecentry
+    \let\unnsubsubsecentry = \numsecentry
+    \openin 1 \tocreadfilename\space
+    \ifeof 1 \else
+      \readtocfile
+    \fi
+    \closein 1
+    \vfill \eject
+    \contentsalignmacro % in case @setchapternewpage odd is in effect
+  \endgroup
+  \lastnegativepageno = \pageno
+  \global\pageno = \savepageno
+}
+\let\shortcontents = \summarycontents
+
+% Typeset the label for a chapter or appendix for the short contents.
+% The arg is, e.g., `A' for an appendix, or `3' for a chapter.
+%
+\def\shortchaplabel#1{%
+  % This space should be enough, since a single number is .5em, and the
+  % widest letter (M) is 1em, at least in the Computer Modern fonts.
+  % But use \hss just in case.
+  % (This space doesn't include the extra space that gets added after
+  % the label; that gets put in by \shortchapentry above.)
+  %
+  % We'd like to right-justify chapter numbers, but that looks strange
+  % with appendix letters.  And right-justifying numbers and
+  % left-justifying letters looks strange when there is less than 10
+  % chapters.  Have to read the whole toc once to know how many chapters
+  % there are before deciding ...
+  \hbox to 1em{#1\hss}%
+}
+
+% These macros generate individual entries in the table of contents.
+% The first argument is the chapter or section name.
+% The last argument is the page number.
+% The arguments in between are the chapter number, section number, ...
+
+% Chapters, in the main contents.
+\def\numchapentry#1#2#3#4{\dochapentry{#2\labelspace#1}{#4}}
+%
+% Chapters, in the short toc.
+% See comments in \dochapentry re vbox and related settings.
+\def\shortchapentry#1#2#3#4{%
+  \tocentry{\shortchaplabel{#2}\labelspace #1}{\doshortpageno\bgroup#4\egroup}%
+}
+
+% Appendices, in the main contents.
+% Need the word Appendix, and a fixed-size box.
+%
+\def\appendixbox#1{%
+  % We use M since it's probably the widest letter.
+  \setbox0 = \hbox{\putwordAppendix{} M}%
+  \hbox to \wd0{\putwordAppendix{} #1\hss}}
+%
+\def\appentry#1#2#3#4{\dochapentry{\appendixbox{#2}\labelspace#1}{#4}}
+
+% Unnumbered chapters.
+\def\unnchapentry#1#2#3#4{\dochapentry{#1}{#4}}
+\def\shortunnchapentry#1#2#3#4{\tocentry{#1}{\doshortpageno\bgroup#4\egroup}}
+
+% Sections.
+\def\numsecentry#1#2#3#4{\dosecentry{#2\labelspace#1}{#4}}
+\let\appsecentry=\numsecentry
+\def\unnsecentry#1#2#3#4{\dosecentry{#1}{#4}}
+
+% Subsections.
+\def\numsubsecentry#1#2#3#4{\dosubsecentry{#2\labelspace#1}{#4}}
+\let\appsubsecentry=\numsubsecentry
+\def\unnsubsecentry#1#2#3#4{\dosubsecentry{#1}{#4}}
+
+% And subsubsections.
+\def\numsubsubsecentry#1#2#3#4{\dosubsubsecentry{#2\labelspace#1}{#4}}
+\let\appsubsubsecentry=\numsubsubsecentry
+\def\unnsubsubsecentry#1#2#3#4{\dosubsubsecentry{#1}{#4}}
+
+% This parameter controls the indentation of the various levels.
+% Same as \defaultparindent.
+\newdimen\tocindent \tocindent = 15pt
+
+% Now for the actual typesetting. In all these, #1 is the text and #2 is the
+% page number.
+%
+% If the toc has to be broken over pages, we want it to be at chapters
+% if at all possible; hence the \penalty.
+\def\dochapentry#1#2{%
+   \penalty-300 \vskip1\baselineskip plus.33\baselineskip minus.25\baselineskip
+   \begingroup
+     \chapentryfonts
+     \tocentry{#1}{\dopageno\bgroup#2\egroup}%
+   \endgroup
+   \nobreak\vskip .25\baselineskip plus.1\baselineskip
+}
+
+\def\dosecentry#1#2{\begingroup
+  \secentryfonts \leftskip=\tocindent
+  \tocentry{#1}{\dopageno\bgroup#2\egroup}%
+\endgroup}
+
+\def\dosubsecentry#1#2{\begingroup
+  \subsecentryfonts \leftskip=2\tocindent
+  \tocentry{#1}{\dopageno\bgroup#2\egroup}%
+\endgroup}
+
+\def\dosubsubsecentry#1#2{\begingroup
+  \subsubsecentryfonts \leftskip=3\tocindent
+  \tocentry{#1}{\dopageno\bgroup#2\egroup}%
+\endgroup}
+
+% We use the same \entry macro as for the index entries.
+\let\tocentry = \entry
+
+% Space between chapter (or whatever) number and the title.
+\def\labelspace{\hskip1em \relax}
+
+\def\dopageno#1{{\rm #1}}
+\def\doshortpageno#1{{\rm #1}}
+
+\def\chapentryfonts{\secfonts \rm}
+\def\secentryfonts{\textfonts}
+\def\subsecentryfonts{\textfonts}
+\def\subsubsecentryfonts{\textfonts}
+
+
+\message{environments,}
+% @foo ... @end foo.
+
+% @point{}, @result{}, @expansion{}, @print{}, @equiv{}.
+%
+% Since these characters are used in examples, it should be an even number of
+% \tt widths. Each \tt character is 1en, so two makes it 1em.
+%
+\def\point{$\star$}
+\def\result{\leavevmode\raise.15ex\hbox to 1em{\hfil$\Rightarrow$\hfil}}
+\def\expansion{\leavevmode\raise.1ex\hbox to 1em{\hfil$\mapsto$\hfil}}
+\def\print{\leavevmode\lower.1ex\hbox to 1em{\hfil$\dashv$\hfil}}
+\def\equiv{\leavevmode\lower.1ex\hbox to 1em{\hfil$\ptexequiv$\hfil}}
+
+% The @error{} command.
+% Adapted from the TeXbook's \boxit.
+%
+\newbox\errorbox
+%
+{\tentt \global\dimen0 = 3em}% Width of the box.
+\dimen2 = .55pt % Thickness of rules
+% The text. (`r' is open on the right, `e' somewhat less so on the left.)
+\setbox0 = \hbox{\kern-.75pt \reducedsf error\kern-1.5pt}
+%
+\setbox\errorbox=\hbox to \dimen0{\hfil
+   \hsize = \dimen0 \advance\hsize by -5.8pt % Space to left+right.
+   \advance\hsize by -2\dimen2 % Rules.
+   \vbox{%
+      \hrule height\dimen2
+      \hbox{\vrule width\dimen2 \kern3pt          % Space to left of text.
+         \vtop{\kern2.4pt \box0 \kern2.4pt}% Space above/below.
+         \kern3pt\vrule width\dimen2}% Space to right.
+      \hrule height\dimen2}
+    \hfil}
+%
+\def\error{\leavevmode\lower.7ex\copy\errorbox}
+
+% @tex ... @end tex    escapes into raw Tex temporarily.
+% One exception: @ is still an escape character, so that @end tex works.
+% But \@ or @@ will get a plain tex @ character.
+
+\envdef\tex{%
+  \catcode `\\=0 \catcode `\{=1 \catcode `\}=2
+  \catcode `\$=3 \catcode `\&=4 \catcode `\#=6
+  \catcode `\^=7 \catcode `\_=8 \catcode `\~=\active \let~=\tie
+  \catcode `\%=14
+  \catcode `\+=\other
+  \catcode `\"=\other
+  \catcode `\|=\other
+  \catcode `\<=\other
+  \catcode `\>=\other
+  \escapechar=`\\
+  %
+  \let\b=\ptexb
+  \let\bullet=\ptexbullet
+  \let\c=\ptexc
+  \let\,=\ptexcomma
+  \let\.=\ptexdot
+  \let\dots=\ptexdots
+  \let\equiv=\ptexequiv
+  \let\!=\ptexexclam
+  \let\i=\ptexi
+  \let\indent=\ptexindent
+  \let\noindent=\ptexnoindent
+  \let\{=\ptexlbrace
+  \let\+=\tabalign
+  \let\}=\ptexrbrace
+  \let\/=\ptexslash
+  \let\*=\ptexstar
+  \let\t=\ptext
+  \let\frenchspacing=\plainfrenchspacing
+  %
+  \def\endldots{\mathinner{\ldots\ldots\ldots\ldots}}%
+  \def\enddots{\relax\ifmmode\endldots\else$\mathsurround=0pt \endldots\,$\fi}%
+  \def\@{@}%
+}
+% There is no need to define \Etex.
+
+% Define @lisp ... @end lisp.
+% @lisp environment forms a group so it can rebind things,
+% including the definition of @end lisp (which normally is erroneous).
+
+% Amount to narrow the margins by for @lisp.
+\newskip\lispnarrowing \lispnarrowing=0.4in
+
+% This is the definition that ^^M gets inside @lisp, @example, and other
+% such environments.  \null is better than a space, since it doesn't
+% have any width.
+\def\lisppar{\null\endgraf}
+
+% This space is always present above and below environments.
+\newskip\envskipamount \envskipamount = 0pt
+
+% Make spacing and below environment symmetrical.  We use \parskip here
+% to help in doing that, since in @example-like environments \parskip
+% is reset to zero; thus the \afterenvbreak inserts no space -- but the
+% start of the next paragraph will insert \parskip.
+%
+\def\aboveenvbreak{{%
+  % =10000 instead of <10000 because of a special case in \itemzzz and
+  % \sectionheading, q.v.
+  \ifnum \lastpenalty=10000 \else
+    \advance\envskipamount by \parskip
+    \endgraf
+    \ifdim\lastskip<\envskipamount
+      \removelastskip
+      % it's not a good place to break if the last penalty was \nobreak
+      % or better ...
+      \ifnum\lastpenalty<10000 \penalty-50 \fi
+      \vskip\envskipamount
+    \fi
+  \fi
+}}
+
+\let\afterenvbreak = \aboveenvbreak
+
+% \nonarrowing is a flag.  If "set", @lisp etc don't narrow margins; it will
+% also clear it, so that its embedded environments do the narrowing again.
+\let\nonarrowing=\relax
+
+% @cartouche ... @end cartouche: draw rectangle w/rounded corners around
+% environment contents.
+\font\circle=lcircle10
+\newdimen\circthick
+\newdimen\cartouter\newdimen\cartinner
+\newskip\normbskip\newskip\normpskip\newskip\normlskip
+\circthick=\fontdimen8\circle
+%
+\def\ctl{{\circle\char'013\hskip -6pt}}% 6pt from pl file: 1/2charwidth
+\def\ctr{{\hskip 6pt\circle\char'010}}
+\def\cbl{{\circle\char'012\hskip -6pt}}
+\def\cbr{{\hskip 6pt\circle\char'011}}
+\def\carttop{\hbox to \cartouter{\hskip\lskip
+        \ctl\leaders\hrule height\circthick\hfil\ctr
+        \hskip\rskip}}
+\def\cartbot{\hbox to \cartouter{\hskip\lskip
+        \cbl\leaders\hrule height\circthick\hfil\cbr
+        \hskip\rskip}}
+%
+\newskip\lskip\newskip\rskip
+
+\envdef\cartouche{%
+  \ifhmode\par\fi  % can't be in the midst of a paragraph.
+  \startsavinginserts
+  \lskip=\leftskip \rskip=\rightskip
+  \leftskip=0pt\rightskip=0pt % we want these *outside*.
+  \cartinner=\hsize \advance\cartinner by-\lskip
+  \advance\cartinner by-\rskip
+  \cartouter=\hsize
+  \advance\cartouter by 18.4pt	% allow for 3pt kerns on either
+				% side, and for 6pt waste from
+				% each corner char, and rule thickness
+  \normbskip=\baselineskip \normpskip=\parskip \normlskip=\lineskip
+  % Flag to tell @lisp, etc., not to narrow margin.
+  \let\nonarrowing = t%
+  \vbox\bgroup
+      \baselineskip=0pt\parskip=0pt\lineskip=0pt
+      \carttop
+      \hbox\bgroup
+	  \hskip\lskip
+	  \vrule\kern3pt
+	  \vbox\bgroup
+	      \kern3pt
+	      \hsize=\cartinner
+	      \baselineskip=\normbskip
+	      \lineskip=\normlskip
+	      \parskip=\normpskip
+	      \vskip -\parskip
+	      \comment % For explanation, see the end of \def\group.
+}
+\def\Ecartouche{%
+              \ifhmode\par\fi
+	      \kern3pt
+	  \egroup
+	  \kern3pt\vrule
+	  \hskip\rskip
+      \egroup
+      \cartbot
+  \egroup
+  \checkinserts
+}
+
+
+% This macro is called at the beginning of all the @example variants,
+% inside a group.
+\def\nonfillstart{%
+  \aboveenvbreak
+  \hfuzz = 12pt % Don't be fussy
+  \sepspaces % Make spaces be word-separators rather than space tokens.
+  \let\par = \lisppar % don't ignore blank lines
+  \obeylines % each line of input is a line of output
+  \parskip = 0pt
+  \parindent = 0pt
+  \emergencystretch = 0pt % don't try to avoid overfull boxes
+  \ifx\nonarrowing\relax
+    \advance \leftskip by \lispnarrowing
+    \exdentamount=\lispnarrowing
+  \else
+    \let\nonarrowing = \relax
+  \fi
+  \let\exdent=\nofillexdent
+}
+
+% If you want all examples etc. small: @set dispenvsize small.
+% If you want even small examples the full size: @set dispenvsize nosmall.
+% This affects the following displayed environments:
+%    @example, @display, @format, @lisp
+%
+\def\smallword{small}
+\def\nosmallword{nosmall}
+\let\SETdispenvsize\relax
+\def\setnormaldispenv{%
+  \ifx\SETdispenvsize\smallword
+    % end paragraph for sake of leading, in case document has no blank
+    % line.  This is redundant with what happens in \aboveenvbreak, but
+    % we need to do it before changing the fonts, and it's inconvenient
+    % to change the fonts afterward.
+    \ifnum \lastpenalty=10000 \else \endgraf \fi
+    \smallexamplefonts \rm
+  \fi
+}
+\def\setsmalldispenv{%
+  \ifx\SETdispenvsize\nosmallword
+  \else
+    \ifnum \lastpenalty=10000 \else \endgraf \fi
+    \smallexamplefonts \rm
+  \fi
+}
+
+% We often define two environments, @foo and @smallfoo.
+% Let's do it by one command:
+\def\makedispenv #1#2{
+  \expandafter\envdef\csname#1\endcsname {\setnormaldispenv #2}
+  \expandafter\envdef\csname small#1\endcsname {\setsmalldispenv #2}
+  \expandafter\let\csname E#1\endcsname \afterenvbreak
+  \expandafter\let\csname Esmall#1\endcsname \afterenvbreak
+}
+
+% Define two synonyms:
+\def\maketwodispenvs #1#2#3{
+  \makedispenv{#1}{#3}
+  \makedispenv{#2}{#3}
+}
+
+% @lisp: indented, narrowed, typewriter font; @example: same as @lisp.
+%
+% @smallexample and @smalllisp: use smaller fonts.
+% Originally contributed by Pavel@xerox.
+%
+\maketwodispenvs {lisp}{example}{%
+  \nonfillstart
+  \tt\quoteexpand
+  \let\kbdfont = \kbdexamplefont % Allow @kbd to do something special.
+  \gobble       % eat return
+}
+% @display/@smalldisplay: same as @lisp except keep current font.
+%
+\makedispenv {display}{%
+  \nonfillstart
+  \gobble
+}
+
+% @format/@smallformat: same as @display except don't narrow margins.
+%
+\makedispenv{format}{%
+  \let\nonarrowing = t%
+  \nonfillstart
+  \gobble
+}
+
+% @flushleft: same as @format, but doesn't obey \SETdispenvsize.
+\envdef\flushleft{%
+  \let\nonarrowing = t%
+  \nonfillstart
+  \gobble
+}
+\let\Eflushleft = \afterenvbreak
+
+% @flushright.
+%
+\envdef\flushright{%
+  \let\nonarrowing = t%
+  \nonfillstart
+  \advance\leftskip by 0pt plus 1fill
+  \gobble
+}
+\let\Eflushright = \afterenvbreak
+
+
+% @quotation does normal linebreaking (hence we can't use \nonfillstart)
+% and narrows the margins.  We keep \parskip nonzero in general, since
+% we're doing normal filling.  So, when using \aboveenvbreak and
+% \afterenvbreak, temporarily make \parskip 0.
+%
+\envdef\quotation{%
+  {\parskip=0pt \aboveenvbreak}% because \aboveenvbreak inserts \parskip
+  \parindent=0pt
+  %
+  % @cartouche defines \nonarrowing to inhibit narrowing at next level down.
+  \ifx\nonarrowing\relax
+    \advance\leftskip by \lispnarrowing
+    \advance\rightskip by \lispnarrowing
+    \exdentamount = \lispnarrowing
+  \else
+    \let\nonarrowing = \relax
+  \fi
+  \parsearg\quotationlabel
+}
+
+% We have retained a nonzero parskip for the environment, since we're
+% doing normal filling.
+%
+\def\Equotation{%
+  \par
+  \ifx\quotationauthor\undefined\else
+    % indent a bit.
+    \leftline{\kern 2\leftskip \sl ---\quotationauthor}%
+  \fi
+  {\parskip=0pt \afterenvbreak}%
+}
+
+% If we're given an argument, typeset it in bold with a colon after.
+\def\quotationlabel#1{%
+  \def\temp{#1}%
+  \ifx\temp\empty \else
+    {\bf #1: }%
+  \fi
+}
+
+
+% LaTeX-like @verbatim...@end verbatim and @verb{<char>...<char>}
+% If we want to allow any <char> as delimiter,
+% we need the curly braces so that makeinfo sees the @verb command, eg:
+% `@verbx...x' would look like the '@verbx' command.  --janneke@gnu.org
+%
+% [Knuth]: Donald Ervin Knuth, 1996.  The TeXbook.
+%
+% [Knuth] p.344; only we need to do the other characters Texinfo sets
+% active too.  Otherwise, they get lost as the first character on a
+% verbatim line.
+\def\dospecials{%
+  \do\ \do\\\do\{\do\}\do\$\do\&%
+  \do\#\do\^\do\^^K\do\_\do\^^A\do\%\do\~%
+  \do\<\do\>\do\|\do\@\do+\do\"%
+}
+%
+% [Knuth] p. 380
+\def\uncatcodespecials{%
+  \def\do##1{\catcode`##1=\other}\dospecials}
+%
+% [Knuth] pp. 380,381,391
+% Disable Spanish ligatures ?` and !` of \tt font
+\begingroup
+  \catcode`\`=\active\gdef`{\relax\lq}
+\endgroup
+%
+% Setup for the @verb command.
+%
+% Eight spaces for a tab
+\begingroup
+  \catcode`\^^I=\active
+  \gdef\tabeightspaces{\catcode`\^^I=\active\def^^I{\ \ \ \ \ \ \ \ }}
+\endgroup
+%
+\def\setupverb{%
+  \tt  % easiest (and conventionally used) font for verbatim
+  \def\par{\leavevmode\endgraf}%
+  \catcode`\`=\active
+  \tabeightspaces
+  % Respect line breaks,
+  % print special symbols as themselves, and
+  % make each space count
+  % must do in this order:
+  \obeylines \uncatcodespecials \sepspaces
+}
+
+% Setup for the @verbatim environment
+%
+% Real tab expansion
+\newdimen\tabw \setbox0=\hbox{\tt\space} \tabw=8\wd0 % tab amount
+%
+\def\starttabbox{\setbox0=\hbox\bgroup}
+
+% Allow an option to not replace quotes with a regular directed right
+% quote/apostrophe (char 0x27), but instead use the undirected quote
+% from cmtt (char 0x0d).  The undirected quote is ugly, so don't make it
+% the default, but it works for pasting with more pdf viewers (at least
+% evince), the lilypond developers report.  xpdf does work with the
+% regular 0x27.  
+% 
+\def\codequoteright{%
+  \expandafter\ifx\csname SETtxicodequoteundirected\endcsname\relax
+    \expandafter\ifx\csname SETcodequoteundirected\endcsname\relax
+      '%
+    \else \char'15 \fi
+  \else \char'15 \fi
+}
+%
+% and a similar option for the left quote char vs. a grave accent.
+% Modern fonts display ASCII 0x60 as a grave accent, so some people like
+% the code environments to do likewise.
+% 
+\def\codequoteleft{%
+  \expandafter\ifx\csname SETtxicodequotebacktick\endcsname\relax
+    \expandafter\ifx\csname SETcodequotebacktick\endcsname\relax
+      `%
+    \else \char'22 \fi
+  \else \char'22 \fi
+}
+%
+\begingroup
+  \catcode`\^^I=\active
+  \gdef\tabexpand{%
+    \catcode`\^^I=\active
+    \def^^I{\leavevmode\egroup
+      \dimen0=\wd0 % the width so far, or since the previous tab
+      \divide\dimen0 by\tabw
+      \multiply\dimen0 by\tabw % compute previous multiple of \tabw
+      \advance\dimen0 by\tabw  % advance to next multiple of \tabw
+      \wd0=\dimen0 \box0 \starttabbox
+    }%
+  }
+  \catcode`\'=\active
+  \gdef\rquoteexpand{\catcode\rquoteChar=\active \def'{\codequoteright}}%
+  %
+  \catcode`\`=\active
+  \gdef\lquoteexpand{\catcode\lquoteChar=\active \def`{\codequoteleft}}%
+  %
+  \gdef\quoteexpand{\rquoteexpand \lquoteexpand}%
+\endgroup
+
+% start the verbatim environment.
+\def\setupverbatim{%
+  \let\nonarrowing = t%
+  \nonfillstart
+  % Easiest (and conventionally used) font for verbatim
+  \tt
+  \def\par{\leavevmode\egroup\box0\endgraf}%
+  \catcode`\`=\active
+  \tabexpand
+  \quoteexpand
+  % Respect line breaks,
+  % print special symbols as themselves, and
+  % make each space count
+  % must do in this order:
+  \obeylines \uncatcodespecials \sepspaces
+  \everypar{\starttabbox}%
+}
+
+% Do the @verb magic: verbatim text is quoted by unique
+% delimiter characters.  Before first delimiter expect a
+% right brace, after last delimiter expect closing brace:
+%
+%    \def\doverb'{'<char>#1<char>'}'{#1}
+%
+% [Knuth] p. 382; only eat outer {}
+\begingroup
+  \catcode`[=1\catcode`]=2\catcode`\{=\other\catcode`\}=\other
+  \gdef\doverb{#1[\def\next##1#1}[##1\endgroup]\next]
+\endgroup
+%
+\def\verb{\begingroup\setupverb\doverb}
+%
+%
+% Do the @verbatim magic: define the macro \doverbatim so that
+% the (first) argument ends when '@end verbatim' is reached, ie:
+%
+%     \def\doverbatim#1@end verbatim{#1}
+%
+% For Texinfo it's a lot easier than for LaTeX,
+% because texinfo's \verbatim doesn't stop at '\end{verbatim}':
+% we need not redefine '\', '{' and '}'.
+%
+% Inspired by LaTeX's verbatim command set [latex.ltx]
+%
+\begingroup
+  \catcode`\ =\active
+  \obeylines %
+  % ignore everything up to the first ^^M, that's the newline at the end
+  % of the @verbatim input line itself.  Otherwise we get an extra blank
+  % line in the output.
+  \xdef\doverbatim#1^^M#2@end verbatim{#2\noexpand\end\gobble verbatim}%
+  % We really want {...\end verbatim} in the body of the macro, but
+  % without the active space; thus we have to use \xdef and \gobble.
+\endgroup
+%
+\envdef\verbatim{%
+    \setupverbatim\doverbatim
+}
+\let\Everbatim = \afterenvbreak
+
+
+% @verbatiminclude FILE - insert text of file in verbatim environment.
+%
+\def\verbatiminclude{\parseargusing\filenamecatcodes\doverbatiminclude}
+%
+\def\doverbatiminclude#1{%
+  {%
+    \makevalueexpandable
+    \setupverbatim
+    \input #1
+    \afterenvbreak
+  }%
+}
+
+% @copying ... @end copying.
+% Save the text away for @insertcopying later.
+%
+% We save the uninterpreted tokens, rather than creating a box.
+% Saving the text in a box would be much easier, but then all the
+% typesetting commands (@smallbook, font changes, etc.) have to be done
+% beforehand -- and a) we want @copying to be done first in the source
+% file; b) letting users define the frontmatter in as flexible order as
+% possible is very desirable.
+%
+\def\copying{\checkenv{}\begingroup\scanargctxt\docopying}
+\def\docopying#1@end copying{\endgroup\def\copyingtext{#1}}
+%
+\def\insertcopying{%
+  \begingroup
+    \parindent = 0pt  % paragraph indentation looks wrong on title page
+    \scanexp\copyingtext
+  \endgroup
+}
+
+
+\message{defuns,}
+% @defun etc.
+
+\newskip\defbodyindent \defbodyindent=.4in
+\newskip\defargsindent \defargsindent=50pt
+\newskip\deflastargmargin \deflastargmargin=18pt
+\newcount\defunpenalty
+
+% Start the processing of @deffn:
+\def\startdefun{%
+  \ifnum\lastpenalty<10000
+    \medbreak
+    \defunpenalty=10003 % Will keep this @deffn together with the
+                        % following @def command, see below.
+  \else
+    % If there are two @def commands in a row, we'll have a \nobreak,
+    % which is there to keep the function description together with its
+    % header.  But if there's nothing but headers, we need to allow a
+    % break somewhere.  Check specifically for penalty 10002, inserted
+    % by \printdefunline, instead of 10000, since the sectioning
+    % commands also insert a nobreak penalty, and we don't want to allow
+    % a break between a section heading and a defun.
+    %
+    % As a minor refinement, we avoid "club" headers by signalling
+    % with penalty of 10003 after the very first @deffn in the
+    % sequence (see above), and penalty of 10002 after any following
+    % @def command.
+    \ifnum\lastpenalty=10002 \penalty2000 \else \defunpenalty=10002 \fi
+    %
+    % Similarly, after a section heading, do not allow a break.
+    % But do insert the glue.
+    \medskip  % preceded by discardable penalty, so not a breakpoint
+  \fi
+  %
+  \parindent=0in
+  \advance\leftskip by \defbodyindent
+  \exdentamount=\defbodyindent
+}
+
+\def\dodefunx#1{%
+  % First, check whether we are in the right environment:
+  \checkenv#1%
+  %
+  % As above, allow line break if we have multiple x headers in a row.
+  % It's not a great place, though.
+  \ifnum\lastpenalty=10002 \penalty3000 \else \defunpenalty=10002 \fi
+  %
+  % And now, it's time to reuse the body of the original defun:
+  \expandafter\gobbledefun#1%
+}
+\def\gobbledefun#1\startdefun{}
+
+% \printdefunline \deffnheader{text}
+%
+\def\printdefunline#1#2{%
+  \begingroup
+    % call \deffnheader:
+    #1#2 \endheader
+    % common ending:
+    \interlinepenalty = 10000
+    \advance\rightskip by 0pt plus 1fil
+    \endgraf
+    \nobreak\vskip -\parskip
+    \penalty\defunpenalty  % signal to \startdefun and \dodefunx
+    % Some of the @defun-type tags do not enable magic parentheses,
+    % rendering the following check redundant.  But we don't optimize.
+    \checkparencounts
+  \endgroup
+}
+
+\def\Edefun{\endgraf\medbreak}
+
+% \makedefun{deffn} creates \deffn, \deffnx and \Edeffn;
+% the only thing remainnig is to define \deffnheader.
+%
+\def\makedefun#1{%
+  \expandafter\let\csname E#1\endcsname = \Edefun
+  \edef\temp{\noexpand\domakedefun
+    \makecsname{#1}\makecsname{#1x}\makecsname{#1header}}%
+  \temp
+}
+
+% \domakedefun \deffn \deffnx \deffnheader
+%
+% Define \deffn and \deffnx, without parameters.
+% \deffnheader has to be defined explicitly.
+%
+\def\domakedefun#1#2#3{%
+  \envdef#1{%
+    \startdefun
+    \parseargusing\activeparens{\printdefunline#3}%
+  }%
+  \def#2{\dodefunx#1}%
+  \def#3%
+}
+
+%%% Untyped functions:
+
+% @deffn category name args
+\makedefun{deffn}{\deffngeneral{}}
+
+% @deffn category class name args
+\makedefun{defop}#1 {\defopon{#1\ \putwordon}}
+
+% \defopon {category on}class name args
+\def\defopon#1#2 {\deffngeneral{\putwordon\ \code{#2}}{#1\ \code{#2}} }
+
+% \deffngeneral {subind}category name args
+%
+\def\deffngeneral#1#2 #3 #4\endheader{%
+  % Remember that \dosubind{fn}{foo}{} is equivalent to \doind{fn}{foo}.
+  \dosubind{fn}{\code{#3}}{#1}%
+  \defname{#2}{}{#3}\magicamp\defunargs{#4\unskip}%
+}
+
+%%% Typed functions:
+
+% @deftypefn category type name args
+\makedefun{deftypefn}{\deftypefngeneral{}}
+
+% @deftypeop category class type name args
+\makedefun{deftypeop}#1 {\deftypeopon{#1\ \putwordon}}
+
+% \deftypeopon {category on}class type name args
+\def\deftypeopon#1#2 {\deftypefngeneral{\putwordon\ \code{#2}}{#1\ \code{#2}} }
+
+% \deftypefngeneral {subind}category type name args
+%
+\def\deftypefngeneral#1#2 #3 #4 #5\endheader{%
+  \dosubind{fn}{\code{#4}}{#1}%
+  \defname{#2}{#3}{#4}\defunargs{#5\unskip}%
+}
+
+%%% Typed variables:
+
+% @deftypevr category type var args
+\makedefun{deftypevr}{\deftypecvgeneral{}}
+
+% @deftypecv category class type var args
+\makedefun{deftypecv}#1 {\deftypecvof{#1\ \putwordof}}
+
+% \deftypecvof {category of}class type var args
+\def\deftypecvof#1#2 {\deftypecvgeneral{\putwordof\ \code{#2}}{#1\ \code{#2}} }
+
+% \deftypecvgeneral {subind}category type var args
+%
+\def\deftypecvgeneral#1#2 #3 #4 #5\endheader{%
+  \dosubind{vr}{\code{#4}}{#1}%
+  \defname{#2}{#3}{#4}\defunargs{#5\unskip}%
+}
+
+%%% Untyped variables:
+
+% @defvr category var args
+\makedefun{defvr}#1 {\deftypevrheader{#1} {} }
+
+% @defcv category class var args
+\makedefun{defcv}#1 {\defcvof{#1\ \putwordof}}
+
+% \defcvof {category of}class var args
+\def\defcvof#1#2 {\deftypecvof{#1}#2 {} }
+
+%%% Type:
+% @deftp category name args
+\makedefun{deftp}#1 #2 #3\endheader{%
+  \doind{tp}{\code{#2}}%
+  \defname{#1}{}{#2}\defunargs{#3\unskip}%
+}
+
+% Remaining @defun-like shortcuts:
+\makedefun{defun}{\deffnheader{\putwordDeffunc} }
+\makedefun{defmac}{\deffnheader{\putwordDefmac} }
+\makedefun{defspec}{\deffnheader{\putwordDefspec} }
+\makedefun{deftypefun}{\deftypefnheader{\putwordDeffunc} }
+\makedefun{defvar}{\defvrheader{\putwordDefvar} }
+\makedefun{defopt}{\defvrheader{\putwordDefopt} }
+\makedefun{deftypevar}{\deftypevrheader{\putwordDefvar} }
+\makedefun{defmethod}{\defopon\putwordMethodon}
+\makedefun{deftypemethod}{\deftypeopon\putwordMethodon}
+\makedefun{defivar}{\defcvof\putwordInstanceVariableof}
+\makedefun{deftypeivar}{\deftypecvof\putwordInstanceVariableof}
+
+% \defname, which formats the name of the @def (not the args).
+% #1 is the category, such as "Function".
+% #2 is the return type, if any.
+% #3 is the function name.
+%
+% We are followed by (but not passed) the arguments, if any.
+%
+\def\defname#1#2#3{%
+  % Get the values of \leftskip and \rightskip as they were outside the @def...
+  \advance\leftskip by -\defbodyindent
+  %
+  % How we'll format the type name.  Putting it in brackets helps
+  % distinguish it from the body text that may end up on the next line
+  % just below it.
+  \def\temp{#1}%
+  \setbox0=\hbox{\kern\deflastargmargin \ifx\temp\empty\else [\rm\temp]\fi}
+  %
+  % Figure out line sizes for the paragraph shape.
+  % The first line needs space for \box0; but if \rightskip is nonzero,
+  % we need only space for the part of \box0 which exceeds it:
+  \dimen0=\hsize  \advance\dimen0 by -\wd0  \advance\dimen0 by \rightskip
+  % The continuations:
+  \dimen2=\hsize  \advance\dimen2 by -\defargsindent
+  % (plain.tex says that \dimen1 should be used only as global.)
+  \parshape 2 0in \dimen0 \defargsindent \dimen2
+  %
+  % Put the type name to the right margin.
+  \noindent
+  \hbox to 0pt{%
+    \hfil\box0 \kern-\hsize
+    % \hsize has to be shortened this way:
+    \kern\leftskip
+    % Intentionally do not respect \rightskip, since we need the space.
+  }%
+  %
+  % Allow all lines to be underfull without complaint:
+  \tolerance=10000 \hbadness=10000
+  \exdentamount=\defbodyindent
+  {%
+    % defun fonts. We use typewriter by default (used to be bold) because:
+    % . we're printing identifiers, they should be in tt in principle.
+    % . in languages with many accents, such as Czech or French, it's
+    %   common to leave accents off identifiers.  The result looks ok in
+    %   tt, but exceedingly strange in rm.
+    % . we don't want -- and --- to be treated as ligatures.
+    % . this still does not fix the ?` and !` ligatures, but so far no
+    %   one has made identifiers using them :).
+    \df \tt
+    \def\temp{#2}% return value type
+    \ifx\temp\empty\else \tclose{\temp} \fi
+    #3% output function name
+  }%
+  {\rm\enskip}% hskip 0.5 em of \tenrm
+  %
+  \boldbrax
+  % arguments will be output next, if any.
+}
+
+% Print arguments in slanted roman (not ttsl), inconsistently with using
+% tt for the name.  This is because literal text is sometimes needed in
+% the argument list (groff manual), and ttsl and tt are not very
+% distinguishable.  Prevent hyphenation at `-' chars.
+%
+\def\defunargs#1{%
+  % use sl by default (not ttsl),
+  % tt for the names.
+  \df \sl \hyphenchar\font=0
+  %
+  % On the other hand, if an argument has two dashes (for instance), we
+  % want a way to get ttsl.  Let's try @var for that.
+  \let\var=\ttslanted
+  #1%
+  \sl\hyphenchar\font=45
+}
+
+% We want ()&[] to print specially on the defun line.
+%
+\def\activeparens{%
+  \catcode`\(=\active \catcode`\)=\active
+  \catcode`\[=\active \catcode`\]=\active
+  \catcode`\&=\active
+}
+
+% Make control sequences which act like normal parenthesis chars.
+\let\lparen = ( \let\rparen = )
+
+% Be sure that we always have a definition for `(', etc.  For example,
+% if the fn name has parens in it, \boldbrax will not be in effect yet,
+% so TeX would otherwise complain about undefined control sequence.
+{
+  \activeparens
+  \global\let(=\lparen \global\let)=\rparen
+  \global\let[=\lbrack \global\let]=\rbrack
+  \global\let& = \&
+
+  \gdef\boldbrax{\let(=\opnr\let)=\clnr\let[=\lbrb\let]=\rbrb}
+  \gdef\magicamp{\let&=\amprm}
+}
+
+\newcount\parencount
+
+% If we encounter &foo, then turn on ()-hacking afterwards
+\newif\ifampseen
+\def\amprm#1 {\ampseentrue{\bf\&#1 }}
+
+\def\parenfont{%
+  \ifampseen
+    % At the first level, print parens in roman,
+    % otherwise use the default font.
+    \ifnum \parencount=1 \rm \fi
+  \else
+    % The \sf parens (in \boldbrax) actually are a little bolder than
+    % the contained text.  This is especially needed for [ and ] .
+    \sf
+  \fi
+}
+\def\infirstlevel#1{%
+  \ifampseen
+    \ifnum\parencount=1
+      #1%
+    \fi
+  \fi
+}
+\def\bfafterword#1 {#1 \bf}
+
+\def\opnr{%
+  \global\advance\parencount by 1
+  {\parenfont(}%
+  \infirstlevel \bfafterword
+}
+\def\clnr{%
+  {\parenfont)}%
+  \infirstlevel \sl
+  \global\advance\parencount by -1
+}
+
+\newcount\brackcount
+\def\lbrb{%
+  \global\advance\brackcount by 1
+  {\bf[}%
+}
+\def\rbrb{%
+  {\bf]}%
+  \global\advance\brackcount by -1
+}
+
+\def\checkparencounts{%
+  \ifnum\parencount=0 \else \badparencount \fi
+  \ifnum\brackcount=0 \else \badbrackcount \fi
+}
+% these should not use \errmessage; the glibc manual, at least, actually
+% has such constructs (when documenting function pointers).
+\def\badparencount{%
+  \message{Warning: unbalanced parentheses in @def...}%
+  \global\parencount=0
+}
+\def\badbrackcount{%
+  \message{Warning: unbalanced square brackets in @def...}%
+  \global\brackcount=0
+}
+
+
+\message{macros,}
+% @macro.
+
+% To do this right we need a feature of e-TeX, \scantokens,
+% which we arrange to emulate with a temporary file in ordinary TeX.
+\ifx\eTeXversion\undefined
+  \newwrite\macscribble
+  \def\scantokens#1{%
+    \toks0={#1}%
+    \immediate\openout\macscribble=\jobname.tmp
+    \immediate\write\macscribble{\the\toks0}%
+    \immediate\closeout\macscribble
+    \input \jobname.tmp
+  }
+\fi
+
+\def\scanmacro#1{%
+  \begingroup
+    \newlinechar`\^^M
+    \let\xeatspaces\eatspaces
+    % Undo catcode changes of \startcontents and \doprintindex
+    % When called from @insertcopying or (short)caption, we need active
+    % backslash to get it printed correctly.  Previously, we had
+    % \catcode`\\=\other instead.  We'll see whether a problem appears
+    % with macro expansion.				--kasal, 19aug04
+    \catcode`\@=0 \catcode`\\=\active \escapechar=`\@
+    % ... and \example
+    \spaceisspace
+    %
+    % Append \endinput to make sure that TeX does not see the ending newline.
+    % I've verified that it is necessary both for e-TeX and for ordinary TeX
+    %							--kasal, 29nov03
+    \scantokens{#1\endinput}%
+  \endgroup
+}
+
+\def\scanexp#1{%
+  \edef\temp{\noexpand\scanmacro{#1}}%
+  \temp
+}
+
+\newcount\paramno   % Count of parameters
+\newtoks\macname    % Macro name
+\newif\ifrecursive  % Is it recursive?
+
+% List of all defined macros in the form
+%    \definedummyword\macro1\definedummyword\macro2...
+% Currently is also contains all @aliases; the list can be split
+% if there is a need.
+\def\macrolist{}
+
+% Add the macro to \macrolist
+\def\addtomacrolist#1{\expandafter \addtomacrolistxxx \csname#1\endcsname}
+\def\addtomacrolistxxx#1{%
+     \toks0 = \expandafter{\macrolist\definedummyword#1}%
+     \xdef\macrolist{\the\toks0}%
+}
+
+% Utility routines.
+% This does \let #1 = #2, with \csnames; that is,
+%   \let \csname#1\endcsname = \csname#2\endcsname
+% (except of course we have to play expansion games).
+% 
+\def\cslet#1#2{%
+  \expandafter\let
+  \csname#1\expandafter\endcsname
+  \csname#2\endcsname
+}
+
+% Trim leading and trailing spaces off a string.
+% Concepts from aro-bend problem 15 (see CTAN).
+{\catcode`\@=11
+\gdef\eatspaces #1{\expandafter\trim@\expandafter{#1 }}
+\gdef\trim@ #1{\trim@@ @#1 @ #1 @ @@}
+\gdef\trim@@ #1@ #2@ #3@@{\trim@@@\empty #2 @}
+\def\unbrace#1{#1}
+\unbrace{\gdef\trim@@@ #1 } #2@{#1}
+}
+
+% Trim a single trailing ^^M off a string.
+{\catcode`\^^M=\other \catcode`\Q=3%
+\gdef\eatcr #1{\eatcra #1Q^^MQ}%
+\gdef\eatcra#1^^MQ{\eatcrb#1Q}%
+\gdef\eatcrb#1Q#2Q{#1}%
+}
+
+% Macro bodies are absorbed as an argument in a context where
+% all characters are catcode 10, 11 or 12, except \ which is active
+% (as in normal texinfo). It is necessary to change the definition of \.
+
+% Non-ASCII encodings make 8-bit characters active, so un-activate
+% them to avoid their expansion.  Must do this non-globally, to
+% confine the change to the current group.
+
+% It's necessary to have hard CRs when the macro is executed. This is
+% done by  making ^^M (\endlinechar) catcode 12 when reading the macro
+% body, and then making it the \newlinechar in \scanmacro.
+
+\def\scanctxt{%
+  \catcode`\"=\other
+  \catcode`\+=\other
+  \catcode`\<=\other
+  \catcode`\>=\other
+  \catcode`\@=\other
+  \catcode`\^=\other
+  \catcode`\_=\other
+  \catcode`\|=\other
+  \catcode`\~=\other
+  \ifx\declaredencoding\ascii \else \setnonasciicharscatcodenonglobal\other \fi
+}
+
+\def\scanargctxt{%
+  \scanctxt
+  \catcode`\\=\other
+  \catcode`\^^M=\other
+}
+
+\def\macrobodyctxt{%
+  \scanctxt
+  \catcode`\{=\other
+  \catcode`\}=\other
+  \catcode`\^^M=\other
+  \usembodybackslash
+}
+
+\def\macroargctxt{%
+  \scanctxt
+  \catcode`\\=\other
+}
+
+% \mbodybackslash is the definition of \ in @macro bodies.
+% It maps \foo\ => \csname macarg.foo\endcsname => #N
+% where N is the macro parameter number.
+% We define \csname macarg.\endcsname to be \realbackslash, so
+% \\ in macro replacement text gets you a backslash.
+
+{\catcode`@=0 @catcode`@\=@active
+ @gdef@usembodybackslash{@let\=@mbodybackslash}
+ @gdef@mbodybackslash#1\{@csname macarg.#1@endcsname}
+}
+\expandafter\def\csname macarg.\endcsname{\realbackslash}
+
+\def\macro{\recursivefalse\parsearg\macroxxx}
+\def\rmacro{\recursivetrue\parsearg\macroxxx}
+
+\def\macroxxx#1{%
+  \getargs{#1}%           now \macname is the macname and \argl the arglist
+  \ifx\argl\empty       % no arguments
+     \paramno=0%
+  \else
+     \expandafter\parsemargdef \argl;%
+  \fi
+  \if1\csname ismacro.\the\macname\endcsname
+     \message{Warning: redefining \the\macname}%
+  \else
+     \expandafter\ifx\csname \the\macname\endcsname \relax
+     \else \errmessage{Macro name \the\macname\space already defined}\fi
+     \global\cslet{macsave.\the\macname}{\the\macname}%
+     \global\expandafter\let\csname ismacro.\the\macname\endcsname=1%
+     \addtomacrolist{\the\macname}%
+  \fi
+  \begingroup \macrobodyctxt
+  \ifrecursive \expandafter\parsermacbody
+  \else \expandafter\parsemacbody
+  \fi}
+
+\parseargdef\unmacro{%
+  \if1\csname ismacro.#1\endcsname
+    \global\cslet{#1}{macsave.#1}%
+    \global\expandafter\let \csname ismacro.#1\endcsname=0%
+    % Remove the macro name from \macrolist:
+    \begingroup
+      \expandafter\let\csname#1\endcsname \relax
+      \let\definedummyword\unmacrodo
+      \xdef\macrolist{\macrolist}%
+    \endgroup
+  \else
+    \errmessage{Macro #1 not defined}%
+  \fi
+}
+
+% Called by \do from \dounmacro on each macro.  The idea is to omit any
+% macro definitions that have been changed to \relax.
+%
+\def\unmacrodo#1{%
+  \ifx #1\relax
+    % remove this
+  \else
+    \noexpand\definedummyword \noexpand#1%
+  \fi
+}
+
+% This makes use of the obscure feature that if the last token of a
+% <parameter list> is #, then the preceding argument is delimited by
+% an opening brace, and that opening brace is not consumed.
+\def\getargs#1{\getargsxxx#1{}}
+\def\getargsxxx#1#{\getmacname #1 \relax\getmacargs}
+\def\getmacname #1 #2\relax{\macname={#1}}
+\def\getmacargs#1{\def\argl{#1}}
+
+% Parse the optional {params} list.  Set up \paramno and \paramlist
+% so \defmacro knows what to do.  Define \macarg.blah for each blah
+% in the params list, to be ##N where N is the position in that list.
+% That gets used by \mbodybackslash (above).
+
+% We need to get `macro parameter char #' into several definitions.
+% The technique used is stolen from LaTeX:  let \hash be something
+% unexpandable, insert that wherever you need a #, and then redefine
+% it to # just before using the token list produced.
+%
+% The same technique is used to protect \eatspaces till just before
+% the macro is used.
+
+\def\parsemargdef#1;{\paramno=0\def\paramlist{}%
+        \let\hash\relax\let\xeatspaces\relax\parsemargdefxxx#1,;,}
+\def\parsemargdefxxx#1,{%
+  \if#1;\let\next=\relax
+  \else \let\next=\parsemargdefxxx
+    \advance\paramno by 1%
+    \expandafter\edef\csname macarg.\eatspaces{#1}\endcsname
+        {\xeatspaces{\hash\the\paramno}}%
+    \edef\paramlist{\paramlist\hash\the\paramno,}%
+  \fi\next}
+
+% These two commands read recursive and nonrecursive macro bodies.
+% (They're different since rec and nonrec macros end differently.)
+
+\long\def\parsemacbody#1@end macro%
+{\xdef\temp{\eatcr{#1}}\endgroup\defmacro}%
+\long\def\parsermacbody#1@end rmacro%
+{\xdef\temp{\eatcr{#1}}\endgroup\defmacro}%
+
+% This defines the macro itself. There are six cases: recursive and
+% nonrecursive macros of zero, one, and many arguments.
+% Much magic with \expandafter here.
+% \xdef is used so that macro definitions will survive the file
+% they're defined in; @include reads the file inside a group.
+\def\defmacro{%
+  \let\hash=##% convert placeholders to macro parameter chars
+  \ifrecursive
+    \ifcase\paramno
+    % 0
+      \expandafter\xdef\csname\the\macname\endcsname{%
+        \noexpand\scanmacro{\temp}}%
+    \or % 1
+      \expandafter\xdef\csname\the\macname\endcsname{%
+         \bgroup\noexpand\macroargctxt
+         \noexpand\braceorline
+         \expandafter\noexpand\csname\the\macname xxx\endcsname}%
+      \expandafter\xdef\csname\the\macname xxx\endcsname##1{%
+         \egroup\noexpand\scanmacro{\temp}}%
+    \else % many
+      \expandafter\xdef\csname\the\macname\endcsname{%
+         \bgroup\noexpand\macroargctxt
+         \noexpand\csname\the\macname xx\endcsname}%
+      \expandafter\xdef\csname\the\macname xx\endcsname##1{%
+          \expandafter\noexpand\csname\the\macname xxx\endcsname ##1,}%
+      \expandafter\expandafter
+      \expandafter\xdef
+      \expandafter\expandafter
+        \csname\the\macname xxx\endcsname
+          \paramlist{\egroup\noexpand\scanmacro{\temp}}%
+    \fi
+  \else
+    \ifcase\paramno
+    % 0
+      \expandafter\xdef\csname\the\macname\endcsname{%
+        \noexpand\norecurse{\the\macname}%
+        \noexpand\scanmacro{\temp}\egroup}%
+    \or % 1
+      \expandafter\xdef\csname\the\macname\endcsname{%
+         \bgroup\noexpand\macroargctxt
+         \noexpand\braceorline
+         \expandafter\noexpand\csname\the\macname xxx\endcsname}%
+      \expandafter\xdef\csname\the\macname xxx\endcsname##1{%
+        \egroup
+        \noexpand\norecurse{\the\macname}%
+        \noexpand\scanmacro{\temp}\egroup}%
+    \else % many
+      \expandafter\xdef\csname\the\macname\endcsname{%
+         \bgroup\noexpand\macroargctxt
+         \expandafter\noexpand\csname\the\macname xx\endcsname}%
+      \expandafter\xdef\csname\the\macname xx\endcsname##1{%
+          \expandafter\noexpand\csname\the\macname xxx\endcsname ##1,}%
+      \expandafter\expandafter
+      \expandafter\xdef
+      \expandafter\expandafter
+      \csname\the\macname xxx\endcsname
+      \paramlist{%
+          \egroup
+          \noexpand\norecurse{\the\macname}%
+          \noexpand\scanmacro{\temp}\egroup}%
+    \fi
+  \fi}
+
+\def\norecurse#1{\bgroup\cslet{#1}{macsave.#1}}
+
+% \braceorline decides whether the next nonwhitespace character is a
+% {.  If so it reads up to the closing }, if not, it reads the whole
+% line.  Whatever was read is then fed to the next control sequence
+% as an argument (by \parsebrace or \parsearg)
+\def\braceorline#1{\let\macnamexxx=#1\futurelet\nchar\braceorlinexxx}
+\def\braceorlinexxx{%
+  \ifx\nchar\bgroup\else
+    \expandafter\parsearg
+  \fi \macnamexxx}
+
+
+% @alias.
+% We need some trickery to remove the optional spaces around the equal
+% sign.  Just make them active and then expand them all to nothing.
+\def\alias{\parseargusing\obeyspaces\aliasxxx}
+\def\aliasxxx #1{\aliasyyy#1\relax}
+\def\aliasyyy #1=#2\relax{%
+  {%
+    \expandafter\let\obeyedspace=\empty
+    \addtomacrolist{#1}%
+    \xdef\next{\global\let\makecsname{#1}=\makecsname{#2}}%
+  }%
+  \next
+}
+
+
+\message{cross references,}
+
+\newwrite\auxfile
+\newif\ifhavexrefs    % True if xref values are known.
+\newif\ifwarnedxrefs  % True if we warned once that they aren't known.
+
+% @inforef is relatively simple.
+\def\inforef #1{\inforefzzz #1,,,,**}
+\def\inforefzzz #1,#2,#3,#4**{\putwordSee{} \putwordInfo{} \putwordfile{} \file{\ignorespaces #3{}},
+  node \samp{\ignorespaces#1{}}}
+
+% @node's only job in TeX is to define \lastnode, which is used in
+% cross-references.  The @node line might or might not have commas, and
+% might or might not have spaces before the first comma, like:
+% @node foo , bar , ...
+% We don't want such trailing spaces in the node name.
+%
+\parseargdef\node{\checkenv{}\donode #1 ,\finishnodeparse}
+%
+% also remove a trailing comma, in case of something like this:
+% @node Help-Cross,  ,  , Cross-refs
+\def\donode#1 ,#2\finishnodeparse{\dodonode #1,\finishnodeparse}
+\def\dodonode#1,#2\finishnodeparse{\gdef\lastnode{#1}}
+
+\let\nwnode=\node
+\let\lastnode=\empty
+
+% Write a cross-reference definition for the current node.  #1 is the
+% type (Ynumbered, Yappendix, Ynothing).
+%
+\def\donoderef#1{%
+  \ifx\lastnode\empty\else
+    \setref{\lastnode}{#1}%
+    \global\let\lastnode=\empty
+  \fi
+}
+
+% @anchor{NAME} -- define xref target at arbitrary point.
+%
+\newcount\savesfregister
+%
+\def\savesf{\relax \ifhmode \savesfregister=\spacefactor \fi}
+\def\restoresf{\relax \ifhmode \spacefactor=\savesfregister \fi}
+\def\anchor#1{\savesf \setref{#1}{Ynothing}\restoresf \ignorespaces}
+
+% \setref{NAME}{SNT} defines a cross-reference point NAME (a node or an
+% anchor), which consists of three parts:
+% 1) NAME-title - the current sectioning name taken from \lastsection,
+%                 or the anchor name.
+% 2) NAME-snt   - section number and type, passed as the SNT arg, or
+%                 empty for anchors.
+% 3) NAME-pg    - the page number.
+%
+% This is called from \donoderef, \anchor, and \dofloat.  In the case of
+% floats, there is an additional part, which is not written here:
+% 4) NAME-lof   - the text as it should appear in a @listoffloats.
+%
+\def\setref#1#2{%
+  \pdfmkdest{#1}%
+  \iflinks
+    {%
+      \atdummies  % preserve commands, but don't expand them
+      \edef\writexrdef##1##2{%
+	\write\auxfile{@xrdef{#1-% #1 of \setref, expanded by the \edef
+	  ##1}{##2}}% these are parameters of \writexrdef
+      }%
+      \toks0 = \expandafter{\lastsection}%
+      \immediate \writexrdef{title}{\the\toks0 }%
+      \immediate \writexrdef{snt}{\csname #2\endcsname}% \Ynumbered etc.
+      \safewhatsit{\writexrdef{pg}{\folio}}% will be written later, during \shipout
+    }%
+  \fi
+}
+
+% @xref, @pxref, and @ref generate cross-references.  For \xrefX, #1 is
+% the node name, #2 the name of the Info cross-reference, #3 the printed
+% node name, #4 the name of the Info file, #5 the name of the printed
+% manual.  All but the node name can be omitted.
+%
+\def\pxref#1{\putwordsee{} \xrefX[#1,,,,,,,]}
+\def\xref#1{\putwordSee{} \xrefX[#1,,,,,,,]}
+\def\ref#1{\xrefX[#1,,,,,,,]}
+\def\xrefX[#1,#2,#3,#4,#5,#6]{\begingroup
+  \unsepspaces
+  \def\printedmanual{\ignorespaces #5}%
+  \def\printedrefname{\ignorespaces #3}%
+  \setbox1=\hbox{\printedmanual\unskip}%
+  \setbox0=\hbox{\printedrefname\unskip}%
+  \ifdim \wd0 = 0pt
+    % No printed node name was explicitly given.
+    \expandafter\ifx\csname SETxref-automatic-section-title\endcsname\relax
+      % Use the node name inside the square brackets.
+      \def\printedrefname{\ignorespaces #1}%
+    \else
+      % Use the actual chapter/section title appear inside
+      % the square brackets.  Use the real section title if we have it.
+      \ifdim \wd1 > 0pt
+        % It is in another manual, so we don't have it.
+        \def\printedrefname{\ignorespaces #1}%
+      \else
+        \ifhavexrefs
+          % We know the real title if we have the xref values.
+          \def\printedrefname{\refx{#1-title}{}}%
+        \else
+          % Otherwise just copy the Info node name.
+          \def\printedrefname{\ignorespaces #1}%
+        \fi%
+      \fi
+    \fi
+  \fi
+  %
+  % Make link in pdf output.
+  \ifpdf
+    \leavevmode
+    \getfilename{#4}%
+    {\indexnofonts
+     \turnoffactive
+     % See comments at \activebackslashdouble.
+     {\activebackslashdouble \xdef\pdfxrefdest{#1}%
+      \backslashparens\pdfxrefdest}%
+     %
+     \ifnum\filenamelength>0
+       \startlink attr{/Border [0 0 0]}%
+         goto file{\the\filename.pdf} name{\pdfxrefdest}%
+     \else
+       \startlink attr{/Border [0 0 0]}%
+         goto name{\pdfmkpgn{\pdfxrefdest}}%
+     \fi
+    }%
+    \setcolor{\linkcolor}%
+  \fi
+  %
+  % Float references are printed completely differently: "Figure 1.2"
+  % instead of "[somenode], p.3".  We distinguish them by the
+  % LABEL-title being set to a magic string.
+  {%
+    % Have to otherify everything special to allow the \csname to
+    % include an _ in the xref name, etc.
+    \indexnofonts
+    \turnoffactive
+    \expandafter\global\expandafter\let\expandafter\Xthisreftitle
+      \csname XR#1-title\endcsname
+  }%
+  \iffloat\Xthisreftitle
+    % If the user specified the print name (third arg) to the ref,
+    % print it instead of our usual "Figure 1.2".
+    \ifdim\wd0 = 0pt
+      \refx{#1-snt}{}%
+    \else
+      \printedrefname
+    \fi
+    %
+    % if the user also gave the printed manual name (fifth arg), append
+    % "in MANUALNAME".
+    \ifdim \wd1 > 0pt
+      \space \putwordin{} \cite{\printedmanual}%
+    \fi
+  \else
+    % node/anchor (non-float) references.
+    %
+    % If we use \unhbox0 and \unhbox1 to print the node names, TeX does not
+    % insert empty discretionaries after hyphens, which means that it will
+    % not find a line break at a hyphen in a node names.  Since some manuals
+    % are best written with fairly long node names, containing hyphens, this
+    % is a loss.  Therefore, we give the text of the node name again, so it
+    % is as if TeX is seeing it for the first time.
+    \ifdim \wd1 > 0pt
+      \putwordSection{} ``\printedrefname'' \putwordin{} \cite{\printedmanual}%
+    \else
+      % _ (for example) has to be the character _ for the purposes of the
+      % control sequence corresponding to the node, but it has to expand
+      % into the usual \leavevmode...\vrule stuff for purposes of
+      % printing. So we \turnoffactive for the \refx-snt, back on for the
+      % printing, back off for the \refx-pg.
+      {\turnoffactive
+       % Only output a following space if the -snt ref is nonempty; for
+       % @unnumbered and @anchor, it won't be.
+       \setbox2 = \hbox{\ignorespaces \refx{#1-snt}{}}%
+       \ifdim \wd2 > 0pt \refx{#1-snt}\space\fi
+      }%
+      % output the `[mynode]' via a macro so it can be overridden.
+      \xrefprintnodename\printedrefname
+      %
+      % But we always want a comma and a space:
+      ,\space
+      %
+      % output the `page 3'.
+      \turnoffactive \putwordpage\tie\refx{#1-pg}{}%
+    \fi
+  \fi
+  \endlink
+\endgroup}
+
+% This macro is called from \xrefX for the `[nodename]' part of xref
+% output.  It's a separate macro only so it can be changed more easily,
+% since square brackets don't work well in some documents.  Particularly
+% one that Bob is working on :).
+%
+\def\xrefprintnodename#1{[#1]}
+
+% Things referred to by \setref.
+%
+\def\Ynothing{}
+\def\Yomitfromtoc{}
+\def\Ynumbered{%
+  \ifnum\secno=0
+    \putwordChapter@tie \the\chapno
+  \else \ifnum\subsecno=0
+    \putwordSection@tie \the\chapno.\the\secno
+  \else \ifnum\subsubsecno=0
+    \putwordSection@tie \the\chapno.\the\secno.\the\subsecno
+  \else
+    \putwordSection@tie \the\chapno.\the\secno.\the\subsecno.\the\subsubsecno
+  \fi\fi\fi
+}
+\def\Yappendix{%
+  \ifnum\secno=0
+     \putwordAppendix@tie @char\the\appendixno{}%
+  \else \ifnum\subsecno=0
+     \putwordSection@tie @char\the\appendixno.\the\secno
+  \else \ifnum\subsubsecno=0
+    \putwordSection@tie @char\the\appendixno.\the\secno.\the\subsecno
+  \else
+    \putwordSection@tie
+      @char\the\appendixno.\the\secno.\the\subsecno.\the\subsubsecno
+  \fi\fi\fi
+}
+
+% Define \refx{NAME}{SUFFIX} to reference a cross-reference string named NAME.
+% If its value is nonempty, SUFFIX is output afterward.
+%
+\def\refx#1#2{%
+  {%
+    \indexnofonts
+    \otherbackslash
+    \expandafter\global\expandafter\let\expandafter\thisrefX
+      \csname XR#1\endcsname
+  }%
+  \ifx\thisrefX\relax
+    % If not defined, say something at least.
+    \angleleft un\-de\-fined\angleright
+    \iflinks
+      \ifhavexrefs
+        \message{\linenumber Undefined cross reference `#1'.}%
+      \else
+        \ifwarnedxrefs\else
+          \global\warnedxrefstrue
+          \message{Cross reference values unknown; you must run TeX again.}%
+        \fi
+      \fi
+    \fi
+  \else
+    % It's defined, so just use it.
+    \thisrefX
+  \fi
+  #2% Output the suffix in any case.
+}
+
+% This is the macro invoked by entries in the aux file.  Usually it's
+% just a \def (we prepend XR to the control sequence name to avoid
+% collisions).  But if this is a float type, we have more work to do.
+%
+\def\xrdef#1#2{%
+  {% The node name might contain 8-bit characters, which in our current
+   % implementation are changed to commands like @'e.  Don't let these
+   % mess up the control sequence name.
+    \indexnofonts
+    \turnoffactive
+    \xdef\safexrefname{#1}%
+  }%
+  %
+  \expandafter\gdef\csname XR\safexrefname\endcsname{#2}% remember this xref
+  %
+  % Was that xref control sequence that we just defined for a float?
+  \expandafter\iffloat\csname XR\safexrefname\endcsname
+    % it was a float, and we have the (safe) float type in \iffloattype.
+    \expandafter\let\expandafter\floatlist
+      \csname floatlist\iffloattype\endcsname
+    %
+    % Is this the first time we've seen this float type?
+    \expandafter\ifx\floatlist\relax
+      \toks0 = {\do}% yes, so just \do
+    \else
+      % had it before, so preserve previous elements in list.
+      \toks0 = \expandafter{\floatlist\do}%
+    \fi
+    %
+    % Remember this xref in the control sequence \floatlistFLOATTYPE,
+    % for later use in \listoffloats.
+    \expandafter\xdef\csname floatlist\iffloattype\endcsname{\the\toks0
+      {\safexrefname}}%
+  \fi
+}
+
+% Read the last existing aux file, if any.  No error if none exists.
+%
+\def\tryauxfile{%
+  \openin 1 \jobname.aux
+  \ifeof 1 \else
+    \readdatafile{aux}%
+    \global\havexrefstrue
+  \fi
+  \closein 1
+}
+
+\def\setupdatafile{%
+  \catcode`\^^@=\other
+  \catcode`\^^A=\other
+  \catcode`\^^B=\other
+  \catcode`\^^C=\other
+  \catcode`\^^D=\other
+  \catcode`\^^E=\other
+  \catcode`\^^F=\other
+  \catcode`\^^G=\other
+  \catcode`\^^H=\other
+  \catcode`\^^K=\other
+  \catcode`\^^L=\other
+  \catcode`\^^N=\other
+  \catcode`\^^P=\other
+  \catcode`\^^Q=\other
+  \catcode`\^^R=\other
+  \catcode`\^^S=\other
+  \catcode`\^^T=\other
+  \catcode`\^^U=\other
+  \catcode`\^^V=\other
+  \catcode`\^^W=\other
+  \catcode`\^^X=\other
+  \catcode`\^^Z=\other
+  \catcode`\^^[=\other
+  \catcode`\^^\=\other
+  \catcode`\^^]=\other
+  \catcode`\^^^=\other
+  \catcode`\^^_=\other
+  % It was suggested to set the catcode of ^ to 7, which would allow ^^e4 etc.
+  % in xref tags, i.e., node names.  But since ^^e4 notation isn't
+  % supported in the main text, it doesn't seem desirable.  Furthermore,
+  % that is not enough: for node names that actually contain a ^
+  % character, we would end up writing a line like this: 'xrdef {'hat
+  % b-title}{'hat b} and \xrdef does a \csname...\endcsname on the first
+  % argument, and \hat is not an expandable control sequence.  It could
+  % all be worked out, but why?  Either we support ^^ or we don't.
+  %
+  % The other change necessary for this was to define \auxhat:
+  % \def\auxhat{\def^{'hat }}% extra space so ok if followed by letter
+  % and then to call \auxhat in \setq.
+  %
+  \catcode`\^=\other
+  %
+  % Special characters.  Should be turned off anyway, but...
+  \catcode`\~=\other
+  \catcode`\[=\other
+  \catcode`\]=\other
+  \catcode`\"=\other
+  \catcode`\_=\other
+  \catcode`\|=\other
+  \catcode`\<=\other
+  \catcode`\>=\other
+  \catcode`\$=\other
+  \catcode`\#=\other
+  \catcode`\&=\other
+  \catcode`\%=\other
+  \catcode`+=\other % avoid \+ for paranoia even though we've turned it off
+  %
+  % This is to support \ in node names and titles, since the \
+  % characters end up in a \csname.  It's easier than
+  % leaving it active and making its active definition an actual \
+  % character.  What I don't understand is why it works in the *value*
+  % of the xrdef.  Seems like it should be a catcode12 \, and that
+  % should not typeset properly.  But it works, so I'm moving on for
+  % now.  --karl, 15jan04.
+  \catcode`\\=\other
+  %
+  % Make the characters 128-255 be printing characters.
+  {%
+    \count1=128
+    \def\loop{%
+      \catcode\count1=\other
+      \advance\count1 by 1
+      \ifnum \count1<256 \loop \fi
+    }%
+  }%
+  %
+  % @ is our escape character in .aux files, and we need braces.
+  \catcode`\{=1
+  \catcode`\}=2
+  \catcode`\@=0
+}
+
+\def\readdatafile#1{%
+\begingroup
+  \setupdatafile
+  \input\jobname.#1
+\endgroup}
+
+
+\message{insertions,}
+% including footnotes.
+
+\newcount \footnoteno
+
+% The trailing space in the following definition for supereject is
+% vital for proper filling; pages come out unaligned when you do a
+% pagealignmacro call if that space before the closing brace is
+% removed. (Generally, numeric constants should always be followed by a
+% space to prevent strange expansion errors.)
+\def\supereject{\par\penalty -20000\footnoteno =0 }
+
+% @footnotestyle is meaningful for info output only.
+\let\footnotestyle=\comment
+
+{\catcode `\@=11
+%
+% Auto-number footnotes.  Otherwise like plain.
+\gdef\footnote{%
+  \let\indent=\ptexindent
+  \let\noindent=\ptexnoindent
+  \global\advance\footnoteno by \@ne
+  \edef\thisfootno{$^{\the\footnoteno}$}%
+  %
+  % In case the footnote comes at the end of a sentence, preserve the
+  % extra spacing after we do the footnote number.
+  \let\@sf\empty
+  \ifhmode\edef\@sf{\spacefactor\the\spacefactor}\ptexslash\fi
+  %
+  % Remove inadvertent blank space before typesetting the footnote number.
+  \unskip
+  \thisfootno\@sf
+  \dofootnote
+}%
+
+% Don't bother with the trickery in plain.tex to not require the
+% footnote text as a parameter.  Our footnotes don't need to be so general.
+%
+% Oh yes, they do; otherwise, @ifset (and anything else that uses
+% \parseargline) fails inside footnotes because the tokens are fixed when
+% the footnote is read.  --karl, 16nov96.
+%
+\gdef\dofootnote{%
+  \insert\footins\bgroup
+  % We want to typeset this text as a normal paragraph, even if the
+  % footnote reference occurs in (for example) a display environment.
+  % So reset some parameters.
+  \hsize=\pagewidth
+  \interlinepenalty\interfootnotelinepenalty
+  \splittopskip\ht\strutbox % top baseline for broken footnotes
+  \splitmaxdepth\dp\strutbox
+  \floatingpenalty\@MM
+  \leftskip\z@skip
+  \rightskip\z@skip
+  \spaceskip\z@skip
+  \xspaceskip\z@skip
+  \parindent\defaultparindent
+  %
+  \smallfonts \rm
+  %
+  % Because we use hanging indentation in footnotes, a @noindent appears
+  % to exdent this text, so make it be a no-op.  makeinfo does not use
+  % hanging indentation so @noindent can still be needed within footnote
+  % text after an @example or the like (not that this is good style).
+  \let\noindent = \relax
+  %
+  % Hang the footnote text off the number.  Use \everypar in case the
+  % footnote extends for more than one paragraph.
+  \everypar = {\hang}%
+  \textindent{\thisfootno}%
+  %
+  % Don't crash into the line above the footnote text.  Since this
+  % expands into a box, it must come within the paragraph, lest it
+  % provide a place where TeX can split the footnote.
+  \footstrut
+  \futurelet\next\fo@t
+}
+}%end \catcode `\@=11
+
+% In case a @footnote appears in a vbox, save the footnote text and create
+% the real \insert just after the vbox finished.  Otherwise, the insertion
+% would be lost.
+% Similarily, if a @footnote appears inside an alignment, save the footnote
+% text to a box and make the \insert when a row of the table is finished.
+% And the same can be done for other insert classes.  --kasal, 16nov03.
+
+% Replace the \insert primitive by a cheating macro.
+% Deeper inside, just make sure that the saved insertions are not spilled
+% out prematurely.
+%
+\def\startsavinginserts{%
+  \ifx \insert\ptexinsert
+    \let\insert\saveinsert
+  \else
+    \let\checkinserts\relax
+  \fi
+}
+
+% This \insert replacement works for both \insert\footins{foo} and
+% \insert\footins\bgroup foo\egroup, but it doesn't work for \insert27{foo}.
+%
+\def\saveinsert#1{%
+  \edef\next{\noexpand\savetobox \makeSAVEname#1}%
+  \afterassignment\next
+  % swallow the left brace
+  \let\temp =
+}
+\def\makeSAVEname#1{\makecsname{SAVE\expandafter\gobble\string#1}}
+\def\savetobox#1{\global\setbox#1 = \vbox\bgroup \unvbox#1}
+
+\def\checksaveins#1{\ifvoid#1\else \placesaveins#1\fi}
+
+\def\placesaveins#1{%
+  \ptexinsert \csname\expandafter\gobblesave\string#1\endcsname
+    {\box#1}%
+}
+
+% eat @SAVE -- beware, all of them have catcode \other:
+{
+  \def\dospecials{\do S\do A\do V\do E} \uncatcodespecials  %  ;-)
+  \gdef\gobblesave @SAVE{}
+}
+
+% initialization:
+\def\newsaveins #1{%
+  \edef\next{\noexpand\newsaveinsX \makeSAVEname#1}%
+  \next
+}
+\def\newsaveinsX #1{%
+  \csname newbox\endcsname #1%
+  \expandafter\def\expandafter\checkinserts\expandafter{\checkinserts
+    \checksaveins #1}%
+}
+
+% initialize:
+\let\checkinserts\empty
+\newsaveins\footins
+\newsaveins\margin
+
+
+% @image.  We use the macros from epsf.tex to support this.
+% If epsf.tex is not installed and @image is used, we complain.
+%
+% Check for and read epsf.tex up front.  If we read it only at @image
+% time, we might be inside a group, and then its definitions would get
+% undone and the next image would fail.
+\openin 1 = epsf.tex
+\ifeof 1 \else
+  % Do not bother showing banner with epsf.tex v2.7k (available in
+  % doc/epsf.tex and on ctan).
+  \def\epsfannounce{\toks0 = }%
+  \input epsf.tex
+\fi
+\closein 1
+%
+% We will only complain once about lack of epsf.tex.
+\newif\ifwarnednoepsf
+\newhelp\noepsfhelp{epsf.tex must be installed for images to
+  work.  It is also included in the Texinfo distribution, or you can get
+  it from ftp://tug.org/tex/epsf.tex.}
+%
+\def\image#1{%
+  \ifx\epsfbox\undefined
+    \ifwarnednoepsf \else
+      \errhelp = \noepsfhelp
+      \errmessage{epsf.tex not found, images will be ignored}%
+      \global\warnednoepsftrue
+    \fi
+  \else
+    \imagexxx #1,,,,,\finish
+  \fi
+}
+%
+% Arguments to @image:
+% #1 is (mandatory) image filename; we tack on .eps extension.
+% #2 is (optional) width, #3 is (optional) height.
+% #4 is (ignored optional) html alt text.
+% #5 is (ignored optional) extension.
+% #6 is just the usual extra ignored arg for parsing this stuff.
+\newif\ifimagevmode
+\def\imagexxx#1,#2,#3,#4,#5,#6\finish{\begingroup
+  \catcode`\^^M = 5     % in case we're inside an example
+  \normalturnoffactive  % allow _ et al. in names
+  % If the image is by itself, center it.
+  \ifvmode
+    \imagevmodetrue
+    \nobreak\bigskip
+    % Usually we'll have text after the image which will insert
+    % \parskip glue, so insert it here too to equalize the space
+    % above and below.
+    \nobreak\vskip\parskip
+    \nobreak
+    \line\bgroup
+  \fi
+  %
+  % Output the image.
+  \ifpdf
+    \dopdfimage{#1}{#2}{#3}%
+  \else
+    % \epsfbox itself resets \epsf?size at each figure.
+    \setbox0 = \hbox{\ignorespaces #2}\ifdim\wd0 > 0pt \epsfxsize=#2\relax \fi
+    \setbox0 = \hbox{\ignorespaces #3}\ifdim\wd0 > 0pt \epsfysize=#3\relax \fi
+    \epsfbox{#1.eps}%
+  \fi
+  %
+  \ifimagevmode \egroup \bigbreak \fi  % space after the image
+\endgroup}
+
+
+% @float FLOATTYPE,LABEL,LOC ... @end float for displayed figures, tables,
+% etc.  We don't actually implement floating yet, we always include the
+% float "here".  But it seemed the best name for the future.
+%
+\envparseargdef\float{\eatcommaspace\eatcommaspace\dofloat#1, , ,\finish}
+
+% There may be a space before second and/or third parameter; delete it.
+\def\eatcommaspace#1, {#1,}
+
+% #1 is the optional FLOATTYPE, the text label for this float, typically
+% "Figure", "Table", "Example", etc.  Can't contain commas.  If omitted,
+% this float will not be numbered and cannot be referred to.
+%
+% #2 is the optional xref label.  Also must be present for the float to
+% be referable.
+%
+% #3 is the optional positioning argument; for now, it is ignored.  It
+% will somehow specify the positions allowed to float to (here, top, bottom).
+%
+% We keep a separate counter for each FLOATTYPE, which we reset at each
+% chapter-level command.
+\let\resetallfloatnos=\empty
+%
+\def\dofloat#1,#2,#3,#4\finish{%
+  \let\thiscaption=\empty
+  \let\thisshortcaption=\empty
+  %
+  % don't lose footnotes inside @float.
+  %
+  % BEWARE: when the floats start float, we have to issue warning whenever an
+  % insert appears inside a float which could possibly float. --kasal, 26may04
+  %
+  \startsavinginserts
+  %
+  % We can't be used inside a paragraph.
+  \par
+  %
+  \vtop\bgroup
+    \def\floattype{#1}%
+    \def\floatlabel{#2}%
+    \def\floatloc{#3}% we do nothing with this yet.
+    %
+    \ifx\floattype\empty
+      \let\safefloattype=\empty
+    \else
+      {%
+        % the floattype might have accents or other special characters,
+        % but we need to use it in a control sequence name.
+        \indexnofonts
+        \turnoffactive
+        \xdef\safefloattype{\floattype}%
+      }%
+    \fi
+    %
+    % If label is given but no type, we handle that as the empty type.
+    \ifx\floatlabel\empty \else
+      % We want each FLOATTYPE to be numbered separately (Figure 1,
+      % Table 1, Figure 2, ...).  (And if no label, no number.)
+      %
+      \expandafter\getfloatno\csname\safefloattype floatno\endcsname
+      \global\advance\floatno by 1
+      %
+      {%
+        % This magic value for \lastsection is output by \setref as the
+        % XREFLABEL-title value.  \xrefX uses it to distinguish float
+        % labels (which have a completely different output format) from
+        % node and anchor labels.  And \xrdef uses it to construct the
+        % lists of floats.
+        %
+        \edef\lastsection{\floatmagic=\safefloattype}%
+        \setref{\floatlabel}{Yfloat}%
+      }%
+    \fi
+    %
+    % start with \parskip glue, I guess.
+    \vskip\parskip
+    %
+    % Don't suppress indentation if a float happens to start a section.
+    \restorefirstparagraphindent
+}
+
+% we have these possibilities:
+% @float Foo,lbl & @caption{Cap}: Foo 1.1: Cap
+% @float Foo,lbl & no caption:    Foo 1.1
+% @float Foo & @caption{Cap}:     Foo: Cap
+% @float Foo & no caption:        Foo
+% @float ,lbl & Caption{Cap}:     1.1: Cap
+% @float ,lbl & no caption:       1.1
+% @float & @caption{Cap}:         Cap
+% @float & no caption:
+%
+\def\Efloat{%
+    \let\floatident = \empty
+    %
+    % In all cases, if we have a float type, it comes first.
+    \ifx\floattype\empty \else \def\floatident{\floattype}\fi
+    %
+    % If we have an xref label, the number comes next.
+    \ifx\floatlabel\empty \else
+      \ifx\floattype\empty \else % if also had float type, need tie first.
+        \appendtomacro\floatident{\tie}%
+      \fi
+      % the number.
+      \appendtomacro\floatident{\chaplevelprefix\the\floatno}%
+    \fi
+    %
+    % Start the printed caption with what we've constructed in
+    % \floatident, but keep it separate; we need \floatident again.
+    \let\captionline = \floatident
+    %
+    \ifx\thiscaption\empty \else
+      \ifx\floatident\empty \else
+	\appendtomacro\captionline{: }% had ident, so need a colon between
+      \fi
+      %
+      % caption text.
+      \appendtomacro\captionline{\scanexp\thiscaption}%
+    \fi
+    %
+    % If we have anything to print, print it, with space before.
+    % Eventually this needs to become an \insert.
+    \ifx\captionline\empty \else
+      \vskip.5\parskip
+      \captionline
+      %
+      % Space below caption.
+      \vskip\parskip
+    \fi
+    %
+    % If have an xref label, write the list of floats info.  Do this
+    % after the caption, to avoid chance of it being a breakpoint.
+    \ifx\floatlabel\empty \else
+      % Write the text that goes in the lof to the aux file as
+      % \floatlabel-lof.  Besides \floatident, we include the short
+      % caption if specified, else the full caption if specified, else nothing.
+      {%
+        \atdummies
+        %
+        % since we read the caption text in the macro world, where ^^M
+        % is turned into a normal character, we have to scan it back, so
+        % we don't write the literal three characters "^^M" into the aux file.
+	\scanexp{%
+	  \xdef\noexpand\gtemp{%
+	    \ifx\thisshortcaption\empty
+	      \thiscaption
+	    \else
+	      \thisshortcaption
+	    \fi
+	  }%
+	}%
+        \immediate\write\auxfile{@xrdef{\floatlabel-lof}{\floatident
+	  \ifx\gtemp\empty \else : \gtemp \fi}}%
+      }%
+    \fi
+  \egroup  % end of \vtop
+  %
+  % place the captured inserts
+  %
+  % BEWARE: when the floats start floating, we have to issue warning
+  % whenever an insert appears inside a float which could possibly
+  % float. --kasal, 26may04
+  %
+  \checkinserts
+}
+
+% Append the tokens #2 to the definition of macro #1, not expanding either.
+%
+\def\appendtomacro#1#2{%
+  \expandafter\def\expandafter#1\expandafter{#1#2}%
+}
+
+% @caption, @shortcaption
+%
+\def\caption{\docaption\thiscaption}
+\def\shortcaption{\docaption\thisshortcaption}
+\def\docaption{\checkenv\float \bgroup\scanargctxt\defcaption}
+\def\defcaption#1#2{\egroup \def#1{#2}}
+
+% The parameter is the control sequence identifying the counter we are
+% going to use.  Create it if it doesn't exist and assign it to \floatno.
+\def\getfloatno#1{%
+  \ifx#1\relax
+      % Haven't seen this figure type before.
+      \csname newcount\endcsname #1%
+      %
+      % Remember to reset this floatno at the next chap.
+      \expandafter\gdef\expandafter\resetallfloatnos
+        \expandafter{\resetallfloatnos #1=0 }%
+  \fi
+  \let\floatno#1%
+}
+
+% \setref calls this to get the XREFLABEL-snt value.  We want an @xref
+% to the FLOATLABEL to expand to "Figure 3.1".  We call \setref when we
+% first read the @float command.
+%
+\def\Yfloat{\floattype@tie \chaplevelprefix\the\floatno}%
+
+% Magic string used for the XREFLABEL-title value, so \xrefX can
+% distinguish floats from other xref types.
+\def\floatmagic{!!float!!}
+
+% #1 is the control sequence we are passed; we expand into a conditional
+% which is true if #1 represents a float ref.  That is, the magic
+% \lastsection value which we \setref above.
+%
+\def\iffloat#1{\expandafter\doiffloat#1==\finish}
+%
+% #1 is (maybe) the \floatmagic string.  If so, #2 will be the
+% (safe) float type for this float.  We set \iffloattype to #2.
+%
+\def\doiffloat#1=#2=#3\finish{%
+  \def\temp{#1}%
+  \def\iffloattype{#2}%
+  \ifx\temp\floatmagic
+}
+
+% @listoffloats FLOATTYPE - print a list of floats like a table of contents.
+%
+\parseargdef\listoffloats{%
+  \def\floattype{#1}% floattype
+  {%
+    % the floattype might have accents or other special characters,
+    % but we need to use it in a control sequence name.
+    \indexnofonts
+    \turnoffactive
+    \xdef\safefloattype{\floattype}%
+  }%
+  %
+  % \xrdef saves the floats as a \do-list in \floatlistSAFEFLOATTYPE.
+  \expandafter\ifx\csname floatlist\safefloattype\endcsname \relax
+    \ifhavexrefs
+      % if the user said @listoffloats foo but never @float foo.
+      \message{\linenumber No `\safefloattype' floats to list.}%
+    \fi
+  \else
+    \begingroup
+      \leftskip=\tocindent  % indent these entries like a toc
+      \let\do=\listoffloatsdo
+      \csname floatlist\safefloattype\endcsname
+    \endgroup
+  \fi
+}
+
+% This is called on each entry in a list of floats.  We're passed the
+% xref label, in the form LABEL-title, which is how we save it in the
+% aux file.  We strip off the -title and look up \XRLABEL-lof, which
+% has the text we're supposed to typeset here.
+%
+% Figures without xref labels will not be included in the list (since
+% they won't appear in the aux file).
+%
+\def\listoffloatsdo#1{\listoffloatsdoentry#1\finish}
+\def\listoffloatsdoentry#1-title\finish{{%
+  % Can't fully expand XR#1-lof because it can contain anything.  Just
+  % pass the control sequence.  On the other hand, XR#1-pg is just the
+  % page number, and we want to fully expand that so we can get a link
+  % in pdf output.
+  \toksA = \expandafter{\csname XR#1-lof\endcsname}%
+  %
+  % use the same \entry macro we use to generate the TOC and index.
+  \edef\writeentry{\noexpand\entry{\the\toksA}{\csname XR#1-pg\endcsname}}%
+  \writeentry
+}}
+
+
+\message{localization,}
+
+% @documentlanguage is usually given very early, just after
+% @setfilename.  If done too late, it may not override everything
+% properly.  Single argument is the language (de) or locale (de_DE)
+% abbreviation.  It would be nice if we could set up a hyphenation file.
+%
+{
+  \catcode`\_ = \active
+  \globaldefs=1
+\parseargdef\documentlanguage{\begingroup
+  \let_=\normalunderscore  % normal _ character for filenames
+  \tex % read txi-??.tex file in plain TeX.
+    % Read the file by the name they passed if it exists.
+    \openin 1 txi-#1.tex
+    \ifeof 1
+      \documentlanguagetrywithoutunderscore{#1_\finish}%
+    \else
+      \input txi-#1.tex
+    \fi
+    \closein 1
+  \endgroup
+\endgroup}
+}
+%
+% If they passed de_DE, and txi-de_DE.tex doesn't exist,
+% try txi-de.tex.
+% 
+\def\documentlanguagetrywithoutunderscore#1_#2\finish{%
+  \openin 1 txi-#1.tex
+  \ifeof 1
+    \errhelp = \nolanghelp
+    \errmessage{Cannot read language file txi-#1.tex}%
+  \else
+    \input txi-#1.tex
+  \fi
+  \closein 1
+}
+%
+\newhelp\nolanghelp{The given language definition file cannot be found or
+is empty.  Maybe you need to install it?  In the current directory
+should work if nowhere else does.}
+
+% Set the catcode of characters 128 through 255 to the specified number.
+%
+\def\setnonasciicharscatcode#1{%
+   \count255=128
+   \loop\ifnum\count255<256
+      \global\catcode\count255=#1\relax
+      \advance\count255 by 1
+   \repeat
+}
+
+\def\setnonasciicharscatcodenonglobal#1{%
+   \count255=128
+   \loop\ifnum\count255<256
+      \catcode\count255=#1\relax
+      \advance\count255 by 1
+   \repeat
+}
+
+% @documentencoding sets the definition of non-ASCII characters
+% according to the specified encoding.
+%
+\parseargdef\documentencoding{%
+  % Encoding being declared for the document.
+  \def\declaredencoding{\csname #1.enc\endcsname}%
+  %
+  % Supported encodings: names converted to tokens in order to be able
+  % to compare them with \ifx.
+  \def\ascii{\csname US-ASCII.enc\endcsname}%
+  \def\latnine{\csname ISO-8859-15.enc\endcsname}%
+  \def\latone{\csname ISO-8859-1.enc\endcsname}%
+  \def\lattwo{\csname ISO-8859-2.enc\endcsname}%
+  \def\utfeight{\csname UTF-8.enc\endcsname}%
+  %
+  \ifx \declaredencoding \ascii
+     \asciichardefs
+  %
+  \else \ifx \declaredencoding \lattwo
+     \setnonasciicharscatcode\active
+     \lattwochardefs
+  %
+  \else \ifx \declaredencoding \latone 
+     \setnonasciicharscatcode\active
+     \latonechardefs
+  %
+  \else \ifx \declaredencoding \latnine
+     \setnonasciicharscatcode\active
+     \latninechardefs
+  %
+  \else \ifx \declaredencoding \utfeight
+     \setnonasciicharscatcode\active
+     \utfeightchardefs
+  %
+  \else 
+    \message{Unknown document encoding #1, ignoring.}%
+  %
+  \fi % utfeight
+  \fi % latnine
+  \fi % latone
+  \fi % lattwo
+  \fi % ascii
+}
+
+% A message to be logged when using a character that isn't available
+% the default font encoding (OT1).
+% 
+\def\missingcharmsg#1{\message{Character missing in OT1 encoding: #1.}}
+
+% Take account of \c (plain) vs. \, (Texinfo) difference.
+\def\cedilla#1{\ifx\c\ptexc\c{#1}\else\,{#1}\fi}
+
+% First, make active non-ASCII characters in order for them to be
+% correctly categorized when TeX reads the replacement text of
+% macros containing the character definitions.
+\setnonasciicharscatcode\active
+%
+% Latin1 (ISO-8859-1) character definitions.
+\def\latonechardefs{%
+  \gdef^^a0{~} 
+  \gdef^^a1{\exclamdown}
+  \gdef^^a2{\missingcharmsg{CENT SIGN}} 
+  \gdef^^a3{{\pounds}}
+  \gdef^^a4{\missingcharmsg{CURRENCY SIGN}}
+  \gdef^^a5{\missingcharmsg{YEN SIGN}}
+  \gdef^^a6{\missingcharmsg{BROKEN BAR}} 
+  \gdef^^a7{\S}
+  \gdef^^a8{\"{}} 
+  \gdef^^a9{\copyright} 
+  \gdef^^aa{\ordf}
+  \gdef^^ab{\missingcharmsg{LEFT-POINTING DOUBLE ANGLE QUOTATION MARK}} 
+  \gdef^^ac{$\lnot$}
+  \gdef^^ad{\-} 
+  \gdef^^ae{\registeredsymbol} 
+  \gdef^^af{\={}}
+  %
+  \gdef^^b0{\textdegree}
+  \gdef^^b1{$\pm$}
+  \gdef^^b2{$^2$}
+  \gdef^^b3{$^3$}
+  \gdef^^b4{\'{}}
+  \gdef^^b5{$\mu$}
+  \gdef^^b6{\P}
+  %
+  \gdef^^b7{$^.$}
+  \gdef^^b8{\cedilla\ }
+  \gdef^^b9{$^1$}
+  \gdef^^ba{\ordm}
+  %
+  \gdef^^bb{\missingcharmsg{RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK}}
+  \gdef^^bc{$1\over4$}
+  \gdef^^bd{$1\over2$}
+  \gdef^^be{$3\over4$}
+  \gdef^^bf{\questiondown}
+  %
+  \gdef^^c0{\`A}
+  \gdef^^c1{\'A}
+  \gdef^^c2{\^A}
+  \gdef^^c3{\~A}
+  \gdef^^c4{\"A}
+  \gdef^^c5{\ringaccent A} 
+  \gdef^^c6{\AE}
+  \gdef^^c7{\cedilla C}
+  \gdef^^c8{\`E}
+  \gdef^^c9{\'E}
+  \gdef^^ca{\^E}
+  \gdef^^cb{\"E}
+  \gdef^^cc{\`I}
+  \gdef^^cd{\'I}
+  \gdef^^ce{\^I}
+  \gdef^^cf{\"I}
+  %
+  \gdef^^d0{\missingcharmsg{LATIN CAPITAL LETTER ETH}}
+  \gdef^^d1{\~N}
+  \gdef^^d2{\`O}
+  \gdef^^d3{\'O}
+  \gdef^^d4{\^O}
+  \gdef^^d5{\~O}
+  \gdef^^d6{\"O}
+  \gdef^^d7{$\times$}
+  \gdef^^d8{\O}
+  \gdef^^d9{\`U}
+  \gdef^^da{\'U}
+  \gdef^^db{\^U}
+  \gdef^^dc{\"U}
+  \gdef^^dd{\'Y}
+  \gdef^^de{\missingcharmsg{LATIN CAPITAL LETTER THORN}}
+  \gdef^^df{\ss}
+  %
+  \gdef^^e0{\`a}
+  \gdef^^e1{\'a}
+  \gdef^^e2{\^a}
+  \gdef^^e3{\~a}
+  \gdef^^e4{\"a}
+  \gdef^^e5{\ringaccent a}
+  \gdef^^e6{\ae}
+  \gdef^^e7{\cedilla c}
+  \gdef^^e8{\`e}
+  \gdef^^e9{\'e}
+  \gdef^^ea{\^e}
+  \gdef^^eb{\"e}
+  \gdef^^ec{\`{\dotless i}}
+  \gdef^^ed{\'{\dotless i}}
+  \gdef^^ee{\^{\dotless i}}
+  \gdef^^ef{\"{\dotless i}}
+  %
+  \gdef^^f0{\missingcharmsg{LATIN SMALL LETTER ETH}}
+  \gdef^^f1{\~n}
+  \gdef^^f2{\`o}
+  \gdef^^f3{\'o}
+  \gdef^^f4{\^o}
+  \gdef^^f5{\~o}
+  \gdef^^f6{\"o}
+  \gdef^^f7{$\div$}
+  \gdef^^f8{\o}
+  \gdef^^f9{\`u}
+  \gdef^^fa{\'u}
+  \gdef^^fb{\^u}
+  \gdef^^fc{\"u}
+  \gdef^^fd{\'y}
+  \gdef^^fe{\missingcharmsg{LATIN SMALL LETTER THORN}}
+  \gdef^^ff{\"y}
+}
+
+% Latin9 (ISO-8859-15) encoding character definitions.
+\def\latninechardefs{%
+  % Encoding is almost identical to Latin1.
+  \latonechardefs
+  %
+  \gdef^^a4{\euro}
+  \gdef^^a6{\v S}
+  \gdef^^a8{\v s}
+  \gdef^^b4{\v Z}
+  \gdef^^b8{\v z}
+  \gdef^^bc{\OE}
+  \gdef^^bd{\oe}
+  \gdef^^be{\"Y}
+}
+
+% Latin2 (ISO-8859-2) character definitions.
+\def\lattwochardefs{%
+  \gdef^^a0{~}
+  \gdef^^a1{\missingcharmsg{LATIN CAPITAL LETTER A WITH OGONEK}}
+  \gdef^^a2{\u{}}
+  \gdef^^a3{\L}
+  \gdef^^a4{\missingcharmsg{CURRENCY SIGN}}
+  \gdef^^a5{\v L}
+  \gdef^^a6{\'S}
+  \gdef^^a7{\S}
+  \gdef^^a8{\"{}}
+  \gdef^^a9{\v S}
+  \gdef^^aa{\cedilla S}
+  \gdef^^ab{\v T}
+  \gdef^^ac{\'Z}
+  \gdef^^ad{\-}
+  \gdef^^ae{\v Z}
+  \gdef^^af{\dotaccent Z}
+  %
+  \gdef^^b0{\textdegree}
+  \gdef^^b1{\missingcharmsg{LATIN SMALL LETTER A WITH OGONEK}}
+  \gdef^^b2{\missingcharmsg{OGONEK}}
+  \gdef^^b3{\l}
+  \gdef^^b4{\'{}}
+  \gdef^^b5{\v l}
+  \gdef^^b6{\'s}
+  \gdef^^b7{\v{}}
+  \gdef^^b8{\cedilla\ }
+  \gdef^^b9{\v s}
+  \gdef^^ba{\cedilla s}
+  \gdef^^bb{\v t}
+  \gdef^^bc{\'z}
+  \gdef^^bd{\H{}}
+  \gdef^^be{\v z}
+  \gdef^^bf{\dotaccent z}
+  %
+  \gdef^^c0{\'R}
+  \gdef^^c1{\'A}
+  \gdef^^c2{\^A}
+  \gdef^^c3{\u A}
+  \gdef^^c4{\"A}
+  \gdef^^c5{\'L}
+  \gdef^^c6{\'C}
+  \gdef^^c7{\cedilla C}
+  \gdef^^c8{\v C}
+  \gdef^^c9{\'E}
+  \gdef^^ca{\missingcharmsg{LATIN CAPITAL LETTER E WITH OGONEK}}
+  \gdef^^cb{\"E}
+  \gdef^^cc{\v E}
+  \gdef^^cd{\'I}
+  \gdef^^ce{\^I}
+  \gdef^^cf{\v D}
+  %
+  \gdef^^d0{\missingcharmsg{LATIN CAPITAL LETTER D WITH STROKE}}
+  \gdef^^d1{\'N}
+  \gdef^^d2{\v N}
+  \gdef^^d3{\'O}
+  \gdef^^d4{\^O}
+  \gdef^^d5{\H O}
+  \gdef^^d6{\"O}
+  \gdef^^d7{$\times$}
+  \gdef^^d8{\v R}
+  \gdef^^d9{\ringaccent U} 
+  \gdef^^da{\'U}
+  \gdef^^db{\H U}
+  \gdef^^dc{\"U}
+  \gdef^^dd{\'Y}
+  \gdef^^de{\cedilla T}
+  \gdef^^df{\ss}
+  %
+  \gdef^^e0{\'r}
+  \gdef^^e1{\'a}
+  \gdef^^e2{\^a}
+  \gdef^^e3{\u a}
+  \gdef^^e4{\"a}
+  \gdef^^e5{\'l}
+  \gdef^^e6{\'c}
+  \gdef^^e7{\cedilla c}
+  \gdef^^e8{\v c}
+  \gdef^^e9{\'e}
+  \gdef^^ea{\missingcharmsg{LATIN SMALL LETTER E WITH OGONEK}}
+  \gdef^^eb{\"e}
+  \gdef^^ec{\v e}
+  \gdef^^ed{\'\i}
+  \gdef^^ee{\^\i}
+  \gdef^^ef{\v d}
+  %
+  \gdef^^f0{\missingcharmsg{LATIN SMALL LETTER D WITH STROKE}}
+  \gdef^^f1{\'n}
+  \gdef^^f2{\v n}
+  \gdef^^f3{\'o}
+  \gdef^^f4{\^o}
+  \gdef^^f5{\H o}
+  \gdef^^f6{\"o}
+  \gdef^^f7{$\div$}
+  \gdef^^f8{\v r}
+  \gdef^^f9{\ringaccent u}
+  \gdef^^fa{\'u}
+  \gdef^^fb{\H u}
+  \gdef^^fc{\"u}
+  \gdef^^fd{\'y}
+  \gdef^^fe{\cedilla t}
+  \gdef^^ff{\dotaccent{}}
+}
+
+% UTF-8 character definitions.
+% 
+% This code to support UTF-8 is based on LaTeX's utf8.def, with some
+% changes for Texinfo conventions.  It is included here under the GPL by
+% permission from Frank Mittelbach and the LaTeX team.
+% 
+\newcount\countUTFx
+\newcount\countUTFy
+\newcount\countUTFz
+
+\gdef\UTFviiiTwoOctets#1#2{\expandafter
+   \UTFviiiDefined\csname u8:#1\string #2\endcsname}
+%
+\gdef\UTFviiiThreeOctets#1#2#3{\expandafter
+   \UTFviiiDefined\csname u8:#1\string #2\string #3\endcsname}
+%
+\gdef\UTFviiiFourOctets#1#2#3#4{\expandafter
+   \UTFviiiDefined\csname u8:#1\string #2\string #3\string #4\endcsname}
+
+\gdef\UTFviiiDefined#1{%
+  \ifx #1\relax
+    \message{\linenumber Unicode char \string #1 not defined for Texinfo}%
+  \else
+    \expandafter #1%
+  \fi
+}
+
+\begingroup
+  \catcode`\~13
+  \catcode`\"12
+
+  \def\UTFviiiLoop{%
+    \global\catcode\countUTFx\active
+    \uccode`\~\countUTFx
+    \uppercase\expandafter{\UTFviiiTmp}%
+    \advance\countUTFx by 1
+    \ifnum\countUTFx < \countUTFy
+      \expandafter\UTFviiiLoop
+    \fi}
+
+  \countUTFx = "C2
+  \countUTFy = "E0
+  \def\UTFviiiTmp{%
+    \xdef~{\noexpand\UTFviiiTwoOctets\string~}}
+  \UTFviiiLoop
+
+  \countUTFx = "E0
+  \countUTFy = "F0
+  \def\UTFviiiTmp{%
+    \xdef~{\noexpand\UTFviiiThreeOctets\string~}}
+  \UTFviiiLoop
+
+  \countUTFx = "F0
+  \countUTFy = "F4
+  \def\UTFviiiTmp{%
+    \xdef~{\noexpand\UTFviiiFourOctets\string~}}
+  \UTFviiiLoop
+\endgroup
+
+\begingroup
+  \catcode`\"=12
+  \catcode`\<=12
+  \catcode`\.=12
+  \catcode`\,=12
+  \catcode`\;=12
+  \catcode`\!=12
+  \catcode`\~=13
+
+  \gdef\DeclareUnicodeCharacter#1#2{%
+    \countUTFz = "#1\relax
+    \wlog{\space\space defining Unicode char U+#1 (decimal \the\countUTFz)}%
+    \begingroup
+      \parseXMLCharref
+      \def\UTFviiiTwoOctets##1##2{%
+        \csname u8:##1\string ##2\endcsname}%
+      \def\UTFviiiThreeOctets##1##2##3{%
+        \csname u8:##1\string ##2\string ##3\endcsname}%
+      \def\UTFviiiFourOctets##1##2##3##4{%
+        \csname u8:##1\string ##2\string ##3\string ##4\endcsname}%
+      \expandafter\expandafter\expandafter\expandafter
+       \expandafter\expandafter\expandafter
+       \gdef\UTFviiiTmp{#2}%
+    \endgroup}
+
+  \gdef\parseXMLCharref{%
+    \ifnum\countUTFz < "A0\relax
+      \errhelp = \EMsimple
+      \errmessage{Cannot define Unicode char value < 00A0}%
+    \else\ifnum\countUTFz < "800\relax
+      \parseUTFviiiA,%
+      \parseUTFviiiB C\UTFviiiTwoOctets.,%
+    \else\ifnum\countUTFz < "10000\relax
+      \parseUTFviiiA;%
+      \parseUTFviiiA,%
+      \parseUTFviiiB E\UTFviiiThreeOctets.{,;}%
+    \else
+      \parseUTFviiiA;%
+      \parseUTFviiiA,%
+      \parseUTFviiiA!%
+      \parseUTFviiiB F\UTFviiiFourOctets.{!,;}%
+    \fi\fi\fi
+  }
+
+  \gdef\parseUTFviiiA#1{%
+    \countUTFx = \countUTFz
+    \divide\countUTFz by 64
+    \countUTFy = \countUTFz
+    \multiply\countUTFz by 64
+    \advance\countUTFx by -\countUTFz
+    \advance\countUTFx by 128
+    \uccode `#1\countUTFx
+    \countUTFz = \countUTFy}
+
+  \gdef\parseUTFviiiB#1#2#3#4{%
+    \advance\countUTFz by "#10\relax
+    \uccode `#3\countUTFz
+    \uppercase{\gdef\UTFviiiTmp{#2#3#4}}}
+\endgroup
+
+\def\utfeightchardefs{%
+  \DeclareUnicodeCharacter{00A0}{\tie}
+  \DeclareUnicodeCharacter{00A1}{\exclamdown}
+  \DeclareUnicodeCharacter{00A3}{\pounds}
+  \DeclareUnicodeCharacter{00A8}{\"{ }}
+  \DeclareUnicodeCharacter{00A9}{\copyright}
+  \DeclareUnicodeCharacter{00AA}{\ordf}
+  \DeclareUnicodeCharacter{00AB}{\guillemetleft}
+  \DeclareUnicodeCharacter{00AD}{\-}
+  \DeclareUnicodeCharacter{00AE}{\registeredsymbol}
+  \DeclareUnicodeCharacter{00AF}{\={ }}
+
+  \DeclareUnicodeCharacter{00B0}{\ringaccent{ }}
+  \DeclareUnicodeCharacter{00B4}{\'{ }}
+  \DeclareUnicodeCharacter{00B8}{\cedilla{ }}
+  \DeclareUnicodeCharacter{00BA}{\ordm}
+  \DeclareUnicodeCharacter{00BB}{\guillemetright}
+  \DeclareUnicodeCharacter{00BF}{\questiondown}
+
+  \DeclareUnicodeCharacter{00C0}{\`A}
+  \DeclareUnicodeCharacter{00C1}{\'A}
+  \DeclareUnicodeCharacter{00C2}{\^A}
+  \DeclareUnicodeCharacter{00C3}{\~A}
+  \DeclareUnicodeCharacter{00C4}{\"A}
+  \DeclareUnicodeCharacter{00C5}{\AA}
+  \DeclareUnicodeCharacter{00C6}{\AE}
+  \DeclareUnicodeCharacter{00C7}{\cedilla{C}}
+  \DeclareUnicodeCharacter{00C8}{\`E}
+  \DeclareUnicodeCharacter{00C9}{\'E}
+  \DeclareUnicodeCharacter{00CA}{\^E}
+  \DeclareUnicodeCharacter{00CB}{\"E}
+  \DeclareUnicodeCharacter{00CC}{\`I}
+  \DeclareUnicodeCharacter{00CD}{\'I}
+  \DeclareUnicodeCharacter{00CE}{\^I}
+  \DeclareUnicodeCharacter{00CF}{\"I}
+
+  \DeclareUnicodeCharacter{00D1}{\~N}
+  \DeclareUnicodeCharacter{00D2}{\`O}
+  \DeclareUnicodeCharacter{00D3}{\'O}
+  \DeclareUnicodeCharacter{00D4}{\^O}
+  \DeclareUnicodeCharacter{00D5}{\~O}
+  \DeclareUnicodeCharacter{00D6}{\"O}
+  \DeclareUnicodeCharacter{00D8}{\O}
+  \DeclareUnicodeCharacter{00D9}{\`U}
+  \DeclareUnicodeCharacter{00DA}{\'U}
+  \DeclareUnicodeCharacter{00DB}{\^U}
+  \DeclareUnicodeCharacter{00DC}{\"U}
+  \DeclareUnicodeCharacter{00DD}{\'Y}
+  \DeclareUnicodeCharacter{00DF}{\ss}
+
+  \DeclareUnicodeCharacter{00E0}{\`a}
+  \DeclareUnicodeCharacter{00E1}{\'a}
+  \DeclareUnicodeCharacter{00E2}{\^a}
+  \DeclareUnicodeCharacter{00E3}{\~a}
+  \DeclareUnicodeCharacter{00E4}{\"a}
+  \DeclareUnicodeCharacter{00E5}{\aa}
+  \DeclareUnicodeCharacter{00E6}{\ae}
+  \DeclareUnicodeCharacter{00E7}{\cedilla{c}}
+  \DeclareUnicodeCharacter{00E8}{\`e}
+  \DeclareUnicodeCharacter{00E9}{\'e}
+  \DeclareUnicodeCharacter{00EA}{\^e}
+  \DeclareUnicodeCharacter{00EB}{\"e}
+  \DeclareUnicodeCharacter{00EC}{\`{\dotless{i}}}
+  \DeclareUnicodeCharacter{00ED}{\'{\dotless{i}}}
+  \DeclareUnicodeCharacter{00EE}{\^{\dotless{i}}}
+  \DeclareUnicodeCharacter{00EF}{\"{\dotless{i}}}
+
+  \DeclareUnicodeCharacter{00F1}{\~n}
+  \DeclareUnicodeCharacter{00F2}{\`o}
+  \DeclareUnicodeCharacter{00F3}{\'o}
+  \DeclareUnicodeCharacter{00F4}{\^o}
+  \DeclareUnicodeCharacter{00F5}{\~o}
+  \DeclareUnicodeCharacter{00F6}{\"o}
+  \DeclareUnicodeCharacter{00F8}{\o}
+  \DeclareUnicodeCharacter{00F9}{\`u}
+  \DeclareUnicodeCharacter{00FA}{\'u}
+  \DeclareUnicodeCharacter{00FB}{\^u}
+  \DeclareUnicodeCharacter{00FC}{\"u}
+  \DeclareUnicodeCharacter{00FD}{\'y}
+  \DeclareUnicodeCharacter{00FF}{\"y}
+
+  \DeclareUnicodeCharacter{0100}{\=A}
+  \DeclareUnicodeCharacter{0101}{\=a}
+  \DeclareUnicodeCharacter{0102}{\u{A}}
+  \DeclareUnicodeCharacter{0103}{\u{a}}
+  \DeclareUnicodeCharacter{0106}{\'C}
+  \DeclareUnicodeCharacter{0107}{\'c}
+  \DeclareUnicodeCharacter{0108}{\^C}
+  \DeclareUnicodeCharacter{0109}{\^c}
+  \DeclareUnicodeCharacter{010A}{\dotaccent{C}}
+  \DeclareUnicodeCharacter{010B}{\dotaccent{c}}
+  \DeclareUnicodeCharacter{010C}{\v{C}}
+  \DeclareUnicodeCharacter{010D}{\v{c}}
+  \DeclareUnicodeCharacter{010E}{\v{D}}
+
+  \DeclareUnicodeCharacter{0112}{\=E}
+  \DeclareUnicodeCharacter{0113}{\=e}
+  \DeclareUnicodeCharacter{0114}{\u{E}}
+  \DeclareUnicodeCharacter{0115}{\u{e}}
+  \DeclareUnicodeCharacter{0116}{\dotaccent{E}}
+  \DeclareUnicodeCharacter{0117}{\dotaccent{e}}
+  \DeclareUnicodeCharacter{011A}{\v{E}}
+  \DeclareUnicodeCharacter{011B}{\v{e}}
+  \DeclareUnicodeCharacter{011C}{\^G}
+  \DeclareUnicodeCharacter{011D}{\^g}
+  \DeclareUnicodeCharacter{011E}{\u{G}}
+  \DeclareUnicodeCharacter{011F}{\u{g}}
+
+  \DeclareUnicodeCharacter{0120}{\dotaccent{G}}
+  \DeclareUnicodeCharacter{0121}{\dotaccent{g}}
+  \DeclareUnicodeCharacter{0124}{\^H}
+  \DeclareUnicodeCharacter{0125}{\^h}
+  \DeclareUnicodeCharacter{0128}{\~I}
+  \DeclareUnicodeCharacter{0129}{\~{\dotless{i}}}
+  \DeclareUnicodeCharacter{012A}{\=I}
+  \DeclareUnicodeCharacter{012B}{\={\dotless{i}}}
+  \DeclareUnicodeCharacter{012C}{\u{I}}
+  \DeclareUnicodeCharacter{012D}{\u{\dotless{i}}}
+
+  \DeclareUnicodeCharacter{0130}{\dotaccent{I}}
+  \DeclareUnicodeCharacter{0131}{\dotless{i}}
+  \DeclareUnicodeCharacter{0132}{IJ}
+  \DeclareUnicodeCharacter{0133}{ij}
+  \DeclareUnicodeCharacter{0134}{\^J}
+  \DeclareUnicodeCharacter{0135}{\^{\dotless{j}}}
+  \DeclareUnicodeCharacter{0139}{\'L}
+  \DeclareUnicodeCharacter{013A}{\'l}
+
+  \DeclareUnicodeCharacter{0141}{\L}
+  \DeclareUnicodeCharacter{0142}{\l}
+  \DeclareUnicodeCharacter{0143}{\'N}
+  \DeclareUnicodeCharacter{0144}{\'n}
+  \DeclareUnicodeCharacter{0147}{\v{N}}
+  \DeclareUnicodeCharacter{0148}{\v{n}}
+  \DeclareUnicodeCharacter{014C}{\=O}
+  \DeclareUnicodeCharacter{014D}{\=o}
+  \DeclareUnicodeCharacter{014E}{\u{O}}
+  \DeclareUnicodeCharacter{014F}{\u{o}}
+
+  \DeclareUnicodeCharacter{0150}{\H{O}}
+  \DeclareUnicodeCharacter{0151}{\H{o}}
+  \DeclareUnicodeCharacter{0152}{\OE}
+  \DeclareUnicodeCharacter{0153}{\oe}
+  \DeclareUnicodeCharacter{0154}{\'R}
+  \DeclareUnicodeCharacter{0155}{\'r}
+  \DeclareUnicodeCharacter{0158}{\v{R}}
+  \DeclareUnicodeCharacter{0159}{\v{r}}
+  \DeclareUnicodeCharacter{015A}{\'S}
+  \DeclareUnicodeCharacter{015B}{\'s}
+  \DeclareUnicodeCharacter{015C}{\^S}
+  \DeclareUnicodeCharacter{015D}{\^s}
+  \DeclareUnicodeCharacter{015E}{\cedilla{S}}
+  \DeclareUnicodeCharacter{015F}{\cedilla{s}}
+
+  \DeclareUnicodeCharacter{0160}{\v{S}}
+  \DeclareUnicodeCharacter{0161}{\v{s}}
+  \DeclareUnicodeCharacter{0162}{\cedilla{t}}
+  \DeclareUnicodeCharacter{0163}{\cedilla{T}}
+  \DeclareUnicodeCharacter{0164}{\v{T}}
+
+  \DeclareUnicodeCharacter{0168}{\~U}
+  \DeclareUnicodeCharacter{0169}{\~u}
+  \DeclareUnicodeCharacter{016A}{\=U}
+  \DeclareUnicodeCharacter{016B}{\=u}
+  \DeclareUnicodeCharacter{016C}{\u{U}}
+  \DeclareUnicodeCharacter{016D}{\u{u}}
+  \DeclareUnicodeCharacter{016E}{\ringaccent{U}}
+  \DeclareUnicodeCharacter{016F}{\ringaccent{u}}
+
+  \DeclareUnicodeCharacter{0170}{\H{U}}
+  \DeclareUnicodeCharacter{0171}{\H{u}}
+  \DeclareUnicodeCharacter{0174}{\^W}
+  \DeclareUnicodeCharacter{0175}{\^w}
+  \DeclareUnicodeCharacter{0176}{\^Y}
+  \DeclareUnicodeCharacter{0177}{\^y}
+  \DeclareUnicodeCharacter{0178}{\"Y}
+  \DeclareUnicodeCharacter{0179}{\'Z}
+  \DeclareUnicodeCharacter{017A}{\'z}
+  \DeclareUnicodeCharacter{017B}{\dotaccent{Z}}
+  \DeclareUnicodeCharacter{017C}{\dotaccent{z}}
+  \DeclareUnicodeCharacter{017D}{\v{Z}}
+  \DeclareUnicodeCharacter{017E}{\v{z}}
+
+  \DeclareUnicodeCharacter{01C4}{D\v{Z}}
+  \DeclareUnicodeCharacter{01C5}{D\v{z}}
+  \DeclareUnicodeCharacter{01C6}{d\v{z}}
+  \DeclareUnicodeCharacter{01C7}{LJ}
+  \DeclareUnicodeCharacter{01C8}{Lj}
+  \DeclareUnicodeCharacter{01C9}{lj}
+  \DeclareUnicodeCharacter{01CA}{NJ}
+  \DeclareUnicodeCharacter{01CB}{Nj}
+  \DeclareUnicodeCharacter{01CC}{nj}
+  \DeclareUnicodeCharacter{01CD}{\v{A}}
+  \DeclareUnicodeCharacter{01CE}{\v{a}}
+  \DeclareUnicodeCharacter{01CF}{\v{I}}
+
+  \DeclareUnicodeCharacter{01D0}{\v{\dotless{i}}}
+  \DeclareUnicodeCharacter{01D1}{\v{O}}
+  \DeclareUnicodeCharacter{01D2}{\v{o}}
+  \DeclareUnicodeCharacter{01D3}{\v{U}}
+  \DeclareUnicodeCharacter{01D4}{\v{u}}
+
+  \DeclareUnicodeCharacter{01E2}{\={\AE}}
+  \DeclareUnicodeCharacter{01E3}{\={\ae}}
+  \DeclareUnicodeCharacter{01E6}{\v{G}}
+  \DeclareUnicodeCharacter{01E7}{\v{g}}
+  \DeclareUnicodeCharacter{01E8}{\v{K}}
+  \DeclareUnicodeCharacter{01E9}{\v{k}}
+
+  \DeclareUnicodeCharacter{01F0}{\v{\dotless{j}}}
+  \DeclareUnicodeCharacter{01F1}{DZ}
+  \DeclareUnicodeCharacter{01F2}{Dz}
+  \DeclareUnicodeCharacter{01F3}{dz}
+  \DeclareUnicodeCharacter{01F4}{\'G}
+  \DeclareUnicodeCharacter{01F5}{\'g}
+  \DeclareUnicodeCharacter{01F8}{\`N}
+  \DeclareUnicodeCharacter{01F9}{\`n}
+  \DeclareUnicodeCharacter{01FC}{\'{\AE}}
+  \DeclareUnicodeCharacter{01FD}{\'{\ae}}
+  \DeclareUnicodeCharacter{01FE}{\'{\O}}
+  \DeclareUnicodeCharacter{01FF}{\'{\o}}
+
+  \DeclareUnicodeCharacter{021E}{\v{H}}
+  \DeclareUnicodeCharacter{021F}{\v{h}}
+
+  \DeclareUnicodeCharacter{0226}{\dotaccent{A}}
+  \DeclareUnicodeCharacter{0227}{\dotaccent{a}}
+  \DeclareUnicodeCharacter{0228}{\cedilla{E}}
+  \DeclareUnicodeCharacter{0229}{\cedilla{e}}
+  \DeclareUnicodeCharacter{022E}{\dotaccent{O}}
+  \DeclareUnicodeCharacter{022F}{\dotaccent{o}}
+
+  \DeclareUnicodeCharacter{0232}{\=Y}
+  \DeclareUnicodeCharacter{0233}{\=y}
+  \DeclareUnicodeCharacter{0237}{\dotless{j}}
+
+  \DeclareUnicodeCharacter{1E02}{\dotaccent{B}}
+  \DeclareUnicodeCharacter{1E03}{\dotaccent{b}}
+  \DeclareUnicodeCharacter{1E04}{\udotaccent{B}}
+  \DeclareUnicodeCharacter{1E05}{\udotaccent{b}}
+  \DeclareUnicodeCharacter{1E06}{\ubaraccent{B}}
+  \DeclareUnicodeCharacter{1E07}{\ubaraccent{b}}
+  \DeclareUnicodeCharacter{1E0A}{\dotaccent{D}}
+  \DeclareUnicodeCharacter{1E0B}{\dotaccent{d}}
+  \DeclareUnicodeCharacter{1E0C}{\udotaccent{D}}
+  \DeclareUnicodeCharacter{1E0D}{\udotaccent{d}}
+  \DeclareUnicodeCharacter{1E0E}{\ubaraccent{D}}
+  \DeclareUnicodeCharacter{1E0F}{\ubaraccent{d}}
+
+  \DeclareUnicodeCharacter{1E1E}{\dotaccent{F}}
+  \DeclareUnicodeCharacter{1E1F}{\dotaccent{f}}
+
+  \DeclareUnicodeCharacter{1E20}{\=G}
+  \DeclareUnicodeCharacter{1E21}{\=g}
+  \DeclareUnicodeCharacter{1E22}{\dotaccent{H}}
+  \DeclareUnicodeCharacter{1E23}{\dotaccent{h}}
+  \DeclareUnicodeCharacter{1E24}{\udotaccent{H}}
+  \DeclareUnicodeCharacter{1E25}{\udotaccent{h}}
+  \DeclareUnicodeCharacter{1E26}{\"H}
+  \DeclareUnicodeCharacter{1E27}{\"h}
+
+  \DeclareUnicodeCharacter{1E30}{\'K}
+  \DeclareUnicodeCharacter{1E31}{\'k}
+  \DeclareUnicodeCharacter{1E32}{\udotaccent{K}}
+  \DeclareUnicodeCharacter{1E33}{\udotaccent{k}}
+  \DeclareUnicodeCharacter{1E34}{\ubaraccent{K}}
+  \DeclareUnicodeCharacter{1E35}{\ubaraccent{k}}
+  \DeclareUnicodeCharacter{1E36}{\udotaccent{L}}
+  \DeclareUnicodeCharacter{1E37}{\udotaccent{l}}
+  \DeclareUnicodeCharacter{1E3A}{\ubaraccent{L}}
+  \DeclareUnicodeCharacter{1E3B}{\ubaraccent{l}}
+  \DeclareUnicodeCharacter{1E3E}{\'M}
+  \DeclareUnicodeCharacter{1E3F}{\'m}
+
+  \DeclareUnicodeCharacter{1E40}{\dotaccent{M}}
+  \DeclareUnicodeCharacter{1E41}{\dotaccent{m}}
+  \DeclareUnicodeCharacter{1E42}{\udotaccent{M}}
+  \DeclareUnicodeCharacter{1E43}{\udotaccent{m}}
+  \DeclareUnicodeCharacter{1E44}{\dotaccent{N}}
+  \DeclareUnicodeCharacter{1E45}{\dotaccent{n}}
+  \DeclareUnicodeCharacter{1E46}{\udotaccent{N}}
+  \DeclareUnicodeCharacter{1E47}{\udotaccent{n}}
+  \DeclareUnicodeCharacter{1E48}{\ubaraccent{N}}
+  \DeclareUnicodeCharacter{1E49}{\ubaraccent{n}}
+
+  \DeclareUnicodeCharacter{1E54}{\'P}
+  \DeclareUnicodeCharacter{1E55}{\'p}
+  \DeclareUnicodeCharacter{1E56}{\dotaccent{P}}
+  \DeclareUnicodeCharacter{1E57}{\dotaccent{p}}
+  \DeclareUnicodeCharacter{1E58}{\dotaccent{R}}
+  \DeclareUnicodeCharacter{1E59}{\dotaccent{r}}
+  \DeclareUnicodeCharacter{1E5A}{\udotaccent{R}}
+  \DeclareUnicodeCharacter{1E5B}{\udotaccent{r}}
+  \DeclareUnicodeCharacter{1E5E}{\ubaraccent{R}}
+  \DeclareUnicodeCharacter{1E5F}{\ubaraccent{r}}
+
+  \DeclareUnicodeCharacter{1E60}{\dotaccent{S}}
+  \DeclareUnicodeCharacter{1E61}{\dotaccent{s}}
+  \DeclareUnicodeCharacter{1E62}{\udotaccent{S}}
+  \DeclareUnicodeCharacter{1E63}{\udotaccent{s}}
+  \DeclareUnicodeCharacter{1E6A}{\dotaccent{T}}
+  \DeclareUnicodeCharacter{1E6B}{\dotaccent{t}}
+  \DeclareUnicodeCharacter{1E6C}{\udotaccent{T}}
+  \DeclareUnicodeCharacter{1E6D}{\udotaccent{t}}
+  \DeclareUnicodeCharacter{1E6E}{\ubaraccent{T}}
+  \DeclareUnicodeCharacter{1E6F}{\ubaraccent{t}}
+
+  \DeclareUnicodeCharacter{1E7C}{\~V}
+  \DeclareUnicodeCharacter{1E7D}{\~v}
+  \DeclareUnicodeCharacter{1E7E}{\udotaccent{V}}
+  \DeclareUnicodeCharacter{1E7F}{\udotaccent{v}}
+
+  \DeclareUnicodeCharacter{1E80}{\`W}
+  \DeclareUnicodeCharacter{1E81}{\`w}
+  \DeclareUnicodeCharacter{1E82}{\'W}
+  \DeclareUnicodeCharacter{1E83}{\'w}
+  \DeclareUnicodeCharacter{1E84}{\"W}
+  \DeclareUnicodeCharacter{1E85}{\"w}
+  \DeclareUnicodeCharacter{1E86}{\dotaccent{W}}
+  \DeclareUnicodeCharacter{1E87}{\dotaccent{w}}
+  \DeclareUnicodeCharacter{1E88}{\udotaccent{W}}
+  \DeclareUnicodeCharacter{1E89}{\udotaccent{w}}
+  \DeclareUnicodeCharacter{1E8A}{\dotaccent{X}}
+  \DeclareUnicodeCharacter{1E8B}{\dotaccent{x}}
+  \DeclareUnicodeCharacter{1E8C}{\"X}
+  \DeclareUnicodeCharacter{1E8D}{\"x}
+  \DeclareUnicodeCharacter{1E8E}{\dotaccent{Y}}
+  \DeclareUnicodeCharacter{1E8F}{\dotaccent{y}}
+
+  \DeclareUnicodeCharacter{1E90}{\^Z}
+  \DeclareUnicodeCharacter{1E91}{\^z}
+  \DeclareUnicodeCharacter{1E92}{\udotaccent{Z}}
+  \DeclareUnicodeCharacter{1E93}{\udotaccent{z}}
+  \DeclareUnicodeCharacter{1E94}{\ubaraccent{Z}}
+  \DeclareUnicodeCharacter{1E95}{\ubaraccent{z}}
+  \DeclareUnicodeCharacter{1E96}{\ubaraccent{h}}
+  \DeclareUnicodeCharacter{1E97}{\"t}
+  \DeclareUnicodeCharacter{1E98}{\ringaccent{w}}
+  \DeclareUnicodeCharacter{1E99}{\ringaccent{y}}
+
+  \DeclareUnicodeCharacter{1EA0}{\udotaccent{A}}
+  \DeclareUnicodeCharacter{1EA1}{\udotaccent{a}}
+
+  \DeclareUnicodeCharacter{1EB8}{\udotaccent{E}}
+  \DeclareUnicodeCharacter{1EB9}{\udotaccent{e}}
+  \DeclareUnicodeCharacter{1EBC}{\~E}
+  \DeclareUnicodeCharacter{1EBD}{\~e}
+
+  \DeclareUnicodeCharacter{1ECA}{\udotaccent{I}}
+  \DeclareUnicodeCharacter{1ECB}{\udotaccent{i}}
+  \DeclareUnicodeCharacter{1ECC}{\udotaccent{O}}
+  \DeclareUnicodeCharacter{1ECD}{\udotaccent{o}}
+
+  \DeclareUnicodeCharacter{1EE4}{\udotaccent{U}}
+  \DeclareUnicodeCharacter{1EE5}{\udotaccent{u}}
+
+  \DeclareUnicodeCharacter{1EF2}{\`Y}
+  \DeclareUnicodeCharacter{1EF3}{\`y}
+  \DeclareUnicodeCharacter{1EF4}{\udotaccent{Y}}
+
+  \DeclareUnicodeCharacter{1EF8}{\~Y}
+  \DeclareUnicodeCharacter{1EF9}{\~y}
+
+  \DeclareUnicodeCharacter{2013}{--}
+  \DeclareUnicodeCharacter{2014}{---}
+  \DeclareUnicodeCharacter{2018}{\quoteleft}
+  \DeclareUnicodeCharacter{2019}{\quoteright}
+  \DeclareUnicodeCharacter{201A}{\quotesinglbase}
+  \DeclareUnicodeCharacter{201C}{\quotedblleft}
+  \DeclareUnicodeCharacter{201D}{\quotedblright}
+  \DeclareUnicodeCharacter{201E}{\quotedblbase}
+  \DeclareUnicodeCharacter{2022}{\bullet}
+  \DeclareUnicodeCharacter{2026}{\dots}
+  \DeclareUnicodeCharacter{2039}{\guilsinglleft}
+  \DeclareUnicodeCharacter{203A}{\guilsinglright}
+  \DeclareUnicodeCharacter{20AC}{\euro}
+
+  \DeclareUnicodeCharacter{2192}{\expansion}
+  \DeclareUnicodeCharacter{21D2}{\result}
+
+  \DeclareUnicodeCharacter{2212}{\minus}
+  \DeclareUnicodeCharacter{2217}{\point}
+  \DeclareUnicodeCharacter{2261}{\equiv}
+}% end of \utfeightchardefs
+
+
+% US-ASCII character definitions.
+\def\asciichardefs{% nothing need be done
+   \relax
+}
+
+% Make non-ASCII characters printable again for compatibility with
+% existing Texinfo documents that may use them, even without declaring a
+% document encoding.
+%
+\setnonasciicharscatcode \other
+
+
+\message{formatting,}
+
+\newdimen\defaultparindent \defaultparindent = 15pt
+
+\chapheadingskip = 15pt plus 4pt minus 2pt
+\secheadingskip = 12pt plus 3pt minus 2pt
+\subsecheadingskip = 9pt plus 2pt minus 2pt
+
+% Prevent underfull vbox error messages.
+\vbadness = 10000
+
+% Don't be so finicky about underfull hboxes, either.
+\hbadness = 2000
+
+% Following George Bush, get rid of widows and orphans.
+\widowpenalty=10000
+\clubpenalty=10000
+
+% Use TeX 3.0's \emergencystretch to help line breaking, but if we're
+% using an old version of TeX, don't do anything.  We want the amount of
+% stretch added to depend on the line length, hence the dependence on
+% \hsize.  We call this whenever the paper size is set.
+%
+\def\setemergencystretch{%
+  \ifx\emergencystretch\thisisundefined
+    % Allow us to assign to \emergencystretch anyway.
+    \def\emergencystretch{\dimen0}%
+  \else
+    \emergencystretch = .15\hsize
+  \fi
+}
+
+% Parameters in order: 1) textheight; 2) textwidth;
+% 3) voffset; 4) hoffset; 5) binding offset; 6) topskip;
+% 7) physical page height; 8) physical page width.
+%
+% We also call \setleading{\textleading}, so the caller should define
+% \textleading.  The caller should also set \parskip.
+%
+\def\internalpagesizes#1#2#3#4#5#6#7#8{%
+  \voffset = #3\relax
+  \topskip = #6\relax
+  \splittopskip = \topskip
+  %
+  \vsize = #1\relax
+  \advance\vsize by \topskip
+  \outervsize = \vsize
+  \advance\outervsize by 2\topandbottommargin
+  \pageheight = \vsize
+  %
+  \hsize = #2\relax
+  \outerhsize = \hsize
+  \advance\outerhsize by 0.5in
+  \pagewidth = \hsize
+  %
+  \normaloffset = #4\relax
+  \bindingoffset = #5\relax
+  %
+  \ifpdf
+    \pdfpageheight #7\relax
+    \pdfpagewidth #8\relax
+    % if we don't reset these, they will remain at "1 true in" of
+    % whatever layout pdftex was dumped with.
+    \pdfhorigin = 1 true in
+    \pdfvorigin = 1 true in
+  \fi
+  %
+  \setleading{\textleading}
+  %
+  \parindent = \defaultparindent
+  \setemergencystretch
+}
+
+% @letterpaper (the default).
+\def\letterpaper{{\globaldefs = 1
+  \parskip = 3pt plus 2pt minus 1pt
+  \textleading = 13.2pt
+  %
+  % If page is nothing but text, make it come out even.
+  \internalpagesizes{607.2pt}{6in}% that's 46 lines
+                    {\voffset}{.25in}%
+                    {\bindingoffset}{36pt}%
+                    {11in}{8.5in}%
+}}
+
+% Use @smallbook to reset parameters for 7x9.25 trim size.
+\def\smallbook{{\globaldefs = 1
+  \parskip = 2pt plus 1pt
+  \textleading = 12pt
+  %
+  \internalpagesizes{7.5in}{5in}%
+                    {-.2in}{0in}%
+                    {\bindingoffset}{16pt}%
+                    {9.25in}{7in}%
+  %
+  \lispnarrowing = 0.3in
+  \tolerance = 700
+  \hfuzz = 1pt
+  \contentsrightmargin = 0pt
+  \defbodyindent = .5cm
+}}
+
+% Use @smallerbook to reset parameters for 6x9 trim size.
+% (Just testing, parameters still in flux.)
+\def\smallerbook{{\globaldefs = 1
+  \parskip = 1.5pt plus 1pt
+  \textleading = 12pt
+  %
+  \internalpagesizes{7.4in}{4.8in}%
+                    {-.2in}{-.4in}%
+                    {0pt}{14pt}%
+                    {9in}{6in}%
+  %
+  \lispnarrowing = 0.25in
+  \tolerance = 700
+  \hfuzz = 1pt
+  \contentsrightmargin = 0pt
+  \defbodyindent = .4cm
+}}
+
+% Use @afourpaper to print on European A4 paper.
+\def\afourpaper{{\globaldefs = 1
+  \parskip = 3pt plus 2pt minus 1pt
+  \textleading = 13.2pt
+  %
+  % Double-side printing via postscript on Laserjet 4050
+  % prints double-sided nicely when \bindingoffset=10mm and \hoffset=-6mm.
+  % To change the settings for a different printer or situation, adjust
+  % \normaloffset until the front-side and back-side texts align.  Then
+  % do the same for \bindingoffset.  You can set these for testing in
+  % your texinfo source file like this:
+  % @tex
+  % \global\normaloffset = -6mm
+  % \global\bindingoffset = 10mm
+  % @end tex
+  \internalpagesizes{673.2pt}{160mm}% that's 51 lines
+                    {\voffset}{\hoffset}%
+                    {\bindingoffset}{44pt}%
+                    {297mm}{210mm}%
+  %
+  \tolerance = 700
+  \hfuzz = 1pt
+  \contentsrightmargin = 0pt
+  \defbodyindent = 5mm
+}}
+
+% Use @afivepaper to print on European A5 paper.
+% From romildo@urano.iceb.ufop.br, 2 July 2000.
+% He also recommends making @example and @lisp be small.
+\def\afivepaper{{\globaldefs = 1
+  \parskip = 2pt plus 1pt minus 0.1pt
+  \textleading = 12.5pt
+  %
+  \internalpagesizes{160mm}{120mm}%
+                    {\voffset}{\hoffset}%
+                    {\bindingoffset}{8pt}%
+                    {210mm}{148mm}%
+  %
+  \lispnarrowing = 0.2in
+  \tolerance = 800
+  \hfuzz = 1.2pt
+  \contentsrightmargin = 0pt
+  \defbodyindent = 2mm
+  \tableindent = 12mm
+}}
+
+% A specific text layout, 24x15cm overall, intended for A4 paper.
+\def\afourlatex{{\globaldefs = 1
+  \afourpaper
+  \internalpagesizes{237mm}{150mm}%
+                    {\voffset}{4.6mm}%
+                    {\bindingoffset}{7mm}%
+                    {297mm}{210mm}%
+  %
+  % Must explicitly reset to 0 because we call \afourpaper.
+  \globaldefs = 0
+}}
+
+% Use @afourwide to print on A4 paper in landscape format.
+\def\afourwide{{\globaldefs = 1
+  \afourpaper
+  \internalpagesizes{241mm}{165mm}%
+                    {\voffset}{-2.95mm}%
+                    {\bindingoffset}{7mm}%
+                    {297mm}{210mm}%
+  \globaldefs = 0
+}}
+
+% @pagesizes TEXTHEIGHT[,TEXTWIDTH]
+% Perhaps we should allow setting the margins, \topskip, \parskip,
+% and/or leading, also. Or perhaps we should compute them somehow.
+%
+\parseargdef\pagesizes{\pagesizesyyy #1,,\finish}
+\def\pagesizesyyy#1,#2,#3\finish{{%
+  \setbox0 = \hbox{\ignorespaces #2}\ifdim\wd0 > 0pt \hsize=#2\relax \fi
+  \globaldefs = 1
+  %
+  \parskip = 3pt plus 2pt minus 1pt
+  \setleading{\textleading}%
+  %
+  \dimen0 = #1\relax
+  \advance\dimen0 by \voffset
+  %
+  \dimen2 = \hsize
+  \advance\dimen2 by \normaloffset
+  %
+  \internalpagesizes{#1}{\hsize}%
+                    {\voffset}{\normaloffset}%
+                    {\bindingoffset}{44pt}%
+                    {\dimen0}{\dimen2}%
+}}
+
+% Set default to letter.
+%
+\letterpaper
+
+
+\message{and turning on texinfo input format.}
+
+% Define macros to output various characters with catcode for normal text.
+\catcode`\"=\other
+\catcode`\~=\other
+\catcode`\^=\other
+\catcode`\_=\other
+\catcode`\|=\other
+\catcode`\<=\other
+\catcode`\>=\other
+\catcode`\+=\other
+\catcode`\$=\other
+\def\normaldoublequote{"}
+\def\normaltilde{~}
+\def\normalcaret{^}
+\def\normalunderscore{_}
+\def\normalverticalbar{|}
+\def\normalless{<}
+\def\normalgreater{>}
+\def\normalplus{+}
+\def\normaldollar{$}%$ font-lock fix
+
+% This macro is used to make a character print one way in \tt
+% (where it can probably be output as-is), and another way in other fonts,
+% where something hairier probably needs to be done.
+%
+% #1 is what to print if we are indeed using \tt; #2 is what to print
+% otherwise.  Since all the Computer Modern typewriter fonts have zero
+% interword stretch (and shrink), and it is reasonable to expect all
+% typewriter fonts to have this, we can check that font parameter.
+%
+\def\ifusingtt#1#2{\ifdim \fontdimen3\font=0pt #1\else #2\fi}
+
+% Same as above, but check for italic font.  Actually this also catches
+% non-italic slanted fonts since it is impossible to distinguish them from
+% italic fonts.  But since this is only used by $ and it uses \sl anyway
+% this is not a problem.
+\def\ifusingit#1#2{\ifdim \fontdimen1\font>0pt #1\else #2\fi}
+
+% Turn off all special characters except @
+% (and those which the user can use as if they were ordinary).
+% Most of these we simply print from the \tt font, but for some, we can
+% use math or other variants that look better in normal text.
+
+\catcode`\"=\active
+\def\activedoublequote{{\tt\char34}}
+\let"=\activedoublequote
+\catcode`\~=\active
+\def~{{\tt\char126}}
+\chardef\hat=`\^
+\catcode`\^=\active
+\def^{{\tt \hat}}
+
+\catcode`\_=\active
+\def_{\ifusingtt\normalunderscore\_}
+\let\realunder=_
+% Subroutine for the previous macro.
+\def\_{\leavevmode \kern.07em \vbox{\hrule width.3em height.1ex}\kern .07em }
+
+\catcode`\|=\active
+\def|{{\tt\char124}}
+\chardef \less=`\<
+\catcode`\<=\active
+\def<{{\tt \less}}
+\chardef \gtr=`\>
+\catcode`\>=\active
+\def>{{\tt \gtr}}
+\catcode`\+=\active
+\def+{{\tt \char 43}}
+\catcode`\$=\active
+\def${\ifusingit{{\sl\$}}\normaldollar}%$ font-lock fix
+
+% If a .fmt file is being used, characters that might appear in a file
+% name cannot be active until we have parsed the command line.
+% So turn them off again, and have \everyjob (or @setfilename) turn them on.
+% \otherifyactive is called near the end of this file.
+\def\otherifyactive{\catcode`+=\other \catcode`\_=\other}
+
+% Used sometimes to turn off (effectively) the active characters even after
+% parsing them.
+\def\turnoffactive{%
+  \normalturnoffactive
+  \otherbackslash
+}
+
+\catcode`\@=0
+
+% \backslashcurfont outputs one backslash character in current font,
+% as in \char`\\.
+\global\chardef\backslashcurfont=`\\
+\global\let\rawbackslashxx=\backslashcurfont  % let existing .??s files work
+
+% \realbackslash is an actual character `\' with catcode other, and
+% \doublebackslash is two of them (for the pdf outlines).
+{\catcode`\\=\other @gdef@realbackslash{\} @gdef@doublebackslash{\\}}
+
+% In texinfo, backslash is an active character; it prints the backslash
+% in fixed width font.
+\catcode`\\=\active
+@def@normalbackslash{{@tt@backslashcurfont}}
+% On startup, @fixbackslash assigns:
+%  @let \ = @normalbackslash
+
+% \rawbackslash defines an active \ to do \backslashcurfont.
+% \otherbackslash defines an active \ to be a literal `\' character with
+% catcode other.
+@gdef@rawbackslash{@let\=@backslashcurfont}
+@gdef@otherbackslash{@let\=@realbackslash}
+
+% Same as @turnoffactive except outputs \ as {\tt\char`\\} instead of
+% the literal character `\'.
+% 
+@def@normalturnoffactive{%
+  @let\=@normalbackslash
+  @let"=@normaldoublequote
+  @let~=@normaltilde
+  @let^=@normalcaret
+  @let_=@normalunderscore
+  @let|=@normalverticalbar
+  @let<=@normalless
+  @let>=@normalgreater
+  @let+=@normalplus
+  @let$=@normaldollar %$ font-lock fix
+  @unsepspaces
+}
+
+% Make _ and + \other characters, temporarily.
+% This is canceled by @fixbackslash.
+@otherifyactive
+
+% If a .fmt file is being used, we don't want the `\input texinfo' to show up.
+% That is what \eatinput is for; after that, the `\' should revert to printing
+% a backslash.
+%
+@gdef@eatinput input texinfo{@fixbackslash}
+@global@let\ = @eatinput
+
+% On the other hand, perhaps the file did not have a `\input texinfo'. Then
+% the first `\' in the file would cause an error. This macro tries to fix
+% that, assuming it is called before the first `\' could plausibly occur.
+% Also turn back on active characters that might appear in the input
+% file name, in case not using a pre-dumped format.
+%
+@gdef@fixbackslash{%
+  @ifx\@eatinput @let\ = @normalbackslash @fi
+  @catcode`+=@active
+  @catcode`@_=@active
+}
+
+% Say @foo, not \foo, in error messages.
+@escapechar = `@@
+
+% These look ok in all fonts, so just make them not special.
+@catcode`@& = @other
+@catcode`@# = @other
+@catcode`@% = @other
+
+
+@c Local variables:
+@c eval: (add-hook 'write-file-hooks 'time-stamp)
+@c page-delimiter: "^\\\\message"
+@c time-stamp-start: "def\\\\texinfoversion{"
+@c time-stamp-format: "%:y-%02m-%02d.%02H"
+@c time-stamp-end: "}"
+@c End:
+
+@c vim:sw=2:
+
+@ignore
+   arch-tag: e1b36e32-c96e-4135-a41a-0b2efa2ea115
+@end ignore
diff --git a/doc/tutorial/Makefile.am b/doc/tutorial/Makefile.am
index f49220da7..d359c4fed 100644
--- a/doc/tutorial/Makefile.am
+++ b/doc/tutorial/Makefile.am
@@ -4,20 +4,20 @@
 ##
 ##   This file is part of GUILE.
 ##   
-##   GUILE 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
+##   GUILE is free software; you can redistribute it and/or modify it
+##   under the terms of the GNU Lesser General Public License as
+##   published by the Free Software Foundation; either version 3, or
 ##   (at your option) any later version.
-##   
+##
 ##   GUILE is distributed in the hope that 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 GUILE; see the file COPYING.  If not, write
-##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-##   Floor, Boston, MA 02110-1301 USA
+##   GNU Lesser General Public License for more details.
+##
+##   You should have received a copy of the GNU Lesser General Public
+##   License along with GUILE; see the file COPYING.LESSER.  If not,
+##   write to the Free Software Foundation, Inc., 51 Franklin Street,
+##   Fifth Floor, Boston, MA 02110-1301 USA
 
 AUTOMAKE_OPTIONS = gnu
 
diff --git a/emacs/Makefile.am b/emacs/Makefile.am
index ad7a5c939..e18f30bf1 100644
--- a/emacs/Makefile.am
+++ b/emacs/Makefile.am
@@ -4,20 +4,20 @@
 ##
 ##   This file is part of GUILE.
 ##
-##   GUILE 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
+##   GUILE is free software; you can redistribute it and/or modify it
+##   under the terms of the GNU Lesser General Public License as
+##   published by the Free Software Foundation; either version 3, or
 ##   (at your option) any later version.
 ##
 ##   GUILE is distributed in the hope that 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.
+##   GNU Lesser General Public License for more details.
 ##
-##   You should have received a copy of the GNU General Public
-##   License along with GUILE; see the file COPYING.  If not, write
-##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-##   Floor, Boston, MA 02110-1301 USA
+##   You should have received a copy of the GNU Lesser General Public
+##   License along with GUILE; see the file COPYING.LESSER.  If not,
+##   write to the Free Software Foundation, Inc., 51 Franklin Street,
+##   Fifth Floor, Boston, MA 02110-1301 USA
 
 AUTOMAKE_OPTIONS = gnu
 
diff --git a/emacs/gds-faq.txt b/emacs/gds-faq.txt
new file mode 100755
index 000000000..b60a2c9ae
--- /dev/null
+++ b/emacs/gds-faq.txt
@@ -0,0 +1,225 @@
+
+* Installation
+
+** How do I install guile-debugging?
+
+After unpacking the .tar.gz file, run the usual sequence of commands:
+
+$ ./configure
+$ make
+$ sudo make install
+
+Then you need to make sure that the directory where guile-debugging's
+Scheme files were installed is included in your Guile's load path.
+(The sequence above will usually install guile-debugging under
+/usr/local, and /usr/local is not in Guile's load path by default,
+unless Guile itself was installed under /usr/local.)  You can discover
+your Guile's default load path by typing
+
+$ guile -q -c '(begin (write %load-path) (newline))'
+
+There are two ways to add guile-debugging's installation directory to
+Guile's load path, if it isn't already there.
+
+1. Edit or create the `init.scm' file, which Guile reads on startup,
+   so that it includes a line like this:
+
+   (set! %load-path (cons "/usr/local/share/guile" %load-path))
+
+   but with "/usr/local" replaced by the prefix that you installed
+   guile-debugging under, if not /usr/local.
+
+   The init.scm file must be installed (if it does not already exist
+   there) in one of the directories in Guile's default load-path.
+
+2. Add this line to your .emacs file:
+
+   (setq gds-scheme-directory "/usr/local/share/guile")
+
+   before the `require' or `load' line that loads GDS, but with
+   "/usr/local" replaced by the prefix that you installed
+   guile-debugging under, if not /usr/local.
+
+Finally, if you want guile-debugging's GDS interface to be loaded
+automatically whenever you run Emacs, add this line to your .emacs:
+
+(require 'gds)
+
+* Troubleshooting
+
+** "error in process filter" when starting Emacs (or loading GDS)
+
+This is caused by an internal error in GDS's Scheme code, for which a
+backtrace will have appeared in the gds-debug buffer, so please switch
+to the gds-debug buffer and see what it says there.
+
+The most common cause is a load path problem: Guile cannot find GDS's
+Scheme code because it is not in the known load path.  In this case
+you should see the error message "no code for module" somewhere in the
+backtrace.  If you see this, please try the remedies described in `How
+do I install guile-debugging?' above, then restart Emacs and see if
+the problem has been cured.
+
+If you don't see "no code for module", or if the described remedies
+don't fix the problem, please send the contents of the gds-debug
+buffer to me at <neil@ossau.uklinux.net>, so I can debug the problem.
+
+If you don't see a backtrace at all in the gds-debug buffer, try the
+next item ...
+
+** "error in process filter" at some other time
+
+This is caused by an internal error somewhere in GDS's Emacs Lisp
+code.  If possible, please
+
+- switch on the `debug-on-error' option (M-x set-variable RET
+  debug-on-error RET t RET)
+
+- do whatever you were doing so that the same error happens again
+
+- send the Emacs Lisp stack trace which pops up to me at
+  <neil@ossau.uklinux.net>.
+
+If that doesn't work, please just mail me with as much detail as
+possible of what you were doing when the error occurred.
+
+* GDS Features
+
+** How do I inspect variable values?
+
+Type `e' followed by the name of the variable, then <RET>.  This
+works whenever GDS is displaying a stack for an error at at a
+breakpoint.  (You can actually `e' to evaluate any expression in the
+local environment of the selected stack frame; inspecting variables is
+the special case of this where the expression is only a variable name.)
+
+If GDS is displaying the associated source code in the window above or
+below the stack, you can see the values of any variables in the
+highlighted code just by hovering your mouse over them.
+
+** How do I change a variable's value?
+
+Type `e' and then `(set! VARNAME NEWVAL)', where VARNAME is the name
+of the variable you want to set and NEWVAL is an expression which
+Guile can evaluate to get the new value.  This works whenever GDS is
+displaying a stack for an error at at a breakpoint.  The setting will
+take effect in the local environment of the selected stack frame.
+
+** How do I change the expression that Guile is about to evaluate?
+
+Type `t' followed by the expression that you want Guile to evaluate
+instead, then <RET>.
+
+Then type one of the commands that tells Guile to continue execution.
+
+(Tweaking expressions, as described here, is only supported by the
+latest CVS version of Guile.  The GDS stack display tells you when
+tweaking is possible by adding "(tweakable)" to the first line of the
+stack window.)
+
+** How do I return a value from the current stack frame different to what the evaluator has calculated?
+
+You have to be at the normal exit of the relevant frame first, so if
+GDS is not already showing you the normally calculated return value,
+type `o' to finish the evaluation of the selected frame.
+
+Then type `t' followed by the value you want to return, and <RET>.
+The value that you type can be any expression, but note that it will
+not be evaluated before being returned; for example if you type `(+ 2
+3)', the return value will be a three-element list, not 5.
+
+Finally type one of the commands that tells Guile to continue
+execution.
+
+(Tweaking return values, as described here, is only supported by the
+latest CVS version of Guile.  The GDS stack display tells you when
+tweaking is possible by adding "(tweakable)" to the first line of the
+stack window.)
+
+** How do I step over a line of code?
+
+Scheme isn't organized by lines, so it doesn't really make sense to
+think of stepping over lines.  Instead please see the next entry on
+stepping over expressions.
+
+** How do I step over an expression?
+
+It depends what you mean by "step over".  If you mean that you want
+Guile to evaluate that expression normally, but then show you its
+return value, type `o', which does exactly that.
+
+If you mean that you want to skip the evaluation of that expression
+(for example because it has side effects that you don't want to
+happen), use `t' to change the expression to something else which
+Guile will evaluate instead.
+
+There has to be a substitute expression so Guile can calculate a value
+to return to the calling frame.  If you know at a particular point
+that the return value is not important, you can type `t #f <RET>' or
+`t 0 <RET>'.
+
+See `How do I change the expression that Guile is about to evaluate?'
+above for more on using `t'.
+
+** How do I move up and down the call stack?
+
+Type `u' to move up and `d' to move down.  "Up" in GDS means to a more
+"inner" frame, and "down" means to a more "outer" frame.
+
+** How do I run until the next breakpoint?
+
+Type `g' (for "go").
+
+** How do I run until the end of the selected stack frame?
+
+Type `o'.
+
+** How do I set a breakpoint?
+
+First identify the code that you want to set the breakpoint in, and
+what kind of breakpoint you want.  To set a breakpoint on entry to a
+top level procedure, move the cursor to anywhere in the procedure
+definition, and make sure that the region/mark is inactive.  To set a
+breakpoint on a particular expression (or sequence of expressions) set
+point and mark so that the region covers the opening parentheses of
+all the target expressions.
+
+Then type ...
+
+  `C-c C-b d' for a `debug' breakpoint, which means that GDS will
+  display the stack when the breakpoint is hit
+
+  `C-c C-b t' for a `trace' breakpoint, which means that the start and
+  end of the relevant procedure or expression(s) will be traced to the
+  *GDS Trace* buffer
+
+  `C-c C-b T' for a `trace-subtree' breakpoint, which means that every
+  evaluation step involved in the evaluation of the relevant procedure
+  or expression(s) will be traced to the *GDS Trace* buffer.
+
+You can also type `C-x <SPC>', which does the same as one of the
+above, depending on the value of `gds-default-breakpoint-type'.
+
+** How do I clear a breakpoint?
+
+Select a region containing the breakpoints that you want to clear, and
+type `C-c C-b <DEL>'.
+
+** How do I trace calls to a particular procedure or evaluations of a particular expression?
+
+In GDS this means setting a breakpoint whose type is `trace' or
+`trace-subtree'.  See `How do I set a breakpoint?' above.
+
+* Development
+
+** How can I follow or contribute to guile-debugging's development?
+
+guile-debugging is hosted at http://gna.org, so please see the project
+page there.  Feel free to raise bugs, tasks containing patches or
+feature requests, and so on.  You can also write directly to me by
+email: <neil@ossau.uklinux.net>.
+
+
+Local Variables:
+mode: outline
+End:
diff --git a/emacs/gds-scheme.el b/emacs/gds-scheme.el
index b8a161b37..bb605c364 100755
--- a/emacs/gds-scheme.el
+++ b/emacs/gds-scheme.el
@@ -5,8 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later
-;;;; version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -207,23 +206,28 @@ Emacs to display an error or trap so that the user can debug it."
                               "-q"
                               "--debug"
                               "-c"
-                              code))
-         (client nil))
+                              code)))
     ;; Note that this process can be killed automatically on Emacs
     ;; exit.
     (process-kill-without-query proc)
     ;; Set up a process filter to catch the new client's number.
     (set-process-filter proc
                         (lambda (proc string)
-                          (setq client (string-to-number string))
                           (if (process-buffer proc)
                               (with-current-buffer (process-buffer proc)
-                                (insert string)))))
+                                (insert string)
+				(or gds-client
+				    (save-excursion
+				      (goto-char (point-min))
+				      (setq gds-client
+					    (condition-case nil
+						(read (current-buffer))
+					      (error nil)))))))))
     ;; Accept output from the new process until we have its number.
-    (while (not client)
+    (while (not (with-current-buffer (process-buffer proc) gds-client))
       (accept-process-output proc))
     ;; Return the new process's client number.
-    client))
+    (with-current-buffer (process-buffer proc) gds-client)))
 
 ;;;; Evaluating code.
 
diff --git a/emacs/gds-server.el b/emacs/gds-server.el
index 86defc07b..9cfcd3aab 100644
--- a/emacs/gds-server.el
+++ b/emacs/gds-server.el
@@ -5,8 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later
-;;;; version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -44,25 +43,24 @@
   :group 'gds
   :type '(choice (const :tag "nil" nil) directory))
 
-(defun gds-start-server (procname port-or-path protocol-handler &optional bufname)
-  "Start a GDS server process called PROCNAME, listening on TCP port
-or Unix domain socket PORT-OR-PATH.  PROTOCOL-HANDLER should be a
-function that accepts and processes one protocol form.  Optional arg
-BUFNAME specifies the name of the buffer that is used for process
-output; if not specified the buffer name is the same as the process
-name."
-  (with-current-buffer (get-buffer-create (or bufname procname))
+(defun gds-start-server (procname unix-socket-name tcp-port protocol-handler)
+  "Start a GDS server process called PROCNAME, listening on Unix
+domain socket UNIX-SOCKET-NAME and TCP port number TCP-PORT.
+PROTOCOL-HANDLER should be a function that accepts and processes
+one protocol form."
+  (with-current-buffer (get-buffer-create procname)
     (erase-buffer)
     (let* ((code (format "(begin
                             %s
                             (use-modules (ice-9 gds-server))
-                            (run-server %S))"
+                            (run-server %S %S))"
 			 (if gds-scheme-directory
 			     (concat "(set! %load-path (cons "
 				     (format "%S" gds-scheme-directory)
 				     " %load-path))")
 			   "")
-                         port-or-path))
+                         unix-socket-name
+			 tcp-port))
            (process-connection-type nil) ; use a pipe
            (proc (start-process procname
                                 (current-buffer)
diff --git a/emacs/gds-test.el b/emacs/gds-test.el
new file mode 100644
index 000000000..dfd4f6c7b
--- /dev/null
+++ b/emacs/gds-test.el
@@ -0,0 +1,166 @@
+
+;; Test utility code.
+(defun gds-test-execute-keys (keys &optional keys2)
+  (execute-kbd-macro (apply 'vector (listify-key-sequence keys))))
+
+(defvar gds-test-expecting nil)
+
+(defun gds-test-protocol-hook (form)
+  (message "[protocol: %s]" (car form))
+  (if (eq (car form) gds-test-expecting)
+      (setq gds-test-expecting nil)))
+
+(defun gds-test-expect-protocol (proc &optional timeout)
+  (message "[expect: %s]" proc)
+  (setq gds-test-expecting proc)
+  (while gds-test-expecting
+    (or (accept-process-output gds-debug-server (or timeout 5))
+	(error "Timed out after %ds waiting for %s" (or timeout 5) proc))))
+
+(defun gds-test-check-buffer (name &rest strings)
+  (let ((buf (or (get-buffer name) (error "No %s buffer" name))))
+    (save-excursion
+      (set-buffer buf)
+      (goto-char (point-min))
+      (while strings
+	(search-forward (car strings))
+	(setq strings (cdr strings))))))
+
+(defun TEST (desc)
+  (message "TEST: %s" desc))
+
+;; Make sure we take GDS elisp code from this code tree.
+(setq load-path (cons (concat default-directory "emacs/") load-path))
+
+;; Protect the tests so we can do some cleanups in case of error.
+(unwind-protect
+    (progn
+
+      ;; Visit the tutorial.
+      (find-file "gds-tutorial.txt")
+
+      (TEST "Load up GDS.")
+      (search-forward "(require 'gds)")
+      (setq load-path (cons (concat default-directory "emacs/") load-path))
+      (gds-test-execute-keys "\C-x\C-e")
+
+      ;; Install our testing hook.
+      (add-hook 'gds-protocol-hook 'gds-test-protocol-hook)
+
+      (TEST "Help.")
+      (search-forward "(list-ref")
+      (backward-char 2)
+      (gds-test-execute-keys "\C-hg\C-m")
+      (gds-test-expect-protocol 'eval-results 10)
+      (gds-test-check-buffer "*Guile Help*"
+			     "help list-ref"
+			     "is a primitive procedure in the (guile) module")
+
+      (TEST "Completion.")
+      (re-search-forward "^with-output-to-s")
+      (gds-test-execute-keys "\e\C-i")
+      (beginning-of-line)
+      (or (looking-at "with-output-to-string")
+	  (error "Expected completion `with-output-to-string' failed"))
+
+      (TEST "Eval defun.")
+      (search-forward "(display z)")
+      (gds-test-execute-keys "\e\C-x")
+      (gds-test-expect-protocol 'eval-results)
+      (gds-test-check-buffer "*Guile Evaluation*"
+			     "(let ((x 1) (y 2))"
+			     "Arctangent is: 0.46"
+			     "=> 0.46")
+
+      (TEST "Multiple values.")
+      (search-forward "(values 'a ")
+      (gds-test-execute-keys "\e\C-x")
+      (gds-test-expect-protocol 'eval-results)
+      (gds-test-check-buffer "*Guile Evaluation*"
+			     "(values 'a"
+			     "hello world"
+			     "=> a"
+			     "=> b"
+			     "=> c")
+
+      (TEST "Eval region with multiple expressions.")
+      (search-forward "(display \"Arctangent is: \")")
+      (beginning-of-line)
+      (push-mark nil nil t)
+      (forward-line 3)
+      (gds-test-execute-keys "\C-c\C-r")
+      (gds-test-expect-protocol 'eval-results)
+      (gds-test-check-buffer "*Guile Evaluation*"
+			     "(display \"Arctangent is"
+			     "Arctangent is:"
+			     "=> no (or unspecified) value"
+			     "ERROR: Unbound variable: z"
+			     "=> error-in-evaluation"
+			     "Evaluating expression 3"
+			     "=> no (or unspecified) value")
+
+      (TEST "Eval syntactically unbalanced region.")
+      (search-forward "(let ((z (atan x y)))")
+      (beginning-of-line)
+      (push-mark nil nil t)
+      (forward-line 4)
+      (gds-test-execute-keys "\C-c\C-r")
+      (gds-test-expect-protocol 'eval-results)
+      (gds-test-check-buffer "*Guile Evaluation*"
+			     "(let ((z (atan"
+			     "Reading expressions to evaluate"
+			     "ERROR"
+			     "end of file"
+			     "=> error-in-read")
+
+      (TEST "Stepping through an evaluation.")
+      (search-forward "(for-each (lambda (x)")
+      (forward-line 1)
+      (push-mark nil nil t)
+      (forward-line 1)
+      (gds-test-execute-keys "\C-u\e\C-x")
+      (gds-test-expect-protocol 'stack)
+      (gds-test-execute-keys " ")
+      (gds-test-expect-protocol 'stack)
+      (gds-test-execute-keys "o")
+      (gds-test-expect-protocol 'stack)
+      (gds-test-execute-keys "o")
+      (gds-test-expect-protocol 'stack)
+      (gds-test-execute-keys "o")
+      (gds-test-expect-protocol 'stack)
+      (gds-test-execute-keys "o")
+      (gds-test-expect-protocol 'stack)
+      (gds-test-execute-keys "o")
+      (gds-test-expect-protocol 'stack)
+      (gds-test-execute-keys "o")
+      (gds-test-expect-protocol 'stack)
+      (gds-test-execute-keys "o")
+      (gds-test-expect-protocol 'stack)
+      (gds-test-execute-keys "o")
+      (gds-test-expect-protocol 'stack)
+      (gds-test-execute-keys "o")
+      (gds-test-expect-protocol 'stack)
+      (gds-test-execute-keys "o")
+      (gds-test-expect-protocol 'stack)
+      (gds-test-execute-keys "g")
+      (gds-test-expect-protocol 'eval-results)
+      (gds-test-check-buffer "*Guile Evaluation*"
+			     "(for-each (lambda"
+			     "Evaluating in current module"
+			     "3 cubed is 27"
+			     "=> no (or unspecified) value")
+
+      ;; Done.
+      (message "====================================")
+      (message "gds-test.el completed without errors")
+      (message "====================================")
+      
+      )
+
+  (switch-to-buffer "gds-debug")
+  (write-region (point-min) (point-max) "gds-test.debug")
+
+  (switch-to-buffer "*GDS Transcript*")
+  (write-region (point-min) (point-max) "gds-test.transcript")
+
+  )
diff --git a/emacs/gds-test.sh b/emacs/gds-test.sh
new file mode 100755
index 000000000..2f8ddff9f
--- /dev/null
+++ b/emacs/gds-test.sh
@@ -0,0 +1,2 @@
+#!/bin/sh
+GUILE_LOAD_PATH=$(pwd) emacs --batch --no-site-file -q -l gds-test.el < gds-test.stdin
diff --git a/emacs/gds-test.stdin b/emacs/gds-test.stdin
new file mode 100644
index 000000000..8b1378917
--- /dev/null
+++ b/emacs/gds-test.stdin
@@ -0,0 +1 @@
+
diff --git a/emacs/gds-tutorial.txt b/emacs/gds-tutorial.txt
new file mode 100755
index 000000000..4254803ec
--- /dev/null
+++ b/emacs/gds-tutorial.txt
@@ -0,0 +1,223 @@
+
+;; Welcome to the GDS tutorial!
+
+;; This tutorial teaches the use of GDS by leading you through a set
+;; of examples where you actually use GDS, in Emacs, along the way.
+;; To get maximum benefit, therefore, you should be reading this
+;; tutorial in Emacs.
+
+;; ** GDS setup
+
+;; The first thing to do, if you haven't already, is to load the GDS
+;; library into Emacs.  The Emacs Lisp expression for this is:
+
+(require 'gds)
+
+;; So, if you don't already have this in your .emacs, either add it
+;; and then restart Emacs, or evaluate it just for this Emacs session
+;; by moving the cursor to just after the closing parenthesis and
+;; typing `C-x C-e'.
+
+;; (Note that if you _have_ already loaded GDS, and you type `C-x C-e'
+;; after this expression, you will see a *Guile Evaluation* window
+;; telling you that the evaluation failed because `require' is
+;; unbound.  Don't worry; this is not a problem, and the rest of the
+;; tutorial should still work just fine.)
+
+;; ** Help
+
+;; GDS makes it easy to access the Guile help system when working on a
+;; Scheme program in Emacs.  For example, suppose that you are writing
+;; code that uses list-ref, and need to remind yourself about
+;; list-ref's arguments ...
+
+(define (penultimate l)
+  (list-ref
+
+;; Just place the cursor on the word "list-ref" and type `C-h g RET'.
+;; Try it now!
+
+;; If GDS is working correctly, a window should have popped up above
+;; or below showing the Guile help for list-ref.
+
+;; You can also do an "apropos" search through Guile's help.  If you
+;; couldn't remember the name list-ref, for example, you could search
+;; for anything matching "list" by typing `C-h C-g' and entering
+;; "list" at the minibuffer prompt.  Try doing this now: you should
+;; see a longish list of Guile definitions whose names include "list".
+;; As usual in Emacs, you can use `M-PageUp' and `M-PageDown' to
+;; conveniently scroll the other window without having to select it.
+
+;; The functions called by `C-h g' and `C-h C-g' are gds-help-symbol
+;; and gds-apropos.  They both look up the symbol or word at point by
+;; default, but that default can be overidden by typing something else
+;; at the minibuffer prompt.
+
+;; ** Completion
+
+;; As you are typing Scheme code, you can ask GDS to complete the
+;; symbol before point for you, by typing `ESC TAB'.  GDS selects
+;; possible completions by matching the text so far against all
+;; definitions in the Guile environment.  (This may be contrasted with
+;; the "dabbrev" completion performed by `M-/', which selects possible
+;; completions from the contents of Emacs buffers.  So, if you are
+;; trying to complete "with-ou", to get "with-output-to-string", for
+;; example, `ESC TAB' will always work, because with-output-to-string
+;; is always defined in Guile's default environment, whereas `M-/'
+;; will only work if one of Emacs's buffers happens to contain the
+;; full name "with-output-to-string".)
+
+;; To illustrate the idea, here are some partial names that you can
+;; try completing.  For each one, move the cursor to the end of the
+;; line and type `ESC TAB' to try to complete it.
+
+list-
+with-ou
+with-output-to-s
+mkst
+
+;; (If you are not familiar with any of the completed definitions,
+;; feel free to use `C-h g' to find out about them!)
+
+;; ** Evaluation
+
+;; GDS provides several ways for you to evaluate Scheme code from
+;; within Emacs.
+
+;; Just like in Emacs Lisp, a single expression in a buffer can be
+;; evaluated using `C-x C-e' or `C-M-x'.  For `C-x C-e', the
+;; expression is that which ends immediately before point (so that it
+;; is useful for evaluating something just after you have typed it).
+;; For `C-M-x', the expression is the "top level defun" around point;
+;; this means the balanced chunk of code around point whose opening
+;; parenthesis is in column 0.
+
+;; Take this code fragment as an example:
+
+(let ((x 1) (y 2))
+  (let ((z (atan x y)))
+    (display "Arctangent is: ")
+    (display z)
+    (newline)
+    z))
+
+;; If you move the cursor to the end of the (display z) line and type
+;; `C-x C-e', the code evaluated is just "(display z)", which normally
+;; produces an error, because z is not defined in the usual Guile
+;; environment.  If, however, you type `C-M-x' with the cursor in the
+;; same place, the code evaluated is the whole "(let ((x 1) (y 2))
+;; ...)" kaboodle, because that is the most recent expression before
+;; point that starts in column 0.
+
+;; Try these now.  The Guile Evaluation window should pop up again,
+;; and show you:
+;; - the expression that was evaluated (probably abbreviated)
+;; - the module that it was evaluated in
+;; - anything that the code wrote to its standard output
+;; - the return value(s) of the evaluation.
+;; Following the convention of the Emacs Lisp and Guile manuals,
+;; return values are indicated by the symbol "=>".
+
+;; To see what happens when an expression has multiple return values,
+;; try evaluating this one:
+
+(values 'a (begin (display "hello world\n") 'b) 'c)
+
+;; You can also evaluate a region of a buffer using `C-c C-r'.  If the
+;; code in the region consists of multiple expressions, GDS evaluates
+;; them sequentially.  For example, try selecting the following three
+;; lines and typing `C-c C-r'.
+
+    (display "Arctangent is: ")
+    (display z)
+    (newline)
+
+;; If the code in the region evaluated isn't syntactically balanced,
+;; GDS will indicate a read error, for example for this code:
+
+  (let ((z (atan x y)))
+    (display "Arctangent is: ")
+    (display z)
+    (newline)
+
+;; Finally, if you want to evaluate something quickly that is not in a
+;; buffer, you can use `C-c C-e' and type the code to evaluate at the
+;; minibuffer prompt.  The results are popped up in the same way as
+;; for code from a buffer.
+
+;; ** Breakpoints
+
+;; Before evaluating Scheme code from an Emacs buffer, you may want to
+;; set some breakpoints in it.  With GDS you can set breakpoints in
+;; Scheme code by typing `C-x SPC'.
+;;
+;; To see how this works, select the second line of the following code
+;; (the `(format ...)' line) and type `C-x SPC'.
+
+(for-each (lambda (x)
+	    (format #t "~A cubed is ~A\n" x (* x x x)))
+	  (iota 6))
+
+;; The two opening parentheses in that line should now be highlighted
+;; in red, to show that breakpoints have been set at the start of the
+;; `(format ...)' and `(* x x x)' expressions.  Then evaluate the
+;; whole for-each expression by typing `C-M-x' ...
+;;
+;; In the upper half of your Emacs, a buffer appears showing you the
+;; Scheme stack.
+;;
+;; In the lower half, the `(format ...)' expression is highlighted.
+;;
+;; What has happened is that Guile started evaluating the for-each
+;; code, but then hit the breakpoint that you set on the start of the
+;; format expression.  Guile therefore pauses the evaluation at that
+;; point and passes the stack (which encapsulates everything that is
+;; interesting about the state of Guile at that point) to GDS.  You
+;; can then explore the stack and decide how to tell Guile to
+;; continue.
+;;
+;; - If you move your mouse over any of the identifiers in the
+;;   highlighted code, a help echo (or tooltip) will appear to tell
+;;   you that identifier's current value.  (Note though that this only
+;;   works when the stack buffer is selected.  So if you have switched
+;;   to this buffer in order to scroll down and read these lines, you
+;;   will need to switch back to the stack buffer before trying this
+;;   out.)
+;;
+;; - In the stack buffer, the "=>" on the left shows you that the top
+;;   frame is currently selected.  You can move up and down the stack
+;;   by pressing the up and down arrows (or `u' and `d').  As you do
+;;   this, GDS will change the highlight in the lower window to show
+;;   the code that corresponds to the selected stack frame.
+;;
+;; - You can evaluate an arbitrary expression in the local environment
+;;   of the selected stack frame by typing `e' followed by the
+;;   expression.
+;;
+;; - You can show various bits of information about the selected frame
+;;   by typing `I', `A' and `S'.  Feel free to try these now, to see
+;;   what they do.
+;;
+;; You also have control over the continuing evaluation of this code.
+;; Here are some of the things you can do - please try them as you
+;; read.
+;;
+;; - `g' tells Guile to continue execution normally.  In this case
+;;   that means that evaluation will continue until it hits the next
+;;   breakpoint, which is on the `(* x x x)' expression.
+;;
+;; - `SPC' tells Guile to continue until the next significant event in
+;;   the same source file as the selected frame.  A "significant
+;;   event" means either beginning to evaluate an expression in the
+;;   relevant file, or completing such an evaluation, in which case
+;;   GDS tells you the value that it is returning.  Pressing `SPC'
+;;   repeatedly is a nice way to step through all the details of the
+;;   code in a given file, but stepping over calls that involve code
+;;   from other files.
+;;
+;; - `o' tells Guile to continue execution until the selected stack
+;;   frame completes, and then to show its return value.
+
+;; Local Variables:
+;; mode: scheme
+;; End:
diff --git a/emacs/gds.el b/emacs/gds.el
index 7a1486d8d..991ba7504 100644
--- a/emacs/gds.el
+++ b/emacs/gds.el
@@ -5,8 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later
-;;;; version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -37,10 +36,11 @@
 ;; The subprocess object for the debug server.
 (defvar gds-debug-server nil)
 
-(defvar gds-socket-type-alist '((tcp . 8333)
-				(unix . "/tmp/.gds_socket"))
-  "Maps each of the possible socket types that the GDS server can
-listen on to the path that it should bind to for each one.")
+(defvar gds-unix-socket-name (format "/tmp/.gds-socket-%d" (emacs-pid))
+  "Name of the Unix domain socket that GDS will listen on.")
+
+(defvar gds-tcp-port 8333
+  "The TCP port number that GDS will listen on.")
 
 (defun gds-run-debug-server ()
   "Start (or restart, if already running) the GDS debug server process."
@@ -48,10 +48,14 @@ listen on to the path that it should bind to for each one.")
   (if gds-debug-server (gds-kill-debug-server))
   (setq gds-debug-server
         (gds-start-server "gds-debug"
-			  (cdr (assq gds-server-socket-type
-				     gds-socket-type-alist))
+			  gds-unix-socket-name
+			  gds-tcp-port
 			  'gds-debug-protocol))
-  (process-kill-without-query gds-debug-server))
+  (process-kill-without-query gds-debug-server)
+  ;; Add the Unix socket name to the environment, so that Guile
+  ;; clients started from within this Emacs will be able to use it,
+  ;; and thereby ensure that they connect to the GDS in this Emacs.
+  (setenv "GDS_UNIX_SOCKET_NAME" gds-unix-socket-name))
 
 (defun gds-kill-debug-server ()
   "Kill the GDS debug server process."
@@ -138,7 +142,13 @@ listen on to the path that it should bind to for each one.")
 
 ;;;; Debugger protocol
 
+(defcustom gds-protocol-hook nil
+  "Hook called on receipt of a protocol form from the GDS client."
+  :type 'hook
+  :group 'gds)
+
 (defun gds-debug-protocol (client form)
+  (run-hook-with-args 'gds-protocol-hook form)
   (or (eq client '*)
       (let ((proc (car form)))
         (cond ((eq proc 'name)
@@ -611,7 +621,7 @@ you would add an element to this alist to transform
   :group 'gds)
 
 (defcustom gds-server-socket-type 'tcp
-  "What kind of socket the GDS server should listen on."
+  "This option is now obsolete and has no effect."
   :group 'gds
   :type '(choice (const :tag "TCP" tcp)
 		 (const :tag "Unix" unix)))
diff --git a/emacs/gud-guile.el b/emacs/gud-guile.el
index bd1b0ff26..5d295268f 100644
--- a/emacs/gud-guile.el
+++ b/emacs/gud-guile.el
@@ -2,20 +2,20 @@
 
 ;; Copyright (C) 2001, 2006 Free Software Foundation, Inc.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free
+;;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;;; 02111-1307 USA
 
 ;;; Author: Thien-Thi Nguyen <ttn@gnu.org>
 ;;; Version: 1
diff --git a/emacs/guile-c.el b/emacs/guile-c.el
index b23ddd30f..1ccfd4dbc 100644
--- a/emacs/guile-c.el
+++ b/emacs/guile-c.el
@@ -2,20 +2,20 @@
 
 ;; Copyright (C) 2001, 2006 Free Software Foundation, Inc.
 
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free
+;;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;;; 02111-1307 USA
 
 ;;; Commentary:
 
diff --git a/emacs/guile-emacs.scm b/emacs/guile-emacs.scm
index 000d0cc2e..4d99002b6 100644
--- a/emacs/guile-emacs.scm
+++ b/emacs/guile-emacs.scm
@@ -2,20 +2,20 @@
 
 ;; Copyright (C) 2001 Keisuke Nishida <kxn30@po.cwru.edu>
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free
+;;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;;; 02111-1307 USA
 
 ;;; Code:
 
diff --git a/emacs/guile-scheme.el b/emacs/guile-scheme.el
index a6d8b1f19..5e112a0dc 100644
--- a/emacs/guile-scheme.el
+++ b/emacs/guile-scheme.el
@@ -2,20 +2,20 @@
 
 ;; Copyright (C) 2001, 2006 Free Software Foundation, Inc.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free
+;;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;;; 02111-1307 USA
 
 ;;; Commentary:
 
diff --git a/emacs/guile.el b/emacs/guile.el
index e85c81c29..25a9b9b8e 100644
--- a/emacs/guile.el
+++ b/emacs/guile.el
@@ -2,20 +2,20 @@
 
 ;; Copyright (C) 2001 Keisuke Nishida <kxn30@po.cwru.edu>
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free
+;;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;;; 02111-1307 USA
 
 ;;; Code:
 
diff --git a/emacs/multistring.el b/emacs/multistring.el
index ca17a8469..df8419542 100644
--- a/emacs/multistring.el
+++ b/emacs/multistring.el
@@ -2,22 +2,20 @@
 
 ;; Copyright (C) 2000, 2006 Free Software Foundation, Inc.
 
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free
+;;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;;; 02111-1307 USA
 
 ;;; Author: Mikael Djurfeldt <djurfeldt@nada.kth.se>
 
diff --git a/emacs/patch.el b/emacs/patch.el
index 6bcb0876f..2fd20f579 100644
--- a/emacs/patch.el
+++ b/emacs/patch.el
@@ -2,20 +2,20 @@
 
 ;; Copyright (C) 2001, 2006 Free Software Foundation, Inc.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free
+;;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;;; 02111-1307 USA
 
 ;;; Author: Thien-Thi Nguyen <ttn@gnu.org>
 ;;; Version: 1
diff --git a/emacs/ppexpand.el b/emacs/ppexpand.el
index 7ec3b1c45..f6c18765c 100644
--- a/emacs/ppexpand.el
+++ b/emacs/ppexpand.el
@@ -2,22 +2,20 @@
 
 ;; Copyright (C) 2000, 2006 Free Software Foundation, Inc.
 
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free
+;;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;;; 02111-1307 USA
 
 ;;; Author: Mikael Djurfeldt <djurfeldt@nada.kth.se>
 
diff --git a/emacs/update-changelog.el b/emacs/update-changelog.el
index e0c0a4b11..c8dfa93a2 100644
--- a/emacs/update-changelog.el
+++ b/emacs/update-changelog.el
@@ -2,20 +2,20 @@
 
 ;;; Copyright (C) 2001, 2006 Free Software Foundation, Inc.
 
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free
+;;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;;; 02111-1307 USA
 
 ;;; Commentary:
 
diff --git a/examples/Makefile.am b/examples/Makefile.am
index 84503088f..5de528a21 100644
--- a/examples/Makefile.am
+++ b/examples/Makefile.am
@@ -1,25 +1,95 @@
 ## Process this file with Automake to create Makefile.in
 ##
-##   Copyright (C) 2001, 2006, 2008 Free Software Foundation, Inc.
+##   Copyright (C) 2001, 2006, 2008, 2009 Free Software Foundation, Inc.
 ##
 ##   This file is part of GUILE.
 ##   
-##   GUILE 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
+##   GUILE is free software; you can redistribute it and/or modify it
+##   under the terms of the GNU Lesser General Public License as
+##   published by the Free Software Foundation; either version 3, or
 ##   (at your option) any later version.
-##   
+##
 ##   GUILE is distributed in the hope that 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 GUILE; see the file COPYING.  If not, write
-##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-##   Floor, Boston, MA 02110-1301 USA
+##   GNU Lesser General Public License for more details.
+##
+##   You should have received a copy of the GNU Lesser General Public
+##   License along with GUILE; see the file COPYING.LESSER.  If not,
+##   write to the Free Software Foundation, Inc., 51 Franklin Street,
+##   Fifth Floor, Boston, MA 02110-1301 USA
+
+EXTRA_DIST = README ChangeLog-2008 check.test				\
+									\
+ scripts/README scripts/simple-hello.scm scripts/hello			\
+ scripts/fact								\
+									\
+ box/README box/box.c							\
+									\
+ box-module/README box-module/box.c					\
+									\
+ box-dynamic/README box-dynamic/box.c					\
+									\
+ box-dynamic-module/README box-dynamic-module/box.c			\
+ box-dynamic-module/box-module.scm box-dynamic-module/box-mixed.scm	\
+									\
+ modules/README modules/module-0.scm modules/module-1.scm		\
+ modules/module-2.scm modules/main					\
+									\
+ safe/README safe/safe safe/untrusted.scm safe/evil.scm
+
+AM_CFLAGS = `PATH=$(bindir):$$PATH PKG_CONFIG_PATH=$(libdir)/pkgconfig $(bindir)/guile-config compile`
+AM_LIBS   = `PATH=$(bindir):$$PATH PKG_CONFIG_PATH=$(libdir)/pkgconfig $(bindir)/guile-config link`
+
+
+box/box: box/box.o
+	-$(MKDIR_P) box
+	$(CC) $< $(AM_LIBS) -o $@
+
+box/box.o: box/box.c
+	-$(MKDIR_P) box
+	$(CC) $(AM_CFLAGS) -c $< -o $@
+
+
+box-module/box: box-module/box.o
+	-$(MKDIR_P) box-module
+	$(CC) $< $(AM_LIBS) -o $@
+
+box-module/box.o: box-module/box.c
+	-$(MKDIR_P) box-module
+	$(CC) $(AM_CFLAGS) -c $< -o $@
+
+
+libbox.la: box-dynamic/box.lo
+	$(top_builddir)/libtool --mode=link $(CC) $< $(AM_LIBS) -rpath $(libdir) -o $@
+
+box-dynamic/box.lo: box-dynamic/box.c
+	-$(MKDIR_P) box-dynamic
+	$(top_builddir)/libtool --mode=compile $(CC) $(AM_CFLAGS) -c $< -o $@
+
+
+libbox-module.la: box-dynamic-module/box.lo
+	$(top_builddir)/libtool --mode=link $(CC) $< $(AM_LIBS) -rpath $(libdir) -o $@
+
+box-dynamic-module/box.lo: box-dynamic-module/box.c
+	-$(MKDIR_P) box-dynamic-module
+	$(top_builddir)/libtool --mode=compile $(CC) $(AM_CFLAGS) -c $< -o $@
+
+
+installcheck: box/box box-module/box libbox.la libbox-module.la
+	LD_LIBRARY_PATH="$(libdir):$$LD_LIBRARY_PATH"		\
+	  LTDL_LIBRARY_PATH="$(builddir):$$LTDL_LIBRARY_PATH"	\
+	  GUILE_LOAD_PATH="$(abs_top_srcdir):$$GUILE_LOAD_PATH"	\
+	  PATH="$(bindir):$$PATH"				\
+	  GUILE_AUTO_COMPILE=0					\
+	  srcdir="$(srcdir)"					\
+	  $(srcdir)/check.test
 
-SUBDIRS = scripts box box-module box-dynamic box-dynamic-module\
- modules safe
+CLEANFILES =					\
+  box/box box/box.o				\
+  box-module/box box-module/box.o
 
-EXTRA_DIST = README ChangeLog-2008
+clean-local:
+	$(top_builddir)/libtool --mode=clean rm -f	\
+	  box-dynamic/box.lo libbox.la			\
+	  box-dynamic-module/box.lo libbox-module.la
diff --git a/examples/box-dynamic-module/Makefile.am b/examples/box-dynamic-module/Makefile.am
deleted file mode 100644
index bf18f4f66..000000000
--- a/examples/box-dynamic-module/Makefile.am
+++ /dev/null
@@ -1,36 +0,0 @@
-## Process this file with Automake to create Makefile.in
-##
-##   Copyright (C) 2001, 2006 Free Software Foundation, Inc.
-##
-##   This file is part of GUILE.
-##   
-##   GUILE 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.
-##   
-##   GUILE is distributed in the hope that 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 GUILE; see the file COPYING.  If not, write
-##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-##   Floor, Boston, MA 02110-1301 USA
-
-EXTRA_DIST = README box.c box-module.scm box-mixed.scm check.test
-
-CFLAGS=`$(bindir)/guile-config compile`
-LIBS=`$(bindir)/guile-config link`
-
-libbox-module: box.lo
-	sh ../../libtool --mode=link $(CC) $< $(LIBS) -rpath $(libdir) -o libbox-module.la
-
-box.lo: box.c
-	sh ../../libtool --mode=compile $(CC) $(CFLAGS) -c $< 
-
-installcheck: libbox-module
-	LTDL_LIBRARY_PATH=.libs GUILE_LOAD_PATH=$(top_srcdir):$(srcdir) $(srcdir)/check.test
-
-CLEANFILES=libbox-module.la box.lo box.o
diff --git a/examples/box-dynamic-module/box.c b/examples/box-dynamic-module/box.c
index 7d6e2ce5d..e180565eb 100644
--- a/examples/box-dynamic-module/box.c
+++ b/examples/box-dynamic-module/box.c
@@ -2,20 +2,20 @@
  * 
  *	Copyright (C) 1998,2001, 2006 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 free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3, 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.
+ * This program is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
  * 
- * You should have received a copy of the GNU General Public License
- * along with this software; see the file COPYING.  If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301 USA
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this software; see the file COPYING.LESSER.  If
+ * not, write to the Free Software Foundation, Inc., 51 Franklin
+ * Street, Fifth Floor, Boston, MA 02110-1301 USA
  */
 
 /* Include all needed declarations.  */
diff --git a/examples/box-dynamic-module/check.test b/examples/box-dynamic-module/check.test
deleted file mode 100755
index 935176d20..000000000
--- a/examples/box-dynamic-module/check.test
+++ /dev/null
@@ -1,48 +0,0 @@
-#!/bin/sh
-
-# must be run from this directory
-guile=${GUILE-../../libguile/guile}
-
-set -e
-
-#
-# ./box test #1
-#
-$guile -c '(begin (use-modules (box-module)) (let ((b (make-box))) (display b) (newline)))' > TMP
-cat <<EOF | diff -u - TMP
-#<box #f>
-EOF
-rm -f TMP
-
-#
-# ./box test #2
-#
-$guile -c '(begin (use-modules (box-module)) (let ((b (make-box))) (display b) (newline) (box-set! b 1) (display b) (newline)))' > TMP
-cat <<EOF | diff -u - TMP
-#<box #f>
-#<box 1>
-EOF
-rm -f TMP
-
-#
-# ./box test #3
-#
-$guile -c '(begin (use-modules (box-module)) (let ((b (make-box))) (display b) (newline) (box-set! b 1) (display b) (newline) (display (box-ref b)) (newline)))' > TMP
-cat <<EOF | diff -u - TMP
-#<box #f>
-#<box 1>
-1
-EOF
-rm -f TMP
-
-#
-# ./box test #4
-#
-$guile -c '(begin (use-modules (box-mixed)) (let ((b (make-box-list 1 2 3))) (display b) (newline) (display (box-map 1+ b)) (newline)))' > TMP
-cat <<EOF | diff -u - TMP
-(#<box 1> #<box 2> #<box 3>)
-(#<box 2> #<box 3> #<box 4>)
-EOF
-rm -f TMP
-
-# check.test ends here
diff --git a/examples/box-dynamic/Makefile.am b/examples/box-dynamic/Makefile.am
deleted file mode 100644
index 6fa20c59c..000000000
--- a/examples/box-dynamic/Makefile.am
+++ /dev/null
@@ -1,36 +0,0 @@
-## Process this file with Automake to create Makefile.in
-##
-##   Copyright (C) 2001, 2006 Free Software Foundation, Inc.
-##
-##   This file is part of GUILE.
-##   
-##   GUILE 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.
-##   
-##   GUILE is distributed in the hope that 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 GUILE; see the file COPYING.  If not, write
-##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-##   Floor, Boston, MA 02110-1301 USA
-
-EXTRA_DIST = README box.c check.test
-
-CFLAGS=`$(bindir)/guile-config compile`
-LIBS=`$(bindir)/guile-config link`
-
-libbox: box.lo
-	sh ../../libtool --mode=link $(CC) $< $(LIBS) -rpath $(libdir) -o libbox.la
-
-box.lo: box.c
-	sh ../../libtool --mode=compile $(CC) $(CFLAGS) -c $< 
-
-installcheck: libbox
-	LTDL_LIBRARY_PATH=.libs GUILE_LOAD_PATH=$(top_srcdir):$(srcdir) $(srcdir)/check.test
-
-CLEANFILES=libbox.la box.lo box.o
diff --git a/examples/box-dynamic/box.c b/examples/box-dynamic/box.c
index bb9529650..e96c011ab 100644
--- a/examples/box-dynamic/box.c
+++ b/examples/box-dynamic/box.c
@@ -2,20 +2,20 @@
  * 
  *	Copyright (C) 1998,2001, 2006 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 free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3, 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.
+ * This program is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
  * 
- * You should have received a copy of the GNU General Public License
- * along with this software; see the file COPYING.  If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301 USA
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this software; see the file COPYING.LESSER.  If
+ * not, write to the Free Software Foundation, Inc., 51 Franklin
+ * Street, Fifth Floor, Boston, MA 02110-1301 USA
  */
 
 /* Include all needed declarations.  */
diff --git a/examples/box-dynamic/check.test b/examples/box-dynamic/check.test
deleted file mode 100755
index c0923365c..000000000
--- a/examples/box-dynamic/check.test
+++ /dev/null
@@ -1,38 +0,0 @@
-#!/bin/sh
-
-# must be run from this directory
-guile=${GUILE-../../libguile/guile}
-
-set -e
-
-#
-# ./box test #1
-#
-$guile -c '(begin (load-extension "libbox" "scm_init_box") (let ((b (make-box))) (display b) (newline)))' > TMP
-cat <<EOF | diff -u - TMP
-#<box #f>
-EOF
-rm -f TMP
-
-#
-# ./box test #2
-#
-$guile -c '(begin (load-extension "libbox" "scm_init_box") (let ((b (make-box))) (display b) (newline) (box-set! b 1) (display b) (newline)))' > TMP
-cat <<EOF | diff -u - TMP
-#<box #f>
-#<box 1>
-EOF
-rm -f TMP
-
-#
-# ./box test #3
-#
-$guile -c '(begin (load-extension "libbox" "scm_init_box") (let ((b (make-box))) (display b) (newline) (box-set! b 1) (display b) (newline) (display (box-ref b)) (newline)))' > TMP
-cat <<EOF | diff -u - TMP
-#<box #f>
-#<box 1>
-1
-EOF
-rm -f TMP
-
-# check.test ends here
diff --git a/examples/box-module/Makefile.am b/examples/box-module/Makefile.am
deleted file mode 100644
index 4790a296c..000000000
--- a/examples/box-module/Makefile.am
+++ /dev/null
@@ -1,36 +0,0 @@
-## Process this file with Automake to create Makefile.in
-##
-##   Copyright (C) 2001, 2006 Free Software Foundation, Inc.
-##
-##   This file is part of GUILE.
-##   
-##   GUILE 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.
-##   
-##   GUILE is distributed in the hope that 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 GUILE; see the file COPYING.  If not, write
-##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-##   Floor, Boston, MA 02110-1301 USA
-
-EXTRA_DIST = README box.c check.test
-
-CFLAGS=`$(bindir)/guile-config compile`
-LIBS=`$(bindir)/guile-config link`
-
-box: box.o
-	$(CC) $< $(LIBS) -o box
-
-box.o: box.c
-	$(CC) $(CFLAGS) -c $< 
-
-installcheck: box
-	LD_LIBRARY_PATH=$(libdir) GUILE_LOAD_PATH=$(top_srcdir) $(srcdir)/check.test
-
-CLEANFILES=box box.o
diff --git a/examples/box-module/box.c b/examples/box-module/box.c
index b589b262f..b69377e38 100644
--- a/examples/box-module/box.c
+++ b/examples/box-module/box.c
@@ -2,20 +2,20 @@
  * 
  *	Copyright (C) 1998,2001, 2006 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 free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3, 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.
+ * This program is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
  * 
- * You should have received a copy of the GNU General Public License
- * along with this software; see the file COPYING.  If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301 USA
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this software; see the file COPYING.LESSER.  If
+ * not, write to the Free Software Foundation, Inc., 51 Franklin
+ * Street, Fifth Floor, Boston, MA 02110-1301 USA
  */
 
 /* Include all needed declarations.  */
diff --git a/examples/box-module/check.test b/examples/box-module/check.test
deleted file mode 100755
index 28a79d45b..000000000
--- a/examples/box-module/check.test
+++ /dev/null
@@ -1,38 +0,0 @@
-#!/bin/sh
-
-# must be run from this directory
-guile=${GUILE-../../libguile/guile}
-
-set -e
-
-#
-# ./box test #1
-#
-./box -c '(begin (use-modules (box-module)) (let ((b (make-box))) (display b) (newline)))' > TMP
-cat <<EOF | diff -u - TMP
-#<box #f>
-EOF
-rm -f TMP
-
-#
-# ./box test #2
-#
-./box -c '(begin (use-modules (box-module)) (let ((b (make-box))) (display b) (newline) (box-set! b 1) (display b) (newline)))' > TMP
-cat <<EOF | diff -u - TMP
-#<box #f>
-#<box 1>
-EOF
-rm -f TMP
-
-#
-# ./box test #3
-#
-./box -c '(begin (use-modules (box-module)) (let ((b (make-box))) (display b) (newline) (box-set! b 1) (display b) (newline) (display (box-ref b)) (newline)))' > TMP
-cat <<EOF | diff -u - TMP
-#<box #f>
-#<box 1>
-1
-EOF
-rm -f TMP
-
-# check.test ends here
diff --git a/examples/box/Makefile.am b/examples/box/Makefile.am
deleted file mode 100644
index 4790a296c..000000000
--- a/examples/box/Makefile.am
+++ /dev/null
@@ -1,36 +0,0 @@
-## Process this file with Automake to create Makefile.in
-##
-##   Copyright (C) 2001, 2006 Free Software Foundation, Inc.
-##
-##   This file is part of GUILE.
-##   
-##   GUILE 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.
-##   
-##   GUILE is distributed in the hope that 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 GUILE; see the file COPYING.  If not, write
-##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-##   Floor, Boston, MA 02110-1301 USA
-
-EXTRA_DIST = README box.c check.test
-
-CFLAGS=`$(bindir)/guile-config compile`
-LIBS=`$(bindir)/guile-config link`
-
-box: box.o
-	$(CC) $< $(LIBS) -o box
-
-box.o: box.c
-	$(CC) $(CFLAGS) -c $< 
-
-installcheck: box
-	LD_LIBRARY_PATH=$(libdir) GUILE_LOAD_PATH=$(top_srcdir) $(srcdir)/check.test
-
-CLEANFILES=box box.o
diff --git a/examples/box/box.c b/examples/box/box.c
index e36d650b3..0662c3d12 100644
--- a/examples/box/box.c
+++ b/examples/box/box.c
@@ -2,20 +2,20 @@
  * 
  *	Copyright (C) 1998,2001, 2006 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 free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3, 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.
+ * This program is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
  * 
- * You should have received a copy of the GNU General Public License
- * along with this software; see the file COPYING.  If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301 USA
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this software; see the file COPYING.LESSER.  If
+ * not, write to the Free Software Foundation, Inc., 51 Franklin
+ * Street, Fifth Floor, Boston, MA 02110-1301 USA
  */
 
 /* Include all needed declarations.  */
diff --git a/examples/box/check.test b/examples/box/check.test
deleted file mode 100755
index 1909ffb7e..000000000
--- a/examples/box/check.test
+++ /dev/null
@@ -1,38 +0,0 @@
-#!/bin/sh
-
-# must be run from this directory
-guile=${GUILE-../../libguile/guile}
-
-set -e
-
-#
-# ./box test #1
-#
-./box -c '(let ((b (make-box))) (display b) (newline))' > TMP
-cat <<EOF | diff -u - TMP
-#<box #f>
-EOF
-rm -f TMP
-
-#
-# ./box test #2
-#
-./box -c '(let ((b (make-box))) (display b) (newline) (box-set! b 1) (display b) (newline))' > TMP
-cat <<EOF | diff -u - TMP
-#<box #f>
-#<box 1>
-EOF
-rm -f TMP
-
-#
-# ./box test #3
-#
-./box -c '(let ((b (make-box))) (display b) (newline) (box-set! b 1) (display b) (newline) (display (box-ref b)) (newline))' > TMP
-cat <<EOF | diff -u - TMP
-#<box #f>
-#<box 1>
-1
-EOF
-rm -f TMP
-
-# check.test ends here
diff --git a/examples/check.test b/examples/check.test
new file mode 100755
index 000000000..b659ce8dc
--- /dev/null
+++ b/examples/check.test
@@ -0,0 +1,238 @@
+#!/bin/sh
+
+# must be run from this directory
+guile=${GUILE-../libguile/guile}
+if [ -x $guile ] ; then
+    :
+else
+    echo could not find guile interpreter.
+    echo '(are you running this script from' `dirname $0` '?)'
+    echo GUILE env var: ${GUILE-not set}
+    exit 1
+fi
+
+if test "X$srcdir" = X; then
+    srcdir=.
+fi
+
+set -e
+
+#
+# simple-hello.scm
+#
+$guile -s $srcdir/scripts/simple-hello.scm > TMP
+cat <<EOF | diff -u - TMP
+Hello, World!
+EOF
+rm -f TMP
+
+#
+# hello
+#
+$guile -s $srcdir/scripts/hello > TMP
+echo "Hello, World!" | diff -u - TMP
+rm -f TMP
+
+$guile -s $srcdir/scripts/hello --version > TMP
+echo "hello 0.0.1" | diff -u - TMP
+rm -f TMP
+
+$guile -s $srcdir/scripts/hello --help > TMP
+cat <<EOF | diff -u - TMP
+Usage: hello [options...]
+  --help, -h           Show this usage information
+  --version, -v        Show version information
+EOF
+rm -f TMP
+
+#
+# fact
+#
+case `$guile -s $srcdir/scripts/fact 5` in 120) ;; *) echo $0: error: fact 5 ;; esac
+
+
+#
+# ./box/box test #1
+#
+./box/box -c '(let ((b (make-box))) (display b) (newline))' > TMP
+cat <<EOF | diff -u - TMP
+#<box #f>
+EOF
+rm -f TMP
+
+#
+# ./box/box test #2
+#
+./box/box -c '(let ((b (make-box))) (display b) (newline) (box-set! b 1) (display b) (newline))' > TMP
+cat <<EOF | diff -u - TMP
+#<box #f>
+#<box 1>
+EOF
+rm -f TMP
+
+#
+# ./box/box test #3
+#
+./box/box -c '(let ((b (make-box))) (display b) (newline) (box-set! b 1) (display b) (newline) (display (box-ref b)) (newline))' > TMP
+cat <<EOF | diff -u - TMP
+#<box #f>
+#<box 1>
+1
+EOF
+rm -f TMP
+
+
+
+#
+# ./box-module/box test #1
+#
+./box-module/box -c '(begin (use-modules (box-module)) (let ((b (make-box))) (display b) (newline)))' > TMP
+cat <<EOF | diff -u - TMP
+#<box #f>
+EOF
+rm -f TMP
+
+#
+# ./box-module/box test #2
+#
+./box-module/box -c '(begin (use-modules (box-module)) (let ((b (make-box))) (display b) (newline) (box-set! b 1) (display b) (newline)))' > TMP
+cat <<EOF | diff -u - TMP
+#<box #f>
+#<box 1>
+EOF
+rm -f TMP
+
+#
+# ./box-module/box test #3
+#
+./box-module/box -c '(begin (use-modules (box-module)) (let ((b (make-box))) (display b) (newline) (box-set! b 1) (display b) (newline) (display (box-ref b)) (newline)))' > TMP
+cat <<EOF | diff -u - TMP
+#<box #f>
+#<box 1>
+1
+EOF
+rm -f TMP
+
+
+#
+# ./box-dynamic/box test #1
+#
+$guile -c '(begin (load-extension "libbox" "scm_init_box") (let ((b (make-box))) (display b) (newline)))' > TMP
+cat <<EOF | diff -u - TMP
+#<box #f>
+EOF
+rm -f TMP
+
+#
+# ./box-dynamic/box test #2
+#
+$guile -c '(begin (load-extension "libbox" "scm_init_box") (let ((b (make-box))) (display b) (newline) (box-set! b 1) (display b) (newline)))' > TMP
+cat <<EOF | diff -u - TMP
+#<box #f>
+#<box 1>
+EOF
+rm -f TMP
+
+#
+# ./box-dynamic/box test #3
+#
+$guile -c '(begin (load-extension "libbox" "scm_init_box") (let ((b (make-box))) (display b) (newline) (box-set! b 1) (display b) (newline) (display (box-ref b)) (newline)))' > TMP
+cat <<EOF | diff -u - TMP
+#<box #f>
+#<box 1>
+1
+EOF
+rm -f TMP
+
+
+#
+# ./box-dynamic-module/box test #1
+#
+$guile -L $srcdir/box-dynamic-module \
+  -c '(begin (use-modules (box-module)) (let ((b (make-box))) (display b) (newline)))' > TMP
+cat <<EOF | diff -u - TMP
+#<box #f>
+EOF
+rm -f TMP
+
+#
+# ./box-dynamic-module/box test #2
+#
+$guile -L $srcdir/box-dynamic-module \
+  -c '(begin (use-modules (box-module)) (let ((b (make-box))) (display b) (newline) (box-set! b 1) (display b) (newline)))' > TMP
+cat <<EOF | diff -u - TMP
+#<box #f>
+#<box 1>
+EOF
+rm -f TMP
+
+#
+# ./box-dynamic-module/box test #3
+#
+$guile -L $srcdir/box-dynamic-module \
+  -c '(begin (use-modules (box-module)) (let ((b (make-box))) (display b) (newline) (box-set! b 1) (display b) (newline) (display (box-ref b)) (newline)))' > TMP
+cat <<EOF | diff -u - TMP
+#<box #f>
+#<box 1>
+1
+EOF
+rm -f TMP
+
+#
+# ./box-dynamic-module/box test #4
+#
+$guile -L $srcdir/box-dynamic-module \
+  -c '(begin (use-modules (box-mixed)) (let ((b (make-box-list 1 2 3))) (display b) (newline) (display (box-map 1+ b)) (newline)))' > TMP
+cat <<EOF | diff -u - TMP
+(#<box 1> #<box 2> #<box 3>)
+(#<box 2> #<box 3> #<box 4>)
+EOF
+rm -f TMP
+
+
+
+#
+# ./main test
+#
+$guile -L $srcdir/modules -s $srcdir/modules/main > TMP
+cat <<EOF | diff -u - TMP
+module-0 foo
+module-0 bar
+module-1 foo
+module-1 bar
+module-2 braz
+module-2 braz
+module-2 foo
+EOF
+rm -f TMP
+
+
+#
+# ./safe untrusted.scm
+#
+$guile -s $srcdir/safe/safe $srcdir/safe/untrusted.scm > TMP
+cat <<EOF | diff -u - TMP
+1
+1
+2
+6
+24
+120
+720
+5040
+40320
+362880
+3628800
+EOF
+rm -f TMP
+
+#
+# ./safe evil.scm
+#
+$guile -s $srcdir/safe/safe $srcdir/safe/evil.scm > TMP
+cat <<EOF | diff -u - TMP
+** Exception: (unbound-variable #f "Unbound variable: ~S" (open-input-file) #f)
+EOF
+rm -f TMP
+
+# check.test ends here
diff --git a/examples/compat/compat.h b/examples/compat/compat.h
index 5ed11eff9..67f1b9bd0 100644
--- a/examples/compat/compat.h
+++ b/examples/compat/compat.h
@@ -5,9 +5,9 @@
 /*	Copyright (C) 2001, 2002, 2006, 2008 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
  * This library is distributed in the hope that it will be useful,
  * but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -16,7 +16,8 @@
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/examples/modules/Makefile.am b/examples/modules/Makefile.am
deleted file mode 100644
index 80b829b03..000000000
--- a/examples/modules/Makefile.am
+++ /dev/null
@@ -1,25 +0,0 @@
-## Process this file with Automake to create Makefile.in
-##
-##   Copyright (C) 2001, 2006 Free Software Foundation, Inc.
-##
-##   This file is part of GUILE.
-##   
-##   GUILE 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.
-##   
-##   GUILE is distributed in the hope that 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 GUILE; see the file COPYING.  If not, write
-##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-##   Floor, Boston, MA 02110-1301 USA
-
-EXTRA_DIST = README module-0.scm module-1.scm module-2.scm main check.test
-
-installcheck:
-	srcdir=$(srcdir) GUILE_LOAD_PATH=$(top_srcdir):$(srcdir) $(srcdir)/check.test
diff --git a/examples/modules/check.test b/examples/modules/check.test
deleted file mode 100755
index f7a789b69..000000000
--- a/examples/modules/check.test
+++ /dev/null
@@ -1,27 +0,0 @@
-#!/bin/sh
-
-# must be run from this directory
-guile=${GUILE-../../libguile/guile}
-
-if test "X$srcdir" = X; then
-    srcdir=.
-fi
-
-set -e
-
-#
-# ./main test
-#
-$guile -s $srcdir/main > TMP
-cat <<EOF | diff -u - TMP
-module-0 foo
-module-0 bar
-module-1 foo
-module-1 bar
-module-2 braz
-module-2 braz
-module-2 foo
-EOF
-rm -f TMP
-
-# check.test ends here
diff --git a/examples/safe/Makefile.am b/examples/safe/Makefile.am
deleted file mode 100644
index a2e966296..000000000
--- a/examples/safe/Makefile.am
+++ /dev/null
@@ -1,25 +0,0 @@
-## Process this file with Automake to create Makefile.in
-##
-##   Copyright (C) 2001, 2006 Free Software Foundation, Inc.
-##
-##   This file is part of GUILE.
-##   
-##   GUILE 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.
-##   
-##   GUILE is distributed in the hope that 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 GUILE; see the file COPYING.  If not, write
-##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-##   Floor, Boston, MA 02110-1301 USA
-
-EXTRA_DIST = README safe untrusted.scm evil.scm check.test
-
-installcheck:
-	srcdir=$(srcdir) GUILE_LOAD_PATH=$(top_srcdir) $(srcdir)/check.test
diff --git a/examples/safe/check.test b/examples/safe/check.test
deleted file mode 100755
index 9e5f192d8..000000000
--- a/examples/safe/check.test
+++ /dev/null
@@ -1,40 +0,0 @@
-#!/bin/sh
-
-# must be run from this directory
-guile=${GUILE-../../libguile/guile}
-
-if test "X$srcdir" = X; then
-    srcdir=.
-fi
-
-set -e
-
-#
-# ./safe untrusted.scm
-#
-$guile -s $srcdir/safe $srcdir/untrusted.scm > TMP
-cat <<EOF | diff -u - TMP
-1
-1
-2
-6
-24
-120
-720
-5040
-40320
-362880
-3628800
-EOF
-rm -f TMP
-
-#
-# ./safe evil.scm
-#
-$guile -s $srcdir/safe $srcdir/evil.scm > TMP
-cat <<EOF | diff -u - TMP
-** Exception: (unbound-variable #f "Unbound variable: ~S" (open-input-file) #f)
-EOF
-rm -f TMP
-
-# check.test ends here
diff --git a/examples/scripts/Makefile.am b/examples/scripts/Makefile.am
deleted file mode 100644
index cd588f543..000000000
--- a/examples/scripts/Makefile.am
+++ /dev/null
@@ -1,25 +0,0 @@
-## Process this file with Automake to create Makefile.in
-##
-##   Copyright (C) 2001, 2006 Free Software Foundation, Inc.
-##
-##   This file is part of GUILE.
-##
-##   GUILE 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.
-##
-##   GUILE is distributed in the hope that 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 GUILE; see the file COPYING.  If not, write
-##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-##   Floor, Boston, MA 02110-1301 USA
-
-EXTRA_DIST = README simple-hello.scm hello fact check.test
-
-installcheck:
-	srcdir=$(srcdir) GUILE_LOAD_PATH=$(top_srcdir) $(srcdir)/check.test
diff --git a/examples/scripts/check.test b/examples/scripts/check.test
deleted file mode 100755
index 2a3e753d6..000000000
--- a/examples/scripts/check.test
+++ /dev/null
@@ -1,53 +0,0 @@
-#!/bin/sh
-
-# must be run from this directory
-guile=${GUILE-../../libguile/guile}
-if [ -x $guile ] ; then
-    :
-else
-    echo could not find guile interpreter.
-    echo '(are you running this script from' `dirname $0` '?)'
-    echo GUILE env var: ${GUILE-not set}
-    exit 1
-fi
-
-if test "X$srcdir" = X; then
-    srcdir=.
-fi
-
-set -e
-
-#
-# simple-hello.scm
-#
-$guile -s $srcdir/simple-hello.scm > TMP
-cat <<EOF | diff -u - TMP
-Hello, World!
-EOF
-rm -f TMP
-
-#
-# hello
-#
-$guile -s $srcdir/hello > TMP
-echo "Hello, World!" | diff -u - TMP
-rm -f TMP
-
-$guile -s $srcdir/hello --version > TMP
-echo "hello 0.0.1" | diff -u - TMP
-rm -f TMP
-
-$guile -s $srcdir/hello --help > TMP
-cat <<EOF | diff -u - TMP
-Usage: hello [options...]
-  --help, -h           Show this usage information
-  --version, -v        Show version information
-EOF
-rm -f TMP
-
-#
-# fact
-#
-case `$guile -s $srcdir/fact 5` in 120) ;; *) echo $0: error: fact 5 ;; esac
-
-# check.test ends here
diff --git a/gc-benchmarks/gc-profile.scm b/gc-benchmarks/gc-profile.scm
index 002bfc595..3365832a0 100755
--- a/gc-benchmarks/gc-profile.scm
+++ b/gc-benchmarks/gc-profile.scm
@@ -5,20 +5,20 @@ exec ${GUILE-guile} --no-debug -q -l "$0" \
 !#
 ;;; Copyright (C) 2008 Free Software Foundation, Inc.
 ;;;
-;;; This program is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 2, or (at your option)
-;;; any later version.
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 3, 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.
+;;; GNU Lesser General Public License for more details.
 ;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this software; see the file COPYING.  If not, write to
-;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;; Boston, MA 02110-1301 USA
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this software; see the file COPYING.LESSER.  If
+;;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (use-modules (ice-9 format)
              (ice-9 rdelim)
diff --git a/gc-benchmarks/run-benchmark.scm b/gc-benchmarks/run-benchmark.scm
index 509f978ee..915143f1d 100755
--- a/gc-benchmarks/run-benchmark.scm
+++ b/gc-benchmarks/run-benchmark.scm
@@ -6,20 +6,20 @@ exec ${GUILE-guile} -q -l "$0"                                  \
 !#
 ;;; Copyright (C) 2008 Free Software Foundation, Inc.
 ;;;
-;;; This program is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 2, or (at your option)
-;;; any later version.
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 3, 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.
+;;; GNU Lesser General Public License for more details.
 ;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this software; see the file COPYING.  If not, write to
-;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;; Boston, MA 02110-1301 USA
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this software; see the file COPYING.LESSER.  If
+;;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (use-modules (ice-9 rdelim)
              (ice-9 popen)
@@ -233,7 +233,7 @@ Report bugs to <bug-guile@gnu.org>.~%"))
            (ref-env   (assoc-ref args 'reference-environment))
            (bdwgc-env (or (assoc-ref args 'bdwgc-environment)
                           (string-append "GUILE=" bench-dir
-                                         "/../pre-inst-guile")))
+                                         "/../meta/guile")))
            (prof-opts (assoc-ref args 'profile-options)))
       (for-each (lambda (benchmark)
                   (let ((ref   (parse-result (run-reference-guile ref-env
diff --git a/gdbinit b/gdbinit
new file mode 100644
index 000000000..b66e3e249
--- /dev/null
+++ b/gdbinit
@@ -0,0 +1,197 @@
+# -*- GDB-Script -*-
+
+define newline
+  call (void)scm_newline (scm_current_error_port ())
+end
+
+define pp
+  call (void)scm_call_1 (scm_variable_ref (scm_c_module_lookup (scm_c_resolve_module ("ice-9 pretty-print"), "pretty-print")), $arg0)
+end
+
+define gdisplay
+  call (void)scm_display ($arg0, scm_current_error_port ())
+  newline
+end
+
+define gwrite
+  call (void)scm_write ($arg0, scm_current_error_port ())
+  newline
+end
+
+define sputs
+  call (void)scm_puts ($arg0, scm_current_error_port ())
+end
+
+define gslot
+  print ((SCM**)$arg0)[1][$arg1]
+end
+
+define pslot
+  gslot $arg0 $arg1
+  gwrite $
+end
+
+define lforeach
+  set $l=$arg0
+  while $l != 0x404
+    set $x=scm_car($l)
+    $arg1 $x
+    set $l = scm_cdr($l)
+  end
+end
+
+define modsum
+  modname $arg0
+  gslot $arg0 1
+  set $uses=$
+  output "uses:\n"
+  lforeach $uses modname
+end
+
+define moduses
+  pslot $arg0 1
+end
+
+define modname
+  pslot $arg0 5
+end
+
+define modkind
+  pslot $arg0 6
+end
+
+define car
+  call scm_car ($arg0)
+end
+
+define cdr
+  call scm_cdr ($arg0)
+end
+
+define smobwordtox
+  set $x=((SCM*)$arg0)[$arg1]
+end
+
+define smobdatatox
+  smobwordtox $arg0 1
+end
+
+define program_objcode
+  smobdatatox $arg0
+  set $objcode=$x
+  smobdatatox $objcode
+  p *(struct scm_objcode*)$x
+end
+
+define proglocals
+  set $i=bp->nlocs
+  while $i > 0
+    set $i=$i-1
+    gwrite fp[bp->nargs+$i]
+  end
+end
+
+define progstack
+  set $x=sp
+  while $x > stack_base
+    gwrite *$x
+    set $x=$x-1
+  end
+end
+
+define tc16
+  p ((scm_t_bits)$arg0) & 0xffff
+end
+
+define smobdescriptor
+  p scm_smobs[0xff & (((scm_t_bits)$arg0) >> 8)]
+end
+
+define vmstackinit
+  set $vmsp=sp
+  set $vmstack_base=stack_base
+  set $vmfp=fp
+  set $vmbp=bp
+  set $vmframe=0
+end
+
+define nextframe
+  set $orig_vmsp=$vmsp
+  while $vmsp > $vmstack_base
+    output $orig_vmsp - $vmsp
+    sputs "\t"
+    output $vmsp
+    sputs "\t"
+    gwrite *$vmsp
+    set $vmsp=$vmsp-1
+  end
+  newline
+  sputs "Frame "
+  output $vmframe
+  newline
+  sputs "ra:\t"
+  output $vmsp
+  sputs "\t"
+  output (SCM*)*$vmsp
+  set $vmsp=$vmsp-1
+  newline
+  sputs "mvra:\t"
+  output $vmsp
+  sputs "\t"
+  output (SCM*)*$vmsp
+  set $vmsp=$vmsp-1
+  newline
+  sputs "dl:\t"
+  output $vmsp
+  sputs "\t"
+  set $vmdl=(SCM*)(*$vmsp)
+  output $vmdl
+  newline
+  set $vmsp=$vmsp-1
+  set $vmnlocs=(int)$vmbp->nlocs
+  while $vmnlocs > 0
+    sputs "loc #"
+    output $vmnlocs
+    sputs ":\t"
+    output $vmsp
+    sputs "\t"
+    gwrite *$vmsp
+    set $vmsp=$vmsp-1
+    set $vmnlocs=$vmnlocs-1
+  end
+  set $vmnargs=(int)$vmbp->nargs
+  while $vmnargs > 0
+    sputs "arg #"
+    output $vmnargs
+    sputs ":\t"
+    output $vmsp
+    sputs "\t"
+    gwrite *$vmsp
+    set $vmsp=$vmsp-1
+    set $vmnargs=$vmnargs-1
+  end
+  sputs "prog:\t"
+  output $vmsp
+  sputs "\t"
+  gwrite *$vmsp
+  set $vmsp=$vmsp-1
+  newline
+  if $vmdl
+    set $vmfp=$vmdl
+    set $vmbp=(struct scm_objcode*)((SCM*)(((SCM*)($vmfp[-1]))[1])[1])
+    set $vmstack_base=$vmfp+$vmbp->nargs+$vmbp->nlocs+4
+    set $vmframe=$vmframe+1
+    newline
+  end
+end
+
+define vmstack
+  vmstackinit
+  while $vmsp > vp->stack_base
+    nextframe
+  end
+end
+
+define inst
+  p scm_instruction_table[$arg0]
+end
diff --git a/guile-config/Makefile.am b/guile-config/Makefile.am
deleted file mode 100644
index cedcba968..000000000
--- a/guile-config/Makefile.am
+++ /dev/null
@@ -1,46 +0,0 @@
-## Process this file with Automake to create Makefile.in
-## Jim Blandy <jimb@red-bean.com> --- September 1997
-##
-##  	Copyright (C) 1998, 1999, 2001, 2006, 2007, 2008 Free Software Foundation, Inc.
-##
-##   This file is part of GUILE.
-##   
-##   GUILE 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.
-##   
-##   GUILE is distributed in the hope that 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 GUILE; see the file COPYING.  If not, write
-##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-##   Floor, Boston, MA 02110-1301 USA
-
-bin_SCRIPTS=guile-config
-CLEANFILES=guile-config
-EXTRA_DIST=guile-config.in guile.m4 ChangeLog-2008
-
-## FIXME: in the future there will be direct automake support for
-## doing this.  When that happens, switch over.
-aclocaldir = $(datadir)/aclocal
-aclocal_DATA = guile.m4
-
-## We use @-...-@ as the substitution brackets here, instead of the
-## usual @...@, so autoconf doesn't go and substitute the values
-## directly into the left-hand sides of the sed substitutions.  *sigh*
-guile-config: guile-config.in ${top_builddir}/libguile/libpath.h
-	rm -f guile-config.tmp
-	sed < ${srcdir}/guile-config.in > guile-config.tmp \
-	    -e 's|@-bindir-@|${bindir}|' \
-	    -e s:@-GUILE_VERSION-@:${GUILE_VERSION}:
-	chmod +x guile-config.tmp
-	mv guile-config.tmp guile-config
-
-## Get rid of any copies of the configuration script under the old
-## name, so people don't end up running ancient copies of it.
-install-exec-local:
-	rm -f ${bindir}/build-guile
diff --git a/guile-readline/Makefile.am b/guile-readline/Makefile.am
index 94e6f9741..efdcd7523 100644
--- a/guile-readline/Makefile.am
+++ b/guile-readline/Makefile.am
@@ -1,33 +1,42 @@
 ## Process this file with Automake to create Makefile.in
 ##
-##  	Copyright (C) 1998, 1999, 2000, 2001, 2004, 2006, 2007, 2008 Free Software Foundation, Inc.
+##  	Copyright (C) 1998, 1999, 2000, 2001, 2004, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
 ##
-##   This file is part of GUILE.
+##   This file is part of guile-readline.
 ##
-##   GUILE 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
+##   guile-readline 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 3, or
 ##   (at your option) any later version.
 ##
-##   GUILE is distributed in the hope that 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.
+##   guile-readline is distributed in the hope that 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 GUILE; see the file COPYING.  If not, write
+##   You should have received a copy of the GNU General Public License
+##   along with guile-readline; see the file COPYING.  If not, write
 ##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
 ##   Floor, Boston, MA 02110-1301 USA
 
-SUBDIRS = ice-9
-
 ## Prevent automake from adding extra -I options
 DEFS = @DEFS@ @EXTRA_DEFS@
+
+if HAVE_READLINE
+
+# `ice-9' subdirectory.
+ice9dir = $(pkgdatadir)/$(GUILE_EFFECTIVE_VERSION)
+nobase_ice9_DATA = ice-9/readline.scm
+EXTRA_DIST = $(nobase_ice9_DATA)
+
+
 ## Check for headers in $(srcdir)/.., so that #include
 ## <libguile/MUMBLE.h> will find MUMBLE.h in this dir when we're
 ## building.  Also look for Gnulib headers in `lib'.
-INCLUDES = -I. -I.. -I$(srcdir)/..			\
-	   -I$(top_srcdir)/lib -I$(top_builddir)/lib
+AM_CPPFLAGS = -I. -I.. -I$(srcdir)/..			\
+	      -I$(top_srcdir)/lib -I$(top_builddir)/lib
+
+AM_CFLAGS = $(GCC_CFLAGS)
 
 GUILE_SNARF = ../libguile/guile-snarf
 
@@ -35,25 +44,33 @@ lib_LTLIBRARIES = libguilereadline-v-@LIBGUILEREADLINE_MAJOR@.la
 
 libguilereadline_v_@LIBGUILEREADLINE_MAJOR@_la_SOURCES = readline.c
 libguilereadline_v_@LIBGUILEREADLINE_MAJOR@_la_LIBADD =	\
-   ../libguile/libguile.la ../lib/libgnu.la
-libguilereadline_v_@LIBGUILEREADLINE_MAJOR@_la_LDFLAGS = -version-info @LIBGUILEREADLINE_INTERFACE@ -export-dynamic -no-undefined
+  $(READLINE_LIBS)					\
+  ../libguile/libguile.la ../lib/libgnu.la
+
+libguilereadline_v_@LIBGUILEREADLINE_MAJOR@_la_LDFLAGS =	\
+  -version-info @LIBGUILEREADLINE_INTERFACE@ -export-dynamic	\
+  -no-undefined
 
 
 BUILT_SOURCES = readline.x
 
 pkginclude_HEADERS = readline.h
 
-snarfcppopts = $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS)
+snarfcppopts = $(DEFS) $(AM_CPPFLAGS) $(CPPFLAGS) $(CFLAGS)
 SUFFIXES = .x
 .c.x:
 	$(GUILE_SNARF) -o $@ $< $(snarfcppopts)
 
-EXTRA_DIST = LIBGUILEREADLINE-VERSION ChangeLog-2008
+EXTRA_DIST += LIBGUILEREADLINE-VERSION ChangeLog-2008
 
-MKDEP = gcc -M -MG $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS)
+ETAGS_ARGS =							\
+  $(nobase_ice9_DATA)						\
+  $(libguilereadline_v_@LIBGUILEREADLINE_MAJOR@_la_SOURCES)
 
 CLEANFILES = *.x
 
+endif HAVE_READLINE
+
 dist-hook:
 	(temp="/tmp/mangle-deps.$$$$"; \
 	 trap "rm -f $$temp" 0 1 2 15; \
diff --git a/guile-readline/autogen.sh b/guile-readline/autogen.sh
deleted file mode 100755
index 76149ba31..000000000
--- a/guile-readline/autogen.sh
+++ /dev/null
@@ -1,8 +0,0 @@
-#!/bin/sh
-
-[ -f readline-activator.scm ] || {
-  echo "autogen.sh: run this command only in the guile-readline directory."
-  exit 1
-}
-
-autoreconf -i --force
diff --git a/guile-readline/configure.in b/guile-readline/configure.in
deleted file mode 100644
index 9098a31e6..000000000
--- a/guile-readline/configure.in
+++ /dev/null
@@ -1,158 +0,0 @@
-AC_PREREQ(2.50)
-
-dnl Don't use "echo -n", which is not portable (e.g., not available on
-dnl MacOS X).  Instead, use `patsubst' to remove the newline.
-AC_INIT(guile-readline,
-        patsubst(m4_esyscmd(. ../GUILE-VERSION && echo ${GUILE_VERSION}), [
-]),
-	[bug-guile@gnu.org])
-
-AC_CONFIG_AUX_DIR([.])
-AC_CONFIG_SRCDIR(readline.c)
-AM_CONFIG_HEADER([guile-readline-config.h])
-AM_INIT_AUTOMAKE([foreign no-define])
-
-. $srcdir/../GUILE-VERSION
-
-AC_PROG_INSTALL
-AC_PROG_CC
-AM_PROG_CC_STDC
-AC_LIBTOOL_WIN32_DLL
-AC_PROG_LIBTOOL
-
-dnl
-dnl Check for Winsock and other functionality on Win32 (*not* CygWin)
-dnl
-AC_CYGWIN
-AC_MINGW32
-EXTRA_DEFS=""
-if test "$MINGW32" = "yes" ; then
-    if test $enable_shared = yes ; then
-      EXTRA_DEFS="-DSCM_IMPORT"
-    fi
-fi
-AC_SUBST(EXTRA_DEFS)
-
-for termlib in ncurses curses termcap terminfo termlib ; do
-   AC_CHECK_LIB(${termlib}, tgoto,
-                [LIBS="-l${termlib} $LIBS"; break])
-done
-
-AC_CHECK_LIB(readline, readline)
-if test $ac_cv_lib_readline_readline = no; then
-  AC_MSG_WARN([libreadline was not found on your system.])
-fi
-
-AC_CHECK_FUNCS(siginterrupt rl_clear_signals rl_cleanup_after_signal)
-
-dnl Check for modern readline naming
-AC_CHECK_FUNCS(rl_filename_completion_function)
-
-dnl Check for rl_get_keymap.  We only use this for deciding whether to
-dnl install paren matching on the Guile command line (when using
-dnl readline for input), so it's completely optional.
-AC_CHECK_FUNCS(rl_get_keymap)
-
-dnl Check for rl_pre_input_hook.  This is more complicated because on
-dnl some systems (HP/UX), the linker wont let us treat
-dnl rl_pre_input_hook as a function when it really is a function
-dnl pointer.
-
-AC_MSG_CHECKING([for rl_pre_input_hook])
-AC_CACHE_VAL(ac_cv_var_rl_pre_input_hook,
-[AC_TRY_LINK([
-#include <stdio.h>
-#include <readline/readline.h>
-], [
-rl_pre_input_hook = 0;
-],
-ac_cv_var_rl_pre_input_hook=yes,
-ac_cv_var_rl_pre_input_hook=no)])
-AC_MSG_RESULT($ac_cv_var_rl_pre_input_hook)
-if test $ac_cv_var_rl_pre_input_hook = yes; then
-  AC_DEFINE(HAVE_RL_PRE_INPUT_HOOK,1,
-            [Define if rl_pre_input_hook is available.])
-fi
-
-
-AC_MSG_CHECKING(if readline clears SA_RESTART flag for SIGWINCH)
-AC_CACHE_VAL(guile_cv_sigwinch_sa_restart_cleared,
-AC_TRY_RUN([#include <signal.h>
-#include <stdio.h>
-#include <readline/readline.h>
-
-int
-hook ()
-{
-  struct sigaction action;
-
-  sigaction (SIGWINCH, NULL, &action);
-  rl_cleanup_after_signal();
-
-  /* exit with 0 if readline disabled SA_RESTART */
-  exit (action.sa_flags & SA_RESTART);
-}
-
-int
-main ()
-{
-  struct sigaction action;
-
-  sigaction (SIGWINCH, NULL, &action);
-  action.sa_flags |= SA_RESTART;
-  sigaction (SIGWINCH, &action, NULL);
-
-  /* Give readline something to read.  Otherwise, it might hang, for
-     example when run as a background process with job control.
-  */
-  rl_instream = fopen ("/dev/null", "r");
-  if (rl_instream == NULL)
-    {
-      perror ("/dev/null");
-      exit (1);
-    }
-
-  rl_pre_input_hook = hook;
-  readline ("");
-}],
-guile_cv_sigwinch_sa_restart_cleared=yes,
-guile_cv_sigwinch_sa_restart_cleared=no,
-guile_cv_sigwinch_sa_restart_cleared=yes))
-AC_MSG_RESULT($guile_cv_sigwinch_sa_restart_cleared)
-if test $guile_cv_sigwinch_sa_restart_cleared = yes; then
-  AC_DEFINE(GUILE_SIGWINCH_SA_RESTART_CLEARED, 1,
-    [Define if readline disables SA_RESTART.])
-fi
-
-AC_CACHE_CHECK([for rl_getc_function pointer in readline],
-		 ac_cv_var_rl_getc_function,
-		 [AC_TRY_LINK([
-#include <stdio.h>
-#include <readline/readline.h>],
-			      [printf ("%ld", (long) rl_getc_function)],
-			      [ac_cv_var_rl_getc_function=yes],
-			      [ac_cv_var_rl_getc_function=no])])
-if test "${ac_cv_var_rl_getc_function}" = "yes"; then
-  AC_DEFINE(HAVE_RL_GETC_FUNCTION, 1,
-    [Define if your readline library has the rl_getc_function variable.])
-fi
-
-if test $ac_cv_lib_readline_readline = yes \
-        -a $ac_cv_var_rl_getc_function = no; then
-  AC_MSG_WARN([*** libreadline is too old on your system.])
-  AC_MSG_WARN([*** You need readline version 2.1 or later.])
-fi
-
-AC_CHECK_FUNCS(strdup)
-
-. $srcdir/LIBGUILEREADLINE-VERSION
-AC_SUBST(LIBGUILEREADLINE_MAJOR)
-AC_SUBST(LIBGUILEREADLINE_INTERFACE_CURRENT)
-AC_SUBST(LIBGUILEREADLINE_INTERFACE_REVISION)
-AC_SUBST(LIBGUILEREADLINE_INTERFACE_AGE)
-AC_SUBST(LIBGUILEREADLINE_INTERFACE)
-
-AC_SUBST(GUILE_EFFECTIVE_VERSION)
-
-AC_CONFIG_FILES(Makefile ice-9/Makefile)
-AC_OUTPUT
diff --git a/guile-readline/ice-9/Makefile.am b/guile-readline/ice-9/Makefile.am
deleted file mode 100644
index d1e7c8270..000000000
--- a/guile-readline/ice-9/Makefile.am
+++ /dev/null
@@ -1,28 +0,0 @@
-## Process this file with Automake to create Makefile.in
-##
-##  	Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2006, 2008 Free Software Foundation, Inc.
-##
-##   This file is part of GUILE.
-##
-##   GUILE 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.
-##
-##   GUILE is distributed in the hope that 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 GUILE; see the file COPYING.  If not, write
-##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-##   Floor, Boston, MA 02110-1301 USA
-
-# Guile's `pkgdatadir'.
-guile_pdd = $(datadir)/guile
-
-ice9dir = $(guile_pdd)/$(GUILE_EFFECTIVE_VERSION)/ice-9
-ice9_DATA = readline.scm
-ETAGS_ARGS = $(ice9_DATA)
-EXTRA_DIST = $(ice9_DATA)
diff --git a/guile-readline/ice-9/readline.scm b/guile-readline/ice-9/readline.scm
index e74bc0243..96af69e2f 100644
--- a/guile-readline/ice-9/readline.scm
+++ b/guile-readline/ice-9/readline.scm
@@ -4,7 +4,7 @@
 ;;;; 
 ;;;; 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)
+;;;; the Free Software Foundation; either version 3, or (at your option)
 ;;;; any later version.
 ;;;; 
 ;;;; This program is distributed in the hope that it will be useful,
@@ -169,24 +169,22 @@
 (define-public (set-readline-read-hook! h)
   (set! read-hook h))
 
+(define-public apropos-completion-function
+  (let ((completions '()))
+    (lambda (text cont?)
+      (if (not cont?)
+          (set! completions
+                (map symbol->string
+                     (apropos-internal
+                      (string-append "^" (regexp-quote text))))))
+      (if (null? completions)
+          #f
+          (let ((retval (car completions)))
+            (begin (set! completions (cdr completions))
+                   retval))))))
+
 (if (provided? 'regex)
-    (begin
-      (define-public apropos-completion-function
-	(let ((completions '()))
-	  (lambda (text cont?)
-	    (if (not cont?)
-		(set! completions
-		      (map symbol->string
-			   (apropos-internal
-			    (string-append "^" (regexp-quote text))))))
-	    (if (null? completions)
-		#f
-		(let ((retval (car completions)))
-		  (begin (set! completions (cdr completions))
-			 retval))))))
-
-      (set! *readline-completion-function* apropos-completion-function)
-      ))
+    (set! *readline-completion-function* apropos-completion-function))
 
 (define-public (with-readline-completion-function completer thunk)
   "With @var{completer} as readline completion function, call @var{thunk}."
@@ -215,7 +213,7 @@
 			(set-buffered-input-continuation?! (readline-port) #f)
 			(set-readline-prompt! repl-prompt "... ")
 			(set-readline-read-hook! repl-read-hook))
-		      (lambda () (read))
+		      (lambda () ((or (fluid-ref current-reader) read)))
 		      (lambda ()
 			(set-readline-prompt! outer-new-input-prompt outer-continuation-prompt)
 			(set-readline-read-hook! outer-read-hook))))))
diff --git a/guile-readline/readline.c b/guile-readline/readline.c
index 58599cacc..cbf4051cc 100644
--- a/guile-readline/readline.c
+++ b/guile-readline/readline.c
@@ -1,10 +1,10 @@
 /* readline.c --- line editing support for Guile */
 
-/* Copyright (C) 1997,1999,2000,2001, 2002, 2003, 2006, 2007, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1997,1999,2000,2001, 2002, 2003, 2006, 2007, 2008, 2009 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)
+ * the Free Software Foundation; either version 3, or (at your option)
  * any later version.
  * 
  * This program is distributed in the hope that it will be useful,
@@ -21,9 +21,9 @@
 
 
 
-
-/* Include private, configure generated header (i.e. config.h). */
-#include "guile-readline-config.h"
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
 
 #ifdef HAVE_RL_GETC_FUNCTION
 #include "libguile.h"
@@ -530,26 +530,6 @@ match_paren (int x, int k)
 }
 #endif /* HAVE_RL_GET_KEYMAP */
 
-#if defined (HAVE_RL_PRE_INPUT_HOOK) && defined (GUILE_SIGWINCH_SA_RESTART_CLEARED)
-/* Readline disables SA_RESTART on SIGWINCH.
- * This code turns it back on.
- */
-static int
-sigwinch_enable_restart (void)
-{
-#ifdef HAVE_SIGINTERRUPT
-  siginterrupt (SIGWINCH, 0);
-#else
-  struct sigaction action;
-  
-  sigaction (SIGWINCH, NULL, &action);
-  action.sa_flags |= SA_RESTART;
-  sigaction (SIGWINCH, &action, NULL);
-#endif
-  return 0;
-}
-#endif
-
 #endif /* HAVE_RL_GETC_FUNCTION */
 
 void
@@ -569,9 +549,6 @@ scm_init_readline ()
 #endif
   rl_basic_word_break_characters = "\t\n\"'`;()";
   rl_readline_name = "Guile";
-#if defined (HAVE_RL_PRE_INPUT_HOOK) && defined (GUILE_SIGWINCH_SA_RESTART_CLEARED)
-  rl_pre_input_hook = sigwinch_enable_restart;
-#endif
 
   reentry_barrier_mutex = scm_permanent_object (scm_make_mutex ());
   scm_init_opts (scm_readline_options,
diff --git a/guile-readline/readline.h b/guile-readline/readline.h
index 6242c5642..2bf5f8000 100644
--- a/guile-readline/readline.h
+++ b/guile-readline/readline.h
@@ -5,7 +5,7 @@
  * 
  * 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)
+ * the Free Software Foundation; either version 3, or (at your option)
  * any later version.
  * 
  * This program is distributed in the hope that it will be useful,
diff --git a/guile-tools.in b/guile-tools.in
deleted file mode 100644
index fc4b1274b..000000000
--- a/guile-tools.in
+++ /dev/null
@@ -1,115 +0,0 @@
-#!/bin/sh
-
-# 	Copyright (C) 2001, 2003, 2006, 2008 Free Software Foundation, Inc.
-#
-# This program is free software; you can redistribute it and/or
-# modify it under the terms of the GNU General Public License as
-# published by the Free Software Foundation; either version 2, or
-# (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this software; see the file COPYING.  If not, write to
-# the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-# Boston, MA 02110-1301 USA
-
-# Usage: See `help' func below.
-#
-# TODO
-# - handle pre-install invocation
-# - "full" option processing (but see comment below)
-#
-# Author: Thien-Thi Nguyen
-
-help ()
-{
-    cat <<EOF
-Usage: guile-tools --version
-       guile-tools --help
-       guile-tools [OPTION] PROGRAM [ARGS]
-
-If PROGRAM is "list" or omitted, display contents of scripts dir, otherwise
-PROGRAM is run w/ ARGS.  Options (only one of which may be used at a time):
- --scriptsdir DIR    -- Look in DIR for scripts
- --guileversion VERS -- Look in $pkgdatadir/VERS/scripts for scripts
- --source            -- Display PROGRAM source (ignore ARGS) to stdout
-
-Default scripts dir: $default_scriptsdir
-EOF
-}
-
-prefix="@prefix@"
-datarootdir="@datarootdir@"
-pkgdatadir="@datadir@/@PACKAGE@"
-guileversion="@GUILE_EFFECTIVE_VERSION@"
-default_scriptsdir=$pkgdatadir/$guileversion/scripts
-
-# pre-install invocation frob
-mydir=`dirname $0`
-if [ -d "$mydir/scripts" -a -f "$mydir/scripts/Makefile.am" ] ; then
-    default_scriptsdir=`(cd $mydir/scripts ; pwd)`
-fi
-
-# option processing -- basically, you can override either the script dir
-# completely, or just the guile version.  we choose implementation simplicity
-# over orthogonality.
-
-case x"$1" in
-x--version)
-    echo $0 $guileversion
-    exit 0
-    ;;
-x--help)
-    help
-    exit 0
-    ;;
-esac
-
-if [ x"$1" = x--scriptsdir ] ; then
-    user_scriptsdir=$2
-    shift
-    shift
-elif [ x"$1" = x--guileversion ] ; then
-    user_scriptsdir=$pkgdatadir/$2/scripts
-    shift
-    shift
-fi
-
-scriptsdir=${user_scriptsdir-$default_scriptsdir}
-
-if [ ! -d $scriptsdir ] ; then
-    echo $0: no such directory: $scriptsdir
-    exit 1
-fi
-
-if [ x"$1" = x -o x"$1" = xlist ] ; then
-    ls $scriptsdir
-    exit 0
-fi
-
-if [ x"$1" = x--source ] ; then
-    if [ x"$2" = x ] ; then echo $0: need to specify program ; exit 1 ; fi
-    if [ -x $scriptsdir/$2 ] ; then
-        cat $scriptsdir/$2
-        exit 0
-    else
-        echo $0: no such program: $2
-        exit 1
-    fi
-fi
-
-program=$scriptsdir/$1
-shift
-
-if [ -x $program ] ; then
-    exec $program "$@"
-else
-    echo $0: no such program: $program
-    exit 1
-fi
-
-# guile-tools ends here
diff --git a/ice-9/Makefile.am b/ice-9/Makefile.am
deleted file mode 100644
index 22299c15f..000000000
--- a/ice-9/Makefile.am
+++ /dev/null
@@ -1,58 +0,0 @@
-## Process this file with automake to produce Makefile.in.
-##
-##   Copyright (C) 1998,1999,2000,2001,2003, 2004, 2006, 2008 Free Software Foundation, Inc.
-##
-##   This file is part of GUILE.
-##
-##   GUILE 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.
-##
-##   GUILE is distributed in the hope that 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 GUILE; see the file COPYING.  If not, write
-##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-##   Floor, Boston, MA 02110-1301 USA
-
-AUTOMAKE_OPTIONS = gnu
-
-SUBDIRS = debugger debugging
-
-# These should be installed and distributed.
-ice9_sources =								\
-	and-let-star.scm boot-9.scm calling.scm common-list.scm		\
-	debug.scm debugger.scm documentation.scm emacs.scm expect.scm	\
-	format.scm getopt-long.scm hcons.scm i18n.scm			\
-	lineio.scm ls.scm mapping.scm					\
-	match.scm networking.scm null.scm optargs.scm poe.scm popen.scm	\
-	posix.scm psyntax.pp psyntax.ss q.scm r4rs.scm r5rs.scm		\
-	rdelim.scm receive.scm regex.scm runq.scm rw.scm		\
-	safe-r5rs.scm safe.scm session.scm slib.scm stack-catch.scm	\
-	streams.scm string-fun.scm syncase.scm threads.scm		\
-	buffered-input.scm time.scm history.scm channel.scm		\
-        pretty-print.scm ftw.scm gap-buffer.scm occam-channel.scm	\
-	weak-vector.scm deprecated.scm list.scm serialize.scm		\
-	gds-client.scm gds-server.scm
-
-subpkgdatadir = $(pkgdatadir)/${GUILE_EFFECTIVE_VERSION}/ice-9
-subpkgdata_DATA = $(ice9_sources)
-TAGS_FILES = $(subpkgdata_DATA)
-
-## test.scm is not currently installed.
-EXTRA_DIST = $(ice9_sources) test.scm compile-psyntax.scm ChangeLog-2008
-
-# We expect this to never be invoked when there is not already
-# ice-9/psyntax.pp in %load-path, since compile-psyntax.scm depends
-# on ice-9/syncase.scm, which does `(load-from-path "ice-9/psyntax.pp")'.
-# In other words, to bootstrap this file, you need to do something like:
-#    GUILE_LOAD_PATH=/usr/local/share/guile/1.5.4 make psyntax.pp
-include $(top_srcdir)/am/pre-inst-guile
-psyntax.pp: psyntax.ss
-	$(preinstguile) -s $(srcdir)/compile-psyntax.scm \
-		$(srcdir)/psyntax.ss $(srcdir)/psyntax.pp
-
diff --git a/ice-9/arrays.scm b/ice-9/arrays.scm
deleted file mode 100644
index 7ddcc8ab8..000000000
--- a/ice-9/arrays.scm
+++ /dev/null
@@ -1,23 +0,0 @@
-;;; installed-scm-file
-
-;;;; Copyright (C) 1999, 2001, 2004, 2006 Free Software Foundation, Inc.
-;;;; 
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
-;;;; 
-;;;; This program is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
-;;;; 
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
-;;;; 
-
-(define (array-shape a)
-  (map (lambda (ind) (if (number? ind) (list 0 (+ -1 ind)) ind))
-       (array-dimensions a)))
diff --git a/ice-9/compile-psyntax.scm b/ice-9/compile-psyntax.scm
deleted file mode 100644
index a2fe77546..000000000
--- a/ice-9/compile-psyntax.scm
+++ /dev/null
@@ -1,27 +0,0 @@
-(use-modules (ice-9 syncase))
-
-;; XXX - We need to be inside (ice-9 syncase) since psyntax.ss calls
-;; `eval' int he `interaction-environment' aka the current module and
-;; it expects to have `andmap' there.  The reason for this escapes me
-;; at the moment.
-;;
-(define-module (ice-9 syncase))
-
-(define source (list-ref (command-line) 1))
-(define target (list-ref (command-line) 2))
-
-(let ((in (open-input-file source))
-      (out (open-output-file (string-append target ".tmp"))))
-  (with-fluids ((expansion-eval-closure
-		 (module-eval-closure (current-module))))
-    (let loop ((x (read in)))
-      (if (eof-object? x)
-	  (begin
-	    (close-port out)
-	    (close-port in))
-	  (begin
-	    (write (sc-expand3 x 'c '(compile load eval)) out)
-	    (newline out)
-	    (loop (read in)))))))
-
-(system (format #f "mv -f ~s.tmp ~s" target target))
diff --git a/ice-9/debugger/Makefile.am b/ice-9/debugger/Makefile.am
deleted file mode 100644
index 7ef09a025..000000000
--- a/ice-9/debugger/Makefile.am
+++ /dev/null
@@ -1,31 +0,0 @@
-## Process this file with automake to produce Makefile.in.
-##
-##  	Copyright (C) 2002, 2004, 2006 Free Software Foundation, Inc.
-##
-##   This file is part of GUILE.
-##
-##   GUILE 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.
-##
-##   GUILE is distributed in the hope that 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 GUILE; see the file COPYING.  If not, write
-##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-##   Floor, Boston, MA 02110-1301 USA
-
-AUTOMAKE_OPTIONS = gnu
-
-# These should be installed and distributed.
-ice9_debugger_sources = command-loop.scm commands.scm state.scm trc.scm utils.scm
-
-subpkgdatadir = $(pkgdatadir)/$(GUILE_EFFECTIVE_VERSION)/ice-9/debugger
-subpkgdata_DATA = $(ice9_debugger_sources)
-TAGS_FILES = $(subpkgdata_DATA)
-
-EXTRA_DIST = $(ice9_debugger_sources)
diff --git a/ice-9/debugging/Makefile.am b/ice-9/debugging/Makefile.am
deleted file mode 100644
index 44d86d3cf..000000000
--- a/ice-9/debugging/Makefile.am
+++ /dev/null
@@ -1,33 +0,0 @@
-## Process this file with automake to produce Makefile.in.
-##
-##  	Copyright (C) 2006 Free Software Foundation, Inc.
-##
-##   This file is part of GUILE.
-##
-##   GUILE 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.
-##
-##   GUILE is distributed in the hope that 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 GUILE; see the file COPYING.  If not, write
-##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-##   Floor, Boston, MA 02110-1301 USA
-
-AUTOMAKE_OPTIONS = gnu
-
-# These should be installed and distributed.
-ice9_debugging_sources = example-fns.scm \
-               ice-9-debugger-extensions.scm \
-               steps.scm trace.scm traps.scm trc.scm
-
-subpkgdatadir = $(pkgdatadir)/${GUILE_EFFECTIVE_VERSION}/ice-9/debugging
-subpkgdata_DATA = $(ice9_debugging_sources)
-TAGS_FILES = $(subpkgdata_DATA)
-
-EXTRA_DIST = $(ice9_debugging_sources)
diff --git a/ice-9/debugging/ice-9-debugger-extensions.scm b/ice-9/debugging/ice-9-debugger-extensions.scm
deleted file mode 100644
index a8b8c970e..000000000
--- a/ice-9/debugging/ice-9-debugger-extensions.scm
+++ /dev/null
@@ -1,172 +0,0 @@
-
-(define-module (ice-9 debugging ice-9-debugger-extensions)
-  #:use-module (ice-9 debugger))
-
-;;; Upgrade the debugger state object so that it can carry a flag
-;;; indicating whether the debugging session is continuable.
-
-(cond ((string>=? (version) "1.7")
-       (use-modules (ice-9 debugger state))
-       (define-module (ice-9 debugger state)))
-      (else
-       (define-module (ice-9 debugger))))
-
-(set! state-rtd (make-record-type "debugger-state" '(stack index flags)))
-(set! state? (record-predicate state-rtd))
-(set! make-state
-  (let ((make-state-internal (record-constructor state-rtd
-						 '(stack index flags))))
-    (lambda (stack index . flags)
-      (make-state-internal stack index flags))))
-(set! state-stack (record-accessor state-rtd 'stack))
-(set! state-index (record-accessor state-rtd 'index))
-
-(define state-flags (record-accessor state-rtd 'flags))
-
-;;; Add commands that (ice-9 debugger) doesn't currently have, for
-;;; continuing or single stepping program execution.
-
-(cond ((string>=? (version) "1.7")
-       (use-modules (ice-9 debugger command-loop))
-       (define-module (ice-9 debugger command-loop)
-	 #:use-module (ice-9 debugger)
-	 #:use-module (ice-9 debugger state)
-	 #:use-module (ice-9 debugging traps))
-       (define new-define-command define-command)
-       (set! define-command
-	     (lambda (name argument-template documentation procedure)
-	       (new-define-command name argument-template procedure))))
-      (else
-       (define-module (ice-9 debugger))))
-
-(use-modules (ice-9 debugging steps))
-
-(define (assert-continuable state)
-  ;; Check that debugger is in a state where `continuing' makes sense.
-  ;; If not, signal an error.
-  (or (memq #:continuable (state-flags state))
-      (user-error "This debug session is not continuable.")))
-
-(define (debugger:continue state)
-  "Tell the program being debugged to continue running.  (In fact this is
-the same as the @code{quit} command, because it exits the debugger
-command loop and so allows whatever code it was that invoked the
-debugger to continue.)"
-  (assert-continuable state)
-  (throw 'exit-debugger))
-
-(define (debugger:finish state)
-  "Continue until evaluation of the current frame is complete, and
-print the result obtained."
-  (assert-continuable state)
-  (at-exit (- (stack-length (state-stack state))
-	      (state-index state))
-	   (list trace-trap debug-trap))
-  (debugger:continue state))
-
-(define (debugger:step state n)
-  "Tell the debugged program to do @var{n} more steps from its current
-position.  One @dfn{step} means executing until the next frame entry
-or exit of any kind.  @var{n} defaults to 1."
-  (assert-continuable state)
-  (at-step debug-trap (or n 1))
-  (debugger:continue state))
-
-(define (debugger:next state n)
-  "Tell the debugged program to do @var{n} more steps from its current
-position, but only counting frame entries and exits where the
-corresponding source code comes from the same file as the current
-stack frame.  (See @ref{Step Traps} for the details of how this
-works.)  If the current stack frame has no source code, the effect of
-this command is the same as of @code{step}.  @var{n} defaults to 1."
-  (assert-continuable state)
-  (at-step debug-trap
-	   (or n 1)
-	   (frame-file-name (stack-ref (state-stack state)
-				       (state-index state)))
-	   (if (memq #:return (state-flags state))
-	       #f
-	       (- (stack-length (state-stack state)) (state-index state))))
-  (debugger:continue state))
-
-(define-command "continue" '()
-  "Continue program execution."
-  debugger:continue)
-
-(define-command "finish" '()
-  "Continue until evaluation of the current frame is complete, and
-print the result obtained."
-  debugger:finish)
-
-(define-command "step" '('optional exact-integer)
-  "Continue until entry to @var{n}th next frame."
-  debugger:step)
-
-(define-command "next" '('optional exact-integer)
-  "Continue until entry to @var{n}th next frame in same file."
-  debugger:next)
-
-;;; Export a couple of procedures for use by (ice-9 debugging trace).
-
-(cond ((string>=? (version) "1.7"))
-      (else
-       (define-module (ice-9 debugger))
-       (export write-frame-short/expression
-	       write-frame-short/application)))
-
-;;; Provide a `debug-trap' entry point in (ice-9 debugger).  This is
-;;; designed so that it can be called to explore the stack at a
-;;; breakpoint, and to single step from the breakpoint.
-
-(define-module (ice-9 debugger))
-
-(use-modules (ice-9 debugging traps))
-
-(define *not-yet-introduced* #t)
-
-(cond ((string>=? (version) "1.7"))
-      (else
-       (define (debugger-command-loop state)
-	 (read-and-dispatch-commands state (current-input-port)))))
-
-(define-public (debug-trap trap-context)
-  "Invoke the Guile debugger to explore the stack at the specified @var{trap}."
-  (start-stack 'debugger
-	       (let* ((stack (tc:stack trap-context))
-		      (flags1 (let ((trap-type (tc:type trap-context)))
-				(case trap-type
-				  ((#:return #:error)
-				   (list trap-type
-					 (tc:return-value trap-context)))
-				  (else
-				   (list trap-type)))))
-		      (flags (if (tc:continuation trap-context)
-				 (cons #:continuable flags1)
-				 flags1))
-		      (state (apply make-state stack 0 flags)))
-		 (if *not-yet-introduced*
-		     (let ((ssize (stack-length stack)))
-		       (display "This is the Guile debugger -- for help, type `help'.\n")
-		       (set! *not-yet-introduced* #f)
-		       (if (= ssize 1)
-			   (display "There is 1 frame on the stack.\n\n")
-			   (format #t "There are ~A frames on the stack.\n\n" ssize))))
-		 (write-state-short-with-source-location state)
-		 (debugger-command-loop state))))
-
-(define write-state-short-with-source-location
-  (cond ((string>=? (version) "1.7")
-	 write-state-short)
-	(else
-	 (lambda (state)
-	   (let* ((frame (stack-ref (state-stack state) (state-index state)))
-		  (source (frame-source frame))
-		  (position (and source (source-position source))))
-	     (format #t "Frame ~A at " (frame-number frame))
-	     (if position
-		 (display-position position)
-		 (display "unknown source location"))
-	     (newline)
-	     (write-char #\tab)
-	     (write-frame-short frame)
-	     (newline))))))
diff --git a/ice-9/list.scm b/ice-9/list.scm
deleted file mode 100644
index af83d1742..000000000
--- a/ice-9/list.scm
+++ /dev/null
@@ -1,36 +0,0 @@
-;;;; List functions not provided in R5RS or srfi-1
-
-;;; Copyright (C) 2003, 2006 Free Software Foundation, Inc.
-;;;
-;; This library is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU Lesser General Public
-;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
-;; 
-;; This library is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;; Lesser General Public License for more details.
-;; 
-;; You should have received a copy of the GNU Lesser General Public
-;; License along with this library; if not, write to the Free Software
-;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-
-(define-module (ice-9 list)
-  :export (rassoc rassv rassq))
-
-(define (generic-rassoc key alist =)
-  (let loop ((ls alist))
-      (and (not (null? ls))
-	   (if (= key (cdar ls))
-	       (car ls)
-	       (loop (cdr ls))))))
-
-(define (rassoc key alist . =)
-  (generic-rassoc key alist (if (null? =) equal? (car =))))
-
-(define (rassv key alist)
-  (generic-rassoc key alist eqv?))
-
-(define (rassq key alist)
-  (generic-rassoc key alist eq?))
diff --git a/ice-9/psyntax.pp b/ice-9/psyntax.pp
deleted file mode 100644
index 4abf7bcc9..000000000
--- a/ice-9/psyntax.pp
+++ /dev/null
@@ -1,11 +0,0 @@
-(letrec ((syntmp-lambda-var-list-164 (lambda (syntmp-vars-549) (let syntmp-lvl-550 ((syntmp-vars-551 syntmp-vars-549) (syntmp-ls-552 (quote ())) (syntmp-w-553 (quote (())))) (cond ((pair? syntmp-vars-551) (syntmp-lvl-550 (cdr syntmp-vars-551) (cons (syntmp-wrap-143 (car syntmp-vars-551) syntmp-w-553) syntmp-ls-552) syntmp-w-553)) ((syntmp-id?-115 syntmp-vars-551) (cons (syntmp-wrap-143 syntmp-vars-551 syntmp-w-553) syntmp-ls-552)) ((null? syntmp-vars-551) syntmp-ls-552) ((syntmp-syntax-object?-101 syntmp-vars-551) (syntmp-lvl-550 (syntmp-syntax-object-expression-102 syntmp-vars-551) syntmp-ls-552 (syntmp-join-wraps-134 syntmp-w-553 (syntmp-syntax-object-wrap-103 syntmp-vars-551)))) ((syntmp-annotation?-89 syntmp-vars-551) (syntmp-lvl-550 (annotation-expression syntmp-vars-551) syntmp-ls-552 syntmp-w-553)) (else (cons syntmp-vars-551 syntmp-ls-552)))))) (syntmp-gen-var-163 (lambda (syntmp-id-554) (let ((syntmp-id-555 (if (syntmp-syntax-object?-101 syntmp-id-554) (syntmp-syntax-object-expression-102 syntmp-id-554) syntmp-id-554))) (if (syntmp-annotation?-89 syntmp-id-555) (gensym (symbol->string (annotation-expression syntmp-id-555))) (gensym (symbol->string syntmp-id-555)))))) (syntmp-strip-162 (lambda (syntmp-x-556 syntmp-w-557) (if (memq (quote top) (syntmp-wrap-marks-118 syntmp-w-557)) (if (or (syntmp-annotation?-89 syntmp-x-556) (and (pair? syntmp-x-556) (syntmp-annotation?-89 (car syntmp-x-556)))) (syntmp-strip-annotation-161 syntmp-x-556 #f) syntmp-x-556) (let syntmp-f-558 ((syntmp-x-559 syntmp-x-556)) (cond ((syntmp-syntax-object?-101 syntmp-x-559) (syntmp-strip-162 (syntmp-syntax-object-expression-102 syntmp-x-559) (syntmp-syntax-object-wrap-103 syntmp-x-559))) ((pair? syntmp-x-559) (let ((syntmp-a-560 (syntmp-f-558 (car syntmp-x-559))) (syntmp-d-561 (syntmp-f-558 (cdr syntmp-x-559)))) (if (and (eq? syntmp-a-560 (car syntmp-x-559)) (eq? syntmp-d-561 (cdr syntmp-x-559))) syntmp-x-559 (cons syntmp-a-560 syntmp-d-561)))) ((vector? syntmp-x-559) (let ((syntmp-old-562 (vector->list syntmp-x-559))) (let ((syntmp-new-563 (map syntmp-f-558 syntmp-old-562))) (if (andmap eq? syntmp-old-562 syntmp-new-563) syntmp-x-559 (list->vector syntmp-new-563))))) (else syntmp-x-559)))))) (syntmp-strip-annotation-161 (lambda (syntmp-x-564 syntmp-parent-565) (cond ((pair? syntmp-x-564) (let ((syntmp-new-566 (cons #f #f))) (begin (when syntmp-parent-565 (set-annotation-stripped! syntmp-parent-565 syntmp-new-566)) (set-car! syntmp-new-566 (syntmp-strip-annotation-161 (car syntmp-x-564) #f)) (set-cdr! syntmp-new-566 (syntmp-strip-annotation-161 (cdr syntmp-x-564) #f)) syntmp-new-566))) ((syntmp-annotation?-89 syntmp-x-564) (or (annotation-stripped syntmp-x-564) (syntmp-strip-annotation-161 (annotation-expression syntmp-x-564) syntmp-x-564))) ((vector? syntmp-x-564) (let ((syntmp-new-567 (make-vector (vector-length syntmp-x-564)))) (begin (when syntmp-parent-565 (set-annotation-stripped! syntmp-parent-565 syntmp-new-567)) (let syntmp-loop-568 ((syntmp-i-569 (- (vector-length syntmp-x-564) 1))) (unless (syntmp-fx<-88 syntmp-i-569 0) (vector-set! syntmp-new-567 syntmp-i-569 (syntmp-strip-annotation-161 (vector-ref syntmp-x-564 syntmp-i-569) #f)) (syntmp-loop-568 (syntmp-fx--86 syntmp-i-569 1)))) syntmp-new-567))) (else syntmp-x-564)))) (syntmp-ellipsis?-160 (lambda (syntmp-x-570) (and (syntmp-nonsymbol-id?-114 syntmp-x-570) (syntmp-free-id=?-138 syntmp-x-570 (quote #(syntax-object ... ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))))))))) (syntmp-chi-void-159 (lambda () (list (quote void)))) (syntmp-eval-local-transformer-158 (lambda (syntmp-expanded-571) (let ((syntmp-p-572 (syntmp-local-eval-hook-91 syntmp-expanded-571))) (if (procedure? syntmp-p-572) syntmp-p-572 (syntax-error syntmp-p-572 "nonprocedure transformer"))))) (syntmp-chi-local-syntax-157 (lambda (syntmp-rec?-573 syntmp-e-574 syntmp-r-575 syntmp-w-576 syntmp-s-577 syntmp-k-578) ((lambda (syntmp-tmp-579) ((lambda (syntmp-tmp-580) (if syntmp-tmp-580 (apply (lambda (syntmp-_-581 syntmp-id-582 syntmp-val-583 syntmp-e1-584 syntmp-e2-585) (let ((syntmp-ids-586 syntmp-id-582)) (if (not (syntmp-valid-bound-ids?-140 syntmp-ids-586)) (syntax-error syntmp-e-574 "duplicate bound keyword in") (let ((syntmp-labels-588 (syntmp-gen-labels-121 syntmp-ids-586))) (let ((syntmp-new-w-589 (syntmp-make-binding-wrap-132 syntmp-ids-586 syntmp-labels-588 syntmp-w-576))) (syntmp-k-578 (cons syntmp-e1-584 syntmp-e2-585) (syntmp-extend-env-109 syntmp-labels-588 (let ((syntmp-w-591 (if syntmp-rec?-573 syntmp-new-w-589 syntmp-w-576)) (syntmp-trans-r-592 (syntmp-macros-only-env-111 syntmp-r-575))) (map (lambda (syntmp-x-593) (cons (quote macro) (syntmp-eval-local-transformer-158 (syntmp-chi-151 syntmp-x-593 syntmp-trans-r-592 syntmp-w-591)))) syntmp-val-583)) syntmp-r-575) syntmp-new-w-589 syntmp-s-577)))))) syntmp-tmp-580) ((lambda (syntmp-_-595) (syntax-error (syntmp-source-wrap-144 syntmp-e-574 syntmp-w-576 syntmp-s-577))) syntmp-tmp-579))) (syntax-dispatch syntmp-tmp-579 (quote (any #(each (any any)) any . each-any))))) syntmp-e-574))) (syntmp-chi-lambda-clause-156 (lambda (syntmp-e-596 syntmp-c-597 syntmp-r-598 syntmp-w-599 syntmp-k-600) ((lambda (syntmp-tmp-601) ((lambda (syntmp-tmp-602) (if syntmp-tmp-602 (apply (lambda (syntmp-id-603 syntmp-e1-604 syntmp-e2-605) (let ((syntmp-ids-606 syntmp-id-603)) (if (not (syntmp-valid-bound-ids?-140 syntmp-ids-606)) (syntax-error syntmp-e-596 "invalid parameter list in") (let ((syntmp-labels-608 (syntmp-gen-labels-121 syntmp-ids-606)) (syntmp-new-vars-609 (map syntmp-gen-var-163 syntmp-ids-606))) (syntmp-k-600 syntmp-new-vars-609 (syntmp-chi-body-155 (cons syntmp-e1-604 syntmp-e2-605) syntmp-e-596 (syntmp-extend-var-env-110 syntmp-labels-608 syntmp-new-vars-609 syntmp-r-598) (syntmp-make-binding-wrap-132 syntmp-ids-606 syntmp-labels-608 syntmp-w-599))))))) syntmp-tmp-602) ((lambda (syntmp-tmp-611) (if syntmp-tmp-611 (apply (lambda (syntmp-ids-612 syntmp-e1-613 syntmp-e2-614) (let ((syntmp-old-ids-615 (syntmp-lambda-var-list-164 syntmp-ids-612))) (if (not (syntmp-valid-bound-ids?-140 syntmp-old-ids-615)) (syntax-error syntmp-e-596 "invalid parameter list in") (let ((syntmp-labels-616 (syntmp-gen-labels-121 syntmp-old-ids-615)) (syntmp-new-vars-617 (map syntmp-gen-var-163 syntmp-old-ids-615))) (syntmp-k-600 (let syntmp-f-618 ((syntmp-ls1-619 (cdr syntmp-new-vars-617)) (syntmp-ls2-620 (car syntmp-new-vars-617))) (if (null? syntmp-ls1-619) syntmp-ls2-620 (syntmp-f-618 (cdr syntmp-ls1-619) (cons (car syntmp-ls1-619) syntmp-ls2-620)))) (syntmp-chi-body-155 (cons syntmp-e1-613 syntmp-e2-614) syntmp-e-596 (syntmp-extend-var-env-110 syntmp-labels-616 syntmp-new-vars-617 syntmp-r-598) (syntmp-make-binding-wrap-132 syntmp-old-ids-615 syntmp-labels-616 syntmp-w-599))))))) syntmp-tmp-611) ((lambda (syntmp-_-622) (syntax-error syntmp-e-596)) syntmp-tmp-601))) (syntax-dispatch syntmp-tmp-601 (quote (any any . each-any)))))) (syntax-dispatch syntmp-tmp-601 (quote (each-any any . each-any))))) syntmp-c-597))) (syntmp-chi-body-155 (lambda (syntmp-body-623 syntmp-outer-form-624 syntmp-r-625 syntmp-w-626) (let ((syntmp-r-627 (cons (quote ("placeholder" placeholder)) syntmp-r-625))) (let ((syntmp-ribcage-628 (syntmp-make-ribcage-122 (quote ()) (quote ()) (quote ())))) (let ((syntmp-w-629 (syntmp-make-wrap-117 (syntmp-wrap-marks-118 syntmp-w-626) (cons syntmp-ribcage-628 (syntmp-wrap-subst-119 syntmp-w-626))))) (let syntmp-parse-630 ((syntmp-body-631 (map (lambda (syntmp-x-637) (cons syntmp-r-627 (syntmp-wrap-143 syntmp-x-637 syntmp-w-629))) syntmp-body-623)) (syntmp-ids-632 (quote ())) (syntmp-labels-633 (quote ())) (syntmp-vars-634 (quote ())) (syntmp-vals-635 (quote ())) (syntmp-bindings-636 (quote ()))) (if (null? syntmp-body-631) (syntax-error syntmp-outer-form-624 "no expressions in body") (let ((syntmp-e-638 (cdar syntmp-body-631)) (syntmp-er-639 (caar syntmp-body-631))) (call-with-values (lambda () (syntmp-syntax-type-149 syntmp-e-638 syntmp-er-639 (quote (())) #f syntmp-ribcage-628)) (lambda (syntmp-type-640 syntmp-value-641 syntmp-e-642 syntmp-w-643 syntmp-s-644) (let ((syntmp-t-645 syntmp-type-640)) (if (memv syntmp-t-645 (quote (define-form))) (let ((syntmp-id-646 (syntmp-wrap-143 syntmp-value-641 syntmp-w-643)) (syntmp-label-647 (syntmp-gen-label-120))) (let ((syntmp-var-648 (syntmp-gen-var-163 syntmp-id-646))) (begin (syntmp-extend-ribcage!-131 syntmp-ribcage-628 syntmp-id-646 syntmp-label-647) (syntmp-parse-630 (cdr syntmp-body-631) (cons syntmp-id-646 syntmp-ids-632) (cons syntmp-label-647 syntmp-labels-633) (cons syntmp-var-648 syntmp-vars-634) (cons (cons syntmp-er-639 (syntmp-wrap-143 syntmp-e-642 syntmp-w-643)) syntmp-vals-635) (cons (cons (quote lexical) syntmp-var-648) syntmp-bindings-636))))) (if (memv syntmp-t-645 (quote (define-syntax-form))) (let ((syntmp-id-649 (syntmp-wrap-143 syntmp-value-641 syntmp-w-643)) (syntmp-label-650 (syntmp-gen-label-120))) (begin (syntmp-extend-ribcage!-131 syntmp-ribcage-628 syntmp-id-649 syntmp-label-650) (syntmp-parse-630 (cdr syntmp-body-631) (cons syntmp-id-649 syntmp-ids-632) (cons syntmp-label-650 syntmp-labels-633) syntmp-vars-634 syntmp-vals-635 (cons (cons (quote macro) (cons syntmp-er-639 (syntmp-wrap-143 syntmp-e-642 syntmp-w-643))) syntmp-bindings-636)))) (if (memv syntmp-t-645 (quote (begin-form))) ((lambda (syntmp-tmp-651) ((lambda (syntmp-tmp-652) (if syntmp-tmp-652 (apply (lambda (syntmp-_-653 syntmp-e1-654) (syntmp-parse-630 (let syntmp-f-655 ((syntmp-forms-656 syntmp-e1-654)) (if (null? syntmp-forms-656) (cdr syntmp-body-631) (cons (cons syntmp-er-639 (syntmp-wrap-143 (car syntmp-forms-656) syntmp-w-643)) (syntmp-f-655 (cdr syntmp-forms-656))))) syntmp-ids-632 syntmp-labels-633 syntmp-vars-634 syntmp-vals-635 syntmp-bindings-636)) syntmp-tmp-652) (syntax-error syntmp-tmp-651))) (syntax-dispatch syntmp-tmp-651 (quote (any . each-any))))) syntmp-e-642) (if (memv syntmp-t-645 (quote (local-syntax-form))) (syntmp-chi-local-syntax-157 syntmp-value-641 syntmp-e-642 syntmp-er-639 syntmp-w-643 syntmp-s-644 (lambda (syntmp-forms-658 syntmp-er-659 syntmp-w-660 syntmp-s-661) (syntmp-parse-630 (let syntmp-f-662 ((syntmp-forms-663 syntmp-forms-658)) (if (null? syntmp-forms-663) (cdr syntmp-body-631) (cons (cons syntmp-er-659 (syntmp-wrap-143 (car syntmp-forms-663) syntmp-w-660)) (syntmp-f-662 (cdr syntmp-forms-663))))) syntmp-ids-632 syntmp-labels-633 syntmp-vars-634 syntmp-vals-635 syntmp-bindings-636))) (if (null? syntmp-ids-632) (syntmp-build-sequence-96 #f (map (lambda (syntmp-x-664) (syntmp-chi-151 (cdr syntmp-x-664) (car syntmp-x-664) (quote (())))) (cons (cons syntmp-er-639 (syntmp-source-wrap-144 syntmp-e-642 syntmp-w-643 syntmp-s-644)) (cdr syntmp-body-631)))) (begin (if (not (syntmp-valid-bound-ids?-140 syntmp-ids-632)) (syntax-error syntmp-outer-form-624 "invalid or duplicate identifier in definition")) (let syntmp-loop-665 ((syntmp-bs-666 syntmp-bindings-636) (syntmp-er-cache-667 #f) (syntmp-r-cache-668 #f)) (if (not (null? syntmp-bs-666)) (let ((syntmp-b-669 (car syntmp-bs-666))) (if (eq? (car syntmp-b-669) (quote macro)) (let ((syntmp-er-670 (cadr syntmp-b-669))) (let ((syntmp-r-cache-671 (if (eq? syntmp-er-670 syntmp-er-cache-667) syntmp-r-cache-668 (syntmp-macros-only-env-111 syntmp-er-670)))) (begin (set-cdr! syntmp-b-669 (syntmp-eval-local-transformer-158 (syntmp-chi-151 (cddr syntmp-b-669) syntmp-r-cache-671 (quote (()))))) (syntmp-loop-665 (cdr syntmp-bs-666) syntmp-er-670 syntmp-r-cache-671)))) (syntmp-loop-665 (cdr syntmp-bs-666) syntmp-er-cache-667 syntmp-r-cache-668))))) (set-cdr! syntmp-r-627 (syntmp-extend-env-109 syntmp-labels-633 syntmp-bindings-636 (cdr syntmp-r-627))) (syntmp-build-letrec-99 #f syntmp-vars-634 (map (lambda (syntmp-x-672) (syntmp-chi-151 (cdr syntmp-x-672) (car syntmp-x-672) (quote (())))) syntmp-vals-635) (syntmp-build-sequence-96 #f (map (lambda (syntmp-x-673) (syntmp-chi-151 (cdr syntmp-x-673) (car syntmp-x-673) (quote (())))) (cons (cons syntmp-er-639 (syntmp-source-wrap-144 syntmp-e-642 syntmp-w-643 syntmp-s-644)) (cdr syntmp-body-631)))))))))))))))))))))) (syntmp-chi-macro-154 (lambda (syntmp-p-674 syntmp-e-675 syntmp-r-676 syntmp-w-677 syntmp-rib-678) (letrec ((syntmp-rebuild-macro-output-679 (lambda (syntmp-x-680 syntmp-m-681) (cond ((pair? syntmp-x-680) (cons (syntmp-rebuild-macro-output-679 (car syntmp-x-680) syntmp-m-681) (syntmp-rebuild-macro-output-679 (cdr syntmp-x-680) syntmp-m-681))) ((syntmp-syntax-object?-101 syntmp-x-680) (let ((syntmp-w-682 (syntmp-syntax-object-wrap-103 syntmp-x-680))) (let ((syntmp-ms-683 (syntmp-wrap-marks-118 syntmp-w-682)) (syntmp-s-684 (syntmp-wrap-subst-119 syntmp-w-682))) (syntmp-make-syntax-object-100 (syntmp-syntax-object-expression-102 syntmp-x-680) (if (and (pair? syntmp-ms-683) (eq? (car syntmp-ms-683) #f)) (syntmp-make-wrap-117 (cdr syntmp-ms-683) (if syntmp-rib-678 (cons syntmp-rib-678 (cdr syntmp-s-684)) (cdr syntmp-s-684))) (syntmp-make-wrap-117 (cons syntmp-m-681 syntmp-ms-683) (if syntmp-rib-678 (cons syntmp-rib-678 (cons (quote shift) syntmp-s-684)) (cons (quote shift) syntmp-s-684)))))))) ((vector? syntmp-x-680) (let ((syntmp-n-685 (vector-length syntmp-x-680))) (let ((syntmp-v-686 (make-vector syntmp-n-685))) (let syntmp-doloop-687 ((syntmp-i-688 0)) (if (syntmp-fx=-87 syntmp-i-688 syntmp-n-685) syntmp-v-686 (begin (vector-set! syntmp-v-686 syntmp-i-688 (syntmp-rebuild-macro-output-679 (vector-ref syntmp-x-680 syntmp-i-688) syntmp-m-681)) (syntmp-doloop-687 (syntmp-fx+-85 syntmp-i-688 1)))))))) ((symbol? syntmp-x-680) (syntax-error syntmp-x-680 "encountered raw symbol in macro output")) (else syntmp-x-680))))) (syntmp-rebuild-macro-output-679 (syntmp-p-674 (syntmp-wrap-143 syntmp-e-675 (syntmp-anti-mark-130 syntmp-w-677))) (string #\m))))) (syntmp-chi-application-153 (lambda (syntmp-x-689 syntmp-e-690 syntmp-r-691 syntmp-w-692 syntmp-s-693) ((lambda (syntmp-tmp-694) ((lambda (syntmp-tmp-695) (if syntmp-tmp-695 (apply (lambda (syntmp-e0-696 syntmp-e1-697) (cons syntmp-x-689 (map (lambda (syntmp-e-698) (syntmp-chi-151 syntmp-e-698 syntmp-r-691 syntmp-w-692)) syntmp-e1-697))) syntmp-tmp-695) (syntax-error syntmp-tmp-694))) (syntax-dispatch syntmp-tmp-694 (quote (any . each-any))))) syntmp-e-690))) (syntmp-chi-expr-152 (lambda (syntmp-type-700 syntmp-value-701 syntmp-e-702 syntmp-r-703 syntmp-w-704 syntmp-s-705) (let ((syntmp-t-706 syntmp-type-700)) (if (memv syntmp-t-706 (quote (lexical))) syntmp-value-701 (if (memv syntmp-t-706 (quote (core external-macro))) (syntmp-value-701 syntmp-e-702 syntmp-r-703 syntmp-w-704 syntmp-s-705) (if (memv syntmp-t-706 (quote (lexical-call))) (syntmp-chi-application-153 syntmp-value-701 syntmp-e-702 syntmp-r-703 syntmp-w-704 syntmp-s-705) (if (memv syntmp-t-706 (quote (global-call))) (syntmp-chi-application-153 syntmp-value-701 syntmp-e-702 syntmp-r-703 syntmp-w-704 syntmp-s-705) (if (memv syntmp-t-706 (quote (constant))) (syntmp-build-data-95 syntmp-s-705 (syntmp-strip-162 (syntmp-source-wrap-144 syntmp-e-702 syntmp-w-704 syntmp-s-705) (quote (())))) (if (memv syntmp-t-706 (quote (global))) syntmp-value-701 (if (memv syntmp-t-706 (quote (call))) (syntmp-chi-application-153 (syntmp-chi-151 (car syntmp-e-702) syntmp-r-703 syntmp-w-704) syntmp-e-702 syntmp-r-703 syntmp-w-704 syntmp-s-705) (if (memv syntmp-t-706 (quote (begin-form))) ((lambda (syntmp-tmp-707) ((lambda (syntmp-tmp-708) (if syntmp-tmp-708 (apply (lambda (syntmp-_-709 syntmp-e1-710 syntmp-e2-711) (syntmp-chi-sequence-145 (cons syntmp-e1-710 syntmp-e2-711) syntmp-r-703 syntmp-w-704 syntmp-s-705)) syntmp-tmp-708) (syntax-error syntmp-tmp-707))) (syntax-dispatch syntmp-tmp-707 (quote (any any . each-any))))) syntmp-e-702) (if (memv syntmp-t-706 (quote (local-syntax-form))) (syntmp-chi-local-syntax-157 syntmp-value-701 syntmp-e-702 syntmp-r-703 syntmp-w-704 syntmp-s-705 syntmp-chi-sequence-145) (if (memv syntmp-t-706 (quote (eval-when-form))) ((lambda (syntmp-tmp-713) ((lambda (syntmp-tmp-714) (if syntmp-tmp-714 (apply (lambda (syntmp-_-715 syntmp-x-716 syntmp-e1-717 syntmp-e2-718) (let ((syntmp-when-list-719 (syntmp-chi-when-list-148 syntmp-e-702 syntmp-x-716 syntmp-w-704))) (if (memq (quote eval) syntmp-when-list-719) (syntmp-chi-sequence-145 (cons syntmp-e1-717 syntmp-e2-718) syntmp-r-703 syntmp-w-704 syntmp-s-705) (syntmp-chi-void-159)))) syntmp-tmp-714) (syntax-error syntmp-tmp-713))) (syntax-dispatch syntmp-tmp-713 (quote (any each-any any . each-any))))) syntmp-e-702) (if (memv syntmp-t-706 (quote (define-form define-syntax-form))) (syntax-error (syntmp-wrap-143 syntmp-value-701 syntmp-w-704) "invalid context for definition of") (if (memv syntmp-t-706 (quote (syntax))) (syntax-error (syntmp-source-wrap-144 syntmp-e-702 syntmp-w-704 syntmp-s-705) "reference to pattern variable outside syntax form") (if (memv syntmp-t-706 (quote (displaced-lexical))) (syntax-error (syntmp-source-wrap-144 syntmp-e-702 syntmp-w-704 syntmp-s-705) "reference to identifier outside its scope") (syntax-error (syntmp-source-wrap-144 syntmp-e-702 syntmp-w-704 syntmp-s-705)))))))))))))))))) (syntmp-chi-151 (lambda (syntmp-e-722 syntmp-r-723 syntmp-w-724) (call-with-values (lambda () (syntmp-syntax-type-149 syntmp-e-722 syntmp-r-723 syntmp-w-724 #f #f)) (lambda (syntmp-type-725 syntmp-value-726 syntmp-e-727 syntmp-w-728 syntmp-s-729) (syntmp-chi-expr-152 syntmp-type-725 syntmp-value-726 syntmp-e-727 syntmp-r-723 syntmp-w-728 syntmp-s-729))))) (syntmp-chi-top-150 (lambda (syntmp-e-730 syntmp-r-731 syntmp-w-732 syntmp-m-733 syntmp-esew-734) (call-with-values (lambda () (syntmp-syntax-type-149 syntmp-e-730 syntmp-r-731 syntmp-w-732 #f #f)) (lambda (syntmp-type-747 syntmp-value-748 syntmp-e-749 syntmp-w-750 syntmp-s-751) (let ((syntmp-t-752 syntmp-type-747)) (if (memv syntmp-t-752 (quote (begin-form))) ((lambda (syntmp-tmp-753) ((lambda (syntmp-tmp-754) (if syntmp-tmp-754 (apply (lambda (syntmp-_-755) (syntmp-chi-void-159)) syntmp-tmp-754) ((lambda (syntmp-tmp-756) (if syntmp-tmp-756 (apply (lambda (syntmp-_-757 syntmp-e1-758 syntmp-e2-759) (syntmp-chi-top-sequence-146 (cons syntmp-e1-758 syntmp-e2-759) syntmp-r-731 syntmp-w-750 syntmp-s-751 syntmp-m-733 syntmp-esew-734)) syntmp-tmp-756) (syntax-error syntmp-tmp-753))) (syntax-dispatch syntmp-tmp-753 (quote (any any . each-any)))))) (syntax-dispatch syntmp-tmp-753 (quote (any))))) syntmp-e-749) (if (memv syntmp-t-752 (quote (local-syntax-form))) (syntmp-chi-local-syntax-157 syntmp-value-748 syntmp-e-749 syntmp-r-731 syntmp-w-750 syntmp-s-751 (lambda (syntmp-body-761 syntmp-r-762 syntmp-w-763 syntmp-s-764) (syntmp-chi-top-sequence-146 syntmp-body-761 syntmp-r-762 syntmp-w-763 syntmp-s-764 syntmp-m-733 syntmp-esew-734))) (if (memv syntmp-t-752 (quote (eval-when-form))) ((lambda (syntmp-tmp-765) ((lambda (syntmp-tmp-766) (if syntmp-tmp-766 (apply (lambda (syntmp-_-767 syntmp-x-768 syntmp-e1-769 syntmp-e2-770) (let ((syntmp-when-list-771 (syntmp-chi-when-list-148 syntmp-e-749 syntmp-x-768 syntmp-w-750)) (syntmp-body-772 (cons syntmp-e1-769 syntmp-e2-770))) (cond ((eq? syntmp-m-733 (quote e)) (if (memq (quote eval) syntmp-when-list-771) (syntmp-chi-top-sequence-146 syntmp-body-772 syntmp-r-731 syntmp-w-750 syntmp-s-751 (quote e) (quote (eval))) (syntmp-chi-void-159))) ((memq (quote load) syntmp-when-list-771) (if (or (memq (quote compile) syntmp-when-list-771) (and (eq? syntmp-m-733 (quote c&e)) (memq (quote eval) syntmp-when-list-771))) (syntmp-chi-top-sequence-146 syntmp-body-772 syntmp-r-731 syntmp-w-750 syntmp-s-751 (quote c&e) (quote (compile load))) (if (memq syntmp-m-733 (quote (c c&e))) (syntmp-chi-top-sequence-146 syntmp-body-772 syntmp-r-731 syntmp-w-750 syntmp-s-751 (quote c) (quote (load))) (syntmp-chi-void-159)))) ((or (memq (quote compile) syntmp-when-list-771) (and (eq? syntmp-m-733 (quote c&e)) (memq (quote eval) syntmp-when-list-771))) (syntmp-top-level-eval-hook-90 (syntmp-chi-top-sequence-146 syntmp-body-772 syntmp-r-731 syntmp-w-750 syntmp-s-751 (quote e) (quote (eval)))) (syntmp-chi-void-159)) (else (syntmp-chi-void-159))))) syntmp-tmp-766) (syntax-error syntmp-tmp-765))) (syntax-dispatch syntmp-tmp-765 (quote (any each-any any . each-any))))) syntmp-e-749) (if (memv syntmp-t-752 (quote (define-syntax-form))) (let ((syntmp-n-775 (syntmp-id-var-name-137 syntmp-value-748 syntmp-w-750)) (syntmp-r-776 (syntmp-macros-only-env-111 syntmp-r-731))) (let ((syntmp-t-777 syntmp-m-733)) (if (memv syntmp-t-777 (quote (c))) (if (memq (quote compile) syntmp-esew-734) (let ((syntmp-e-778 (syntmp-chi-install-global-147 syntmp-n-775 (syntmp-chi-151 syntmp-e-749 syntmp-r-776 syntmp-w-750)))) (begin (syntmp-top-level-eval-hook-90 syntmp-e-778) (if (memq (quote load) syntmp-esew-734) syntmp-e-778 (syntmp-chi-void-159)))) (if (memq (quote load) syntmp-esew-734) (syntmp-chi-install-global-147 syntmp-n-775 (syntmp-chi-151 syntmp-e-749 syntmp-r-776 syntmp-w-750)) (syntmp-chi-void-159))) (if (memv syntmp-t-777 (quote (c&e))) (let ((syntmp-e-779 (syntmp-chi-install-global-147 syntmp-n-775 (syntmp-chi-151 syntmp-e-749 syntmp-r-776 syntmp-w-750)))) (begin (syntmp-top-level-eval-hook-90 syntmp-e-779) syntmp-e-779)) (begin (if (memq (quote eval) syntmp-esew-734) (syntmp-top-level-eval-hook-90 (syntmp-chi-install-global-147 syntmp-n-775 (syntmp-chi-151 syntmp-e-749 syntmp-r-776 syntmp-w-750)))) (syntmp-chi-void-159)))))) (if (memv syntmp-t-752 (quote (define-form))) (let ((syntmp-n-780 (syntmp-id-var-name-137 syntmp-value-748 syntmp-w-750))) (let ((syntmp-type-781 (syntmp-binding-type-107 (syntmp-lookup-112 syntmp-n-780 syntmp-r-731)))) (let ((syntmp-t-782 syntmp-type-781)) (if (memv syntmp-t-782 (quote (global))) (let ((syntmp-x-783 (list (quote define) syntmp-n-780 (syntmp-chi-151 syntmp-e-749 syntmp-r-731 syntmp-w-750)))) (begin (if (eq? syntmp-m-733 (quote c&e)) (syntmp-top-level-eval-hook-90 syntmp-x-783)) syntmp-x-783)) (if (memv syntmp-t-782 (quote (displaced-lexical))) (syntax-error (syntmp-wrap-143 syntmp-value-748 syntmp-w-750) "identifier out of context") (if (eq? syntmp-type-781 (quote external-macro)) (let ((syntmp-x-784 (list (quote define) syntmp-n-780 (syntmp-chi-151 syntmp-e-749 syntmp-r-731 syntmp-w-750)))) (begin (if (eq? syntmp-m-733 (quote c&e)) (syntmp-top-level-eval-hook-90 syntmp-x-784)) syntmp-x-784)) (syntax-error (syntmp-wrap-143 syntmp-value-748 syntmp-w-750) "cannot define keyword at top level"))))))) (let ((syntmp-x-785 (syntmp-chi-expr-152 syntmp-type-747 syntmp-value-748 syntmp-e-749 syntmp-r-731 syntmp-w-750 syntmp-s-751))) (begin (if (eq? syntmp-m-733 (quote c&e)) (syntmp-top-level-eval-hook-90 syntmp-x-785)) syntmp-x-785)))))))))))) (syntmp-syntax-type-149 (lambda (syntmp-e-786 syntmp-r-787 syntmp-w-788 syntmp-s-789 syntmp-rib-790) (cond ((symbol? syntmp-e-786) (let ((syntmp-n-791 (syntmp-id-var-name-137 syntmp-e-786 syntmp-w-788))) (let ((syntmp-b-792 (syntmp-lookup-112 syntmp-n-791 syntmp-r-787))) (let ((syntmp-type-793 (syntmp-binding-type-107 syntmp-b-792))) (let ((syntmp-t-794 syntmp-type-793)) (if (memv syntmp-t-794 (quote (lexical))) (values syntmp-type-793 (syntmp-binding-value-108 syntmp-b-792) syntmp-e-786 syntmp-w-788 syntmp-s-789) (if (memv syntmp-t-794 (quote (global))) (values syntmp-type-793 syntmp-n-791 syntmp-e-786 syntmp-w-788 syntmp-s-789) (if (memv syntmp-t-794 (quote (macro))) (syntmp-syntax-type-149 (syntmp-chi-macro-154 (syntmp-binding-value-108 syntmp-b-792) syntmp-e-786 syntmp-r-787 syntmp-w-788 syntmp-rib-790) syntmp-r-787 (quote (())) syntmp-s-789 syntmp-rib-790) (values syntmp-type-793 (syntmp-binding-value-108 syntmp-b-792) syntmp-e-786 syntmp-w-788 syntmp-s-789))))))))) ((pair? syntmp-e-786) (let ((syntmp-first-795 (car syntmp-e-786))) (if (syntmp-id?-115 syntmp-first-795) (let ((syntmp-n-796 (syntmp-id-var-name-137 syntmp-first-795 syntmp-w-788))) (let ((syntmp-b-797 (syntmp-lookup-112 syntmp-n-796 syntmp-r-787))) (let ((syntmp-type-798 (syntmp-binding-type-107 syntmp-b-797))) (let ((syntmp-t-799 syntmp-type-798)) (if (memv syntmp-t-799 (quote (lexical))) (values (quote lexical-call) (syntmp-binding-value-108 syntmp-b-797) syntmp-e-786 syntmp-w-788 syntmp-s-789) (if (memv syntmp-t-799 (quote (global))) (values (quote global-call) syntmp-n-796 syntmp-e-786 syntmp-w-788 syntmp-s-789) (if (memv syntmp-t-799 (quote (macro))) (syntmp-syntax-type-149 (syntmp-chi-macro-154 (syntmp-binding-value-108 syntmp-b-797) syntmp-e-786 syntmp-r-787 syntmp-w-788 syntmp-rib-790) syntmp-r-787 (quote (())) syntmp-s-789 syntmp-rib-790) (if (memv syntmp-t-799 (quote (core external-macro))) (values syntmp-type-798 (syntmp-binding-value-108 syntmp-b-797) syntmp-e-786 syntmp-w-788 syntmp-s-789) (if (memv syntmp-t-799 (quote (local-syntax))) (values (quote local-syntax-form) (syntmp-binding-value-108 syntmp-b-797) syntmp-e-786 syntmp-w-788 syntmp-s-789) (if (memv syntmp-t-799 (quote (begin))) (values (quote begin-form) #f syntmp-e-786 syntmp-w-788 syntmp-s-789) (if (memv syntmp-t-799 (quote (eval-when))) (values (quote eval-when-form) #f syntmp-e-786 syntmp-w-788 syntmp-s-789) (if (memv syntmp-t-799 (quote (define))) ((lambda (syntmp-tmp-800) ((lambda (syntmp-tmp-801) (if (if syntmp-tmp-801 (apply (lambda (syntmp-_-802 syntmp-name-803 syntmp-val-804) (syntmp-id?-115 syntmp-name-803)) syntmp-tmp-801) #f) (apply (lambda (syntmp-_-805 syntmp-name-806 syntmp-val-807) (values (quote define-form) syntmp-name-806 syntmp-val-807 syntmp-w-788 syntmp-s-789)) syntmp-tmp-801) ((lambda (syntmp-tmp-808) (if (if syntmp-tmp-808 (apply (lambda (syntmp-_-809 syntmp-name-810 syntmp-args-811 syntmp-e1-812 syntmp-e2-813) (and (syntmp-id?-115 syntmp-name-810) (syntmp-valid-bound-ids?-140 (syntmp-lambda-var-list-164 syntmp-args-811)))) syntmp-tmp-808) #f) (apply (lambda (syntmp-_-814 syntmp-name-815 syntmp-args-816 syntmp-e1-817 syntmp-e2-818) (values (quote define-form) (syntmp-wrap-143 syntmp-name-815 syntmp-w-788) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))))) (syntmp-wrap-143 (cons syntmp-args-816 (cons syntmp-e1-817 syntmp-e2-818)) syntmp-w-788)) (quote (())) syntmp-s-789)) syntmp-tmp-808) ((lambda (syntmp-tmp-820) (if (if syntmp-tmp-820 (apply (lambda (syntmp-_-821 syntmp-name-822) (syntmp-id?-115 syntmp-name-822)) syntmp-tmp-820) #f) (apply (lambda (syntmp-_-823 syntmp-name-824) (values (quote define-form) (syntmp-wrap-143 syntmp-name-824 syntmp-w-788) (quote (#(syntax-object void ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i")))))) (quote (())) syntmp-s-789)) syntmp-tmp-820) (syntax-error syntmp-tmp-800))) (syntax-dispatch syntmp-tmp-800 (quote (any any)))))) (syntax-dispatch syntmp-tmp-800 (quote (any (any . any) any . each-any)))))) (syntax-dispatch syntmp-tmp-800 (quote (any any any))))) syntmp-e-786) (if (memv syntmp-t-799 (quote (define-syntax))) ((lambda (syntmp-tmp-825) ((lambda (syntmp-tmp-826) (if (if syntmp-tmp-826 (apply (lambda (syntmp-_-827 syntmp-name-828 syntmp-val-829) (syntmp-id?-115 syntmp-name-828)) syntmp-tmp-826) #f) (apply (lambda (syntmp-_-830 syntmp-name-831 syntmp-val-832) (values (quote define-syntax-form) syntmp-name-831 syntmp-val-832 syntmp-w-788 syntmp-s-789)) syntmp-tmp-826) (syntax-error syntmp-tmp-825))) (syntax-dispatch syntmp-tmp-825 (quote (any any any))))) syntmp-e-786) (values (quote call) #f syntmp-e-786 syntmp-w-788 syntmp-s-789)))))))))))))) (values (quote call) #f syntmp-e-786 syntmp-w-788 syntmp-s-789)))) ((syntmp-syntax-object?-101 syntmp-e-786) (syntmp-syntax-type-149 (syntmp-syntax-object-expression-102 syntmp-e-786) syntmp-r-787 (syntmp-join-wraps-134 syntmp-w-788 (syntmp-syntax-object-wrap-103 syntmp-e-786)) #f syntmp-rib-790)) ((syntmp-annotation?-89 syntmp-e-786) (syntmp-syntax-type-149 (annotation-expression syntmp-e-786) syntmp-r-787 syntmp-w-788 (annotation-source syntmp-e-786) syntmp-rib-790)) ((self-evaluating? syntmp-e-786) (values (quote constant) #f syntmp-e-786 syntmp-w-788 syntmp-s-789)) (else (values (quote other) #f syntmp-e-786 syntmp-w-788 syntmp-s-789))))) (syntmp-chi-when-list-148 (lambda (syntmp-e-833 syntmp-when-list-834 syntmp-w-835) (let syntmp-f-836 ((syntmp-when-list-837 syntmp-when-list-834) (syntmp-situations-838 (quote ()))) (if (null? syntmp-when-list-837) syntmp-situations-838 (syntmp-f-836 (cdr syntmp-when-list-837) (cons (let ((syntmp-x-839 (car syntmp-when-list-837))) (cond ((syntmp-free-id=?-138 syntmp-x-839 (quote #(syntax-object compile ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i")))))) (quote compile)) ((syntmp-free-id=?-138 syntmp-x-839 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i")))))) (quote load)) ((syntmp-free-id=?-138 syntmp-x-839 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i")))))) (quote eval)) (else (syntax-error (syntmp-wrap-143 syntmp-x-839 syntmp-w-835) "invalid eval-when situation")))) syntmp-situations-838)))))) (syntmp-chi-install-global-147 (lambda (syntmp-name-840 syntmp-e-841) (list (quote install-global-transformer) (syntmp-build-data-95 #f syntmp-name-840) syntmp-e-841))) (syntmp-chi-top-sequence-146 (lambda (syntmp-body-842 syntmp-r-843 syntmp-w-844 syntmp-s-845 syntmp-m-846 syntmp-esew-847) (syntmp-build-sequence-96 syntmp-s-845 (let syntmp-dobody-848 ((syntmp-body-849 syntmp-body-842) (syntmp-r-850 syntmp-r-843) (syntmp-w-851 syntmp-w-844) (syntmp-m-852 syntmp-m-846) (syntmp-esew-853 syntmp-esew-847)) (if (null? syntmp-body-849) (quote ()) (let ((syntmp-first-854 (syntmp-chi-top-150 (car syntmp-body-849) syntmp-r-850 syntmp-w-851 syntmp-m-852 syntmp-esew-853))) (cons syntmp-first-854 (syntmp-dobody-848 (cdr syntmp-body-849) syntmp-r-850 syntmp-w-851 syntmp-m-852 syntmp-esew-853)))))))) (syntmp-chi-sequence-145 (lambda (syntmp-body-855 syntmp-r-856 syntmp-w-857 syntmp-s-858) (syntmp-build-sequence-96 syntmp-s-858 (let syntmp-dobody-859 ((syntmp-body-860 syntmp-body-855) (syntmp-r-861 syntmp-r-856) (syntmp-w-862 syntmp-w-857)) (if (null? syntmp-body-860) (quote ()) (let ((syntmp-first-863 (syntmp-chi-151 (car syntmp-body-860) syntmp-r-861 syntmp-w-862))) (cons syntmp-first-863 (syntmp-dobody-859 (cdr syntmp-body-860) syntmp-r-861 syntmp-w-862)))))))) (syntmp-source-wrap-144 (lambda (syntmp-x-864 syntmp-w-865 syntmp-s-866) (syntmp-wrap-143 (if syntmp-s-866 (make-annotation syntmp-x-864 syntmp-s-866 #f) syntmp-x-864) syntmp-w-865))) (syntmp-wrap-143 (lambda (syntmp-x-867 syntmp-w-868) (cond ((and (null? (syntmp-wrap-marks-118 syntmp-w-868)) (null? (syntmp-wrap-subst-119 syntmp-w-868))) syntmp-x-867) ((syntmp-syntax-object?-101 syntmp-x-867) (syntmp-make-syntax-object-100 (syntmp-syntax-object-expression-102 syntmp-x-867) (syntmp-join-wraps-134 syntmp-w-868 (syntmp-syntax-object-wrap-103 syntmp-x-867)))) ((null? syntmp-x-867) syntmp-x-867) (else (syntmp-make-syntax-object-100 syntmp-x-867 syntmp-w-868))))) (syntmp-bound-id-member?-142 (lambda (syntmp-x-869 syntmp-list-870) (and (not (null? syntmp-list-870)) (or (syntmp-bound-id=?-139 syntmp-x-869 (car syntmp-list-870)) (syntmp-bound-id-member?-142 syntmp-x-869 (cdr syntmp-list-870)))))) (syntmp-distinct-bound-ids?-141 (lambda (syntmp-ids-871) (let syntmp-distinct?-872 ((syntmp-ids-873 syntmp-ids-871)) (or (null? syntmp-ids-873) (and (not (syntmp-bound-id-member?-142 (car syntmp-ids-873) (cdr syntmp-ids-873))) (syntmp-distinct?-872 (cdr syntmp-ids-873))))))) (syntmp-valid-bound-ids?-140 (lambda (syntmp-ids-874) (and (let syntmp-all-ids?-875 ((syntmp-ids-876 syntmp-ids-874)) (or (null? syntmp-ids-876) (and (syntmp-id?-115 (car syntmp-ids-876)) (syntmp-all-ids?-875 (cdr syntmp-ids-876))))) (syntmp-distinct-bound-ids?-141 syntmp-ids-874)))) (syntmp-bound-id=?-139 (lambda (syntmp-i-877 syntmp-j-878) (if (and (syntmp-syntax-object?-101 syntmp-i-877) (syntmp-syntax-object?-101 syntmp-j-878)) (and (eq? (let ((syntmp-e-879 (syntmp-syntax-object-expression-102 syntmp-i-877))) (if (syntmp-annotation?-89 syntmp-e-879) (annotation-expression syntmp-e-879) syntmp-e-879)) (let ((syntmp-e-880 (syntmp-syntax-object-expression-102 syntmp-j-878))) (if (syntmp-annotation?-89 syntmp-e-880) (annotation-expression syntmp-e-880) syntmp-e-880))) (syntmp-same-marks?-136 (syntmp-wrap-marks-118 (syntmp-syntax-object-wrap-103 syntmp-i-877)) (syntmp-wrap-marks-118 (syntmp-syntax-object-wrap-103 syntmp-j-878)))) (eq? (let ((syntmp-e-881 syntmp-i-877)) (if (syntmp-annotation?-89 syntmp-e-881) (annotation-expression syntmp-e-881) syntmp-e-881)) (let ((syntmp-e-882 syntmp-j-878)) (if (syntmp-annotation?-89 syntmp-e-882) (annotation-expression syntmp-e-882) syntmp-e-882)))))) (syntmp-free-id=?-138 (lambda (syntmp-i-883 syntmp-j-884) (and (eq? (let ((syntmp-x-885 syntmp-i-883)) (let ((syntmp-e-886 (if (syntmp-syntax-object?-101 syntmp-x-885) (syntmp-syntax-object-expression-102 syntmp-x-885) syntmp-x-885))) (if (syntmp-annotation?-89 syntmp-e-886) (annotation-expression syntmp-e-886) syntmp-e-886))) (let ((syntmp-x-887 syntmp-j-884)) (let ((syntmp-e-888 (if (syntmp-syntax-object?-101 syntmp-x-887) (syntmp-syntax-object-expression-102 syntmp-x-887) syntmp-x-887))) (if (syntmp-annotation?-89 syntmp-e-888) (annotation-expression syntmp-e-888) syntmp-e-888)))) (eq? (syntmp-id-var-name-137 syntmp-i-883 (quote (()))) (syntmp-id-var-name-137 syntmp-j-884 (quote (()))))))) (syntmp-id-var-name-137 (lambda (syntmp-id-889 syntmp-w-890) (letrec ((syntmp-search-vector-rib-893 (lambda (syntmp-sym-904 syntmp-subst-905 syntmp-marks-906 syntmp-symnames-907 syntmp-ribcage-908) (let ((syntmp-n-909 (vector-length syntmp-symnames-907))) (let syntmp-f-910 ((syntmp-i-911 0)) (cond ((syntmp-fx=-87 syntmp-i-911 syntmp-n-909) (syntmp-search-891 syntmp-sym-904 (cdr syntmp-subst-905) syntmp-marks-906)) ((and (eq? (vector-ref syntmp-symnames-907 syntmp-i-911) syntmp-sym-904) (syntmp-same-marks?-136 syntmp-marks-906 (vector-ref (syntmp-ribcage-marks-125 syntmp-ribcage-908) syntmp-i-911))) (values (vector-ref (syntmp-ribcage-labels-126 syntmp-ribcage-908) syntmp-i-911) syntmp-marks-906)) (else (syntmp-f-910 (syntmp-fx+-85 syntmp-i-911 1)))))))) (syntmp-search-list-rib-892 (lambda (syntmp-sym-912 syntmp-subst-913 syntmp-marks-914 syntmp-symnames-915 syntmp-ribcage-916) (let syntmp-f-917 ((syntmp-symnames-918 syntmp-symnames-915) (syntmp-i-919 0)) (cond ((null? syntmp-symnames-918) (syntmp-search-891 syntmp-sym-912 (cdr syntmp-subst-913) syntmp-marks-914)) ((and (eq? (car syntmp-symnames-918) syntmp-sym-912) (syntmp-same-marks?-136 syntmp-marks-914 (list-ref (syntmp-ribcage-marks-125 syntmp-ribcage-916) syntmp-i-919))) (values (list-ref (syntmp-ribcage-labels-126 syntmp-ribcage-916) syntmp-i-919) syntmp-marks-914)) (else (syntmp-f-917 (cdr syntmp-symnames-918) (syntmp-fx+-85 syntmp-i-919 1))))))) (syntmp-search-891 (lambda (syntmp-sym-920 syntmp-subst-921 syntmp-marks-922) (if (null? syntmp-subst-921) (values #f syntmp-marks-922) (let ((syntmp-fst-923 (car syntmp-subst-921))) (if (eq? syntmp-fst-923 (quote shift)) (syntmp-search-891 syntmp-sym-920 (cdr syntmp-subst-921) (cdr syntmp-marks-922)) (let ((syntmp-symnames-924 (syntmp-ribcage-symnames-124 syntmp-fst-923))) (if (vector? syntmp-symnames-924) (syntmp-search-vector-rib-893 syntmp-sym-920 syntmp-subst-921 syntmp-marks-922 syntmp-symnames-924 syntmp-fst-923) (syntmp-search-list-rib-892 syntmp-sym-920 syntmp-subst-921 syntmp-marks-922 syntmp-symnames-924 syntmp-fst-923))))))))) (cond ((symbol? syntmp-id-889) (or (call-with-values (lambda () (syntmp-search-891 syntmp-id-889 (syntmp-wrap-subst-119 syntmp-w-890) (syntmp-wrap-marks-118 syntmp-w-890))) (lambda (syntmp-x-926 . syntmp-ignore-925) syntmp-x-926)) syntmp-id-889)) ((syntmp-syntax-object?-101 syntmp-id-889) (let ((syntmp-id-927 (let ((syntmp-e-929 (syntmp-syntax-object-expression-102 syntmp-id-889))) (if (syntmp-annotation?-89 syntmp-e-929) (annotation-expression syntmp-e-929) syntmp-e-929))) (syntmp-w1-928 (syntmp-syntax-object-wrap-103 syntmp-id-889))) (let ((syntmp-marks-930 (syntmp-join-marks-135 (syntmp-wrap-marks-118 syntmp-w-890) (syntmp-wrap-marks-118 syntmp-w1-928)))) (call-with-values (lambda () (syntmp-search-891 syntmp-id-927 (syntmp-wrap-subst-119 syntmp-w-890) syntmp-marks-930)) (lambda (syntmp-new-id-931 syntmp-marks-932) (or syntmp-new-id-931 (call-with-values (lambda () (syntmp-search-891 syntmp-id-927 (syntmp-wrap-subst-119 syntmp-w1-928) syntmp-marks-932)) (lambda (syntmp-x-934 . syntmp-ignore-933) syntmp-x-934)) syntmp-id-927)))))) ((syntmp-annotation?-89 syntmp-id-889) (let ((syntmp-id-935 (let ((syntmp-e-936 syntmp-id-889)) (if (syntmp-annotation?-89 syntmp-e-936) (annotation-expression syntmp-e-936) syntmp-e-936)))) (or (call-with-values (lambda () (syntmp-search-891 syntmp-id-935 (syntmp-wrap-subst-119 syntmp-w-890) (syntmp-wrap-marks-118 syntmp-w-890))) (lambda (syntmp-x-938 . syntmp-ignore-937) syntmp-x-938)) syntmp-id-935))) (else (syntmp-error-hook-92 (quote id-var-name) "invalid id" syntmp-id-889)))))) (syntmp-same-marks?-136 (lambda (syntmp-x-939 syntmp-y-940) (or (eq? syntmp-x-939 syntmp-y-940) (and (not (null? syntmp-x-939)) (not (null? syntmp-y-940)) (eq? (car syntmp-x-939) (car syntmp-y-940)) (syntmp-same-marks?-136 (cdr syntmp-x-939) (cdr syntmp-y-940)))))) (syntmp-join-marks-135 (lambda (syntmp-m1-941 syntmp-m2-942) (syntmp-smart-append-133 syntmp-m1-941 syntmp-m2-942))) (syntmp-join-wraps-134 (lambda (syntmp-w1-943 syntmp-w2-944) (let ((syntmp-m1-945 (syntmp-wrap-marks-118 syntmp-w1-943)) (syntmp-s1-946 (syntmp-wrap-subst-119 syntmp-w1-943))) (if (null? syntmp-m1-945) (if (null? syntmp-s1-946) syntmp-w2-944 (syntmp-make-wrap-117 (syntmp-wrap-marks-118 syntmp-w2-944) (syntmp-smart-append-133 syntmp-s1-946 (syntmp-wrap-subst-119 syntmp-w2-944)))) (syntmp-make-wrap-117 (syntmp-smart-append-133 syntmp-m1-945 (syntmp-wrap-marks-118 syntmp-w2-944)) (syntmp-smart-append-133 syntmp-s1-946 (syntmp-wrap-subst-119 syntmp-w2-944))))))) (syntmp-smart-append-133 (lambda (syntmp-m1-947 syntmp-m2-948) (if (null? syntmp-m2-948) syntmp-m1-947 (append syntmp-m1-947 syntmp-m2-948)))) (syntmp-make-binding-wrap-132 (lambda (syntmp-ids-949 syntmp-labels-950 syntmp-w-951) (if (null? syntmp-ids-949) syntmp-w-951 (syntmp-make-wrap-117 (syntmp-wrap-marks-118 syntmp-w-951) (cons (let ((syntmp-labelvec-952 (list->vector syntmp-labels-950))) (let ((syntmp-n-953 (vector-length syntmp-labelvec-952))) (let ((syntmp-symnamevec-954 (make-vector syntmp-n-953)) (syntmp-marksvec-955 (make-vector syntmp-n-953))) (begin (let syntmp-f-956 ((syntmp-ids-957 syntmp-ids-949) (syntmp-i-958 0)) (if (not (null? syntmp-ids-957)) (call-with-values (lambda () (syntmp-id-sym-name&marks-116 (car syntmp-ids-957) syntmp-w-951)) (lambda (syntmp-symname-959 syntmp-marks-960) (begin (vector-set! syntmp-symnamevec-954 syntmp-i-958 syntmp-symname-959) (vector-set! syntmp-marksvec-955 syntmp-i-958 syntmp-marks-960) (syntmp-f-956 (cdr syntmp-ids-957) (syntmp-fx+-85 syntmp-i-958 1))))))) (syntmp-make-ribcage-122 syntmp-symnamevec-954 syntmp-marksvec-955 syntmp-labelvec-952))))) (syntmp-wrap-subst-119 syntmp-w-951)))))) (syntmp-extend-ribcage!-131 (lambda (syntmp-ribcage-961 syntmp-id-962 syntmp-label-963) (begin (syntmp-set-ribcage-symnames!-127 syntmp-ribcage-961 (cons (let ((syntmp-e-964 (syntmp-syntax-object-expression-102 syntmp-id-962))) (if (syntmp-annotation?-89 syntmp-e-964) (annotation-expression syntmp-e-964) syntmp-e-964)) (syntmp-ribcage-symnames-124 syntmp-ribcage-961))) (syntmp-set-ribcage-marks!-128 syntmp-ribcage-961 (cons (syntmp-wrap-marks-118 (syntmp-syntax-object-wrap-103 syntmp-id-962)) (syntmp-ribcage-marks-125 syntmp-ribcage-961))) (syntmp-set-ribcage-labels!-129 syntmp-ribcage-961 (cons syntmp-label-963 (syntmp-ribcage-labels-126 syntmp-ribcage-961)))))) (syntmp-anti-mark-130 (lambda (syntmp-w-965) (syntmp-make-wrap-117 (cons #f (syntmp-wrap-marks-118 syntmp-w-965)) (cons (quote shift) (syntmp-wrap-subst-119 syntmp-w-965))))) (syntmp-set-ribcage-labels!-129 (lambda (syntmp-x-966 syntmp-update-967) (vector-set! syntmp-x-966 3 syntmp-update-967))) (syntmp-set-ribcage-marks!-128 (lambda (syntmp-x-968 syntmp-update-969) (vector-set! syntmp-x-968 2 syntmp-update-969))) (syntmp-set-ribcage-symnames!-127 (lambda (syntmp-x-970 syntmp-update-971) (vector-set! syntmp-x-970 1 syntmp-update-971))) (syntmp-ribcage-labels-126 (lambda (syntmp-x-972) (vector-ref syntmp-x-972 3))) (syntmp-ribcage-marks-125 (lambda (syntmp-x-973) (vector-ref syntmp-x-973 2))) (syntmp-ribcage-symnames-124 (lambda (syntmp-x-974) (vector-ref syntmp-x-974 1))) (syntmp-ribcage?-123 (lambda (syntmp-x-975) (and (vector? syntmp-x-975) (= (vector-length syntmp-x-975) 4) (eq? (vector-ref syntmp-x-975 0) (quote ribcage))))) (syntmp-make-ribcage-122 (lambda (syntmp-symnames-976 syntmp-marks-977 syntmp-labels-978) (vector (quote ribcage) syntmp-symnames-976 syntmp-marks-977 syntmp-labels-978))) (syntmp-gen-labels-121 (lambda (syntmp-ls-979) (if (null? syntmp-ls-979) (quote ()) (cons (syntmp-gen-label-120) (syntmp-gen-labels-121 (cdr syntmp-ls-979)))))) (syntmp-gen-label-120 (lambda () (string #\i))) (syntmp-wrap-subst-119 cdr) (syntmp-wrap-marks-118 car) (syntmp-make-wrap-117 cons) (syntmp-id-sym-name&marks-116 (lambda (syntmp-x-980 syntmp-w-981) (if (syntmp-syntax-object?-101 syntmp-x-980) (values (let ((syntmp-e-982 (syntmp-syntax-object-expression-102 syntmp-x-980))) (if (syntmp-annotation?-89 syntmp-e-982) (annotation-expression syntmp-e-982) syntmp-e-982)) (syntmp-join-marks-135 (syntmp-wrap-marks-118 syntmp-w-981) (syntmp-wrap-marks-118 (syntmp-syntax-object-wrap-103 syntmp-x-980)))) (values (let ((syntmp-e-983 syntmp-x-980)) (if (syntmp-annotation?-89 syntmp-e-983) (annotation-expression syntmp-e-983) syntmp-e-983)) (syntmp-wrap-marks-118 syntmp-w-981))))) (syntmp-id?-115 (lambda (syntmp-x-984) (cond ((symbol? syntmp-x-984) #t) ((syntmp-syntax-object?-101 syntmp-x-984) (symbol? (let ((syntmp-e-985 (syntmp-syntax-object-expression-102 syntmp-x-984))) (if (syntmp-annotation?-89 syntmp-e-985) (annotation-expression syntmp-e-985) syntmp-e-985)))) ((syntmp-annotation?-89 syntmp-x-984) (symbol? (annotation-expression syntmp-x-984))) (else #f)))) (syntmp-nonsymbol-id?-114 (lambda (syntmp-x-986) (and (syntmp-syntax-object?-101 syntmp-x-986) (symbol? (let ((syntmp-e-987 (syntmp-syntax-object-expression-102 syntmp-x-986))) (if (syntmp-annotation?-89 syntmp-e-987) (annotation-expression syntmp-e-987) syntmp-e-987)))))) (syntmp-global-extend-113 (lambda (syntmp-type-988 syntmp-sym-989 syntmp-val-990) (syntmp-put-global-definition-hook-93 syntmp-sym-989 (cons syntmp-type-988 syntmp-val-990)))) (syntmp-lookup-112 (lambda (syntmp-x-991 syntmp-r-992) (cond ((assq syntmp-x-991 syntmp-r-992) => cdr) ((symbol? syntmp-x-991) (or (syntmp-get-global-definition-hook-94 syntmp-x-991) (quote (global)))) (else (quote (displaced-lexical)))))) (syntmp-macros-only-env-111 (lambda (syntmp-r-993) (if (null? syntmp-r-993) (quote ()) (let ((syntmp-a-994 (car syntmp-r-993))) (if (eq? (cadr syntmp-a-994) (quote macro)) (cons syntmp-a-994 (syntmp-macros-only-env-111 (cdr syntmp-r-993))) (syntmp-macros-only-env-111 (cdr syntmp-r-993))))))) (syntmp-extend-var-env-110 (lambda (syntmp-labels-995 syntmp-vars-996 syntmp-r-997) (if (null? syntmp-labels-995) syntmp-r-997 (syntmp-extend-var-env-110 (cdr syntmp-labels-995) (cdr syntmp-vars-996) (cons (cons (car syntmp-labels-995) (cons (quote lexical) (car syntmp-vars-996))) syntmp-r-997))))) (syntmp-extend-env-109 (lambda (syntmp-labels-998 syntmp-bindings-999 syntmp-r-1000) (if (null? syntmp-labels-998) syntmp-r-1000 (syntmp-extend-env-109 (cdr syntmp-labels-998) (cdr syntmp-bindings-999) (cons (cons (car syntmp-labels-998) (car syntmp-bindings-999)) syntmp-r-1000))))) (syntmp-binding-value-108 cdr) (syntmp-binding-type-107 car) (syntmp-source-annotation-106 (lambda (syntmp-x-1001) (cond ((syntmp-annotation?-89 syntmp-x-1001) (annotation-source syntmp-x-1001)) ((syntmp-syntax-object?-101 syntmp-x-1001) (syntmp-source-annotation-106 (syntmp-syntax-object-expression-102 syntmp-x-1001))) (else #f)))) (syntmp-set-syntax-object-wrap!-105 (lambda (syntmp-x-1002 syntmp-update-1003) (vector-set! syntmp-x-1002 2 syntmp-update-1003))) (syntmp-set-syntax-object-expression!-104 (lambda (syntmp-x-1004 syntmp-update-1005) (vector-set! syntmp-x-1004 1 syntmp-update-1005))) (syntmp-syntax-object-wrap-103 (lambda (syntmp-x-1006) (vector-ref syntmp-x-1006 2))) (syntmp-syntax-object-expression-102 (lambda (syntmp-x-1007) (vector-ref syntmp-x-1007 1))) (syntmp-syntax-object?-101 (lambda (syntmp-x-1008) (and (vector? syntmp-x-1008) (= (vector-length syntmp-x-1008) 3) (eq? (vector-ref syntmp-x-1008 0) (quote syntax-object))))) (syntmp-make-syntax-object-100 (lambda (syntmp-expression-1009 syntmp-wrap-1010) (vector (quote syntax-object) syntmp-expression-1009 syntmp-wrap-1010))) (syntmp-build-letrec-99 (lambda (syntmp-src-1011 syntmp-vars-1012 syntmp-val-exps-1013 syntmp-body-exp-1014) (if (null? syntmp-vars-1012) syntmp-body-exp-1014 (list (quote letrec) (map list syntmp-vars-1012 syntmp-val-exps-1013) syntmp-body-exp-1014)))) (syntmp-build-named-let-98 (lambda (syntmp-src-1015 syntmp-vars-1016 syntmp-val-exps-1017 syntmp-body-exp-1018) (if (null? syntmp-vars-1016) syntmp-body-exp-1018 (list (quote let) (car syntmp-vars-1016) (map list (cdr syntmp-vars-1016) syntmp-val-exps-1017) syntmp-body-exp-1018)))) (syntmp-build-let-97 (lambda (syntmp-src-1019 syntmp-vars-1020 syntmp-val-exps-1021 syntmp-body-exp-1022) (if (null? syntmp-vars-1020) syntmp-body-exp-1022 (list (quote let) (map list syntmp-vars-1020 syntmp-val-exps-1021) syntmp-body-exp-1022)))) (syntmp-build-sequence-96 (lambda (syntmp-src-1023 syntmp-exps-1024) (if (null? (cdr syntmp-exps-1024)) (car syntmp-exps-1024) (cons (quote begin) syntmp-exps-1024)))) (syntmp-build-data-95 (lambda (syntmp-src-1025 syntmp-exp-1026) (if (and (self-evaluating? syntmp-exp-1026) (not (vector? syntmp-exp-1026))) syntmp-exp-1026 (list (quote quote) syntmp-exp-1026)))) (syntmp-get-global-definition-hook-94 (lambda (syntmp-symbol-1027) (getprop syntmp-symbol-1027 (quote *sc-expander*)))) (syntmp-put-global-definition-hook-93 (lambda (syntmp-symbol-1028 syntmp-binding-1029) (putprop syntmp-symbol-1028 (quote *sc-expander*) syntmp-binding-1029))) (syntmp-error-hook-92 (lambda (syntmp-who-1030 syntmp-why-1031 syntmp-what-1032) (error syntmp-who-1030 "~a ~s" syntmp-why-1031 syntmp-what-1032))) (syntmp-local-eval-hook-91 (lambda (syntmp-x-1033) (eval (list syntmp-noexpand-84 syntmp-x-1033) (interaction-environment)))) (syntmp-top-level-eval-hook-90 (lambda (syntmp-x-1034) (eval (list syntmp-noexpand-84 syntmp-x-1034) (interaction-environment)))) (syntmp-annotation?-89 (lambda (syntmp-x-1035) #f)) (syntmp-fx<-88 <) (syntmp-fx=-87 =) (syntmp-fx--86 -) (syntmp-fx+-85 +) (syntmp-noexpand-84 "noexpand")) (begin (syntmp-global-extend-113 (quote local-syntax) (quote letrec-syntax) #t) (syntmp-global-extend-113 (quote local-syntax) (quote let-syntax) #f) (syntmp-global-extend-113 (quote core) (quote fluid-let-syntax) (lambda (syntmp-e-1036 syntmp-r-1037 syntmp-w-1038 syntmp-s-1039) ((lambda (syntmp-tmp-1040) ((lambda (syntmp-tmp-1041) (if (if syntmp-tmp-1041 (apply (lambda (syntmp-_-1042 syntmp-var-1043 syntmp-val-1044 syntmp-e1-1045 syntmp-e2-1046) (syntmp-valid-bound-ids?-140 syntmp-var-1043)) syntmp-tmp-1041) #f) (apply (lambda (syntmp-_-1048 syntmp-var-1049 syntmp-val-1050 syntmp-e1-1051 syntmp-e2-1052) (let ((syntmp-names-1053 (map (lambda (syntmp-x-1054) (syntmp-id-var-name-137 syntmp-x-1054 syntmp-w-1038)) syntmp-var-1049))) (begin (for-each (lambda (syntmp-id-1056 syntmp-n-1057) (let ((syntmp-t-1058 (syntmp-binding-type-107 (syntmp-lookup-112 syntmp-n-1057 syntmp-r-1037)))) (if (memv syntmp-t-1058 (quote (displaced-lexical))) (syntax-error (syntmp-source-wrap-144 syntmp-id-1056 syntmp-w-1038 syntmp-s-1039) "identifier out of context")))) syntmp-var-1049 syntmp-names-1053) (syntmp-chi-body-155 (cons syntmp-e1-1051 syntmp-e2-1052) (syntmp-source-wrap-144 syntmp-e-1036 syntmp-w-1038 syntmp-s-1039) (syntmp-extend-env-109 syntmp-names-1053 (let ((syntmp-trans-r-1061 (syntmp-macros-only-env-111 syntmp-r-1037))) (map (lambda (syntmp-x-1062) (cons (quote macro) (syntmp-eval-local-transformer-158 (syntmp-chi-151 syntmp-x-1062 syntmp-trans-r-1061 syntmp-w-1038)))) syntmp-val-1050)) syntmp-r-1037) syntmp-w-1038)))) syntmp-tmp-1041) ((lambda (syntmp-_-1064) (syntax-error (syntmp-source-wrap-144 syntmp-e-1036 syntmp-w-1038 syntmp-s-1039))) syntmp-tmp-1040))) (syntax-dispatch syntmp-tmp-1040 (quote (any #(each (any any)) any . each-any))))) syntmp-e-1036))) (syntmp-global-extend-113 (quote core) (quote quote) (lambda (syntmp-e-1065 syntmp-r-1066 syntmp-w-1067 syntmp-s-1068) ((lambda (syntmp-tmp-1069) ((lambda (syntmp-tmp-1070) (if syntmp-tmp-1070 (apply (lambda (syntmp-_-1071 syntmp-e-1072) (syntmp-build-data-95 syntmp-s-1068 (syntmp-strip-162 syntmp-e-1072 syntmp-w-1067))) syntmp-tmp-1070) ((lambda (syntmp-_-1073) (syntax-error (syntmp-source-wrap-144 syntmp-e-1065 syntmp-w-1067 syntmp-s-1068))) syntmp-tmp-1069))) (syntax-dispatch syntmp-tmp-1069 (quote (any any))))) syntmp-e-1065))) (syntmp-global-extend-113 (quote core) (quote syntax) (letrec ((syntmp-regen-1081 (lambda (syntmp-x-1082) (let ((syntmp-t-1083 (car syntmp-x-1082))) (if (memv syntmp-t-1083 (quote (ref))) (cadr syntmp-x-1082) (if (memv syntmp-t-1083 (quote (primitive))) (cadr syntmp-x-1082) (if (memv syntmp-t-1083 (quote (quote))) (syntmp-build-data-95 #f (cadr syntmp-x-1082)) (if (memv syntmp-t-1083 (quote (lambda))) (list (quote lambda) (cadr syntmp-x-1082) (syntmp-regen-1081 (caddr syntmp-x-1082))) (if (memv syntmp-t-1083 (quote (map))) (let ((syntmp-ls-1084 (map syntmp-regen-1081 (cdr syntmp-x-1082)))) (cons (if (syntmp-fx=-87 (length syntmp-ls-1084) 2) (quote map) (quote map)) syntmp-ls-1084)) (cons (car syntmp-x-1082) (map syntmp-regen-1081 (cdr syntmp-x-1082))))))))))) (syntmp-gen-vector-1080 (lambda (syntmp-x-1085) (cond ((eq? (car syntmp-x-1085) (quote list)) (cons (quote vector) (cdr syntmp-x-1085))) ((eq? (car syntmp-x-1085) (quote quote)) (list (quote quote) (list->vector (cadr syntmp-x-1085)))) (else (list (quote list->vector) syntmp-x-1085))))) (syntmp-gen-append-1079 (lambda (syntmp-x-1086 syntmp-y-1087) (if (equal? syntmp-y-1087 (quote (quote ()))) syntmp-x-1086 (list (quote append) syntmp-x-1086 syntmp-y-1087)))) (syntmp-gen-cons-1078 (lambda (syntmp-x-1088 syntmp-y-1089) (let ((syntmp-t-1090 (car syntmp-y-1089))) (if (memv syntmp-t-1090 (quote (quote))) (if (eq? (car syntmp-x-1088) (quote quote)) (list (quote quote) (cons (cadr syntmp-x-1088) (cadr syntmp-y-1089))) (if (eq? (cadr syntmp-y-1089) (quote ())) (list (quote list) syntmp-x-1088) (list (quote cons) syntmp-x-1088 syntmp-y-1089))) (if (memv syntmp-t-1090 (quote (list))) (cons (quote list) (cons syntmp-x-1088 (cdr syntmp-y-1089))) (list (quote cons) syntmp-x-1088 syntmp-y-1089)))))) (syntmp-gen-map-1077 (lambda (syntmp-e-1091 syntmp-map-env-1092) (let ((syntmp-formals-1093 (map cdr syntmp-map-env-1092)) (syntmp-actuals-1094 (map (lambda (syntmp-x-1095) (list (quote ref) (car syntmp-x-1095))) syntmp-map-env-1092))) (cond ((eq? (car syntmp-e-1091) (quote ref)) (car syntmp-actuals-1094)) ((andmap (lambda (syntmp-x-1096) (and (eq? (car syntmp-x-1096) (quote ref)) (memq (cadr syntmp-x-1096) syntmp-formals-1093))) (cdr syntmp-e-1091)) (cons (quote map) (cons (list (quote primitive) (car syntmp-e-1091)) (map (let ((syntmp-r-1097 (map cons syntmp-formals-1093 syntmp-actuals-1094))) (lambda (syntmp-x-1098) (cdr (assq (cadr syntmp-x-1098) syntmp-r-1097)))) (cdr syntmp-e-1091))))) (else (cons (quote map) (cons (list (quote lambda) syntmp-formals-1093 syntmp-e-1091) syntmp-actuals-1094))))))) (syntmp-gen-mappend-1076 (lambda (syntmp-e-1099 syntmp-map-env-1100) (list (quote apply) (quote (primitive append)) (syntmp-gen-map-1077 syntmp-e-1099 syntmp-map-env-1100)))) (syntmp-gen-ref-1075 (lambda (syntmp-src-1101 syntmp-var-1102 syntmp-level-1103 syntmp-maps-1104) (if (syntmp-fx=-87 syntmp-level-1103 0) (values syntmp-var-1102 syntmp-maps-1104) (if (null? syntmp-maps-1104) (syntax-error syntmp-src-1101 "missing ellipsis in syntax form") (call-with-values (lambda () (syntmp-gen-ref-1075 syntmp-src-1101 syntmp-var-1102 (syntmp-fx--86 syntmp-level-1103 1) (cdr syntmp-maps-1104))) (lambda (syntmp-outer-var-1105 syntmp-outer-maps-1106) (let ((syntmp-b-1107 (assq syntmp-outer-var-1105 (car syntmp-maps-1104)))) (if syntmp-b-1107 (values (cdr syntmp-b-1107) syntmp-maps-1104) (let ((syntmp-inner-var-1108 (syntmp-gen-var-163 (quote tmp)))) (values syntmp-inner-var-1108 (cons (cons (cons syntmp-outer-var-1105 syntmp-inner-var-1108) (car syntmp-maps-1104)) syntmp-outer-maps-1106))))))))))) (syntmp-gen-syntax-1074 (lambda (syntmp-src-1109 syntmp-e-1110 syntmp-r-1111 syntmp-maps-1112 syntmp-ellipsis?-1113) (if (syntmp-id?-115 syntmp-e-1110) (let ((syntmp-label-1114 (syntmp-id-var-name-137 syntmp-e-1110 (quote (()))))) (let ((syntmp-b-1115 (syntmp-lookup-112 syntmp-label-1114 syntmp-r-1111))) (if (eq? (syntmp-binding-type-107 syntmp-b-1115) (quote syntax)) (call-with-values (lambda () (let ((syntmp-var.lev-1116 (syntmp-binding-value-108 syntmp-b-1115))) (syntmp-gen-ref-1075 syntmp-src-1109 (car syntmp-var.lev-1116) (cdr syntmp-var.lev-1116) syntmp-maps-1112))) (lambda (syntmp-var-1117 syntmp-maps-1118) (values (list (quote ref) syntmp-var-1117) syntmp-maps-1118))) (if (syntmp-ellipsis?-1113 syntmp-e-1110) (syntax-error syntmp-src-1109 "misplaced ellipsis in syntax form") (values (list (quote quote) syntmp-e-1110) syntmp-maps-1112))))) ((lambda (syntmp-tmp-1119) ((lambda (syntmp-tmp-1120) (if (if syntmp-tmp-1120 (apply (lambda (syntmp-dots-1121 syntmp-e-1122) (syntmp-ellipsis?-1113 syntmp-dots-1121)) syntmp-tmp-1120) #f) (apply (lambda (syntmp-dots-1123 syntmp-e-1124) (syntmp-gen-syntax-1074 syntmp-src-1109 syntmp-e-1124 syntmp-r-1111 syntmp-maps-1112 (lambda (syntmp-x-1125) #f))) syntmp-tmp-1120) ((lambda (syntmp-tmp-1126) (if (if syntmp-tmp-1126 (apply (lambda (syntmp-x-1127 syntmp-dots-1128 syntmp-y-1129) (syntmp-ellipsis?-1113 syntmp-dots-1128)) syntmp-tmp-1126) #f) (apply (lambda (syntmp-x-1130 syntmp-dots-1131 syntmp-y-1132) (let syntmp-f-1133 ((syntmp-y-1134 syntmp-y-1132) (syntmp-k-1135 (lambda (syntmp-maps-1136) (call-with-values (lambda () (syntmp-gen-syntax-1074 syntmp-src-1109 syntmp-x-1130 syntmp-r-1111 (cons (quote ()) syntmp-maps-1136) syntmp-ellipsis?-1113)) (lambda (syntmp-x-1137 syntmp-maps-1138) (if (null? (car syntmp-maps-1138)) (syntax-error syntmp-src-1109 "extra ellipsis in syntax form") (values (syntmp-gen-map-1077 syntmp-x-1137 (car syntmp-maps-1138)) (cdr syntmp-maps-1138)))))))) ((lambda (syntmp-tmp-1139) ((lambda (syntmp-tmp-1140) (if (if syntmp-tmp-1140 (apply (lambda (syntmp-dots-1141 syntmp-y-1142) (syntmp-ellipsis?-1113 syntmp-dots-1141)) syntmp-tmp-1140) #f) (apply (lambda (syntmp-dots-1143 syntmp-y-1144) (syntmp-f-1133 syntmp-y-1144 (lambda (syntmp-maps-1145) (call-with-values (lambda () (syntmp-k-1135 (cons (quote ()) syntmp-maps-1145))) (lambda (syntmp-x-1146 syntmp-maps-1147) (if (null? (car syntmp-maps-1147)) (syntax-error syntmp-src-1109 "extra ellipsis in syntax form") (values (syntmp-gen-mappend-1076 syntmp-x-1146 (car syntmp-maps-1147)) (cdr syntmp-maps-1147)))))))) syntmp-tmp-1140) ((lambda (syntmp-_-1148) (call-with-values (lambda () (syntmp-gen-syntax-1074 syntmp-src-1109 syntmp-y-1134 syntmp-r-1111 syntmp-maps-1112 syntmp-ellipsis?-1113)) (lambda (syntmp-y-1149 syntmp-maps-1150) (call-with-values (lambda () (syntmp-k-1135 syntmp-maps-1150)) (lambda (syntmp-x-1151 syntmp-maps-1152) (values (syntmp-gen-append-1079 syntmp-x-1151 syntmp-y-1149) syntmp-maps-1152)))))) syntmp-tmp-1139))) (syntax-dispatch syntmp-tmp-1139 (quote (any . any))))) syntmp-y-1134))) syntmp-tmp-1126) ((lambda (syntmp-tmp-1153) (if syntmp-tmp-1153 (apply (lambda (syntmp-x-1154 syntmp-y-1155) (call-with-values (lambda () (syntmp-gen-syntax-1074 syntmp-src-1109 syntmp-x-1154 syntmp-r-1111 syntmp-maps-1112 syntmp-ellipsis?-1113)) (lambda (syntmp-x-1156 syntmp-maps-1157) (call-with-values (lambda () (syntmp-gen-syntax-1074 syntmp-src-1109 syntmp-y-1155 syntmp-r-1111 syntmp-maps-1157 syntmp-ellipsis?-1113)) (lambda (syntmp-y-1158 syntmp-maps-1159) (values (syntmp-gen-cons-1078 syntmp-x-1156 syntmp-y-1158) syntmp-maps-1159)))))) syntmp-tmp-1153) ((lambda (syntmp-tmp-1160) (if syntmp-tmp-1160 (apply (lambda (syntmp-e1-1161 syntmp-e2-1162) (call-with-values (lambda () (syntmp-gen-syntax-1074 syntmp-src-1109 (cons syntmp-e1-1161 syntmp-e2-1162) syntmp-r-1111 syntmp-maps-1112 syntmp-ellipsis?-1113)) (lambda (syntmp-e-1164 syntmp-maps-1165) (values (syntmp-gen-vector-1080 syntmp-e-1164) syntmp-maps-1165)))) syntmp-tmp-1160) ((lambda (syntmp-_-1166) (values (list (quote quote) syntmp-e-1110) syntmp-maps-1112)) syntmp-tmp-1119))) (syntax-dispatch syntmp-tmp-1119 (quote #(vector (any . each-any))))))) (syntax-dispatch syntmp-tmp-1119 (quote (any . any)))))) (syntax-dispatch syntmp-tmp-1119 (quote (any any . any)))))) (syntax-dispatch syntmp-tmp-1119 (quote (any any))))) syntmp-e-1110))))) (lambda (syntmp-e-1167 syntmp-r-1168 syntmp-w-1169 syntmp-s-1170) (let ((syntmp-e-1171 (syntmp-source-wrap-144 syntmp-e-1167 syntmp-w-1169 syntmp-s-1170))) ((lambda (syntmp-tmp-1172) ((lambda (syntmp-tmp-1173) (if syntmp-tmp-1173 (apply (lambda (syntmp-_-1174 syntmp-x-1175) (call-with-values (lambda () (syntmp-gen-syntax-1074 syntmp-e-1171 syntmp-x-1175 syntmp-r-1168 (quote ()) syntmp-ellipsis?-160)) (lambda (syntmp-e-1176 syntmp-maps-1177) (syntmp-regen-1081 syntmp-e-1176)))) syntmp-tmp-1173) ((lambda (syntmp-_-1178) (syntax-error syntmp-e-1171)) syntmp-tmp-1172))) (syntax-dispatch syntmp-tmp-1172 (quote (any any))))) syntmp-e-1171))))) (syntmp-global-extend-113 (quote core) (quote lambda) (lambda (syntmp-e-1179 syntmp-r-1180 syntmp-w-1181 syntmp-s-1182) ((lambda (syntmp-tmp-1183) ((lambda (syntmp-tmp-1184) (if syntmp-tmp-1184 (apply (lambda (syntmp-_-1185 syntmp-c-1186) (syntmp-chi-lambda-clause-156 (syntmp-source-wrap-144 syntmp-e-1179 syntmp-w-1181 syntmp-s-1182) syntmp-c-1186 syntmp-r-1180 syntmp-w-1181 (lambda (syntmp-vars-1187 syntmp-body-1188) (list (quote lambda) syntmp-vars-1187 syntmp-body-1188)))) syntmp-tmp-1184) (syntax-error syntmp-tmp-1183))) (syntax-dispatch syntmp-tmp-1183 (quote (any . any))))) syntmp-e-1179))) (syntmp-global-extend-113 (quote core) (quote let) (letrec ((syntmp-chi-let-1189 (lambda (syntmp-e-1190 syntmp-r-1191 syntmp-w-1192 syntmp-s-1193 syntmp-constructor-1194 syntmp-ids-1195 syntmp-vals-1196 syntmp-exps-1197) (if (not (syntmp-valid-bound-ids?-140 syntmp-ids-1195)) (syntax-error syntmp-e-1190 "duplicate bound variable in") (let ((syntmp-labels-1198 (syntmp-gen-labels-121 syntmp-ids-1195)) (syntmp-new-vars-1199 (map syntmp-gen-var-163 syntmp-ids-1195))) (let ((syntmp-nw-1200 (syntmp-make-binding-wrap-132 syntmp-ids-1195 syntmp-labels-1198 syntmp-w-1192)) (syntmp-nr-1201 (syntmp-extend-var-env-110 syntmp-labels-1198 syntmp-new-vars-1199 syntmp-r-1191))) (syntmp-constructor-1194 syntmp-s-1193 syntmp-new-vars-1199 (map (lambda (syntmp-x-1202) (syntmp-chi-151 syntmp-x-1202 syntmp-r-1191 syntmp-w-1192)) syntmp-vals-1196) (syntmp-chi-body-155 syntmp-exps-1197 (syntmp-source-wrap-144 syntmp-e-1190 syntmp-nw-1200 syntmp-s-1193) syntmp-nr-1201 syntmp-nw-1200)))))))) (lambda (syntmp-e-1203 syntmp-r-1204 syntmp-w-1205 syntmp-s-1206) ((lambda (syntmp-tmp-1207) ((lambda (syntmp-tmp-1208) (if syntmp-tmp-1208 (apply (lambda (syntmp-_-1209 syntmp-id-1210 syntmp-val-1211 syntmp-e1-1212 syntmp-e2-1213) (syntmp-chi-let-1189 syntmp-e-1203 syntmp-r-1204 syntmp-w-1205 syntmp-s-1206 syntmp-build-let-97 syntmp-id-1210 syntmp-val-1211 (cons syntmp-e1-1212 syntmp-e2-1213))) syntmp-tmp-1208) ((lambda (syntmp-tmp-1217) (if (if syntmp-tmp-1217 (apply (lambda (syntmp-_-1218 syntmp-f-1219 syntmp-id-1220 syntmp-val-1221 syntmp-e1-1222 syntmp-e2-1223) (syntmp-id?-115 syntmp-f-1219)) syntmp-tmp-1217) #f) (apply (lambda (syntmp-_-1224 syntmp-f-1225 syntmp-id-1226 syntmp-val-1227 syntmp-e1-1228 syntmp-e2-1229) (syntmp-chi-let-1189 syntmp-e-1203 syntmp-r-1204 syntmp-w-1205 syntmp-s-1206 syntmp-build-named-let-98 (cons syntmp-f-1225 syntmp-id-1226) syntmp-val-1227 (cons syntmp-e1-1228 syntmp-e2-1229))) syntmp-tmp-1217) ((lambda (syntmp-_-1233) (syntax-error (syntmp-source-wrap-144 syntmp-e-1203 syntmp-w-1205 syntmp-s-1206))) syntmp-tmp-1207))) (syntax-dispatch syntmp-tmp-1207 (quote (any any #(each (any any)) any . each-any)))))) (syntax-dispatch syntmp-tmp-1207 (quote (any #(each (any any)) any . each-any))))) syntmp-e-1203)))) (syntmp-global-extend-113 (quote core) (quote letrec) (lambda (syntmp-e-1234 syntmp-r-1235 syntmp-w-1236 syntmp-s-1237) ((lambda (syntmp-tmp-1238) ((lambda (syntmp-tmp-1239) (if syntmp-tmp-1239 (apply (lambda (syntmp-_-1240 syntmp-id-1241 syntmp-val-1242 syntmp-e1-1243 syntmp-e2-1244) (let ((syntmp-ids-1245 syntmp-id-1241)) (if (not (syntmp-valid-bound-ids?-140 syntmp-ids-1245)) (syntax-error syntmp-e-1234 "duplicate bound variable in") (let ((syntmp-labels-1247 (syntmp-gen-labels-121 syntmp-ids-1245)) (syntmp-new-vars-1248 (map syntmp-gen-var-163 syntmp-ids-1245))) (let ((syntmp-w-1249 (syntmp-make-binding-wrap-132 syntmp-ids-1245 syntmp-labels-1247 syntmp-w-1236)) (syntmp-r-1250 (syntmp-extend-var-env-110 syntmp-labels-1247 syntmp-new-vars-1248 syntmp-r-1235))) (syntmp-build-letrec-99 syntmp-s-1237 syntmp-new-vars-1248 (map (lambda (syntmp-x-1251) (syntmp-chi-151 syntmp-x-1251 syntmp-r-1250 syntmp-w-1249)) syntmp-val-1242) (syntmp-chi-body-155 (cons syntmp-e1-1243 syntmp-e2-1244) (syntmp-source-wrap-144 syntmp-e-1234 syntmp-w-1249 syntmp-s-1237) syntmp-r-1250 syntmp-w-1249))))))) syntmp-tmp-1239) ((lambda (syntmp-_-1254) (syntax-error (syntmp-source-wrap-144 syntmp-e-1234 syntmp-w-1236 syntmp-s-1237))) syntmp-tmp-1238))) (syntax-dispatch syntmp-tmp-1238 (quote (any #(each (any any)) any . each-any))))) syntmp-e-1234))) (syntmp-global-extend-113 (quote core) (quote set!) (lambda (syntmp-e-1255 syntmp-r-1256 syntmp-w-1257 syntmp-s-1258) ((lambda (syntmp-tmp-1259) ((lambda (syntmp-tmp-1260) (if (if syntmp-tmp-1260 (apply (lambda (syntmp-_-1261 syntmp-id-1262 syntmp-val-1263) (syntmp-id?-115 syntmp-id-1262)) syntmp-tmp-1260) #f) (apply (lambda (syntmp-_-1264 syntmp-id-1265 syntmp-val-1266) (let ((syntmp-val-1267 (syntmp-chi-151 syntmp-val-1266 syntmp-r-1256 syntmp-w-1257)) (syntmp-n-1268 (syntmp-id-var-name-137 syntmp-id-1265 syntmp-w-1257))) (let ((syntmp-b-1269 (syntmp-lookup-112 syntmp-n-1268 syntmp-r-1256))) (let ((syntmp-t-1270 (syntmp-binding-type-107 syntmp-b-1269))) (if (memv syntmp-t-1270 (quote (lexical))) (list (quote set!) (syntmp-binding-value-108 syntmp-b-1269) syntmp-val-1267) (if (memv syntmp-t-1270 (quote (global))) (list (quote set!) syntmp-n-1268 syntmp-val-1267) (if (memv syntmp-t-1270 (quote (displaced-lexical))) (syntax-error (syntmp-wrap-143 syntmp-id-1265 syntmp-w-1257) "identifier out of context") (syntax-error (syntmp-source-wrap-144 syntmp-e-1255 syntmp-w-1257 syntmp-s-1258))))))))) syntmp-tmp-1260) ((lambda (syntmp-tmp-1271) (if syntmp-tmp-1271 (apply (lambda (syntmp-_-1272 syntmp-getter-1273 syntmp-arg-1274 syntmp-val-1275) (cons (syntmp-chi-151 (list (quote #(syntax-object setter ((top) #(ribcage #(_ getter arg val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))))) syntmp-getter-1273) syntmp-r-1256 syntmp-w-1257) (map (lambda (syntmp-e-1276) (syntmp-chi-151 syntmp-e-1276 syntmp-r-1256 syntmp-w-1257)) (append syntmp-arg-1274 (list syntmp-val-1275))))) syntmp-tmp-1271) ((lambda (syntmp-_-1278) (syntax-error (syntmp-source-wrap-144 syntmp-e-1255 syntmp-w-1257 syntmp-s-1258))) syntmp-tmp-1259))) (syntax-dispatch syntmp-tmp-1259 (quote (any (any . each-any) any)))))) (syntax-dispatch syntmp-tmp-1259 (quote (any any any))))) syntmp-e-1255))) (syntmp-global-extend-113 (quote begin) (quote begin) (quote ())) (syntmp-global-extend-113 (quote define) (quote define) (quote ())) (syntmp-global-extend-113 (quote define-syntax) (quote define-syntax) (quote ())) (syntmp-global-extend-113 (quote eval-when) (quote eval-when) (quote ())) (syntmp-global-extend-113 (quote core) (quote syntax-case) (letrec ((syntmp-gen-syntax-case-1282 (lambda (syntmp-x-1283 syntmp-keys-1284 syntmp-clauses-1285 syntmp-r-1286) (if (null? syntmp-clauses-1285) (list (quote syntax-error) syntmp-x-1283) ((lambda (syntmp-tmp-1287) ((lambda (syntmp-tmp-1288) (if syntmp-tmp-1288 (apply (lambda (syntmp-pat-1289 syntmp-exp-1290) (if (and (syntmp-id?-115 syntmp-pat-1289) (andmap (lambda (syntmp-x-1291) (not (syntmp-free-id=?-138 syntmp-pat-1289 syntmp-x-1291))) (cons (quote #(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x keys clauses r) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))))) syntmp-keys-1284))) (let ((syntmp-labels-1292 (list (syntmp-gen-label-120))) (syntmp-var-1293 (syntmp-gen-var-163 syntmp-pat-1289))) (list (list (quote lambda) (list syntmp-var-1293) (syntmp-chi-151 syntmp-exp-1290 (syntmp-extend-env-109 syntmp-labels-1292 (list (cons (quote syntax) (cons syntmp-var-1293 0))) syntmp-r-1286) (syntmp-make-binding-wrap-132 (list syntmp-pat-1289) syntmp-labels-1292 (quote (()))))) syntmp-x-1283)) (syntmp-gen-clause-1281 syntmp-x-1283 syntmp-keys-1284 (cdr syntmp-clauses-1285) syntmp-r-1286 syntmp-pat-1289 #t syntmp-exp-1290))) syntmp-tmp-1288) ((lambda (syntmp-tmp-1294) (if syntmp-tmp-1294 (apply (lambda (syntmp-pat-1295 syntmp-fender-1296 syntmp-exp-1297) (syntmp-gen-clause-1281 syntmp-x-1283 syntmp-keys-1284 (cdr syntmp-clauses-1285) syntmp-r-1286 syntmp-pat-1295 syntmp-fender-1296 syntmp-exp-1297)) syntmp-tmp-1294) ((lambda (syntmp-_-1298) (syntax-error (car syntmp-clauses-1285) "invalid syntax-case clause")) syntmp-tmp-1287))) (syntax-dispatch syntmp-tmp-1287 (quote (any any any)))))) (syntax-dispatch syntmp-tmp-1287 (quote (any any))))) (car syntmp-clauses-1285))))) (syntmp-gen-clause-1281 (lambda (syntmp-x-1299 syntmp-keys-1300 syntmp-clauses-1301 syntmp-r-1302 syntmp-pat-1303 syntmp-fender-1304 syntmp-exp-1305) (call-with-values (lambda () (syntmp-convert-pattern-1279 syntmp-pat-1303 syntmp-keys-1300)) (lambda (syntmp-p-1306 syntmp-pvars-1307) (cond ((not (syntmp-distinct-bound-ids?-141 (map car syntmp-pvars-1307))) (syntax-error syntmp-pat-1303 "duplicate pattern variable in syntax-case pattern")) ((not (andmap (lambda (syntmp-x-1308) (not (syntmp-ellipsis?-160 (car syntmp-x-1308)))) syntmp-pvars-1307)) (syntax-error syntmp-pat-1303 "misplaced ellipsis in syntax-case pattern")) (else (let ((syntmp-y-1309 (syntmp-gen-var-163 (quote tmp)))) (list (list (quote lambda) (list syntmp-y-1309) (let ((syntmp-y-1310 syntmp-y-1309)) (list (quote if) ((lambda (syntmp-tmp-1311) ((lambda (syntmp-tmp-1312) (if syntmp-tmp-1312 (apply (lambda () syntmp-y-1310) syntmp-tmp-1312) ((lambda (syntmp-_-1313) (list (quote if) syntmp-y-1310 (syntmp-build-dispatch-call-1280 syntmp-pvars-1307 syntmp-fender-1304 syntmp-y-1310 syntmp-r-1302) (syntmp-build-data-95 #f #f))) syntmp-tmp-1311))) (syntax-dispatch syntmp-tmp-1311 (quote #(atom #t))))) syntmp-fender-1304) (syntmp-build-dispatch-call-1280 syntmp-pvars-1307 syntmp-exp-1305 syntmp-y-1310 syntmp-r-1302) (syntmp-gen-syntax-case-1282 syntmp-x-1299 syntmp-keys-1300 syntmp-clauses-1301 syntmp-r-1302)))) (if (eq? syntmp-p-1306 (quote any)) (list (quote list) syntmp-x-1299) (list (quote syntax-dispatch) syntmp-x-1299 (syntmp-build-data-95 #f syntmp-p-1306))))))))))) (syntmp-build-dispatch-call-1280 (lambda (syntmp-pvars-1314 syntmp-exp-1315 syntmp-y-1316 syntmp-r-1317) (let ((syntmp-ids-1318 (map car syntmp-pvars-1314)) (syntmp-levels-1319 (map cdr syntmp-pvars-1314))) (let ((syntmp-labels-1320 (syntmp-gen-labels-121 syntmp-ids-1318)) (syntmp-new-vars-1321 (map syntmp-gen-var-163 syntmp-ids-1318))) (list (quote apply) (list (quote lambda) syntmp-new-vars-1321 (syntmp-chi-151 syntmp-exp-1315 (syntmp-extend-env-109 syntmp-labels-1320 (map (lambda (syntmp-var-1322 syntmp-level-1323) (cons (quote syntax) (cons syntmp-var-1322 syntmp-level-1323))) syntmp-new-vars-1321 (map cdr syntmp-pvars-1314)) syntmp-r-1317) (syntmp-make-binding-wrap-132 syntmp-ids-1318 syntmp-labels-1320 (quote (()))))) syntmp-y-1316))))) (syntmp-convert-pattern-1279 (lambda (syntmp-pattern-1324 syntmp-keys-1325) (let syntmp-cvt-1326 ((syntmp-p-1327 syntmp-pattern-1324) (syntmp-n-1328 0) (syntmp-ids-1329 (quote ()))) (if (syntmp-id?-115 syntmp-p-1327) (if (syntmp-bound-id-member?-142 syntmp-p-1327 syntmp-keys-1325) (values (vector (quote free-id) syntmp-p-1327) syntmp-ids-1329) (values (quote any) (cons (cons syntmp-p-1327 syntmp-n-1328) syntmp-ids-1329))) ((lambda (syntmp-tmp-1330) ((lambda (syntmp-tmp-1331) (if (if syntmp-tmp-1331 (apply (lambda (syntmp-x-1332 syntmp-dots-1333) (syntmp-ellipsis?-160 syntmp-dots-1333)) syntmp-tmp-1331) #f) (apply (lambda (syntmp-x-1334 syntmp-dots-1335) (call-with-values (lambda () (syntmp-cvt-1326 syntmp-x-1334 (syntmp-fx+-85 syntmp-n-1328 1) syntmp-ids-1329)) (lambda (syntmp-p-1336 syntmp-ids-1337) (values (if (eq? syntmp-p-1336 (quote any)) (quote each-any) (vector (quote each) syntmp-p-1336)) syntmp-ids-1337)))) syntmp-tmp-1331) ((lambda (syntmp-tmp-1338) (if syntmp-tmp-1338 (apply (lambda (syntmp-x-1339 syntmp-y-1340) (call-with-values (lambda () (syntmp-cvt-1326 syntmp-y-1340 syntmp-n-1328 syntmp-ids-1329)) (lambda (syntmp-y-1341 syntmp-ids-1342) (call-with-values (lambda () (syntmp-cvt-1326 syntmp-x-1339 syntmp-n-1328 syntmp-ids-1342)) (lambda (syntmp-x-1343 syntmp-ids-1344) (values (cons syntmp-x-1343 syntmp-y-1341) syntmp-ids-1344)))))) syntmp-tmp-1338) ((lambda (syntmp-tmp-1345) (if syntmp-tmp-1345 (apply (lambda () (values (quote ()) syntmp-ids-1329)) syntmp-tmp-1345) ((lambda (syntmp-tmp-1346) (if syntmp-tmp-1346 (apply (lambda (syntmp-x-1347) (call-with-values (lambda () (syntmp-cvt-1326 syntmp-x-1347 syntmp-n-1328 syntmp-ids-1329)) (lambda (syntmp-p-1349 syntmp-ids-1350) (values (vector (quote vector) syntmp-p-1349) syntmp-ids-1350)))) syntmp-tmp-1346) ((lambda (syntmp-x-1351) (values (vector (quote atom) (syntmp-strip-162 syntmp-p-1327 (quote (())))) syntmp-ids-1329)) syntmp-tmp-1330))) (syntax-dispatch syntmp-tmp-1330 (quote #(vector each-any)))))) (syntax-dispatch syntmp-tmp-1330 (quote ()))))) (syntax-dispatch syntmp-tmp-1330 (quote (any . any)))))) (syntax-dispatch syntmp-tmp-1330 (quote (any any))))) syntmp-p-1327)))))) (lambda (syntmp-e-1352 syntmp-r-1353 syntmp-w-1354 syntmp-s-1355) (let ((syntmp-e-1356 (syntmp-source-wrap-144 syntmp-e-1352 syntmp-w-1354 syntmp-s-1355))) ((lambda (syntmp-tmp-1357) ((lambda (syntmp-tmp-1358) (if syntmp-tmp-1358 (apply (lambda (syntmp-_-1359 syntmp-val-1360 syntmp-key-1361 syntmp-m-1362) (if (andmap (lambda (syntmp-x-1363) (and (syntmp-id?-115 syntmp-x-1363) (not (syntmp-ellipsis?-160 syntmp-x-1363)))) syntmp-key-1361) (let ((syntmp-x-1365 (syntmp-gen-var-163 (quote tmp)))) (list (list (quote lambda) (list syntmp-x-1365) (syntmp-gen-syntax-case-1282 syntmp-x-1365 syntmp-key-1361 syntmp-m-1362 syntmp-r-1353)) (syntmp-chi-151 syntmp-val-1360 syntmp-r-1353 (quote (()))))) (syntax-error syntmp-e-1356 "invalid literals list in"))) syntmp-tmp-1358) (syntax-error syntmp-tmp-1357))) (syntax-dispatch syntmp-tmp-1357 (quote (any any each-any . each-any))))) syntmp-e-1356))))) (set! sc-expand (let ((syntmp-m-1368 (quote e)) (syntmp-esew-1369 (quote (eval)))) (lambda (syntmp-x-1370) (if (and (pair? syntmp-x-1370) (equal? (car syntmp-x-1370) syntmp-noexpand-84)) (cadr syntmp-x-1370) (syntmp-chi-top-150 syntmp-x-1370 (quote ()) (quote ((top))) syntmp-m-1368 syntmp-esew-1369))))) (set! sc-expand3 (let ((syntmp-m-1371 (quote e)) (syntmp-esew-1372 (quote (eval)))) (lambda (syntmp-x-1374 . syntmp-rest-1373) (if (and (pair? syntmp-x-1374) (equal? (car syntmp-x-1374) syntmp-noexpand-84)) (cadr syntmp-x-1374) (syntmp-chi-top-150 syntmp-x-1374 (quote ()) (quote ((top))) (if (null? syntmp-rest-1373) syntmp-m-1371 (car syntmp-rest-1373)) (if (or (null? syntmp-rest-1373) (null? (cdr syntmp-rest-1373))) syntmp-esew-1372 (cadr syntmp-rest-1373))))))) (set! identifier? (lambda (syntmp-x-1375) (syntmp-nonsymbol-id?-114 syntmp-x-1375))) (set! datum->syntax-object (lambda (syntmp-id-1376 syntmp-datum-1377) (syntmp-make-syntax-object-100 syntmp-datum-1377 (syntmp-syntax-object-wrap-103 syntmp-id-1376)))) (set! syntax-object->datum (lambda (syntmp-x-1378) (syntmp-strip-162 syntmp-x-1378 (quote (()))))) (set! generate-temporaries (lambda (syntmp-ls-1379) (begin (let ((syntmp-x-1380 syntmp-ls-1379)) (if (not (list? syntmp-x-1380)) (syntmp-error-hook-92 (quote generate-temporaries) "invalid argument" syntmp-x-1380))) (map (lambda (syntmp-x-1381) (syntmp-wrap-143 (gensym) (quote ((top))))) syntmp-ls-1379)))) (set! free-identifier=? (lambda (syntmp-x-1382 syntmp-y-1383) (begin (let ((syntmp-x-1384 syntmp-x-1382)) (if (not (syntmp-nonsymbol-id?-114 syntmp-x-1384)) (syntmp-error-hook-92 (quote free-identifier=?) "invalid argument" syntmp-x-1384))) (let ((syntmp-x-1385 syntmp-y-1383)) (if (not (syntmp-nonsymbol-id?-114 syntmp-x-1385)) (syntmp-error-hook-92 (quote free-identifier=?) "invalid argument" syntmp-x-1385))) (syntmp-free-id=?-138 syntmp-x-1382 syntmp-y-1383)))) (set! bound-identifier=? (lambda (syntmp-x-1386 syntmp-y-1387) (begin (let ((syntmp-x-1388 syntmp-x-1386)) (if (not (syntmp-nonsymbol-id?-114 syntmp-x-1388)) (syntmp-error-hook-92 (quote bound-identifier=?) "invalid argument" syntmp-x-1388))) (let ((syntmp-x-1389 syntmp-y-1387)) (if (not (syntmp-nonsymbol-id?-114 syntmp-x-1389)) (syntmp-error-hook-92 (quote bound-identifier=?) "invalid argument" syntmp-x-1389))) (syntmp-bound-id=?-139 syntmp-x-1386 syntmp-y-1387)))) (set! syntax-error (lambda (syntmp-object-1391 . syntmp-messages-1390) (begin (for-each (lambda (syntmp-x-1392) (let ((syntmp-x-1393 syntmp-x-1392)) (if (not (string? syntmp-x-1393)) (syntmp-error-hook-92 (quote syntax-error) "invalid argument" syntmp-x-1393)))) syntmp-messages-1390) (let ((syntmp-message-1394 (if (null? syntmp-messages-1390) "invalid syntax" (apply string-append syntmp-messages-1390)))) (syntmp-error-hook-92 #f syntmp-message-1394 (syntmp-strip-162 syntmp-object-1391 (quote (())))))))) (set! install-global-transformer (lambda (syntmp-sym-1395 syntmp-v-1396) (begin (let ((syntmp-x-1397 syntmp-sym-1395)) (if (not (symbol? syntmp-x-1397)) (syntmp-error-hook-92 (quote define-syntax) "invalid argument" syntmp-x-1397))) (let ((syntmp-x-1398 syntmp-v-1396)) (if (not (procedure? syntmp-x-1398)) (syntmp-error-hook-92 (quote define-syntax) "invalid argument" syntmp-x-1398))) (syntmp-global-extend-113 (quote macro) syntmp-sym-1395 syntmp-v-1396)))) (letrec ((syntmp-match-1403 (lambda (syntmp-e-1404 syntmp-p-1405 syntmp-w-1406 syntmp-r-1407) (cond ((not syntmp-r-1407) #f) ((eq? syntmp-p-1405 (quote any)) (cons (syntmp-wrap-143 syntmp-e-1404 syntmp-w-1406) syntmp-r-1407)) ((syntmp-syntax-object?-101 syntmp-e-1404) (syntmp-match*-1402 (let ((syntmp-e-1408 (syntmp-syntax-object-expression-102 syntmp-e-1404))) (if (syntmp-annotation?-89 syntmp-e-1408) (annotation-expression syntmp-e-1408) syntmp-e-1408)) syntmp-p-1405 (syntmp-join-wraps-134 syntmp-w-1406 (syntmp-syntax-object-wrap-103 syntmp-e-1404)) syntmp-r-1407)) (else (syntmp-match*-1402 (let ((syntmp-e-1409 syntmp-e-1404)) (if (syntmp-annotation?-89 syntmp-e-1409) (annotation-expression syntmp-e-1409) syntmp-e-1409)) syntmp-p-1405 syntmp-w-1406 syntmp-r-1407))))) (syntmp-match*-1402 (lambda (syntmp-e-1410 syntmp-p-1411 syntmp-w-1412 syntmp-r-1413) (cond ((null? syntmp-p-1411) (and (null? syntmp-e-1410) syntmp-r-1413)) ((pair? syntmp-p-1411) (and (pair? syntmp-e-1410) (syntmp-match-1403 (car syntmp-e-1410) (car syntmp-p-1411) syntmp-w-1412 (syntmp-match-1403 (cdr syntmp-e-1410) (cdr syntmp-p-1411) syntmp-w-1412 syntmp-r-1413)))) ((eq? syntmp-p-1411 (quote each-any)) (let ((syntmp-l-1414 (syntmp-match-each-any-1400 syntmp-e-1410 syntmp-w-1412))) (and syntmp-l-1414 (cons syntmp-l-1414 syntmp-r-1413)))) (else (let ((syntmp-t-1415 (vector-ref syntmp-p-1411 0))) (if (memv syntmp-t-1415 (quote (each))) (if (null? syntmp-e-1410) (syntmp-match-empty-1401 (vector-ref syntmp-p-1411 1) syntmp-r-1413) (let ((syntmp-l-1416 (syntmp-match-each-1399 syntmp-e-1410 (vector-ref syntmp-p-1411 1) syntmp-w-1412))) (and syntmp-l-1416 (let syntmp-collect-1417 ((syntmp-l-1418 syntmp-l-1416)) (if (null? (car syntmp-l-1418)) syntmp-r-1413 (cons (map car syntmp-l-1418) (syntmp-collect-1417 (map cdr syntmp-l-1418)))))))) (if (memv syntmp-t-1415 (quote (free-id))) (and (syntmp-id?-115 syntmp-e-1410) (syntmp-free-id=?-138 (syntmp-wrap-143 syntmp-e-1410 syntmp-w-1412) (vector-ref syntmp-p-1411 1)) syntmp-r-1413) (if (memv syntmp-t-1415 (quote (atom))) (and (equal? (vector-ref syntmp-p-1411 1) (syntmp-strip-162 syntmp-e-1410 syntmp-w-1412)) syntmp-r-1413) (if (memv syntmp-t-1415 (quote (vector))) (and (vector? syntmp-e-1410) (syntmp-match-1403 (vector->list syntmp-e-1410) (vector-ref syntmp-p-1411 1) syntmp-w-1412 syntmp-r-1413))))))))))) (syntmp-match-empty-1401 (lambda (syntmp-p-1419 syntmp-r-1420) (cond ((null? syntmp-p-1419) syntmp-r-1420) ((eq? syntmp-p-1419 (quote any)) (cons (quote ()) syntmp-r-1420)) ((pair? syntmp-p-1419) (syntmp-match-empty-1401 (car syntmp-p-1419) (syntmp-match-empty-1401 (cdr syntmp-p-1419) syntmp-r-1420))) ((eq? syntmp-p-1419 (quote each-any)) (cons (quote ()) syntmp-r-1420)) (else (let ((syntmp-t-1421 (vector-ref syntmp-p-1419 0))) (if (memv syntmp-t-1421 (quote (each))) (syntmp-match-empty-1401 (vector-ref syntmp-p-1419 1) syntmp-r-1420) (if (memv syntmp-t-1421 (quote (free-id atom))) syntmp-r-1420 (if (memv syntmp-t-1421 (quote (vector))) (syntmp-match-empty-1401 (vector-ref syntmp-p-1419 1) syntmp-r-1420))))))))) (syntmp-match-each-any-1400 (lambda (syntmp-e-1422 syntmp-w-1423) (cond ((syntmp-annotation?-89 syntmp-e-1422) (syntmp-match-each-any-1400 (annotation-expression syntmp-e-1422) syntmp-w-1423)) ((pair? syntmp-e-1422) (let ((syntmp-l-1424 (syntmp-match-each-any-1400 (cdr syntmp-e-1422) syntmp-w-1423))) (and syntmp-l-1424 (cons (syntmp-wrap-143 (car syntmp-e-1422) syntmp-w-1423) syntmp-l-1424)))) ((null? syntmp-e-1422) (quote ())) ((syntmp-syntax-object?-101 syntmp-e-1422) (syntmp-match-each-any-1400 (syntmp-syntax-object-expression-102 syntmp-e-1422) (syntmp-join-wraps-134 syntmp-w-1423 (syntmp-syntax-object-wrap-103 syntmp-e-1422)))) (else #f)))) (syntmp-match-each-1399 (lambda (syntmp-e-1425 syntmp-p-1426 syntmp-w-1427) (cond ((syntmp-annotation?-89 syntmp-e-1425) (syntmp-match-each-1399 (annotation-expression syntmp-e-1425) syntmp-p-1426 syntmp-w-1427)) ((pair? syntmp-e-1425) (let ((syntmp-first-1428 (syntmp-match-1403 (car syntmp-e-1425) syntmp-p-1426 syntmp-w-1427 (quote ())))) (and syntmp-first-1428 (let ((syntmp-rest-1429 (syntmp-match-each-1399 (cdr syntmp-e-1425) syntmp-p-1426 syntmp-w-1427))) (and syntmp-rest-1429 (cons syntmp-first-1428 syntmp-rest-1429)))))) ((null? syntmp-e-1425) (quote ())) ((syntmp-syntax-object?-101 syntmp-e-1425) (syntmp-match-each-1399 (syntmp-syntax-object-expression-102 syntmp-e-1425) syntmp-p-1426 (syntmp-join-wraps-134 syntmp-w-1427 (syntmp-syntax-object-wrap-103 syntmp-e-1425)))) (else #f))))) (begin (set! syntax-dispatch (lambda (syntmp-e-1430 syntmp-p-1431) (cond ((eq? syntmp-p-1431 (quote any)) (list syntmp-e-1430)) ((syntmp-syntax-object?-101 syntmp-e-1430) (syntmp-match*-1402 (let ((syntmp-e-1432 (syntmp-syntax-object-expression-102 syntmp-e-1430))) (if (syntmp-annotation?-89 syntmp-e-1432) (annotation-expression syntmp-e-1432) syntmp-e-1432)) syntmp-p-1431 (syntmp-syntax-object-wrap-103 syntmp-e-1430) (quote ()))) (else (syntmp-match*-1402 (let ((syntmp-e-1433 syntmp-e-1430)) (if (syntmp-annotation?-89 syntmp-e-1433) (annotation-expression syntmp-e-1433) syntmp-e-1433)) syntmp-p-1431 (quote (())) (quote ())))))) (set! sc-chi syntmp-chi-151)))))
-(install-global-transformer (quote with-syntax) (lambda (syntmp-x-1434) ((lambda (syntmp-tmp-1435) ((lambda (syntmp-tmp-1436) (if syntmp-tmp-1436 (apply (lambda (syntmp-_-1437 syntmp-e1-1438 syntmp-e2-1439) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons syntmp-e1-1438 syntmp-e2-1439))) syntmp-tmp-1436) ((lambda (syntmp-tmp-1441) (if syntmp-tmp-1441 (apply (lambda (syntmp-_-1442 syntmp-out-1443 syntmp-in-1444 syntmp-e1-1445 syntmp-e2-1446) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) syntmp-in-1444 (quote ()) (list syntmp-out-1443 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons syntmp-e1-1445 syntmp-e2-1446))))) syntmp-tmp-1441) ((lambda (syntmp-tmp-1448) (if syntmp-tmp-1448 (apply (lambda (syntmp-_-1449 syntmp-out-1450 syntmp-in-1451 syntmp-e1-1452 syntmp-e2-1453) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons (quote #(syntax-object list ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) syntmp-in-1451) (quote ()) (list syntmp-out-1450 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons syntmp-e1-1452 syntmp-e2-1453))))) syntmp-tmp-1448) (syntax-error syntmp-tmp-1435))) (syntax-dispatch syntmp-tmp-1435 (quote (any #(each (any any)) any . each-any)))))) (syntax-dispatch syntmp-tmp-1435 (quote (any ((any any)) any . each-any)))))) (syntax-dispatch syntmp-tmp-1435 (quote (any () any . each-any))))) syntmp-x-1434)))
-(install-global-transformer (quote syntax-rules) (lambda (syntmp-x-1475) ((lambda (syntmp-tmp-1476) ((lambda (syntmp-tmp-1477) (if syntmp-tmp-1477 (apply (lambda (syntmp-_-1478 syntmp-k-1479 syntmp-keyword-1480 syntmp-pattern-1481 syntmp-template-1482) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote (#(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))))) (cons (quote #(syntax-object syntax-case ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons (quote #(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons syntmp-k-1479 (map (lambda (syntmp-tmp-1485 syntmp-tmp-1484) (list (cons (quote #(syntax-object dummy ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) syntmp-tmp-1484) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) syntmp-tmp-1485))) syntmp-template-1482 syntmp-pattern-1481)))))) syntmp-tmp-1477) (syntax-error syntmp-tmp-1476))) (syntax-dispatch syntmp-tmp-1476 (quote (any each-any . #(each ((any . any) any))))))) syntmp-x-1475)))
-(install-global-transformer (quote let*) (lambda (syntmp-x-1496) ((lambda (syntmp-tmp-1497) ((lambda (syntmp-tmp-1498) (if (if syntmp-tmp-1498 (apply (lambda (syntmp-let*-1499 syntmp-x-1500 syntmp-v-1501 syntmp-e1-1502 syntmp-e2-1503) (andmap identifier? syntmp-x-1500)) syntmp-tmp-1498) #f) (apply (lambda (syntmp-let*-1505 syntmp-x-1506 syntmp-v-1507 syntmp-e1-1508 syntmp-e2-1509) (let syntmp-f-1510 ((syntmp-bindings-1511 (map list syntmp-x-1506 syntmp-v-1507))) (if (null? syntmp-bindings-1511) (cons (quote #(syntax-object let ((top) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons (quote ()) (cons syntmp-e1-1508 syntmp-e2-1509))) ((lambda (syntmp-tmp-1515) ((lambda (syntmp-tmp-1516) (if syntmp-tmp-1516 (apply (lambda (syntmp-body-1517 syntmp-binding-1518) (list (quote #(syntax-object let ((top) #(ribcage #(body binding) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (list syntmp-binding-1518) syntmp-body-1517)) syntmp-tmp-1516) (syntax-error syntmp-tmp-1515))) (syntax-dispatch syntmp-tmp-1515 (quote (any any))))) (list (syntmp-f-1510 (cdr syntmp-bindings-1511)) (car syntmp-bindings-1511)))))) syntmp-tmp-1498) (syntax-error syntmp-tmp-1497))) (syntax-dispatch syntmp-tmp-1497 (quote (any #(each (any any)) any . each-any))))) syntmp-x-1496)))
-(install-global-transformer (quote do) (lambda (syntmp-orig-x-1538) ((lambda (syntmp-tmp-1539) ((lambda (syntmp-tmp-1540) (if syntmp-tmp-1540 (apply (lambda (syntmp-_-1541 syntmp-var-1542 syntmp-init-1543 syntmp-step-1544 syntmp-e0-1545 syntmp-e1-1546 syntmp-c-1547) ((lambda (syntmp-tmp-1548) ((lambda (syntmp-tmp-1549) (if syntmp-tmp-1549 (apply (lambda (syntmp-step-1550) ((lambda (syntmp-tmp-1551) ((lambda (syntmp-tmp-1552) (if syntmp-tmp-1552 (apply (lambda () (list (quote #(syntax-object let ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) (map list syntmp-var-1542 syntmp-init-1543) (list (quote #(syntax-object if ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) (list (quote #(syntax-object not ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) syntmp-e0-1545) (cons (quote #(syntax-object begin ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) (append syntmp-c-1547 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) syntmp-step-1550))))))) syntmp-tmp-1552) ((lambda (syntmp-tmp-1557) (if syntmp-tmp-1557 (apply (lambda (syntmp-e1-1558 syntmp-e2-1559) (list (quote #(syntax-object let ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) (map list syntmp-var-1542 syntmp-init-1543) (list (quote #(syntax-object if ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) syntmp-e0-1545 (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) (cons syntmp-e1-1558 syntmp-e2-1559)) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) (append syntmp-c-1547 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) syntmp-step-1550))))))) syntmp-tmp-1557) (syntax-error syntmp-tmp-1551))) (syntax-dispatch syntmp-tmp-1551 (quote (any . each-any)))))) (syntax-dispatch syntmp-tmp-1551 (quote ())))) syntmp-e1-1546)) syntmp-tmp-1549) (syntax-error syntmp-tmp-1548))) (syntax-dispatch syntmp-tmp-1548 (quote each-any)))) (map (lambda (syntmp-v-1566 syntmp-s-1567) ((lambda (syntmp-tmp-1568) ((lambda (syntmp-tmp-1569) (if syntmp-tmp-1569 (apply (lambda () syntmp-v-1566) syntmp-tmp-1569) ((lambda (syntmp-tmp-1570) (if syntmp-tmp-1570 (apply (lambda (syntmp-e-1571) syntmp-e-1571) syntmp-tmp-1570) ((lambda (syntmp-_-1572) (syntax-error syntmp-orig-x-1538)) syntmp-tmp-1568))) (syntax-dispatch syntmp-tmp-1568 (quote (any)))))) (syntax-dispatch syntmp-tmp-1568 (quote ())))) syntmp-s-1567)) syntmp-var-1542 syntmp-step-1544))) syntmp-tmp-1540) (syntax-error syntmp-tmp-1539))) (syntax-dispatch syntmp-tmp-1539 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) syntmp-orig-x-1538)))
-(install-global-transformer (quote quasiquote) (letrec ((syntmp-quasicons-1600 (lambda (syntmp-x-1604 syntmp-y-1605) ((lambda (syntmp-tmp-1606) ((lambda (syntmp-tmp-1607) (if syntmp-tmp-1607 (apply (lambda (syntmp-x-1608 syntmp-y-1609) ((lambda (syntmp-tmp-1610) ((lambda (syntmp-tmp-1611) (if syntmp-tmp-1611 (apply (lambda (syntmp-dy-1612) ((lambda (syntmp-tmp-1613) ((lambda (syntmp-tmp-1614) (if syntmp-tmp-1614 (apply (lambda (syntmp-dx-1615) (list (quote #(syntax-object quote ((top) #(ribcage #(dx) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) (cons syntmp-dx-1615 syntmp-dy-1612))) syntmp-tmp-1614) ((lambda (syntmp-_-1616) (if (null? syntmp-dy-1612) (list (quote #(syntax-object list ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) syntmp-x-1608) (list (quote #(syntax-object cons ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) syntmp-x-1608 syntmp-y-1609))) syntmp-tmp-1613))) (syntax-dispatch syntmp-tmp-1613 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) any))))) syntmp-x-1608)) syntmp-tmp-1611) ((lambda (syntmp-tmp-1617) (if syntmp-tmp-1617 (apply (lambda (syntmp-stuff-1618) (cons (quote #(syntax-object list ((top) #(ribcage #(stuff) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) (cons syntmp-x-1608 syntmp-stuff-1618))) syntmp-tmp-1617) ((lambda (syntmp-else-1619) (list (quote #(syntax-object cons ((top) #(ribcage #(else) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) syntmp-x-1608 syntmp-y-1609)) syntmp-tmp-1610))) (syntax-dispatch syntmp-tmp-1610 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) . any)))))) (syntax-dispatch syntmp-tmp-1610 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) any))))) syntmp-y-1609)) syntmp-tmp-1607) (syntax-error syntmp-tmp-1606))) (syntax-dispatch syntmp-tmp-1606 (quote (any any))))) (list syntmp-x-1604 syntmp-y-1605)))) (syntmp-quasiappend-1601 (lambda (syntmp-x-1620 syntmp-y-1621) ((lambda (syntmp-tmp-1622) ((lambda (syntmp-tmp-1623) (if syntmp-tmp-1623 (apply (lambda (syntmp-x-1624 syntmp-y-1625) ((lambda (syntmp-tmp-1626) ((lambda (syntmp-tmp-1627) (if syntmp-tmp-1627 (apply (lambda () syntmp-x-1624) syntmp-tmp-1627) ((lambda (syntmp-_-1628) (list (quote #(syntax-object append ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) syntmp-x-1624 syntmp-y-1625)) syntmp-tmp-1626))) (syntax-dispatch syntmp-tmp-1626 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) ()))))) syntmp-y-1625)) syntmp-tmp-1623) (syntax-error syntmp-tmp-1622))) (syntax-dispatch syntmp-tmp-1622 (quote (any any))))) (list syntmp-x-1620 syntmp-y-1621)))) (syntmp-quasivector-1602 (lambda (syntmp-x-1629) ((lambda (syntmp-tmp-1630) ((lambda (syntmp-x-1631) ((lambda (syntmp-tmp-1632) ((lambda (syntmp-tmp-1633) (if syntmp-tmp-1633 (apply (lambda (syntmp-x-1634) (list (quote #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) (list->vector syntmp-x-1634))) syntmp-tmp-1633) ((lambda (syntmp-tmp-1636) (if syntmp-tmp-1636 (apply (lambda (syntmp-x-1637) (cons (quote #(syntax-object vector ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) syntmp-x-1637)) syntmp-tmp-1636) ((lambda (syntmp-_-1639) (list (quote #(syntax-object list->vector ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) syntmp-x-1631)) syntmp-tmp-1632))) (syntax-dispatch syntmp-tmp-1632 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) . each-any)))))) (syntax-dispatch syntmp-tmp-1632 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) each-any))))) syntmp-x-1631)) syntmp-tmp-1630)) syntmp-x-1629))) (syntmp-quasi-1603 (lambda (syntmp-p-1640 syntmp-lev-1641) ((lambda (syntmp-tmp-1642) ((lambda (syntmp-tmp-1643) (if syntmp-tmp-1643 (apply (lambda (syntmp-p-1644) (if (= syntmp-lev-1641 0) syntmp-p-1644 (syntmp-quasicons-1600 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))) #(syntax-object unquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))))) (syntmp-quasi-1603 (list syntmp-p-1644) (- syntmp-lev-1641 1))))) syntmp-tmp-1643) ((lambda (syntmp-tmp-1645) (if syntmp-tmp-1645 (apply (lambda (syntmp-p-1646 syntmp-q-1647) (if (= syntmp-lev-1641 0) (syntmp-quasiappend-1601 syntmp-p-1646 (syntmp-quasi-1603 syntmp-q-1647 syntmp-lev-1641)) (syntmp-quasicons-1600 (syntmp-quasicons-1600 (quote (#(syntax-object quote ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))) #(syntax-object unquote-splicing ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))))) (syntmp-quasi-1603 (list syntmp-p-1646) (- syntmp-lev-1641 1))) (syntmp-quasi-1603 syntmp-q-1647 syntmp-lev-1641)))) syntmp-tmp-1645) ((lambda (syntmp-tmp-1648) (if syntmp-tmp-1648 (apply (lambda (syntmp-p-1649) (syntmp-quasicons-1600 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))) #(syntax-object quasiquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))))) (syntmp-quasi-1603 (list syntmp-p-1649) (+ syntmp-lev-1641 1)))) syntmp-tmp-1648) ((lambda (syntmp-tmp-1650) (if syntmp-tmp-1650 (apply (lambda (syntmp-p-1651 syntmp-q-1652) (syntmp-quasicons-1600 (syntmp-quasi-1603 syntmp-p-1651 syntmp-lev-1641) (syntmp-quasi-1603 syntmp-q-1652 syntmp-lev-1641))) syntmp-tmp-1650) ((lambda (syntmp-tmp-1653) (if syntmp-tmp-1653 (apply (lambda (syntmp-x-1654) (syntmp-quasivector-1602 (syntmp-quasi-1603 syntmp-x-1654 syntmp-lev-1641))) syntmp-tmp-1653) ((lambda (syntmp-p-1656) (list (quote #(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) syntmp-p-1656)) syntmp-tmp-1642))) (syntax-dispatch syntmp-tmp-1642 (quote #(vector each-any)))))) (syntax-dispatch syntmp-tmp-1642 (quote (any . any)))))) (syntax-dispatch syntmp-tmp-1642 (quote (#(free-id #(syntax-object quasiquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) any)))))) (syntax-dispatch syntmp-tmp-1642 (quote ((#(free-id #(syntax-object unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) any) . any)))))) (syntax-dispatch syntmp-tmp-1642 (quote (#(free-id #(syntax-object unquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) any))))) syntmp-p-1640)))) (lambda (syntmp-x-1657) ((lambda (syntmp-tmp-1658) ((lambda (syntmp-tmp-1659) (if syntmp-tmp-1659 (apply (lambda (syntmp-_-1660 syntmp-e-1661) (syntmp-quasi-1603 syntmp-e-1661 0)) syntmp-tmp-1659) (syntax-error syntmp-tmp-1658))) (syntax-dispatch syntmp-tmp-1658 (quote (any any))))) syntmp-x-1657))))
-(install-global-transformer (quote include) (lambda (syntmp-x-1721) (letrec ((syntmp-read-file-1722 (lambda (syntmp-fn-1723 syntmp-k-1724) (let ((syntmp-p-1725 (open-input-file syntmp-fn-1723))) (let syntmp-f-1726 ((syntmp-x-1727 (read syntmp-p-1725))) (if (eof-object? syntmp-x-1727) (begin (close-input-port syntmp-p-1725) (quote ())) (cons (datum->syntax-object syntmp-k-1724 syntmp-x-1727) (syntmp-f-1726 (read syntmp-p-1725))))))))) ((lambda (syntmp-tmp-1728) ((lambda (syntmp-tmp-1729) (if syntmp-tmp-1729 (apply (lambda (syntmp-k-1730 syntmp-filename-1731) (let ((syntmp-fn-1732 (syntax-object->datum syntmp-filename-1731))) ((lambda (syntmp-tmp-1733) ((lambda (syntmp-tmp-1734) (if syntmp-tmp-1734 (apply (lambda (syntmp-exp-1735) (cons (quote #(syntax-object begin ((top) #(ribcage #(exp) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(fn) #((top)) #("i")) #(ribcage #(k filename) #((top) (top)) #("i" "i")) #(ribcage (read-file) ((top)) ("i")) #(ribcage #(x) #((top)) #("i"))))) syntmp-exp-1735)) syntmp-tmp-1734) (syntax-error syntmp-tmp-1733))) (syntax-dispatch syntmp-tmp-1733 (quote each-any)))) (syntmp-read-file-1722 syntmp-fn-1732 syntmp-k-1730)))) syntmp-tmp-1729) (syntax-error syntmp-tmp-1728))) (syntax-dispatch syntmp-tmp-1728 (quote (any any))))) syntmp-x-1721))))
-(install-global-transformer (quote unquote) (lambda (syntmp-x-1752) ((lambda (syntmp-tmp-1753) ((lambda (syntmp-tmp-1754) (if syntmp-tmp-1754 (apply (lambda (syntmp-_-1755 syntmp-e-1756) (error (quote unquote) "expression ,~s not valid outside of quasiquote" (syntax-object->datum syntmp-e-1756))) syntmp-tmp-1754) (syntax-error syntmp-tmp-1753))) (syntax-dispatch syntmp-tmp-1753 (quote (any any))))) syntmp-x-1752)))
-(install-global-transformer (quote unquote-splicing) (lambda (syntmp-x-1762) ((lambda (syntmp-tmp-1763) ((lambda (syntmp-tmp-1764) (if syntmp-tmp-1764 (apply (lambda (syntmp-_-1765 syntmp-e-1766) (error (quote unquote-splicing) "expression ,@~s not valid outside of quasiquote" (syntax-object->datum syntmp-e-1766))) syntmp-tmp-1764) (syntax-error syntmp-tmp-1763))) (syntax-dispatch syntmp-tmp-1763 (quote (any any))))) syntmp-x-1762)))
-(install-global-transformer (quote case) (lambda (syntmp-x-1772) ((lambda (syntmp-tmp-1773) ((lambda (syntmp-tmp-1774) (if syntmp-tmp-1774 (apply (lambda (syntmp-_-1775 syntmp-e-1776 syntmp-m1-1777 syntmp-m2-1778) ((lambda (syntmp-tmp-1779) ((lambda (syntmp-body-1780) (list (quote #(syntax-object let ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (list (list (quote #(syntax-object t ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) syntmp-e-1776)) syntmp-body-1780)) syntmp-tmp-1779)) (let syntmp-f-1781 ((syntmp-clause-1782 syntmp-m1-1777) (syntmp-clauses-1783 syntmp-m2-1778)) (if (null? syntmp-clauses-1783) ((lambda (syntmp-tmp-1785) ((lambda (syntmp-tmp-1786) (if syntmp-tmp-1786 (apply (lambda (syntmp-e1-1787 syntmp-e2-1788) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons syntmp-e1-1787 syntmp-e2-1788))) syntmp-tmp-1786) ((lambda (syntmp-tmp-1790) (if syntmp-tmp-1790 (apply (lambda (syntmp-k-1791 syntmp-e1-1792 syntmp-e2-1793) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) syntmp-k-1791)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons syntmp-e1-1792 syntmp-e2-1793)))) syntmp-tmp-1790) ((lambda (syntmp-_-1796) (syntax-error syntmp-x-1772)) syntmp-tmp-1785))) (syntax-dispatch syntmp-tmp-1785 (quote (each-any any . each-any)))))) (syntax-dispatch syntmp-tmp-1785 (quote (#(free-id #(syntax-object else ((top) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) any . each-any))))) syntmp-clause-1782) ((lambda (syntmp-tmp-1797) ((lambda (syntmp-rest-1798) ((lambda (syntmp-tmp-1799) ((lambda (syntmp-tmp-1800) (if syntmp-tmp-1800 (apply (lambda (syntmp-k-1801 syntmp-e1-1802 syntmp-e2-1803) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) syntmp-k-1801)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons syntmp-e1-1802 syntmp-e2-1803)) syntmp-rest-1798)) syntmp-tmp-1800) ((lambda (syntmp-_-1806) (syntax-error syntmp-x-1772)) syntmp-tmp-1799))) (syntax-dispatch syntmp-tmp-1799 (quote (each-any any . each-any))))) syntmp-clause-1782)) syntmp-tmp-1797)) (syntmp-f-1781 (car syntmp-clauses-1783) (cdr syntmp-clauses-1783))))))) syntmp-tmp-1774) (syntax-error syntmp-tmp-1773))) (syntax-dispatch syntmp-tmp-1773 (quote (any any any . each-any))))) syntmp-x-1772)))
-(install-global-transformer (quote identifier-syntax) (lambda (syntmp-x-1836) ((lambda (syntmp-tmp-1837) ((lambda (syntmp-tmp-1838) (if syntmp-tmp-1838 (apply (lambda (syntmp-_-1839 syntmp-e-1840) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))))) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote #(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote ()) (list (quote #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote (#(syntax-object identifier? ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))) (#(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))) #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) syntmp-e-1840)) (list (cons syntmp-_-1839 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons syntmp-e-1840 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))))))))))) syntmp-tmp-1838) (syntax-error syntmp-tmp-1837))) (syntax-dispatch syntmp-tmp-1837 (quote (any any))))) syntmp-x-1836)))
diff --git a/ice-9/receive.scm b/ice-9/receive.scm
deleted file mode 100644
index 693dfe3f4..000000000
--- a/ice-9/receive.scm
+++ /dev/null
@@ -1,28 +0,0 @@
-;;;; SRFI-8
-
-;;; Copyright (C) 2000, 2001, 2004, 2006 Free Software Foundation, Inc.
-;;;
-;; This library is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU Lesser General Public
-;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
-;; 
-;; This library is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;; Lesser General Public License for more details.
-;; 
-;; You should have received a copy of the GNU Lesser General Public
-;; License along with this library; if not, write to the Free Software
-;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-
-(define-module (ice-9 receive)
-  :export (receive)
-  :no-backtrace
-  )
-
-(define-macro (receive vars vals . body)
-  `(call-with-values (lambda () ,vals)
-     (lambda ,vars ,@body)))
-
-(cond-expand-provide (current-module) '(srfi-8))
diff --git a/ice-9/syncase.scm b/ice-9/syncase.scm
deleted file mode 100644
index 39cf27372..000000000
--- a/ice-9/syncase.scm
+++ /dev/null
@@ -1,249 +0,0 @@
-;;;; 	Copyright (C) 1997, 2000, 2001, 2002, 2003, 2006 Free Software Foundation, Inc.
-;;;; 
-;;;; This library is free software; you can redistribute it and/or
-;;;; modify it under the terms of the GNU Lesser General Public
-;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
-;;;; 
-;;;; This library is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;;; Lesser General Public License for more details.
-;;;; 
-;;;; You should have received a copy of the GNU Lesser General Public
-;;;; License along with this library; if not, write to the Free Software
-;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-;;;; 
-
-
-(define-module (ice-9 syncase)
-  :use-module (ice-9 debug)
-  :use-module (ice-9 threads)
-  :export-syntax (sc-macro define-syntax define-syntax-public 
-                  eval-when fluid-let-syntax
-		  identifier-syntax let-syntax
-		  letrec-syntax syntax syntax-case  syntax-rules
-		  with-syntax
-		  include)
-  :export (sc-expand sc-expand3 install-global-transformer
-	   syntax-dispatch syntax-error bound-identifier=?
-	   datum->syntax-object free-identifier=?
-	   generate-temporaries identifier? syntax-object->datum
-	   void syncase)
-  :replace (eval))
-
-
-
-(define expansion-eval-closure (make-fluid))
-
-(define (env->eval-closure env)
-  (or (and env
-	   (car (last-pair env)))
-      (module-eval-closure the-root-module)))
-
-(define sc-macro
-  (procedure->memoizing-macro
-    (lambda (exp env)
-      (with-fluids ((expansion-eval-closure (env->eval-closure env)))
-        (sc-expand exp)))))
-
-;;; Exported variables
-
-(define sc-expand #f)
-(define sc-expand3 #f)
-(define sc-chi #f)
-(define install-global-transformer #f)
-(define syntax-dispatch #f)
-(define syntax-error #f)
-
-(define bound-identifier=? #f)
-(define datum->syntax-object #f)
-(define free-identifier=? #f)
-(define generate-temporaries #f)
-(define identifier? #f)
-(define syntax-object->datum #f)
-
-(define primitive-syntax '(quote lambda letrec if set! begin define or
-			   and let let* cond do quasiquote unquote
-			   unquote-splicing case))
-
-(for-each (lambda (symbol)
-	    (set-symbol-property! symbol 'primitive-syntax #t))
-	  primitive-syntax)
-
-;;; Hooks needed by the syntax-case macro package
-
-(define (void) *unspecified*)
-
-(define andmap
-  (lambda (f first . rest)
-    (or (null? first)
-        (if (null? rest)
-            (let andmap ((first first))
-              (let ((x (car first)) (first (cdr first)))
-                (if (null? first)
-                    (f x)
-                    (and (f x) (andmap first)))))
-            (let andmap ((first first) (rest rest))
-              (let ((x (car first))
-                    (xr (map car rest))
-                    (first (cdr first))
-                    (rest (map cdr rest)))
-                (if (null? first)
-                    (apply f (cons x xr))
-                    (and (apply f (cons x xr)) (andmap first rest)))))))))
-
-(define (error who format-string why what)
-  (start-stack 'syncase-stack
-	       (scm-error 'misc-error
-			  who
-			  "~A ~S"
-			  (list why what)
-			  '())))
-
-(define the-syncase-module (current-module))
-(define the-syncase-eval-closure (module-eval-closure the-syncase-module))
-
-(fluid-set! expansion-eval-closure the-syncase-eval-closure)
-
-(define (putprop symbol key binding)
-  (let* ((eval-closure (fluid-ref expansion-eval-closure))
-	 ;; Why not simply do (eval-closure symbol #t)?
-	 ;; Answer: That would overwrite imported bindings
-	 (v (or (eval-closure symbol #f) ;lookup
-		(eval-closure symbol #t) ;create it locally
-		)))
-    ;; Don't destroy Guile macros corresponding to
-    ;; primitive syntax when syncase boots.
-    (if (not (and (symbol-property symbol 'primitive-syntax)
-		  (eq? eval-closure the-syncase-eval-closure)))
-	(variable-set! v sc-macro))
-    ;; Properties are tied to variable objects
-    (set-object-property! v key binding)))
-
-(define (getprop symbol key)
-  (let* ((v ((fluid-ref expansion-eval-closure) symbol #f)))
-    (and v
-	 (or (object-property v key)
-	     (and (variable-bound? v)
-		  (macro? (variable-ref v))
-		  (macro-transformer (variable-ref v)) ;non-primitive
-		  guile-macro)))))
-
-(define guile-macro
-  (cons 'external-macro
-	(lambda (e r w s)
-	  (let ((e (syntax-object->datum e)))
-	    (if (symbol? e)
-		;; pass the expression through
-		e
-		(let* ((eval-closure (fluid-ref expansion-eval-closure))
-		       (m (variable-ref (eval-closure (car e) #f))))
-		  (if (eq? (macro-type m) 'syntax)
-		      ;; pass the expression through
-		      e
-		      ;; perform Guile macro transform
-		      (let ((e ((macro-transformer m)
-				e
-				(append r (list eval-closure)))))
-			(if (variable? e)
-			    e
-			    (if (null? r)
-				(sc-expand e)
-				(sc-chi e r w)))))))))))
-
-(define generated-symbols (make-weak-key-hash-table 1019))
-
-;; We define our own gensym here because the Guile built-in one will
-;; eventually produce uninterned and unreadable symbols (as needed for
-;; safe macro expansions) and will the be inappropriate for dumping to
-;; pssyntax.pp.
-;;
-;; syncase is supposed to only require that gensym produce unique
-;; readable symbols, and they only need be unique with respect to
-;; multiple calls to gensym, not globally unique.
-;;
-(define gensym
-  (let ((counter 0))
-
-    (define next-id
-      (if (provided? 'threads)
-          (let ((symlock (make-mutex)))
-            (lambda ()
-              (let ((result #f))
-                (with-mutex symlock
-                  (set! result counter)
-                  (set! counter (+ counter 1)))
-                result)))
-          ;; faster, non-threaded case.
-          (lambda ()
-            (let ((result counter))
-              (set! counter (+ counter 1))
-              result))))
-    
-    ;; actual gensym body code.
-    (lambda (. rest)
-      (let* ((next-val (next-id))
-             (valstr (number->string next-val)))
-          (cond
-           ((null? rest)
-            (string->symbol (string-append "syntmp-" valstr)))
-           ((null? (cdr rest))
-            (string->symbol (string-append "syntmp-" (car rest) "-" valstr)))
-           (else
-            (error
-             (string-append
-              "syncase's gensym expected 0 or 1 arguments, got "
-              (length rest)))))))))
-
-;;; Load the preprocessed code
-
-(let ((old-debug #f)
-      (old-read #f))
-  (dynamic-wind (lambda ()
-		  (set! old-debug (debug-options))
-		  (set! old-read (read-options)))
-		(lambda ()
-		  (debug-disable 'debug 'procnames)
-		  (read-disable 'positions)
-		  (load-from-path "ice-9/psyntax.pp"))
-		(lambda ()
-		  (debug-options old-debug)
-		  (read-options old-read))))
-
-
-;;; The following lines are necessary only if we start making changes
-;; (use-syntax sc-expand)
-;; (load-from-path "ice-9/psyntax.ss")
-
-(define internal-eval (nested-ref the-scm-module '(%app modules guile eval)))
-
-(define (eval x environment)
-  (internal-eval (if (and (pair? x)
-			  (equal? (car x) "noexpand"))
-		     (cadr x)
-		     (sc-expand x))
-		 environment))
-
-;;; Hack to make syncase macros work in the slib module
-(let ((m (nested-ref the-root-module '(%app modules ice-9 slib))))
-  (if m
-      (set-object-property! (module-local-variable m 'define)
-			    '*sc-expander*
-			    '(define))))
-
-(define (syncase exp)
-  (with-fluids ((expansion-eval-closure
-		 (module-eval-closure (current-module))))
-    (sc-expand exp)))
-
-(set-module-transformer! the-syncase-module syncase)
-
-(define-syntax define-syntax-public
-  (syntax-rules ()
-    ((_ name rules ...)
-     (begin
-       ;(eval-case ((load-toplevel) (export-syntax name)))
-       (define-syntax name rules ...)))))
-
-(fluid-set! expansion-eval-closure (env->eval-closure #f))
diff --git a/lang/Makefile.am b/lang/Makefile.am
index 6dc2e2902..adbe4d43c 100644
--- a/lang/Makefile.am
+++ b/lang/Makefile.am
@@ -4,20 +4,20 @@
 ##
 ##   This file is part of GUILE.
 ##   
-##   GUILE 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
+##   GUILE is free software; you can redistribute it and/or modify it
+##   under the terms of the GNU Lesser General Public License as
+##   published by the Free Software Foundation; either version 3, or
 ##   (at your option) any later version.
-##   
+##
 ##   GUILE is distributed in the hope that 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 GUILE; see the file COPYING.  If not, write
-##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-##   Floor, Boston, MA 02110-1301 USA
+##   GNU Lesser General Public License for more details.
+##
+##   You should have received a copy of the GNU Lesser General Public
+##   License along with GUILE; see the file COPYING.LESSER.  If not,
+##   write to the Free Software Foundation, Inc., 51 Franklin Street,
+##   Fifth Floor, Boston, MA 02110-1301 USA
 
 AUTOMAKE_OPTIONS = gnu
 
@@ -28,6 +28,7 @@ elisp_sources =					\
 	elisp/example.el			\
 	elisp/interface.scm			\
 	elisp/transform.scm			\
+	elisp/expand.scm			\
 	elisp/variables.scm			\
 						\
 	elisp/primitives/buffers.scm		\
diff --git a/lang/elisp/expand.scm b/lang/elisp/expand.scm
new file mode 100644
index 000000000..0599d5984
--- /dev/null
+++ b/lang/elisp/expand.scm
@@ -0,0 +1,4 @@
+(define-module (lang elisp expand)
+  #:export (expand))
+
+(define (expand x) x)
diff --git a/lang/elisp/interface.scm b/lang/elisp/interface.scm
index 1e0758569..31864cc8e 100644
--- a/lang/elisp/interface.scm
+++ b/lang/elisp/interface.scm
@@ -1,4 +1,5 @@
 (define-module (lang elisp interface)
+  #:use-syntax (lang elisp expand)
   #:use-module (lang elisp internals evaluation)
   #:use-module (lang elisp internals fset)
   #:use-module ((lang elisp internals load) #:select ((load . elisp:load)))
@@ -19,7 +20,10 @@
 
 (define (eval-elisp x)
   "Evaluate the Elisp expression @var{x}."
-  (eval x the-elisp-module))
+  (save-module-excursion 
+   (lambda ()
+     (set-current-module the-elisp-module)
+     (primitive-eval x))))
 
 (define (translate-elisp x)
   "Translate the Elisp expression @var{x} to equivalent Scheme code."
@@ -66,31 +70,39 @@ one of the directories of @code{load-path}."
 	    (string->symbol (string-append "imports:"
 					   (number->string counter)))))))
 
-(define-macro (use-elisp-file file-name . imports)
-  "Load Elisp code file @var{file-name} and import its definitions
+(define use-elisp-file
+  (procedure->memoizing-macro
+   (lambda (exp env)
+     "Load Elisp code file @var{file-name} and import its definitions
 into the current Scheme module.  If any @var{imports} are specified,
 they are interpreted as selection and renaming specifiers as per
 @code{use-modules}."
-  (let ((export-module-name (export-module-name)))
-    `(begin
-       (fluid-set! ,elisp-export-module (resolve-module ',export-module-name))
-       (beautify-user-module! (resolve-module ',export-module-name))
-       (load-elisp-file ,file-name)
-       (use-modules (,export-module-name ,@imports))
-       (fluid-set! ,elisp-export-module #f))))
+     (let ((file-name (cadr exp))
+           (env (cddr exp)))
+       (let ((export-module-name (export-module-name)))
+         `(begin
+            (fluid-set! ,elisp-export-module (resolve-module ',export-module-name))
+            (beautify-user-module! (resolve-module ',export-module-name))
+            (load-elisp-file ,file-name)
+            (use-modules (,export-module-name ,@imports))
+            (fluid-set! ,elisp-export-module #f)))))))
 
-(define-macro (use-elisp-library library . imports)
-  "Load Elisp library @var{library} and import its definitions into
+(define use-elisp-library
+  (procedure->memoizing-macro
+   (lambda (exp env)
+     "Load Elisp library @var{library} and import its definitions into
 the current Scheme module.  If any @var{imports} are specified, they
 are interpreted as selection and renaming specifiers as per
 @code{use-modules}."
-  (let ((export-module-name (export-module-name)))
-    `(begin
-       (fluid-set! ,elisp-export-module (resolve-module ',export-module-name))
-       (beautify-user-module! (resolve-module ',export-module-name))
-       (load-elisp-library ,library)
-       (use-modules (,export-module-name ,@imports))
-       (fluid-set! ,elisp-export-module #f))))
+     (let ((library (cadr exp))
+           (env (cddr exp)))
+       (let ((export-module-name (export-module-name)))
+         `(begin
+            (fluid-set! ,elisp-export-module (resolve-module ',export-module-name))
+            (beautify-user-module! (resolve-module ',export-module-name))
+            (load-elisp-library ,library)
+            (use-modules (,export-module-name ,@imports))
+            (fluid-set! ,elisp-export-module #f)))))))
 
 (define (export-to-elisp . defs)
   "Export procedures and variables specified by @var{defs} to Elisp.
diff --git a/lang/elisp/internals/lambda.scm b/lang/elisp/internals/lambda.scm
index 9917c08bd..f7c7a4d01 100644
--- a/lang/elisp/internals/lambda.scm
+++ b/lang/elisp/internals/lambda.scm
@@ -1,4 +1,5 @@
 (define-module (lang elisp internals lambda)
+  #:use-syntax (lang elisp expand)
   #:use-module (lang elisp internals fset)
   #:use-module (lang elisp transform)
   #:export (parse-formals
diff --git a/lang/elisp/primitives/fns.scm b/lang/elisp/primitives/fns.scm
index f7a4aa003..7beb8a51c 100644
--- a/lang/elisp/primitives/fns.scm
+++ b/lang/elisp/primitives/fns.scm
@@ -26,7 +26,8 @@
 
 (fset 'symbol-function fref/error-if-void)
 
-(fset 'macroexpand macroexpand)
+;; FIXME -- lost in the syncase conversion
+;; (fset 'macroexpand macroexpand)
 
 (fset 'subrp
       (lambda (obj)
diff --git a/lang/elisp/primitives/syntax.scm b/lang/elisp/primitives/syntax.scm
index 6babb3dd3..118b3bc0c 100644
--- a/lang/elisp/primitives/syntax.scm
+++ b/lang/elisp/primitives/syntax.scm
@@ -1,4 +1,5 @@
 (define-module (lang elisp primitives syntax)
+  #:use-syntax (lang elisp expand)
   #:use-module (lang elisp internals evaluation)
   #:use-module (lang elisp internals fset)
   #:use-module (lang elisp internals lambda)
diff --git a/lang/elisp/transform.scm b/lang/elisp/transform.scm
index ee288a722..09159c073 100644
--- a/lang/elisp/transform.scm
+++ b/lang/elisp/transform.scm
@@ -1,4 +1,5 @@
 (define-module (lang elisp transform)
+  #:use-syntax (lang elisp expand)
   #:use-module (lang elisp internals trace)
   #:use-module (lang elisp internals fset)
   #:use-module (lang elisp internals evaluation)
@@ -26,23 +27,27 @@
 (define (syntax-error x)
   (error "Syntax error in expression" x))
 
-(define-macro (scheme exp . module)
-  (let ((m (if (null? module)
-	       the-root-module
-	       (save-module-excursion
-		(lambda ()
-		  ;; In order for `resolve-module' to work as
-		  ;; expected, the current module must contain the
-		  ;; `app' variable.  This is not true for #:pure
-		  ;; modules, specifically (lang elisp base).  So,
-		  ;; switch to the root module (guile) before calling
-		  ;; resolve-module.
-		  (set-current-module the-root-module)
-		  (resolve-module (car module)))))))
-    (let ((x `(,eval (,quote ,exp) ,m)))
-      ;;(write x)
-      ;;(newline)
-      x)))
+(define scheme
+  (procedure->memoizing-macro
+   (lambda (exp env)
+     (let ((exp (cadr exp))
+           (module (cddr exp)))
+       (let ((m (if (null? module)
+                    the-root-module
+                    (save-module-excursion
+                     (lambda ()
+                       ;; In order for `resolve-module' to work as
+                       ;; expected, the current module must contain the
+                       ;; `app' variable.  This is not true for #:pure
+                       ;; modules, specifically (lang elisp base).  So,
+                       ;; switch to the root module (guile) before calling
+                       ;; resolve-module.
+                       (set-current-module the-root-module)
+                       (resolve-module (car module)))))))
+         (let ((x `(,eval (,quote ,exp) ,m)))
+           ;;(write x)
+           ;;(newline)
+           x))))))
 
 (define (transformer x)
   (cond ((pair? x)
diff --git a/lib/Makefile.am b/lib/Makefile.am
index bd59069f8..075cd75b7 100644
--- a/lib/Makefile.am
+++ b/lib/Makefile.am
@@ -9,9 +9,9 @@
 # the same distribution terms as the rest of that program.
 #
 # Generated by gnulib-tool.
-# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --lgpl --libtool --macro-prefix=gl --no-vc-files alloca-opt autobuild extensions full-read full-write strcase strftime
+# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --lgpl --libtool --macro-prefix=gl --no-vc-files alloca-opt autobuild byteswap canonicalize-lgpl environ extensions flock fpieee full-read full-write havelib iconv_open-utf lib-symbol-versions lib-symbol-visibility libunistring putenv stdlib strcase strftime striconveh string verify vsnprintf
 
-AUTOMAKE_OPTIONS = 1.5 gnits
+AUTOMAKE_OPTIONS = 1.5 gnits subdir-objects
 
 SUBDIRS =
 noinst_HEADERS =
@@ -27,6 +27,7 @@ DISTCLEANFILES =
 MAINTAINERCLEANFILES =
 
 AM_CPPFLAGS =
+AM_CFLAGS =
 
 noinst_LTLIBRARIES += libgnu.la
 
@@ -53,6 +54,51 @@ EXTRA_DIST += alloca.in.h
 
 ## end   gnulib module alloca-opt
 
+## begin gnulib module byteswap
+
+BUILT_SOURCES += $(BYTESWAP_H)
+
+# We need the following in order to create <byteswap.h> when the system
+# doesn't have one.
+byteswap.h: byteswap.in.h
+	{ echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
+	  cat $(srcdir)/byteswap.in.h; \
+	} > $@-t
+	mv -f $@-t $@
+MOSTLYCLEANFILES += byteswap.h byteswap.h-t
+
+EXTRA_DIST += byteswap.in.h
+
+## end   gnulib module byteswap
+
+## begin gnulib module c-ctype
+
+libgnu_la_SOURCES += c-ctype.h c-ctype.c
+
+## end   gnulib module c-ctype
+
+## begin gnulib module c-strcase
+
+libgnu_la_SOURCES += c-strcase.h c-strcasecmp.c c-strncasecmp.c
+
+## end   gnulib module c-strcase
+
+## begin gnulib module c-strcaseeq
+
+
+EXTRA_DIST += c-strcaseeq.h
+
+## end   gnulib module c-strcaseeq
+
+## begin gnulib module canonicalize-lgpl
+
+
+EXTRA_DIST += canonicalize-lgpl.c canonicalize.h
+
+EXTRA_libgnu_la_SOURCES += canonicalize-lgpl.c
+
+## end   gnulib module canonicalize-lgpl
+
 ## begin gnulib module configmake
 
 # Retrieve values of the variables through 'configure' followed by
@@ -73,7 +119,7 @@ EXTRA_DIST += alloca.in.h
 # The Automake-defined pkg* macros are appended, in the order
 # listed in the Automake 1.10a+ documentation.
 configmake.h: Makefile
-	rm -f $@-t $@
+	rm -f $@-t
 	{ echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
 	  echo '#define PREFIX "$(prefix)"'; \
 	  echo '#define EXEC_PREFIX "$(exec_prefix)"'; \
@@ -103,12 +149,74 @@ configmake.h: Makefile
 	  echo '#define PKGLIBDIR "$(pkglibdir)"'; \
 	  echo '#define PKGLIBEXECDIR "$(pkglibexecdir)"'; \
 	} | sed '/""/d' > $@-t
-	mv $@-t $@
+	if test -f $@ && cmp $@-t $@ > /dev/null; then \
+	  rm -f $@-t; \
+	else \
+	  rm -f $@; mv $@-t $@; \
+	fi
+
 BUILT_SOURCES += configmake.h
 CLEANFILES += configmake.h configmake.h-t
 
 ## end   gnulib module configmake
 
+## begin gnulib module errno
+
+BUILT_SOURCES += $(ERRNO_H)
+
+# We need the following in order to create <errno.h> when the system
+# doesn't have one that is POSIX compliant.
+errno.h: errno.in.h
+	rm -f $@-t $@
+	{ echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \
+	  sed -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
+	      -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
+	      -e 's|@''NEXT_ERRNO_H''@|$(NEXT_ERRNO_H)|g' \
+	      -e 's|@''EMULTIHOP_HIDDEN''@|$(EMULTIHOP_HIDDEN)|g' \
+	      -e 's|@''EMULTIHOP_VALUE''@|$(EMULTIHOP_VALUE)|g' \
+	      -e 's|@''ENOLINK_HIDDEN''@|$(ENOLINK_HIDDEN)|g' \
+	      -e 's|@''ENOLINK_VALUE''@|$(ENOLINK_VALUE)|g' \
+	      -e 's|@''EOVERFLOW_HIDDEN''@|$(EOVERFLOW_HIDDEN)|g' \
+	      -e 's|@''EOVERFLOW_VALUE''@|$(EOVERFLOW_VALUE)|g' \
+	      < $(srcdir)/errno.in.h; \
+	} > $@-t
+	mv $@-t $@
+MOSTLYCLEANFILES += errno.h errno.h-t
+
+EXTRA_DIST += errno.in.h
+
+## end   gnulib module errno
+
+## begin gnulib module float
+
+BUILT_SOURCES += $(FLOAT_H)
+
+# We need the following in order to create <float.h> when the system
+# doesn't have one that works with the given compiler.
+float.h: float.in.h
+	rm -f $@-t $@
+	{ echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \
+	  sed -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
+	      -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
+	      -e 's|@''NEXT_FLOAT_H''@|$(NEXT_FLOAT_H)|g' \
+	      < $(srcdir)/float.in.h; \
+	} > $@-t
+	mv $@-t $@
+MOSTLYCLEANFILES += float.h float.h-t
+
+EXTRA_DIST += float.in.h
+
+## end   gnulib module float
+
+## begin gnulib module flock
+
+
+EXTRA_DIST += flock.c
+
+EXTRA_libgnu_la_SOURCES += flock.c
+
+## end   gnulib module flock
+
 ## begin gnulib module full-read
 
 libgnu_la_SOURCES += full-read.h full-read.c
@@ -121,6 +229,91 @@ libgnu_la_SOURCES += full-write.h full-write.c
 
 ## end   gnulib module full-write
 
+## begin gnulib module getpagesize
+
+
+EXTRA_DIST += getpagesize.c
+
+EXTRA_libgnu_la_SOURCES += getpagesize.c
+
+## end   gnulib module getpagesize
+
+## begin gnulib module gperf
+
+GPERF = gperf
+
+## end   gnulib module gperf
+
+## begin gnulib module havelib
+
+
+EXTRA_DIST += $(top_srcdir)/build-aux/config.rpath
+
+## end   gnulib module havelib
+
+## begin gnulib module iconv_open
+
+BUILT_SOURCES += $(ICONV_H)
+
+# We need the following in order to create <iconv.h> when the system
+# doesn't have one that works with the given compiler.
+iconv.h: iconv.in.h
+	rm -f $@-t $@
+	{ echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \
+	  sed -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
+	      -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
+	      -e 's|@''NEXT_ICONV_H''@|$(NEXT_ICONV_H)|g' \
+	      -e 's|@''ICONV_CONST''@|$(ICONV_CONST)|g' \
+	      -e 's|@''REPLACE_ICONV''@|$(REPLACE_ICONV)|g' \
+	      -e 's|@''REPLACE_ICONV_OPEN''@|$(REPLACE_ICONV_OPEN)|g' \
+	      -e 's|@''REPLACE_ICONV_UTF''@|$(REPLACE_ICONV_UTF)|g' \
+	      < $(srcdir)/iconv.in.h; \
+	} > $@-t
+	mv $@-t $@
+MOSTLYCLEANFILES += iconv.h iconv.h-t
+
+iconv_open-aix.h: iconv_open-aix.gperf
+	$(GPERF) -m 10 $(srcdir)/iconv_open-aix.gperf > $(srcdir)/iconv_open-aix.h-t
+	mv $(srcdir)/iconv_open-aix.h-t $(srcdir)/iconv_open-aix.h
+iconv_open-hpux.h: iconv_open-hpux.gperf
+	$(GPERF) -m 10 $(srcdir)/iconv_open-hpux.gperf > $(srcdir)/iconv_open-hpux.h-t
+	mv $(srcdir)/iconv_open-hpux.h-t $(srcdir)/iconv_open-hpux.h
+iconv_open-irix.h: iconv_open-irix.gperf
+	$(GPERF) -m 10 $(srcdir)/iconv_open-irix.gperf > $(srcdir)/iconv_open-irix.h-t
+	mv $(srcdir)/iconv_open-irix.h-t $(srcdir)/iconv_open-irix.h
+iconv_open-osf.h: iconv_open-osf.gperf
+	$(GPERF) -m 10 $(srcdir)/iconv_open-osf.gperf > $(srcdir)/iconv_open-osf.h-t
+	mv $(srcdir)/iconv_open-osf.h-t $(srcdir)/iconv_open-osf.h
+BUILT_SOURCES        += iconv_open-aix.h iconv_open-hpux.h iconv_open-irix.h iconv_open-osf.h
+MOSTLYCLEANFILES     += iconv_open-aix.h-t iconv_open-hpux.h-t iconv_open-irix.h-t iconv_open-osf.h-t
+MAINTAINERCLEANFILES += iconv_open-aix.h iconv_open-hpux.h iconv_open-irix.h iconv_open-osf.h
+EXTRA_DIST           += iconv_open-aix.h iconv_open-hpux.h iconv_open-irix.h iconv_open-osf.h
+
+EXTRA_DIST += iconv.in.h iconv_open-aix.gperf iconv_open-hpux.gperf iconv_open-irix.gperf iconv_open-osf.gperf iconv_open.c
+
+EXTRA_libgnu_la_SOURCES += iconv_open.c
+
+## end   gnulib module iconv_open
+
+## begin gnulib module iconv_open-utf
+
+
+EXTRA_DIST += iconv.c iconv_close.c
+
+EXTRA_libgnu_la_SOURCES += iconv.c iconv_close.c
+
+## end   gnulib module iconv_open-utf
+
+## begin gnulib module lib-symbol-visibility
+
+# The value of $(CFLAG_VISIBILITY) needs to be added to the CFLAGS for the
+# compilation of all sources that make up the library. This line here does it
+# only for the gnulib part of it. The developer is responsible for adding
+# $(CFLAG_VISIBILITY) to the Makefile.ams of the other portions of the library.
+AM_CFLAGS += $(CFLAG_VISIBILITY)
+
+## end   gnulib module lib-symbol-visibility
+
 ## begin gnulib module link-warning
 
 LINK_WARNING_H=$(top_srcdir)/build-aux/link-warning.h
@@ -144,21 +337,37 @@ all-local: charset.alias ref-add.sed ref-del.sed
 
 charset_alias = $(DESTDIR)$(libdir)/charset.alias
 charset_tmp = $(DESTDIR)$(libdir)/charset.tmp
-install-exec-local: all-local
-	test $(GLIBC21) != no || $(mkinstalldirs) $(DESTDIR)$(libdir)
+install-exec-local: install-exec-localcharset
+install-exec-localcharset: all-local
+	if test $(GLIBC21) = no; then \
+	  case '$(host_os)' in \
+	    darwin[56]*) \
+	      need_charset_alias=true ;; \
+	    darwin* | cygwin* | mingw* | pw32* | cegcc*) \
+	      need_charset_alias=false ;; \
+	    *) \
+	      need_charset_alias=true ;; \
+	  esac ; \
+	else \
+	  need_charset_alias=false ; \
+	fi ; \
+	if $$need_charset_alias; then \
+	  $(mkinstalldirs) $(DESTDIR)$(libdir) ; \
+	fi ; \
 	if test -f $(charset_alias); then \
 	  sed -f ref-add.sed $(charset_alias) > $(charset_tmp) ; \
 	  $(INSTALL_DATA) $(charset_tmp) $(charset_alias) ; \
 	  rm -f $(charset_tmp) ; \
 	else \
-	  if test $(GLIBC21) = no; then \
+	  if $$need_charset_alias; then \
 	    sed -f ref-add.sed charset.alias > $(charset_tmp) ; \
 	    $(INSTALL_DATA) $(charset_tmp) $(charset_alias) ; \
 	    rm -f $(charset_tmp) ; \
 	  fi ; \
 	fi
 
-uninstall-local: all-local
+uninstall-local: uninstall-localcharset
+uninstall-localcharset: all-local
 	if test -f $(charset_alias); then \
 	  sed -f ref-del.sed $(charset_alias) > $(charset_tmp); \
 	  if grep '^# Packages using this file: $$' $(charset_tmp) \
@@ -187,6 +396,23 @@ EXTRA_DIST += config.charset ref-add.sin ref-del.sin
 
 ## end   gnulib module localcharset
 
+## begin gnulib module malloc-posix
+
+
+EXTRA_DIST += malloc.c
+
+EXTRA_libgnu_la_SOURCES += malloc.c
+
+## end   gnulib module malloc-posix
+
+## begin gnulib module malloca
+
+libgnu_la_SOURCES += malloca.c
+
+EXTRA_DIST += malloca.h malloca.valgrind
+
+## end   gnulib module malloca
+
 ## begin gnulib module mbrlen
 
 
@@ -214,6 +440,40 @@ EXTRA_libgnu_la_SOURCES += mbsinit.c
 
 ## end   gnulib module mbsinit
 
+## begin gnulib module memchr
+
+
+EXTRA_DIST += memchr.c memchr.valgrind
+
+EXTRA_libgnu_la_SOURCES += memchr.c
+
+## end   gnulib module memchr
+
+## begin gnulib module pathmax
+
+
+EXTRA_DIST += pathmax.h
+
+## end   gnulib module pathmax
+
+## begin gnulib module putenv
+
+
+EXTRA_DIST += putenv.c
+
+EXTRA_libgnu_la_SOURCES += putenv.c
+
+## end   gnulib module putenv
+
+## begin gnulib module readlink
+
+
+EXTRA_DIST += readlink.c
+
+EXTRA_libgnu_la_SOURCES += readlink.c
+
+## end   gnulib module readlink
+
 ## begin gnulib module safe-read
 
 
@@ -232,6 +492,12 @@ EXTRA_libgnu_la_SOURCES += safe-write.c
 
 ## end   gnulib module safe-write
 
+## begin gnulib module size_max
+
+libgnu_la_SOURCES += size_max.h
+
+## end   gnulib module size_max
+
 ## begin gnulib module stdbool
 
 BUILT_SOURCES += $(STDBOOL_H)
@@ -250,6 +516,200 @@ EXTRA_DIST += stdbool.in.h
 
 ## end   gnulib module stdbool
 
+## begin gnulib module stdint
+
+BUILT_SOURCES += $(STDINT_H)
+
+# We need the following in order to create <stdint.h> when the system
+# doesn't have one that works with the given compiler.
+stdint.h: stdint.in.h
+	rm -f $@-t $@
+	{ echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
+	  sed -e 's/@''HAVE_STDINT_H''@/$(HAVE_STDINT_H)/g' \
+	      -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
+	      -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
+	      -e 's|@''NEXT_STDINT_H''@|$(NEXT_STDINT_H)|g' \
+	      -e 's/@''HAVE_SYS_TYPES_H''@/$(HAVE_SYS_TYPES_H)/g' \
+	      -e 's/@''HAVE_INTTYPES_H''@/$(HAVE_INTTYPES_H)/g' \
+	      -e 's/@''HAVE_SYS_INTTYPES_H''@/$(HAVE_SYS_INTTYPES_H)/g' \
+	      -e 's/@''HAVE_SYS_BITYPES_H''@/$(HAVE_SYS_BITYPES_H)/g' \
+	      -e 's/@''HAVE_LONG_LONG_INT''@/$(HAVE_LONG_LONG_INT)/g' \
+	      -e 's/@''HAVE_UNSIGNED_LONG_LONG_INT''@/$(HAVE_UNSIGNED_LONG_LONG_INT)/g' \
+	      -e 's/@''APPLE_UNIVERSAL_BUILD''@/$(APPLE_UNIVERSAL_BUILD)/g' \
+	      -e 's/@''BITSIZEOF_PTRDIFF_T''@/$(BITSIZEOF_PTRDIFF_T)/g' \
+	      -e 's/@''PTRDIFF_T_SUFFIX''@/$(PTRDIFF_T_SUFFIX)/g' \
+	      -e 's/@''BITSIZEOF_SIG_ATOMIC_T''@/$(BITSIZEOF_SIG_ATOMIC_T)/g' \
+	      -e 's/@''HAVE_SIGNED_SIG_ATOMIC_T''@/$(HAVE_SIGNED_SIG_ATOMIC_T)/g' \
+	      -e 's/@''SIG_ATOMIC_T_SUFFIX''@/$(SIG_ATOMIC_T_SUFFIX)/g' \
+	      -e 's/@''BITSIZEOF_SIZE_T''@/$(BITSIZEOF_SIZE_T)/g' \
+	      -e 's/@''SIZE_T_SUFFIX''@/$(SIZE_T_SUFFIX)/g' \
+	      -e 's/@''BITSIZEOF_WCHAR_T''@/$(BITSIZEOF_WCHAR_T)/g' \
+	      -e 's/@''HAVE_SIGNED_WCHAR_T''@/$(HAVE_SIGNED_WCHAR_T)/g' \
+	      -e 's/@''WCHAR_T_SUFFIX''@/$(WCHAR_T_SUFFIX)/g' \
+	      -e 's/@''BITSIZEOF_WINT_T''@/$(BITSIZEOF_WINT_T)/g' \
+	      -e 's/@''HAVE_SIGNED_WINT_T''@/$(HAVE_SIGNED_WINT_T)/g' \
+	      -e 's/@''WINT_T_SUFFIX''@/$(WINT_T_SUFFIX)/g' \
+	      < $(srcdir)/stdint.in.h; \
+	} > $@-t
+	mv $@-t $@
+MOSTLYCLEANFILES += stdint.h stdint.h-t
+
+EXTRA_DIST += stdint.in.h
+
+## end   gnulib module stdint
+
+## begin gnulib module stdio
+
+BUILT_SOURCES += stdio.h
+
+# We need the following in order to create <stdio.h> when the system
+# doesn't have one that works with the given compiler.
+stdio.h: stdio.in.h
+	rm -f $@-t $@
+	{ echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \
+	  sed -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
+	      -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
+	      -e 's|@''NEXT_STDIO_H''@|$(NEXT_STDIO_H)|g' \
+	      -e 's|@''GNULIB_FPRINTF''@|$(GNULIB_FPRINTF)|g' \
+	      -e 's|@''GNULIB_FPRINTF_POSIX''@|$(GNULIB_FPRINTF_POSIX)|g' \
+	      -e 's|@''GNULIB_PRINTF''@|$(GNULIB_PRINTF)|g' \
+	      -e 's|@''GNULIB_PRINTF_POSIX''@|$(GNULIB_PRINTF_POSIX)|g' \
+	      -e 's|@''GNULIB_SNPRINTF''@|$(GNULIB_SNPRINTF)|g' \
+	      -e 's|@''GNULIB_SPRINTF_POSIX''@|$(GNULIB_SPRINTF_POSIX)|g' \
+	      -e 's|@''GNULIB_VFPRINTF''@|$(GNULIB_VFPRINTF)|g' \
+	      -e 's|@''GNULIB_VFPRINTF_POSIX''@|$(GNULIB_VFPRINTF_POSIX)|g' \
+	      -e 's|@''GNULIB_VPRINTF''@|$(GNULIB_VPRINTF)|g' \
+	      -e 's|@''GNULIB_VPRINTF_POSIX''@|$(GNULIB_VPRINTF_POSIX)|g' \
+	      -e 's|@''GNULIB_VSNPRINTF''@|$(GNULIB_VSNPRINTF)|g' \
+	      -e 's|@''GNULIB_VSPRINTF_POSIX''@|$(GNULIB_VSPRINTF_POSIX)|g' \
+	      -e 's|@''GNULIB_DPRINTF''@|$(GNULIB_DPRINTF)|g' \
+	      -e 's|@''GNULIB_VDPRINTF''@|$(GNULIB_VDPRINTF)|g' \
+	      -e 's|@''GNULIB_VASPRINTF''@|$(GNULIB_VASPRINTF)|g' \
+	      -e 's|@''GNULIB_OBSTACK_PRINTF''@|$(GNULIB_OBSTACK_PRINTF)|g' \
+	      -e 's|@''GNULIB_OBSTACK_PRINTF_POSIX''@|$(GNULIB_OBSTACK_PRINTF_POSIX)|g' \
+	      -e 's|@''GNULIB_FOPEN''@|$(GNULIB_FOPEN)|g' \
+	      -e 's|@''GNULIB_FREOPEN''@|$(GNULIB_FREOPEN)|g' \
+	      -e 's|@''GNULIB_FSEEK''@|$(GNULIB_FSEEK)|g' \
+	      -e 's|@''GNULIB_FSEEKO''@|$(GNULIB_FSEEKO)|g' \
+	      -e 's|@''GNULIB_FTELL''@|$(GNULIB_FTELL)|g' \
+	      -e 's|@''GNULIB_FTELLO''@|$(GNULIB_FTELLO)|g' \
+	      -e 's|@''GNULIB_FFLUSH''@|$(GNULIB_FFLUSH)|g' \
+	      -e 's|@''GNULIB_FPURGE''@|$(GNULIB_FPURGE)|g' \
+	      -e 's|@''GNULIB_FCLOSE''@|$(GNULIB_FCLOSE)|g' \
+	      -e 's|@''GNULIB_FPUTC''@|$(GNULIB_FPUTC)|g' \
+	      -e 's|@''GNULIB_PUTC''@|$(GNULIB_PUTC)|g' \
+	      -e 's|@''GNULIB_PUTCHAR''@|$(GNULIB_PUTCHAR)|g' \
+	      -e 's|@''GNULIB_FPUTS''@|$(GNULIB_FPUTS)|g' \
+	      -e 's|@''GNULIB_PUTS''@|$(GNULIB_PUTS)|g' \
+	      -e 's|@''GNULIB_FWRITE''@|$(GNULIB_FWRITE)|g' \
+	      -e 's|@''GNULIB_GETDELIM''@|$(GNULIB_GETDELIM)|g' \
+	      -e 's|@''GNULIB_GETLINE''@|$(GNULIB_GETLINE)|g' \
+	      -e 's|@''GNULIB_PERROR''@|$(GNULIB_PERROR)|g' \
+	      -e 's|@''GNULIB_STDIO_H_SIGPIPE''@|$(GNULIB_STDIO_H_SIGPIPE)|g' \
+	      -e 's|@''REPLACE_STDIO_WRITE_FUNCS''@|$(REPLACE_STDIO_WRITE_FUNCS)|g' \
+	      -e 's|@''REPLACE_FPRINTF''@|$(REPLACE_FPRINTF)|g' \
+	      -e 's|@''REPLACE_VFPRINTF''@|$(REPLACE_VFPRINTF)|g' \
+	      -e 's|@''REPLACE_PRINTF''@|$(REPLACE_PRINTF)|g' \
+	      -e 's|@''REPLACE_VPRINTF''@|$(REPLACE_VPRINTF)|g' \
+	      -e 's|@''REPLACE_SNPRINTF''@|$(REPLACE_SNPRINTF)|g' \
+	      -e 's|@''HAVE_DECL_SNPRINTF''@|$(HAVE_DECL_SNPRINTF)|g' \
+	      -e 's|@''REPLACE_VSNPRINTF''@|$(REPLACE_VSNPRINTF)|g' \
+	      -e 's|@''HAVE_DECL_VSNPRINTF''@|$(HAVE_DECL_VSNPRINTF)|g' \
+	      -e 's|@''REPLACE_SPRINTF''@|$(REPLACE_SPRINTF)|g' \
+	      -e 's|@''REPLACE_VSPRINTF''@|$(REPLACE_VSPRINTF)|g' \
+	      -e 's|@''HAVE_DPRINTF''@|$(HAVE_DPRINTF)|g' \
+	      -e 's|@''REPLACE_DPRINTF''@|$(REPLACE_DPRINTF)|g' \
+	      -e 's|@''HAVE_VDPRINTF''@|$(HAVE_VDPRINTF)|g' \
+	      -e 's|@''REPLACE_VDPRINTF''@|$(REPLACE_VDPRINTF)|g' \
+	      -e 's|@''HAVE_VASPRINTF''@|$(HAVE_VASPRINTF)|g' \
+	      -e 's|@''REPLACE_VASPRINTF''@|$(REPLACE_VASPRINTF)|g' \
+	      -e 's|@''HAVE_DECL_OBSTACK_PRINTF''@|$(HAVE_DECL_OBSTACK_PRINTF)|g' \
+	      -e 's|@''REPLACE_OBSTACK_PRINTF''@|$(REPLACE_OBSTACK_PRINTF)|g' \
+	      -e 's|@''REPLACE_FOPEN''@|$(REPLACE_FOPEN)|g' \
+	      -e 's|@''REPLACE_FREOPEN''@|$(REPLACE_FREOPEN)|g' \
+	      -e 's|@''REPLACE_FSEEKO''@|$(REPLACE_FSEEKO)|g' \
+	      -e 's|@''REPLACE_FSEEK''@|$(REPLACE_FSEEK)|g' \
+	      -e 's|@''REPLACE_FTELLO''@|$(REPLACE_FTELLO)|g' \
+	      -e 's|@''REPLACE_FTELL''@|$(REPLACE_FTELL)|g' \
+	      -e 's|@''REPLACE_FFLUSH''@|$(REPLACE_FFLUSH)|g' \
+	      -e 's|@''REPLACE_FPURGE''@|$(REPLACE_FPURGE)|g' \
+	      -e 's|@''HAVE_DECL_FPURGE''@|$(HAVE_DECL_FPURGE)|g' \
+	      -e 's|@''REPLACE_FCLOSE''@|$(REPLACE_FCLOSE)|g' \
+	      -e 's|@''HAVE_DECL_GETDELIM''@|$(HAVE_DECL_GETDELIM)|g' \
+	      -e 's|@''HAVE_DECL_GETLINE''@|$(HAVE_DECL_GETLINE)|g' \
+	      -e 's|@''REPLACE_GETLINE''@|$(REPLACE_GETLINE)|g' \
+	      -e 's|@''REPLACE_PERROR''@|$(REPLACE_PERROR)|g' \
+	      -e '/definition of GL_LINK_WARNING/r $(LINK_WARNING_H)' \
+	      < $(srcdir)/stdio.in.h; \
+	} > $@-t
+	mv $@-t $@
+MOSTLYCLEANFILES += stdio.h stdio.h-t
+
+EXTRA_DIST += stdio-write.c stdio.in.h
+
+EXTRA_libgnu_la_SOURCES += stdio-write.c
+
+## end   gnulib module stdio
+
+## begin gnulib module stdlib
+
+BUILT_SOURCES += stdlib.h
+
+# We need the following in order to create <stdlib.h> when the system
+# doesn't have one that works with the given compiler.
+stdlib.h: stdlib.in.h
+	rm -f $@-t $@
+	{ echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \
+	  sed -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
+	      -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
+	      -e 's|@''NEXT_STDLIB_H''@|$(NEXT_STDLIB_H)|g' \
+	      -e 's|@''HAVE_RANDOM_H''@|$(HAVE_RANDOM_H)|g' \
+	      -e 's|@''GNULIB_MALLOC_POSIX''@|$(GNULIB_MALLOC_POSIX)|g' \
+	      -e 's|@''GNULIB_REALLOC_POSIX''@|$(GNULIB_REALLOC_POSIX)|g' \
+	      -e 's|@''GNULIB_CALLOC_POSIX''@|$(GNULIB_CALLOC_POSIX)|g' \
+	      -e 's|@''GNULIB_ATOLL''@|$(GNULIB_ATOLL)|g' \
+	      -e 's|@''GNULIB_GETLOADAVG''@|$(GNULIB_GETLOADAVG)|g' \
+	      -e 's|@''GNULIB_GETSUBOPT''@|$(GNULIB_GETSUBOPT)|g' \
+	      -e 's|@''GNULIB_MKDTEMP''@|$(GNULIB_MKDTEMP)|g' \
+	      -e 's|@''GNULIB_MKSTEMP''@|$(GNULIB_MKSTEMP)|g' \
+	      -e 's|@''GNULIB_PUTENV''@|$(GNULIB_PUTENV)|g' \
+	      -e 's|@''GNULIB_RANDOM_R''@|$(GNULIB_RANDOM_R)|g' \
+	      -e 's|@''GNULIB_RPMATCH''@|$(GNULIB_RPMATCH)|g' \
+	      -e 's|@''GNULIB_SETENV''@|$(GNULIB_SETENV)|g' \
+	      -e 's|@''GNULIB_STRTOD''@|$(GNULIB_STRTOD)|g' \
+	      -e 's|@''GNULIB_STRTOLL''@|$(GNULIB_STRTOLL)|g' \
+	      -e 's|@''GNULIB_STRTOULL''@|$(GNULIB_STRTOULL)|g' \
+	      -e 's|@''GNULIB_UNSETENV''@|$(GNULIB_UNSETENV)|g' \
+	      -e 's|@''HAVE_ATOLL''@|$(HAVE_ATOLL)|g' \
+	      -e 's|@''HAVE_CALLOC_POSIX''@|$(HAVE_CALLOC_POSIX)|g' \
+	      -e 's|@''HAVE_GETSUBOPT''@|$(HAVE_GETSUBOPT)|g' \
+	      -e 's|@''HAVE_MALLOC_POSIX''@|$(HAVE_MALLOC_POSIX)|g' \
+	      -e 's|@''HAVE_MKDTEMP''@|$(HAVE_MKDTEMP)|g' \
+	      -e 's|@''HAVE_REALLOC_POSIX''@|$(HAVE_REALLOC_POSIX)|g' \
+	      -e 's|@''HAVE_RANDOM_R''@|$(HAVE_RANDOM_R)|g' \
+	      -e 's|@''HAVE_RPMATCH''@|$(HAVE_RPMATCH)|g' \
+	      -e 's|@''HAVE_SETENV''@|$(HAVE_SETENV)|g' \
+	      -e 's|@''HAVE_STRTOD''@|$(HAVE_STRTOD)|g' \
+	      -e 's|@''HAVE_STRTOLL''@|$(HAVE_STRTOLL)|g' \
+	      -e 's|@''HAVE_STRTOULL''@|$(HAVE_STRTOULL)|g' \
+	      -e 's|@''HAVE_STRUCT_RANDOM_DATA''@|$(HAVE_STRUCT_RANDOM_DATA)|g' \
+	      -e 's|@''HAVE_SYS_LOADAVG_H''@|$(HAVE_SYS_LOADAVG_H)|g' \
+	      -e 's|@''HAVE_UNSETENV''@|$(HAVE_UNSETENV)|g' \
+	      -e 's|@''HAVE_DECL_GETLOADAVG''@|$(HAVE_DECL_GETLOADAVG)|g' \
+	      -e 's|@''REPLACE_MKSTEMP''@|$(REPLACE_MKSTEMP)|g' \
+	      -e 's|@''REPLACE_PUTENV''@|$(REPLACE_PUTENV)|g' \
+	      -e 's|@''REPLACE_STRTOD''@|$(REPLACE_STRTOD)|g' \
+	      -e 's|@''VOID_UNSETENV''@|$(VOID_UNSETENV)|g' \
+	      -e '/definition of GL_LINK_WARNING/r $(LINK_WARNING_H)' \
+	      < $(srcdir)/stdlib.in.h; \
+	} > $@-t
+	mv $@-t $@
+MOSTLYCLEANFILES += stdlib.h stdlib.h-t
+
+EXTRA_DIST += stdlib.in.h
+
+## end   gnulib module stdlib
+
 ## begin gnulib module strcase
 
 
@@ -275,6 +735,97 @@ EXTRA_libgnu_la_SOURCES += strftime.c
 
 ## end   gnulib module strftime
 
+## begin gnulib module striconveh
+
+libgnu_la_SOURCES += striconveh.h striconveh.c
+if GL_COND_LIBTOOL
+libgnu_la_LDFLAGS += $(LTLIBICONV)
+endif
+
+EXTRA_DIST += iconveh.h
+
+## end   gnulib module striconveh
+
+## begin gnulib module string
+
+BUILT_SOURCES += string.h
+
+# We need the following in order to create <string.h> when the system
+# doesn't have one that works with the given compiler.
+string.h: string.in.h
+	rm -f $@-t $@
+	{ echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \
+	  sed -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
+	      -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
+	      -e 's|@''NEXT_STRING_H''@|$(NEXT_STRING_H)|g' \
+	      -e 's|@''GNULIB_MBSLEN''@|$(GNULIB_MBSLEN)|g' \
+	      -e 's|@''GNULIB_MBSNLEN''@|$(GNULIB_MBSNLEN)|g' \
+	      -e 's|@''GNULIB_MBSCHR''@|$(GNULIB_MBSCHR)|g' \
+	      -e 's|@''GNULIB_MBSRCHR''@|$(GNULIB_MBSRCHR)|g' \
+	      -e 's|@''GNULIB_MBSSTR''@|$(GNULIB_MBSSTR)|g' \
+	      -e 's|@''GNULIB_MBSCASECMP''@|$(GNULIB_MBSCASECMP)|g' \
+	      -e 's|@''GNULIB_MBSNCASECMP''@|$(GNULIB_MBSNCASECMP)|g' \
+	      -e 's|@''GNULIB_MBSPCASECMP''@|$(GNULIB_MBSPCASECMP)|g' \
+	      -e 's|@''GNULIB_MBSCASESTR''@|$(GNULIB_MBSCASESTR)|g' \
+	      -e 's|@''GNULIB_MBSCSPN''@|$(GNULIB_MBSCSPN)|g' \
+	      -e 's|@''GNULIB_MBSPBRK''@|$(GNULIB_MBSPBRK)|g' \
+	      -e 's|@''GNULIB_MBSSPN''@|$(GNULIB_MBSSPN)|g' \
+	      -e 's|@''GNULIB_MBSSEP''@|$(GNULIB_MBSSEP)|g' \
+	      -e 's|@''GNULIB_MBSTOK_R''@|$(GNULIB_MBSTOK_R)|g' \
+	      -e 's|@''GNULIB_MEMCHR''@|$(GNULIB_MEMCHR)|g' \
+	      -e 's|@''GNULIB_MEMMEM''@|$(GNULIB_MEMMEM)|g' \
+	      -e 's|@''GNULIB_MEMPCPY''@|$(GNULIB_MEMPCPY)|g' \
+	      -e 's|@''GNULIB_MEMRCHR''@|$(GNULIB_MEMRCHR)|g' \
+	      -e 's|@''GNULIB_RAWMEMCHR''@|$(GNULIB_RAWMEMCHR)|g' \
+	      -e 's|@''GNULIB_STPCPY''@|$(GNULIB_STPCPY)|g' \
+	      -e 's|@''GNULIB_STPNCPY''@|$(GNULIB_STPNCPY)|g' \
+	      -e 's|@''GNULIB_STRCHRNUL''@|$(GNULIB_STRCHRNUL)|g' \
+	      -e 's|@''GNULIB_STRDUP''@|$(GNULIB_STRDUP)|g' \
+	      -e 's|@''GNULIB_STRNDUP''@|$(GNULIB_STRNDUP)|g' \
+	      -e 's|@''GNULIB_STRNLEN''@|$(GNULIB_STRNLEN)|g' \
+	      -e 's|@''GNULIB_STRPBRK''@|$(GNULIB_STRPBRK)|g' \
+	      -e 's|@''GNULIB_STRSEP''@|$(GNULIB_STRSEP)|g' \
+	      -e 's|@''GNULIB_STRSTR''@|$(GNULIB_STRSTR)|g' \
+	      -e 's|@''GNULIB_STRCASESTR''@|$(GNULIB_STRCASESTR)|g' \
+	      -e 's|@''GNULIB_STRTOK_R''@|$(GNULIB_STRTOK_R)|g' \
+	      -e 's|@''GNULIB_STRERROR''@|$(GNULIB_STRERROR)|g' \
+	      -e 's|@''GNULIB_STRSIGNAL''@|$(GNULIB_STRSIGNAL)|g' \
+	      -e 's|@''GNULIB_STRVERSCMP''@|$(GNULIB_STRVERSCMP)|g' \
+	      -e 's|@''HAVE_DECL_MEMMEM''@|$(HAVE_DECL_MEMMEM)|g' \
+	      -e 's|@''HAVE_MEMPCPY''@|$(HAVE_MEMPCPY)|g' \
+	      -e 's|@''HAVE_DECL_MEMRCHR''@|$(HAVE_DECL_MEMRCHR)|g' \
+	      -e 's|@''HAVE_RAWMEMCHR''@|$(HAVE_RAWMEMCHR)|g' \
+	      -e 's|@''HAVE_STPCPY''@|$(HAVE_STPCPY)|g' \
+	      -e 's|@''HAVE_STPNCPY''@|$(HAVE_STPNCPY)|g' \
+	      -e 's|@''HAVE_STRCHRNUL''@|$(HAVE_STRCHRNUL)|g' \
+	      -e 's|@''HAVE_DECL_STRDUP''@|$(HAVE_DECL_STRDUP)|g' \
+	      -e 's|@''HAVE_STRNDUP''@|$(HAVE_STRNDUP)|g' \
+	      -e 's|@''HAVE_DECL_STRNDUP''@|$(HAVE_DECL_STRNDUP)|g' \
+	      -e 's|@''HAVE_DECL_STRNLEN''@|$(HAVE_DECL_STRNLEN)|g' \
+	      -e 's|@''HAVE_STRPBRK''@|$(HAVE_STRPBRK)|g' \
+	      -e 's|@''HAVE_STRSEP''@|$(HAVE_STRSEP)|g' \
+	      -e 's|@''HAVE_STRCASESTR''@|$(HAVE_STRCASESTR)|g' \
+	      -e 's|@''HAVE_DECL_STRTOK_R''@|$(HAVE_DECL_STRTOK_R)|g' \
+	      -e 's|@''HAVE_DECL_STRERROR''@|$(HAVE_DECL_STRERROR)|g' \
+	      -e 's|@''HAVE_DECL_STRSIGNAL''@|$(HAVE_DECL_STRSIGNAL)|g' \
+	      -e 's|@''HAVE_STRVERSCMP''@|$(HAVE_STRVERSCMP)|g' \
+	      -e 's|@''REPLACE_MEMCHR''@|$(REPLACE_MEMCHR)|g' \
+	      -e 's|@''REPLACE_MEMMEM''@|$(REPLACE_MEMMEM)|g' \
+	      -e 's|@''REPLACE_STRCASESTR''@|$(REPLACE_STRCASESTR)|g' \
+	      -e 's|@''REPLACE_STRDUP''@|$(REPLACE_STRDUP)|g' \
+	      -e 's|@''REPLACE_STRSTR''@|$(REPLACE_STRSTR)|g' \
+	      -e 's|@''REPLACE_STRERROR''@|$(REPLACE_STRERROR)|g' \
+	      -e 's|@''REPLACE_STRSIGNAL''@|$(REPLACE_STRSIGNAL)|g' \
+	      -e '/definition of GL_LINK_WARNING/r $(LINK_WARNING_H)' \
+	      < $(srcdir)/string.in.h; \
+	} > $@-t
+	mv $@-t $@
+MOSTLYCLEANFILES += string.h string.h-t
+
+EXTRA_DIST += string.in.h
+
+## end   gnulib module string
+
 ## begin gnulib module strings
 
 BUILT_SOURCES += strings.h
@@ -299,6 +850,32 @@ EXTRA_DIST += strings.in.h
 
 ## end   gnulib module strings
 
+## begin gnulib module sys_file
+
+BUILT_SOURCES += $(SYS_FILE_H)
+
+# We need the following in order to create <sys/file.h> when the system
+# has one that is incomplete.
+sys/file.h: sys_file.in.h
+	@MKDIR_P@ sys
+	rm -f $@-t $@
+	{ echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
+	  sed -e 's/@''HAVE_SYS_FILE_H''@/$(HAVE_SYS_FILE_H)/g' \
+	      -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
+	      -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
+	      -e 's|@''NEXT_SYS_FILE_H''@|$(NEXT_SYS_FILE_H)|g' \
+	      -e 's/@''HAVE_FLOCK''@/$(HAVE_FLOCK)/g' \
+	      -e 's/@''GNULIB_FLOCK''@/$(GNULIB_FLOCK)/g' \
+	      < $(srcdir)/sys_file.in.h; \
+	} > $@-t
+	mv $@-t $@
+MOSTLYCLEANFILES += sys/file.h sys/file.h-t
+MOSTLYCLEANDIRS += sys
+
+EXTRA_DIST += sys_file.in.h
+
+## end   gnulib module sys_file
+
 ## begin gnulib module time
 
 BUILT_SOURCES += time.h
@@ -312,6 +889,7 @@ time.h: time.in.h
 	      -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
 	      -e 's|@NEXT_TIME_H''@|$(NEXT_TIME_H)|g' \
 	      -e 's|@REPLACE_LOCALTIME_R''@|$(REPLACE_LOCALTIME_R)|g' \
+	      -e 's|@REPLACE_MKTIME''@|$(REPLACE_MKTIME)|g' \
 	      -e 's|@REPLACE_NANOSLEEP''@|$(REPLACE_NANOSLEEP)|g' \
 	      -e 's|@REPLACE_STRPTIME''@|$(REPLACE_STRPTIME)|g' \
 	      -e 's|@REPLACE_TIMEGM''@|$(REPLACE_TIMEGM)|g' \
@@ -364,6 +942,7 @@ unistd.h: unistd.in.h
 	      -e 's|@''GNULIB_GETPAGESIZE''@|$(GNULIB_GETPAGESIZE)|g' \
 	      -e 's|@''GNULIB_GETUSERSHELL''@|$(GNULIB_GETUSERSHELL)|g' \
 	      -e 's|@''GNULIB_LCHOWN''@|$(GNULIB_LCHOWN)|g' \
+	      -e 's|@''GNULIB_LINK''@|$(GNULIB_LINK)|g' \
 	      -e 's|@''GNULIB_LSEEK''@|$(GNULIB_LSEEK)|g' \
 	      -e 's|@''GNULIB_READLINK''@|$(GNULIB_READLINK)|g' \
 	      -e 's|@''GNULIB_SLEEP''@|$(GNULIB_SLEEP)|g' \
@@ -378,6 +957,7 @@ unistd.h: unistd.in.h
 	      -e 's|@''HAVE_GETHOSTNAME''@|$(HAVE_GETHOSTNAME)|g' \
 	      -e 's|@''HAVE_GETPAGESIZE''@|$(HAVE_GETPAGESIZE)|g' \
 	      -e 's|@''HAVE_GETUSERSHELL''@|$(HAVE_GETUSERSHELL)|g' \
+	      -e 's|@''HAVE_LINK''@|$(HAVE_LINK)|g' \
 	      -e 's|@''HAVE_READLINK''@|$(HAVE_READLINK)|g' \
 	      -e 's|@''HAVE_SLEEP''@|$(HAVE_SLEEP)|g' \
 	      -e 's|@''HAVE_DECL_ENVIRON''@|$(HAVE_DECL_ENVIRON)|g' \
@@ -386,6 +966,7 @@ unistd.h: unistd.in.h
 	      -e 's|@''HAVE_SYS_PARAM_H''@|$(HAVE_SYS_PARAM_H)|g' \
 	      -e 's|@''REPLACE_CHOWN''@|$(REPLACE_CHOWN)|g' \
 	      -e 's|@''REPLACE_CLOSE''@|$(REPLACE_CLOSE)|g' \
+	      -e 's|@''REPLACE_DUP2''@|$(REPLACE_DUP2)|g' \
 	      -e 's|@''REPLACE_FCHDIR''@|$(REPLACE_FCHDIR)|g' \
 	      -e 's|@''REPLACE_GETCWD''@|$(REPLACE_GETCWD)|g' \
 	      -e 's|@''REPLACE_GETPAGESIZE''@|$(REPLACE_GETPAGESIZE)|g' \
@@ -403,12 +984,74 @@ EXTRA_DIST += unistd.in.h
 
 ## end   gnulib module unistd
 
+## begin gnulib module unistr/base
+
+
+EXTRA_DIST += unistr.h
+
+## end   gnulib module unistr/base
+
+## begin gnulib module unistr/u8-mbtouc
+
+libgnu_la_SOURCES += unistr/u8-mbtouc.c unistr/u8-mbtouc-aux.c
+
+## end   gnulib module unistr/u8-mbtouc
+
+## begin gnulib module unistr/u8-mbtouc-unsafe
+
+libgnu_la_SOURCES += unistr/u8-mbtouc-unsafe.c unistr/u8-mbtouc-unsafe-aux.c
+
+## end   gnulib module unistr/u8-mbtouc-unsafe
+
+## begin gnulib module unistr/u8-mbtoucr
+
+libgnu_la_SOURCES += unistr/u8-mbtoucr.c
+
+## end   gnulib module unistr/u8-mbtoucr
+
+## begin gnulib module unistr/u8-prev
+
+libgnu_la_SOURCES += unistr/u8-prev.c
+
+## end   gnulib module unistr/u8-prev
+
+## begin gnulib module unistr/u8-uctomb
+
+libgnu_la_SOURCES += unistr/u8-uctomb.c unistr/u8-uctomb-aux.c
+
+## end   gnulib module unistr/u8-uctomb
+
+## begin gnulib module unitypes
+
+
+EXTRA_DIST += unitypes.h
+
+## end   gnulib module unitypes
+
+## begin gnulib module vasnprintf
+
+
+EXTRA_DIST += asnprintf.c float+.h printf-args.c printf-args.h printf-parse.c printf-parse.h vasnprintf.c vasnprintf.h
+
+EXTRA_libgnu_la_SOURCES += asnprintf.c printf-args.c printf-parse.c vasnprintf.c
+
+## end   gnulib module vasnprintf
+
 ## begin gnulib module verify
 
 libgnu_la_SOURCES += verify.h
 
 ## end   gnulib module verify
 
+## begin gnulib module vsnprintf
+
+
+EXTRA_DIST += vsnprintf.c
+
+EXTRA_libgnu_la_SOURCES += vsnprintf.c
+
+## end   gnulib module vsnprintf
+
 ## begin gnulib module wchar
 
 BUILT_SOURCES += $(WCHAR_H)
@@ -455,6 +1098,7 @@ wchar.h: wchar.in.h
 	      -e 's|@''REPLACE_MBSNRTOWCS''@|$(REPLACE_MBSNRTOWCS)|g' \
 	      -e 's|@''REPLACE_WCRTOMB''@|$(REPLACE_WCRTOMB)|g' \
 	      -e 's|@''REPLACE_WCSRTOMBS''@|$(REPLACE_WCSRTOMBS)|g' \
+	      -e 's|@''REPLACE_WCSNRTOMBS''@|$(REPLACE_WCSNRTOMBS)|g' \
 	      -e 's|@''REPLACE_WCWIDTH''@|$(REPLACE_WCWIDTH)|g' \
 	      -e '/definition of GL_LINK_WARNING/r $(LINK_WARNING_H)' \
 	    < $(srcdir)/wchar.in.h; \
@@ -475,6 +1119,12 @@ EXTRA_libgnu_la_SOURCES += write.c
 
 ## end   gnulib module write
 
+## begin gnulib module xsize
+
+libgnu_la_SOURCES += xsize.h
+
+## end   gnulib module xsize
+
 
 mostlyclean-local: mostlyclean-generic
 	@for dir in '' $(MOSTLYCLEANDIRS); do \
diff --git a/lib/asnprintf.c b/lib/asnprintf.c
new file mode 100644
index 000000000..3b374a2a4
--- /dev/null
+++ b/lib/asnprintf.c
@@ -0,0 +1,35 @@
+/* Formatted output to strings.
+   Copyright (C) 1999, 2002, 2006 Free Software Foundation, Inc.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 2, or (at your option)
+   any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License along
+   with this program; if not, write to the Free Software Foundation,
+   Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+#include <config.h>
+
+/* Specification.  */
+#include "vasnprintf.h"
+
+#include <stdarg.h>
+
+char *
+asnprintf (char *resultbuf, size_t *lengthp, const char *format, ...)
+{
+  va_list args;
+  char *result;
+
+  va_start (args, format);
+  result = vasnprintf (resultbuf, lengthp, format, args);
+  va_end (args);
+  return result;
+}
diff --git a/lib/byteswap.in.h b/lib/byteswap.in.h
new file mode 100644
index 000000000..f03463db6
--- /dev/null
+++ b/lib/byteswap.in.h
@@ -0,0 +1,44 @@
+/* byteswap.h - Byte swapping
+   Copyright (C) 2005, 2007 Free Software Foundation, Inc.
+   Written by Oskar Liljeblad <oskar@osk.mine.nu>, 2005.
+
+   This program is free software: you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#ifndef _GL_BYTESWAP_H
+#define _GL_BYTESWAP_H
+
+/* Given an unsigned 16-bit argument X, return the value corresponding to
+   X with reversed byte order.  */
+#define bswap_16(x) ((((x) & 0x00FF) << 8) | \
+		     (((x) & 0xFF00) >> 8))
+
+/* Given an unsigned 32-bit argument X, return the value corresponding to
+   X with reversed byte order.  */
+#define bswap_32(x) ((((x) & 0x000000FF) << 24) | \
+		     (((x) & 0x0000FF00) << 8) | \
+		     (((x) & 0x00FF0000) >> 8) | \
+		     (((x) & 0xFF000000) >> 24))
+
+/* Given an unsigned 64-bit argument X, return the value corresponding to
+   X with reversed byte order.  */
+#define bswap_64(x) ((((x) & 0x00000000000000FFULL) << 56) | \
+		     (((x) & 0x000000000000FF00ULL) << 40) | \
+		     (((x) & 0x0000000000FF0000ULL) << 24) | \
+		     (((x) & 0x00000000FF000000ULL) << 8) | \
+		     (((x) & 0x000000FF00000000ULL) >> 8) | \
+		     (((x) & 0x0000FF0000000000ULL) >> 24) | \
+		     (((x) & 0x00FF000000000000ULL) >> 40) | \
+		     (((x) & 0xFF00000000000000ULL) >> 56))
+
+#endif /* _GL_BYTESWAP_H */
diff --git a/lib/c-ctype.c b/lib/c-ctype.c
new file mode 100644
index 000000000..e36a51340
--- /dev/null
+++ b/lib/c-ctype.c
@@ -0,0 +1,396 @@
+/* Character handling in C locale.
+
+   Copyright 2000-2003, 2006 Free Software Foundation, Inc.
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 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 Lesser General Public License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with this program; if not, write to the Free Software Foundation,
+Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+#include <config.h>
+
+/* Specification.  */
+#define NO_C_CTYPE_MACROS
+#include "c-ctype.h"
+
+/* The function isascii is not locale dependent. Its use in EBCDIC is
+   questionable. */
+bool
+c_isascii (int c)
+{
+  return (c >= 0x00 && c <= 0x7f);
+}
+
+bool
+c_isalnum (int c)
+{
+#if C_CTYPE_CONSECUTIVE_DIGITS \
+    && C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE
+#if C_CTYPE_ASCII
+  return ((c >= '0' && c <= '9')
+          || ((c & ~0x20) >= 'A' && (c & ~0x20) <= 'Z'));
+#else
+  return ((c >= '0' && c <= '9')
+          || (c >= 'A' && c <= 'Z')
+          || (c >= 'a' && c <= 'z'));
+#endif
+#else
+  switch (c)
+    {
+    case '0': case '1': case '2': case '3': case '4': case '5':
+    case '6': case '7': case '8': case '9':
+    case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+    case 'G': case 'H': case 'I': case 'J': case 'K': case 'L':
+    case 'M': case 'N': case 'O': case 'P': case 'Q': case 'R':
+    case 'S': case 'T': case 'U': case 'V': case 'W': case 'X':
+    case 'Y': case 'Z':
+    case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+    case 'g': case 'h': case 'i': case 'j': case 'k': case 'l':
+    case 'm': case 'n': case 'o': case 'p': case 'q': case 'r':
+    case 's': case 't': case 'u': case 'v': case 'w': case 'x':
+    case 'y': case 'z':
+      return 1;
+    default:
+      return 0;
+    }
+#endif
+}
+
+bool
+c_isalpha (int c)
+{
+#if C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE
+#if C_CTYPE_ASCII
+  return ((c & ~0x20) >= 'A' && (c & ~0x20) <= 'Z');
+#else
+  return ((c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z'));
+#endif
+#else
+  switch (c)
+    {
+    case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+    case 'G': case 'H': case 'I': case 'J': case 'K': case 'L':
+    case 'M': case 'N': case 'O': case 'P': case 'Q': case 'R':
+    case 'S': case 'T': case 'U': case 'V': case 'W': case 'X':
+    case 'Y': case 'Z':
+    case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+    case 'g': case 'h': case 'i': case 'j': case 'k': case 'l':
+    case 'm': case 'n': case 'o': case 'p': case 'q': case 'r':
+    case 's': case 't': case 'u': case 'v': case 'w': case 'x':
+    case 'y': case 'z':
+      return 1;
+    default:
+      return 0;
+    }
+#endif
+}
+
+bool
+c_isblank (int c)
+{
+  return (c == ' ' || c == '\t');
+}
+
+bool
+c_iscntrl (int c)
+{
+#if C_CTYPE_ASCII
+  return ((c & ~0x1f) == 0 || c == 0x7f);
+#else
+  switch (c)
+    {
+    case ' ': case '!': case '"': case '#': case '$': case '%':
+    case '&': case '\'': case '(': case ')': case '*': case '+':
+    case ',': case '-': case '.': case '/':
+    case '0': case '1': case '2': case '3': case '4': case '5':
+    case '6': case '7': case '8': case '9':
+    case ':': case ';': case '<': case '=': case '>': case '?':
+    case '@':
+    case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+    case 'G': case 'H': case 'I': case 'J': case 'K': case 'L':
+    case 'M': case 'N': case 'O': case 'P': case 'Q': case 'R':
+    case 'S': case 'T': case 'U': case 'V': case 'W': case 'X':
+    case 'Y': case 'Z':
+    case '[': case '\\': case ']': case '^': case '_': case '`':
+    case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+    case 'g': case 'h': case 'i': case 'j': case 'k': case 'l':
+    case 'm': case 'n': case 'o': case 'p': case 'q': case 'r':
+    case 's': case 't': case 'u': case 'v': case 'w': case 'x':
+    case 'y': case 'z':
+    case '{': case '|': case '}': case '~':
+      return 0;
+    default:
+      return 1;
+    }
+#endif
+}
+
+bool
+c_isdigit (int c)
+{
+#if C_CTYPE_CONSECUTIVE_DIGITS
+  return (c >= '0' && c <= '9');
+#else
+  switch (c)
+    {
+    case '0': case '1': case '2': case '3': case '4': case '5':
+    case '6': case '7': case '8': case '9':
+      return 1;
+    default:
+      return 0;
+    }
+#endif
+}
+
+bool
+c_islower (int c)
+{
+#if C_CTYPE_CONSECUTIVE_LOWERCASE
+  return (c >= 'a' && c <= 'z');
+#else
+  switch (c)
+    {
+    case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+    case 'g': case 'h': case 'i': case 'j': case 'k': case 'l':
+    case 'm': case 'n': case 'o': case 'p': case 'q': case 'r':
+    case 's': case 't': case 'u': case 'v': case 'w': case 'x':
+    case 'y': case 'z':
+      return 1;
+    default:
+      return 0;
+    }
+#endif
+}
+
+bool
+c_isgraph (int c)
+{
+#if C_CTYPE_ASCII
+  return (c >= '!' && c <= '~');
+#else
+  switch (c)
+    {
+    case '!': case '"': case '#': case '$': case '%': case '&':
+    case '\'': case '(': case ')': case '*': case '+': case ',':
+    case '-': case '.': case '/':
+    case '0': case '1': case '2': case '3': case '4': case '5':
+    case '6': case '7': case '8': case '9':
+    case ':': case ';': case '<': case '=': case '>': case '?':
+    case '@':
+    case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+    case 'G': case 'H': case 'I': case 'J': case 'K': case 'L':
+    case 'M': case 'N': case 'O': case 'P': case 'Q': case 'R':
+    case 'S': case 'T': case 'U': case 'V': case 'W': case 'X':
+    case 'Y': case 'Z':
+    case '[': case '\\': case ']': case '^': case '_': case '`':
+    case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+    case 'g': case 'h': case 'i': case 'j': case 'k': case 'l':
+    case 'm': case 'n': case 'o': case 'p': case 'q': case 'r':
+    case 's': case 't': case 'u': case 'v': case 'w': case 'x':
+    case 'y': case 'z':
+    case '{': case '|': case '}': case '~':
+      return 1;
+    default:
+      return 0;
+    }
+#endif
+}
+
+bool
+c_isprint (int c)
+{
+#if C_CTYPE_ASCII
+  return (c >= ' ' && c <= '~');
+#else
+  switch (c)
+    {
+    case ' ': case '!': case '"': case '#': case '$': case '%':
+    case '&': case '\'': case '(': case ')': case '*': case '+':
+    case ',': case '-': case '.': case '/':
+    case '0': case '1': case '2': case '3': case '4': case '5':
+    case '6': case '7': case '8': case '9':
+    case ':': case ';': case '<': case '=': case '>': case '?':
+    case '@':
+    case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+    case 'G': case 'H': case 'I': case 'J': case 'K': case 'L':
+    case 'M': case 'N': case 'O': case 'P': case 'Q': case 'R':
+    case 'S': case 'T': case 'U': case 'V': case 'W': case 'X':
+    case 'Y': case 'Z':
+    case '[': case '\\': case ']': case '^': case '_': case '`':
+    case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+    case 'g': case 'h': case 'i': case 'j': case 'k': case 'l':
+    case 'm': case 'n': case 'o': case 'p': case 'q': case 'r':
+    case 's': case 't': case 'u': case 'v': case 'w': case 'x':
+    case 'y': case 'z':
+    case '{': case '|': case '}': case '~':
+      return 1;
+    default:
+      return 0;
+    }
+#endif
+}
+
+bool
+c_ispunct (int c)
+{
+#if C_CTYPE_ASCII
+  return ((c >= '!' && c <= '~')
+          && !((c >= '0' && c <= '9')
+               || ((c & ~0x20) >= 'A' && (c & ~0x20) <= 'Z')));
+#else
+  switch (c)
+    {
+    case '!': case '"': case '#': case '$': case '%': case '&':
+    case '\'': case '(': case ')': case '*': case '+': case ',':
+    case '-': case '.': case '/':
+    case ':': case ';': case '<': case '=': case '>': case '?':
+    case '@':
+    case '[': case '\\': case ']': case '^': case '_': case '`':
+    case '{': case '|': case '}': case '~':
+      return 1;
+    default:
+      return 0;
+    }
+#endif
+}
+
+bool
+c_isspace (int c)
+{
+  return (c == ' ' || c == '\t'
+          || c == '\n' || c == '\v' || c == '\f' || c == '\r');
+}
+
+bool
+c_isupper (int c)
+{
+#if C_CTYPE_CONSECUTIVE_UPPERCASE
+  return (c >= 'A' && c <= 'Z');
+#else
+  switch (c)
+    {
+    case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+    case 'G': case 'H': case 'I': case 'J': case 'K': case 'L':
+    case 'M': case 'N': case 'O': case 'P': case 'Q': case 'R':
+    case 'S': case 'T': case 'U': case 'V': case 'W': case 'X':
+    case 'Y': case 'Z':
+      return 1;
+    default:
+      return 0;
+    }
+#endif
+}
+
+bool
+c_isxdigit (int c)
+{
+#if C_CTYPE_CONSECUTIVE_DIGITS \
+    && C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE
+#if C_CTYPE_ASCII
+  return ((c >= '0' && c <= '9')
+          || ((c & ~0x20) >= 'A' && (c & ~0x20) <= 'F'));
+#else
+  return ((c >= '0' && c <= '9')
+          || (c >= 'A' && c <= 'F')
+          || (c >= 'a' && c <= 'f'));
+#endif
+#else
+  switch (c)
+    {
+    case '0': case '1': case '2': case '3': case '4': case '5':
+    case '6': case '7': case '8': case '9':
+    case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+    case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+      return 1;
+    default:
+      return 0;
+    }
+#endif
+}
+
+int
+c_tolower (int c)
+{
+#if C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE
+  return (c >= 'A' && c <= 'Z' ? c - 'A' + 'a' : c);
+#else
+  switch (c)
+    {
+    case 'A': return 'a';
+    case 'B': return 'b';
+    case 'C': return 'c';
+    case 'D': return 'd';
+    case 'E': return 'e';
+    case 'F': return 'f';
+    case 'G': return 'g';
+    case 'H': return 'h';
+    case 'I': return 'i';
+    case 'J': return 'j';
+    case 'K': return 'k';
+    case 'L': return 'l';
+    case 'M': return 'm';
+    case 'N': return 'n';
+    case 'O': return 'o';
+    case 'P': return 'p';
+    case 'Q': return 'q';
+    case 'R': return 'r';
+    case 'S': return 's';
+    case 'T': return 't';
+    case 'U': return 'u';
+    case 'V': return 'v';
+    case 'W': return 'w';
+    case 'X': return 'x';
+    case 'Y': return 'y';
+    case 'Z': return 'z';
+    default: return c;
+    }
+#endif
+}
+
+int
+c_toupper (int c)
+{
+#if C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE
+  return (c >= 'a' && c <= 'z' ? c - 'a' + 'A' : c);
+#else
+  switch (c)
+    {
+    case 'a': return 'A';
+    case 'b': return 'B';
+    case 'c': return 'C';
+    case 'd': return 'D';
+    case 'e': return 'E';
+    case 'f': return 'F';
+    case 'g': return 'G';
+    case 'h': return 'H';
+    case 'i': return 'I';
+    case 'j': return 'J';
+    case 'k': return 'K';
+    case 'l': return 'L';
+    case 'm': return 'M';
+    case 'n': return 'N';
+    case 'o': return 'O';
+    case 'p': return 'P';
+    case 'q': return 'Q';
+    case 'r': return 'R';
+    case 's': return 'S';
+    case 't': return 'T';
+    case 'u': return 'U';
+    case 'v': return 'V';
+    case 'w': return 'W';
+    case 'x': return 'X';
+    case 'y': return 'Y';
+    case 'z': return 'Z';
+    default: return c;
+    }
+#endif
+}
diff --git a/lib/c-ctype.h b/lib/c-ctype.h
new file mode 100644
index 000000000..d7b067e83
--- /dev/null
+++ b/lib/c-ctype.h
@@ -0,0 +1,295 @@
+/* Character handling in C locale.
+
+   These functions work like the corresponding functions in <ctype.h>,
+   except that they have the C (POSIX) locale hardwired, whereas the
+   <ctype.h> functions' behaviour depends on the current locale set via
+   setlocale.
+
+   Copyright (C) 2000-2003, 2006, 2008 Free Software Foundation, Inc.
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU Lesser General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU Lesser General Public License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with this program; if not, write to the Free Software Foundation,
+Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+#ifndef C_CTYPE_H
+#define C_CTYPE_H
+
+#include <stdbool.h>
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
+/* The functions defined in this file assume the "C" locale and a character
+   set without diacritics (ASCII-US or EBCDIC-US or something like that).
+   Even if the "C" locale on a particular system is an extension of the ASCII
+   character set (like on BeOS, where it is UTF-8, or on AmigaOS, where it
+   is ISO-8859-1), the functions in this file recognize only the ASCII
+   characters.  */
+
+
+/* Check whether the ASCII optimizations apply. */
+
+/* ANSI C89 (and ISO C99 5.2.1.3 too) already guarantees that
+   '0', '1', ..., '9' have consecutive integer values.  */
+#define C_CTYPE_CONSECUTIVE_DIGITS 1
+
+#if ('A' <= 'Z') \
+    && ('A' + 1 == 'B') && ('B' + 1 == 'C') && ('C' + 1 == 'D') \
+    && ('D' + 1 == 'E') && ('E' + 1 == 'F') && ('F' + 1 == 'G') \
+    && ('G' + 1 == 'H') && ('H' + 1 == 'I') && ('I' + 1 == 'J') \
+    && ('J' + 1 == 'K') && ('K' + 1 == 'L') && ('L' + 1 == 'M') \
+    && ('M' + 1 == 'N') && ('N' + 1 == 'O') && ('O' + 1 == 'P') \
+    && ('P' + 1 == 'Q') && ('Q' + 1 == 'R') && ('R' + 1 == 'S') \
+    && ('S' + 1 == 'T') && ('T' + 1 == 'U') && ('U' + 1 == 'V') \
+    && ('V' + 1 == 'W') && ('W' + 1 == 'X') && ('X' + 1 == 'Y') \
+    && ('Y' + 1 == 'Z')
+#define C_CTYPE_CONSECUTIVE_UPPERCASE 1
+#endif
+
+#if ('a' <= 'z') \
+    && ('a' + 1 == 'b') && ('b' + 1 == 'c') && ('c' + 1 == 'd') \
+    && ('d' + 1 == 'e') && ('e' + 1 == 'f') && ('f' + 1 == 'g') \
+    && ('g' + 1 == 'h') && ('h' + 1 == 'i') && ('i' + 1 == 'j') \
+    && ('j' + 1 == 'k') && ('k' + 1 == 'l') && ('l' + 1 == 'm') \
+    && ('m' + 1 == 'n') && ('n' + 1 == 'o') && ('o' + 1 == 'p') \
+    && ('p' + 1 == 'q') && ('q' + 1 == 'r') && ('r' + 1 == 's') \
+    && ('s' + 1 == 't') && ('t' + 1 == 'u') && ('u' + 1 == 'v') \
+    && ('v' + 1 == 'w') && ('w' + 1 == 'x') && ('x' + 1 == 'y') \
+    && ('y' + 1 == 'z')
+#define C_CTYPE_CONSECUTIVE_LOWERCASE 1
+#endif
+
+#if (' ' == 32) && ('!' == 33) && ('"' == 34) && ('#' == 35) \
+    && ('%' == 37) && ('&' == 38) && ('\'' == 39) && ('(' == 40) \
+    && (')' == 41) && ('*' == 42) && ('+' == 43) && (',' == 44) \
+    && ('-' == 45) && ('.' == 46) && ('/' == 47) && ('0' == 48) \
+    && ('1' == 49) && ('2' == 50) && ('3' == 51) && ('4' == 52) \
+    && ('5' == 53) && ('6' == 54) && ('7' == 55) && ('8' == 56) \
+    && ('9' == 57) && (':' == 58) && (';' == 59) && ('<' == 60) \
+    && ('=' == 61) && ('>' == 62) && ('?' == 63) && ('A' == 65) \
+    && ('B' == 66) && ('C' == 67) && ('D' == 68) && ('E' == 69) \
+    && ('F' == 70) && ('G' == 71) && ('H' == 72) && ('I' == 73) \
+    && ('J' == 74) && ('K' == 75) && ('L' == 76) && ('M' == 77) \
+    && ('N' == 78) && ('O' == 79) && ('P' == 80) && ('Q' == 81) \
+    && ('R' == 82) && ('S' == 83) && ('T' == 84) && ('U' == 85) \
+    && ('V' == 86) && ('W' == 87) && ('X' == 88) && ('Y' == 89) \
+    && ('Z' == 90) && ('[' == 91) && ('\\' == 92) && (']' == 93) \
+    && ('^' == 94) && ('_' == 95) && ('a' == 97) && ('b' == 98) \
+    && ('c' == 99) && ('d' == 100) && ('e' == 101) && ('f' == 102) \
+    && ('g' == 103) && ('h' == 104) && ('i' == 105) && ('j' == 106) \
+    && ('k' == 107) && ('l' == 108) && ('m' == 109) && ('n' == 110) \
+    && ('o' == 111) && ('p' == 112) && ('q' == 113) && ('r' == 114) \
+    && ('s' == 115) && ('t' == 116) && ('u' == 117) && ('v' == 118) \
+    && ('w' == 119) && ('x' == 120) && ('y' == 121) && ('z' == 122) \
+    && ('{' == 123) && ('|' == 124) && ('}' == 125) && ('~' == 126)
+/* The character set is ASCII or one of its variants or extensions, not EBCDIC.
+   Testing the value of '\n' and '\r' is not relevant.  */
+#define C_CTYPE_ASCII 1
+#endif
+
+
+/* Function declarations. */
+
+/* Unlike the functions in <ctype.h>, which require an argument in the range
+   of the 'unsigned char' type, the functions here operate on values that are
+   in the 'unsigned char' range or in the 'char' range.  In other words,
+   when you have a 'char' value, you need to cast it before using it as
+   argument to a <ctype.h> function:
+
+         const char *s = ...;
+         if (isalpha ((unsigned char) *s)) ...
+
+   but you don't need to cast it for the functions defined in this file:
+
+         const char *s = ...;
+         if (c_isalpha (*s)) ...
+ */
+
+extern bool c_isascii (int c); /* not locale dependent */
+
+extern bool c_isalnum (int c);
+extern bool c_isalpha (int c);
+extern bool c_isblank (int c);
+extern bool c_iscntrl (int c);
+extern bool c_isdigit (int c);
+extern bool c_islower (int c);
+extern bool c_isgraph (int c);
+extern bool c_isprint (int c);
+extern bool c_ispunct (int c);
+extern bool c_isspace (int c);
+extern bool c_isupper (int c);
+extern bool c_isxdigit (int c);
+
+extern int c_tolower (int c);
+extern int c_toupper (int c);
+
+
+#if defined __GNUC__ && defined __OPTIMIZE__ && !defined __OPTIMIZE_SIZE__ && !defined NO_C_CTYPE_MACROS
+
+/* ASCII optimizations. */
+
+#undef c_isascii
+#define c_isascii(c) \
+  ({ int __c = (c); \
+     (__c >= 0x00 && __c <= 0x7f); \
+   })
+
+#if C_CTYPE_CONSECUTIVE_DIGITS \
+    && C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE
+#if C_CTYPE_ASCII
+#undef c_isalnum
+#define c_isalnum(c) \
+  ({ int __c = (c); \
+     ((__c >= '0' && __c <= '9') \
+      || ((__c & ~0x20) >= 'A' && (__c & ~0x20) <= 'Z')); \
+   })
+#else
+#undef c_isalnum
+#define c_isalnum(c) \
+  ({ int __c = (c); \
+     ((__c >= '0' && __c <= '9') \
+      || (__c >= 'A' && __c <= 'Z') \
+      || (__c >= 'a' && __c <= 'z')); \
+   })
+#endif
+#endif
+
+#if C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE
+#if C_CTYPE_ASCII
+#undef c_isalpha
+#define c_isalpha(c) \
+  ({ int __c = (c); \
+     ((__c & ~0x20) >= 'A' && (__c & ~0x20) <= 'Z'); \
+   })
+#else
+#undef c_isalpha
+#define c_isalpha(c) \
+  ({ int __c = (c); \
+     ((__c >= 'A' && __c <= 'Z') || (__c >= 'a' && __c <= 'z')); \
+   })
+#endif
+#endif
+
+#undef c_isblank
+#define c_isblank(c) \
+  ({ int __c = (c); \
+     (__c == ' ' || __c == '\t'); \
+   })
+
+#if C_CTYPE_ASCII
+#undef c_iscntrl
+#define c_iscntrl(c) \
+  ({ int __c = (c); \
+     ((__c & ~0x1f) == 0 || __c == 0x7f); \
+   })
+#endif
+
+#if C_CTYPE_CONSECUTIVE_DIGITS
+#undef c_isdigit
+#define c_isdigit(c) \
+  ({ int __c = (c); \
+     (__c >= '0' && __c <= '9'); \
+   })
+#endif
+
+#if C_CTYPE_CONSECUTIVE_LOWERCASE
+#undef c_islower
+#define c_islower(c) \
+  ({ int __c = (c); \
+     (__c >= 'a' && __c <= 'z'); \
+   })
+#endif
+
+#if C_CTYPE_ASCII
+#undef c_isgraph
+#define c_isgraph(c) \
+  ({ int __c = (c); \
+     (__c >= '!' && __c <= '~'); \
+   })
+#endif
+
+#if C_CTYPE_ASCII
+#undef c_isprint
+#define c_isprint(c) \
+  ({ int __c = (c); \
+     (__c >= ' ' && __c <= '~'); \
+   })
+#endif
+
+#if C_CTYPE_ASCII
+#undef c_ispunct
+#define c_ispunct(c) \
+  ({ int _c = (c); \
+     (c_isgraph (_c) && ! c_isalnum (_c)); \
+   })
+#endif
+
+#undef c_isspace
+#define c_isspace(c) \
+  ({ int __c = (c); \
+     (__c == ' ' || __c == '\t' \
+      || __c == '\n' || __c == '\v' || __c == '\f' || __c == '\r'); \
+   })
+
+#if C_CTYPE_CONSECUTIVE_UPPERCASE
+#undef c_isupper
+#define c_isupper(c) \
+  ({ int __c = (c); \
+     (__c >= 'A' && __c <= 'Z'); \
+   })
+#endif
+
+#if C_CTYPE_CONSECUTIVE_DIGITS \
+    && C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE
+#if C_CTYPE_ASCII
+#undef c_isxdigit
+#define c_isxdigit(c) \
+  ({ int __c = (c); \
+     ((__c >= '0' && __c <= '9') \
+      || ((__c & ~0x20) >= 'A' && (__c & ~0x20) <= 'F')); \
+   })
+#else
+#undef c_isxdigit
+#define c_isxdigit(c) \
+  ({ int __c = (c); \
+     ((__c >= '0' && __c <= '9') \
+      || (__c >= 'A' && __c <= 'F') \
+      || (__c >= 'a' && __c <= 'f')); \
+   })
+#endif
+#endif
+
+#if C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE
+#undef c_tolower
+#define c_tolower(c) \
+  ({ int __c = (c); \
+     (__c >= 'A' && __c <= 'Z' ? __c - 'A' + 'a' : __c); \
+   })
+#undef c_toupper
+#define c_toupper(c) \
+  ({ int __c = (c); \
+     (__c >= 'a' && __c <= 'z' ? __c - 'a' + 'A' : __c); \
+   })
+#endif
+
+#endif /* optimizing for speed */
+
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* C_CTYPE_H */
diff --git a/lib/c-strcase.h b/lib/c-strcase.h
new file mode 100644
index 000000000..714a3c623
--- /dev/null
+++ b/lib/c-strcase.h
@@ -0,0 +1,55 @@
+/* Case-insensitive string comparison functions in C locale.
+   Copyright (C) 1995-1996, 2001, 2003, 2005 Free Software Foundation, Inc.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 2, or (at your option)
+   any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program; if not, write to the Free Software Foundation,
+   Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+#ifndef C_STRCASE_H
+#define C_STRCASE_H
+
+#include <stddef.h>
+
+
+/* The functions defined in this file assume the "C" locale and a character
+   set without diacritics (ASCII-US or EBCDIC-US or something like that).
+   Even if the "C" locale on a particular system is an extension of the ASCII
+   character set (like on BeOS, where it is UTF-8, or on AmigaOS, where it
+   is ISO-8859-1), the functions in this file recognize only the ASCII
+   characters.  More precisely, one of the string arguments must be an ASCII
+   string; the other one can also contain non-ASCII characters (but then
+   the comparison result will be nonzero).  */
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
+/* Compare strings S1 and S2, ignoring case, returning less than, equal to or
+   greater than zero if S1 is lexicographically less than, equal to or greater
+   than S2.  */
+extern int c_strcasecmp (const char *s1, const char *s2);
+
+/* Compare no more than N characters of strings S1 and S2, ignoring case,
+   returning less than, equal to or greater than zero if S1 is
+   lexicographically less than, equal to or greater than S2.  */
+extern int c_strncasecmp (const char *s1, const char *s2, size_t n);
+
+
+#ifdef __cplusplus
+}
+#endif
+
+
+#endif /* C_STRCASE_H */
diff --git a/lib/c-strcasecmp.c b/lib/c-strcasecmp.c
new file mode 100644
index 000000000..a52389883
--- /dev/null
+++ b/lib/c-strcasecmp.c
@@ -0,0 +1,57 @@
+/* c-strcasecmp.c -- case insensitive string comparator in C locale
+   Copyright (C) 1998-1999, 2005-2006 Free Software Foundation, Inc.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 2, or (at your option)
+   any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program; if not, write to the Free Software Foundation,
+   Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+#include <config.h>
+
+/* Specification.  */
+#include "c-strcase.h"
+
+#include <limits.h>
+
+#include "c-ctype.h"
+
+int
+c_strcasecmp (const char *s1, const char *s2)
+{
+  register const unsigned char *p1 = (const unsigned char *) s1;
+  register const unsigned char *p2 = (const unsigned char *) s2;
+  unsigned char c1, c2;
+
+  if (p1 == p2)
+    return 0;
+
+  do
+    {
+      c1 = c_tolower (*p1);
+      c2 = c_tolower (*p2);
+
+      if (c1 == '\0')
+	break;
+
+      ++p1;
+      ++p2;
+    }
+  while (c1 == c2);
+
+  if (UCHAR_MAX <= INT_MAX)
+    return c1 - c2;
+  else
+    /* On machines where 'char' and 'int' are types of the same size, the
+       difference of two 'unsigned char' values - including the sign bit -
+       doesn't fit in an 'int'.  */
+    return (c1 > c2 ? 1 : c1 < c2 ? -1 : 0);
+}
diff --git a/lib/c-strcaseeq.h b/lib/c-strcaseeq.h
new file mode 100644
index 000000000..cd29b66c7
--- /dev/null
+++ b/lib/c-strcaseeq.h
@@ -0,0 +1,184 @@
+/* Optimized case-insensitive string comparison in C locale.
+   Copyright (C) 2001-2002, 2007 Free Software Foundation, Inc.
+
+   This program is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+/* Written by Bruno Haible <bruno@clisp.org>.  */
+
+#include "c-strcase.h"
+#include "c-ctype.h"
+
+/* STRCASEEQ allows to optimize string comparison with a small literal string.
+     STRCASEEQ (s, "UTF-8", 'U','T','F','-','8',0,0,0,0)
+   is semantically equivalent to
+     c_strcasecmp (s, "UTF-8") == 0
+   just faster.  */
+
+/* Help GCC to generate good code for string comparisons with
+   immediate strings. */
+#if defined (__GNUC__) && defined (__OPTIMIZE__)
+
+/* Case insensitive comparison of ASCII characters.  */
+# if C_CTYPE_ASCII
+#  define CASEEQ(other,upper) \
+     (c_isupper (upper) ? ((other) & ~0x20) == (upper) : (other) == (upper))
+# elif C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE
+#  define CASEEQ(other,upper) \
+     (c_isupper (upper) ? (other) == (upper) || (other) == (upper) - 'A' + 'a' : (other) == (upper))
+# else
+#  define CASEEQ(other,upper) \
+     (c_toupper (other) == (upper))
+# endif
+
+static inline int
+strcaseeq9 (const char *s1, const char *s2)
+{
+  return c_strcasecmp (s1 + 9, s2 + 9) == 0;
+}
+
+static inline int
+strcaseeq8 (const char *s1, const char *s2, char s28)
+{
+  if (CASEEQ (s1[8], s28))
+    {
+      if (s28 == 0)
+        return 1;
+      else
+        return strcaseeq9 (s1, s2);
+    }
+  else
+    return 0;
+}
+
+static inline int
+strcaseeq7 (const char *s1, const char *s2, char s27, char s28)
+{
+  if (CASEEQ (s1[7], s27))
+    {
+      if (s27 == 0)
+        return 1;
+      else
+        return strcaseeq8 (s1, s2, s28);
+    }
+  else
+    return 0;
+}
+
+static inline int
+strcaseeq6 (const char *s1, const char *s2, char s26, char s27, char s28)
+{
+  if (CASEEQ (s1[6], s26))
+    {
+      if (s26 == 0)
+        return 1;
+      else
+        return strcaseeq7 (s1, s2, s27, s28);
+    }
+  else
+    return 0;
+}
+
+static inline int
+strcaseeq5 (const char *s1, const char *s2, char s25, char s26, char s27, char s28)
+{
+  if (CASEEQ (s1[5], s25))
+    {
+      if (s25 == 0)
+        return 1;
+      else
+        return strcaseeq6 (s1, s2, s26, s27, s28);
+    }
+  else
+    return 0;
+}
+
+static inline int
+strcaseeq4 (const char *s1, const char *s2, char s24, char s25, char s26, char s27, char s28)
+{
+  if (CASEEQ (s1[4], s24))
+    {
+      if (s24 == 0)
+        return 1;
+      else
+        return strcaseeq5 (s1, s2, s25, s26, s27, s28);
+    }
+  else
+    return 0;
+}
+
+static inline int
+strcaseeq3 (const char *s1, const char *s2, char s23, char s24, char s25, char s26, char s27, char s28)
+{
+  if (CASEEQ (s1[3], s23))
+    {
+      if (s23 == 0)
+        return 1;
+      else
+        return strcaseeq4 (s1, s2, s24, s25, s26, s27, s28);
+    }
+  else
+    return 0;
+}
+
+static inline int
+strcaseeq2 (const char *s1, const char *s2, char s22, char s23, char s24, char s25, char s26, char s27, char s28)
+{
+  if (CASEEQ (s1[2], s22))
+    {
+      if (s22 == 0)
+        return 1;
+      else
+        return strcaseeq3 (s1, s2, s23, s24, s25, s26, s27, s28);
+    }
+  else
+    return 0;
+}
+
+static inline int
+strcaseeq1 (const char *s1, const char *s2, char s21, char s22, char s23, char s24, char s25, char s26, char s27, char s28)
+{
+  if (CASEEQ (s1[1], s21))
+    {
+      if (s21 == 0)
+        return 1;
+      else
+        return strcaseeq2 (s1, s2, s22, s23, s24, s25, s26, s27, s28);
+    }
+  else
+    return 0;
+}
+
+static inline int
+strcaseeq0 (const char *s1, const char *s2, char s20, char s21, char s22, char s23, char s24, char s25, char s26, char s27, char s28)
+{
+  if (CASEEQ (s1[0], s20))
+    {
+      if (s20 == 0)
+        return 1;
+      else
+        return strcaseeq1 (s1, s2, s21, s22, s23, s24, s25, s26, s27, s28);
+    }
+  else
+    return 0;
+}
+
+#define STRCASEEQ(s1,s2,s20,s21,s22,s23,s24,s25,s26,s27,s28) \
+  strcaseeq0 (s1, s2, s20, s21, s22, s23, s24, s25, s26, s27, s28)
+
+#else
+
+#define STRCASEEQ(s1,s2,s20,s21,s22,s23,s24,s25,s26,s27,s28) \
+  (c_strcasecmp (s1, s2) == 0)
+
+#endif
diff --git a/lib/c-strncasecmp.c b/lib/c-strncasecmp.c
new file mode 100644
index 000000000..c1496ca41
--- /dev/null
+++ b/lib/c-strncasecmp.c
@@ -0,0 +1,57 @@
+/* c-strncasecmp.c -- case insensitive string comparator in C locale
+   Copyright (C) 1998-1999, 2005-2006 Free Software Foundation, Inc.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 2, or (at your option)
+   any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program; if not, write to the Free Software Foundation,
+   Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+#include <config.h>
+
+/* Specification.  */
+#include "c-strcase.h"
+
+#include <limits.h>
+
+#include "c-ctype.h"
+
+int
+c_strncasecmp (const char *s1, const char *s2, size_t n)
+{
+  register const unsigned char *p1 = (const unsigned char *) s1;
+  register const unsigned char *p2 = (const unsigned char *) s2;
+  unsigned char c1, c2;
+
+  if (p1 == p2 || n == 0)
+    return 0;
+
+  do
+    {
+      c1 = c_tolower (*p1);
+      c2 = c_tolower (*p2);
+
+      if (--n == 0 || c1 == '\0')
+	break;
+
+      ++p1;
+      ++p2;
+    }
+  while (c1 == c2);
+
+  if (UCHAR_MAX <= INT_MAX)
+    return c1 - c2;
+  else
+    /* On machines where 'char' and 'int' are types of the same size, the
+       difference of two 'unsigned char' values - including the sign bit -
+       doesn't fit in an 'int'.  */
+    return (c1 > c2 ? 1 : c1 < c2 ? -1 : 0);
+}
diff --git a/lib/canonicalize-lgpl.c b/lib/canonicalize-lgpl.c
new file mode 100644
index 000000000..8bc24680f
--- /dev/null
+++ b/lib/canonicalize-lgpl.c
@@ -0,0 +1,362 @@
+/* Return the canonical absolute name of a given file.
+   Copyright (C) 1996-2003, 2005-2008 Free Software Foundation, Inc.
+   This file is part of the GNU C Library.
+
+   This program is free software: you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#include <config.h>
+
+/* Avoid a clash of our rpl_realpath() function with the prototype in
+   <stdlib.h> on Solaris 2.5.1.  */
+#undef realpath
+
+#if !HAVE_CANONICALIZE_FILE_NAME || defined _LIBC
+
+#include <alloca.h>
+
+/* Specification.  */
+#include "canonicalize.h"
+
+#include <stddef.h>
+#include <stdlib.h>
+#include <string.h>
+
+#if HAVE_UNISTD_H || defined _LIBC
+# include <unistd.h>
+#endif
+
+#include <limits.h>
+
+#if HAVE_SYS_PARAM_H || defined _LIBC
+# include <sys/param.h>
+#endif
+#ifndef MAXSYMLINKS
+# define MAXSYMLINKS 20
+#endif
+
+#include <sys/stat.h>
+
+#include <errno.h>
+#ifndef _LIBC
+# define __set_errno(e) errno = (e)
+# ifndef ENAMETOOLONG
+#  define ENAMETOOLONG EINVAL
+# endif
+#endif
+
+#ifdef _LIBC
+# include <shlib-compat.h>
+#else
+# define SHLIB_COMPAT(lib, introduced, obsoleted) 0
+# define versioned_symbol(lib, local, symbol, version)
+# define compat_symbol(lib, local, symbol, version)
+# define weak_alias(local, symbol)
+# define __canonicalize_file_name canonicalize_file_name
+# define __realpath rpl_realpath
+# include "pathmax.h"
+# include "malloca.h"
+# if HAVE_GETCWD
+#  ifdef VMS
+    /* We want the directory in Unix syntax, not in VMS syntax.  */
+#   define __getcwd(buf, max) getcwd (buf, max, 0)
+#  else
+#   define __getcwd getcwd
+#  endif
+# else
+#  define __getcwd(buf, max) getwd (buf)
+# endif
+# define __readlink readlink
+  /* On systems without symbolic links, call stat() instead of lstat().  */
+# if !defined S_ISLNK && !HAVE_READLINK
+#  define lstat stat
+# endif
+#endif
+
+/* Return the canonical absolute name of file NAME.  A canonical name
+   does not contain any `.', `..' components nor any repeated path
+   separators ('/') or symlinks.  All path components must exist.  If
+   RESOLVED is null, the result is malloc'd; otherwise, if the
+   canonical name is PATH_MAX chars or more, returns null with `errno'
+   set to ENAMETOOLONG; if the name fits in fewer than PATH_MAX chars,
+   returns the name in RESOLVED.  If the name cannot be resolved and
+   RESOLVED is non-NULL, it contains the path of the first component
+   that cannot be resolved.  If the path can be resolved, RESOLVED
+   holds the same value as the value returned.  */
+
+char *
+__realpath (const char *name, char *resolved)
+{
+  char *rpath, *dest, *extra_buf = NULL;
+  const char *start, *end, *rpath_limit;
+  long int path_max;
+#if HAVE_READLINK
+  int num_links = 0;
+#endif
+
+  if (name == NULL)
+    {
+      /* As per Single Unix Specification V2 we must return an error if
+	 either parameter is a null pointer.  We extend this to allow
+	 the RESOLVED parameter to be NULL in case the we are expected to
+	 allocate the room for the return value.  */
+      __set_errno (EINVAL);
+      return NULL;
+    }
+
+  if (name[0] == '\0')
+    {
+      /* As per Single Unix Specification V2 we must return an error if
+	 the name argument points to an empty string.  */
+      __set_errno (ENOENT);
+      return NULL;
+    }
+
+#ifdef PATH_MAX
+  path_max = PATH_MAX;
+#else
+  path_max = pathconf (name, _PC_PATH_MAX);
+  if (path_max <= 0)
+    path_max = 1024;
+#endif
+
+  if (resolved == NULL)
+    {
+      rpath = malloc (path_max);
+      if (rpath == NULL)
+	{
+	  /* It's easier to set errno to ENOMEM than to rely on the
+	     'malloc-posix' gnulib module.  */
+	  errno = ENOMEM;
+	  return NULL;
+	}
+    }
+  else
+    rpath = resolved;
+  rpath_limit = rpath + path_max;
+
+  if (name[0] != '/')
+    {
+      if (!__getcwd (rpath, path_max))
+	{
+	  rpath[0] = '\0';
+	  goto error;
+	}
+      dest = strchr (rpath, '\0');
+    }
+  else
+    {
+      rpath[0] = '/';
+      dest = rpath + 1;
+    }
+
+  for (start = end = name; *start; start = end)
+    {
+#ifdef _LIBC
+      struct stat64 st;
+#else
+      struct stat st;
+#endif
+
+      /* Skip sequence of multiple path-separators.  */
+      while (*start == '/')
+	++start;
+
+      /* Find end of path component.  */
+      for (end = start; *end && *end != '/'; ++end)
+	/* Nothing.  */;
+
+      if (end - start == 0)
+	break;
+      else if (end - start == 1 && start[0] == '.')
+	/* nothing */;
+      else if (end - start == 2 && start[0] == '.' && start[1] == '.')
+	{
+	  /* Back up to previous component, ignore if at root already.  */
+	  if (dest > rpath + 1)
+	    while ((--dest)[-1] != '/');
+	}
+      else
+	{
+	  size_t new_size;
+
+	  if (dest[-1] != '/')
+	    *dest++ = '/';
+
+	  if (dest + (end - start) >= rpath_limit)
+	    {
+	      ptrdiff_t dest_offset = dest - rpath;
+	      char *new_rpath;
+
+	      if (resolved)
+		{
+		  __set_errno (ENAMETOOLONG);
+		  if (dest > rpath + 1)
+		    dest--;
+		  *dest = '\0';
+		  goto error;
+		}
+	      new_size = rpath_limit - rpath;
+	      if (end - start + 1 > path_max)
+		new_size += end - start + 1;
+	      else
+		new_size += path_max;
+	      new_rpath = (char *) realloc (rpath, new_size);
+	      if (new_rpath == NULL)
+		{
+		  /* It's easier to set errno to ENOMEM than to rely on the
+		     'realloc-posix' gnulib module.  */
+		  errno = ENOMEM;
+		  goto error;
+		}
+	      rpath = new_rpath;
+	      rpath_limit = rpath + new_size;
+
+	      dest = rpath + dest_offset;
+	    }
+
+#ifdef _LIBC
+	  dest = __mempcpy (dest, start, end - start);
+#else
+	  memcpy (dest, start, end - start);
+	  dest += end - start;
+#endif
+	  *dest = '\0';
+
+#ifdef _LIBC
+	  if (__lxstat64 (_STAT_VER, rpath, &st) < 0)
+#else
+	  if (lstat (rpath, &st) < 0)
+#endif
+	    goto error;
+
+#if HAVE_READLINK
+	  if (S_ISLNK (st.st_mode))
+	    {
+	      char *buf;
+	      size_t len;
+	      int n;
+
+	      if (++num_links > MAXSYMLINKS)
+		{
+		  __set_errno (ELOOP);
+		  goto error;
+		}
+
+	      buf = malloca (path_max);
+	      if (!buf)
+		{
+		  errno = ENOMEM;
+		  goto error;
+		}
+
+	      n = __readlink (rpath, buf, path_max - 1);
+	      if (n < 0)
+		{
+		  int saved_errno = errno;
+		  freea (buf);
+		  errno = saved_errno;
+		  goto error;
+		}
+	      buf[n] = '\0';
+
+	      if (!extra_buf)
+		{
+		  extra_buf = malloca (path_max);
+		  if (!extra_buf)
+		    {
+		      freea (buf);
+		      errno = ENOMEM;
+		      goto error;
+		    }
+		}
+
+	      len = strlen (end);
+	      if ((long int) (n + len) >= path_max)
+		{
+		  freea (buf);
+		  __set_errno (ENAMETOOLONG);
+		  goto error;
+		}
+
+	      /* Careful here, end may be a pointer into extra_buf... */
+	      memmove (&extra_buf[n], end, len + 1);
+	      name = end = memcpy (extra_buf, buf, n);
+
+	      if (buf[0] == '/')
+		dest = rpath + 1;	/* It's an absolute symlink */
+	      else
+		/* Back up to previous component, ignore if at root already: */
+		if (dest > rpath + 1)
+		  while ((--dest)[-1] != '/');
+	    }
+#endif
+	}
+    }
+  if (dest > rpath + 1 && dest[-1] == '/')
+    --dest;
+  *dest = '\0';
+
+  if (extra_buf)
+    freea (extra_buf);
+
+  return resolved ? memcpy (resolved, rpath, dest - rpath + 1) : rpath;
+
+error:
+  {
+    int saved_errno = errno;
+    if (extra_buf)
+      freea (extra_buf);
+    if (resolved)
+      strcpy (resolved, rpath);
+    else
+      free (rpath);
+    errno = saved_errno;
+  }
+  return NULL;
+}
+#ifdef _LIBC
+versioned_symbol (libc, __realpath, realpath, GLIBC_2_3);
+#endif
+
+
+#if SHLIB_COMPAT(libc, GLIBC_2_0, GLIBC_2_3)
+char *
+__old_realpath (const char *name, char *resolved)
+{
+  if (resolved == NULL)
+    {
+      __set_errno (EINVAL);
+      return NULL;
+    }
+
+  return __realpath (name, resolved);
+}
+compat_symbol (libc, __old_realpath, realpath, GLIBC_2_0);
+#endif
+
+
+char *
+__canonicalize_file_name (const char *name)
+{
+  return __realpath (name, NULL);
+}
+weak_alias (__canonicalize_file_name, canonicalize_file_name)
+
+#else
+
+/* This declaration is solely to ensure that after preprocessing
+   this file is never empty.  */
+typedef int dummy;
+
+#endif
diff --git a/lib/canonicalize.h b/lib/canonicalize.h
new file mode 100644
index 000000000..184cf1637
--- /dev/null
+++ b/lib/canonicalize.h
@@ -0,0 +1,52 @@
+/* Return the canonical absolute name of a given file.
+   Copyright (C) 1996-2007 Free Software Foundation, Inc.
+
+   This program is free software: you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#ifndef CANONICALIZE_H_
+# define CANONICALIZE_H_
+
+# if GNULIB_CANONICALIZE
+enum canonicalize_mode_t
+  {
+    /* All components must exist.  */
+    CAN_EXISTING = 0,
+
+    /* All components excluding last one must exist.  */
+    CAN_ALL_BUT_LAST = 1,
+
+    /* No requirements on components existence.  */
+    CAN_MISSING = 2
+  };
+typedef enum canonicalize_mode_t canonicalize_mode_t;
+
+/* Return a malloc'd string containing the canonical absolute name of
+   the named file.  This acts like canonicalize_file_name, except that
+   whether components must exist depends on the canonicalize_mode_t
+   argument.  */
+char *canonicalize_filename_mode (const char *, canonicalize_mode_t);
+# endif
+
+# if HAVE_DECL_CANONICALIZE_FILE_NAME
+#  include <stdlib.h>
+# else
+/* Return a malloc'd string containing the canonical absolute name of
+   the named file.  If any file name component does not exist or is a
+   symlink to a nonexistent file, return NULL.  A canonical name does
+   not contain any `.', `..' components nor any repeated file name
+   separators ('/') or symlinks.  */
+char *canonicalize_file_name (const char *);
+# endif
+
+#endif /* !CANONICALIZE_H_ */
diff --git a/lib/config.charset b/lib/config.charset
index 50b4406b2..c1a7f5dbb 100755
--- a/lib/config.charset
+++ b/lib/config.charset
@@ -1,7 +1,7 @@
 #! /bin/sh
 # Output a system dependent table of character encoding aliases.
 #
-#   Copyright (C) 2000-2004, 2006-2008 Free Software Foundation, Inc.
+#   Copyright (C) 2000-2004, 2006-2009 Free Software Foundation, Inc.
 #
 #   This program is free software; you can redistribute it and/or modify
 #   it under the terms of the GNU Lesser General Public License as published by
@@ -63,12 +63,13 @@
 #   CP922                       aix
 #   CP932                       aix woe32 dos
 #   CP943                       aix
-#   CP949                       osf woe32 dos
+#   CP949                       osf darwin woe32 dos
 #   CP950                       woe32 dos
 #   CP1046                      aix
 #   CP1124                      aix
 #   CP1125                      dos
 #   CP1129                      aix
+#   CP1131                      darwin
 #   CP1250                      woe32
 #   CP1251                      glibc solaris netbsd openbsd darwin woe32
 #   CP1252                      aix woe32
@@ -82,15 +83,17 @@
 #   EUC-KR                  Y   glibc aix hpux irix osf solaris freebsd netbsd darwin
 #   EUC-TW                      glibc aix hpux irix osf solaris netbsd
 #   BIG5                    Y   glibc aix hpux osf solaris freebsd netbsd darwin
-#   BIG5-HKSCS                  glibc solaris
-#   GBK                         glibc aix osf solaris woe32 dos
-#   GB18030                     glibc solaris netbsd
+#   BIG5-HKSCS                  glibc solaris darwin
+#   GBK                         glibc aix osf solaris darwin woe32 dos
+#   GB18030                     glibc solaris netbsd darwin
 #   SHIFT_JIS               Y   hpux osf solaris freebsd netbsd darwin
 #   JOHAB                       glibc solaris woe32
 #   TIS-620                     glibc aix hpux osf solaris
 #   VISCII                  Y   glibc
 #   TCVN5712-1                  glibc
+#   ARMSCII-8                   glibc darwin
 #   GEORGIAN-PS                 glibc
+#   PT154                       glibc
 #   HP-ROMAN8                   hpux
 #   HP-ARABIC8                  hpux
 #   HP-GREEK8                   hpux
@@ -449,7 +452,8 @@ case "$os" in
 	echo "ko_KR.EUC EUC-KR"
 	;;
     darwin*)
-	# Darwin 7.5 has nl_langinfo(CODESET), but it is useless:
+	# Darwin 7.5 has nl_langinfo(CODESET), but sometimes its value is
+	# useless:
 	# - It returns the empty string when LANG is set to a locale of the
 	#   form ll_CC, although ll_CC/LC_CTYPE is a symlink to an UTF-8
 	#   LC_CTYPE file.
@@ -476,6 +480,36 @@ case "$os" in
 	# minimize the use of decomposed Unicode. Unfortunately, through the
 	# Darwin file system, decomposed UTF-8 strings are leaked into user
 	# space nevertheless.
+	# Then there are also the locales with encodings other than US-ASCII
+	# and UTF-8. These locales can be occasionally useful to users (e.g.
+	# when grepping through ISO-8859-1 encoded text files), when all their
+	# file names are in US-ASCII.
+	echo "ISO8859-1 ISO-8859-1"
+	echo "ISO8859-2 ISO-8859-2"
+	echo "ISO8859-4 ISO-8859-4"
+	echo "ISO8859-5 ISO-8859-5"
+	echo "ISO8859-7 ISO-8859-7"
+	echo "ISO8859-9 ISO-8859-9"
+	echo "ISO8859-13 ISO-8859-13"
+	echo "ISO8859-15 ISO-8859-15"
+	echo "KOI8-R KOI8-R"
+	echo "KOI8-U KOI8-U"
+	echo "CP866 CP866"
+	echo "CP949 CP949"
+	echo "CP1131 CP1131"
+	echo "CP1251 CP1251"
+	echo "eucCN GB2312"
+	echo "GB2312 GB2312"
+	echo "eucJP EUC-JP"
+	echo "eucKR EUC-KR"
+	echo "Big5 BIG5"
+	echo "Big5HKSCS BIG5-HKSCS"
+	echo "GBK GBK"
+	echo "GB18030 GB18030"
+	echo "SJIS SHIFT_JIS"
+	echo "ARMSCII-8 ARMSCII-8"
+	echo "PT154 PT154"
+	#echo "ISCII-DEV ?"
 	echo "* UTF-8"
 	;;
     beos* | haiku*)
diff --git a/lib/errno.in.h b/lib/errno.in.h
new file mode 100644
index 000000000..a9b81d5df
--- /dev/null
+++ b/lib/errno.in.h
@@ -0,0 +1,160 @@
+/* A POSIX-like <errno.h>.
+
+   Copyright (C) 2008-2009 Free Software Foundation, Inc.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 2, or (at your option)
+   any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program; if not, write to the Free Software Foundation,
+   Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+#ifndef _GL_ERRNO_H
+
+#if __GNUC__ >= 3
+@PRAGMA_SYSTEM_HEADER@
+#endif
+
+/* The include_next requires a split double-inclusion guard.  */
+#@INCLUDE_NEXT@ @NEXT_ERRNO_H@
+
+#ifndef _GL_ERRNO_H
+#define _GL_ERRNO_H
+
+
+/* On native Windows platforms, many macros are not defined.  */
+# if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
+
+/* POSIX says that EAGAIN and EWOULDBLOCK may have the same value.  */
+#  define EWOULDBLOCK     EAGAIN
+
+/* Values >= 100 seem safe to use.  */
+#  define ETXTBSY   100
+#  define GNULIB_defined_ETXTBSY 1
+
+/* These are intentionally the same values as the WSA* error numbers, defined
+   in <winsock2.h>.  */
+#  define EINPROGRESS     10036
+#  define EALREADY        10037
+#  define ENOTSOCK        10038
+#  define EDESTADDRREQ    10039
+#  define EMSGSIZE        10040
+#  define EPROTOTYPE      10041
+#  define ENOPROTOOPT     10042
+#  define EPROTONOSUPPORT 10043
+#  define ESOCKTNOSUPPORT 10044  /* not required by POSIX */
+#  define EOPNOTSUPP      10045
+#  define EPFNOSUPPORT    10046  /* not required by POSIX */
+#  define EAFNOSUPPORT    10047
+#  define EADDRINUSE      10048
+#  define EADDRNOTAVAIL   10049
+#  define ENETDOWN        10050
+#  define ENETUNREACH     10051
+#  define ENETRESET       10052
+#  define ECONNABORTED    10053
+#  define ECONNRESET      10054
+#  define ENOBUFS         10055
+#  define EISCONN         10056
+#  define ENOTCONN        10057
+#  define ESHUTDOWN       10058  /* not required by POSIX */
+#  define ETOOMANYREFS    10059  /* not required by POSIX */
+#  define ETIMEDOUT       10060
+#  define ECONNREFUSED    10061
+#  define ELOOP           10062
+#  define EHOSTDOWN       10064  /* not required by POSIX */
+#  define EHOSTUNREACH    10065
+#  define EPROCLIM        10067  /* not required by POSIX */
+#  define EUSERS          10068  /* not required by POSIX */
+#  define EDQUOT          10069
+#  define ESTALE          10070
+#  define EREMOTE         10071  /* not required by POSIX */
+#  define GNULIB_defined_ESOCK 1
+
+# endif
+
+
+/* On OSF/1 5.1, when _XOPEN_SOURCE_EXTENDED is not defined, the macros
+   EMULTIHOP, ENOLINK, EOVERFLOW are not defined.  */
+# if @EMULTIHOP_HIDDEN@
+#  define EMULTIHOP @EMULTIHOP_VALUE@
+#  define GNULIB_defined_EMULTIHOP 1
+# endif
+# if @ENOLINK_HIDDEN@
+#  define ENOLINK   @ENOLINK_VALUE@
+#  define GNULIB_defined_ENOLINK 1
+# endif
+# if @EOVERFLOW_HIDDEN@
+#  define EOVERFLOW @EOVERFLOW_VALUE@
+#  define GNULIB_defined_EOVERFLOW 1
+# endif
+
+
+/* On OpenBSD 4.0 and on native Windows, the macros ENOMSG, EIDRM, ENOLINK,
+   EPROTO, EMULTIHOP, EBADMSG, EOVERFLOW, ENOTSUP, ECANCELED are not defined.
+   Define them here.  Values >= 2000 seem safe to use: Solaris ESTALE = 151,
+   HP-UX EWOULDBLOCK = 246, IRIX EDQUOT = 1133.
+
+   Note: When one of these systems defines some of these macros some day,
+   binaries will have to be recompiled so that they recognizes the new
+   errno values from the system.  */
+
+# ifndef ENOMSG
+#  define ENOMSG    2000
+#  define GNULIB_defined_ENOMSG 1
+# endif
+
+# ifndef EIDRM
+#  define EIDRM     2001
+#  define GNULIB_defined_EIDRM 1
+# endif
+
+# ifndef ENOLINK
+#  define ENOLINK   2002
+#  define GNULIB_defined_ENOLINK 1
+# endif
+
+# ifndef EPROTO
+#  define EPROTO    2003
+#  define GNULIB_defined_EPROTO 1
+# endif
+
+# ifndef EMULTIHOP
+#  define EMULTIHOP 2004
+#  define GNULIB_defined_EMULTIHOP 1
+# endif
+
+# ifndef EBADMSG
+#  define EBADMSG   2005
+#  define GNULIB_defined_EBADMSG 1
+# endif
+
+# ifndef EOVERFLOW
+#  define EOVERFLOW 2006
+#  define GNULIB_defined_EOVERFLOW 1
+# endif
+
+# ifndef ENOTSUP
+#  define ENOTSUP   2007
+#  define GNULIB_defined_ENOTSUP 1
+# endif
+
+# ifndef ESTALE
+#  define ESTALE    2009
+#  define GNULIB_defined_ESTALE 1
+# endif
+
+# ifndef ECANCELED
+#  define ECANCELED 2008
+#  define GNULIB_defined_ECANCELED 1
+# endif
+
+
+#endif /* _GL_ERRNO_H */
+#endif /* _GL_ERRNO_H */
diff --git a/lib/float+.h b/lib/float+.h
new file mode 100644
index 000000000..2288e3d34
--- /dev/null
+++ b/lib/float+.h
@@ -0,0 +1,148 @@
+/* Supplemental information about the floating-point formats.
+   Copyright (C) 2007 Free Software Foundation, Inc.
+   Written by Bruno Haible <bruno@clisp.org>, 2007.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 2, or (at your option)
+   any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program; if not, write to the Free Software Foundation,
+   Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+#ifndef _FLOATPLUS_H
+#define _FLOATPLUS_H
+
+#include <float.h>
+#include <limits.h>
+
+/* Number of bits in the mantissa of a floating-point number, including the
+   "hidden bit".  */
+#if FLT_RADIX == 2
+# define FLT_MANT_BIT FLT_MANT_DIG
+# define DBL_MANT_BIT DBL_MANT_DIG
+# define LDBL_MANT_BIT LDBL_MANT_DIG
+#elif FLT_RADIX == 4
+# define FLT_MANT_BIT (FLT_MANT_DIG * 2)
+# define DBL_MANT_BIT (DBL_MANT_DIG * 2)
+# define LDBL_MANT_BIT (LDBL_MANT_DIG * 2)
+#elif FLT_RADIX == 16
+# define FLT_MANT_BIT (FLT_MANT_DIG * 4)
+# define DBL_MANT_BIT (DBL_MANT_DIG * 4)
+# define LDBL_MANT_BIT (LDBL_MANT_DIG * 4)
+#endif
+
+/* Bit mask that can be used to mask the exponent, as an unsigned number.  */
+#define FLT_EXP_MASK ((FLT_MAX_EXP - FLT_MIN_EXP) | 7)
+#define DBL_EXP_MASK ((DBL_MAX_EXP - DBL_MIN_EXP) | 7)
+#define LDBL_EXP_MASK ((LDBL_MAX_EXP - LDBL_MIN_EXP) | 7)
+
+/* Number of bits used for the exponent of a floating-point number, including
+   the exponent's sign.  */
+#define FLT_EXP_BIT \
+  (FLT_EXP_MASK < 0x100 ? 8 : \
+   FLT_EXP_MASK < 0x200 ? 9 : \
+   FLT_EXP_MASK < 0x400 ? 10 : \
+   FLT_EXP_MASK < 0x800 ? 11 : \
+   FLT_EXP_MASK < 0x1000 ? 12 : \
+   FLT_EXP_MASK < 0x2000 ? 13 : \
+   FLT_EXP_MASK < 0x4000 ? 14 : \
+   FLT_EXP_MASK < 0x8000 ? 15 : \
+   FLT_EXP_MASK < 0x10000 ? 16 : \
+   FLT_EXP_MASK < 0x20000 ? 17 : \
+   FLT_EXP_MASK < 0x40000 ? 18 : \
+   FLT_EXP_MASK < 0x80000 ? 19 : \
+   FLT_EXP_MASK < 0x100000 ? 20 : \
+   FLT_EXP_MASK < 0x200000 ? 21 : \
+   FLT_EXP_MASK < 0x400000 ? 22 : \
+   FLT_EXP_MASK < 0x800000 ? 23 : \
+   FLT_EXP_MASK < 0x1000000 ? 24 : \
+   FLT_EXP_MASK < 0x2000000 ? 25 : \
+   FLT_EXP_MASK < 0x4000000 ? 26 : \
+   FLT_EXP_MASK < 0x8000000 ? 27 : \
+   FLT_EXP_MASK < 0x10000000 ? 28 : \
+   FLT_EXP_MASK < 0x20000000 ? 29 : \
+   FLT_EXP_MASK < 0x40000000 ? 30 : \
+   FLT_EXP_MASK <= 0x7fffffff ? 31 : \
+   32)
+#define DBL_EXP_BIT \
+  (DBL_EXP_MASK < 0x100 ? 8 : \
+   DBL_EXP_MASK < 0x200 ? 9 : \
+   DBL_EXP_MASK < 0x400 ? 10 : \
+   DBL_EXP_MASK < 0x800 ? 11 : \
+   DBL_EXP_MASK < 0x1000 ? 12 : \
+   DBL_EXP_MASK < 0x2000 ? 13 : \
+   DBL_EXP_MASK < 0x4000 ? 14 : \
+   DBL_EXP_MASK < 0x8000 ? 15 : \
+   DBL_EXP_MASK < 0x10000 ? 16 : \
+   DBL_EXP_MASK < 0x20000 ? 17 : \
+   DBL_EXP_MASK < 0x40000 ? 18 : \
+   DBL_EXP_MASK < 0x80000 ? 19 : \
+   DBL_EXP_MASK < 0x100000 ? 20 : \
+   DBL_EXP_MASK < 0x200000 ? 21 : \
+   DBL_EXP_MASK < 0x400000 ? 22 : \
+   DBL_EXP_MASK < 0x800000 ? 23 : \
+   DBL_EXP_MASK < 0x1000000 ? 24 : \
+   DBL_EXP_MASK < 0x2000000 ? 25 : \
+   DBL_EXP_MASK < 0x4000000 ? 26 : \
+   DBL_EXP_MASK < 0x8000000 ? 27 : \
+   DBL_EXP_MASK < 0x10000000 ? 28 : \
+   DBL_EXP_MASK < 0x20000000 ? 29 : \
+   DBL_EXP_MASK < 0x40000000 ? 30 : \
+   DBL_EXP_MASK <= 0x7fffffff ? 31 : \
+   32)
+#define LDBL_EXP_BIT \
+  (LDBL_EXP_MASK < 0x100 ? 8 : \
+   LDBL_EXP_MASK < 0x200 ? 9 : \
+   LDBL_EXP_MASK < 0x400 ? 10 : \
+   LDBL_EXP_MASK < 0x800 ? 11 : \
+   LDBL_EXP_MASK < 0x1000 ? 12 : \
+   LDBL_EXP_MASK < 0x2000 ? 13 : \
+   LDBL_EXP_MASK < 0x4000 ? 14 : \
+   LDBL_EXP_MASK < 0x8000 ? 15 : \
+   LDBL_EXP_MASK < 0x10000 ? 16 : \
+   LDBL_EXP_MASK < 0x20000 ? 17 : \
+   LDBL_EXP_MASK < 0x40000 ? 18 : \
+   LDBL_EXP_MASK < 0x80000 ? 19 : \
+   LDBL_EXP_MASK < 0x100000 ? 20 : \
+   LDBL_EXP_MASK < 0x200000 ? 21 : \
+   LDBL_EXP_MASK < 0x400000 ? 22 : \
+   LDBL_EXP_MASK < 0x800000 ? 23 : \
+   LDBL_EXP_MASK < 0x1000000 ? 24 : \
+   LDBL_EXP_MASK < 0x2000000 ? 25 : \
+   LDBL_EXP_MASK < 0x4000000 ? 26 : \
+   LDBL_EXP_MASK < 0x8000000 ? 27 : \
+   LDBL_EXP_MASK < 0x10000000 ? 28 : \
+   LDBL_EXP_MASK < 0x20000000 ? 29 : \
+   LDBL_EXP_MASK < 0x40000000 ? 30 : \
+   LDBL_EXP_MASK <= 0x7fffffff ? 31 : \
+   32)
+
+/* Number of bits used for a floating-point number: the mantissa (not
+   counting the "hidden bit", since it may or may not be explicit), the
+   exponent, and the sign.  */
+#define FLT_TOTAL_BIT ((FLT_MANT_BIT - 1) + FLT_EXP_BIT + 1)
+#define DBL_TOTAL_BIT ((DBL_MANT_BIT - 1) + DBL_EXP_BIT + 1)
+#define LDBL_TOTAL_BIT ((LDBL_MANT_BIT - 1) + LDBL_EXP_BIT + 1)
+
+/* Number of bytes used for a floating-point number.
+   This can be smaller than the 'sizeof'.  For example, on i386 systems,
+   'long double' most often have LDBL_MANT_BIT = 64, LDBL_EXP_BIT = 16, hence
+   LDBL_TOTAL_BIT = 80 bits, i.e. 10 bytes of consecutive memory, but
+   sizeof (long double) = 12 or = 16.  */
+#define SIZEOF_FLT ((FLT_TOTAL_BIT + CHAR_BIT - 1) / CHAR_BIT)
+#define SIZEOF_DBL ((DBL_TOTAL_BIT + CHAR_BIT - 1) / CHAR_BIT)
+#define SIZEOF_LDBL ((LDBL_TOTAL_BIT + CHAR_BIT - 1) / CHAR_BIT)
+
+/* Verify that SIZEOF_FLT <= sizeof (float) etc.  */
+typedef int verify_sizeof_flt[2 * (SIZEOF_FLT <= sizeof (float)) - 1];
+typedef int verify_sizeof_dbl[2 * (SIZEOF_DBL <= sizeof (double)) - 1];
+typedef int verify_sizeof_ldbl[2 * (SIZEOF_LDBL <= sizeof (long double)) - 1];
+
+#endif /* _FLOATPLUS_H */
diff --git a/lib/float.in.h b/lib/float.in.h
new file mode 100644
index 000000000..63d55f879
--- /dev/null
+++ b/lib/float.in.h
@@ -0,0 +1,62 @@
+/* A correct <float.h>.
+
+   Copyright (C) 2007-2008 Free Software Foundation, Inc.
+
+   This program is free software: you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#ifndef _GL_FLOAT_H
+
+#if __GNUC__ >= 3
+@PRAGMA_SYSTEM_HEADER@
+#endif
+
+/* The include_next requires a split double-inclusion guard.  */
+#@INCLUDE_NEXT@ @NEXT_FLOAT_H@
+
+#ifndef _GL_FLOAT_H
+#define _GL_FLOAT_H
+
+/* 'long double' properties.  */
+#if defined __i386__ && (defined __BEOS__ || defined __OpenBSD__)
+/* Number of mantissa units, in base FLT_RADIX.  */
+# undef LDBL_MANT_DIG
+# define LDBL_MANT_DIG   64
+/* Number of decimal digits that is sufficient for representing a number.  */
+# undef LDBL_DIG
+# define LDBL_DIG        18
+/* x-1 where x is the smallest representable number > 1.  */
+# undef LDBL_EPSILON
+# define LDBL_EPSILON    1.0842021724855044340E-19L
+/* Minimum e such that FLT_RADIX^(e-1) is a normalized number.  */
+# undef LDBL_MIN_EXP
+# define LDBL_MIN_EXP    (-16381)
+/* Maximum e such that FLT_RADIX^(e-1) is a representable finite number.  */
+# undef LDBL_MAX_EXP
+# define LDBL_MAX_EXP    16384
+/* Minimum positive normalized number.  */
+# undef LDBL_MIN
+# define LDBL_MIN        3.3621031431120935063E-4932L
+/* Maximum representable finite number.  */
+# undef LDBL_MAX
+# define LDBL_MAX        1.1897314953572317650E+4932L
+/* Minimum e such that 10^e is in the range of normalized numbers.  */
+# undef LDBL_MIN_10_EXP
+# define LDBL_MIN_10_EXP (-4931)
+/* Maximum e such that 10^e is in the range of representable finite numbers.  */
+# undef LDBL_MAX_10_EXP
+# define LDBL_MAX_10_EXP 4932
+#endif
+
+#endif /* _GL_FLOAT_H */
+#endif /* _GL_FLOAT_H */
diff --git a/lib/flock.c b/lib/flock.c
new file mode 100644
index 000000000..2993432de
--- /dev/null
+++ b/lib/flock.c
@@ -0,0 +1,222 @@
+/* Emulate flock on platforms that lack it, primarily Windows and MinGW.
+
+   This is derived from sqlite3 sources.
+   http://www.sqlite.org/cvstrac/rlog?f=sqlite/src/os_win.c
+   http://www.sqlite.org/copyright.html
+
+   Written by Richard W.M. Jones <rjones.at.redhat.com>
+
+   Copyright (C) 2008 Free Software Foundation, Inc.
+
+   This library is free software; you can redistribute it and/or
+   modify it under the terms of the GNU Lesser General Public
+   License as published by the Free Software Foundation; either
+   version 2.1 of the License, or (at your option) any later version.
+
+   This library is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#include <config.h>
+#include <sys/file.h>
+
+#if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
+
+/* _get_osfhandle */
+#include <io.h>
+
+/* LockFileEx */
+#define WIN32_LEAN_AND_MEAN
+#include <windows.h>
+
+#include <errno.h>
+
+/* Determine the current size of a file.  Because the other braindead
+ * APIs we'll call need lower/upper 32 bit pairs, keep the file size
+ * like that too.
+ */
+static BOOL
+file_size (HANDLE h, DWORD * lower, DWORD * upper)
+{
+  *lower = GetFileSize (h, upper);
+  return 1;
+}
+
+/* LOCKFILE_FAIL_IMMEDIATELY is undefined on some Windows systems. */
+#ifndef LOCKFILE_FAIL_IMMEDIATELY
+# define LOCKFILE_FAIL_IMMEDIATELY 1
+#endif
+
+/* Acquire a lock. */
+static BOOL
+do_lock (HANDLE h, int non_blocking, int exclusive)
+{
+  BOOL res;
+  DWORD size_lower, size_upper;
+  OVERLAPPED ovlp;
+  int flags = 0;
+
+  /* We're going to lock the whole file, so get the file size. */
+  res = file_size (h, &size_lower, &size_upper);
+  if (!res)
+    return 0;
+
+  /* Start offset is 0, and also zero the remaining members of this struct. */
+  memset (&ovlp, 0, sizeof ovlp);
+
+  if (non_blocking)
+    flags |= LOCKFILE_FAIL_IMMEDIATELY;
+  if (exclusive)
+    flags |= LOCKFILE_EXCLUSIVE_LOCK;
+
+  return LockFileEx (h, flags, 0, size_lower, size_upper, &ovlp);
+}
+
+/* Unlock reader or exclusive lock. */
+static BOOL
+do_unlock (HANDLE h)
+{
+  int res;
+  DWORD size_lower, size_upper;
+
+  res = file_size (h, &size_lower, &size_upper);
+  if (!res)
+    return 0;
+
+  return UnlockFile (h, 0, 0, size_lower, size_upper);
+}
+
+/* Now our BSD-like flock operation. */
+int
+flock (int fd, int operation)
+{
+  HANDLE h = (HANDLE) _get_osfhandle (fd);
+  DWORD res;
+  int non_blocking;
+
+  if (h == INVALID_HANDLE_VALUE)
+    {
+      errno = EBADF;
+      return -1;
+    }
+
+  non_blocking = operation & LOCK_NB;
+  operation &= ~LOCK_NB;
+
+  switch (operation)
+    {
+    case LOCK_SH:
+      res = do_lock (h, non_blocking, 0);
+      break;
+    case LOCK_EX:
+      res = do_lock (h, non_blocking, 1);
+      break;
+    case LOCK_UN:
+      res = do_unlock (h);
+      break;
+    default:
+      errno = EINVAL;
+      return -1;
+    }
+
+  /* Map Windows errors into Unix errnos.  As usual MSDN fails to
+   * document the permissible error codes.
+   */
+  if (!res)
+    {
+      DWORD err = GetLastError ();
+      switch (err)
+	{
+	  /* This means someone else is holding a lock. */
+	case ERROR_LOCK_VIOLATION:
+	  errno = EAGAIN;
+	  break;
+
+	  /* Out of memory. */
+	case ERROR_NOT_ENOUGH_MEMORY:
+	  errno = ENOMEM;
+	  break;
+
+	case ERROR_BAD_COMMAND:
+	  errno = EINVAL;
+	  break;
+
+	  /* Unlikely to be other errors, but at least don't lose the
+	   * error code.
+	   */
+	default:
+	  errno = err;
+	}
+
+      return -1;
+    }
+
+  return 0;
+}
+
+#else /* !Windows */
+
+#ifdef HAVE_STRUCT_FLOCK_L_TYPE
+/* We know how to implement flock in terms of fcntl. */
+
+#ifdef HAVE_FCNTL_H
+#include <fcntl.h>
+#endif
+
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+
+#include <errno.h>
+#include <string.h>
+
+int
+flock (int fd, int operation)
+{
+  int cmd, r;
+  struct flock fl;
+
+  if (operation & LOCK_NB)
+    cmd = F_SETLK;
+  else
+    cmd = F_SETLKW;
+  operation &= ~LOCK_NB;
+
+  memset (&fl, 0, sizeof fl);
+  fl.l_whence = SEEK_SET;
+  /* l_start & l_len are 0, which as a special case means "whole file". */
+
+  switch (operation)
+    {
+    case LOCK_SH:
+      fl.l_type = F_RDLCK;
+      break;
+    case LOCK_EX:
+      fl.l_type = F_WRLCK;
+      break;
+    case LOCK_UN:
+      fl.l_type = F_UNLCK;
+      break;
+    default:
+      errno = EINVAL;
+      return -1;
+    }
+
+  r = fcntl (fd, cmd, &fl);
+  if (r == -1 && errno == EACCES)
+    errno = EAGAIN;
+
+  return r;
+}
+
+#else /* !HAVE_STRUCT_FLOCK_L_TYPE */
+
+#error "This platform lacks flock function, and Gnulib doesn't provide a replacement. This is a bug in Gnulib."
+
+#endif /* !HAVE_STRUCT_FLOCK_L_TYPE */
+
+#endif /* !Windows */
diff --git a/lib/getpagesize.c b/lib/getpagesize.c
new file mode 100644
index 000000000..82238df19
--- /dev/null
+++ b/lib/getpagesize.c
@@ -0,0 +1,39 @@
+/* getpagesize emulation for systems where it cannot be done in a C macro.
+
+   Copyright (C) 2007 Free Software Foundation, Inc.
+
+   This program is free software: you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+/* Written by Bruno Haible and Martin Lambers.  */
+
+#include <config.h>
+
+/* Specification. */
+#include <unistd.h>
+
+/* This implementation is only for native Win32 systems.  */
+#if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
+
+# define WIN32_LEAN_AND_MEAN
+# include <windows.h>
+
+int
+getpagesize (void)
+{
+  SYSTEM_INFO system_info;
+  GetSystemInfo (&system_info);
+  return system_info.dwPageSize;
+}
+
+#endif
diff --git a/lib/iconv.c b/lib/iconv.c
new file mode 100644
index 000000000..56a84c456
--- /dev/null
+++ b/lib/iconv.c
@@ -0,0 +1,450 @@
+/* Character set conversion.
+   Copyright (C) 1999-2001, 2007 Free Software Foundation, Inc.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 2, or (at your option)
+   any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License along
+   with this program; if not, write to the Free Software Foundation,
+   Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+#include <config.h>
+
+/* Specification.  */
+#include <iconv.h>
+
+#include <stddef.h>
+
+#if REPLACE_ICONV_UTF
+# include <errno.h>
+# include <stdint.h>
+# include <stdlib.h>
+# include "unistr.h"
+# ifndef uintptr_t
+#  define uintptr_t unsigned long
+# endif
+#endif
+
+#if REPLACE_ICONV_UTF
+
+/* UTF-{16,32}{BE,LE} converters taken from GNU libiconv 1.11.  */
+
+/* Return code if invalid. (xxx_mbtowc) */
+# define RET_ILSEQ      -1
+/* Return code if no bytes were read. (xxx_mbtowc) */
+# define RET_TOOFEW     -2
+
+/* Return code if invalid. (xxx_wctomb) */
+# define RET_ILUNI      -1
+/* Return code if output buffer is too small. (xxx_wctomb, xxx_reset) */
+# define RET_TOOSMALL   -2
+
+/*
+ * UTF-16BE
+ */
+
+/* Specification: RFC 2781 */
+
+static int
+utf16be_mbtowc (ucs4_t *pwc, const unsigned char *s, size_t n)
+{
+  if (n >= 2)
+    {
+      ucs4_t wc = (s[0] << 8) + s[1];
+      if (wc >= 0xd800 && wc < 0xdc00)
+	{
+	  if (n >= 4)
+	    {
+	      ucs4_t wc2 = (s[2] << 8) + s[3];
+	      if (!(wc2 >= 0xdc00 && wc2 < 0xe000))
+		return RET_ILSEQ;
+	      *pwc = 0x10000 + ((wc - 0xd800) << 10) + (wc2 - 0xdc00);
+	      return 4;
+	    }
+	}
+      else if (wc >= 0xdc00 && wc < 0xe000)
+	{
+	  return RET_ILSEQ;
+	}
+      else
+	{
+	  *pwc = wc;
+	  return 2;
+	}
+    }
+  return RET_TOOFEW;
+}
+
+static int
+utf16be_wctomb (unsigned char *r, ucs4_t wc, size_t n)
+{
+  if (!(wc >= 0xd800 && wc < 0xe000))
+    {
+      if (wc < 0x10000)
+	{
+	  if (n >= 2)
+	    {
+	      r[0] = (unsigned char) (wc >> 8);
+	      r[1] = (unsigned char) wc;
+	      return 2;
+	    }
+	  else
+	    return RET_TOOSMALL;
+	}
+      else if (wc < 0x110000)
+	{
+	  if (n >= 4)
+	    {
+	      ucs4_t wc1 = 0xd800 + ((wc - 0x10000) >> 10);
+	      ucs4_t wc2 = 0xdc00 + ((wc - 0x10000) & 0x3ff);
+	      r[0] = (unsigned char) (wc1 >> 8);
+	      r[1] = (unsigned char) wc1;
+	      r[2] = (unsigned char) (wc2 >> 8);
+	      r[3] = (unsigned char) wc2;
+	      return 4;
+	    }
+	  else
+	    return RET_TOOSMALL;
+	}
+    }
+  return RET_ILUNI;
+}
+
+/*
+ * UTF-16LE
+ */
+
+/* Specification: RFC 2781 */
+
+static int
+utf16le_mbtowc (ucs4_t *pwc, const unsigned char *s, size_t n)
+{
+  if (n >= 2)
+    {
+      ucs4_t wc = s[0] + (s[1] << 8);
+      if (wc >= 0xd800 && wc < 0xdc00)
+	{
+	  if (n >= 4)
+	    {
+	      ucs4_t wc2 = s[2] + (s[3] << 8);
+	      if (!(wc2 >= 0xdc00 && wc2 < 0xe000))
+		return RET_ILSEQ;
+	      *pwc = 0x10000 + ((wc - 0xd800) << 10) + (wc2 - 0xdc00);
+	      return 4;
+	    }
+	}
+      else if (wc >= 0xdc00 && wc < 0xe000)
+	{
+	  return RET_ILSEQ;
+	}
+      else
+	{
+	  *pwc = wc;
+	  return 2;
+	}
+    }
+  return RET_TOOFEW;
+}
+
+static int
+utf16le_wctomb (unsigned char *r, ucs4_t wc, size_t n)
+{
+  if (!(wc >= 0xd800 && wc < 0xe000))
+    {
+      if (wc < 0x10000)
+	{
+	  if (n >= 2)
+	    {
+	      r[0] = (unsigned char) wc;
+	      r[1] = (unsigned char) (wc >> 8);
+	      return 2;
+	    }
+	  else
+	    return RET_TOOSMALL;
+	}
+      else if (wc < 0x110000)
+	{
+	  if (n >= 4)
+	    {
+	      ucs4_t wc1 = 0xd800 + ((wc - 0x10000) >> 10);
+	      ucs4_t wc2 = 0xdc00 + ((wc - 0x10000) & 0x3ff);
+	      r[0] = (unsigned char) wc1;
+	      r[1] = (unsigned char) (wc1 >> 8);
+	      r[2] = (unsigned char) wc2;
+	      r[3] = (unsigned char) (wc2 >> 8);
+	      return 4;
+	    }
+	  else
+	    return RET_TOOSMALL;
+	}
+    }
+  return RET_ILUNI;
+}
+
+/*
+ * UTF-32BE
+ */
+
+/* Specification: Unicode 3.1 Standard Annex #19 */
+
+static int
+utf32be_mbtowc (ucs4_t *pwc, const unsigned char *s, size_t n)
+{
+  if (n >= 4)
+    {
+      ucs4_t wc = (s[0] << 24) + (s[1] << 16) + (s[2] << 8) + s[3];
+      if (wc < 0x110000 && !(wc >= 0xd800 && wc < 0xe000))
+	{
+	  *pwc = wc;
+	  return 4;
+	}
+      else
+	return RET_ILSEQ;
+    }
+  return RET_TOOFEW;
+}
+
+static int
+utf32be_wctomb (unsigned char *r, ucs4_t wc, size_t n)
+{
+  if (wc < 0x110000 && !(wc >= 0xd800 && wc < 0xe000))
+    {
+      if (n >= 4)
+	{
+	  r[0] = 0;
+	  r[1] = (unsigned char) (wc >> 16);
+	  r[2] = (unsigned char) (wc >> 8);
+	  r[3] = (unsigned char) wc;
+	  return 4;
+	}
+      else
+	return RET_TOOSMALL;
+    }
+  return RET_ILUNI;
+}
+
+/*
+ * UTF-32LE
+ */
+
+/* Specification: Unicode 3.1 Standard Annex #19 */
+
+static int
+utf32le_mbtowc (ucs4_t *pwc, const unsigned char *s, size_t n)
+{
+  if (n >= 4)
+    {
+      ucs4_t wc = s[0] + (s[1] << 8) + (s[2] << 16) + (s[3] << 24);
+      if (wc < 0x110000 && !(wc >= 0xd800 && wc < 0xe000))
+	{
+	  *pwc = wc;
+	  return 4;
+	}
+      else
+	return RET_ILSEQ;
+    }
+  return RET_TOOFEW;
+}
+
+static int
+utf32le_wctomb (unsigned char *r, ucs4_t wc, size_t n)
+{
+  if (wc < 0x110000 && !(wc >= 0xd800 && wc < 0xe000))
+    {
+      if (n >= 4)
+	{
+	  r[0] = (unsigned char) wc;
+	  r[1] = (unsigned char) (wc >> 8);
+	  r[2] = (unsigned char) (wc >> 16);
+	  r[3] = 0;
+	  return 4;
+        }
+      else
+	return RET_TOOSMALL;
+    }
+  return RET_ILUNI;
+}
+
+#endif
+
+size_t
+rpl_iconv (iconv_t cd,
+	   ICONV_CONST char **inbuf, size_t *inbytesleft,
+	   char **outbuf, size_t *outbytesleft)
+#undef iconv
+{
+#if REPLACE_ICONV_UTF
+  switch ((uintptr_t) cd)
+    {
+      {
+	int (*xxx_wctomb) (unsigned char *, ucs4_t, size_t);
+
+	case (uintptr_t) _ICONV_UTF8_UTF16BE:
+	  xxx_wctomb = utf16be_wctomb;
+	  goto loop_from_utf8;
+	case (uintptr_t) _ICONV_UTF8_UTF16LE:
+	  xxx_wctomb = utf16le_wctomb;
+	  goto loop_from_utf8;
+	case (uintptr_t) _ICONV_UTF8_UTF32BE:
+	  xxx_wctomb = utf32be_wctomb;
+	  goto loop_from_utf8;
+	case (uintptr_t) _ICONV_UTF8_UTF32LE:
+	  xxx_wctomb = utf32le_wctomb;
+	  goto loop_from_utf8;
+
+       loop_from_utf8:
+	if (inbuf == NULL || *inbuf == NULL)
+	  return 0;
+	{
+	  ICONV_CONST char *inptr = *inbuf;
+	  size_t inleft = *inbytesleft;
+	  char *outptr = *outbuf;
+	  size_t outleft = *outbytesleft;
+	  size_t res = 0;
+	  while (inleft > 0)
+	    {
+	      ucs4_t uc;
+	      int m = u8_mbtoucr (&uc, (const uint8_t *) inptr, inleft);
+	      if (m <= 0)
+		{
+		  if (m == -1)
+		    {
+		      errno = EILSEQ;
+		      res = (size_t)(-1);
+		      break;
+		    }
+		  if (m == -2)
+		    {
+		      errno = EINVAL;
+		      res = (size_t)(-1);
+		      break;
+		    }
+		  abort ();
+		}
+	      else
+		{
+		  int n = xxx_wctomb ((uint8_t *) outptr, uc, outleft);
+		  if (n < 0)
+		    {
+		      if (n == RET_ILUNI)
+			{
+			  errno = EILSEQ;
+			  res = (size_t)(-1);
+			  break;
+			}
+		      if (n == RET_TOOSMALL)
+			{
+			  errno = E2BIG;
+			  res = (size_t)(-1);
+			  break;
+			}
+		      abort ();
+		    }
+		  else
+		    {
+		      inptr += m;
+		      inleft -= m;
+		      outptr += n;
+		      outleft -= n;
+		    }
+		}
+	    }
+	  *inbuf = inptr;
+	  *inbytesleft = inleft;
+	  *outbuf = outptr;
+	  *outbytesleft = outleft;
+	  return res;
+	}
+      }
+
+      {
+	int (*xxx_mbtowc) (ucs4_t *, const unsigned char *, size_t);
+
+	case (uintptr_t) _ICONV_UTF16BE_UTF8:
+	  xxx_mbtowc = utf16be_mbtowc;
+	  goto loop_to_utf8;
+	case (uintptr_t) _ICONV_UTF16LE_UTF8:
+	  xxx_mbtowc = utf16le_mbtowc;
+	  goto loop_to_utf8;
+	case (uintptr_t) _ICONV_UTF32BE_UTF8:
+	  xxx_mbtowc = utf32be_mbtowc;
+	  goto loop_to_utf8;
+	case (uintptr_t) _ICONV_UTF32LE_UTF8:
+	  xxx_mbtowc = utf32le_mbtowc;
+	  goto loop_to_utf8;
+
+       loop_to_utf8:
+	if (inbuf == NULL || *inbuf == NULL)
+	  return 0;
+	{
+	  ICONV_CONST char *inptr = *inbuf;
+	  size_t inleft = *inbytesleft;
+	  char *outptr = *outbuf;
+	  size_t outleft = *outbytesleft;
+	  size_t res = 0;
+	  while (inleft > 0)
+	    {
+	      ucs4_t uc;
+	      int m = xxx_mbtowc (&uc, (const uint8_t *) inptr, inleft);
+	      if (m <= 0)
+		{
+		  if (m == RET_ILSEQ)
+		    {
+		      errno = EILSEQ;
+		      res = (size_t)(-1);
+		      break;
+		    }
+		  if (m == RET_TOOFEW)
+		    {
+		      errno = EINVAL;
+		      res = (size_t)(-1);
+		      break;
+		    }
+		  abort ();
+		}
+	      else
+		{
+		  int n = u8_uctomb ((uint8_t *) outptr, uc, outleft);
+		  if (n < 0)
+		    {
+		      if (n == -1)
+			{
+			  errno = EILSEQ;
+			  res = (size_t)(-1);
+			  break;
+			}
+		      if (n == -2)
+			{
+			  errno = E2BIG;
+			  res = (size_t)(-1);
+			  break;
+			}
+		      abort ();
+		    }
+		  else
+		    {
+		      inptr += m;
+		      inleft -= m;
+		      outptr += n;
+		      outleft -= n;
+		    }
+		}
+	    }
+	  *inbuf = inptr;
+	  *inbytesleft = inleft;
+	  *outbuf = outptr;
+	  *outbytesleft = outleft;
+	  return res;
+	}
+      }
+    }
+#endif
+  return iconv (cd, inbuf, inbytesleft, outbuf, outbytesleft);
+}
diff --git a/lib/iconv.in.h b/lib/iconv.in.h
new file mode 100644
index 000000000..915dce2e7
--- /dev/null
+++ b/lib/iconv.in.h
@@ -0,0 +1,71 @@
+/* A GNU-like <iconv.h>.
+
+   Copyright (C) 2007-2008 Free Software Foundation, Inc.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 2, or (at your option)
+   any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program; if not, write to the Free Software Foundation,
+   Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+#ifndef _GL_ICONV_H
+
+#if __GNUC__ >= 3
+@PRAGMA_SYSTEM_HEADER@
+#endif
+
+/* The include_next requires a split double-inclusion guard.  */
+#@INCLUDE_NEXT@ @NEXT_ICONV_H@
+
+#ifndef _GL_ICONV_H
+#define _GL_ICONV_H
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
+#if @REPLACE_ICONV_OPEN@
+/* An iconv_open wrapper that supports the IANA standardized encoding names
+   ("ISO-8859-1" etc.) as far as possible.  */
+# define iconv_open rpl_iconv_open
+extern iconv_t iconv_open (const char *tocode, const char *fromcode);
+#endif
+
+#if @REPLACE_ICONV_UTF@
+/* Special constants for supporting UTF-{16,32}{BE,LE} encodings.
+   Not public.  */
+# define _ICONV_UTF8_UTF16BE (iconv_t)(-161)
+# define _ICONV_UTF8_UTF16LE (iconv_t)(-162)
+# define _ICONV_UTF8_UTF32BE (iconv_t)(-163)
+# define _ICONV_UTF8_UTF32LE (iconv_t)(-164)
+# define _ICONV_UTF16BE_UTF8 (iconv_t)(-165)
+# define _ICONV_UTF16LE_UTF8 (iconv_t)(-166)
+# define _ICONV_UTF32BE_UTF8 (iconv_t)(-167)
+# define _ICONV_UTF32LE_UTF8 (iconv_t)(-168)
+#endif
+
+#if @REPLACE_ICONV@
+# define iconv rpl_iconv
+extern size_t iconv (iconv_t cd,
+		     @ICONV_CONST@ char **inbuf, size_t *inbytesleft,
+		     char **outbuf, size_t *outbytesleft);
+# define iconv_close rpl_iconv_close
+extern int iconv_close (iconv_t cd);
+#endif
+
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* _GL_ICONV_H */
+#endif /* _GL_ICONV_H */
diff --git a/lib/iconv_close.c b/lib/iconv_close.c
new file mode 100644
index 000000000..3680412a0
--- /dev/null
+++ b/lib/iconv_close.c
@@ -0,0 +1,47 @@
+/* Character set conversion.
+   Copyright (C) 2007 Free Software Foundation, Inc.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 2, or (at your option)
+   any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License along
+   with this program; if not, write to the Free Software Foundation,
+   Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+#include <config.h>
+
+/* Specification.  */
+#include <iconv.h>
+
+#include <stdint.h>
+#ifndef uintptr_t
+# define uintptr_t unsigned long
+#endif
+
+int
+rpl_iconv_close (iconv_t cd)
+#undef iconv_close
+{
+#if REPLACE_ICONV_UTF
+  switch ((uintptr_t) cd)
+    {
+    case (uintptr_t) _ICONV_UTF8_UTF16BE:
+    case (uintptr_t) _ICONV_UTF8_UTF16LE:
+    case (uintptr_t) _ICONV_UTF8_UTF32BE:
+    case (uintptr_t) _ICONV_UTF8_UTF32LE:
+    case (uintptr_t) _ICONV_UTF16BE_UTF8:
+    case (uintptr_t) _ICONV_UTF16LE_UTF8:
+    case (uintptr_t) _ICONV_UTF32BE_UTF8:
+    case (uintptr_t) _ICONV_UTF32LE_UTF8:
+      return 0;
+    }
+#endif
+  return iconv_close (cd);
+}
diff --git a/lib/iconv_open-aix.gperf b/lib/iconv_open-aix.gperf
new file mode 100644
index 000000000..6782b9956
--- /dev/null
+++ b/lib/iconv_open-aix.gperf
@@ -0,0 +1,44 @@
+struct mapping { int standard_name; const char vendor_name[10 + 1]; };
+%struct-type
+%language=ANSI-C
+%define slot-name standard_name
+%define hash-function-name mapping_hash
+%define lookup-function-name mapping_lookup
+%readonly-tables
+%global-table
+%define word-array-name mappings
+%pic
+%%
+# On AIX 5.1, look in /usr/lib/nls/loc/uconvTable.
+ISO-8859-1, "ISO8859-1"
+ISO-8859-2, "ISO8859-2"
+ISO-8859-3, "ISO8859-3"
+ISO-8859-4, "ISO8859-4"
+ISO-8859-5, "ISO8859-5"
+ISO-8859-6, "ISO8859-6"
+ISO-8859-7, "ISO8859-7"
+ISO-8859-8, "ISO8859-8"
+ISO-8859-9, "ISO8859-9"
+ISO-8859-15, "ISO8859-15"
+CP437, "IBM-437"
+CP850, "IBM-850"
+CP852, "IBM-852"
+CP856, "IBM-856"
+CP857, "IBM-857"
+CP861, "IBM-861"
+CP865, "IBM-865"
+CP869, "IBM-869"
+ISO-8859-13, "IBM-921"
+CP922, "IBM-922"
+CP932, "IBM-932"
+CP943, "IBM-943"
+CP1046, "IBM-1046"
+CP1124, "IBM-1124"
+CP1125, "IBM-1125"
+CP1129, "IBM-1129"
+CP1252, "IBM-1252"
+GB2312, "IBM-eucCN"
+EUC-JP, "IBM-eucJP"
+EUC-KR, "IBM-eucKR"
+EUC-TW, "IBM-eucTW"
+BIG5, "big5"
diff --git a/lib/iconv_open-aix.h b/lib/iconv_open-aix.h
new file mode 100644
index 000000000..0ffc3fef1
--- /dev/null
+++ b/lib/iconv_open-aix.h
@@ -0,0 +1,256 @@
+/* ANSI-C code produced by gperf version 3.0.3 */
+/* Command-line: gperf -m 10 ./iconv_open-aix.gperf  */
+/* Computed positions: -k'4,$' */
+
+#if !((' ' == 32) && ('!' == 33) && ('"' == 34) && ('#' == 35) \
+      && ('%' == 37) && ('&' == 38) && ('\'' == 39) && ('(' == 40) \
+      && (')' == 41) && ('*' == 42) && ('+' == 43) && (',' == 44) \
+      && ('-' == 45) && ('.' == 46) && ('/' == 47) && ('0' == 48) \
+      && ('1' == 49) && ('2' == 50) && ('3' == 51) && ('4' == 52) \
+      && ('5' == 53) && ('6' == 54) && ('7' == 55) && ('8' == 56) \
+      && ('9' == 57) && (':' == 58) && (';' == 59) && ('<' == 60) \
+      && ('=' == 61) && ('>' == 62) && ('?' == 63) && ('A' == 65) \
+      && ('B' == 66) && ('C' == 67) && ('D' == 68) && ('E' == 69) \
+      && ('F' == 70) && ('G' == 71) && ('H' == 72) && ('I' == 73) \
+      && ('J' == 74) && ('K' == 75) && ('L' == 76) && ('M' == 77) \
+      && ('N' == 78) && ('O' == 79) && ('P' == 80) && ('Q' == 81) \
+      && ('R' == 82) && ('S' == 83) && ('T' == 84) && ('U' == 85) \
+      && ('V' == 86) && ('W' == 87) && ('X' == 88) && ('Y' == 89) \
+      && ('Z' == 90) && ('[' == 91) && ('\\' == 92) && (']' == 93) \
+      && ('^' == 94) && ('_' == 95) && ('a' == 97) && ('b' == 98) \
+      && ('c' == 99) && ('d' == 100) && ('e' == 101) && ('f' == 102) \
+      && ('g' == 103) && ('h' == 104) && ('i' == 105) && ('j' == 106) \
+      && ('k' == 107) && ('l' == 108) && ('m' == 109) && ('n' == 110) \
+      && ('o' == 111) && ('p' == 112) && ('q' == 113) && ('r' == 114) \
+      && ('s' == 115) && ('t' == 116) && ('u' == 117) && ('v' == 118) \
+      && ('w' == 119) && ('x' == 120) && ('y' == 121) && ('z' == 122) \
+      && ('{' == 123) && ('|' == 124) && ('}' == 125) && ('~' == 126))
+/* The character set is not based on ISO-646.  */
+#error "gperf generated tables don't work with this execution character set. Please report a bug to <bug-gnu-gperf@gnu.org>."
+#endif
+
+#line 1 "./iconv_open-aix.gperf"
+struct mapping { int standard_name; const char vendor_name[10 + 1]; };
+
+#define TOTAL_KEYWORDS 32
+#define MIN_WORD_LENGTH 4
+#define MAX_WORD_LENGTH 11
+#define MIN_HASH_VALUE 6
+#define MAX_HASH_VALUE 44
+/* maximum key range = 39, duplicates = 0 */
+
+#ifdef __GNUC__
+__inline
+#else
+#ifdef __cplusplus
+inline
+#endif
+#endif
+static unsigned int
+mapping_hash (register const char *str, register unsigned int len)
+{
+  static const unsigned char asso_values[] =
+    {
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45,  0,  4, 25,
+       0, 11, 24,  9, 17,  3, 14, 21, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+       3, 45,  1, 45, 45, 45, 45,  0, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+      45, 45, 45, 45, 45, 45, 45, 45
+    };
+  return len + asso_values[(unsigned char)str[3]+2] + asso_values[(unsigned char)str[len - 1]];
+}
+
+struct stringpool_t
+  {
+    char stringpool_str6[sizeof("EUC-TW")];
+    char stringpool_str7[sizeof("EUC-KR")];
+    char stringpool_str8[sizeof("CP852")];
+    char stringpool_str9[sizeof("EUC-JP")];
+    char stringpool_str10[sizeof("ISO-8859-2")];
+    char stringpool_str11[sizeof("CP857")];
+    char stringpool_str12[sizeof("CP850")];
+    char stringpool_str13[sizeof("ISO-8859-7")];
+    char stringpool_str14[sizeof("CP932")];
+    char stringpool_str15[sizeof("GB2312")];
+    char stringpool_str16[sizeof("BIG5")];
+    char stringpool_str17[sizeof("CP437")];
+    char stringpool_str19[sizeof("ISO-8859-5")];
+    char stringpool_str20[sizeof("ISO-8859-15")];
+    char stringpool_str21[sizeof("ISO-8859-3")];
+    char stringpool_str22[sizeof("ISO-8859-13")];
+    char stringpool_str23[sizeof("CP1046")];
+    char stringpool_str24[sizeof("ISO-8859-8")];
+    char stringpool_str25[sizeof("CP856")];
+    char stringpool_str26[sizeof("CP1125")];
+    char stringpool_str27[sizeof("ISO-8859-6")];
+    char stringpool_str28[sizeof("CP865")];
+    char stringpool_str29[sizeof("CP922")];
+    char stringpool_str30[sizeof("CP1252")];
+    char stringpool_str31[sizeof("ISO-8859-9")];
+    char stringpool_str33[sizeof("CP943")];
+    char stringpool_str34[sizeof("ISO-8859-4")];
+    char stringpool_str35[sizeof("ISO-8859-1")];
+    char stringpool_str38[sizeof("CP1129")];
+    char stringpool_str40[sizeof("CP869")];
+    char stringpool_str41[sizeof("CP1124")];
+    char stringpool_str44[sizeof("CP861")];
+  };
+static const struct stringpool_t stringpool_contents =
+  {
+    "EUC-TW",
+    "EUC-KR",
+    "CP852",
+    "EUC-JP",
+    "ISO-8859-2",
+    "CP857",
+    "CP850",
+    "ISO-8859-7",
+    "CP932",
+    "GB2312",
+    "BIG5",
+    "CP437",
+    "ISO-8859-5",
+    "ISO-8859-15",
+    "ISO-8859-3",
+    "ISO-8859-13",
+    "CP1046",
+    "ISO-8859-8",
+    "CP856",
+    "CP1125",
+    "ISO-8859-6",
+    "CP865",
+    "CP922",
+    "CP1252",
+    "ISO-8859-9",
+    "CP943",
+    "ISO-8859-4",
+    "ISO-8859-1",
+    "CP1129",
+    "CP869",
+    "CP1124",
+    "CP861"
+  };
+#define stringpool ((const char *) &stringpool_contents)
+
+static const struct mapping mappings[] =
+  {
+    {-1}, {-1}, {-1}, {-1}, {-1}, {-1},
+#line 43 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str6, "IBM-eucTW"},
+#line 42 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str7, "IBM-eucKR"},
+#line 25 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str8, "IBM-852"},
+#line 41 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str9, "IBM-eucJP"},
+#line 14 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str10, "ISO8859-2"},
+#line 27 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str11, "IBM-857"},
+#line 24 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str12, "IBM-850"},
+#line 19 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str13, "ISO8859-7"},
+#line 33 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str14, "IBM-932"},
+#line 40 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str15, "IBM-eucCN"},
+#line 44 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str16, "big5"},
+#line 23 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str17, "IBM-437"},
+    {-1},
+#line 17 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str19, "ISO8859-5"},
+#line 22 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str20, "ISO8859-15"},
+#line 15 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str21, "ISO8859-3"},
+#line 31 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str22, "IBM-921"},
+#line 35 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str23, "IBM-1046"},
+#line 20 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str24, "ISO8859-8"},
+#line 26 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str25, "IBM-856"},
+#line 37 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str26, "IBM-1125"},
+#line 18 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str27, "ISO8859-6"},
+#line 29 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str28, "IBM-865"},
+#line 32 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str29, "IBM-922"},
+#line 39 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str30, "IBM-1252"},
+#line 21 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str31, "ISO8859-9"},
+    {-1},
+#line 34 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str33, "IBM-943"},
+#line 16 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str34, "ISO8859-4"},
+#line 13 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str35, "ISO8859-1"},
+    {-1}, {-1},
+#line 38 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str38, "IBM-1129"},
+    {-1},
+#line 30 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str40, "IBM-869"},
+#line 36 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str41, "IBM-1124"},
+    {-1}, {-1},
+#line 28 "./iconv_open-aix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str44, "IBM-861"}
+  };
+
+#ifdef __GNUC__
+__inline
+#ifdef __GNUC_STDC_INLINE__
+__attribute__ ((__gnu_inline__))
+#endif
+#endif
+const struct mapping *
+mapping_lookup (register const char *str, register unsigned int len)
+{
+  if (len <= MAX_WORD_LENGTH && len >= MIN_WORD_LENGTH)
+    {
+      register int key = mapping_hash (str, len);
+
+      if (key <= MAX_HASH_VALUE && key >= 0)
+        {
+          register int o = mappings[key].standard_name;
+          if (o >= 0)
+            {
+              register const char *s = o + stringpool;
+
+              if (*str == *s && !strcmp (str + 1, s + 1))
+                return &mappings[key];
+            }
+        }
+    }
+  return 0;
+}
diff --git a/lib/iconv_open-hpux.gperf b/lib/iconv_open-hpux.gperf
new file mode 100644
index 000000000..5a35c83e1
--- /dev/null
+++ b/lib/iconv_open-hpux.gperf
@@ -0,0 +1,56 @@
+struct mapping { int standard_name; const char vendor_name[9 + 1]; };
+%struct-type
+%language=ANSI-C
+%define slot-name standard_name
+%define hash-function-name mapping_hash
+%define lookup-function-name mapping_lookup
+%readonly-tables
+%global-table
+%define word-array-name mappings
+%pic
+%%
+# On HP-UX 11.11, look in /usr/lib/nls/iconv.
+ISO-8859-1, "iso88591"
+ISO-8859-2, "iso88592"
+ISO-8859-5, "iso88595"
+ISO-8859-6, "iso88596"
+ISO-8859-7, "iso88597"
+ISO-8859-8, "iso88598"
+ISO-8859-9, "iso88599"
+ISO-8859-15, "iso885915"
+CP437, "cp437"
+CP775, "cp775"
+CP850, "cp850"
+CP852, "cp852"
+CP855, "cp855"
+CP857, "cp857"
+CP861, "cp861"
+CP862, "cp862"
+CP864, "cp864"
+CP865, "cp865"
+CP866, "cp866"
+CP869, "cp869"
+CP874, "cp874"
+CP1250, "cp1250"
+CP1251, "cp1251"
+CP1252, "cp1252"
+CP1253, "cp1253"
+CP1254, "cp1254"
+CP1255, "cp1255"
+CP1256, "cp1256"
+CP1257, "cp1257"
+CP1258, "cp1258"
+HP-ROMAN8, "roman8"
+HP-ARABIC8, "arabic8"
+HP-GREEK8, "greek8"
+HP-HEBREW8, "hebrew8"
+HP-TURKISH8, "turkish8"
+HP-KANA8, "kana8"
+TIS-620, "tis620"
+GB2312, "hp15CN"
+EUC-JP, "eucJP"
+EUC-KR, "eucKR"
+EUC-TW, "eucTW"
+BIG5, "big5"
+SHIFT_JIS, "sjis"
+UTF-8, "utf8"
diff --git a/lib/iconv_open-hpux.h b/lib/iconv_open-hpux.h
new file mode 100644
index 000000000..8f9f0a9ad
--- /dev/null
+++ b/lib/iconv_open-hpux.h
@@ -0,0 +1,299 @@
+/* ANSI-C code produced by gperf version 3.0.3 */
+/* Command-line: gperf -m 10 ./iconv_open-hpux.gperf  */
+/* Computed positions: -k'4,$' */
+
+#if !((' ' == 32) && ('!' == 33) && ('"' == 34) && ('#' == 35) \
+      && ('%' == 37) && ('&' == 38) && ('\'' == 39) && ('(' == 40) \
+      && (')' == 41) && ('*' == 42) && ('+' == 43) && (',' == 44) \
+      && ('-' == 45) && ('.' == 46) && ('/' == 47) && ('0' == 48) \
+      && ('1' == 49) && ('2' == 50) && ('3' == 51) && ('4' == 52) \
+      && ('5' == 53) && ('6' == 54) && ('7' == 55) && ('8' == 56) \
+      && ('9' == 57) && (':' == 58) && (';' == 59) && ('<' == 60) \
+      && ('=' == 61) && ('>' == 62) && ('?' == 63) && ('A' == 65) \
+      && ('B' == 66) && ('C' == 67) && ('D' == 68) && ('E' == 69) \
+      && ('F' == 70) && ('G' == 71) && ('H' == 72) && ('I' == 73) \
+      && ('J' == 74) && ('K' == 75) && ('L' == 76) && ('M' == 77) \
+      && ('N' == 78) && ('O' == 79) && ('P' == 80) && ('Q' == 81) \
+      && ('R' == 82) && ('S' == 83) && ('T' == 84) && ('U' == 85) \
+      && ('V' == 86) && ('W' == 87) && ('X' == 88) && ('Y' == 89) \
+      && ('Z' == 90) && ('[' == 91) && ('\\' == 92) && (']' == 93) \
+      && ('^' == 94) && ('_' == 95) && ('a' == 97) && ('b' == 98) \
+      && ('c' == 99) && ('d' == 100) && ('e' == 101) && ('f' == 102) \
+      && ('g' == 103) && ('h' == 104) && ('i' == 105) && ('j' == 106) \
+      && ('k' == 107) && ('l' == 108) && ('m' == 109) && ('n' == 110) \
+      && ('o' == 111) && ('p' == 112) && ('q' == 113) && ('r' == 114) \
+      && ('s' == 115) && ('t' == 116) && ('u' == 117) && ('v' == 118) \
+      && ('w' == 119) && ('x' == 120) && ('y' == 121) && ('z' == 122) \
+      && ('{' == 123) && ('|' == 124) && ('}' == 125) && ('~' == 126))
+/* The character set is not based on ISO-646.  */
+#error "gperf generated tables don't work with this execution character set. Please report a bug to <bug-gnu-gperf@gnu.org>."
+#endif
+
+#line 1 "./iconv_open-hpux.gperf"
+struct mapping { int standard_name; const char vendor_name[9 + 1]; };
+
+#define TOTAL_KEYWORDS 44
+#define MIN_WORD_LENGTH 4
+#define MAX_WORD_LENGTH 11
+#define MIN_HASH_VALUE 6
+#define MAX_HASH_VALUE 49
+/* maximum key range = 44, duplicates = 0 */
+
+#ifdef __GNUC__
+__inline
+#else
+#ifdef __cplusplus
+inline
+#endif
+#endif
+static unsigned int
+mapping_hash (register const char *str, register unsigned int len)
+{
+  static const unsigned char asso_values[] =
+    {
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50,  1,  2,
+      24, 43,  5, 10,  0, 13, 32,  3, 19, 18,
+      50, 50, 50, 50, 50, 50, 50, 50, 50,  5,
+      50, 50, 50, 50, 14,  5,  0, 50, 50,  0,
+      27, 50, 12, 14, 50, 50,  0,  5,  2, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50,
+      50, 50, 50, 50, 50, 50, 50, 50, 50, 50
+    };
+  return len + asso_values[(unsigned char)str[3]+4] + asso_values[(unsigned char)str[len - 1]];
+}
+
+struct stringpool_t
+  {
+    char stringpool_str6[sizeof("CP1256")];
+    char stringpool_str7[sizeof("CP1250")];
+    char stringpool_str8[sizeof("CP1251")];
+    char stringpool_str9[sizeof("CP850")];
+    char stringpool_str10[sizeof("TIS-620")];
+    char stringpool_str11[sizeof("CP1254")];
+    char stringpool_str12[sizeof("ISO-8859-6")];
+    char stringpool_str13[sizeof("EUC-TW")];
+    char stringpool_str14[sizeof("ISO-8859-1")];
+    char stringpool_str15[sizeof("ISO-8859-9")];
+    char stringpool_str16[sizeof("CP1255")];
+    char stringpool_str17[sizeof("BIG5")];
+    char stringpool_str18[sizeof("CP855")];
+    char stringpool_str19[sizeof("CP1257")];
+    char stringpool_str20[sizeof("EUC-KR")];
+    char stringpool_str21[sizeof("CP857")];
+    char stringpool_str22[sizeof("ISO-8859-5")];
+    char stringpool_str23[sizeof("ISO-8859-15")];
+    char stringpool_str24[sizeof("CP866")];
+    char stringpool_str25[sizeof("ISO-8859-7")];
+    char stringpool_str26[sizeof("CP861")];
+    char stringpool_str27[sizeof("CP869")];
+    char stringpool_str28[sizeof("CP874")];
+    char stringpool_str29[sizeof("CP864")];
+    char stringpool_str30[sizeof("CP1252")];
+    char stringpool_str31[sizeof("CP437")];
+    char stringpool_str32[sizeof("CP852")];
+    char stringpool_str33[sizeof("CP775")];
+    char stringpool_str34[sizeof("CP865")];
+    char stringpool_str35[sizeof("EUC-JP")];
+    char stringpool_str36[sizeof("ISO-8859-2")];
+    char stringpool_str37[sizeof("SHIFT_JIS")];
+    char stringpool_str38[sizeof("CP1258")];
+    char stringpool_str39[sizeof("UTF-8")];
+    char stringpool_str40[sizeof("HP-KANA8")];
+    char stringpool_str41[sizeof("HP-ROMAN8")];
+    char stringpool_str42[sizeof("HP-HEBREW8")];
+    char stringpool_str43[sizeof("GB2312")];
+    char stringpool_str44[sizeof("ISO-8859-8")];
+    char stringpool_str45[sizeof("HP-TURKISH8")];
+    char stringpool_str46[sizeof("HP-GREEK8")];
+    char stringpool_str47[sizeof("HP-ARABIC8")];
+    char stringpool_str48[sizeof("CP862")];
+    char stringpool_str49[sizeof("CP1253")];
+  };
+static const struct stringpool_t stringpool_contents =
+  {
+    "CP1256",
+    "CP1250",
+    "CP1251",
+    "CP850",
+    "TIS-620",
+    "CP1254",
+    "ISO-8859-6",
+    "EUC-TW",
+    "ISO-8859-1",
+    "ISO-8859-9",
+    "CP1255",
+    "BIG5",
+    "CP855",
+    "CP1257",
+    "EUC-KR",
+    "CP857",
+    "ISO-8859-5",
+    "ISO-8859-15",
+    "CP866",
+    "ISO-8859-7",
+    "CP861",
+    "CP869",
+    "CP874",
+    "CP864",
+    "CP1252",
+    "CP437",
+    "CP852",
+    "CP775",
+    "CP865",
+    "EUC-JP",
+    "ISO-8859-2",
+    "SHIFT_JIS",
+    "CP1258",
+    "UTF-8",
+    "HP-KANA8",
+    "HP-ROMAN8",
+    "HP-HEBREW8",
+    "GB2312",
+    "ISO-8859-8",
+    "HP-TURKISH8",
+    "HP-GREEK8",
+    "HP-ARABIC8",
+    "CP862",
+    "CP1253"
+  };
+#define stringpool ((const char *) &stringpool_contents)
+
+static const struct mapping mappings[] =
+  {
+    {-1}, {-1}, {-1}, {-1}, {-1}, {-1},
+#line 40 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str6, "cp1256"},
+#line 34 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str7, "cp1250"},
+#line 35 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str8, "cp1251"},
+#line 23 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str9, "cp850"},
+#line 49 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str10, "tis620"},
+#line 38 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str11, "cp1254"},
+#line 16 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str12, "iso88596"},
+#line 53 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str13, "eucTW"},
+#line 13 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str14, "iso88591"},
+#line 19 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str15, "iso88599"},
+#line 39 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str16, "cp1255"},
+#line 54 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str17, "big5"},
+#line 25 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str18, "cp855"},
+#line 41 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str19, "cp1257"},
+#line 52 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str20, "eucKR"},
+#line 26 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str21, "cp857"},
+#line 15 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str22, "iso88595"},
+#line 20 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str23, "iso885915"},
+#line 31 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str24, "cp866"},
+#line 17 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str25, "iso88597"},
+#line 27 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str26, "cp861"},
+#line 32 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str27, "cp869"},
+#line 33 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str28, "cp874"},
+#line 29 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str29, "cp864"},
+#line 36 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str30, "cp1252"},
+#line 21 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str31, "cp437"},
+#line 24 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str32, "cp852"},
+#line 22 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str33, "cp775"},
+#line 30 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str34, "cp865"},
+#line 51 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str35, "eucJP"},
+#line 14 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str36, "iso88592"},
+#line 55 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str37, "sjis"},
+#line 42 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str38, "cp1258"},
+#line 56 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str39, "utf8"},
+#line 48 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str40, "kana8"},
+#line 43 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str41, "roman8"},
+#line 46 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str42, "hebrew8"},
+#line 50 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str43, "hp15CN"},
+#line 18 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str44, "iso88598"},
+#line 47 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str45, "turkish8"},
+#line 45 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str46, "greek8"},
+#line 44 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str47, "arabic8"},
+#line 28 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str48, "cp862"},
+#line 37 "./iconv_open-hpux.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str49, "cp1253"}
+  };
+
+#ifdef __GNUC__
+__inline
+#ifdef __GNUC_STDC_INLINE__
+__attribute__ ((__gnu_inline__))
+#endif
+#endif
+const struct mapping *
+mapping_lookup (register const char *str, register unsigned int len)
+{
+  if (len <= MAX_WORD_LENGTH && len >= MIN_WORD_LENGTH)
+    {
+      register int key = mapping_hash (str, len);
+
+      if (key <= MAX_HASH_VALUE && key >= 0)
+        {
+          register int o = mappings[key].standard_name;
+          if (o >= 0)
+            {
+              register const char *s = o + stringpool;
+
+              if (*str == *s && !strcmp (str + 1, s + 1))
+                return &mappings[key];
+            }
+        }
+    }
+  return 0;
+}
diff --git a/lib/iconv_open-irix.gperf b/lib/iconv_open-irix.gperf
new file mode 100644
index 000000000..3672a8013
--- /dev/null
+++ b/lib/iconv_open-irix.gperf
@@ -0,0 +1,31 @@
+struct mapping { int standard_name; const char vendor_name[10 + 1]; };
+%struct-type
+%language=ANSI-C
+%define slot-name standard_name
+%define hash-function-name mapping_hash
+%define lookup-function-name mapping_lookup
+%readonly-tables
+%global-table
+%define word-array-name mappings
+%pic
+%%
+# On IRIX 6.5, look in /usr/lib/iconv and /usr/lib/international/encodings.
+ISO-8859-1, "ISO8859-1"
+ISO-8859-2, "ISO8859-2"
+ISO-8859-3, "ISO8859-3"
+ISO-8859-4, "ISO8859-4"
+ISO-8859-5, "ISO8859-5"
+ISO-8859-6, "ISO8859-6"
+ISO-8859-7, "ISO8859-7"
+ISO-8859-8, "ISO8859-8"
+ISO-8859-9, "ISO8859-9"
+ISO-8859-15, "ISO8859-15"
+KOI8-R, "KOI8"
+CP855, "DOS855"
+CP1251, "WIN1251"
+GB2312, "eucCN"
+EUC-JP, "eucJP"
+EUC-KR, "eucKR"
+EUC-TW, "eucTW"
+SHIFT_JIS, "sjis"
+TIS-620, "TIS620"
diff --git a/lib/iconv_open-irix.h b/lib/iconv_open-irix.h
new file mode 100644
index 000000000..520582e52
--- /dev/null
+++ b/lib/iconv_open-irix.h
@@ -0,0 +1,199 @@
+/* ANSI-C code produced by gperf version 3.0.3 */
+/* Command-line: gperf -m 10 ./iconv_open-irix.gperf  */
+/* Computed positions: -k'1,$' */
+
+#if !((' ' == 32) && ('!' == 33) && ('"' == 34) && ('#' == 35) \
+      && ('%' == 37) && ('&' == 38) && ('\'' == 39) && ('(' == 40) \
+      && (')' == 41) && ('*' == 42) && ('+' == 43) && (',' == 44) \
+      && ('-' == 45) && ('.' == 46) && ('/' == 47) && ('0' == 48) \
+      && ('1' == 49) && ('2' == 50) && ('3' == 51) && ('4' == 52) \
+      && ('5' == 53) && ('6' == 54) && ('7' == 55) && ('8' == 56) \
+      && ('9' == 57) && (':' == 58) && (';' == 59) && ('<' == 60) \
+      && ('=' == 61) && ('>' == 62) && ('?' == 63) && ('A' == 65) \
+      && ('B' == 66) && ('C' == 67) && ('D' == 68) && ('E' == 69) \
+      && ('F' == 70) && ('G' == 71) && ('H' == 72) && ('I' == 73) \
+      && ('J' == 74) && ('K' == 75) && ('L' == 76) && ('M' == 77) \
+      && ('N' == 78) && ('O' == 79) && ('P' == 80) && ('Q' == 81) \
+      && ('R' == 82) && ('S' == 83) && ('T' == 84) && ('U' == 85) \
+      && ('V' == 86) && ('W' == 87) && ('X' == 88) && ('Y' == 89) \
+      && ('Z' == 90) && ('[' == 91) && ('\\' == 92) && (']' == 93) \
+      && ('^' == 94) && ('_' == 95) && ('a' == 97) && ('b' == 98) \
+      && ('c' == 99) && ('d' == 100) && ('e' == 101) && ('f' == 102) \
+      && ('g' == 103) && ('h' == 104) && ('i' == 105) && ('j' == 106) \
+      && ('k' == 107) && ('l' == 108) && ('m' == 109) && ('n' == 110) \
+      && ('o' == 111) && ('p' == 112) && ('q' == 113) && ('r' == 114) \
+      && ('s' == 115) && ('t' == 116) && ('u' == 117) && ('v' == 118) \
+      && ('w' == 119) && ('x' == 120) && ('y' == 121) && ('z' == 122) \
+      && ('{' == 123) && ('|' == 124) && ('}' == 125) && ('~' == 126))
+/* The character set is not based on ISO-646.  */
+#error "gperf generated tables don't work with this execution character set. Please report a bug to <bug-gnu-gperf@gnu.org>."
+#endif
+
+#line 1 "./iconv_open-irix.gperf"
+struct mapping { int standard_name; const char vendor_name[10 + 1]; };
+
+#define TOTAL_KEYWORDS 19
+#define MIN_WORD_LENGTH 5
+#define MAX_WORD_LENGTH 11
+#define MIN_HASH_VALUE 5
+#define MAX_HASH_VALUE 23
+/* maximum key range = 19, duplicates = 0 */
+
+#ifdef __GNUC__
+__inline
+#else
+#ifdef __cplusplus
+inline
+#endif
+#endif
+static unsigned int
+mapping_hash (register const char *str, register unsigned int len)
+{
+  static const unsigned char asso_values[] =
+    {
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24,  8,  2,
+       5, 12, 11,  0, 10,  9,  8,  7, 24, 24,
+      24, 24, 24, 24, 24, 24, 24,  0, 24,  0,
+      24,  5, 24,  0, 24,  7, 24, 24, 24, 24,
+       7, 24,  1,  0,  8, 24, 24,  0, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+      24, 24, 24, 24, 24, 24
+    };
+  return len + asso_values[(unsigned char)str[len - 1]] + asso_values[(unsigned char)str[0]];
+}
+
+struct stringpool_t
+  {
+    char stringpool_str5[sizeof("CP855")];
+    char stringpool_str6[sizeof("EUC-TW")];
+    char stringpool_str7[sizeof("EUC-KR")];
+    char stringpool_str8[sizeof("CP1251")];
+    char stringpool_str9[sizeof("SHIFT_JIS")];
+    char stringpool_str10[sizeof("ISO-8859-5")];
+    char stringpool_str11[sizeof("ISO-8859-15")];
+    char stringpool_str12[sizeof("ISO-8859-1")];
+    char stringpool_str13[sizeof("EUC-JP")];
+    char stringpool_str14[sizeof("KOI8-R")];
+    char stringpool_str15[sizeof("ISO-8859-2")];
+    char stringpool_str16[sizeof("GB2312")];
+    char stringpool_str17[sizeof("ISO-8859-9")];
+    char stringpool_str18[sizeof("ISO-8859-8")];
+    char stringpool_str19[sizeof("ISO-8859-7")];
+    char stringpool_str20[sizeof("ISO-8859-6")];
+    char stringpool_str21[sizeof("ISO-8859-4")];
+    char stringpool_str22[sizeof("ISO-8859-3")];
+    char stringpool_str23[sizeof("TIS-620")];
+  };
+static const struct stringpool_t stringpool_contents =
+  {
+    "CP855",
+    "EUC-TW",
+    "EUC-KR",
+    "CP1251",
+    "SHIFT_JIS",
+    "ISO-8859-5",
+    "ISO-8859-15",
+    "ISO-8859-1",
+    "EUC-JP",
+    "KOI8-R",
+    "ISO-8859-2",
+    "GB2312",
+    "ISO-8859-9",
+    "ISO-8859-8",
+    "ISO-8859-7",
+    "ISO-8859-6",
+    "ISO-8859-4",
+    "ISO-8859-3",
+    "TIS-620"
+  };
+#define stringpool ((const char *) &stringpool_contents)
+
+static const struct mapping mappings[] =
+  {
+    {-1}, {-1}, {-1}, {-1}, {-1},
+#line 24 "./iconv_open-irix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str5, "DOS855"},
+#line 29 "./iconv_open-irix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str6, "eucTW"},
+#line 28 "./iconv_open-irix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str7, "eucKR"},
+#line 25 "./iconv_open-irix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str8, "WIN1251"},
+#line 30 "./iconv_open-irix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str9, "sjis"},
+#line 17 "./iconv_open-irix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str10, "ISO8859-5"},
+#line 22 "./iconv_open-irix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str11, "ISO8859-15"},
+#line 13 "./iconv_open-irix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str12, "ISO8859-1"},
+#line 27 "./iconv_open-irix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str13, "eucJP"},
+#line 23 "./iconv_open-irix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str14, "KOI8"},
+#line 14 "./iconv_open-irix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str15, "ISO8859-2"},
+#line 26 "./iconv_open-irix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str16, "eucCN"},
+#line 21 "./iconv_open-irix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str17, "ISO8859-9"},
+#line 20 "./iconv_open-irix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str18, "ISO8859-8"},
+#line 19 "./iconv_open-irix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str19, "ISO8859-7"},
+#line 18 "./iconv_open-irix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str20, "ISO8859-6"},
+#line 16 "./iconv_open-irix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str21, "ISO8859-4"},
+#line 15 "./iconv_open-irix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str22, "ISO8859-3"},
+#line 31 "./iconv_open-irix.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str23, "TIS620"}
+  };
+
+#ifdef __GNUC__
+__inline
+#ifdef __GNUC_STDC_INLINE__
+__attribute__ ((__gnu_inline__))
+#endif
+#endif
+const struct mapping *
+mapping_lookup (register const char *str, register unsigned int len)
+{
+  if (len <= MAX_WORD_LENGTH && len >= MIN_WORD_LENGTH)
+    {
+      register int key = mapping_hash (str, len);
+
+      if (key <= MAX_HASH_VALUE && key >= 0)
+        {
+          register int o = mappings[key].standard_name;
+          if (o >= 0)
+            {
+              register const char *s = o + stringpool;
+
+              if (*str == *s && !strcmp (str + 1, s + 1))
+                return &mappings[key];
+            }
+        }
+    }
+  return 0;
+}
diff --git a/lib/iconv_open-osf.gperf b/lib/iconv_open-osf.gperf
new file mode 100644
index 000000000..f468ff609
--- /dev/null
+++ b/lib/iconv_open-osf.gperf
@@ -0,0 +1,50 @@
+struct mapping { int standard_name; const char vendor_name[10 + 1]; };
+%struct-type
+%language=ANSI-C
+%define slot-name standard_name
+%define hash-function-name mapping_hash
+%define lookup-function-name mapping_lookup
+%readonly-tables
+%global-table
+%define word-array-name mappings
+%pic
+%%
+# On OSF/1 5.1, look in /usr/lib/nls/loc/iconv.
+ISO-8859-1, "ISO8859-1"
+ISO-8859-2, "ISO8859-2"
+ISO-8859-3, "ISO8859-3"
+ISO-8859-4, "ISO8859-4"
+ISO-8859-5, "ISO8859-5"
+ISO-8859-6, "ISO8859-6"
+ISO-8859-7, "ISO8859-7"
+ISO-8859-8, "ISO8859-8"
+ISO-8859-9, "ISO8859-9"
+ISO-8859-15, "ISO8859-15"
+CP437, "cp437"
+CP775, "cp775"
+CP850, "cp850"
+CP852, "cp852"
+CP855, "cp855"
+CP857, "cp857"
+CP861, "cp861"
+CP862, "cp862"
+CP865, "cp865"
+CP866, "cp866"
+CP869, "cp869"
+CP874, "cp874"
+CP949, "KSC5601"
+CP1250, "cp1250"
+CP1251, "cp1251"
+CP1252, "cp1252"
+CP1253, "cp1253"
+CP1254, "cp1254"
+CP1255, "cp1255"
+CP1256, "cp1256"
+CP1257, "cp1257"
+CP1258, "cp1258"
+EUC-JP, "eucJP"
+EUC-KR, "eucKR"
+EUC-TW, "eucTW"
+BIG5, "big5"
+SHIFT_JIS, "SJIS"
+TIS-620, "TACTIS"
diff --git a/lib/iconv_open-osf.h b/lib/iconv_open-osf.h
new file mode 100644
index 000000000..85e4c0f8f
--- /dev/null
+++ b/lib/iconv_open-osf.h
@@ -0,0 +1,278 @@
+/* ANSI-C code produced by gperf version 3.0.3 */
+/* Command-line: gperf -m 10 ./iconv_open-osf.gperf  */
+/* Computed positions: -k'4,$' */
+
+#if !((' ' == 32) && ('!' == 33) && ('"' == 34) && ('#' == 35) \
+      && ('%' == 37) && ('&' == 38) && ('\'' == 39) && ('(' == 40) \
+      && (')' == 41) && ('*' == 42) && ('+' == 43) && (',' == 44) \
+      && ('-' == 45) && ('.' == 46) && ('/' == 47) && ('0' == 48) \
+      && ('1' == 49) && ('2' == 50) && ('3' == 51) && ('4' == 52) \
+      && ('5' == 53) && ('6' == 54) && ('7' == 55) && ('8' == 56) \
+      && ('9' == 57) && (':' == 58) && (';' == 59) && ('<' == 60) \
+      && ('=' == 61) && ('>' == 62) && ('?' == 63) && ('A' == 65) \
+      && ('B' == 66) && ('C' == 67) && ('D' == 68) && ('E' == 69) \
+      && ('F' == 70) && ('G' == 71) && ('H' == 72) && ('I' == 73) \
+      && ('J' == 74) && ('K' == 75) && ('L' == 76) && ('M' == 77) \
+      && ('N' == 78) && ('O' == 79) && ('P' == 80) && ('Q' == 81) \
+      && ('R' == 82) && ('S' == 83) && ('T' == 84) && ('U' == 85) \
+      && ('V' == 86) && ('W' == 87) && ('X' == 88) && ('Y' == 89) \
+      && ('Z' == 90) && ('[' == 91) && ('\\' == 92) && (']' == 93) \
+      && ('^' == 94) && ('_' == 95) && ('a' == 97) && ('b' == 98) \
+      && ('c' == 99) && ('d' == 100) && ('e' == 101) && ('f' == 102) \
+      && ('g' == 103) && ('h' == 104) && ('i' == 105) && ('j' == 106) \
+      && ('k' == 107) && ('l' == 108) && ('m' == 109) && ('n' == 110) \
+      && ('o' == 111) && ('p' == 112) && ('q' == 113) && ('r' == 114) \
+      && ('s' == 115) && ('t' == 116) && ('u' == 117) && ('v' == 118) \
+      && ('w' == 119) && ('x' == 120) && ('y' == 121) && ('z' == 122) \
+      && ('{' == 123) && ('|' == 124) && ('}' == 125) && ('~' == 126))
+/* The character set is not based on ISO-646.  */
+#error "gperf generated tables don't work with this execution character set. Please report a bug to <bug-gnu-gperf@gnu.org>."
+#endif
+
+#line 1 "./iconv_open-osf.gperf"
+struct mapping { int standard_name; const char vendor_name[10 + 1]; };
+
+#define TOTAL_KEYWORDS 38
+#define MIN_WORD_LENGTH 4
+#define MAX_WORD_LENGTH 11
+#define MIN_HASH_VALUE 6
+#define MAX_HASH_VALUE 47
+/* maximum key range = 42, duplicates = 0 */
+
+#ifdef __GNUC__
+__inline
+#else
+#ifdef __cplusplus
+inline
+#endif
+#endif
+static unsigned int
+mapping_hash (register const char *str, register unsigned int len)
+{
+  static const unsigned char asso_values[] =
+    {
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48,  2, 29,
+      24, 34, 31,  0, 15, 14, 10, 13,  2, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48,  7, 48, 48, 48, 48, 48, 48,
+      11, 48,  2,  7, 48, 48, 48,  1, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
+      48, 48, 48, 48, 48, 48, 48, 48, 48
+    };
+  return len + asso_values[(unsigned char)str[3]+3] + asso_values[(unsigned char)str[len - 1]];
+}
+
+struct stringpool_t
+  {
+    char stringpool_str6[sizeof("CP1255")];
+    char stringpool_str7[sizeof("CP775")];
+    char stringpool_str8[sizeof("CP1250")];
+    char stringpool_str9[sizeof("EUC-TW")];
+    char stringpool_str10[sizeof("EUC-KR")];
+    char stringpool_str11[sizeof("TIS-620")];
+    char stringpool_str12[sizeof("ISO-8859-5")];
+    char stringpool_str13[sizeof("ISO-8859-15")];
+    char stringpool_str14[sizeof("BIG5")];
+    char stringpool_str15[sizeof("CP855")];
+    char stringpool_str16[sizeof("CP1258")];
+    char stringpool_str17[sizeof("CP850")];
+    char stringpool_str18[sizeof("CP865")];
+    char stringpool_str19[sizeof("EUC-JP")];
+    char stringpool_str20[sizeof("CP1257")];
+    char stringpool_str21[sizeof("CP1256")];
+    char stringpool_str22[sizeof("ISO-8859-8")];
+    char stringpool_str23[sizeof("SHIFT_JIS")];
+    char stringpool_str25[sizeof("ISO-8859-9")];
+    char stringpool_str26[sizeof("ISO-8859-7")];
+    char stringpool_str27[sizeof("ISO-8859-6")];
+    char stringpool_str29[sizeof("CP857")];
+    char stringpool_str30[sizeof("CP1252")];
+    char stringpool_str31[sizeof("CP869")];
+    char stringpool_str32[sizeof("CP949")];
+    char stringpool_str33[sizeof("CP866")];
+    char stringpool_str34[sizeof("CP437")];
+    char stringpool_str35[sizeof("CP1251")];
+    char stringpool_str36[sizeof("ISO-8859-2")];
+    char stringpool_str37[sizeof("CP1254")];
+    char stringpool_str38[sizeof("CP874")];
+    char stringpool_str39[sizeof("CP852")];
+    char stringpool_str40[sizeof("CP1253")];
+    char stringpool_str41[sizeof("ISO-8859-1")];
+    char stringpool_str42[sizeof("CP862")];
+    char stringpool_str43[sizeof("ISO-8859-4")];
+    char stringpool_str46[sizeof("ISO-8859-3")];
+    char stringpool_str47[sizeof("CP861")];
+  };
+static const struct stringpool_t stringpool_contents =
+  {
+    "CP1255",
+    "CP775",
+    "CP1250",
+    "EUC-TW",
+    "EUC-KR",
+    "TIS-620",
+    "ISO-8859-5",
+    "ISO-8859-15",
+    "BIG5",
+    "CP855",
+    "CP1258",
+    "CP850",
+    "CP865",
+    "EUC-JP",
+    "CP1257",
+    "CP1256",
+    "ISO-8859-8",
+    "SHIFT_JIS",
+    "ISO-8859-9",
+    "ISO-8859-7",
+    "ISO-8859-6",
+    "CP857",
+    "CP1252",
+    "CP869",
+    "CP949",
+    "CP866",
+    "CP437",
+    "CP1251",
+    "ISO-8859-2",
+    "CP1254",
+    "CP874",
+    "CP852",
+    "CP1253",
+    "ISO-8859-1",
+    "CP862",
+    "ISO-8859-4",
+    "ISO-8859-3",
+    "CP861"
+  };
+#define stringpool ((const char *) &stringpool_contents)
+
+static const struct mapping mappings[] =
+  {
+    {-1}, {-1}, {-1}, {-1}, {-1}, {-1},
+#line 41 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str6, "cp1255"},
+#line 24 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str7, "cp775"},
+#line 36 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str8, "cp1250"},
+#line 47 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str9, "eucTW"},
+#line 46 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str10, "eucKR"},
+#line 50 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str11, "TACTIS"},
+#line 17 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str12, "ISO8859-5"},
+#line 22 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str13, "ISO8859-15"},
+#line 48 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str14, "big5"},
+#line 27 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str15, "cp855"},
+#line 44 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str16, "cp1258"},
+#line 25 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str17, "cp850"},
+#line 31 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str18, "cp865"},
+#line 45 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str19, "eucJP"},
+#line 43 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str20, "cp1257"},
+#line 42 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str21, "cp1256"},
+#line 20 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str22, "ISO8859-8"},
+#line 49 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str23, "SJIS"},
+    {-1},
+#line 21 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str25, "ISO8859-9"},
+#line 19 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str26, "ISO8859-7"},
+#line 18 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str27, "ISO8859-6"},
+    {-1},
+#line 28 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str29, "cp857"},
+#line 38 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str30, "cp1252"},
+#line 33 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str31, "cp869"},
+#line 35 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str32, "KSC5601"},
+#line 32 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str33, "cp866"},
+#line 23 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str34, "cp437"},
+#line 37 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str35, "cp1251"},
+#line 14 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str36, "ISO8859-2"},
+#line 40 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str37, "cp1254"},
+#line 34 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str38, "cp874"},
+#line 26 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str39, "cp852"},
+#line 39 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str40, "cp1253"},
+#line 13 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str41, "ISO8859-1"},
+#line 30 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str42, "cp862"},
+#line 16 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str43, "ISO8859-4"},
+    {-1}, {-1},
+#line 15 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str46, "ISO8859-3"},
+#line 29 "./iconv_open-osf.gperf"
+    {(int)(long)&((struct stringpool_t *)0)->stringpool_str47, "cp861"}
+  };
+
+#ifdef __GNUC__
+__inline
+#ifdef __GNUC_STDC_INLINE__
+__attribute__ ((__gnu_inline__))
+#endif
+#endif
+const struct mapping *
+mapping_lookup (register const char *str, register unsigned int len)
+{
+  if (len <= MAX_WORD_LENGTH && len >= MIN_WORD_LENGTH)
+    {
+      register int key = mapping_hash (str, len);
+
+      if (key <= MAX_HASH_VALUE && key >= 0)
+        {
+          register int o = mappings[key].standard_name;
+          if (o >= 0)
+            {
+              register const char *s = o + stringpool;
+
+              if (*str == *s && !strcmp (str + 1, s + 1))
+                return &mappings[key];
+            }
+        }
+    }
+  return 0;
+}
diff --git a/lib/iconv_open.c b/lib/iconv_open.c
new file mode 100644
index 000000000..3d873acd6
--- /dev/null
+++ b/lib/iconv_open.c
@@ -0,0 +1,172 @@
+/* Character set conversion.
+   Copyright (C) 2007 Free Software Foundation, Inc.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 2, or (at your option)
+   any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License along
+   with this program; if not, write to the Free Software Foundation,
+   Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+#include <config.h>
+
+/* Specification.  */
+#include <iconv.h>
+
+#include <errno.h>
+#include <string.h>
+#include "c-ctype.h"
+#include "c-strcase.h"
+
+#define SIZEOF(a) (sizeof(a) / sizeof(a[0]))
+
+/* Namespace cleanliness.  */
+#define mapping_lookup rpl_iconv_open_mapping_lookup
+
+/* The macro ICONV_FLAVOR is defined to one of these or undefined.  */
+
+#define ICONV_FLAVOR_AIX "iconv_open-aix.h"
+#define ICONV_FLAVOR_HPUX "iconv_open-hpux.h"
+#define ICONV_FLAVOR_IRIX "iconv_open-irix.h"
+#define ICONV_FLAVOR_OSF "iconv_open-osf.h"
+
+#ifdef ICONV_FLAVOR
+# include ICONV_FLAVOR
+#endif
+
+iconv_t
+rpl_iconv_open (const char *tocode, const char *fromcode)
+#undef iconv_open
+{
+  char fromcode_upper[32];
+  char tocode_upper[32];
+  char *fromcode_upper_end;
+  char *tocode_upper_end;
+
+#if REPLACE_ICONV_UTF
+  /* Special handling of conversion between UTF-8 and UTF-{16,32}{BE,LE}.
+     Do this here, before calling the real iconv_open(), because  OSF/1 5.1
+     iconv() to these encoding inserts a BOM, which is wrong.
+     We do not need to handle conversion between arbitrary encodings and
+     UTF-{16,32}{BE,LE}, because the 'striconveh' module implements two-step
+     conversion throough UTF-8.
+     The _ICONV_* constants are chosen to be disjoint from any iconv_t
+     returned by the system's iconv_open() functions.  Recall that iconv_t
+     is a scalar type.  */
+  if (c_toupper (fromcode[0]) == 'U'
+      && c_toupper (fromcode[1]) == 'T'
+      && c_toupper (fromcode[2]) == 'F'
+      && fromcode[3] == '-')
+    {
+      if (c_toupper (tocode[0]) == 'U'
+	  && c_toupper (tocode[1]) == 'T'
+	  && c_toupper (tocode[2]) == 'F'
+	  && tocode[3] == '-')
+	{
+	  if (strcmp (fromcode + 4, "8") == 0)
+	    {
+	      if (c_strcasecmp (tocode + 4, "16BE") == 0)
+		return _ICONV_UTF8_UTF16BE;
+	      if (c_strcasecmp (tocode + 4, "16LE") == 0)
+		return _ICONV_UTF8_UTF16LE;
+	      if (c_strcasecmp (tocode + 4, "32BE") == 0)
+		return _ICONV_UTF8_UTF32BE;
+	      if (c_strcasecmp (tocode + 4, "32LE") == 0)
+		return _ICONV_UTF8_UTF32LE;
+	    }
+	  else if (strcmp (tocode + 4, "8") == 0)
+	    {
+	      if (c_strcasecmp (fromcode + 4, "16BE") == 0)
+		return _ICONV_UTF16BE_UTF8;
+	      if (c_strcasecmp (fromcode + 4, "16LE") == 0)
+		return _ICONV_UTF16LE_UTF8;
+	      if (c_strcasecmp (fromcode + 4, "32BE") == 0)
+		return _ICONV_UTF32BE_UTF8;
+	      if (c_strcasecmp (fromcode + 4, "32LE") == 0)
+		return _ICONV_UTF32LE_UTF8;
+	    }
+	}
+    }
+#endif
+
+  /* Do *not* add special support for 8-bit encodings like ASCII or ISO-8859-1
+     here.  This would lead to programs that work in some locales (such as the
+     "C" or "en_US" locales) but do not work in East Asian locales.  It is
+     better if programmers make their programs depend on GNU libiconv (except
+     on glibc systems), e.g. by using the AM_ICONV macro and documenting the
+     dependency in an INSTALL or DEPENDENCIES file.  */
+
+  /* Try with the original names first.
+     This covers the case when fromcode or tocode is a lowercase encoding name
+     that is understood by the system's iconv_open but not listed in our
+     mappings table.  */
+  {
+    iconv_t cd = iconv_open (tocode, fromcode);
+    if (cd != (iconv_t)(-1))
+      return cd;
+  }
+
+  /* Convert the encodings to upper case, because
+       1. in the arguments of iconv_open() on AIX, HP-UX, and OSF/1 the case
+	  matters,
+       2. it makes searching in the table faster.  */
+  {
+    const char *p = fromcode;
+    char *q = fromcode_upper;
+    while ((*q = c_toupper (*p)) != '\0')
+      {
+	p++;
+	q++;
+	if (q == &fromcode_upper[SIZEOF (fromcode_upper)])
+	  {
+	    errno = EINVAL;
+	    return (iconv_t)(-1);
+	  }
+      }
+    fromcode_upper_end = q;
+  }
+
+  {
+    const char *p = tocode;
+    char *q = tocode_upper;
+    while ((*q = c_toupper (*p)) != '\0')
+      {
+	p++;
+	q++;
+	if (q == &tocode_upper[SIZEOF (tocode_upper)])
+	  {
+	    errno = EINVAL;
+	    return (iconv_t)(-1);
+	  }
+      }
+    tocode_upper_end = q;
+  }
+
+#ifdef ICONV_FLAVOR
+  /* Apply the mappings.  */
+  {
+    const struct mapping *m =
+      mapping_lookup (fromcode_upper, fromcode_upper_end - fromcode_upper);
+
+    fromcode = (m != NULL ? m->vendor_name : fromcode_upper);
+  }
+  {
+    const struct mapping *m =
+      mapping_lookup (tocode_upper, tocode_upper_end - tocode_upper);
+
+    tocode = (m != NULL ? m->vendor_name : tocode_upper);
+  }
+#else
+  fromcode = fromcode_upper;
+  tocode = tocode_upper;
+#endif
+
+  return iconv_open (tocode, fromcode);
+}
diff --git a/lib/iconveh.h b/lib/iconveh.h
new file mode 100644
index 000000000..06cda52e8
--- /dev/null
+++ b/lib/iconveh.h
@@ -0,0 +1,41 @@
+/* Character set conversion handler type.
+   Copyright (C) 2001-2007, 2009 Free Software Foundation, Inc.
+   Written by Bruno Haible.
+
+   This program is free software: you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#ifndef _ICONVEH_H
+#define _ICONVEH_H
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
+/* Handling of unconvertible characters.  */
+enum iconv_ilseq_handler
+{
+  iconveh_error,		/* return and set errno = EILSEQ */
+  iconveh_question_mark,	/* use one '?' per unconvertible character */
+  iconveh_escape_sequence	/* use escape sequence \uxxxx or \Uxxxxxxxx */
+};
+
+
+#ifdef __cplusplus
+}
+#endif
+
+
+#endif /* _ICONVEH_H */
diff --git a/lib/localcharset.c b/lib/localcharset.c
index c3e393735..93da17077 100644
--- a/lib/localcharset.c
+++ b/lib/localcharset.c
@@ -1,6 +1,6 @@
 /* Determine a canonical name for the current locale's character encoding.
 
-   Copyright (C) 2000-2006, 2008 Free Software Foundation, Inc.
+   Copyright (C) 2000-2006, 2008-2009 Free Software Foundation, Inc.
 
    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU Lesser General Public License as published by
@@ -28,6 +28,10 @@
 #include <string.h>
 #include <stdlib.h>
 
+#if defined __APPLE__ && defined __MACH__ && HAVE_LANGINFO_CODESET
+# define DARWIN7 /* Darwin 7 or newer, i.e. MacOS X 10.3 or newer */
+#endif
+
 #if defined _WIN32 || defined __WIN32__
 # define WIN32_NATIVE
 #endif
@@ -112,7 +116,7 @@ get_charset_aliases (void)
   cp = charset_aliases;
   if (cp == NULL)
     {
-#if !(defined VMS || defined WIN32_NATIVE || defined __CYGWIN__)
+#if !(defined DARWIN7 || defined VMS || defined WIN32_NATIVE || defined __CYGWIN__)
       FILE *fp;
       const char *dir;
       const char *base = "charset.alias";
@@ -213,6 +217,39 @@ get_charset_aliases (void)
 
 #else
 
+# if defined DARWIN7
+      /* To avoid the trouble of installing a file that is shared by many
+	 GNU packages -- many packaging systems have problems with this --,
+	 simply inline the aliases here.  */
+      cp = "ISO8859-1" "\0" "ISO-8859-1" "\0"
+	   "ISO8859-2" "\0" "ISO-8859-2" "\0"
+	   "ISO8859-4" "\0" "ISO-8859-4" "\0"
+	   "ISO8859-5" "\0" "ISO-8859-5" "\0"
+	   "ISO8859-7" "\0" "ISO-8859-7" "\0"
+	   "ISO8859-9" "\0" "ISO-8859-9" "\0"
+	   "ISO8859-13" "\0" "ISO-8859-13" "\0"
+	   "ISO8859-15" "\0" "ISO-8859-15" "\0"
+	   "KOI8-R" "\0" "KOI8-R" "\0"
+	   "KOI8-U" "\0" "KOI8-U" "\0"
+	   "CP866" "\0" "CP866" "\0"
+	   "CP949" "\0" "CP949" "\0"
+	   "CP1131" "\0" "CP1131" "\0"
+	   "CP1251" "\0" "CP1251" "\0"
+	   "eucCN" "\0" "GB2312" "\0"
+	   "GB2312" "\0" "GB2312" "\0"
+	   "eucJP" "\0" "EUC-JP" "\0"
+	   "eucKR" "\0" "EUC-KR" "\0"
+	   "Big5" "\0" "BIG5" "\0"
+	   "Big5HKSCS" "\0" "BIG5-HKSCS" "\0"
+	   "GBK" "\0" "GBK" "\0"
+	   "GB18030" "\0" "GB18030" "\0"
+	   "SJIS" "\0" "SHIFT_JIS" "\0"
+	   "ARMSCII-8" "\0" "ARMSCII-8" "\0"
+	   "PT154" "\0" "PT154" "\0"
+	 /*"ISCII-DEV" "\0" "?" "\0"*/
+	   "*" "\0" "UTF-8" "\0";
+# endif
+
 # if defined VMS
       /* To avoid the troubles of an extra file charset.alias_vms in the
 	 sources of many GNU packages, simply inline the aliases here.  */
diff --git a/lib/malloc.c b/lib/malloc.c
new file mode 100644
index 000000000..9111c7a1e
--- /dev/null
+++ b/lib/malloc.c
@@ -0,0 +1,57 @@
+/* malloc() function that is glibc compatible.
+
+   Copyright (C) 1997, 1998, 2006, 2007 Free Software Foundation, Inc.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 2, or (at your option)
+   any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program; if not, write to the Free Software Foundation,
+   Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+/* written by Jim Meyering and Bruno Haible */
+
+#include <config.h>
+/* Only the AC_FUNC_MALLOC macro defines 'malloc' already in config.h.  */
+#ifdef malloc
+# define NEED_MALLOC_GNU
+# undef malloc
+#endif
+
+/* Specification.  */
+#include <stdlib.h>
+
+#include <errno.h>
+
+/* Call the system's malloc below.  */
+#undef malloc
+
+/* Allocate an N-byte block of memory from the heap.
+   If N is zero, allocate a 1-byte block.  */
+
+void *
+rpl_malloc (size_t n)
+{
+  void *result;
+
+#ifdef NEED_MALLOC_GNU
+  if (n == 0)
+    n = 1;
+#endif
+
+  result = malloc (n);
+
+#if !HAVE_MALLOC_POSIX
+  if (result == NULL)
+    errno = ENOMEM;
+#endif
+
+  return result;
+}
diff --git a/lib/malloca.c b/lib/malloca.c
new file mode 100644
index 000000000..7905e6152
--- /dev/null
+++ b/lib/malloca.c
@@ -0,0 +1,137 @@
+/* Safe automatic memory allocation.
+   Copyright (C) 2003, 2006-2007 Free Software Foundation, Inc.
+   Written by Bruno Haible <bruno@clisp.org>, 2003.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 2, or (at your option)
+   any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program; if not, write to the Free Software Foundation,
+   Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+#include <config.h>
+
+/* Specification.  */
+#include "malloca.h"
+
+/* The speed critical point in this file is freea() applied to an alloca()
+   result: it must be fast, to match the speed of alloca().  The speed of
+   mmalloca() and freea() in the other case are not critical, because they
+   are only invoked for big memory sizes.  */
+
+#if HAVE_ALLOCA
+
+/* Store the mmalloca() results in a hash table.  This is needed to reliably
+   distinguish a mmalloca() result and an alloca() result.
+
+   Although it is possible that the same pointer is returned by alloca() and
+   by mmalloca() at different times in the same application, it does not lead
+   to a bug in freea(), because:
+     - Before a pointer returned by alloca() can point into malloc()ed memory,
+       the function must return, and once this has happened the programmer must
+       not call freea() on it anyway.
+     - Before a pointer returned by mmalloca() can point into the stack, it
+       must be freed.  The only function that can free it is freea(), and
+       when freea() frees it, it also removes it from the hash table.  */
+
+#define MAGIC_NUMBER 0x1415fb4a
+#define MAGIC_SIZE sizeof (int)
+/* This is how the header info would look like without any alignment
+   considerations.  */
+struct preliminary_header { void *next; char room[MAGIC_SIZE]; };
+/* But the header's size must be a multiple of sa_alignment_max.  */
+#define HEADER_SIZE \
+  (((sizeof (struct preliminary_header) + sa_alignment_max - 1) / sa_alignment_max) * sa_alignment_max)
+struct header { void *next; char room[HEADER_SIZE - sizeof (struct preliminary_header) + MAGIC_SIZE]; };
+/* Verify that HEADER_SIZE == sizeof (struct header).  */
+typedef int verify1[2 * (HEADER_SIZE == sizeof (struct header)) - 1];
+/* We make the hash table quite big, so that during lookups the probability
+   of empty hash buckets is quite high.  There is no need to make the hash
+   table resizable, because when the hash table gets filled so much that the
+   lookup becomes slow, it means that the application has memory leaks.  */
+#define HASH_TABLE_SIZE 257
+static void * mmalloca_results[HASH_TABLE_SIZE];
+
+#endif
+
+void *
+mmalloca (size_t n)
+{
+#if HAVE_ALLOCA
+  /* Allocate one more word, that serves as an indicator for malloc()ed
+     memory, so that freea() of an alloca() result is fast.  */
+  size_t nplus = n + HEADER_SIZE;
+
+  if (nplus >= n)
+    {
+      char *p = (char *) malloc (nplus);
+
+      if (p != NULL)
+	{
+	  size_t slot;
+
+	  p += HEADER_SIZE;
+
+	  /* Put a magic number into the indicator word.  */
+	  ((int *) p)[-1] = MAGIC_NUMBER;
+
+	  /* Enter p into the hash table.  */
+	  slot = (unsigned long) p % HASH_TABLE_SIZE;
+	  ((struct header *) (p - HEADER_SIZE))->next = mmalloca_results[slot];
+	  mmalloca_results[slot] = p;
+
+	  return p;
+	}
+    }
+  /* Out of memory.  */
+  return NULL;
+#else
+# if !MALLOC_0_IS_NONNULL
+  if (n == 0)
+    n = 1;
+# endif
+  return malloc (n);
+#endif
+}
+
+#if HAVE_ALLOCA
+void
+freea (void *p)
+{
+  /* mmalloca() may have returned NULL.  */
+  if (p != NULL)
+    {
+      /* Attempt to quickly distinguish the mmalloca() result - which has
+	 a magic indicator word - and the alloca() result - which has an
+	 uninitialized indicator word.  It is for this test that sa_increment
+	 additional bytes are allocated in the alloca() case.  */
+      if (((int *) p)[-1] == MAGIC_NUMBER)
+	{
+	  /* Looks like a mmalloca() result.  To see whether it really is one,
+	     perform a lookup in the hash table.  */
+	  size_t slot = (unsigned long) p % HASH_TABLE_SIZE;
+	  void **chain = &mmalloca_results[slot];
+	  for (; *chain != NULL;)
+	    {
+	      if (*chain == p)
+		{
+		  /* Found it.  Remove it from the hash table and free it.  */
+		  char *p_begin = (char *) p - HEADER_SIZE;
+		  *chain = ((struct header *) p_begin)->next;
+		  free (p_begin);
+		  return;
+		}
+	      chain = &((struct header *) ((char *) *chain - HEADER_SIZE))->next;
+	    }
+	}
+      /* At this point, we know it was not a mmalloca() result.  */
+    }
+}
+#endif
diff --git a/lib/malloca.h b/lib/malloca.h
new file mode 100644
index 000000000..7d92b0af5
--- /dev/null
+++ b/lib/malloca.h
@@ -0,0 +1,134 @@
+/* Safe automatic memory allocation.
+   Copyright (C) 2003-2007 Free Software Foundation, Inc.
+   Written by Bruno Haible <bruno@clisp.org>, 2003.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 2, or (at your option)
+   any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program; if not, write to the Free Software Foundation,
+   Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+#ifndef _MALLOCA_H
+#define _MALLOCA_H
+
+#include <alloca.h>
+#include <stddef.h>
+#include <stdlib.h>
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
+/* safe_alloca(N) is equivalent to alloca(N) when it is safe to call
+   alloca(N); otherwise it returns NULL.  It either returns N bytes of
+   memory allocated on the stack, that lasts until the function returns,
+   or NULL.
+   Use of safe_alloca should be avoided:
+     - inside arguments of function calls - undefined behaviour,
+     - in inline functions - the allocation may actually last until the
+       calling function returns.
+*/
+#if HAVE_ALLOCA
+/* The OS usually guarantees only one guard page at the bottom of the stack,
+   and a page size can be as small as 4096 bytes.  So we cannot safely
+   allocate anything larger than 4096 bytes.  Also care for the possibility
+   of a few compiler-allocated temporary stack slots.
+   This must be a macro, not an inline function.  */
+# define safe_alloca(N) ((N) < 4032 ? alloca (N) : NULL)
+#else
+# define safe_alloca(N) ((void) (N), NULL)
+#endif
+
+/* malloca(N) is a safe variant of alloca(N).  It allocates N bytes of
+   memory allocated on the stack, that must be freed using freea() before
+   the function returns.  Upon failure, it returns NULL.  */
+#if HAVE_ALLOCA
+# define malloca(N) \
+  ((N) < 4032 - sa_increment					    \
+   ? (void *) ((char *) alloca ((N) + sa_increment) + sa_increment) \
+   : mmalloca (N))
+#else
+# define malloca(N) \
+  mmalloca (N)
+#endif
+extern void * mmalloca (size_t n);
+
+/* Free a block of memory allocated through malloca().  */
+#if HAVE_ALLOCA
+extern void freea (void *p);
+#else
+# define freea free
+#endif
+
+/* nmalloca(N,S) is an overflow-safe variant of malloca (N * S).
+   It allocates an array of N objects, each with S bytes of memory,
+   on the stack.  S must be positive and N must be nonnegative.
+   The array must be freed using freea() before the function returns.  */
+#if 1
+/* Cf. the definition of xalloc_oversized.  */
+# define nmalloca(n, s) \
+    ((n) > (size_t) (sizeof (ptrdiff_t) <= sizeof (size_t) ? -1 : -2) / (s) \
+     ? NULL \
+     : malloca ((n) * (s)))
+#else
+extern void * nmalloca (size_t n, size_t s);
+#endif
+
+
+#ifdef __cplusplus
+}
+#endif
+
+
+/* ------------------- Auxiliary, non-public definitions ------------------- */
+
+/* Determine the alignment of a type at compile time.  */
+#if defined __GNUC__
+# define sa_alignof __alignof__
+#elif defined __cplusplus
+  template <class type> struct sa_alignof_helper { char __slot1; type __slot2; };
+# define sa_alignof(type) offsetof (sa_alignof_helper<type>, __slot2)
+#elif defined __hpux
+  /* Work around a HP-UX 10.20 cc bug with enums constants defined as offsetof
+     values.  */
+# define sa_alignof(type) (sizeof (type) <= 4 ? 4 : 8)
+#elif defined _AIX
+  /* Work around an AIX 3.2.5 xlc bug with enums constants defined as offsetof
+     values.  */
+# define sa_alignof(type) (sizeof (type) <= 4 ? 4 : 8)
+#else
+# define sa_alignof(type) offsetof (struct { char __slot1; type __slot2; }, __slot2)
+#endif
+
+enum
+{
+/* The desired alignment of memory allocations is the maximum alignment
+   among all elementary types.  */
+  sa_alignment_long = sa_alignof (long),
+  sa_alignment_double = sa_alignof (double),
+#if HAVE_LONG_LONG_INT
+  sa_alignment_longlong = sa_alignof (long long),
+#endif
+  sa_alignment_longdouble = sa_alignof (long double),
+  sa_alignment_max = ((sa_alignment_long - 1) | (sa_alignment_double - 1)
+#if HAVE_LONG_LONG_INT
+		      | (sa_alignment_longlong - 1)
+#endif
+		      | (sa_alignment_longdouble - 1)
+		     ) + 1,
+/* The increment that guarantees room for a magic word must be >= sizeof (int)
+   and a multiple of sa_alignment_max.  */
+  sa_increment = ((sizeof (int) + sa_alignment_max - 1) / sa_alignment_max) * sa_alignment_max
+};
+
+#endif /* _MALLOCA_H */
diff --git a/lib/malloca.valgrind b/lib/malloca.valgrind
new file mode 100644
index 000000000..52f0a50f5
--- /dev/null
+++ b/lib/malloca.valgrind
@@ -0,0 +1,7 @@
+# Suppress a valgrind message about use of uninitialized memory in freea().
+# This use is OK because it provides only a speedup.
+{
+    freea
+    Memcheck:Cond
+    fun:freea
+}
diff --git a/lib/mbrtowc.c b/lib/mbrtowc.c
index 17b3de53b..7b528e807 100644
--- a/lib/mbrtowc.c
+++ b/lib/mbrtowc.c
@@ -1,5 +1,5 @@
 /* Convert multibyte character to wide character.
-   Copyright (C) 1999-2002, 2005-2008 Free Software Foundation, Inc.
+   Copyright (C) 1999-2002, 2005-2009 Free Software Foundation, Inc.
    Written by Bruno Haible <bruno@clisp.org>, 2008.
 
    This program is free software: you can redistribute it and/or modify
@@ -89,7 +89,7 @@ mbrtowc (wchar_t *pwc, const char *s, size_t n, mbstate_t *ps)
 	return (size_t)(-1);
       }
 
-    /* Here 0 < m ≤ 4.  */
+    /* Here m > 0.  */
 
 # if __GLIBC__
     /* Work around bug <http://sourceware.org/bugzilla/show_bug.cgi?id=9674> */
@@ -118,7 +118,7 @@ mbrtowc (wchar_t *pwc, const char *s, size_t n, mbstate_t *ps)
 	 lack mbrtowc(), we use the second approach.
 	 The possible encodings are:
 	   - 8-bit encodings,
-	   - EUC-JP, EUC-KR, GB2312, EUC-TW, BIG5, SJIS,
+	   - EUC-JP, EUC-KR, GB2312, EUC-TW, BIG5, GB18030, SJIS,
 	   - UTF-8.
 	 Use specialized code for each.  */
       if (m >= 4 || m >= MB_CUR_MAX)
@@ -238,6 +238,39 @@ mbrtowc (wchar_t *pwc, const char *s, size_t n, mbstate_t *ps)
 	      }
 	    goto invalid;
 	  }
+	if (STREQ (encoding, "GB18030", 'G', 'B', '1', '8', '0', '3', '0', 0, 0))
+	  {
+	    if (m == 1)
+	      {
+		unsigned char c = (unsigned char) p[0];
+
+		if ((c >= 0x90 && c <= 0xe3) || (c >= 0xf8 && c <= 0xfe))
+		  goto incomplete;
+	      }
+	    else /* m == 2 || m == 3 */
+	      {
+		unsigned char c = (unsigned char) p[0];
+
+		if (c >= 0x90 && c <= 0xe3)
+		  {
+		    unsigned char c2 = (unsigned char) p[1];
+
+		    if (c2 >= 0x30 && c2 <= 0x39)
+		      {
+			if (m == 2)
+			  goto incomplete;
+			else /* m == 3 */
+			  {
+			    unsigned char c3 = (unsigned char) p[2];
+
+			    if (c3 >= 0x81 && c3 <= 0xfe)
+			      goto incomplete;
+			  }
+		      }
+		  }
+	      }
+	    goto invalid;
+	  }
 	if (STREQ (encoding, "SJIS", 'S', 'J', 'I', 'S', 0, 0, 0, 0, 0))
 	  {
 	    if (m == 1)
@@ -258,10 +291,14 @@ mbrtowc (wchar_t *pwc, const char *s, size_t n, mbstate_t *ps)
      incomplete:
       {
 	size_t k = nstate;
-	/* Here 0 < k < m < 4.  */
+	/* Here 0 <= k < m < 4.  */
 	pstate[++k] = s[0];
 	if (k < m)
-	  pstate[++k] = s[1];
+	  {
+	    pstate[++k] = s[1];
+	    if (k < m)
+	      pstate[++k] = s[2];
+	  }
 	if (k != m)
 	  abort ();
       }
diff --git a/lib/memchr.c b/lib/memchr.c
new file mode 100644
index 000000000..3ea1d5bac
--- /dev/null
+++ b/lib/memchr.c
@@ -0,0 +1,172 @@
+/* Copyright (C) 1991, 1993, 1996, 1997, 1999, 2000, 2003, 2004, 2006, 2008
+   Free Software Foundation, Inc.
+
+   Based on strlen implementation by Torbjorn Granlund (tege@sics.se),
+   with help from Dan Sahlin (dan@sics.se) and
+   commentary by Jim Blandy (jimb@ai.mit.edu);
+   adaptation to memchr suggested by Dick Karpinski (dick@cca.ucsf.edu),
+   and implemented by Roland McGrath (roland@ai.mit.edu).
+
+NOTE: The canonical source of this file is maintained with the GNU C Library.
+Bugs can be reported to bug-glibc@prep.ai.mit.edu.
+
+This program is free software: you can redistribute it and/or modify it
+under the terms of the GNU Lesser General Public License as published by the
+Free Software Foundation; either version 3 of the License, or any
+later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU Lesser General Public License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#ifndef _LIBC
+# include <config.h>
+#endif
+
+#include <string.h>
+
+#include <stddef.h>
+
+#if defined _LIBC
+# include <memcopy.h>
+#else
+# define reg_char char
+#endif
+
+#include <limits.h>
+
+#if HAVE_BP_SYM_H || defined _LIBC
+# include <bp-sym.h>
+#else
+# define BP_SYM(sym) sym
+#endif
+
+#undef __memchr
+#ifdef _LIBC
+# undef memchr
+#endif
+
+#ifndef weak_alias
+# define __memchr memchr
+#endif
+
+/* Search no more than N bytes of S for C.  */
+void *
+__memchr (void const *s, int c_in, size_t n)
+{
+  /* On 32-bit hardware, choosing longword to be a 32-bit unsigned
+     long instead of a 64-bit uintmax_t tends to give better
+     performance.  On 64-bit hardware, unsigned long is generally 64
+     bits already.  Change this typedef to experiment with
+     performance.  */
+  typedef unsigned long int longword;
+
+  const unsigned char *char_ptr;
+  const longword *longword_ptr;
+  longword repeated_one;
+  longword repeated_c;
+  unsigned reg_char c;
+
+  c = (unsigned char) c_in;
+
+  /* Handle the first few bytes by reading one byte at a time.
+     Do this until CHAR_PTR is aligned on a longword boundary.  */
+  for (char_ptr = (const unsigned char *) s;
+       n > 0 && (size_t) char_ptr % sizeof (longword) != 0;
+       --n, ++char_ptr)
+    if (*char_ptr == c)
+      return (void *) char_ptr;
+
+  longword_ptr = (const longword *) char_ptr;
+
+  /* All these elucidatory comments refer to 4-byte longwords,
+     but the theory applies equally well to any size longwords.  */
+
+  /* Compute auxiliary longword values:
+     repeated_one is a value which has a 1 in every byte.
+     repeated_c has c in every byte.  */
+  repeated_one = 0x01010101;
+  repeated_c = c | (c << 8);
+  repeated_c |= repeated_c << 16;
+  if (0xffffffffU < (longword) -1)
+    {
+      repeated_one |= repeated_one << 31 << 1;
+      repeated_c |= repeated_c << 31 << 1;
+      if (8 < sizeof (longword))
+	{
+	  size_t i;
+
+	  for (i = 64; i < sizeof (longword) * 8; i *= 2)
+	    {
+	      repeated_one |= repeated_one << i;
+	      repeated_c |= repeated_c << i;
+	    }
+	}
+    }
+
+  /* Instead of the traditional loop which tests each byte, we will test a
+     longword at a time.  The tricky part is testing if *any of the four*
+     bytes in the longword in question are equal to c.  We first use an xor
+     with repeated_c.  This reduces the task to testing whether *any of the
+     four* bytes in longword1 is zero.
+
+     We compute tmp =
+       ((longword1 - repeated_one) & ~longword1) & (repeated_one << 7).
+     That is, we perform the following operations:
+       1. Subtract repeated_one.
+       2. & ~longword1.
+       3. & a mask consisting of 0x80 in every byte.
+     Consider what happens in each byte:
+       - If a byte of longword1 is zero, step 1 and 2 transform it into 0xff,
+         and step 3 transforms it into 0x80.  A carry can also be propagated
+         to more significant bytes.
+       - If a byte of longword1 is nonzero, let its lowest 1 bit be at
+         position k (0 <= k <= 7); so the lowest k bits are 0.  After step 1,
+         the byte ends in a single bit of value 0 and k bits of value 1.
+         After step 2, the result is just k bits of value 1: 2^k - 1.  After
+         step 3, the result is 0.  And no carry is produced.
+     So, if longword1 has only non-zero bytes, tmp is zero.
+     Whereas if longword1 has a zero byte, call j the position of the least
+     significant zero byte.  Then the result has a zero at positions 0, ...,
+     j-1 and a 0x80 at position j.  We cannot predict the result at the more
+     significant bytes (positions j+1..3), but it does not matter since we
+     already have a non-zero bit at position 8*j+7.
+
+     So, the test whether any byte in longword1 is zero is equivalent to
+     testing whether tmp is nonzero.  */
+
+  while (n >= sizeof (longword))
+    {
+      longword longword1 = *longword_ptr ^ repeated_c;
+
+      if ((((longword1 - repeated_one) & ~longword1)
+	   & (repeated_one << 7)) != 0)
+	break;
+      longword_ptr++;
+      n -= sizeof (longword);
+    }
+
+  char_ptr = (const unsigned char *) longword_ptr;
+
+  /* At this point, we know that either n < sizeof (longword), or one of the
+     sizeof (longword) bytes starting at char_ptr is == c.  On little-endian
+     machines, we could determine the first such byte without any further
+     memory accesses, just by looking at the tmp result from the last loop
+     iteration.  But this does not work on big-endian machines.  Choose code
+     that works in both cases.  */
+
+  for (; n > 0; --n, ++char_ptr)
+    {
+      if (*char_ptr == c)
+	return (void *) char_ptr;
+    }
+
+  return NULL;
+}
+#ifdef weak_alias
+weak_alias (__memchr, BP_SYM (memchr))
+#endif
diff --git a/lib/memchr.valgrind b/lib/memchr.valgrind
new file mode 100644
index 000000000..60f247e10
--- /dev/null
+++ b/lib/memchr.valgrind
@@ -0,0 +1,14 @@
+# Suppress a valgrind message about use of uninitialized memory in memchr().
+# POSIX states that when the character is found, memchr must not read extra
+# bytes in an overestimated length (for example, where memchr is used to
+# implement strnlen).  However, we use a safe word read to provide a speedup.
+{
+    memchr-value4
+    Memcheck:Value4
+    fun:rpl_memchr
+}
+{
+    memchr-value8
+    Memcheck:Value8
+    fun:rpl_memchr
+}
diff --git a/lib/pathmax.h b/lib/pathmax.h
new file mode 100644
index 000000000..a5d433560
--- /dev/null
+++ b/lib/pathmax.h
@@ -0,0 +1,47 @@
+/* Define PATH_MAX somehow.  Requires sys/types.h.
+   Copyright (C) 1992, 1999, 2001, 2003, 2005, 2009 Free Software Foundation, Inc.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 2, or (at your option)
+   any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program; if not, write to the Free Software Foundation,
+   Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+#ifndef _PATHMAX_H
+# define _PATHMAX_H
+
+# include <unistd.h>
+
+# include <limits.h>
+
+# ifndef _POSIX_PATH_MAX
+#  define _POSIX_PATH_MAX 256
+# endif
+
+# if !defined PATH_MAX && defined _PC_PATH_MAX && defined HAVE_PATHCONF
+#  define PATH_MAX (pathconf ("/", _PC_PATH_MAX) < 1 ? 1024 \
+		    : pathconf ("/", _PC_PATH_MAX))
+# endif
+
+/* Don't include sys/param.h if it already has been.  */
+# if defined HAVE_SYS_PARAM_H && !defined PATH_MAX && !defined MAXPATHLEN
+#  include <sys/param.h>
+# endif
+
+# if !defined PATH_MAX && defined MAXPATHLEN
+#  define PATH_MAX MAXPATHLEN
+# endif
+
+# ifndef PATH_MAX
+#  define PATH_MAX _POSIX_PATH_MAX
+# endif
+
+#endif /* _PATHMAX_H */
diff --git a/lib/printf-args.c b/lib/printf-args.c
new file mode 100644
index 000000000..c31d2042e
--- /dev/null
+++ b/lib/printf-args.c
@@ -0,0 +1,187 @@
+/* Decomposed printf argument list.
+   Copyright (C) 1999, 2002-2003, 2005-2007 Free Software Foundation, Inc.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 2, or (at your option)
+   any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License along
+   with this program; if not, write to the Free Software Foundation,
+   Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+/* This file can be parametrized with the following macros:
+     ENABLE_UNISTDIO    Set to 1 to enable the unistdio extensions.
+     PRINTF_FETCHARGS   Name of the function to be defined.
+     STATIC             Set to 'static' to declare the function static.  */
+
+#ifndef PRINTF_FETCHARGS
+# include <config.h>
+#endif
+
+/* Specification.  */
+#ifndef PRINTF_FETCHARGS
+# include "printf-args.h"
+#endif
+
+#ifdef STATIC
+STATIC
+#endif
+int
+PRINTF_FETCHARGS (va_list args, arguments *a)
+{
+  size_t i;
+  argument *ap;
+
+  for (i = 0, ap = &a->arg[0]; i < a->count; i++, ap++)
+    switch (ap->type)
+      {
+      case TYPE_SCHAR:
+	ap->a.a_schar = va_arg (args, /*signed char*/ int);
+	break;
+      case TYPE_UCHAR:
+	ap->a.a_uchar = va_arg (args, /*unsigned char*/ int);
+	break;
+      case TYPE_SHORT:
+	ap->a.a_short = va_arg (args, /*short*/ int);
+	break;
+      case TYPE_USHORT:
+	ap->a.a_ushort = va_arg (args, /*unsigned short*/ int);
+	break;
+      case TYPE_INT:
+	ap->a.a_int = va_arg (args, int);
+	break;
+      case TYPE_UINT:
+	ap->a.a_uint = va_arg (args, unsigned int);
+	break;
+      case TYPE_LONGINT:
+	ap->a.a_longint = va_arg (args, long int);
+	break;
+      case TYPE_ULONGINT:
+	ap->a.a_ulongint = va_arg (args, unsigned long int);
+	break;
+#if HAVE_LONG_LONG_INT
+      case TYPE_LONGLONGINT:
+	ap->a.a_longlongint = va_arg (args, long long int);
+	break;
+      case TYPE_ULONGLONGINT:
+	ap->a.a_ulonglongint = va_arg (args, unsigned long long int);
+	break;
+#endif
+      case TYPE_DOUBLE:
+	ap->a.a_double = va_arg (args, double);
+	break;
+      case TYPE_LONGDOUBLE:
+	ap->a.a_longdouble = va_arg (args, long double);
+	break;
+      case TYPE_CHAR:
+	ap->a.a_char = va_arg (args, int);
+	break;
+#if HAVE_WINT_T
+      case TYPE_WIDE_CHAR:
+	/* Although ISO C 99 7.24.1.(2) says that wint_t is "unchanged by
+	   default argument promotions", this is not the case in mingw32,
+	   where wint_t is 'unsigned short'.  */
+	ap->a.a_wide_char =
+	  (sizeof (wint_t) < sizeof (int)
+	   ? va_arg (args, int)
+	   : va_arg (args, wint_t));
+	break;
+#endif
+      case TYPE_STRING:
+	ap->a.a_string = va_arg (args, const char *);
+	/* A null pointer is an invalid argument for "%s", but in practice
+	   it occurs quite frequently in printf statements that produce
+	   debug output.  Use a fallback in this case.  */
+	if (ap->a.a_string == NULL)
+	  ap->a.a_string = "(NULL)";
+	break;
+#if HAVE_WCHAR_T
+      case TYPE_WIDE_STRING:
+	ap->a.a_wide_string = va_arg (args, const wchar_t *);
+	/* A null pointer is an invalid argument for "%ls", but in practice
+	   it occurs quite frequently in printf statements that produce
+	   debug output.  Use a fallback in this case.  */
+	if (ap->a.a_wide_string == NULL)
+	  {
+	    static const wchar_t wide_null_string[] =
+	      {
+		(wchar_t)'(',
+		(wchar_t)'N', (wchar_t)'U', (wchar_t)'L', (wchar_t)'L',
+		(wchar_t)')',
+		(wchar_t)0
+	      };
+	    ap->a.a_wide_string = wide_null_string;
+	  }
+	break;
+#endif
+      case TYPE_POINTER:
+	ap->a.a_pointer = va_arg (args, void *);
+	break;
+      case TYPE_COUNT_SCHAR_POINTER:
+	ap->a.a_count_schar_pointer = va_arg (args, signed char *);
+	break;
+      case TYPE_COUNT_SHORT_POINTER:
+	ap->a.a_count_short_pointer = va_arg (args, short *);
+	break;
+      case TYPE_COUNT_INT_POINTER:
+	ap->a.a_count_int_pointer = va_arg (args, int *);
+	break;
+      case TYPE_COUNT_LONGINT_POINTER:
+	ap->a.a_count_longint_pointer = va_arg (args, long int *);
+	break;
+#if HAVE_LONG_LONG_INT
+      case TYPE_COUNT_LONGLONGINT_POINTER:
+	ap->a.a_count_longlongint_pointer = va_arg (args, long long int *);
+	break;
+#endif
+#if ENABLE_UNISTDIO
+      /* The unistdio extensions.  */
+      case TYPE_U8_STRING:
+	ap->a.a_u8_string = va_arg (args, const uint8_t *);
+	/* A null pointer is an invalid argument for "%U", but in practice
+	   it occurs quite frequently in printf statements that produce
+	   debug output.  Use a fallback in this case.  */
+	if (ap->a.a_u8_string == NULL)
+	  {
+	    static const uint8_t u8_null_string[] =
+	      { '(', 'N', 'U', 'L', 'L', ')', 0 };
+	    ap->a.a_u8_string = u8_null_string;
+	  }
+	break;
+      case TYPE_U16_STRING:
+	ap->a.a_u16_string = va_arg (args, const uint16_t *);
+	/* A null pointer is an invalid argument for "%lU", but in practice
+	   it occurs quite frequently in printf statements that produce
+	   debug output.  Use a fallback in this case.  */
+	if (ap->a.a_u16_string == NULL)
+	  {
+	    static const uint16_t u16_null_string[] =
+	      { '(', 'N', 'U', 'L', 'L', ')', 0 };
+	    ap->a.a_u16_string = u16_null_string;
+	  }
+	break;
+      case TYPE_U32_STRING:
+	ap->a.a_u32_string = va_arg (args, const uint32_t *);
+	/* A null pointer is an invalid argument for "%llU", but in practice
+	   it occurs quite frequently in printf statements that produce
+	   debug output.  Use a fallback in this case.  */
+	if (ap->a.a_u32_string == NULL)
+	  {
+	    static const uint32_t u32_null_string[] =
+	      { '(', 'N', 'U', 'L', 'L', ')', 0 };
+	    ap->a.a_u32_string = u32_null_string;
+	  }
+	break;
+#endif
+      default:
+	/* Unknown type.  */
+	return -1;
+      }
+  return 0;
+}
diff --git a/lib/printf-args.h b/lib/printf-args.h
new file mode 100644
index 000000000..4c68f115f
--- /dev/null
+++ b/lib/printf-args.h
@@ -0,0 +1,154 @@
+/* Decomposed printf argument list.
+   Copyright (C) 1999, 2002-2003, 2006-2007 Free Software Foundation, Inc.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 2, or (at your option)
+   any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License along
+   with this program; if not, write to the Free Software Foundation,
+   Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+#ifndef _PRINTF_ARGS_H
+#define _PRINTF_ARGS_H
+
+/* This file can be parametrized with the following macros:
+     ENABLE_UNISTDIO    Set to 1 to enable the unistdio extensions.
+     PRINTF_FETCHARGS   Name of the function to be declared.
+     STATIC             Set to 'static' to declare the function static.  */
+
+/* Default parameters.  */
+#ifndef PRINTF_FETCHARGS
+# define PRINTF_FETCHARGS printf_fetchargs
+#endif
+
+/* Get size_t.  */
+#include <stddef.h>
+
+/* Get wchar_t.  */
+#if HAVE_WCHAR_T
+# include <stddef.h>
+#endif
+
+/* Get wint_t.  */
+#if HAVE_WINT_T
+# include <wchar.h>
+#endif
+
+/* Get va_list.  */
+#include <stdarg.h>
+
+
+/* Argument types */
+typedef enum
+{
+  TYPE_NONE,
+  TYPE_SCHAR,
+  TYPE_UCHAR,
+  TYPE_SHORT,
+  TYPE_USHORT,
+  TYPE_INT,
+  TYPE_UINT,
+  TYPE_LONGINT,
+  TYPE_ULONGINT,
+#if HAVE_LONG_LONG_INT
+  TYPE_LONGLONGINT,
+  TYPE_ULONGLONGINT,
+#endif
+  TYPE_DOUBLE,
+  TYPE_LONGDOUBLE,
+  TYPE_CHAR,
+#if HAVE_WINT_T
+  TYPE_WIDE_CHAR,
+#endif
+  TYPE_STRING,
+#if HAVE_WCHAR_T
+  TYPE_WIDE_STRING,
+#endif
+  TYPE_POINTER,
+  TYPE_COUNT_SCHAR_POINTER,
+  TYPE_COUNT_SHORT_POINTER,
+  TYPE_COUNT_INT_POINTER,
+  TYPE_COUNT_LONGINT_POINTER
+#if HAVE_LONG_LONG_INT
+, TYPE_COUNT_LONGLONGINT_POINTER
+#endif
+#if ENABLE_UNISTDIO
+  /* The unistdio extensions.  */
+, TYPE_U8_STRING
+, TYPE_U16_STRING
+, TYPE_U32_STRING
+#endif
+} arg_type;
+
+/* Polymorphic argument */
+typedef struct
+{
+  arg_type type;
+  union
+  {
+    signed char			a_schar;
+    unsigned char		a_uchar;
+    short			a_short;
+    unsigned short		a_ushort;
+    int				a_int;
+    unsigned int		a_uint;
+    long int			a_longint;
+    unsigned long int		a_ulongint;
+#if HAVE_LONG_LONG_INT
+    long long int		a_longlongint;
+    unsigned long long int	a_ulonglongint;
+#endif
+    float			a_float;
+    double			a_double;
+    long double			a_longdouble;
+    int				a_char;
+#if HAVE_WINT_T
+    wint_t			a_wide_char;
+#endif
+    const char*			a_string;
+#if HAVE_WCHAR_T
+    const wchar_t*		a_wide_string;
+#endif
+    void*			a_pointer;
+    signed char *		a_count_schar_pointer;
+    short *			a_count_short_pointer;
+    int *			a_count_int_pointer;
+    long int *			a_count_longint_pointer;
+#if HAVE_LONG_LONG_INT
+    long long int *		a_count_longlongint_pointer;
+#endif
+#if ENABLE_UNISTDIO
+    /* The unistdio extensions.  */
+    const uint8_t *		a_u8_string;
+    const uint16_t *		a_u16_string;
+    const uint32_t *		a_u32_string;
+#endif
+  }
+  a;
+}
+argument;
+
+typedef struct
+{
+  size_t count;
+  argument *arg;
+}
+arguments;
+
+
+/* Fetch the arguments, putting them into a. */
+#ifdef STATIC
+STATIC
+#else
+extern
+#endif
+int PRINTF_FETCHARGS (va_list args, arguments *a);
+
+#endif /* _PRINTF_ARGS_H */
diff --git a/lib/printf-parse.c b/lib/printf-parse.c
new file mode 100644
index 000000000..85c454b22
--- /dev/null
+++ b/lib/printf-parse.c
@@ -0,0 +1,627 @@
+/* Formatted output to strings.
+   Copyright (C) 1999-2000, 2002-2003, 2006-2008 Free Software Foundation, Inc.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 2, or (at your option)
+   any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License along
+   with this program; if not, write to the Free Software Foundation,
+   Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+/* This file can be parametrized with the following macros:
+     CHAR_T             The element type of the format string.
+     CHAR_T_ONLY_ASCII  Set to 1 to enable verification that all characters
+                        in the format string are ASCII.
+     DIRECTIVE          Structure denoting a format directive.
+                        Depends on CHAR_T.
+     DIRECTIVES         Structure denoting the set of format directives of a
+                        format string.  Depends on CHAR_T.
+     PRINTF_PARSE       Function that parses a format string.
+                        Depends on CHAR_T.
+     STATIC             Set to 'static' to declare the function static.
+     ENABLE_UNISTDIO    Set to 1 to enable the unistdio extensions.  */
+
+#ifndef PRINTF_PARSE
+# include <config.h>
+#endif
+
+/* Specification.  */
+#ifndef PRINTF_PARSE
+# include "printf-parse.h"
+#endif
+
+/* Default parameters.  */
+#ifndef PRINTF_PARSE
+# define PRINTF_PARSE printf_parse
+# define CHAR_T char
+# define DIRECTIVE char_directive
+# define DIRECTIVES char_directives
+#endif
+
+/* Get size_t, NULL.  */
+#include <stddef.h>
+
+/* Get intmax_t.  */
+#if defined IN_LIBINTL || defined IN_LIBASPRINTF
+# if HAVE_STDINT_H_WITH_UINTMAX
+#  include <stdint.h>
+# endif
+# if HAVE_INTTYPES_H_WITH_UINTMAX
+#  include <inttypes.h>
+# endif
+#else
+# include <stdint.h>
+#endif
+
+/* malloc(), realloc(), free().  */
+#include <stdlib.h>
+
+/* errno.  */
+#include <errno.h>
+
+/* Checked size_t computations.  */
+#include "xsize.h"
+
+#if CHAR_T_ONLY_ASCII
+/* c_isascii().  */
+# include "c-ctype.h"
+#endif
+
+#ifdef STATIC
+STATIC
+#endif
+int
+PRINTF_PARSE (const CHAR_T *format, DIRECTIVES *d, arguments *a)
+{
+  const CHAR_T *cp = format;		/* pointer into format */
+  size_t arg_posn = 0;		/* number of regular arguments consumed */
+  size_t d_allocated;			/* allocated elements of d->dir */
+  size_t a_allocated;			/* allocated elements of a->arg */
+  size_t max_width_length = 0;
+  size_t max_precision_length = 0;
+
+  d->count = 0;
+  d_allocated = 1;
+  d->dir = (DIRECTIVE *) malloc (d_allocated * sizeof (DIRECTIVE));
+  if (d->dir == NULL)
+    /* Out of memory.  */
+    goto out_of_memory_1;
+
+  a->count = 0;
+  a_allocated = 0;
+  a->arg = NULL;
+
+#define REGISTER_ARG(_index_,_type_) \
+  {									\
+    size_t n = (_index_);						\
+    if (n >= a_allocated)						\
+      {									\
+	size_t memory_size;						\
+	argument *memory;						\
+									\
+	a_allocated = xtimes (a_allocated, 2);				\
+	if (a_allocated <= n)						\
+	  a_allocated = xsum (n, 1);					\
+	memory_size = xtimes (a_allocated, sizeof (argument));		\
+	if (size_overflow_p (memory_size))				\
+	  /* Overflow, would lead to out of memory.  */			\
+	  goto out_of_memory;						\
+	memory = (argument *) (a->arg					\
+			       ? realloc (a->arg, memory_size)		\
+			       : malloc (memory_size));			\
+	if (memory == NULL)						\
+	  /* Out of memory.  */						\
+	  goto out_of_memory;						\
+	a->arg = memory;						\
+      }									\
+    while (a->count <= n)						\
+      a->arg[a->count++].type = TYPE_NONE;				\
+    if (a->arg[n].type == TYPE_NONE)					\
+      a->arg[n].type = (_type_);					\
+    else if (a->arg[n].type != (_type_))				\
+      /* Ambiguous type for positional argument.  */			\
+      goto error;							\
+  }
+
+  while (*cp != '\0')
+    {
+      CHAR_T c = *cp++;
+      if (c == '%')
+	{
+	  size_t arg_index = ARG_NONE;
+	  DIRECTIVE *dp = &d->dir[d->count]; /* pointer to next directive */
+
+	  /* Initialize the next directive.  */
+	  dp->dir_start = cp - 1;
+	  dp->flags = 0;
+	  dp->width_start = NULL;
+	  dp->width_end = NULL;
+	  dp->width_arg_index = ARG_NONE;
+	  dp->precision_start = NULL;
+	  dp->precision_end = NULL;
+	  dp->precision_arg_index = ARG_NONE;
+	  dp->arg_index = ARG_NONE;
+
+	  /* Test for positional argument.  */
+	  if (*cp >= '0' && *cp <= '9')
+	    {
+	      const CHAR_T *np;
+
+	      for (np = cp; *np >= '0' && *np <= '9'; np++)
+		;
+	      if (*np == '$')
+		{
+		  size_t n = 0;
+
+		  for (np = cp; *np >= '0' && *np <= '9'; np++)
+		    n = xsum (xtimes (n, 10), *np - '0');
+		  if (n == 0)
+		    /* Positional argument 0.  */
+		    goto error;
+		  if (size_overflow_p (n))
+		    /* n too large, would lead to out of memory later.  */
+		    goto error;
+		  arg_index = n - 1;
+		  cp = np + 1;
+		}
+	    }
+
+	  /* Read the flags.  */
+	  for (;;)
+	    {
+	      if (*cp == '\'')
+		{
+		  dp->flags |= FLAG_GROUP;
+		  cp++;
+		}
+	      else if (*cp == '-')
+		{
+		  dp->flags |= FLAG_LEFT;
+		  cp++;
+		}
+	      else if (*cp == '+')
+		{
+		  dp->flags |= FLAG_SHOWSIGN;
+		  cp++;
+		}
+	      else if (*cp == ' ')
+		{
+		  dp->flags |= FLAG_SPACE;
+		  cp++;
+		}
+	      else if (*cp == '#')
+		{
+		  dp->flags |= FLAG_ALT;
+		  cp++;
+		}
+	      else if (*cp == '0')
+		{
+		  dp->flags |= FLAG_ZERO;
+		  cp++;
+		}
+	      else
+		break;
+	    }
+
+	  /* Parse the field width.  */
+	  if (*cp == '*')
+	    {
+	      dp->width_start = cp;
+	      cp++;
+	      dp->width_end = cp;
+	      if (max_width_length < 1)
+		max_width_length = 1;
+
+	      /* Test for positional argument.  */
+	      if (*cp >= '0' && *cp <= '9')
+		{
+		  const CHAR_T *np;
+
+		  for (np = cp; *np >= '0' && *np <= '9'; np++)
+		    ;
+		  if (*np == '$')
+		    {
+		      size_t n = 0;
+
+		      for (np = cp; *np >= '0' && *np <= '9'; np++)
+			n = xsum (xtimes (n, 10), *np - '0');
+		      if (n == 0)
+			/* Positional argument 0.  */
+			goto error;
+		      if (size_overflow_p (n))
+			/* n too large, would lead to out of memory later.  */
+			goto error;
+		      dp->width_arg_index = n - 1;
+		      cp = np + 1;
+		    }
+		}
+	      if (dp->width_arg_index == ARG_NONE)
+		{
+		  dp->width_arg_index = arg_posn++;
+		  if (dp->width_arg_index == ARG_NONE)
+		    /* arg_posn wrapped around.  */
+		    goto error;
+		}
+	      REGISTER_ARG (dp->width_arg_index, TYPE_INT);
+	    }
+	  else if (*cp >= '0' && *cp <= '9')
+	    {
+	      size_t width_length;
+
+	      dp->width_start = cp;
+	      for (; *cp >= '0' && *cp <= '9'; cp++)
+		;
+	      dp->width_end = cp;
+	      width_length = dp->width_end - dp->width_start;
+	      if (max_width_length < width_length)
+		max_width_length = width_length;
+	    }
+
+	  /* Parse the precision.  */
+	  if (*cp == '.')
+	    {
+	      cp++;
+	      if (*cp == '*')
+		{
+		  dp->precision_start = cp - 1;
+		  cp++;
+		  dp->precision_end = cp;
+		  if (max_precision_length < 2)
+		    max_precision_length = 2;
+
+		  /* Test for positional argument.  */
+		  if (*cp >= '0' && *cp <= '9')
+		    {
+		      const CHAR_T *np;
+
+		      for (np = cp; *np >= '0' && *np <= '9'; np++)
+			;
+		      if (*np == '$')
+			{
+			  size_t n = 0;
+
+			  for (np = cp; *np >= '0' && *np <= '9'; np++)
+			    n = xsum (xtimes (n, 10), *np - '0');
+			  if (n == 0)
+			    /* Positional argument 0.  */
+			    goto error;
+			  if (size_overflow_p (n))
+			    /* n too large, would lead to out of memory
+			       later.  */
+			    goto error;
+			  dp->precision_arg_index = n - 1;
+			  cp = np + 1;
+			}
+		    }
+		  if (dp->precision_arg_index == ARG_NONE)
+		    {
+		      dp->precision_arg_index = arg_posn++;
+		      if (dp->precision_arg_index == ARG_NONE)
+			/* arg_posn wrapped around.  */
+			goto error;
+		    }
+		  REGISTER_ARG (dp->precision_arg_index, TYPE_INT);
+		}
+	      else
+		{
+		  size_t precision_length;
+
+		  dp->precision_start = cp - 1;
+		  for (; *cp >= '0' && *cp <= '9'; cp++)
+		    ;
+		  dp->precision_end = cp;
+		  precision_length = dp->precision_end - dp->precision_start;
+		  if (max_precision_length < precision_length)
+		    max_precision_length = precision_length;
+		}
+	    }
+
+	  {
+	    arg_type type;
+
+	    /* Parse argument type/size specifiers.  */
+	    {
+	      int flags = 0;
+
+	      for (;;)
+		{
+		  if (*cp == 'h')
+		    {
+		      flags |= (1 << (flags & 1));
+		      cp++;
+		    }
+		  else if (*cp == 'L')
+		    {
+		      flags |= 4;
+		      cp++;
+		    }
+		  else if (*cp == 'l')
+		    {
+		      flags += 8;
+		      cp++;
+		    }
+		  else if (*cp == 'j')
+		    {
+		      if (sizeof (intmax_t) > sizeof (long))
+			{
+			  /* intmax_t = long long */
+			  flags += 16;
+			}
+		      else if (sizeof (intmax_t) > sizeof (int))
+			{
+			  /* intmax_t = long */
+			  flags += 8;
+			}
+		      cp++;
+		    }
+		  else if (*cp == 'z' || *cp == 'Z')
+		    {
+		      /* 'z' is standardized in ISO C 99, but glibc uses 'Z'
+			 because the warning facility in gcc-2.95.2 understands
+			 only 'Z' (see gcc-2.95.2/gcc/c-common.c:1784).  */
+		      if (sizeof (size_t) > sizeof (long))
+			{
+			  /* size_t = long long */
+			  flags += 16;
+			}
+		      else if (sizeof (size_t) > sizeof (int))
+			{
+			  /* size_t = long */
+			  flags += 8;
+			}
+		      cp++;
+		    }
+		  else if (*cp == 't')
+		    {
+		      if (sizeof (ptrdiff_t) > sizeof (long))
+			{
+			  /* ptrdiff_t = long long */
+			  flags += 16;
+			}
+		      else if (sizeof (ptrdiff_t) > sizeof (int))
+			{
+			  /* ptrdiff_t = long */
+			  flags += 8;
+			}
+		      cp++;
+		    }
+#if defined __APPLE__ && defined __MACH__
+		  /* On MacOS X 10.3, PRIdMAX is defined as "qd".
+		     We cannot change it to "lld" because PRIdMAX must also
+		     be understood by the system's printf routines.  */
+		  else if (*cp == 'q')
+		    {
+		      if (64 / 8 > sizeof (long))
+			{
+			  /* int64_t = long long */
+			  flags += 16;
+			}
+		      else
+			{
+			  /* int64_t = long */
+			  flags += 8;
+			}
+		      cp++;
+		    }
+#endif
+#if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
+		  /* On native Win32, PRIdMAX is defined as "I64d".
+		     We cannot change it to "lld" because PRIdMAX must also
+		     be understood by the system's printf routines.  */
+		  else if (*cp == 'I' && cp[1] == '6' && cp[2] == '4')
+		    {
+		      if (64 / 8 > sizeof (long))
+			{
+			  /* __int64 = long long */
+			  flags += 16;
+			}
+		      else
+			{
+			  /* __int64 = long */
+			  flags += 8;
+			}
+		      cp += 3;
+		    }
+#endif
+		  else
+		    break;
+		}
+
+	      /* Read the conversion character.  */
+	      c = *cp++;
+	      switch (c)
+		{
+		case 'd': case 'i':
+#if HAVE_LONG_LONG_INT
+		  /* If 'long long' exists and is larger than 'long':  */
+		  if (flags >= 16 || (flags & 4))
+		    type = TYPE_LONGLONGINT;
+		  else
+#endif
+		  /* If 'long long' exists and is the same as 'long', we parse
+		     "lld" into TYPE_LONGINT.  */
+		  if (flags >= 8)
+		    type = TYPE_LONGINT;
+		  else if (flags & 2)
+		    type = TYPE_SCHAR;
+		  else if (flags & 1)
+		    type = TYPE_SHORT;
+		  else
+		    type = TYPE_INT;
+		  break;
+		case 'o': case 'u': case 'x': case 'X':
+#if HAVE_LONG_LONG_INT
+		  /* If 'long long' exists and is larger than 'long':  */
+		  if (flags >= 16 || (flags & 4))
+		    type = TYPE_ULONGLONGINT;
+		  else
+#endif
+		  /* If 'unsigned long long' exists and is the same as
+		     'unsigned long', we parse "llu" into TYPE_ULONGINT.  */
+		  if (flags >= 8)
+		    type = TYPE_ULONGINT;
+		  else if (flags & 2)
+		    type = TYPE_UCHAR;
+		  else if (flags & 1)
+		    type = TYPE_USHORT;
+		  else
+		    type = TYPE_UINT;
+		  break;
+		case 'f': case 'F': case 'e': case 'E': case 'g': case 'G':
+		case 'a': case 'A':
+		  if (flags >= 16 || (flags & 4))
+		    type = TYPE_LONGDOUBLE;
+		  else
+		    type = TYPE_DOUBLE;
+		  break;
+		case 'c':
+		  if (flags >= 8)
+#if HAVE_WINT_T
+		    type = TYPE_WIDE_CHAR;
+#else
+		    goto error;
+#endif
+		  else
+		    type = TYPE_CHAR;
+		  break;
+#if HAVE_WINT_T
+		case 'C':
+		  type = TYPE_WIDE_CHAR;
+		  c = 'c';
+		  break;
+#endif
+		case 's':
+		  if (flags >= 8)
+#if HAVE_WCHAR_T
+		    type = TYPE_WIDE_STRING;
+#else
+		    goto error;
+#endif
+		  else
+		    type = TYPE_STRING;
+		  break;
+#if HAVE_WCHAR_T
+		case 'S':
+		  type = TYPE_WIDE_STRING;
+		  c = 's';
+		  break;
+#endif
+		case 'p':
+		  type = TYPE_POINTER;
+		  break;
+		case 'n':
+#if HAVE_LONG_LONG_INT
+		  /* If 'long long' exists and is larger than 'long':  */
+		  if (flags >= 16 || (flags & 4))
+		    type = TYPE_COUNT_LONGLONGINT_POINTER;
+		  else
+#endif
+		  /* If 'long long' exists and is the same as 'long', we parse
+		     "lln" into TYPE_COUNT_LONGINT_POINTER.  */
+		  if (flags >= 8)
+		    type = TYPE_COUNT_LONGINT_POINTER;
+		  else if (flags & 2)
+		    type = TYPE_COUNT_SCHAR_POINTER;
+		  else if (flags & 1)
+		    type = TYPE_COUNT_SHORT_POINTER;
+		  else
+		    type = TYPE_COUNT_INT_POINTER;
+		  break;
+#if ENABLE_UNISTDIO
+		/* The unistdio extensions.  */
+		case 'U':
+		  if (flags >= 16)
+		    type = TYPE_U32_STRING;
+		  else if (flags >= 8)
+		    type = TYPE_U16_STRING;
+		  else
+		    type = TYPE_U8_STRING;
+		  break;
+#endif
+		case '%':
+		  type = TYPE_NONE;
+		  break;
+		default:
+		  /* Unknown conversion character.  */
+		  goto error;
+		}
+	    }
+
+	    if (type != TYPE_NONE)
+	      {
+		dp->arg_index = arg_index;
+		if (dp->arg_index == ARG_NONE)
+		  {
+		    dp->arg_index = arg_posn++;
+		    if (dp->arg_index == ARG_NONE)
+		      /* arg_posn wrapped around.  */
+		      goto error;
+		  }
+		REGISTER_ARG (dp->arg_index, type);
+	      }
+	    dp->conversion = c;
+	    dp->dir_end = cp;
+	  }
+
+	  d->count++;
+	  if (d->count >= d_allocated)
+	    {
+	      size_t memory_size;
+	      DIRECTIVE *memory;
+
+	      d_allocated = xtimes (d_allocated, 2);
+	      memory_size = xtimes (d_allocated, sizeof (DIRECTIVE));
+	      if (size_overflow_p (memory_size))
+		/* Overflow, would lead to out of memory.  */
+		goto out_of_memory;
+	      memory = (DIRECTIVE *) realloc (d->dir, memory_size);
+	      if (memory == NULL)
+		/* Out of memory.  */
+		goto out_of_memory;
+	      d->dir = memory;
+	    }
+	}
+#if CHAR_T_ONLY_ASCII
+      else if (!c_isascii (c))
+	{
+	  /* Non-ASCII character.  Not supported.  */
+	  goto error;
+	}
+#endif
+    }
+  d->dir[d->count].dir_start = cp;
+
+  d->max_width_length = max_width_length;
+  d->max_precision_length = max_precision_length;
+  return 0;
+
+error:
+  if (a->arg)
+    free (a->arg);
+  if (d->dir)
+    free (d->dir);
+  errno = EINVAL;
+  return -1;
+
+out_of_memory:
+  if (a->arg)
+    free (a->arg);
+  if (d->dir)
+    free (d->dir);
+out_of_memory_1:
+  errno = ENOMEM;
+  return -1;
+}
+
+#undef PRINTF_PARSE
+#undef DIRECTIVES
+#undef DIRECTIVE
+#undef CHAR_T_ONLY_ASCII
+#undef CHAR_T
diff --git a/lib/printf-parse.h b/lib/printf-parse.h
new file mode 100644
index 000000000..0a496cbda
--- /dev/null
+++ b/lib/printf-parse.h
@@ -0,0 +1,179 @@
+/* Parse printf format string.
+   Copyright (C) 1999, 2002-2003, 2005, 2007 Free Software Foundation, Inc.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 2, or (at your option)
+   any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License along
+   with this program; if not, write to the Free Software Foundation,
+   Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+#ifndef _PRINTF_PARSE_H
+#define _PRINTF_PARSE_H
+
+/* This file can be parametrized with the following macros:
+     ENABLE_UNISTDIO    Set to 1 to enable the unistdio extensions.
+     STATIC             Set to 'static' to declare the function static.  */
+
+#include "printf-args.h"
+
+
+/* Flags */
+#define FLAG_GROUP	 1	/* ' flag */
+#define FLAG_LEFT	 2	/* - flag */
+#define FLAG_SHOWSIGN	 4	/* + flag */
+#define FLAG_SPACE	 8	/* space flag */
+#define FLAG_ALT	16	/* # flag */
+#define FLAG_ZERO	32
+
+/* arg_index value indicating that no argument is consumed.  */
+#define ARG_NONE	(~(size_t)0)
+
+/* xxx_directive: A parsed directive.
+   xxx_directives: A parsed format string.  */
+
+/* A parsed directive.  */
+typedef struct
+{
+  const char* dir_start;
+  const char* dir_end;
+  int flags;
+  const char* width_start;
+  const char* width_end;
+  size_t width_arg_index;
+  const char* precision_start;
+  const char* precision_end;
+  size_t precision_arg_index;
+  char conversion; /* d i o u x X f F e E g G a A c s p n U % but not C S */
+  size_t arg_index;
+}
+char_directive;
+
+/* A parsed format string.  */
+typedef struct
+{
+  size_t count;
+  char_directive *dir;
+  size_t max_width_length;
+  size_t max_precision_length;
+}
+char_directives;
+
+#if ENABLE_UNISTDIO
+
+/* A parsed directive.  */
+typedef struct
+{
+  const uint8_t* dir_start;
+  const uint8_t* dir_end;
+  int flags;
+  const uint8_t* width_start;
+  const uint8_t* width_end;
+  size_t width_arg_index;
+  const uint8_t* precision_start;
+  const uint8_t* precision_end;
+  size_t precision_arg_index;
+  uint8_t conversion; /* d i o u x X f F e E g G a A c s p n U % but not C S */
+  size_t arg_index;
+}
+u8_directive;
+
+/* A parsed format string.  */
+typedef struct
+{
+  size_t count;
+  u8_directive *dir;
+  size_t max_width_length;
+  size_t max_precision_length;
+}
+u8_directives;
+
+/* A parsed directive.  */
+typedef struct
+{
+  const uint16_t* dir_start;
+  const uint16_t* dir_end;
+  int flags;
+  const uint16_t* width_start;
+  const uint16_t* width_end;
+  size_t width_arg_index;
+  const uint16_t* precision_start;
+  const uint16_t* precision_end;
+  size_t precision_arg_index;
+  uint16_t conversion; /* d i o u x X f F e E g G a A c s p n U % but not C S */
+  size_t arg_index;
+}
+u16_directive;
+
+/* A parsed format string.  */
+typedef struct
+{
+  size_t count;
+  u16_directive *dir;
+  size_t max_width_length;
+  size_t max_precision_length;
+}
+u16_directives;
+
+/* A parsed directive.  */
+typedef struct
+{
+  const uint32_t* dir_start;
+  const uint32_t* dir_end;
+  int flags;
+  const uint32_t* width_start;
+  const uint32_t* width_end;
+  size_t width_arg_index;
+  const uint32_t* precision_start;
+  const uint32_t* precision_end;
+  size_t precision_arg_index;
+  uint32_t conversion; /* d i o u x X f F e E g G a A c s p n U % but not C S */
+  size_t arg_index;
+}
+u32_directive;
+
+/* A parsed format string.  */
+typedef struct
+{
+  size_t count;
+  u32_directive *dir;
+  size_t max_width_length;
+  size_t max_precision_length;
+}
+u32_directives;
+
+#endif
+
+
+/* Parses the format string.  Fills in the number N of directives, and fills
+   in directives[0], ..., directives[N-1], and sets directives[N].dir_start
+   to the end of the format string.  Also fills in the arg_type fields of the
+   arguments and the needed count of arguments.  */
+#if ENABLE_UNISTDIO
+extern int
+       ulc_printf_parse (const char *format, char_directives *d, arguments *a);
+extern int
+       u8_printf_parse (const uint8_t *format, u8_directives *d, arguments *a);
+extern int
+       u16_printf_parse (const uint16_t *format, u16_directives *d,
+			 arguments *a);
+extern int
+       u32_printf_parse (const uint32_t *format, u32_directives *d,
+			 arguments *a);
+#else
+# ifdef STATIC
+STATIC
+# else
+extern
+# endif
+int printf_parse (const char *format, char_directives *d, arguments *a);
+#endif
+
+#endif /* _PRINTF_PARSE_H */
diff --git a/lib/putenv.c b/lib/putenv.c
new file mode 100644
index 000000000..53cc83912
--- /dev/null
+++ b/lib/putenv.c
@@ -0,0 +1,132 @@
+/* Copyright (C) 1991, 1994, 1997-1998, 2000, 2003-2008
+   Free Software Foundation, Inc.
+
+   NOTE: The canonical source of this file is maintained with the GNU C
+   Library.  Bugs can be reported to bug-glibc@prep.ai.mit.edu.
+
+   This program is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published by the
+   Free Software Foundation; either version 3 of the License, or any
+   later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#include <config.h>
+
+/* Specification.  */
+#include <stdlib.h>
+
+#include <stddef.h>
+
+/* Include errno.h *after* sys/types.h to work around header problems
+   on AIX 3.2.5.  */
+#include <errno.h>
+#ifndef __set_errno
+# define __set_errno(ev) ((errno) = (ev))
+#endif
+
+#include <string.h>
+#include <unistd.h>
+
+#if HAVE_GNU_LD
+# define environ __environ
+#else
+extern char **environ;
+#endif
+
+#if _LIBC
+/* This lock protects against simultaneous modifications of `environ'.  */
+# include <bits/libc-lock.h>
+__libc_lock_define_initialized (static, envlock)
+# define LOCK	__libc_lock_lock (envlock)
+# define UNLOCK	__libc_lock_unlock (envlock)
+#else
+# define LOCK
+# define UNLOCK
+#endif
+
+static int
+_unsetenv (const char *name)
+{
+  size_t len;
+  char **ep;
+
+  if (name == NULL || *name == '\0' || strchr (name, '=') != NULL)
+    {
+      __set_errno (EINVAL);
+      return -1;
+    }
+
+  len = strlen (name);
+
+  LOCK;
+
+  ep = environ;
+  while (*ep != NULL)
+    if (!strncmp (*ep, name, len) && (*ep)[len] == '=')
+      {
+	/* Found it.  Remove this pointer by moving later ones back.  */
+	char **dp = ep;
+
+	do
+	  dp[0] = dp[1];
+	while (*dp++);
+	/* Continue the loop in case NAME appears again.  */
+      }
+    else
+      ++ep;
+
+  UNLOCK;
+
+  return 0;
+}
+
+
+/* Put STRING, which is of the form "NAME=VALUE", in the environment.
+   If STRING contains no `=', then remove STRING from the environment.  */
+int
+putenv (char *string)
+{
+  const char *const name_end = strchr (string, '=');
+  register size_t size;
+  register char **ep;
+
+  if (name_end == NULL)
+    {
+      /* Remove the variable from the environment.  */
+      return _unsetenv (string);
+    }
+
+  size = 0;
+  for (ep = environ; *ep != NULL; ++ep)
+    if (!strncmp (*ep, string, name_end - string) &&
+	(*ep)[name_end - string] == '=')
+      break;
+    else
+      ++size;
+
+  if (*ep == NULL)
+    {
+      static char **last_environ = NULL;
+      char **new_environ = (char **) malloc ((size + 2) * sizeof (char *));
+      if (new_environ == NULL)
+	return -1;
+      (void) memcpy ((void *) new_environ, (void *) environ,
+		     size * sizeof (char *));
+      new_environ[size] = (char *) string;
+      new_environ[size + 1] = NULL;
+      free (last_environ);
+      last_environ = new_environ;
+      environ = new_environ;
+    }
+  else
+    *ep = string;
+
+  return 0;
+}
diff --git a/lib/readlink.c b/lib/readlink.c
new file mode 100644
index 000000000..c9f49f815
--- /dev/null
+++ b/lib/readlink.c
@@ -0,0 +1,49 @@
+/* Stub for readlink().
+   Copyright (C) 2003-2007 Free Software Foundation, Inc.
+
+   This program is free software: you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#include <config.h>
+
+/* Specification.  */
+#include <unistd.h>
+
+#include <errno.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <stddef.h>
+
+#if !HAVE_READLINK
+
+/* readlink() substitute for systems that don't have a readlink() function,
+   such as DJGPP 2.03 and mingw32.  */
+
+/* The official POSIX return type of readlink() is ssize_t, but since here
+   we have no declaration in a public header file, we use 'int' as return
+   type.  */
+
+int
+readlink (const char *path, char *buf, size_t bufsize)
+{
+  struct stat statbuf;
+
+  /* In general we should use lstat() here, not stat().  But on platforms
+     without symbolic links lstat() - if it exists - would be equivalent to
+     stat(), therefore we can use stat().  This saves us a configure check.  */
+  if (stat (path, &statbuf) >= 0)
+    errno = EINVAL;
+  return -1;
+}
+
+#endif
diff --git a/lib/size_max.h b/lib/size_max.h
new file mode 100644
index 000000000..419d73a18
--- /dev/null
+++ b/lib/size_max.h
@@ -0,0 +1,31 @@
+/* size_max.h -- declare SIZE_MAX through system headers
+   Copyright (C) 2005-2006 Free Software Foundation, Inc.
+   Written by Simon Josefsson.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 2, or (at your option)
+   any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program; if not, write to the Free Software Foundation,
+   Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+#ifndef GNULIB_SIZE_MAX_H
+#define GNULIB_SIZE_MAX_H
+
+/* Get SIZE_MAX declaration on systems like Solaris 7/8/9.  */
+# include <limits.h>
+/* Get SIZE_MAX declaration on systems like glibc 2.  */
+# if HAVE_STDINT_H
+#  include <stdint.h>
+# endif
+/* On systems where these include files don't define it, SIZE_MAX is defined
+   in config.h.  */
+
+#endif /* GNULIB_SIZE_MAX_H */
diff --git a/lib/stdint.in.h b/lib/stdint.in.h
new file mode 100644
index 000000000..11a211763
--- /dev/null
+++ b/lib/stdint.in.h
@@ -0,0 +1,567 @@
+/* Copyright (C) 2001-2002, 2004-2009 Free Software Foundation, Inc.
+   Written by Paul Eggert, Bruno Haible, Sam Steingold, Peter Burwood.
+   This file is part of gnulib.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 2, or (at your option)
+   any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program; if not, write to the Free Software Foundation,
+   Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+/*
+ * ISO C 99 <stdint.h> for platforms that lack it.
+ * <http://www.opengroup.org/susv3xbd/stdint.h.html>
+ */
+
+#ifndef _GL_STDINT_H
+
+/* When including a system file that in turn includes <inttypes.h>,
+   use the system <inttypes.h>, not our substitute.  This avoids
+   problems with (for example) VMS, whose <sys/bitypes.h> includes
+   <inttypes.h>.  */
+#define _GL_JUST_INCLUDE_SYSTEM_INTTYPES_H
+
+/* Get those types that are already defined in other system include
+   files, so that we can "#define int8_t signed char" below without
+   worrying about a later system include file containing a "typedef
+   signed char int8_t;" that will get messed up by our macro.  Our
+   macros should all be consistent with the system versions, except
+   for the "fast" types and macros, which we recommend against using
+   in public interfaces due to compiler differences.  */
+
+#if @HAVE_STDINT_H@
+# if defined __sgi && ! defined __c99
+   /* Bypass IRIX's <stdint.h> if in C89 mode, since it merely annoys users
+      with "This header file is to be used only for c99 mode compilations"
+      diagnostics.  */
+#  define __STDINT_H__
+# endif
+  /* Other systems may have an incomplete or buggy <stdint.h>.
+     Include it before <inttypes.h>, since any "#include <stdint.h>"
+     in <inttypes.h> would reinclude us, skipping our contents because
+     _GL_STDINT_H is defined.
+     The include_next requires a split double-inclusion guard.  */
+# if __GNUC__ >= 3
+@PRAGMA_SYSTEM_HEADER@
+# endif
+# @INCLUDE_NEXT@ @NEXT_STDINT_H@
+#endif
+
+#if ! defined _GL_STDINT_H && ! defined _GL_JUST_INCLUDE_SYSTEM_STDINT_H
+#define _GL_STDINT_H
+
+/* <sys/types.h> defines some of the stdint.h types as well, on glibc,
+   IRIX 6.5, and OpenBSD 3.8 (via <machine/types.h>).
+   AIX 5.2 <sys/types.h> isn't needed and causes troubles.
+   MacOS X 10.4.6 <sys/types.h> includes <stdint.h> (which is us), but
+   relies on the system <stdint.h> definitions, so include
+   <sys/types.h> after @NEXT_STDINT_H@.  */
+#if @HAVE_SYS_TYPES_H@ && ! defined _AIX
+# include <sys/types.h>
+#endif
+
+/* Get LONG_MIN, LONG_MAX, ULONG_MAX.  */
+#include <limits.h>
+
+#if @HAVE_INTTYPES_H@
+  /* In OpenBSD 3.8, <inttypes.h> includes <machine/types.h>, which defines
+     int{8,16,32,64}_t, uint{8,16,32,64}_t and __BIT_TYPES_DEFINED__.
+     <inttypes.h> also defines intptr_t and uintptr_t.  */
+# include <inttypes.h>
+#elif @HAVE_SYS_INTTYPES_H@
+  /* Solaris 7 <sys/inttypes.h> has the types except the *_fast*_t types, and
+     the macros except for *_FAST*_*, INTPTR_MIN, PTRDIFF_MIN, PTRDIFF_MAX.  */
+# include <sys/inttypes.h>
+#endif
+
+#if @HAVE_SYS_BITYPES_H@ && ! defined __BIT_TYPES_DEFINED__
+  /* Linux libc4 >= 4.6.7 and libc5 have a <sys/bitypes.h> that defines
+     int{8,16,32,64}_t and __BIT_TYPES_DEFINED__.  In libc5 >= 5.2.2 it is
+     included by <sys/types.h>.  */
+# include <sys/bitypes.h>
+#endif
+
+#undef _GL_JUST_INCLUDE_SYSTEM_INTTYPES_H
+
+/* Minimum and maximum values for a integer type under the usual assumption.
+   Return an unspecified value if BITS == 0, adding a check to pacify
+   picky compilers.  */
+
+#define _STDINT_MIN(signed, bits, zero) \
+  ((signed) ? (- ((zero) + 1) << ((bits) ? (bits) - 1 : 0)) : (zero))
+
+#define _STDINT_MAX(signed, bits, zero) \
+  ((signed) \
+   ? ~ _STDINT_MIN (signed, bits, zero) \
+   : /* The expression for the unsigned case.  The subtraction of (signed) \
+	is a nop in the unsigned case and avoids "signed integer overflow" \
+	warnings in the signed case.  */ \
+     ((((zero) + 1) << ((bits) ? (bits) - 1 - (signed) : 0)) - 1) * 2 + 1)
+
+/* 7.18.1.1. Exact-width integer types */
+
+/* Here we assume a standard architecture where the hardware integer
+   types have 8, 16, 32, optionally 64 bits.  */
+
+#undef int8_t
+#undef uint8_t
+typedef signed char gl_int8_t;
+typedef unsigned char gl_uint8_t;
+#define int8_t gl_int8_t
+#define uint8_t gl_uint8_t
+
+#undef int16_t
+#undef uint16_t
+typedef short int gl_int16_t;
+typedef unsigned short int gl_uint16_t;
+#define int16_t gl_int16_t
+#define uint16_t gl_uint16_t
+
+#undef int32_t
+#undef uint32_t
+typedef int gl_int32_t;
+typedef unsigned int gl_uint32_t;
+#define int32_t gl_int32_t
+#define uint32_t gl_uint32_t
+
+/* Do not undefine int64_t if gnulib is not being used with 64-bit
+   types, since otherwise it breaks platforms like Tandem/NSK.  */
+#if LONG_MAX >> 31 >> 31 == 1
+# undef int64_t
+typedef long int gl_int64_t;
+# define int64_t gl_int64_t
+# define GL_INT64_T
+#elif defined _MSC_VER
+# undef int64_t
+typedef __int64 gl_int64_t;
+# define int64_t gl_int64_t
+# define GL_INT64_T
+#elif @HAVE_LONG_LONG_INT@
+# undef int64_t
+typedef long long int gl_int64_t;
+# define int64_t gl_int64_t
+# define GL_INT64_T
+#endif
+
+#if ULONG_MAX >> 31 >> 31 >> 1 == 1
+# undef uint64_t
+typedef unsigned long int gl_uint64_t;
+# define uint64_t gl_uint64_t
+# define GL_UINT64_T
+#elif defined _MSC_VER
+# undef uint64_t
+typedef unsigned __int64 gl_uint64_t;
+# define uint64_t gl_uint64_t
+# define GL_UINT64_T
+#elif @HAVE_UNSIGNED_LONG_LONG_INT@
+# undef uint64_t
+typedef unsigned long long int gl_uint64_t;
+# define uint64_t gl_uint64_t
+# define GL_UINT64_T
+#endif
+
+/* Avoid collision with Solaris 2.5.1 <pthread.h> etc.  */
+#define _UINT8_T
+#define _UINT32_T
+#define _UINT64_T
+
+
+/* 7.18.1.2. Minimum-width integer types */
+
+/* Here we assume a standard architecture where the hardware integer
+   types have 8, 16, 32, optionally 64 bits. Therefore the leastN_t types
+   are the same as the corresponding N_t types.  */
+
+#undef int_least8_t
+#undef uint_least8_t
+#undef int_least16_t
+#undef uint_least16_t
+#undef int_least32_t
+#undef uint_least32_t
+#undef int_least64_t
+#undef uint_least64_t
+#define int_least8_t int8_t
+#define uint_least8_t uint8_t
+#define int_least16_t int16_t
+#define uint_least16_t uint16_t
+#define int_least32_t int32_t
+#define uint_least32_t uint32_t
+#ifdef GL_INT64_T
+# define int_least64_t int64_t
+#endif
+#ifdef GL_UINT64_T
+# define uint_least64_t uint64_t
+#endif
+
+/* 7.18.1.3. Fastest minimum-width integer types */
+
+/* Note: Other <stdint.h> substitutes may define these types differently.
+   It is not recommended to use these types in public header files. */
+
+/* Here we assume a standard architecture where the hardware integer
+   types have 8, 16, 32, optionally 64 bits. Therefore the fastN_t types
+   are taken from the same list of types.  Assume that 'long int'
+   is fast enough for all narrower integers.  */
+
+#undef int_fast8_t
+#undef uint_fast8_t
+#undef int_fast16_t
+#undef uint_fast16_t
+#undef int_fast32_t
+#undef uint_fast32_t
+#undef int_fast64_t
+#undef uint_fast64_t
+typedef long int gl_int_fast8_t;
+typedef unsigned long int gl_uint_fast8_t;
+typedef long int gl_int_fast16_t;
+typedef unsigned long int gl_uint_fast16_t;
+typedef long int gl_int_fast32_t;
+typedef unsigned long int gl_uint_fast32_t;
+#define int_fast8_t gl_int_fast8_t
+#define uint_fast8_t gl_uint_fast8_t
+#define int_fast16_t gl_int_fast16_t
+#define uint_fast16_t gl_uint_fast16_t
+#define int_fast32_t gl_int_fast32_t
+#define uint_fast32_t gl_uint_fast32_t
+#ifdef GL_INT64_T
+# define int_fast64_t int64_t
+#endif
+#ifdef GL_UINT64_T
+# define uint_fast64_t uint64_t
+#endif
+
+/* 7.18.1.4. Integer types capable of holding object pointers */
+
+#undef intptr_t
+#undef uintptr_t
+typedef long int gl_intptr_t;
+typedef unsigned long int gl_uintptr_t;
+#define intptr_t gl_intptr_t
+#define uintptr_t gl_uintptr_t
+
+/* 7.18.1.5. Greatest-width integer types */
+
+/* Note: These types are compiler dependent. It may be unwise to use them in
+   public header files. */
+
+#undef intmax_t
+#if @HAVE_LONG_LONG_INT@ && LONG_MAX >> 30 == 1
+typedef long long int gl_intmax_t;
+# define intmax_t gl_intmax_t
+#elif defined GL_INT64_T
+# define intmax_t int64_t
+#else
+typedef long int gl_intmax_t;
+# define intmax_t gl_intmax_t
+#endif
+
+#undef uintmax_t
+#if @HAVE_UNSIGNED_LONG_LONG_INT@ && ULONG_MAX >> 31 == 1
+typedef unsigned long long int gl_uintmax_t;
+# define uintmax_t gl_uintmax_t
+#elif defined GL_UINT64_T
+# define uintmax_t uint64_t
+#else
+typedef unsigned long int gl_uintmax_t;
+# define uintmax_t gl_uintmax_t
+#endif
+
+/* Verify that intmax_t and uintmax_t have the same size.  Too much code
+   breaks if this is not the case.  If this check fails, the reason is likely
+   to be found in the autoconf macros.  */
+typedef int _verify_intmax_size[2 * (sizeof (intmax_t) == sizeof (uintmax_t)) - 1];
+
+/* 7.18.2. Limits of specified-width integer types */
+
+#if ! defined __cplusplus || defined __STDC_LIMIT_MACROS
+
+/* 7.18.2.1. Limits of exact-width integer types */
+
+/* Here we assume a standard architecture where the hardware integer
+   types have 8, 16, 32, optionally 64 bits.  */
+
+#undef INT8_MIN
+#undef INT8_MAX
+#undef UINT8_MAX
+#define INT8_MIN  (~ INT8_MAX)
+#define INT8_MAX  127
+#define UINT8_MAX  255
+
+#undef INT16_MIN
+#undef INT16_MAX
+#undef UINT16_MAX
+#define INT16_MIN  (~ INT16_MAX)
+#define INT16_MAX  32767
+#define UINT16_MAX  65535
+
+#undef INT32_MIN
+#undef INT32_MAX
+#undef UINT32_MAX
+#define INT32_MIN  (~ INT32_MAX)
+#define INT32_MAX  2147483647
+#define UINT32_MAX  4294967295U
+
+#undef INT64_MIN
+#undef INT64_MAX
+#ifdef GL_INT64_T
+/* Prefer (- INTMAX_C (1) << 63) over (~ INT64_MAX) because SunPRO C 5.0
+   evaluates the latter incorrectly in preprocessor expressions.  */
+# define INT64_MIN  (- INTMAX_C (1) << 63)
+# define INT64_MAX  INTMAX_C (9223372036854775807)
+#endif
+
+#undef UINT64_MAX
+#ifdef GL_UINT64_T
+# define UINT64_MAX  UINTMAX_C (18446744073709551615)
+#endif
+
+/* 7.18.2.2. Limits of minimum-width integer types */
+
+/* Here we assume a standard architecture where the hardware integer
+   types have 8, 16, 32, optionally 64 bits. Therefore the leastN_t types
+   are the same as the corresponding N_t types.  */
+
+#undef INT_LEAST8_MIN
+#undef INT_LEAST8_MAX
+#undef UINT_LEAST8_MAX
+#define INT_LEAST8_MIN  INT8_MIN
+#define INT_LEAST8_MAX  INT8_MAX
+#define UINT_LEAST8_MAX  UINT8_MAX
+
+#undef INT_LEAST16_MIN
+#undef INT_LEAST16_MAX
+#undef UINT_LEAST16_MAX
+#define INT_LEAST16_MIN  INT16_MIN
+#define INT_LEAST16_MAX  INT16_MAX
+#define UINT_LEAST16_MAX  UINT16_MAX
+
+#undef INT_LEAST32_MIN
+#undef INT_LEAST32_MAX
+#undef UINT_LEAST32_MAX
+#define INT_LEAST32_MIN  INT32_MIN
+#define INT_LEAST32_MAX  INT32_MAX
+#define UINT_LEAST32_MAX  UINT32_MAX
+
+#undef INT_LEAST64_MIN
+#undef INT_LEAST64_MAX
+#ifdef GL_INT64_T
+# define INT_LEAST64_MIN  INT64_MIN
+# define INT_LEAST64_MAX  INT64_MAX
+#endif
+
+#undef UINT_LEAST64_MAX
+#ifdef GL_UINT64_T
+# define UINT_LEAST64_MAX  UINT64_MAX
+#endif
+
+/* 7.18.2.3. Limits of fastest minimum-width integer types */
+
+/* Here we assume a standard architecture where the hardware integer
+   types have 8, 16, 32, optionally 64 bits. Therefore the fastN_t types
+   are taken from the same list of types.  */
+
+#undef INT_FAST8_MIN
+#undef INT_FAST8_MAX
+#undef UINT_FAST8_MAX
+#define INT_FAST8_MIN  LONG_MIN
+#define INT_FAST8_MAX  LONG_MAX
+#define UINT_FAST8_MAX  ULONG_MAX
+
+#undef INT_FAST16_MIN
+#undef INT_FAST16_MAX
+#undef UINT_FAST16_MAX
+#define INT_FAST16_MIN  LONG_MIN
+#define INT_FAST16_MAX  LONG_MAX
+#define UINT_FAST16_MAX  ULONG_MAX
+
+#undef INT_FAST32_MIN
+#undef INT_FAST32_MAX
+#undef UINT_FAST32_MAX
+#define INT_FAST32_MIN  LONG_MIN
+#define INT_FAST32_MAX  LONG_MAX
+#define UINT_FAST32_MAX  ULONG_MAX
+
+#undef INT_FAST64_MIN
+#undef INT_FAST64_MAX
+#ifdef GL_INT64_T
+# define INT_FAST64_MIN  INT64_MIN
+# define INT_FAST64_MAX  INT64_MAX
+#endif
+
+#undef UINT_FAST64_MAX
+#ifdef GL_UINT64_T
+# define UINT_FAST64_MAX  UINT64_MAX
+#endif
+
+/* 7.18.2.4. Limits of integer types capable of holding object pointers */
+
+#undef INTPTR_MIN
+#undef INTPTR_MAX
+#undef UINTPTR_MAX
+#define INTPTR_MIN  LONG_MIN
+#define INTPTR_MAX  LONG_MAX
+#define UINTPTR_MAX  ULONG_MAX
+
+/* 7.18.2.5. Limits of greatest-width integer types */
+
+#undef INTMAX_MIN
+#undef INTMAX_MAX
+#ifdef INT64_MAX
+# define INTMAX_MIN  INT64_MIN
+# define INTMAX_MAX  INT64_MAX
+#else
+# define INTMAX_MIN  INT32_MIN
+# define INTMAX_MAX  INT32_MAX
+#endif
+
+#undef UINTMAX_MAX
+#ifdef UINT64_MAX
+# define UINTMAX_MAX  UINT64_MAX
+#else
+# define UINTMAX_MAX  UINT32_MAX
+#endif
+
+/* 7.18.3. Limits of other integer types */
+
+/* ptrdiff_t limits */
+#undef PTRDIFF_MIN
+#undef PTRDIFF_MAX
+#if @APPLE_UNIVERSAL_BUILD@
+# ifdef _LP64
+#  define PTRDIFF_MIN  _STDINT_MIN (1, 64, 0l)
+#  define PTRDIFF_MAX  _STDINT_MAX (1, 64, 0l)
+# else
+#  define PTRDIFF_MIN  _STDINT_MIN (1, 32, 0)
+#  define PTRDIFF_MAX  _STDINT_MAX (1, 32, 0)
+# endif
+#else
+# define PTRDIFF_MIN  \
+    _STDINT_MIN (1, @BITSIZEOF_PTRDIFF_T@, 0@PTRDIFF_T_SUFFIX@)
+# define PTRDIFF_MAX  \
+    _STDINT_MAX (1, @BITSIZEOF_PTRDIFF_T@, 0@PTRDIFF_T_SUFFIX@)
+#endif
+
+/* sig_atomic_t limits */
+#undef SIG_ATOMIC_MIN
+#undef SIG_ATOMIC_MAX
+#define SIG_ATOMIC_MIN  \
+   _STDINT_MIN (@HAVE_SIGNED_SIG_ATOMIC_T@, @BITSIZEOF_SIG_ATOMIC_T@, \
+		0@SIG_ATOMIC_T_SUFFIX@)
+#define SIG_ATOMIC_MAX  \
+   _STDINT_MAX (@HAVE_SIGNED_SIG_ATOMIC_T@, @BITSIZEOF_SIG_ATOMIC_T@, \
+		0@SIG_ATOMIC_T_SUFFIX@)
+
+
+/* size_t limit */
+#undef SIZE_MAX
+#if @APPLE_UNIVERSAL_BUILD@
+# ifdef _LP64
+#  define SIZE_MAX  _STDINT_MAX (0, 64, 0ul)
+# else
+#  define SIZE_MAX  _STDINT_MAX (0, 32, 0ul)
+# endif
+#else
+# define SIZE_MAX  _STDINT_MAX (0, @BITSIZEOF_SIZE_T@, 0@SIZE_T_SUFFIX@)
+#endif
+
+/* wchar_t limits */
+/* Get WCHAR_MIN, WCHAR_MAX.
+   This include is not on the top, above, because on OSF/1 4.0 we have a sequence of nested
+   includes <wchar.h> -> <stdio.h> -> <getopt.h> -> <stdlib.h>, and the latter includes
+   <stdint.h> and assumes its types are already defined.  */
+#if ! (defined WCHAR_MIN && defined WCHAR_MAX)
+# define _GL_JUST_INCLUDE_SYSTEM_WCHAR_H
+# include <wchar.h>
+# undef _GL_JUST_INCLUDE_SYSTEM_WCHAR_H
+#endif
+#undef WCHAR_MIN
+#undef WCHAR_MAX
+#define WCHAR_MIN  \
+   _STDINT_MIN (@HAVE_SIGNED_WCHAR_T@, @BITSIZEOF_WCHAR_T@, 0@WCHAR_T_SUFFIX@)
+#define WCHAR_MAX  \
+   _STDINT_MAX (@HAVE_SIGNED_WCHAR_T@, @BITSIZEOF_WCHAR_T@, 0@WCHAR_T_SUFFIX@)
+
+/* wint_t limits */
+#undef WINT_MIN
+#undef WINT_MAX
+#define WINT_MIN  \
+   _STDINT_MIN (@HAVE_SIGNED_WINT_T@, @BITSIZEOF_WINT_T@, 0@WINT_T_SUFFIX@)
+#define WINT_MAX  \
+   _STDINT_MAX (@HAVE_SIGNED_WINT_T@, @BITSIZEOF_WINT_T@, 0@WINT_T_SUFFIX@)
+
+#endif /* !defined __cplusplus || defined __STDC_LIMIT_MACROS */
+
+/* 7.18.4. Macros for integer constants */
+
+#if ! defined __cplusplus || defined __STDC_CONSTANT_MACROS
+
+/* 7.18.4.1. Macros for minimum-width integer constants */
+/* According to ISO C 99 Technical Corrigendum 1 */
+
+/* Here we assume a standard architecture where the hardware integer
+   types have 8, 16, 32, optionally 64 bits, and int is 32 bits.  */
+
+#undef INT8_C
+#undef UINT8_C
+#define INT8_C(x) x
+#define UINT8_C(x) x
+
+#undef INT16_C
+#undef UINT16_C
+#define INT16_C(x) x
+#define UINT16_C(x) x
+
+#undef INT32_C
+#undef UINT32_C
+#define INT32_C(x) x
+#define UINT32_C(x) x ## U
+
+#undef INT64_C
+#undef UINT64_C
+#if LONG_MAX >> 31 >> 31 == 1
+# define INT64_C(x) x##L
+#elif defined _MSC_VER
+# define INT64_C(x) x##i64
+#elif @HAVE_LONG_LONG_INT@
+# define INT64_C(x) x##LL
+#endif
+#if ULONG_MAX >> 31 >> 31 >> 1 == 1
+# define UINT64_C(x) x##UL
+#elif defined _MSC_VER
+# define UINT64_C(x) x##ui64
+#elif @HAVE_UNSIGNED_LONG_LONG_INT@
+# define UINT64_C(x) x##ULL
+#endif
+
+/* 7.18.4.2. Macros for greatest-width integer constants */
+
+#undef INTMAX_C
+#if @HAVE_LONG_LONG_INT@ && LONG_MAX >> 30 == 1
+# define INTMAX_C(x)   x##LL
+#elif defined GL_INT64_T
+# define INTMAX_C(x)   INT64_C(x)
+#else
+# define INTMAX_C(x)   x##L
+#endif
+
+#undef UINTMAX_C
+#if @HAVE_UNSIGNED_LONG_LONG_INT@ && ULONG_MAX >> 31 == 1
+# define UINTMAX_C(x)  x##ULL
+#elif defined GL_UINT64_T
+# define UINTMAX_C(x)  UINT64_C(x)
+#else
+# define UINTMAX_C(x)  x##UL
+#endif
+
+#endif /* !defined __cplusplus || defined __STDC_CONSTANT_MACROS */
+
+#endif /* _GL_STDINT_H */
+#endif /* !defined _GL_STDINT_H && !defined _GL_JUST_INCLUDE_SYSTEM_STDINT_H */
diff --git a/lib/stdio-write.c b/lib/stdio-write.c
new file mode 100644
index 000000000..8f275ffb2
--- /dev/null
+++ b/lib/stdio-write.c
@@ -0,0 +1,148 @@
+/* POSIX compatible FILE stream write function.
+   Copyright (C) 2008 Free Software Foundation, Inc.
+   Written by Bruno Haible <bruno@clisp.org>, 2008.
+
+   This program is free software: you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#include <config.h>
+
+/* Specification.  */
+#include <stdio.h>
+
+/* Replace these functions only if module 'sigpipe' is requested.  */
+#if GNULIB_SIGPIPE
+
+/* On native Windows platforms, SIGPIPE does not exist.  When write() is
+   called on a pipe with no readers, WriteFile() fails with error
+   GetLastError() = ERROR_NO_DATA, and write() in consequence fails with
+   error EINVAL.  This write() function is at the basis of the function
+   which flushes the buffer of a FILE stream.  */
+
+# if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
+
+#  include <errno.h>
+#  include <signal.h>
+#  include <io.h>
+
+#  define WIN32_LEAN_AND_MEAN  /* avoid including junk */
+#  include <windows.h>
+
+#  define CALL_WITH_SIGPIPE_EMULATION(RETTYPE, EXPRESSION, FAILED) \
+  if (ferror (stream))							      \
+    return (EXPRESSION);						      \
+  else									      \
+    {									      \
+      RETTYPE ret;							      \
+      SetLastError (0);							      \
+      ret = (EXPRESSION);						      \
+      if (FAILED && GetLastError () == ERROR_NO_DATA && ferror (stream))      \
+	{								      \
+	  int fd = fileno (stream);					      \
+	  if (fd >= 0							      \
+	      && GetFileType ((HANDLE) _get_osfhandle (fd)) == FILE_TYPE_PIPE)\
+	    {								      \
+	      /* Try to raise signal SIGPIPE.  */			      \
+	      raise (SIGPIPE);						      \
+	      /* If it is currently blocked or ignored, change errno from     \
+		 EINVAL to EPIPE.  */					      \
+	      errno = EPIPE;						      \
+	    }								      \
+	}								      \
+      return ret;							      \
+    }
+
+#  if !REPLACE_PRINTF_POSIX /* avoid collision with printf.c */
+int
+printf (const char *format, ...)
+{
+  int retval;
+  va_list args;
+
+  va_start (args, format);
+  retval = vfprintf (stdout, format, args);
+  va_end (args);
+
+  return retval;
+}
+#  endif
+
+#  if !REPLACE_FPRINTF_POSIX /* avoid collision with fprintf.c */
+int
+fprintf (FILE *stream, const char *format, ...)
+{
+  int retval;
+  va_list args;
+
+  va_start (args, format);
+  retval = vfprintf (stream, format, args);
+  va_end (args);
+
+  return retval;
+}
+#  endif
+
+#  if !REPLACE_VFPRINTF_POSIX /* avoid collision with vprintf.c */
+int
+vprintf (const char *format, va_list args)
+{
+  return vfprintf (stdout, format, args);
+}
+#  endif
+
+#  if !REPLACE_VPRINTF_POSIX /* avoid collision with vfprintf.c */
+int
+vfprintf (FILE *stream, const char *format, va_list args)
+#undef vfprintf
+{
+  CALL_WITH_SIGPIPE_EMULATION (int, vfprintf (stream, format, args), ret == EOF)
+}
+#  endif
+
+int
+putchar (int c)
+{
+  return fputc (c, stdout);
+}
+
+int
+fputc (int c, FILE *stream)
+#undef fputc
+{
+  CALL_WITH_SIGPIPE_EMULATION (int, fputc (c, stream), ret == EOF)
+}
+
+int
+fputs (const char *string, FILE *stream)
+#undef fputs
+{
+  CALL_WITH_SIGPIPE_EMULATION (int, fputs (string, stream), ret == EOF)
+}
+
+int
+puts (const char *string)
+#undef puts
+{
+  FILE *stream = stdout;
+  CALL_WITH_SIGPIPE_EMULATION (int, puts (string), ret == EOF)
+}
+
+size_t
+fwrite (const void *ptr, size_t s, size_t n, FILE *stream)
+#undef fwrite
+{
+  CALL_WITH_SIGPIPE_EMULATION (size_t, fwrite (ptr, s, n, stream), ret < n)
+}
+
+# endif
+#endif
diff --git a/lib/stdio.in.h b/lib/stdio.in.h
new file mode 100644
index 000000000..ae681fccc
--- /dev/null
+++ b/lib/stdio.in.h
@@ -0,0 +1,542 @@
+/* A GNU-like <stdio.h>.
+
+   Copyright (C) 2004, 2007-2009 Free Software Foundation, Inc.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 2, or (at your option)
+   any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program; if not, write to the Free Software Foundation,
+   Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+#if __GNUC__ >= 3
+@PRAGMA_SYSTEM_HEADER@
+#endif
+
+#if defined __need_FILE || defined __need___FILE
+/* Special invocation convention inside glibc header files.  */
+
+#@INCLUDE_NEXT@ @NEXT_STDIO_H@
+
+#else
+/* Normal invocation convention.  */
+
+#ifndef _GL_STDIO_H
+
+/* The include_next requires a split double-inclusion guard.  */
+#@INCLUDE_NEXT@ @NEXT_STDIO_H@
+
+#ifndef _GL_STDIO_H
+#define _GL_STDIO_H
+
+#include <stdarg.h>
+#include <stddef.h>
+
+#if (@GNULIB_FSEEKO@ && @REPLACE_FSEEKO@) \
+  || (@GNULIB_FTELLO@ && @REPLACE_FTELLO@) \
+  || (@GNULIB_GETDELIM@ && !@HAVE_DECL_GETDELIM@) \
+  || (@GNULIB_GETLINE@ && (!@HAVE_DECL_GETLINE@ || @REPLACE_GETLINE@))
+/* Get off_t and ssize_t.  */
+# include <sys/types.h>
+#endif
+
+#ifndef __attribute__
+/* This feature is available in gcc versions 2.5 and later.  */
+# if __GNUC__ < 2 || (__GNUC__ == 2 && __GNUC_MINOR__ < 5)
+#  define __attribute__(Spec) /* empty */
+# endif
+/* The __-protected variants of `format' and `printf' attributes
+   are accepted by gcc versions 2.6.4 (effectively 2.7) and later.  */
+# if __GNUC__ < 2 || (__GNUC__ == 2 && __GNUC_MINOR__ < 7)
+#  define __format__ format
+#  define __printf__ printf
+# endif
+#endif
+
+
+/* The definition of GL_LINK_WARNING is copied here.  */
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
+#if @GNULIB_FPRINTF_POSIX@
+# if @REPLACE_FPRINTF@
+#  define fprintf rpl_fprintf
+extern int fprintf (FILE *fp, const char *format, ...)
+       __attribute__ ((__format__ (__printf__, 2, 3)));
+# endif
+#elif @GNULIB_FPRINTF@ && @REPLACE_STDIO_WRITE_FUNCS@ && @GNULIB_STDIO_H_SIGPIPE@
+# define fprintf rpl_fprintf
+extern int fprintf (FILE *fp, const char *format, ...)
+       __attribute__ ((__format__ (__printf__, 2, 3)));
+#elif defined GNULIB_POSIXCHECK
+# undef fprintf
+# define fprintf \
+    (GL_LINK_WARNING ("fprintf is not always POSIX compliant - " \
+                      "use gnulib module fprintf-posix for portable " \
+                      "POSIX compliance"), \
+     fprintf)
+#endif
+
+#if @GNULIB_VFPRINTF_POSIX@
+# if @REPLACE_VFPRINTF@
+#  define vfprintf rpl_vfprintf
+extern int vfprintf (FILE *fp, const char *format, va_list args)
+       __attribute__ ((__format__ (__printf__, 2, 0)));
+# endif
+#elif @GNULIB_VFPRINTF@ && @REPLACE_STDIO_WRITE_FUNCS@ && @GNULIB_STDIO_H_SIGPIPE@
+# define vfprintf rpl_vfprintf
+extern int vfprintf (FILE *fp, const char *format, va_list args)
+       __attribute__ ((__format__ (__printf__, 2, 0)));
+#elif defined GNULIB_POSIXCHECK
+# undef vfprintf
+# define vfprintf(s,f,a) \
+    (GL_LINK_WARNING ("vfprintf is not always POSIX compliant - " \
+                      "use gnulib module vfprintf-posix for portable " \
+                      "POSIX compliance"), \
+     vfprintf (s, f, a))
+#endif
+
+#if @GNULIB_PRINTF_POSIX@
+# if @REPLACE_PRINTF@
+/* Don't break __attribute__((format(printf,M,N))).  */
+#  define printf __printf__
+extern int printf (const char *format, ...)
+       __attribute__ ((__format__ (__printf__, 1, 2)));
+# endif
+#elif @GNULIB_PRINTF@ && @REPLACE_STDIO_WRITE_FUNCS@ && @GNULIB_STDIO_H_SIGPIPE@
+/* Don't break __attribute__((format(printf,M,N))).  */
+# define printf __printf__
+extern int printf (const char *format, ...)
+       __attribute__ ((__format__ (__printf__, 1, 2)));
+#elif defined GNULIB_POSIXCHECK
+# undef printf
+# define printf \
+    (GL_LINK_WARNING ("printf is not always POSIX compliant - " \
+                      "use gnulib module printf-posix for portable " \
+                      "POSIX compliance"), \
+     printf)
+/* Don't break __attribute__((format(printf,M,N))).  */
+# define format(kind,m,n) format (__##kind##__, m, n)
+# define __format__(kind,m,n) __format__ (__##kind##__, m, n)
+# define ____printf____ __printf__
+# define ____scanf____ __scanf__
+# define ____strftime____ __strftime__
+# define ____strfmon____ __strfmon__
+#endif
+
+#if @GNULIB_VPRINTF_POSIX@
+# if @REPLACE_VPRINTF@
+#  define vprintf rpl_vprintf
+extern int vprintf (const char *format, va_list args)
+       __attribute__ ((__format__ (__printf__, 1, 0)));
+# endif
+#elif @GNULIB_VPRINTF@ && @REPLACE_STDIO_WRITE_FUNCS@ && @GNULIB_STDIO_H_SIGPIPE@
+# define vprintf rpl_vprintf
+extern int vprintf (const char *format, va_list args)
+       __attribute__ ((__format__ (__printf__, 1, 0)));
+#elif defined GNULIB_POSIXCHECK
+# undef vprintf
+# define vprintf(f,a) \
+    (GL_LINK_WARNING ("vprintf is not always POSIX compliant - " \
+                      "use gnulib module vprintf-posix for portable " \
+                      "POSIX compliance"), \
+     vprintf (f, a))
+#endif
+
+#if @GNULIB_SNPRINTF@
+# if @REPLACE_SNPRINTF@
+#  define snprintf rpl_snprintf
+# endif
+# if @REPLACE_SNPRINTF@ || !@HAVE_DECL_SNPRINTF@
+extern int snprintf (char *str, size_t size, const char *format, ...)
+       __attribute__ ((__format__ (__printf__, 3, 4)));
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef snprintf
+# define snprintf \
+    (GL_LINK_WARNING ("snprintf is unportable - " \
+                      "use gnulib module snprintf for portability"), \
+     snprintf)
+#endif
+
+#if @GNULIB_VSNPRINTF@
+# if @REPLACE_VSNPRINTF@
+#  define vsnprintf rpl_vsnprintf
+# endif
+# if @REPLACE_VSNPRINTF@ || !@HAVE_DECL_VSNPRINTF@
+extern int vsnprintf (char *str, size_t size, const char *format, va_list args)
+       __attribute__ ((__format__ (__printf__, 3, 0)));
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef vsnprintf
+# define vsnprintf(b,s,f,a) \
+    (GL_LINK_WARNING ("vsnprintf is unportable - " \
+                      "use gnulib module vsnprintf for portability"), \
+     vsnprintf (b, s, f, a))
+#endif
+
+#if @GNULIB_SPRINTF_POSIX@
+# if @REPLACE_SPRINTF@
+#  define sprintf rpl_sprintf
+extern int sprintf (char *str, const char *format, ...)
+       __attribute__ ((__format__ (__printf__, 2, 3)));
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef sprintf
+# define sprintf \
+    (GL_LINK_WARNING ("sprintf is not always POSIX compliant - " \
+                      "use gnulib module sprintf-posix for portable " \
+                      "POSIX compliance"), \
+     sprintf)
+#endif
+
+#if @GNULIB_VSPRINTF_POSIX@
+# if @REPLACE_VSPRINTF@
+#  define vsprintf rpl_vsprintf
+extern int vsprintf (char *str, const char *format, va_list args)
+       __attribute__ ((__format__ (__printf__, 2, 0)));
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef vsprintf
+# define vsprintf(b,f,a) \
+    (GL_LINK_WARNING ("vsprintf is not always POSIX compliant - " \
+                      "use gnulib module vsprintf-posix for portable " \
+                      "POSIX compliance"), \
+     vsprintf (b, f, a))
+#endif
+
+#if @GNULIB_DPRINTF@
+# if @REPLACE_DPRINTF@
+#  define dprintf rpl_dprintf
+# endif
+# if @REPLACE_DPRINTF@ || !@HAVE_DPRINTF@
+extern int dprintf (int fd, const char *format, ...)
+       __attribute__ ((__format__ (__printf__, 2, 3)));
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef dprintf
+# define dprintf(d,f,a) \
+    (GL_LINK_WARNING ("dprintf is unportable - " \
+                      "use gnulib module dprintf for portability"), \
+     dprintf (d, f, a))
+#endif
+
+#if @GNULIB_VDPRINTF@
+# if @REPLACE_VDPRINTF@
+#  define vdprintf rpl_vdprintf
+# endif
+# if @REPLACE_VDPRINTF@ || !@HAVE_VDPRINTF@
+extern int vdprintf (int fd, const char *format, va_list args)
+       __attribute__ ((__format__ (__printf__, 2, 0)));
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef vdprintf
+# define vdprintf(d,f,a) \
+    (GL_LINK_WARNING ("vdprintf is unportable - " \
+                      "use gnulib module vdprintf for portability"), \
+     vdprintf (d, f, a))
+#endif
+
+#if @GNULIB_VASPRINTF@
+# if @REPLACE_VASPRINTF@
+#  define asprintf rpl_asprintf
+#  define vasprintf rpl_vasprintf
+# endif
+# if @REPLACE_VASPRINTF@ || !@HAVE_VASPRINTF@
+  /* Write formatted output to a string dynamically allocated with malloc().
+     If the memory allocation succeeds, store the address of the string in
+     *RESULT and return the number of resulting bytes, excluding the trailing
+     NUL.  Upon memory allocation error, or some other error, return -1.  */
+  extern int asprintf (char **result, const char *format, ...)
+    __attribute__ ((__format__ (__printf__, 2, 3)));
+  extern int vasprintf (char **result, const char *format, va_list args)
+    __attribute__ ((__format__ (__printf__, 2, 0)));
+# endif
+#endif
+
+#if @GNULIB_OBSTACK_PRINTF@
+# if @REPLACE_OBSTACK_PRINTF@
+#  define obstack_printf rpl_osbtack_printf
+#  define obstack_vprintf rpl_obstack_vprintf
+# endif
+# if @REPLACE_OBSTACK_PRINTF@ || !@HAVE_DECL_OBSTACK_PRINTF@
+  struct obstack;
+  /* Grow an obstack with formatted output.  Return the number of
+     bytes added to OBS.  No trailing nul byte is added, and the
+     object should be closed with obstack_finish before use.  Upon
+     memory allocation error, call obstack_alloc_failed_handler.  Upon
+     other error, return -1.  */
+  extern int obstack_printf (struct obstack *obs, const char *format, ...)
+    __attribute__ ((__format__ (__printf__, 2, 3)));
+  extern int obstack_vprintf (struct obstack *obs, const char *format,
+			      va_list args)
+    __attribute__ ((__format__ (__printf__, 2, 0)));
+# endif
+#endif
+
+#if @GNULIB_FOPEN@
+# if @REPLACE_FOPEN@
+#  undef fopen
+#  define fopen rpl_fopen
+extern FILE * fopen (const char *filename, const char *mode);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef fopen
+# define fopen(f,m) \
+   (GL_LINK_WARNING ("fopen on Win32 platforms is not POSIX compatible - " \
+                     "use gnulib module fopen for portability"), \
+    fopen (f, m))
+#endif
+
+#if @GNULIB_FREOPEN@
+# if @REPLACE_FREOPEN@
+#  undef freopen
+#  define freopen rpl_freopen
+extern FILE * freopen (const char *filename, const char *mode, FILE *stream);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef freopen
+# define freopen(f,m,s) \
+   (GL_LINK_WARNING ("freopen on Win32 platforms is not POSIX compatible - " \
+                     "use gnulib module freopen for portability"), \
+    freopen (f, m, s))
+#endif
+
+#if @GNULIB_FSEEKO@
+# if @REPLACE_FSEEKO@
+/* Provide fseek, fseeko functions that are aware of a preceding
+   fflush(), and which detect pipes.  */
+#  define fseeko rpl_fseeko
+extern int fseeko (FILE *fp, off_t offset, int whence);
+#  define fseek(fp, offset, whence) fseeko (fp, (off_t)(offset), whence)
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef fseeko
+# define fseeko(f,o,w) \
+   (GL_LINK_WARNING ("fseeko is unportable - " \
+                     "use gnulib module fseeko for portability"), \
+    fseeko (f, o, w))
+#endif
+
+#if @GNULIB_FSEEK@ && @REPLACE_FSEEK@
+extern int rpl_fseek (FILE *fp, long offset, int whence);
+# undef fseek
+# if defined GNULIB_POSIXCHECK
+#  define fseek(f,o,w) \
+     (GL_LINK_WARNING ("fseek cannot handle files larger than 4 GB " \
+                       "on 32-bit platforms - " \
+                       "use fseeko function for handling of large files"), \
+      rpl_fseek (f, o, w))
+# else
+#  define fseek rpl_fseek
+# endif
+#elif defined GNULIB_POSIXCHECK
+# ifndef fseek
+#  define fseek(f,o,w) \
+     (GL_LINK_WARNING ("fseek cannot handle files larger than 4 GB " \
+                       "on 32-bit platforms - " \
+                       "use fseeko function for handling of large files"), \
+      fseek (f, o, w))
+# endif
+#endif
+
+#if @GNULIB_FTELLO@
+# if @REPLACE_FTELLO@
+#  define ftello rpl_ftello
+extern off_t ftello (FILE *fp);
+#  define ftell(fp) ftello (fp)
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef ftello
+# define ftello(f) \
+   (GL_LINK_WARNING ("ftello is unportable - " \
+                     "use gnulib module ftello for portability"), \
+    ftello (f))
+#endif
+
+#if @GNULIB_FTELL@ && @REPLACE_FTELL@
+extern long rpl_ftell (FILE *fp);
+# undef ftell
+# if GNULIB_POSIXCHECK
+#  define ftell(f) \
+     (GL_LINK_WARNING ("ftell cannot handle files larger than 4 GB " \
+                       "on 32-bit platforms - " \
+                       "use ftello function for handling of large files"), \
+      rpl_ftell (f))
+# else
+#  define ftell rpl_ftell
+# endif
+#elif defined GNULIB_POSIXCHECK
+# ifndef ftell
+#  define ftell(f) \
+     (GL_LINK_WARNING ("ftell cannot handle files larger than 4 GB " \
+                       "on 32-bit platforms - " \
+                       "use ftello function for handling of large files"), \
+      ftell (f))
+# endif
+#endif
+
+#if @GNULIB_FFLUSH@
+# if @REPLACE_FFLUSH@
+#  define fflush rpl_fflush
+  /* Flush all pending data on STREAM according to POSIX rules.  Both
+     output and seekable input streams are supported.
+     Note! LOSS OF DATA can occur if fflush is applied on an input stream
+     that is _not_seekable_ or on an update stream that is _not_seekable_
+     and in which the most recent operation was input.  Seekability can
+     be tested with lseek(fileno(fp),0,SEEK_CUR).  */
+  extern int fflush (FILE *gl_stream);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef fflush
+# define fflush(f) \
+   (GL_LINK_WARNING ("fflush is not always POSIX compliant - " \
+                     "use gnulib module fflush for portable " \
+                     "POSIX compliance"), \
+    fflush (f))
+#endif
+
+#if @GNULIB_FPURGE@
+# if @REPLACE_FPURGE@
+#  define fpurge rpl_fpurge
+# endif
+# if @REPLACE_FPURGE@ || !@HAVE_DECL_FPURGE@
+  /* Discard all pending buffered I/O data on STREAM.
+     STREAM must not be wide-character oriented.
+     Return 0 if successful.  Upon error, return -1 and set errno.  */
+  extern int fpurge (FILE *gl_stream);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef fpurge
+# define fpurge(f) \
+   (GL_LINK_WARNING ("fpurge is not always present - " \
+                     "use gnulib module fpurge for portability"), \
+    fpurge (f))
+#endif
+
+#if @GNULIB_FCLOSE@
+# if @REPLACE_FCLOSE@
+#  define fclose rpl_fclose
+  /* Close STREAM and its underlying file descriptor.  */
+extern int fclose (FILE *stream);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef fclose
+# define fclose(f) \
+   (GL_LINK_WARNING ("fclose is not always POSIX compliant - " \
+                     "use gnulib module fclose for portable " \
+                     "POSIX compliance"), \
+    fclose (f))
+#endif
+
+#if @GNULIB_FPUTC@ && @REPLACE_STDIO_WRITE_FUNCS@ && @GNULIB_STDIO_H_SIGPIPE@
+# undef fputc
+# define fputc rpl_fputc
+extern int fputc (int c, FILE *stream);
+#endif
+
+#if @GNULIB_PUTC@ && @REPLACE_STDIO_WRITE_FUNCS@ && @GNULIB_STDIO_H_SIGPIPE@
+# undef putc
+# define putc rpl_fputc
+extern int putc (int c, FILE *stream);
+#endif
+
+#if @GNULIB_PUTCHAR@ && @REPLACE_STDIO_WRITE_FUNCS@ && @GNULIB_STDIO_H_SIGPIPE@
+# undef putchar
+# define putchar rpl_putchar
+extern int putchar (int c);
+#endif
+
+#if @GNULIB_FPUTS@ && @REPLACE_STDIO_WRITE_FUNCS@ && @GNULIB_STDIO_H_SIGPIPE@
+# undef fputs
+# define fputs rpl_fputs
+extern int fputs (const char *string, FILE *stream);
+#endif
+
+#if @GNULIB_PUTS@ && @REPLACE_STDIO_WRITE_FUNCS@ && @GNULIB_STDIO_H_SIGPIPE@
+# undef puts
+# define puts rpl_puts
+extern int puts (const char *string);
+#endif
+
+#if @GNULIB_FWRITE@ && @REPLACE_STDIO_WRITE_FUNCS@ && @GNULIB_STDIO_H_SIGPIPE@
+# undef fwrite
+# define fwrite rpl_fwrite
+extern size_t fwrite (const void *ptr, size_t s, size_t n, FILE *stream);
+#endif
+
+#if @GNULIB_GETDELIM@
+# if !@HAVE_DECL_GETDELIM@
+/* Read input, up to (and including) the next occurrence of DELIMITER, from
+   STREAM, store it in *LINEPTR (and NUL-terminate it).
+   *LINEPTR is a pointer returned from malloc (or NULL), pointing to *LINESIZE
+   bytes of space.  It is realloc'd as necessary.
+   Return the number of bytes read and stored at *LINEPTR (not including the
+   NUL terminator), or -1 on error or EOF.  */
+extern ssize_t getdelim (char **lineptr, size_t *linesize, int delimiter,
+			 FILE *stream);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef getdelim
+# define getdelim(l, s, d, f)					    \
+  (GL_LINK_WARNING ("getdelim is unportable - "			    \
+		    "use gnulib module getdelim for portability"),  \
+   getdelim (l, s, d, f))
+#endif
+
+#if @GNULIB_GETLINE@
+# if @REPLACE_GETLINE@
+#  undef getline
+#  define getline rpl_getline
+# endif
+# if !@HAVE_DECL_GETLINE@ || @REPLACE_GETLINE@
+/* Read a line, up to (and including) the next newline, from STREAM, store it
+   in *LINEPTR (and NUL-terminate it).
+   *LINEPTR is a pointer returned from malloc (or NULL), pointing to *LINESIZE
+   bytes of space.  It is realloc'd as necessary.
+   Return the number of bytes read and stored at *LINEPTR (not including the
+   NUL terminator), or -1 on error or EOF.  */
+extern ssize_t getline (char **lineptr, size_t *linesize, FILE *stream);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef getline
+# define getline(l, s, f)						\
+  (GL_LINK_WARNING ("getline is unportable - "				\
+		    "use gnulib module getline for portability"),	\
+   getline (l, s, f))
+#endif
+
+#if @GNULIB_PERROR@
+# if @REPLACE_PERROR@
+#  define perror rpl_perror
+/* Print a message to standard error, describing the value of ERRNO,
+   (if STRING is not NULL and not empty) prefixed with STRING and ": ",
+   and terminated with a newline.  */
+extern void perror (const char *string);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef perror
+# define perror(s) \
+    (GL_LINK_WARNING ("perror is not always POSIX compliant - " \
+                      "use gnulib module perror for portability"), \
+     perror (s))
+#endif
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* _GL_STDIO_H */
+#endif /* _GL_STDIO_H */
+#endif
diff --git a/lib/stdlib.in.h b/lib/stdlib.in.h
new file mode 100644
index 000000000..23325b563
--- /dev/null
+++ b/lib/stdlib.in.h
@@ -0,0 +1,383 @@
+/* A GNU-like <stdlib.h>.
+
+   Copyright (C) 1995, 2001-2004, 2006-2009 Free Software Foundation, Inc.
+
+   This program is free software: you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#if __GNUC__ >= 3
+@PRAGMA_SYSTEM_HEADER@
+#endif
+
+#if defined __need_malloc_and_calloc
+/* Special invocation convention inside glibc header files.  */
+
+#@INCLUDE_NEXT@ @NEXT_STDLIB_H@
+
+#else
+/* Normal invocation convention.  */
+
+#ifndef _GL_STDLIB_H
+
+/* The include_next requires a split double-inclusion guard.  */
+#@INCLUDE_NEXT@ @NEXT_STDLIB_H@
+
+#ifndef _GL_STDLIB_H
+#define _GL_STDLIB_H
+
+
+/* Solaris declares getloadavg() in <sys/loadavg.h>.  */
+#if @GNULIB_GETLOADAVG@ && @HAVE_SYS_LOADAVG_H@
+# include <sys/loadavg.h>
+#endif
+
+/* OSF/1 5.1 declares 'struct random_data' in <random.h>, which is included
+   from <stdlib.h> if _REENTRANT is defined.  Include it always.  */
+#if @HAVE_RANDOM_H@
+# include <random.h>
+#endif
+
+#if @GNULIB_RANDOM_R@ || !@HAVE_STRUCT_RANDOM_DATA@
+# include <stdint.h>
+#endif
+
+#if !@HAVE_STRUCT_RANDOM_DATA@
+struct random_data
+{
+  int32_t *fptr;		/* Front pointer.  */
+  int32_t *rptr;		/* Rear pointer.  */
+  int32_t *state;		/* Array of state values.  */
+  int rand_type;		/* Type of random number generator.  */
+  int rand_deg;			/* Degree of random number generator.  */
+  int rand_sep;			/* Distance between front and rear.  */
+  int32_t *end_ptr;		/* Pointer behind state table.  */
+};
+#endif
+
+/* The definition of GL_LINK_WARNING is copied here.  */
+
+
+/* Some systems do not define EXIT_*, despite otherwise supporting C89.  */
+#ifndef EXIT_SUCCESS
+# define EXIT_SUCCESS 0
+#endif
+/* Tandem/NSK and other platforms that define EXIT_FAILURE as -1 interfere
+   with proper operation of xargs.  */
+#ifndef EXIT_FAILURE
+# define EXIT_FAILURE 1
+#elif EXIT_FAILURE != 1
+# undef EXIT_FAILURE
+# define EXIT_FAILURE 1
+#endif
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
+#if @GNULIB_MALLOC_POSIX@
+# if !@HAVE_MALLOC_POSIX@
+#  undef malloc
+#  define malloc rpl_malloc
+extern void * malloc (size_t size);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef malloc
+# define malloc(s) \
+    (GL_LINK_WARNING ("malloc is not POSIX compliant everywhere - " \
+                      "use gnulib module malloc-posix for portability"), \
+     malloc (s))
+#endif
+
+
+#if @GNULIB_REALLOC_POSIX@
+# if !@HAVE_REALLOC_POSIX@
+#  undef realloc
+#  define realloc rpl_realloc
+extern void * realloc (void *ptr, size_t size);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef realloc
+# define realloc(p,s) \
+    (GL_LINK_WARNING ("realloc is not POSIX compliant everywhere - " \
+                      "use gnulib module realloc-posix for portability"), \
+     realloc (p, s))
+#endif
+
+
+#if @GNULIB_CALLOC_POSIX@
+# if !@HAVE_CALLOC_POSIX@
+#  undef calloc
+#  define calloc rpl_calloc
+extern void * calloc (size_t nmemb, size_t size);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef calloc
+# define calloc(n,s) \
+    (GL_LINK_WARNING ("calloc is not POSIX compliant everywhere - " \
+                      "use gnulib module calloc-posix for portability"), \
+     calloc (n, s))
+#endif
+
+
+#if @GNULIB_ATOLL@
+# if !@HAVE_ATOLL@
+/* Parse a signed decimal integer.
+   Returns the value of the integer.  Errors are not detected.  */
+extern long long atoll (const char *string);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef atoll
+# define atoll(s) \
+    (GL_LINK_WARNING ("atoll is unportable - " \
+                      "use gnulib module atoll for portability"), \
+     atoll (s))
+#endif
+
+
+#if @GNULIB_GETLOADAVG@
+# if !@HAVE_DECL_GETLOADAVG@
+/* Store max(NELEM,3) load average numbers in LOADAVG[].
+   The three numbers are the load average of the last 1 minute, the last 5
+   minutes, and the last 15 minutes, respectively.
+   LOADAVG is an array of NELEM numbers.  */
+extern int getloadavg (double loadavg[], int nelem);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef getloadavg
+# define getloadavg(l,n) \
+    (GL_LINK_WARNING ("getloadavg is not portable - " \
+                      "use gnulib module getloadavg for portability"), \
+     getloadavg (l, n))
+#endif
+
+
+#if @GNULIB_GETSUBOPT@
+/* Assuming *OPTIONP is a comma separated list of elements of the form
+   "token" or "token=value", getsubopt parses the first of these elements.
+   If the first element refers to a "token" that is member of the given
+   NULL-terminated array of tokens:
+     - It replaces the comma with a NUL byte, updates *OPTIONP to point past
+       the first option and the comma, sets *VALUEP to the value of the
+       element (or NULL if it doesn't contain an "=" sign),
+     - It returns the index of the "token" in the given array of tokens.
+   Otherwise it returns -1, and *OPTIONP and *VALUEP are undefined.
+   For more details see the POSIX:2001 specification.
+   http://www.opengroup.org/susv3xsh/getsubopt.html */
+# if !@HAVE_GETSUBOPT@
+extern int getsubopt (char **optionp, char *const *tokens, char **valuep);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef getsubopt
+# define getsubopt(o,t,v) \
+    (GL_LINK_WARNING ("getsubopt is unportable - " \
+                      "use gnulib module getsubopt for portability"), \
+     getsubopt (o, t, v))
+#endif
+
+
+#if @GNULIB_MKDTEMP@
+# if !@HAVE_MKDTEMP@
+/* Create a unique temporary directory from TEMPLATE.
+   The last six characters of TEMPLATE must be "XXXXXX";
+   they are replaced with a string that makes the directory name unique.
+   Returns TEMPLATE, or a null pointer if it cannot get a unique name.
+   The directory is created mode 700.  */
+extern char * mkdtemp (char * /*template*/);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef mkdtemp
+# define mkdtemp(t) \
+    (GL_LINK_WARNING ("mkdtemp is unportable - " \
+                      "use gnulib module mkdtemp for portability"), \
+     mkdtemp (t))
+#endif
+
+
+#if @GNULIB_MKSTEMP@
+# if @REPLACE_MKSTEMP@
+/* Create a unique temporary file from TEMPLATE.
+   The last six characters of TEMPLATE must be "XXXXXX";
+   they are replaced with a string that makes the file name unique.
+   The file is then created, ensuring it didn't exist before.
+   The file is created read-write (mask at least 0600 & ~umask), but it may be
+   world-readable and world-writable (mask 0666 & ~umask), depending on the
+   implementation.
+   Returns the open file descriptor if successful, otherwise -1 and errno
+   set.  */
+#  define mkstemp rpl_mkstemp
+extern int mkstemp (char * /*template*/);
+# else
+/* On MacOS X 10.3, only <unistd.h> declares mkstemp.  */
+#  include <unistd.h>
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef mkstemp
+# define mkstemp(t) \
+    (GL_LINK_WARNING ("mkstemp is unportable - " \
+                      "use gnulib module mkstemp for portability"), \
+     mkstemp (t))
+#endif
+
+
+#if @GNULIB_PUTENV@
+# if @REPLACE_PUTENV@
+#  undef putenv
+#  define putenv rpl_putenv
+extern int putenv (char *string);
+# endif
+#endif
+
+
+#if @GNULIB_RANDOM_R@
+# if !@HAVE_RANDOM_R@
+
+#  ifndef RAND_MAX
+#   define RAND_MAX 2147483647
+#  endif
+
+int srandom_r (unsigned int seed, struct random_data *rand_state);
+int initstate_r (unsigned int seed, char *buf, size_t buf_size,
+		 struct random_data *rand_state);
+int setstate_r (char *arg_state, struct random_data *rand_state);
+int random_r (struct random_data *buf, int32_t *result);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef random_r
+# define random_r(b,r)				  \
+    (GL_LINK_WARNING ("random_r is unportable - " \
+                      "use gnulib module random_r for portability"), \
+     random_r (b,r))
+# undef initstate_r
+# define initstate_r(s,b,sz,r)			     \
+    (GL_LINK_WARNING ("initstate_r is unportable - " \
+                      "use gnulib module random_r for portability"), \
+     initstate_r (s,b,sz,r))
+# undef srandom_r
+# define srandom_r(s,r)				   \
+    (GL_LINK_WARNING ("srandom_r is unportable - " \
+                      "use gnulib module random_r for portability"), \
+     srandom_r (s,r))
+# undef setstate_r
+# define setstate_r(a,r)				    \
+    (GL_LINK_WARNING ("setstate_r is unportable - " \
+                      "use gnulib module random_r for portability"), \
+     setstate_r (a,r))
+#endif
+
+
+#if @GNULIB_RPMATCH@
+# if !@HAVE_RPMATCH@
+/* Test a user response to a question.
+   Return 1 if it is affirmative, 0 if it is negative, or -1 if not clear.  */
+extern int rpmatch (const char *response);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef rpmatch
+# define rpmatch(r) \
+    (GL_LINK_WARNING ("rpmatch is unportable - " \
+                      "use gnulib module rpmatch for portability"), \
+     rpmatch (r))
+#endif
+
+
+#if @GNULIB_SETENV@
+# if !@HAVE_SETENV@
+/* Set NAME to VALUE in the environment.
+   If REPLACE is nonzero, overwrite an existing value.  */
+extern int setenv (const char *name, const char *value, int replace);
+# endif
+#endif
+
+
+#if @GNULIB_UNSETENV@
+# if @HAVE_UNSETENV@
+#  if @VOID_UNSETENV@
+/* On some systems, unsetenv() returns void.
+   This is the case for MacOS X 10.3, FreeBSD 4.8, NetBSD 1.6, OpenBSD 3.4.  */
+#   define unsetenv(name) ((unsetenv)(name), 0)
+#  endif
+# else
+/* Remove the variable NAME from the environment.  */
+extern int unsetenv (const char *name);
+# endif
+#endif
+
+
+#if @GNULIB_STRTOD@
+# if @REPLACE_STRTOD@
+#  define strtod rpl_strtod
+# endif
+# if !@HAVE_STRTOD@ || @REPLACE_STRTOD@
+ /* Parse a double from STRING, updating ENDP if appropriate.  */
+extern double strtod (const char *str, char **endp);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef strtod
+# define strtod(s, e)                           \
+    (GL_LINK_WARNING ("strtod is unportable - " \
+                      "use gnulib module strtod for portability"), \
+     strtod (s, e))
+#endif
+
+
+#if @GNULIB_STRTOLL@
+# if !@HAVE_STRTOLL@
+/* Parse a signed integer whose textual representation starts at STRING.
+   The integer is expected to be in base BASE (2 <= BASE <= 36); if BASE == 0,
+   it may be decimal or octal (with prefix "0") or hexadecimal (with prefix
+   "0x").
+   If ENDPTR is not NULL, the address of the first byte after the integer is
+   stored in *ENDPTR.
+   Upon overflow, the return value is LLONG_MAX or LLONG_MIN, and errno is set
+   to ERANGE.  */
+extern long long strtoll (const char *string, char **endptr, int base);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef strtoll
+# define strtoll(s,e,b) \
+    (GL_LINK_WARNING ("strtoll is unportable - " \
+                      "use gnulib module strtoll for portability"), \
+     strtoll (s, e, b))
+#endif
+
+
+#if @GNULIB_STRTOULL@
+# if !@HAVE_STRTOULL@
+/* Parse an unsigned integer whose textual representation starts at STRING.
+   The integer is expected to be in base BASE (2 <= BASE <= 36); if BASE == 0,
+   it may be decimal or octal (with prefix "0") or hexadecimal (with prefix
+   "0x").
+   If ENDPTR is not NULL, the address of the first byte after the integer is
+   stored in *ENDPTR.
+   Upon overflow, the return value is ULLONG_MAX, and errno is set to
+   ERANGE.  */
+extern unsigned long long strtoull (const char *string, char **endptr, int base);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef strtoull
+# define strtoull(s,e,b) \
+    (GL_LINK_WARNING ("strtoull is unportable - " \
+                      "use gnulib module strtoull for portability"), \
+     strtoull (s, e, b))
+#endif
+
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* _GL_STDLIB_H */
+#endif /* _GL_STDLIB_H */
+#endif
diff --git a/lib/strftime.c b/lib/strftime.c
index ac011d431..e3402237e 100644
--- a/lib/strftime.c
+++ b/lib/strftime.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1991-1999, 2000, 2001, 2003, 2004, 2005, 2006, 2007 Free Software
+/* Copyright (C) 1991-1999, 2000, 2001, 2003, 2004, 2005, 2006, 2007, 2009 Free Software
    Foundation, Inc.
 
    NOTE: The canonical source of this file is maintained with the GNU C Library.
@@ -18,19 +18,18 @@
    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
 
 #ifdef _LIBC
-# define HAVE_MBLEN 1
-# define HAVE_MBRLEN 1
 # define HAVE_STRUCT_ERA_ENTRY 1
 # define HAVE_TM_GMTOFF 1
 # define HAVE_TM_ZONE 1
 # define HAVE_TZNAME 1
 # define HAVE_TZSET 1
-# define MULTIBYTE_IS_FORMAT_SAFE 1
 # include "../locale/localeinfo.h"
 #else
 # include <config.h>
 # if FPRINTFTIME
 #  include "fprintftime.h"
+# else
+#  include "strftime.h"
 # endif
 #endif
 
@@ -44,10 +43,16 @@ extern char *tzname[];
 /* Do multibyte processing if multibytes are supported, unless
    multibyte sequences are safe in formats.  Multibyte sequences are
    safe if they cannot contain byte sequences that look like format
-   conversion specifications.  The GNU C Library uses UTF8 multibyte
-   encoding, which is safe for formats, but strftime.c can be used
-   with other C libraries that use unsafe encodings.  */
-#define DO_MULTIBYTE (HAVE_MBLEN && ! MULTIBYTE_IS_FORMAT_SAFE)
+   conversion specifications.  The multibyte encodings used by the
+   C library on the various platforms (UTF-8, GB2312, GBK, CP936,
+   GB18030, EUC-TW, BIG5, BIG5-HKSCS, CP950, EUC-JP, EUC-KR, CP949,
+   SHIFT_JIS, CP932, JOHAB) are safe for formats, because the byte '%'
+   cannot occur in a multibyte character except in the first byte.
+   But this does not hold for the DEC-HANYU encoding used on OSF/1.  */
+#if !defined __osf__
+# define MULTIBYTE_IS_FORMAT_SAFE 1
+#endif
+#define DO_MULTIBYTE (! MULTIBYTE_IS_FORMAT_SAFE)
 
 #if DO_MULTIBYTE
 # include <wchar.h>
@@ -79,13 +84,6 @@ extern char *tzname[];
 # define MEMCPY(d, s, n) memcpy (d, s, n)
 # define STRLEN(s) strlen (s)
 
-# ifdef _LIBC
-#  define MEMPCPY(d, s, n) __mempcpy (d, s, n)
-# else
-#  ifndef HAVE_MEMPCPY
-#   define MEMPCPY(d, s, n) ((void *) ((char *) memcpy (d, s, n) + (n)))
-#  endif
-# endif
 #endif
 
 /* Shift A right by B bits portably, by dividing A by 2**B and
diff --git a/lib/striconveh.c b/lib/striconveh.c
new file mode 100644
index 000000000..b39a01f19
--- /dev/null
+++ b/lib/striconveh.c
@@ -0,0 +1,1251 @@
+/* Character set conversion with error handling.
+   Copyright (C) 2001-2008 Free Software Foundation, Inc.
+   Written by Bruno Haible and Simon Josefsson.
+
+   This program is free software: you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#include <config.h>
+
+/* Specification.  */
+#include "striconveh.h"
+
+#include <errno.h>
+#include <stdbool.h>
+#include <stdlib.h>
+#include <string.h>
+
+#if HAVE_ICONV
+# include <iconv.h>
+# include "unistr.h"
+#endif
+
+#include "c-strcase.h"
+#include "c-strcaseeq.h"
+
+#ifndef SIZE_MAX
+# define SIZE_MAX ((size_t) -1)
+#endif
+
+
+#if HAVE_ICONV
+
+/* The caller must provide CD, CD1, CD2, not just CD, because when a conversion
+   error occurs, we may have to determine the Unicode representation of the
+   inconvertible character.  */
+
+/* iconv_carefully is like iconv, except that it stops as soon as it encounters
+   a conversion error, and it returns in *INCREMENTED a boolean telling whether
+   it has incremented the input pointers past the error location.  */
+# if !defined _LIBICONV_VERSION && !defined __GLIBC__
+/* Irix iconv() inserts a NUL byte if it cannot convert.
+   NetBSD iconv() inserts a question mark if it cannot convert.
+   Only GNU libiconv and GNU libc are known to prefer to fail rather
+   than doing a lossy conversion.  */
+static size_t
+iconv_carefully (iconv_t cd,
+		 const char **inbuf, size_t *inbytesleft,
+		 char **outbuf, size_t *outbytesleft,
+		 bool *incremented)
+{
+  const char *inptr = *inbuf;
+  const char *inptr_end = inptr + *inbytesleft;
+  char *outptr = *outbuf;
+  size_t outsize = *outbytesleft;
+  const char *inptr_before;
+  size_t res;
+
+  do
+    {
+      size_t insize;
+
+      inptr_before = inptr;
+      res = (size_t)(-1);
+
+      for (insize = 1; inptr + insize <= inptr_end; insize++)
+	{
+	  res = iconv (cd,
+		       (ICONV_CONST char **) &inptr, &insize,
+		       &outptr, &outsize);
+	  if (!(res == (size_t)(-1) && errno == EINVAL))
+	    break;
+	  /* iconv can eat up a shift sequence but give EINVAL while attempting
+	     to convert the first character.  E.g. libiconv does this.  */
+	  if (inptr > inptr_before)
+	    {
+	      res = 0;
+	      break;
+	    }
+	}
+
+      if (res == 0)
+	{
+	  *outbuf = outptr;
+	  *outbytesleft = outsize;
+	}
+    }
+  while (res == 0 && inptr < inptr_end);
+
+  *inbuf = inptr;
+  *inbytesleft = inptr_end - inptr;
+  if (res != (size_t)(-1) && res > 0)
+    {
+      /* iconv() has already incremented INPTR.  We cannot go back to a
+	 previous INPTR, otherwise the state inside CD would become invalid,
+	 if FROM_CODESET is a stateful encoding.  So, tell the caller that
+	 *INBUF has already been incremented.  */
+      *incremented = (inptr > inptr_before);
+      errno = EILSEQ;
+      return (size_t)(-1);
+    }
+  else
+    {
+      *incremented = false;
+      return res;
+    }
+}
+# else
+#  define iconv_carefully(cd, inbuf, inbytesleft, outbuf, outbytesleft, incremented) \
+     (*(incremented) = false, \
+      iconv (cd, (ICONV_CONST char **) (inbuf), inbytesleft, outbuf, outbytesleft))
+# endif
+
+/* iconv_carefully_1 is like iconv_carefully, except that it stops after
+   converting one character or one shift sequence.  */
+static size_t
+iconv_carefully_1 (iconv_t cd,
+		   const char **inbuf, size_t *inbytesleft,
+		   char **outbuf, size_t *outbytesleft,
+		   bool *incremented)
+{
+  const char *inptr_before = *inbuf;
+  const char *inptr = inptr_before;
+  const char *inptr_end = inptr_before + *inbytesleft;
+  char *outptr = *outbuf;
+  size_t outsize = *outbytesleft;
+  size_t res = (size_t)(-1);
+  size_t insize;
+
+  for (insize = 1; inptr_before + insize <= inptr_end; insize++)
+    {
+      inptr = inptr_before;
+      res = iconv (cd,
+		   (ICONV_CONST char **) &inptr, &insize,
+		   &outptr, &outsize);
+      if (!(res == (size_t)(-1) && errno == EINVAL))
+	break;
+      /* iconv can eat up a shift sequence but give EINVAL while attempting
+	 to convert the first character.  E.g. libiconv does this.  */
+      if (inptr > inptr_before)
+	{
+	  res = 0;
+	  break;
+	}
+    }
+
+  *inbuf = inptr;
+  *inbytesleft = inptr_end - inptr;
+# if !defined _LIBICONV_VERSION && !defined __GLIBC__
+  /* Irix iconv() inserts a NUL byte if it cannot convert.
+     NetBSD iconv() inserts a question mark if it cannot convert.
+     Only GNU libiconv and GNU libc are known to prefer to fail rather
+     than doing a lossy conversion.  */
+  if (res != (size_t)(-1) && res > 0)
+    {
+      /* iconv() has already incremented INPTR.  We cannot go back to a
+	 previous INPTR, otherwise the state inside CD would become invalid,
+	 if FROM_CODESET is a stateful encoding.  So, tell the caller that
+	 *INBUF has already been incremented.  */
+      *incremented = (inptr > inptr_before);
+      errno = EILSEQ;
+      return (size_t)(-1);
+    }
+# endif
+
+  if (res != (size_t)(-1))
+    {
+      *outbuf = outptr;
+      *outbytesleft = outsize;
+    }
+  *incremented = false;
+  return res;
+}
+
+/* utf8conv_carefully is like iconv, except that
+     - it converts from UTF-8 to UTF-8,
+     - it stops as soon as it encounters a conversion error, and it returns
+       in *INCREMENTED a boolean telling whether it has incremented the input
+       pointers past the error location,
+     - if one_character_only is true, it stops after converting one
+       character.  */
+static size_t
+utf8conv_carefully (bool one_character_only,
+		    const char **inbuf, size_t *inbytesleft,
+		    char **outbuf, size_t *outbytesleft,
+		    bool *incremented)
+{
+  const char *inptr = *inbuf;
+  size_t insize = *inbytesleft;
+  char *outptr = *outbuf;
+  size_t outsize = *outbytesleft;
+  size_t res;
+
+  res = 0;
+  do
+    {
+      ucs4_t uc;
+      int n;
+      int m;
+
+      n = u8_mbtoucr (&uc, (const uint8_t *) inptr, insize);
+      if (n < 0)
+	{
+	  errno = (n == -2 ? EINVAL : EILSEQ);
+	  n = u8_mbtouc (&uc, (const uint8_t *) inptr, insize);
+	  inptr += n;
+	  insize -= n;
+	  res = (size_t)(-1);
+	  *incremented = true;
+	  break;
+	}
+      if (outsize == 0)
+	{
+	  errno = E2BIG;
+	  res = (size_t)(-1);
+	  *incremented = false;
+	  break;
+	}
+      m = u8_uctomb ((uint8_t *) outptr, uc, outsize);
+      if (m == -2)
+	{
+	  errno = E2BIG;
+	  res = (size_t)(-1);
+	  *incremented = false;
+	  break;
+	}
+      inptr += n;
+      insize -= n;
+      if (m == -1)
+	{
+	  errno = EILSEQ;
+	  res = (size_t)(-1);
+	  *incremented = true;
+	  break;
+	}
+      outptr += m;
+      outsize -= m;
+    }
+  while (!one_character_only && insize > 0);
+
+  *inbuf = inptr;
+  *inbytesleft = insize;
+  *outbuf = outptr;
+  *outbytesleft = outsize;
+  return res;
+}
+
+static int
+mem_cd_iconveh_internal (const char *src, size_t srclen,
+			 iconv_t cd, iconv_t cd1, iconv_t cd2,
+			 enum iconv_ilseq_handler handler,
+			 size_t extra_alloc,
+			 size_t *offsets,
+			 char **resultp, size_t *lengthp)
+{
+  /* When a conversion error occurs, we cannot start using CD1 and CD2 at
+     this point: FROM_CODESET may be a stateful encoding like ISO-2022-KR.
+     Instead, we have to start afresh from the beginning of SRC.  */
+  /* Use a temporary buffer, so that for small strings, a single malloc()
+     call will be sufficient.  */
+# define tmpbufsize 4096
+  /* The alignment is needed when converting e.g. to glibc's WCHAR_T or
+     libiconv's UCS-4-INTERNAL encoding.  */
+  union { unsigned int align; char buf[tmpbufsize]; } tmp;
+# define tmpbuf tmp.buf
+
+  char *initial_result;
+  char *result;
+  size_t allocated;
+  size_t length;
+  size_t last_length = (size_t)(-1); /* only needed if offsets != NULL */
+
+  if (*resultp != NULL && *lengthp >= sizeof (tmpbuf))
+    {
+      initial_result = *resultp;
+      allocated = *lengthp;
+    }
+  else
+    {
+      initial_result = tmpbuf;
+      allocated = sizeof (tmpbuf);
+    }
+  result = initial_result;
+
+  /* Test whether a direct conversion is possible at all.  */
+  if (cd == (iconv_t)(-1))
+    goto indirectly;
+
+  if (offsets != NULL)
+    {
+      size_t i;
+
+      for (i = 0; i < srclen; i++)
+	offsets[i] = (size_t)(-1);
+
+      last_length = (size_t)(-1);
+    }
+  length = 0;
+
+  /* First, try a direct conversion, and see whether a conversion error
+     occurs at all.  */
+  {
+    const char *inptr = src;
+    size_t insize = srclen;
+
+    /* Avoid glibc-2.1 bug and Solaris 2.7-2.9 bug.  */
+# if defined _LIBICONV_VERSION \
+     || !((__GLIBC__ - 0 == 2 && __GLIBC_MINOR__ - 0 <= 1) || defined __sun)
+    /* Set to the initial state.  */
+    iconv (cd, NULL, NULL, NULL, NULL);
+# endif
+
+    while (insize > 0)
+      {
+	char *outptr = result + length;
+	size_t outsize = allocated - extra_alloc - length;
+	bool incremented;
+	size_t res;
+	bool grow;
+
+	if (offsets != NULL)
+	  {
+	    if (length != last_length) /* ensure that offset[] be increasing */
+	      {
+		offsets[inptr - src] = length;
+		last_length = length;
+	      }
+	    res = iconv_carefully_1 (cd,
+				     &inptr, &insize,
+				     &outptr, &outsize,
+				     &incremented);
+	  }
+	else
+	  /* Use iconv_carefully instead of iconv here, because:
+	     - If TO_CODESET is UTF-8, we can do the error handling in this
+	       loop, no need for a second loop,
+	     - With iconv() implementations other than GNU libiconv and GNU
+	       libc, if we use iconv() in a big swoop, checking for an E2BIG
+	       return, we lose the number of irreversible conversions.  */
+	  res = iconv_carefully (cd,
+				 &inptr, &insize,
+				 &outptr, &outsize,
+				 &incremented);
+
+	length = outptr - result;
+	grow = (length + extra_alloc > allocated / 2);
+	if (res == (size_t)(-1))
+	  {
+	    if (errno == E2BIG)
+	      grow = true;
+	    else if (errno == EINVAL)
+	      break;
+	    else if (errno == EILSEQ && handler != iconveh_error)
+	      {
+		if (cd2 == (iconv_t)(-1))
+		  {
+		    /* TO_CODESET is UTF-8.  */
+		    /* Error handling can produce up to 1 byte of output.  */
+		    if (length + 1 + extra_alloc > allocated)
+		      {
+			char *memory;
+
+			allocated = 2 * allocated;
+			if (length + 1 + extra_alloc > allocated)
+			  abort ();
+			if (result == initial_result)
+			  memory = (char *) malloc (allocated);
+			else
+			  memory = (char *) realloc (result, allocated);
+			if (memory == NULL)
+			  {
+			    if (result != initial_result)
+			      free (result);
+			    errno = ENOMEM;
+			    return -1;
+			  }
+			if (result == initial_result)
+			  memcpy (memory, initial_result, length);
+			result = memory;
+			grow = false;
+		      }
+		    /* The input is invalid in FROM_CODESET.  Eat up one byte
+		       and emit a question mark.  */
+		    if (!incremented)
+		      {
+			if (insize == 0)
+			  abort ();
+			inptr++;
+			insize--;
+		      }
+		    result[length] = '?';
+		    length++;
+		  }
+		else
+		  goto indirectly;
+	      }
+	    else
+	      {
+		if (result != initial_result)
+		  {
+		    int saved_errno = errno;
+		    free (result);
+		    errno = saved_errno;
+		  }
+		return -1;
+	      }
+	  }
+	if (insize == 0)
+	  break;
+	if (grow)
+	  {
+	    char *memory;
+
+	    allocated = 2 * allocated;
+	    if (result == initial_result)
+	      memory = (char *) malloc (allocated);
+	    else
+	      memory = (char *) realloc (result, allocated);
+	    if (memory == NULL)
+	      {
+		if (result != initial_result)
+		  free (result);
+		errno = ENOMEM;
+		return -1;
+	      }
+	    if (result == initial_result)
+	      memcpy (memory, initial_result, length);
+	    result = memory;
+	  }
+      }
+  }
+
+  /* Now get the conversion state back to the initial state.
+     But avoid glibc-2.1 bug and Solaris 2.7 bug.  */
+#if defined _LIBICONV_VERSION \
+    || !((__GLIBC__ == 2 && __GLIBC_MINOR__ <= 1) || defined __sun)
+  for (;;)
+    {
+      char *outptr = result + length;
+      size_t outsize = allocated - extra_alloc - length;
+      size_t res;
+
+      res = iconv (cd, NULL, NULL, &outptr, &outsize);
+      length = outptr - result;
+      if (res == (size_t)(-1))
+	{
+	  if (errno == E2BIG)
+	    {
+	      char *memory;
+
+	      allocated = 2 * allocated;
+	      if (result == initial_result)
+		memory = (char *) malloc (allocated);
+	      else
+		memory = (char *) realloc (result, allocated);
+	      if (memory == NULL)
+		{
+		  if (result != initial_result)
+		    free (result);
+		  errno = ENOMEM;
+		  return -1;
+		}
+	      if (result == initial_result)
+		memcpy (memory, initial_result, length);
+	      result = memory;
+	    }
+	  else
+	    {
+	      if (result != initial_result)
+		{
+		  int saved_errno = errno;
+		  free (result);
+		  errno = saved_errno;
+		}
+	      return -1;
+	    }
+	}
+      else
+	break;
+    }
+#endif
+
+  /* The direct conversion succeeded.  */
+  goto done;
+
+ indirectly:
+  /* The direct conversion failed.
+     Use a conversion through UTF-8.  */
+  if (offsets != NULL)
+    {
+      size_t i;
+
+      for (i = 0; i < srclen; i++)
+	offsets[i] = (size_t)(-1);
+
+      last_length = (size_t)(-1);
+    }
+  length = 0;
+  {
+    const bool slowly = (offsets != NULL || handler == iconveh_error);
+# define utf8bufsize 4096 /* may also be smaller or larger than tmpbufsize */
+    char utf8buf[utf8bufsize + 1];
+    size_t utf8len = 0;
+    const char *in1ptr = src;
+    size_t in1size = srclen;
+    bool do_final_flush1 = true;
+    bool do_final_flush2 = true;
+
+    /* Avoid glibc-2.1 bug and Solaris 2.7-2.9 bug.  */
+# if defined _LIBICONV_VERSION \
+     || !((__GLIBC__ - 0 == 2 && __GLIBC_MINOR__ - 0 <= 1) || defined __sun)
+    /* Set to the initial state.  */
+    if (cd1 != (iconv_t)(-1))
+      iconv (cd1, NULL, NULL, NULL, NULL);
+    if (cd2 != (iconv_t)(-1))
+      iconv (cd2, NULL, NULL, NULL, NULL);
+# endif
+
+    while (in1size > 0 || do_final_flush1 || utf8len > 0 || do_final_flush2)
+      {
+	char *out1ptr = utf8buf + utf8len;
+	size_t out1size = utf8bufsize - utf8len;
+	bool incremented1;
+	size_t res1;
+	int errno1;
+
+	/* Conversion step 1: from FROM_CODESET to UTF-8.  */
+	if (in1size > 0)
+	  {
+	    if (offsets != NULL
+		&& length != last_length) /* ensure that offset[] be increasing */
+	      {
+		offsets[in1ptr - src] = length;
+		last_length = length;
+	      }
+	    if (cd1 != (iconv_t)(-1))
+	      {
+		if (slowly)
+		  res1 = iconv_carefully_1 (cd1,
+					    &in1ptr, &in1size,
+					    &out1ptr, &out1size,
+					    &incremented1);
+		else
+		  res1 = iconv_carefully (cd1,
+					  &in1ptr, &in1size,
+					  &out1ptr, &out1size,
+					  &incremented1);
+	      }
+	    else
+	      {
+		/* FROM_CODESET is UTF-8.  */
+		res1 = utf8conv_carefully (slowly,
+					   &in1ptr, &in1size,
+					   &out1ptr, &out1size,
+					   &incremented1);
+	      }
+	  }
+	else if (do_final_flush1)
+	  {
+	    /* Now get the conversion state of CD1 back to the initial state.
+	       But avoid glibc-2.1 bug and Solaris 2.7 bug.  */
+# if defined _LIBICONV_VERSION \
+     || !((__GLIBC__ == 2 && __GLIBC_MINOR__ <= 1) || defined __sun)
+	    if (cd1 != (iconv_t)(-1))
+	      res1 = iconv (cd1, NULL, NULL, &out1ptr, &out1size);
+	    else
+# endif
+	      res1 = 0;
+	    do_final_flush1 = false;
+	    incremented1 = true;
+	  }
+	else
+	  {
+	    res1 = 0;
+	    incremented1 = true;
+	  }
+	if (res1 == (size_t)(-1)
+	    && !(errno == E2BIG || errno == EINVAL || errno == EILSEQ))
+	  {
+	    if (result != initial_result)
+	      {
+		int saved_errno = errno;
+		free (result);
+		errno = saved_errno;
+	      }
+	    return -1;
+	  }
+	if (res1 == (size_t)(-1)
+	    && errno == EILSEQ && handler != iconveh_error)
+	  {
+	    /* The input is invalid in FROM_CODESET.  Eat up one byte and
+	       emit a question mark.  Room for the question mark was allocated
+	       at the end of utf8buf.  */
+	    if (!incremented1)
+	      {
+		if (in1size == 0)
+		  abort ();
+		in1ptr++;
+		in1size--;
+	      }
+	    utf8buf[utf8len++] = '?';
+	  }
+	errno1 = errno;
+	utf8len = out1ptr - utf8buf;
+
+	if (offsets != NULL
+	    || in1size == 0
+	    || utf8len > utf8bufsize / 2
+	    || (res1 == (size_t)(-1) && errno1 == E2BIG))
+	  {
+	    /* Conversion step 2: from UTF-8 to TO_CODESET.  */
+	    const char *in2ptr = utf8buf;
+	    size_t in2size = utf8len;
+
+	    while (in2size > 0
+		   || (in1size == 0 && !do_final_flush1 && do_final_flush2))
+	      {
+		char *out2ptr = result + length;
+		size_t out2size = allocated - extra_alloc - length;
+		bool incremented2;
+		size_t res2;
+		bool grow;
+
+		if (in2size > 0)
+		  {
+		    if (cd2 != (iconv_t)(-1))
+		      res2 = iconv_carefully (cd2,
+					      &in2ptr, &in2size,
+					      &out2ptr, &out2size,
+					      &incremented2);
+		    else
+		      /* TO_CODESET is UTF-8.  */
+		      res2 = utf8conv_carefully (false,
+						 &in2ptr, &in2size,
+						 &out2ptr, &out2size,
+						 &incremented2);
+		  }
+		else /* in1size == 0 && !do_final_flush1
+			&& in2size == 0 && do_final_flush2 */
+		  {
+		    /* Now get the conversion state of CD1 back to the initial
+		       state.  But avoid glibc-2.1 bug and Solaris 2.7 bug.  */
+# if defined _LIBICONV_VERSION \
+     || !((__GLIBC__ == 2 && __GLIBC_MINOR__ <= 1) || defined __sun)
+		    if (cd2 != (iconv_t)(-1))
+		      res2 = iconv (cd2, NULL, NULL, &out2ptr, &out2size);
+		    else
+# endif
+		      res2 = 0;
+		    do_final_flush2 = false;
+		    incremented2 = true;
+		  }
+
+		length = out2ptr - result;
+		grow = (length + extra_alloc > allocated / 2);
+		if (res2 == (size_t)(-1))
+		  {
+		    if (errno == E2BIG)
+		      grow = true;
+		    else if (errno == EINVAL)
+		      break;
+		    else if (errno == EILSEQ && handler != iconveh_error)
+		      {
+			/* Error handling can produce up to 10 bytes of ASCII
+			   output.  But TO_CODESET may be UCS-2, UTF-16 or
+			   UCS-4, so use CD2 here as well.  */
+			char scratchbuf[10];
+			size_t scratchlen;
+			ucs4_t uc;
+			const char *inptr;
+			size_t insize;
+			size_t res;
+
+			if (incremented2)
+			  {
+			    if (u8_prev (&uc, (const uint8_t *) in2ptr,
+					 (const uint8_t *) utf8buf)
+				== NULL)
+			      abort ();
+			  }
+			else
+			  {
+			    int n;
+			    if (in2size == 0)
+			      abort ();
+			    n = u8_mbtouc_unsafe (&uc, (const uint8_t *) in2ptr,
+						  in2size);
+			    in2ptr += n;
+			    in2size -= n;
+			  }
+
+			if (handler == iconveh_escape_sequence)
+			  {
+			    static char hex[16] = "0123456789ABCDEF";
+			    scratchlen = 0;
+			    scratchbuf[scratchlen++] = '\\';
+			    if (uc < 0x10000)
+			      scratchbuf[scratchlen++] = 'u';
+			    else
+			      {
+				scratchbuf[scratchlen++] = 'U';
+				scratchbuf[scratchlen++] = hex[(uc>>28) & 15];
+				scratchbuf[scratchlen++] = hex[(uc>>24) & 15];
+				scratchbuf[scratchlen++] = hex[(uc>>20) & 15];
+				scratchbuf[scratchlen++] = hex[(uc>>16) & 15];
+			      }
+			    scratchbuf[scratchlen++] = hex[(uc>>12) & 15];
+			    scratchbuf[scratchlen++] = hex[(uc>>8) & 15];
+			    scratchbuf[scratchlen++] = hex[(uc>>4) & 15];
+			    scratchbuf[scratchlen++] = hex[uc & 15];
+			  }
+			else
+			  {
+			    scratchbuf[0] = '?';
+			    scratchlen = 1;
+			  }
+
+			inptr = scratchbuf;
+			insize = scratchlen;
+			if (cd2 != (iconv_t)(-1))
+			  res = iconv (cd2,
+				       (ICONV_CONST char **) &inptr, &insize,
+				       &out2ptr, &out2size);
+			else
+			  {
+			    /* TO_CODESET is UTF-8.  */
+			    if (out2size >= insize)
+			      {
+				memcpy (out2ptr, inptr, insize);
+				out2ptr += insize;
+				out2size -= insize;
+				inptr += insize;
+				insize = 0;
+				res = 0;
+			      }
+			    else
+			      {
+				errno = E2BIG;
+				res = (size_t)(-1);
+			      }
+			  }
+			length = out2ptr - result;
+			if (res == (size_t)(-1) && errno == E2BIG)
+			  {
+			    char *memory;
+
+			    allocated = 2 * allocated;
+			    if (length + 1 + extra_alloc > allocated)
+			      abort ();
+			    if (result == initial_result)
+			      memory = (char *) malloc (allocated);
+			    else
+			      memory = (char *) realloc (result, allocated);
+			    if (memory == NULL)
+			      {
+				if (result != initial_result)
+				  free (result);
+				errno = ENOMEM;
+				return -1;
+			      }
+			    if (result == initial_result)
+			      memcpy (memory, initial_result, length);
+			    result = memory;
+			    grow = false;
+
+			    out2ptr = result + length;
+			    out2size = allocated - extra_alloc - length;
+			    if (cd2 != (iconv_t)(-1))
+			      res = iconv (cd2,
+					   (ICONV_CONST char **) &inptr,
+					   &insize,
+					   &out2ptr, &out2size);
+			    else
+			      {
+				/* TO_CODESET is UTF-8.  */
+				if (!(out2size >= insize))
+				  abort ();
+				memcpy (out2ptr, inptr, insize);
+				out2ptr += insize;
+				out2size -= insize;
+				inptr += insize;
+				insize = 0;
+				res = 0;
+			      }
+			    length = out2ptr - result;
+			  }
+# if !defined _LIBICONV_VERSION && !defined __GLIBC__
+			/* Irix iconv() inserts a NUL byte if it cannot convert.
+			   NetBSD iconv() inserts a question mark if it cannot
+			   convert.
+			   Only GNU libiconv and GNU libc are known to prefer
+			   to fail rather than doing a lossy conversion.  */
+			if (res != (size_t)(-1) && res > 0)
+			  {
+			    errno = EILSEQ;
+			    res = (size_t)(-1);
+			  }
+# endif
+			if (res == (size_t)(-1))
+			  {
+			    /* Failure converting the ASCII replacement.  */
+			    if (result != initial_result)
+			      {
+				int saved_errno = errno;
+				free (result);
+				errno = saved_errno;
+			      }
+			    return -1;
+			  }
+		      }
+		    else
+		      {
+			if (result != initial_result)
+			  {
+			    int saved_errno = errno;
+			    free (result);
+			    errno = saved_errno;
+			  }
+			return -1;
+		      }
+		  }
+		if (!(in2size > 0
+		      || (in1size == 0 && !do_final_flush1 && do_final_flush2)))
+		  break;
+		if (grow)
+		  {
+		    char *memory;
+
+		    allocated = 2 * allocated;
+		    if (result == initial_result)
+		      memory = (char *) malloc (allocated);
+		    else
+		      memory = (char *) realloc (result, allocated);
+		    if (memory == NULL)
+		      {
+			if (result != initial_result)
+			  free (result);
+			errno = ENOMEM;
+			return -1;
+		      }
+		    if (result == initial_result)
+		      memcpy (memory, initial_result, length);
+		    result = memory;
+		  }
+	      }
+
+	    /* Move the remaining bytes to the beginning of utf8buf.  */
+	    if (in2size > 0)
+	      memmove (utf8buf, in2ptr, in2size);
+	    utf8len = in2size;
+	  }
+
+	if (res1 == (size_t)(-1))
+	  {
+	    if (errno1 == EINVAL)
+	      in1size = 0;
+	    else if (errno1 == EILSEQ)
+	      {
+		if (result != initial_result)
+		  free (result);
+		errno = errno1;
+		return -1;
+	      }
+	  }
+      }
+# undef utf8bufsize
+  }
+
+ done:
+  /* Now the final memory allocation.  */
+  if (result == tmpbuf)
+    {
+      size_t memsize = length + extra_alloc;
+      char *memory;
+
+      memory = (char *) malloc (memsize > 0 ? memsize : 1);
+      if (memory != NULL)
+	{
+	  memcpy (memory, tmpbuf, length);
+	  result = memory;
+	}
+      else
+	{
+	  errno = ENOMEM;
+	  return -1;
+        }
+    }
+  else if (result != *resultp && length + extra_alloc < allocated)
+    {
+      /* Shrink the allocated memory if possible.  */
+      size_t memsize = length + extra_alloc;
+      char *memory;
+
+      memory = (char *) realloc (result, memsize > 0 ? memsize : 1);
+      if (memory != NULL)
+	result = memory;
+    }
+  *resultp = result;
+  *lengthp = length;
+  return 0;
+# undef tmpbuf
+# undef tmpbufsize
+}
+
+int
+mem_cd_iconveh (const char *src, size_t srclen,
+		iconv_t cd, iconv_t cd1, iconv_t cd2,
+		enum iconv_ilseq_handler handler,
+		size_t *offsets,
+		char **resultp, size_t *lengthp)
+{
+  return mem_cd_iconveh_internal (src, srclen, cd, cd1, cd2, handler, 0,
+				  offsets, resultp, lengthp);
+}
+
+char *
+str_cd_iconveh (const char *src,
+		iconv_t cd, iconv_t cd1, iconv_t cd2,
+		enum iconv_ilseq_handler handler)
+{
+  /* For most encodings, a trailing NUL byte in the input will be converted
+     to a trailing NUL byte in the output.  But not for UTF-7.  So that this
+     function is usable for UTF-7, we have to exclude the NUL byte from the
+     conversion and add it by hand afterwards.  */
+  char *result = NULL;
+  size_t length = 0;
+  int retval = mem_cd_iconveh_internal (src, strlen (src),
+					cd, cd1, cd2, handler, 1, NULL,
+					&result, &length);
+
+  if (retval < 0)
+    {
+      if (result != NULL)
+	{
+	  int saved_errno = errno;
+	  free (result);
+	  errno = saved_errno;
+	}
+      return NULL;
+    }
+
+  /* Add the terminating NUL byte.  */
+  result[length] = '\0';
+
+  return result;
+}
+
+#endif
+
+int
+mem_iconveh (const char *src, size_t srclen,
+	     const char *from_codeset, const char *to_codeset,
+	     enum iconv_ilseq_handler handler,
+	     size_t *offsets,
+	     char **resultp, size_t *lengthp)
+{
+  if (srclen == 0)
+    {
+      /* Nothing to convert.  */
+      *lengthp = 0;
+      return 0;
+    }
+  else if (offsets == NULL && c_strcasecmp (from_codeset, to_codeset) == 0)
+    {
+      char *result;
+
+      if (*resultp != NULL && *lengthp >= srclen)
+	result = *resultp;
+      else
+	{
+	  result = (char *) malloc (srclen);
+	  if (result == NULL)
+	    {
+	      errno = ENOMEM;
+	      return -1;
+	    }
+	}
+      memcpy (result, src, srclen);
+      *resultp = result;
+      *lengthp = srclen;
+      return 0;
+    }
+  else
+    {
+#if HAVE_ICONV
+      iconv_t cd;
+      iconv_t cd1;
+      iconv_t cd2;
+      char *result;
+      size_t length;
+      int retval;
+
+      /* Avoid glibc-2.1 bug with EUC-KR.  */
+# if (__GLIBC__ - 0 == 2 && __GLIBC_MINOR__ - 0 <= 1) && !defined _LIBICONV_VERSION
+      if (c_strcasecmp (from_codeset, "EUC-KR") == 0
+	  || c_strcasecmp (to_codeset, "EUC-KR") == 0)
+	{
+	  errno = EINVAL;
+	  return -1;
+	}
+# endif
+
+      cd = iconv_open (to_codeset, from_codeset);
+
+      if (STRCASEEQ (from_codeset, "UTF-8", 'U','T','F','-','8',0,0,0,0))
+	cd1 = (iconv_t)(-1);
+      else
+	{
+	  cd1 = iconv_open ("UTF-8", from_codeset);
+	  if (cd1 == (iconv_t)(-1))
+	    {
+	      int saved_errno = errno;
+	      if (cd != (iconv_t)(-1))
+		iconv_close (cd);
+	      errno = saved_errno;
+	      return -1;
+	    }
+	}
+
+      if (STRCASEEQ (to_codeset, "UTF-8", 'U','T','F','-','8',0,0,0,0)
+# if (__GLIBC__ == 2 && __GLIBC_MINOR__ >= 2) || __GLIBC__ > 2 || _LIBICONV_VERSION >= 0x0105
+	  || c_strcasecmp (to_codeset, "UTF-8//TRANSLIT") == 0
+# endif
+	 )
+	cd2 = (iconv_t)(-1);
+      else
+	{
+	  cd2 = iconv_open (to_codeset, "UTF-8");
+	  if (cd2 == (iconv_t)(-1))
+	    {
+	      int saved_errno = errno;
+	      if (cd1 != (iconv_t)(-1))
+		iconv_close (cd1);
+	      if (cd != (iconv_t)(-1))
+		iconv_close (cd);
+	      errno = saved_errno;
+	      return -1;
+	    }
+	}
+
+      result = *resultp;
+      length = *lengthp;
+      retval = mem_cd_iconveh (src, srclen, cd, cd1, cd2, handler, offsets,
+			       &result, &length);
+
+      if (retval < 0)
+	{
+	  /* Close cd, cd1, cd2, but preserve the errno from str_cd_iconv.  */
+	  int saved_errno = errno;
+	  if (cd2 != (iconv_t)(-1))
+	    iconv_close (cd2);
+	  if (cd1 != (iconv_t)(-1))
+	    iconv_close (cd1);
+	  if (cd != (iconv_t)(-1))
+	    iconv_close (cd);
+	  errno = saved_errno;
+	}
+      else
+	{
+	  if (cd2 != (iconv_t)(-1) && iconv_close (cd2) < 0)
+	    {
+	      /* Return -1, but free the allocated memory, and while doing
+		 that, preserve the errno from iconv_close.  */
+	      int saved_errno = errno;
+	      if (cd1 != (iconv_t)(-1))
+		iconv_close (cd1);
+	      if (cd != (iconv_t)(-1))
+		iconv_close (cd);
+	      if (result != *resultp && result != NULL)
+		free (result);
+	      errno = saved_errno;
+	      return -1;
+	    }
+	  if (cd1 != (iconv_t)(-1) && iconv_close (cd1) < 0)
+	    {
+	      /* Return -1, but free the allocated memory, and while doing
+		 that, preserve the errno from iconv_close.  */
+	      int saved_errno = errno;
+	      if (cd != (iconv_t)(-1))
+		iconv_close (cd);
+	      if (result != *resultp && result != NULL)
+		free (result);
+	      errno = saved_errno;
+	      return -1;
+	    }
+	  if (cd != (iconv_t)(-1) && iconv_close (cd) < 0)
+	    {
+	      /* Return -1, but free the allocated memory, and while doing
+		 that, preserve the errno from iconv_close.  */
+	      int saved_errno = errno;
+	      if (result != *resultp && result != NULL)
+		free (result);
+	      errno = saved_errno;
+	      return -1;
+	    }
+	  *resultp = result;
+	  *lengthp = length;
+	}
+      return retval;
+#else
+      /* This is a different error code than if iconv_open existed but didn't
+	 support from_codeset and to_codeset, so that the caller can emit
+	 an error message such as
+	   "iconv() is not supported. Installing GNU libiconv and
+	    then reinstalling this package would fix this."  */
+      errno = ENOSYS;
+      return -1;
+#endif
+    }
+}
+
+char *
+str_iconveh (const char *src,
+	     const char *from_codeset, const char *to_codeset,
+	     enum iconv_ilseq_handler handler)
+{
+  if (*src == '\0' || c_strcasecmp (from_codeset, to_codeset) == 0)
+    {
+      char *result = strdup (src);
+
+      if (result == NULL)
+	errno = ENOMEM;
+      return result;
+    }
+  else
+    {
+#if HAVE_ICONV
+      iconv_t cd;
+      iconv_t cd1;
+      iconv_t cd2;
+      char *result;
+
+      /* Avoid glibc-2.1 bug with EUC-KR.  */
+# if (__GLIBC__ - 0 == 2 && __GLIBC_MINOR__ - 0 <= 1) && !defined _LIBICONV_VERSION
+      if (c_strcasecmp (from_codeset, "EUC-KR") == 0
+	  || c_strcasecmp (to_codeset, "EUC-KR") == 0)
+	{
+	  errno = EINVAL;
+	  return NULL;
+	}
+# endif
+
+      cd = iconv_open (to_codeset, from_codeset);
+
+      if (STRCASEEQ (from_codeset, "UTF-8", 'U','T','F','-','8',0,0,0,0))
+	cd1 = (iconv_t)(-1);
+      else
+	{
+	  cd1 = iconv_open ("UTF-8", from_codeset);
+	  if (cd1 == (iconv_t)(-1))
+	    {
+	      int saved_errno = errno;
+	      if (cd != (iconv_t)(-1))
+		iconv_close (cd);
+	      errno = saved_errno;
+	      return NULL;
+	    }
+	}
+
+      if (STRCASEEQ (to_codeset, "UTF-8", 'U','T','F','-','8',0,0,0,0)
+# if (__GLIBC__ == 2 && __GLIBC_MINOR__ >= 2) || __GLIBC__ > 2 || _LIBICONV_VERSION >= 0x0105
+	  || c_strcasecmp (to_codeset, "UTF-8//TRANSLIT") == 0
+# endif
+	 )
+	cd2 = (iconv_t)(-1);
+      else
+	{
+	  cd2 = iconv_open (to_codeset, "UTF-8");
+	  if (cd2 == (iconv_t)(-1))
+	    {
+	      int saved_errno = errno;
+	      if (cd1 != (iconv_t)(-1))
+		iconv_close (cd1);
+	      if (cd != (iconv_t)(-1))
+		iconv_close (cd);
+	      errno = saved_errno;
+	      return NULL;
+	    }
+	}
+
+      result = str_cd_iconveh (src, cd, cd1, cd2, handler);
+
+      if (result == NULL)
+	{
+	  /* Close cd, cd1, cd2, but preserve the errno from str_cd_iconv.  */
+	  int saved_errno = errno;
+	  if (cd2 != (iconv_t)(-1))
+	    iconv_close (cd2);
+	  if (cd1 != (iconv_t)(-1))
+	    iconv_close (cd1);
+	  if (cd != (iconv_t)(-1))
+	    iconv_close (cd);
+	  errno = saved_errno;
+	}
+      else
+	{
+	  if (cd2 != (iconv_t)(-1) && iconv_close (cd2) < 0)
+	    {
+	      /* Return NULL, but free the allocated memory, and while doing
+		 that, preserve the errno from iconv_close.  */
+	      int saved_errno = errno;
+	      if (cd1 != (iconv_t)(-1))
+		iconv_close (cd1);
+	      if (cd != (iconv_t)(-1))
+		iconv_close (cd);
+	      free (result);
+	      errno = saved_errno;
+	      return NULL;
+	    }
+	  if (cd1 != (iconv_t)(-1) && iconv_close (cd1) < 0)
+	    {
+	      /* Return NULL, but free the allocated memory, and while doing
+		 that, preserve the errno from iconv_close.  */
+	      int saved_errno = errno;
+	      if (cd != (iconv_t)(-1))
+		iconv_close (cd);
+	      free (result);
+	      errno = saved_errno;
+	      return NULL;
+	    }
+	  if (cd != (iconv_t)(-1) && iconv_close (cd) < 0)
+	    {
+	      /* Return NULL, but free the allocated memory, and while doing
+		 that, preserve the errno from iconv_close.  */
+	      int saved_errno = errno;
+	      free (result);
+	      errno = saved_errno;
+	      return NULL;
+	    }
+	}
+      return result;
+#else
+      /* This is a different error code than if iconv_open existed but didn't
+	 support from_codeset and to_codeset, so that the caller can emit
+	 an error message such as
+	   "iconv() is not supported. Installing GNU libiconv and
+	    then reinstalling this package would fix this."  */
+      errno = ENOSYS;
+      return NULL;
+#endif
+    }
+}
diff --git a/lib/striconveh.h b/lib/striconveh.h
new file mode 100644
index 000000000..98b4d0c5e
--- /dev/null
+++ b/lib/striconveh.h
@@ -0,0 +1,120 @@
+/* Character set conversion with error handling.
+   Copyright (C) 2001-2007, 2009 Free Software Foundation, Inc.
+   Written by Bruno Haible and Simon Josefsson.
+
+   This program is free software: you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#ifndef _STRICONVEH_H
+#define _STRICONVEH_H
+
+#include <stddef.h>
+#if HAVE_ICONV
+#include <iconv.h>
+#endif
+
+#include "iconveh.h"
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
+#if HAVE_ICONV
+
+/* Convert an entire string from one encoding to another, using iconv.
+   The original string is at [SRC,...,SRC+SRCLEN-1].
+   CD is the conversion descriptor from FROMCODE to TOCODE, or (iconv_t)(-1) if
+   the system does not support a direct conversion from FROMCODE to TOCODE.
+   CD1 is the conversion descriptor from FROM_CODESET to UTF-8 (or
+   (iconv_t)(-1) if FROM_CODESET is UTF-8).
+   CD2 is the conversion descriptor from UTF-8 to TO_CODESET (or (iconv_t)(-1)
+   if TO_CODESET is UTF-8).
+   If OFFSETS is not NULL, it should point to an array of SRCLEN integers; this
+   array is filled with offsets into the result, i.e. the character starting
+   at SRC[i] corresponds to the character starting at (*RESULTP)[OFFSETS[i]],
+   and other offsets are set to (size_t)(-1).
+   *RESULTP and *LENGTH should initially be a scratch buffer and its size,
+   or *RESULTP can initially be NULL.
+   May erase the contents of the memory at *RESULTP.
+   Return value: 0 if successful, otherwise -1 and errno set.
+   If successful: The resulting string is stored in *RESULTP and its length
+   in *LENGTHP.  *RESULTP is set to a freshly allocated memory block, or is
+   unchanged if no dynamic memory allocation was necessary.  */
+extern int
+       mem_cd_iconveh (const char *src, size_t srclen,
+		       iconv_t cd, iconv_t cd1, iconv_t cd2,
+		       enum iconv_ilseq_handler handler,
+		       size_t *offsets,
+		       char **resultp, size_t *lengthp);
+
+/* Convert an entire string from one encoding to another, using iconv.
+   The original string is the NUL-terminated string starting at SRC.
+   CD is the conversion descriptor from FROMCODE to TOCODE, or (iconv_t)(-1) if
+   the system does not support a direct conversion from FROMCODE to TOCODE.
+   Both the "from" and the "to" encoding must use a single NUL byte at the end
+   of the string (i.e. not UCS-2, UCS-4, UTF-16, UTF-32).
+   CD1 is the conversion descriptor from FROM_CODESET to UTF-8 (or
+   (iconv_t)(-1) if FROM_CODESET is UTF-8).
+   CD2 is the conversion descriptor from UTF-8 to TO_CODESET (or (iconv_t)(-1)
+   if TO_CODESET is UTF-8).
+   Allocate a malloced memory block for the result.
+   Return value: the freshly allocated resulting NUL-terminated string if
+   successful, otherwise NULL and errno set.  */
+extern char *
+       str_cd_iconveh (const char *src,
+		       iconv_t cd, iconv_t cd1, iconv_t cd2,
+		       enum iconv_ilseq_handler handler);
+
+#endif
+
+/* Convert an entire string from one encoding to another, using iconv.
+   The original string is at [SRC,...,SRC+SRCLEN-1].
+   If OFFSETS is not NULL, it should point to an array of SRCLEN integers; this
+   array is filled with offsets into the result, i.e. the character starting
+   at SRC[i] corresponds to the character starting at (*RESULTP)[OFFSETS[i]],
+   and other offsets are set to (size_t)(-1).
+   *RESULTP and *LENGTH should initially be a scratch buffer and its size,
+   or *RESULTP can initially be NULL.
+   May erase the contents of the memory at *RESULTP.
+   Return value: 0 if successful, otherwise -1 and errno set.
+   If successful: The resulting string is stored in *RESULTP and its length
+   in *LENGTHP.  *RESULTP is set to a freshly allocated memory block, or is
+   unchanged if no dynamic memory allocation was necessary.  */
+extern int
+       mem_iconveh (const char *src, size_t srclen,
+		    const char *from_codeset, const char *to_codeset,
+		    enum iconv_ilseq_handler handler,
+		    size_t *offsets,
+		    char **resultp, size_t *lengthp);
+
+/* Convert an entire string from one encoding to another, using iconv.
+   The original string is the NUL-terminated string starting at SRC.
+   Both the "from" and the "to" encoding must use a single NUL byte at the
+   end of the string (i.e. not UCS-2, UCS-4, UTF-16, UTF-32).
+   Allocate a malloced memory block for the result.
+   Return value: the freshly allocated resulting NUL-terminated string if
+   successful, otherwise NULL and errno set.  */
+extern char *
+       str_iconveh (const char *src,
+		    const char *from_codeset, const char *to_codeset,
+		    enum iconv_ilseq_handler handler);
+
+
+#ifdef __cplusplus
+}
+#endif
+
+
+#endif /* _STRICONVEH_H */
diff --git a/lib/string.in.h b/lib/string.in.h
new file mode 100644
index 000000000..fe1142562
--- /dev/null
+++ b/lib/string.in.h
@@ -0,0 +1,620 @@
+/* A GNU-like <string.h>.
+
+   Copyright (C) 1995-1996, 2001-2009 Free Software Foundation, Inc.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 2, or (at your option)
+   any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program; if not, write to the Free Software Foundation,
+   Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+#ifndef _GL_STRING_H
+
+#if __GNUC__ >= 3
+@PRAGMA_SYSTEM_HEADER@
+#endif
+
+/* The include_next requires a split double-inclusion guard.  */
+#@INCLUDE_NEXT@ @NEXT_STRING_H@
+
+#ifndef _GL_STRING_H
+#define _GL_STRING_H
+
+
+#ifndef __attribute__
+/* This feature is available in gcc versions 2.5 and later.  */
+# if __GNUC__ < 2 || (__GNUC__ == 2 && __GNUC_MINOR__ < 5)
+#  define __attribute__(Spec) /* empty */
+# endif
+/* The attribute __pure__ was added in gcc 2.96.  */
+# if __GNUC__ < 2 || (__GNUC__ == 2 && __GNUC_MINOR__ < 96)
+#  define __pure__ /* empty */
+# endif
+#endif
+
+
+/* The definition of GL_LINK_WARNING is copied here.  */
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
+/* Return the first instance of C within N bytes of S, or NULL.  */
+#if @GNULIB_MEMCHR@
+# if @REPLACE_MEMCHR@
+#  define memchr rpl_memchr
+extern void *memchr (void const *__s, int __c, size_t __n)
+  __attribute__ ((__pure__));
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef memchr
+# define memchr(s,c,n) \
+    (GL_LINK_WARNING ("memchr has platform-specific bugs - " \
+                      "use gnulib module memchr for portability" ), \
+     memchr (s, c, n))
+#endif
+
+/* Return the first occurrence of NEEDLE in HAYSTACK.  */
+#if @GNULIB_MEMMEM@
+# if @REPLACE_MEMMEM@
+#  define memmem rpl_memmem
+# endif
+# if ! @HAVE_DECL_MEMMEM@ || @REPLACE_MEMMEM@
+extern void *memmem (void const *__haystack, size_t __haystack_len,
+		     void const *__needle, size_t __needle_len)
+  __attribute__ ((__pure__));
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef memmem
+# define memmem(a,al,b,bl) \
+    (GL_LINK_WARNING ("memmem is unportable and often quadratic - " \
+                      "use gnulib module memmem-simple for portability, " \
+                      "and module memmem for speed" ), \
+     memmem (a, al, b, bl))
+#endif
+
+/* Copy N bytes of SRC to DEST, return pointer to bytes after the
+   last written byte.  */
+#if @GNULIB_MEMPCPY@
+# if ! @HAVE_MEMPCPY@
+extern void *mempcpy (void *restrict __dest, void const *restrict __src,
+		      size_t __n);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef mempcpy
+# define mempcpy(a,b,n) \
+    (GL_LINK_WARNING ("mempcpy is unportable - " \
+                      "use gnulib module mempcpy for portability"), \
+     mempcpy (a, b, n))
+#endif
+
+/* Search backwards through a block for a byte (specified as an int).  */
+#if @GNULIB_MEMRCHR@
+# if ! @HAVE_DECL_MEMRCHR@
+extern void *memrchr (void const *, int, size_t)
+  __attribute__ ((__pure__));
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef memrchr
+# define memrchr(a,b,c) \
+    (GL_LINK_WARNING ("memrchr is unportable - " \
+                      "use gnulib module memrchr for portability"), \
+     memrchr (a, b, c))
+#endif
+
+/* Find the first occurrence of C in S.  More efficient than
+   memchr(S,C,N), at the expense of undefined behavior if C does not
+   occur within N bytes.  */
+#if @GNULIB_RAWMEMCHR@
+# if ! @HAVE_RAWMEMCHR@
+extern void *rawmemchr (void const *__s, int __c_in)
+  __attribute__ ((__pure__));
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef rawmemchr
+# define rawmemchr(a,b) \
+    (GL_LINK_WARNING ("rawmemchr is unportable - " \
+                      "use gnulib module rawmemchr for portability"), \
+     rawmemchr (a, b))
+#endif
+
+/* Copy SRC to DST, returning the address of the terminating '\0' in DST.  */
+#if @GNULIB_STPCPY@
+# if ! @HAVE_STPCPY@
+extern char *stpcpy (char *restrict __dst, char const *restrict __src);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef stpcpy
+# define stpcpy(a,b) \
+    (GL_LINK_WARNING ("stpcpy is unportable - " \
+                      "use gnulib module stpcpy for portability"), \
+     stpcpy (a, b))
+#endif
+
+/* Copy no more than N bytes of SRC to DST, returning a pointer past the
+   last non-NUL byte written into DST.  */
+#if @GNULIB_STPNCPY@
+# if ! @HAVE_STPNCPY@
+#  define stpncpy gnu_stpncpy
+extern char *stpncpy (char *restrict __dst, char const *restrict __src,
+		      size_t __n);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef stpncpy
+# define stpncpy(a,b,n) \
+    (GL_LINK_WARNING ("stpncpy is unportable - " \
+                      "use gnulib module stpncpy for portability"), \
+     stpncpy (a, b, n))
+#endif
+
+#if defined GNULIB_POSIXCHECK
+/* strchr() does not work with multibyte strings if the locale encoding is
+   GB18030 and the character to be searched is a digit.  */
+# undef strchr
+# define strchr(s,c) \
+    (GL_LINK_WARNING ("strchr cannot work correctly on character strings " \
+                      "in some multibyte locales - " \
+                      "use mbschr if you care about internationalization"), \
+     strchr (s, c))
+#endif
+
+/* Find the first occurrence of C in S or the final NUL byte.  */
+#if @GNULIB_STRCHRNUL@
+# if ! @HAVE_STRCHRNUL@
+extern char *strchrnul (char const *__s, int __c_in)
+  __attribute__ ((__pure__));
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef strchrnul
+# define strchrnul(a,b) \
+    (GL_LINK_WARNING ("strchrnul is unportable - " \
+                      "use gnulib module strchrnul for portability"), \
+     strchrnul (a, b))
+#endif
+
+/* Duplicate S, returning an identical malloc'd string.  */
+#if @GNULIB_STRDUP@
+# if @REPLACE_STRDUP@
+#  undef strdup
+#  define strdup rpl_strdup
+# endif
+# if !(@HAVE_DECL_STRDUP@ || defined strdup) || @REPLACE_STRDUP@
+extern char *strdup (char const *__s);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef strdup
+# define strdup(a) \
+    (GL_LINK_WARNING ("strdup is unportable - " \
+                      "use gnulib module strdup for portability"), \
+     strdup (a))
+#endif
+
+/* Return a newly allocated copy of at most N bytes of STRING.  */
+#if @GNULIB_STRNDUP@
+# if ! @HAVE_STRNDUP@
+#  undef strndup
+#  define strndup rpl_strndup
+# endif
+# if ! @HAVE_STRNDUP@ || ! @HAVE_DECL_STRNDUP@
+extern char *strndup (char const *__string, size_t __n);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef strndup
+# define strndup(a,n) \
+    (GL_LINK_WARNING ("strndup is unportable - " \
+                      "use gnulib module strndup for portability"), \
+     strndup (a, n))
+#endif
+
+/* Find the length (number of bytes) of STRING, but scan at most
+   MAXLEN bytes.  If no '\0' terminator is found in that many bytes,
+   return MAXLEN.  */
+#if @GNULIB_STRNLEN@
+# if ! @HAVE_DECL_STRNLEN@
+extern size_t strnlen (char const *__string, size_t __maxlen)
+  __attribute__ ((__pure__));
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef strnlen
+# define strnlen(a,n) \
+    (GL_LINK_WARNING ("strnlen is unportable - " \
+                      "use gnulib module strnlen for portability"), \
+     strnlen (a, n))
+#endif
+
+#if defined GNULIB_POSIXCHECK
+/* strcspn() assumes the second argument is a list of single-byte characters.
+   Even in this simple case, it does not work with multibyte strings if the
+   locale encoding is GB18030 and one of the characters to be searched is a
+   digit.  */
+# undef strcspn
+# define strcspn(s,a) \
+    (GL_LINK_WARNING ("strcspn cannot work correctly on character strings " \
+                      "in multibyte locales - " \
+                      "use mbscspn if you care about internationalization"), \
+     strcspn (s, a))
+#endif
+
+/* Find the first occurrence in S of any character in ACCEPT.  */
+#if @GNULIB_STRPBRK@
+# if ! @HAVE_STRPBRK@
+extern char *strpbrk (char const *__s, char const *__accept)
+  __attribute__ ((__pure__));
+# endif
+# if defined GNULIB_POSIXCHECK
+/* strpbrk() assumes the second argument is a list of single-byte characters.
+   Even in this simple case, it does not work with multibyte strings if the
+   locale encoding is GB18030 and one of the characters to be searched is a
+   digit.  */
+#  undef strpbrk
+#  define strpbrk(s,a) \
+     (GL_LINK_WARNING ("strpbrk cannot work correctly on character strings " \
+                       "in multibyte locales - " \
+                       "use mbspbrk if you care about internationalization"), \
+      strpbrk (s, a))
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef strpbrk
+# define strpbrk(s,a) \
+    (GL_LINK_WARNING ("strpbrk is unportable - " \
+                      "use gnulib module strpbrk for portability"), \
+     strpbrk (s, a))
+#endif
+
+#if defined GNULIB_POSIXCHECK
+/* strspn() assumes the second argument is a list of single-byte characters.
+   Even in this simple case, it cannot work with multibyte strings.  */
+# undef strspn
+# define strspn(s,a) \
+    (GL_LINK_WARNING ("strspn cannot work correctly on character strings " \
+                      "in multibyte locales - " \
+                      "use mbsspn if you care about internationalization"), \
+     strspn (s, a))
+#endif
+
+#if defined GNULIB_POSIXCHECK
+/* strrchr() does not work with multibyte strings if the locale encoding is
+   GB18030 and the character to be searched is a digit.  */
+# undef strrchr
+# define strrchr(s,c) \
+    (GL_LINK_WARNING ("strrchr cannot work correctly on character strings " \
+                      "in some multibyte locales - " \
+                      "use mbsrchr if you care about internationalization"), \
+     strrchr (s, c))
+#endif
+
+/* Search the next delimiter (char listed in DELIM) starting at *STRINGP.
+   If one is found, overwrite it with a NUL, and advance *STRINGP
+   to point to the next char after it.  Otherwise, set *STRINGP to NULL.
+   If *STRINGP was already NULL, nothing happens.
+   Return the old value of *STRINGP.
+
+   This is a variant of strtok() that is multithread-safe and supports
+   empty fields.
+
+   Caveat: It modifies the original string.
+   Caveat: These functions cannot be used on constant strings.
+   Caveat: The identity of the delimiting character is lost.
+   Caveat: It doesn't work with multibyte strings unless all of the delimiter
+           characters are ASCII characters < 0x30.
+
+   See also strtok_r().  */
+#if @GNULIB_STRSEP@
+# if ! @HAVE_STRSEP@
+extern char *strsep (char **restrict __stringp, char const *restrict __delim);
+# endif
+# if defined GNULIB_POSIXCHECK
+#  undef strsep
+#  define strsep(s,d) \
+     (GL_LINK_WARNING ("strsep cannot work correctly on character strings " \
+                       "in multibyte locales - " \
+                       "use mbssep if you care about internationalization"), \
+      strsep (s, d))
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef strsep
+# define strsep(s,d) \
+    (GL_LINK_WARNING ("strsep is unportable - " \
+                      "use gnulib module strsep for portability"), \
+     strsep (s, d))
+#endif
+
+#if @GNULIB_STRSTR@
+# if @REPLACE_STRSTR@
+#  define strstr rpl_strstr
+char *strstr (const char *haystack, const char *needle)
+  __attribute__ ((__pure__));
+# endif
+#elif defined GNULIB_POSIXCHECK
+/* strstr() does not work with multibyte strings if the locale encoding is
+   different from UTF-8:
+   POSIX says that it operates on "strings", and "string" in POSIX is defined
+   as a sequence of bytes, not of characters.  */
+# undef strstr
+# define strstr(a,b) \
+    (GL_LINK_WARNING ("strstr is quadratic on many systems, and cannot " \
+                      "work correctly on character strings in most "    \
+                      "multibyte locales - " \
+                      "use mbsstr if you care about internationalization, " \
+                      "or use strstr if you care about speed"), \
+     strstr (a, b))
+#endif
+
+/* Find the first occurrence of NEEDLE in HAYSTACK, using case-insensitive
+   comparison.  */
+#if @GNULIB_STRCASESTR@
+# if @REPLACE_STRCASESTR@
+#  define strcasestr rpl_strcasestr
+# endif
+# if ! @HAVE_STRCASESTR@ || @REPLACE_STRCASESTR@
+extern char *strcasestr (const char *haystack, const char *needle)
+  __attribute__ ((__pure__));
+# endif
+#elif defined GNULIB_POSIXCHECK
+/* strcasestr() does not work with multibyte strings:
+   It is a glibc extension, and glibc implements it only for unibyte
+   locales.  */
+# undef strcasestr
+# define strcasestr(a,b) \
+    (GL_LINK_WARNING ("strcasestr does work correctly on character strings " \
+                      "in multibyte locales - " \
+                      "use mbscasestr if you care about " \
+                      "internationalization, or use c-strcasestr if you want " \
+                      "a locale independent function"), \
+     strcasestr (a, b))
+#endif
+
+/* Parse S into tokens separated by characters in DELIM.
+   If S is NULL, the saved pointer in SAVE_PTR is used as
+   the next starting point.  For example:
+	char s[] = "-abc-=-def";
+	char *sp;
+	x = strtok_r(s, "-", &sp);	// x = "abc", sp = "=-def"
+	x = strtok_r(NULL, "-=", &sp);	// x = "def", sp = NULL
+	x = strtok_r(NULL, "=", &sp);	// x = NULL
+		// s = "abc\0-def\0"
+
+   This is a variant of strtok() that is multithread-safe.
+
+   For the POSIX documentation for this function, see:
+   http://www.opengroup.org/susv3xsh/strtok.html
+
+   Caveat: It modifies the original string.
+   Caveat: These functions cannot be used on constant strings.
+   Caveat: The identity of the delimiting character is lost.
+   Caveat: It doesn't work with multibyte strings unless all of the delimiter
+           characters are ASCII characters < 0x30.
+
+   See also strsep().  */
+#if @GNULIB_STRTOK_R@
+# if ! @HAVE_DECL_STRTOK_R@
+extern char *strtok_r (char *restrict s, char const *restrict delim,
+		       char **restrict save_ptr);
+# endif
+# if defined GNULIB_POSIXCHECK
+#  undef strtok_r
+#  define strtok_r(s,d,p) \
+     (GL_LINK_WARNING ("strtok_r cannot work correctly on character strings " \
+                       "in multibyte locales - " \
+                       "use mbstok_r if you care about internationalization"), \
+      strtok_r (s, d, p))
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef strtok_r
+# define strtok_r(s,d,p) \
+    (GL_LINK_WARNING ("strtok_r is unportable - " \
+                      "use gnulib module strtok_r for portability"), \
+     strtok_r (s, d, p))
+#endif
+
+
+/* The following functions are not specified by POSIX.  They are gnulib
+   extensions.  */
+
+#if @GNULIB_MBSLEN@
+/* Return the number of multibyte characters in the character string STRING.
+   This considers multibyte characters, unlike strlen, which counts bytes.  */
+extern size_t mbslen (const char *string);
+#endif
+
+#if @GNULIB_MBSNLEN@
+/* Return the number of multibyte characters in the character string starting
+   at STRING and ending at STRING + LEN.  */
+extern size_t mbsnlen (const char *string, size_t len);
+#endif
+
+#if @GNULIB_MBSCHR@
+/* Locate the first single-byte character C in the character string STRING,
+   and return a pointer to it.  Return NULL if C is not found in STRING.
+   Unlike strchr(), this function works correctly in multibyte locales with
+   encodings such as GB18030.  */
+# define mbschr rpl_mbschr /* avoid collision with HP-UX function */
+extern char * mbschr (const char *string, int c);
+#endif
+
+#if @GNULIB_MBSRCHR@
+/* Locate the last single-byte character C in the character string STRING,
+   and return a pointer to it.  Return NULL if C is not found in STRING.
+   Unlike strrchr(), this function works correctly in multibyte locales with
+   encodings such as GB18030.  */
+# define mbsrchr rpl_mbsrchr /* avoid collision with HP-UX function */
+extern char * mbsrchr (const char *string, int c);
+#endif
+
+#if @GNULIB_MBSSTR@
+/* Find the first occurrence of the character string NEEDLE in the character
+   string HAYSTACK.  Return NULL if NEEDLE is not found in HAYSTACK.
+   Unlike strstr(), this function works correctly in multibyte locales with
+   encodings different from UTF-8.  */
+extern char * mbsstr (const char *haystack, const char *needle);
+#endif
+
+#if @GNULIB_MBSCASECMP@
+/* Compare the character strings S1 and S2, ignoring case, returning less than,
+   equal to or greater than zero if S1 is lexicographically less than, equal to
+   or greater than S2.
+   Note: This function may, in multibyte locales, return 0 for strings of
+   different lengths!
+   Unlike strcasecmp(), this function works correctly in multibyte locales.  */
+extern int mbscasecmp (const char *s1, const char *s2);
+#endif
+
+#if @GNULIB_MBSNCASECMP@
+/* Compare the initial segment of the character string S1 consisting of at most
+   N characters with the initial segment of the character string S2 consisting
+   of at most N characters, ignoring case, returning less than, equal to or
+   greater than zero if the initial segment of S1 is lexicographically less
+   than, equal to or greater than the initial segment of S2.
+   Note: This function may, in multibyte locales, return 0 for initial segments
+   of different lengths!
+   Unlike strncasecmp(), this function works correctly in multibyte locales.
+   But beware that N is not a byte count but a character count!  */
+extern int mbsncasecmp (const char *s1, const char *s2, size_t n);
+#endif
+
+#if @GNULIB_MBSPCASECMP@
+/* Compare the initial segment of the character string STRING consisting of
+   at most mbslen (PREFIX) characters with the character string PREFIX,
+   ignoring case, returning less than, equal to or greater than zero if this
+   initial segment is lexicographically less than, equal to or greater than
+   PREFIX.
+   Note: This function may, in multibyte locales, return 0 if STRING is of
+   smaller length than PREFIX!
+   Unlike strncasecmp(), this function works correctly in multibyte
+   locales.  */
+extern char * mbspcasecmp (const char *string, const char *prefix);
+#endif
+
+#if @GNULIB_MBSCASESTR@
+/* Find the first occurrence of the character string NEEDLE in the character
+   string HAYSTACK, using case-insensitive comparison.
+   Note: This function may, in multibyte locales, return success even if
+   strlen (haystack) < strlen (needle) !
+   Unlike strcasestr(), this function works correctly in multibyte locales.  */
+extern char * mbscasestr (const char *haystack, const char *needle);
+#endif
+
+#if @GNULIB_MBSCSPN@
+/* Find the first occurrence in the character string STRING of any character
+   in the character string ACCEPT.  Return the number of bytes from the
+   beginning of the string to this occurrence, or to the end of the string
+   if none exists.
+   Unlike strcspn(), this function works correctly in multibyte locales.  */
+extern size_t mbscspn (const char *string, const char *accept);
+#endif
+
+#if @GNULIB_MBSPBRK@
+/* Find the first occurrence in the character string STRING of any character
+   in the character string ACCEPT.  Return the pointer to it, or NULL if none
+   exists.
+   Unlike strpbrk(), this function works correctly in multibyte locales.  */
+# define mbspbrk rpl_mbspbrk /* avoid collision with HP-UX function */
+extern char * mbspbrk (const char *string, const char *accept);
+#endif
+
+#if @GNULIB_MBSSPN@
+/* Find the first occurrence in the character string STRING of any character
+   not in the character string REJECT.  Return the number of bytes from the
+   beginning of the string to this occurrence, or to the end of the string
+   if none exists.
+   Unlike strspn(), this function works correctly in multibyte locales.  */
+extern size_t mbsspn (const char *string, const char *reject);
+#endif
+
+#if @GNULIB_MBSSEP@
+/* Search the next delimiter (multibyte character listed in the character
+   string DELIM) starting at the character string *STRINGP.
+   If one is found, overwrite it with a NUL, and advance *STRINGP to point
+   to the next multibyte character after it.  Otherwise, set *STRINGP to NULL.
+   If *STRINGP was already NULL, nothing happens.
+   Return the old value of *STRINGP.
+
+   This is a variant of mbstok_r() that supports empty fields.
+
+   Caveat: It modifies the original string.
+   Caveat: These functions cannot be used on constant strings.
+   Caveat: The identity of the delimiting character is lost.
+
+   See also mbstok_r().  */
+extern char * mbssep (char **stringp, const char *delim);
+#endif
+
+#if @GNULIB_MBSTOK_R@
+/* Parse the character string STRING into tokens separated by characters in
+   the character string DELIM.
+   If STRING is NULL, the saved pointer in SAVE_PTR is used as
+   the next starting point.  For example:
+	char s[] = "-abc-=-def";
+	char *sp;
+	x = mbstok_r(s, "-", &sp);	// x = "abc", sp = "=-def"
+	x = mbstok_r(NULL, "-=", &sp);	// x = "def", sp = NULL
+	x = mbstok_r(NULL, "=", &sp);	// x = NULL
+		// s = "abc\0-def\0"
+
+   Caveat: It modifies the original string.
+   Caveat: These functions cannot be used on constant strings.
+   Caveat: The identity of the delimiting character is lost.
+
+   See also mbssep().  */
+extern char * mbstok_r (char *string, const char *delim, char **save_ptr);
+#endif
+
+/* Map any int, typically from errno, into an error message.  */
+#if @GNULIB_STRERROR@
+# if @REPLACE_STRERROR@
+#  undef strerror
+#  define strerror rpl_strerror
+extern char *strerror (int);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef strerror
+# define strerror(e) \
+    (GL_LINK_WARNING ("strerror is unportable - " \
+                      "use gnulib module strerror to guarantee non-NULL result"), \
+     strerror (e))
+#endif
+
+#if @GNULIB_STRSIGNAL@
+# if @REPLACE_STRSIGNAL@
+#  define strsignal rpl_strsignal
+# endif
+# if ! @HAVE_DECL_STRSIGNAL@ || @REPLACE_STRSIGNAL@
+extern char *strsignal (int __sig);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef strsignal
+# define strsignal(a) \
+    (GL_LINK_WARNING ("strsignal is unportable - " \
+                      "use gnulib module strsignal for portability"), \
+     strsignal (a))
+#endif
+
+#if @GNULIB_STRVERSCMP@
+# if !@HAVE_STRVERSCMP@
+extern int strverscmp (const char *, const char *);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef strverscmp
+# define strverscmp(a, b) \
+    (GL_LINK_WARNING ("strverscmp is unportable - " \
+                      "use gnulib module strverscmp for portability"), \
+     strverscmp (a, b))
+#endif
+
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* _GL_STRING_H */
+#endif /* _GL_STRING_H */
diff --git a/lib/sys_file.in.h b/lib/sys_file.in.h
new file mode 100644
index 000000000..52ef46619
--- /dev/null
+++ b/lib/sys_file.in.h
@@ -0,0 +1,60 @@
+/* Provide a more complete sys/file.h.
+
+   Copyright (C) 2007-2008 Free Software Foundation, Inc.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 2, or (at your option)
+   any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program; if not, write to the Free Software Foundation,
+   Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+/* Written by Richard W.M. Jones.  */
+#ifndef _GL_SYS_FILE_H
+
+# if __GNUC__ >= 3
+@PRAGMA_SYSTEM_HEADER@
+# endif
+
+/* The include_next requires a split double-inclusion guard.  */
+# if @HAVE_SYS_FILE_H@
+#  @INCLUDE_NEXT@ @NEXT_SYS_FILE_H@
+# endif
+
+#ifndef _GL_SYS_FILE_H
+#define _GL_SYS_FILE_H
+
+
+#if @GNULIB_FLOCK@
+/* Apply or remove advisory locks on an open file.
+   Return 0 if successful, otherwise -1 and errno set.  */
+# if !@HAVE_FLOCK@
+extern int flock (int fd, int operation);
+
+/* Operations for the 'flock' call (same as Linux kernel constants).  */
+#define LOCK_SH 1       /* Shared lock.  */
+#define LOCK_EX 2       /* Exclusive lock.  */
+#define LOCK_UN 8       /* Unlock.  */
+
+/* Can be OR'd in to one of the above.  */
+#define LOCK_NB 4       /* Don't block when locking.  */
+
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef flock
+# define flock(fd,op)			       \
+    (GL_LINK_WARNING ("flock is unportable - " \
+                      "use gnulib module flock for portability"), \
+     flock ((fd), (op)))
+#endif
+
+
+#endif /* _GL_SYS_FILE_H */
+#endif /* _GL_SYS_FILE_H */
diff --git a/lib/time.in.h b/lib/time.in.h
index 7da429a54..cef4e0546 100644
--- a/lib/time.in.h
+++ b/lib/time.in.h
@@ -1,6 +1,6 @@
 /* A more-standard <time.h>.
 
-   Copyright (C) 2007-2008 Free Software Foundation, Inc.
+   Copyright (C) 2007-2009 Free Software Foundation, Inc.
 
    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU Lesser General Public License as published by
@@ -66,6 +66,12 @@ struct timespec
 int nanosleep (struct timespec const *__rqtp, struct timespec *__rmtp);
 # endif
 
+/* Return the 'time_t' representation of TP and normalize TP.  */
+# if @REPLACE_MKTIME@
+#  define mktime rpl_mktime
+extern time_t mktime (struct tm *__tp);
+# endif
+
 /* Convert TIMER to RESULT, assuming local time and UTC respectively.  See
    <http://www.opengroup.org/susv3xsh/localtime_r.html> and
    <http://www.opengroup.org/susv3xsh/gmtime_r.html>.  */
diff --git a/lib/unistd.in.h b/lib/unistd.in.h
index d4b842a05..e2545cbca 100644
--- a/lib/unistd.in.h
+++ b/lib/unistd.in.h
@@ -1,5 +1,5 @@
 /* Substitute for and wrapper around <unistd.h>.
-   Copyright (C) 2003-2008 Free Software Foundation, Inc.
+   Copyright (C) 2003-2009 Free Software Foundation, Inc.
 
    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU Lesser General Public License as published by
@@ -29,7 +29,7 @@
 #ifndef _GL_UNISTD_H
 #define _GL_UNISTD_H
 
-/* mingw doesn't define the SEEK_* macros in <unistd.h>.  */
+/* mingw doesn't define the SEEK_* or *_FILENO macros in <unistd.h>.  */
 #if !(defined SEEK_CUR && defined SEEK_END && defined SEEK_SET)
 # include <stdio.h>
 #endif
@@ -87,6 +87,17 @@
 /* The definition of GL_LINK_WARNING is copied here.  */
 
 
+/* OS/2 EMX lacks these macros.  */
+#ifndef STDIN_FILENO
+# define STDIN_FILENO 0
+#endif
+#ifndef STDOUT_FILENO
+# define STDOUT_FILENO 1
+#endif
+#ifndef STDERR_FILENO
+# define STDERR_FILENO 2
+#endif
+
 /* Declare overridden functions.  */
 
 #ifdef __cplusplus
@@ -120,10 +131,6 @@ extern int chown (const char *file, uid_t uid, gid_t gid);
 
 
 #if @GNULIB_CLOSE@
-# if @UNISTD_H_HAVE_WINSOCK2_H@
-/* Need a gnulib internal function.  */
-#  define HAVE__GL_CLOSE_FD_MAYBE_SOCKET 1
-# endif
 # if @REPLACE_CLOSE@
 /* Automatically included by modules that need a replacement for close.  */
 #  undef close
@@ -143,10 +150,13 @@ extern int close (int);
 
 
 #if @GNULIB_DUP2@
-# if !@HAVE_DUP2@
+# if @REPLACE_DUP2@
+#  define dup2 rpl_dup2
+# endif
+# if !@HAVE_DUP2@ || @REPLACE_DUP2@
 /* Copy the file descriptor OLDFD into file descriptor NEWFD.  Do nothing if
    NEWFD = OLDFD, otherwise close NEWFD first if it is open.
-   Return 0 if successful, otherwise -1 and errno set.
+   Return newfd if successful, otherwise -1 and errno set.
    See the POSIX:2001 specification
    <http://www.opengroup.org/susv3xsh/dup2.html>.  */
 extern int dup2 (int oldfd, int newfd);
@@ -207,7 +217,11 @@ extern int fchdir (int /*fd*/);
 
 #  define dup rpl_dup
 extern int dup (int);
-#  define dup2 rpl_dup2
+
+#  if @REPLACE_DUP2@
+#   undef dup2
+#  endif
+#  define dup2 rpl_dup2_fchdir
 extern int dup2 (int, int);
 
 # endif
@@ -475,6 +489,23 @@ extern int lchown (char const *file, uid_t owner, gid_t group);
 #endif
 
 
+#if @GNULIB_LINK@
+/* Create a new hard link for an existing file.
+   Return 0 if successful, otherwise -1 and errno set.
+   See POSIX:2001 specification
+   <http://www.opengroup.org/susv3xsh/link.html>.  */
+# if !@HAVE_LINK@
+extern int link (const char *path1, const char *path2);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef link
+# define link(path1,path2) \
+    (GL_LINK_WARNING ("link is unportable - " \
+                      "use gnulib module link for portability"), \
+     link (path1, path2))
+#endif
+
+
 #if @GNULIB_LSEEK@
 # if @REPLACE_LSEEK@
 /* Set the offset of FD relative to SEEK_SET, SEEK_CUR, or SEEK_END.
diff --git a/lib/unistr.h b/lib/unistr.h
new file mode 100644
index 000000000..83ff13411
--- /dev/null
+++ b/lib/unistr.h
@@ -0,0 +1,681 @@
+/* Elementary Unicode string functions.
+   Copyright (C) 2001-2002, 2005-2009 Free Software Foundation, Inc.
+
+   This program is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#ifndef _UNISTR_H
+#define _UNISTR_H
+
+#include "unitypes.h"
+
+/* Get bool.  */
+#include <stdbool.h>
+
+/* Get size_t.  */
+#include <stddef.h>
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
+/* Conventions:
+
+   All functions prefixed with u8_ operate on UTF-8 encoded strings.
+   Their unit is an uint8_t (1 byte).
+
+   All functions prefixed with u16_ operate on UTF-16 encoded strings.
+   Their unit is an uint16_t (a 2-byte word).
+
+   All functions prefixed with u32_ operate on UCS-4 encoded strings.
+   Their unit is an uint32_t (a 4-byte word).
+
+   All argument pairs (s, n) denote a Unicode string s[0..n-1] with exactly
+   n units.
+
+   All arguments starting with "str" and the arguments of functions starting
+   with u8_str/u16_str/u32_str denote a NUL terminated string, i.e. a string
+   which terminates at the first NUL unit.  This termination unit is
+   considered part of the string for all memory allocation purposes, but
+   is not considered part of the string for all other logical purposes.
+
+   Functions returning a string result take a (resultbuf, lengthp) argument
+   pair.  If resultbuf is not NULL and the result fits into *lengthp units,
+   it is put in resultbuf, and resultbuf is returned.  Otherwise, a freshly
+   allocated string is returned.  In both cases, *lengthp is set to the
+   length (number of units) of the returned string.  In case of error,
+   NULL is returned and errno is set.  */
+
+
+/* Elementary string checks.  */
+
+/* Check whether an UTF-8 string is well-formed.
+   Return NULL if valid, or a pointer to the first invalid unit otherwise.  */
+extern const uint8_t *
+       u8_check (const uint8_t *s, size_t n);
+
+/* Check whether an UTF-16 string is well-formed.
+   Return NULL if valid, or a pointer to the first invalid unit otherwise.  */
+extern const uint16_t *
+       u16_check (const uint16_t *s, size_t n);
+
+/* Check whether an UCS-4 string is well-formed.
+   Return NULL if valid, or a pointer to the first invalid unit otherwise.  */
+extern const uint32_t *
+       u32_check (const uint32_t *s, size_t n);
+
+
+/* Elementary string conversions.  */
+
+/* Convert an UTF-8 string to an UTF-16 string.  */
+extern uint16_t *
+       u8_to_u16 (const uint8_t *s, size_t n, uint16_t *resultbuf,
+		  size_t *lengthp);
+
+/* Convert an UTF-8 string to an UCS-4 string.  */
+extern uint32_t *
+       u8_to_u32 (const uint8_t *s, size_t n, uint32_t *resultbuf,
+		  size_t *lengthp);
+
+/* Convert an UTF-16 string to an UTF-8 string.  */
+extern uint8_t *
+       u16_to_u8 (const uint16_t *s, size_t n, uint8_t *resultbuf,
+		  size_t *lengthp);
+
+/* Convert an UTF-16 string to an UCS-4 string.  */
+extern uint32_t *
+       u16_to_u32 (const uint16_t *s, size_t n, uint32_t *resultbuf,
+		   size_t *lengthp);
+
+/* Convert an UCS-4 string to an UTF-8 string.  */
+extern uint8_t *
+       u32_to_u8 (const uint32_t *s, size_t n, uint8_t *resultbuf,
+		  size_t *lengthp);
+
+/* Convert an UCS-4 string to an UTF-16 string.  */
+extern uint16_t *
+       u32_to_u16 (const uint32_t *s, size_t n, uint16_t *resultbuf,
+		   size_t *lengthp);
+
+
+/* Elementary string functions.  */
+
+/* Return the length (number of units) of the first character in S, which is
+   no longer than N.  Return 0 if it is the NUL character.  Return -1 upon
+   failure.  */
+/* Similar to mblen(), except that s must not be NULL.  */
+extern int
+       u8_mblen (const uint8_t *s, size_t n);
+extern int
+       u16_mblen (const uint16_t *s, size_t n);
+extern int
+       u32_mblen (const uint32_t *s, size_t n);
+
+/* Return the length (number of units) of the first character in S, putting
+   its 'ucs4_t' representation in *PUC.  Upon failure, *PUC is set to 0xfffd,
+   and an appropriate number of units is returned.
+   The number of available units, N, must be > 0.  */
+/* Similar to mbtowc(), except that puc and s must not be NULL, n must be > 0,
+   and the NUL character is not treated specially.  */
+/* The variants with _safe suffix are safe, even if the library is compiled
+   without --enable-safety.  */
+
+#ifdef GNULIB_UNISTR_U8_MBTOUC_UNSAFE
+# if !HAVE_INLINE
+extern int
+       u8_mbtouc_unsafe (ucs4_t *puc, const uint8_t *s, size_t n);
+# else
+extern int
+       u8_mbtouc_unsafe_aux (ucs4_t *puc, const uint8_t *s, size_t n);
+static inline int
+u8_mbtouc_unsafe (ucs4_t *puc, const uint8_t *s, size_t n)
+{
+  uint8_t c = *s;
+
+  if (c < 0x80)
+    {
+      *puc = c;
+      return 1;
+    }
+  else
+    return u8_mbtouc_unsafe_aux (puc, s, n);
+}
+# endif
+#endif
+
+#ifdef GNULIB_UNISTR_U16_MBTOUC_UNSAFE
+# if !HAVE_INLINE
+extern int
+       u16_mbtouc_unsafe (ucs4_t *puc, const uint16_t *s, size_t n);
+# else
+extern int
+       u16_mbtouc_unsafe_aux (ucs4_t *puc, const uint16_t *s, size_t n);
+static inline int
+u16_mbtouc_unsafe (ucs4_t *puc, const uint16_t *s, size_t n)
+{
+  uint16_t c = *s;
+
+  if (c < 0xd800 || c >= 0xe000)
+    {
+      *puc = c;
+      return 1;
+    }
+  else
+    return u16_mbtouc_unsafe_aux (puc, s, n);
+}
+# endif
+#endif
+
+#ifdef GNULIB_UNISTR_U32_MBTOUC_UNSAFE
+# if !HAVE_INLINE
+extern int
+       u32_mbtouc_unsafe (ucs4_t *puc, const uint32_t *s, size_t n);
+# else
+static inline int
+u32_mbtouc_unsafe (ucs4_t *puc, const uint32_t *s, size_t n _UNUSED_PARAMETER_)
+{
+  uint32_t c = *s;
+
+#  if CONFIG_UNICODE_SAFETY
+  if (c < 0xd800 || (c >= 0xe000 && c < 0x110000))
+#  endif
+    *puc = c;
+#  if CONFIG_UNICODE_SAFETY
+  else
+    /* invalid multibyte character */
+    *puc = 0xfffd;
+#  endif
+  return 1;
+}
+# endif
+#endif
+
+#ifdef GNULIB_UNISTR_U8_MBTOUC
+# if !HAVE_INLINE
+extern int
+       u8_mbtouc (ucs4_t *puc, const uint8_t *s, size_t n);
+# else
+extern int
+       u8_mbtouc_aux (ucs4_t *puc, const uint8_t *s, size_t n);
+static inline int
+u8_mbtouc (ucs4_t *puc, const uint8_t *s, size_t n)
+{
+  uint8_t c = *s;
+
+  if (c < 0x80)
+    {
+      *puc = c;
+      return 1;
+    }
+  else
+    return u8_mbtouc_aux (puc, s, n);
+}
+# endif
+#endif
+
+#ifdef GNULIB_UNISTR_U16_MBTOUC
+# if !HAVE_INLINE
+extern int
+       u16_mbtouc (ucs4_t *puc, const uint16_t *s, size_t n);
+# else
+extern int
+       u16_mbtouc_aux (ucs4_t *puc, const uint16_t *s, size_t n);
+static inline int
+u16_mbtouc (ucs4_t *puc, const uint16_t *s, size_t n)
+{
+  uint16_t c = *s;
+
+  if (c < 0xd800 || c >= 0xe000)
+    {
+      *puc = c;
+      return 1;
+    }
+  else
+    return u16_mbtouc_aux (puc, s, n);
+}
+# endif
+#endif
+
+#ifdef GNULIB_UNISTR_U32_MBTOUC
+# if !HAVE_INLINE
+extern int
+       u32_mbtouc (ucs4_t *puc, const uint32_t *s, size_t n);
+# else
+static inline int
+u32_mbtouc (ucs4_t *puc, const uint32_t *s, size_t n _UNUSED_PARAMETER_)
+{
+  uint32_t c = *s;
+
+  if (c < 0xd800 || (c >= 0xe000 && c < 0x110000))
+    *puc = c;
+  else
+    /* invalid multibyte character */
+    *puc = 0xfffd;
+  return 1;
+}
+# endif
+#endif
+
+/* Return the length (number of units) of the first character in S, putting
+   its 'ucs4_t' representation in *PUC.  Upon failure, *PUC is set to 0xfffd,
+   and -1 is returned for an invalid sequence of units, -2 is returned for an
+   incomplete sequence of units.
+   The number of available units, N, must be > 0.  */
+/* Similar to u*_mbtouc(), except that the return value gives more details
+   about the failure, similar to mbrtowc().  */
+
+#ifdef GNULIB_UNISTR_U8_MBTOUCR
+extern int
+       u8_mbtoucr (ucs4_t *puc, const uint8_t *s, size_t n);
+#endif
+
+#ifdef GNULIB_UNISTR_U16_MBTOUCR
+extern int
+       u16_mbtoucr (ucs4_t *puc, const uint16_t *s, size_t n);
+#endif
+
+#ifdef GNULIB_UNISTR_U32_MBTOUCR
+extern int
+       u32_mbtoucr (ucs4_t *puc, const uint32_t *s, size_t n);
+#endif
+
+/* Put the multibyte character represented by UC in S, returning its
+   length.  Return -1 upon failure, -2 if the number of available units, N,
+   is too small.  The latter case cannot occur if N >= 6/2/1, respectively.  */
+/* Similar to wctomb(), except that s must not be NULL, and the argument n
+   must be specified.  */
+
+#ifdef GNULIB_UNISTR_U8_UCTOMB
+/* Auxiliary function, also used by u8_chr, u8_strchr, u8_strrchr.  */
+extern int
+       u8_uctomb_aux (uint8_t *s, ucs4_t uc, int n);
+# if !HAVE_INLINE
+extern int
+       u8_uctomb (uint8_t *s, ucs4_t uc, int n);
+# else
+static inline int
+u8_uctomb (uint8_t *s, ucs4_t uc, int n)
+{
+  if (uc < 0x80 && n > 0)
+    {
+      s[0] = uc;
+      return 1;
+    }
+  else
+    return u8_uctomb_aux (s, uc, n);
+}
+# endif
+#endif
+
+#ifdef GNULIB_UNISTR_U16_UCTOMB
+/* Auxiliary function, also used by u16_chr, u16_strchr, u16_strrchr.  */
+extern int
+       u16_uctomb_aux (uint16_t *s, ucs4_t uc, int n);
+# if !HAVE_INLINE
+extern int
+       u16_uctomb (uint16_t *s, ucs4_t uc, int n);
+# else
+static inline int
+u16_uctomb (uint16_t *s, ucs4_t uc, int n)
+{
+  if (uc < 0xd800 && n > 0)
+    {
+      s[0] = uc;
+      return 1;
+    }
+  else
+    return u16_uctomb_aux (s, uc, n);
+}
+# endif
+#endif
+
+#ifdef GNULIB_UNISTR_U32_UCTOMB
+# if !HAVE_INLINE
+extern int
+       u32_uctomb (uint32_t *s, ucs4_t uc, int n);
+# else
+static inline int
+u32_uctomb (uint32_t *s, ucs4_t uc, int n)
+{
+  if (uc < 0xd800 || (uc >= 0xe000 && uc < 0x110000))
+    {
+      if (n > 0)
+	{
+	  *s = uc;
+	  return 1;
+	}
+      else
+	return -2;
+    }
+  else
+    return -1;
+}
+# endif
+#endif
+
+/* Copy N units from SRC to DEST.  */
+/* Similar to memcpy().  */
+extern uint8_t *
+       u8_cpy (uint8_t *dest, const uint8_t *src, size_t n);
+extern uint16_t *
+       u16_cpy (uint16_t *dest, const uint16_t *src, size_t n);
+extern uint32_t *
+       u32_cpy (uint32_t *dest, const uint32_t *src, size_t n);
+
+/* Copy N units from SRC to DEST, guaranteeing correct behavior for
+   overlapping memory areas.  */
+/* Similar to memmove().  */
+extern uint8_t *
+       u8_move (uint8_t *dest, const uint8_t *src, size_t n);
+extern uint16_t *
+       u16_move (uint16_t *dest, const uint16_t *src, size_t n);
+extern uint32_t *
+       u32_move (uint32_t *dest, const uint32_t *src, size_t n);
+
+/* Set the first N characters of S to UC.  UC should be a character that
+   occupies only 1 unit.  */
+/* Similar to memset().  */
+extern uint8_t *
+       u8_set (uint8_t *s, ucs4_t uc, size_t n);
+extern uint16_t *
+       u16_set (uint16_t *s, ucs4_t uc, size_t n);
+extern uint32_t *
+       u32_set (uint32_t *s, ucs4_t uc, size_t n);
+
+/* Compare S1 and S2, each of length N.  */
+/* Similar to memcmp().  */
+extern int
+       u8_cmp (const uint8_t *s1, const uint8_t *s2, size_t n);
+extern int
+       u16_cmp (const uint16_t *s1, const uint16_t *s2, size_t n);
+extern int
+       u32_cmp (const uint32_t *s1, const uint32_t *s2, size_t n);
+
+/* Compare S1 and S2.  */
+/* Similar to the gnulib function memcmp2().  */
+extern int
+       u8_cmp2 (const uint8_t *s1, size_t n1, const uint8_t *s2, size_t n2);
+extern int
+       u16_cmp2 (const uint16_t *s1, size_t n1, const uint16_t *s2, size_t n2);
+extern int
+       u32_cmp2 (const uint32_t *s1, size_t n1, const uint32_t *s2, size_t n2);
+
+/* Search the string at S for UC.  */
+/* Similar to memchr().  */
+extern uint8_t *
+       u8_chr (const uint8_t *s, size_t n, ucs4_t uc);
+extern uint16_t *
+       u16_chr (const uint16_t *s, size_t n, ucs4_t uc);
+extern uint32_t *
+       u32_chr (const uint32_t *s, size_t n, ucs4_t uc);
+
+/* Count the number of Unicode characters in the N units from S.  */
+/* Similar to mbsnlen().  */
+extern size_t
+       u8_mbsnlen (const uint8_t *s, size_t n);
+extern size_t
+       u16_mbsnlen (const uint16_t *s, size_t n);
+extern size_t
+       u32_mbsnlen (const uint32_t *s, size_t n);
+
+/* Elementary string functions with memory allocation.  */
+
+/* Make a freshly allocated copy of S, of length N.  */
+extern uint8_t *
+       u8_cpy_alloc (const uint8_t *s, size_t n);
+extern uint16_t *
+       u16_cpy_alloc (const uint16_t *s, size_t n);
+extern uint32_t *
+       u32_cpy_alloc (const uint32_t *s, size_t n);
+
+/* Elementary string functions on NUL terminated strings.  */
+
+/* Return the length (number of units) of the first character in S.
+   Return 0 if it is the NUL character.  Return -1 upon failure.  */
+extern int
+       u8_strmblen (const uint8_t *s);
+extern int
+       u16_strmblen (const uint16_t *s);
+extern int
+       u32_strmblen (const uint32_t *s);
+
+/* Return the length (number of units) of the first character in S, putting
+   its 'ucs4_t' representation in *PUC.  Return 0 if it is the NUL
+   character.  Return -1 upon failure.  */
+extern int
+       u8_strmbtouc (ucs4_t *puc, const uint8_t *s);
+extern int
+       u16_strmbtouc (ucs4_t *puc, const uint16_t *s);
+extern int
+       u32_strmbtouc (ucs4_t *puc, const uint32_t *s);
+
+/* Forward iteration step.  Advances the pointer past the next character,
+   or returns NULL if the end of the string has been reached.  Puts the
+   character's 'ucs4_t' representation in *PUC.  */
+extern const uint8_t *
+       u8_next (ucs4_t *puc, const uint8_t *s);
+extern const uint16_t *
+       u16_next (ucs4_t *puc, const uint16_t *s);
+extern const uint32_t *
+       u32_next (ucs4_t *puc, const uint32_t *s);
+
+/* Backward iteration step.  Advances the pointer to point to the previous
+   character, or returns NULL if the beginning of the string had been reached.
+   Puts the character's 'ucs4_t' representation in *PUC.  */
+extern const uint8_t *
+       u8_prev (ucs4_t *puc, const uint8_t *s, const uint8_t *start);
+extern const uint16_t *
+       u16_prev (ucs4_t *puc, const uint16_t *s, const uint16_t *start);
+extern const uint32_t *
+       u32_prev (ucs4_t *puc, const uint32_t *s, const uint32_t *start);
+
+/* Return the number of units in S.  */
+/* Similar to strlen(), wcslen().  */
+extern size_t
+       u8_strlen (const uint8_t *s);
+extern size_t
+       u16_strlen (const uint16_t *s);
+extern size_t
+       u32_strlen (const uint32_t *s);
+
+/* Return the number of units in S, but at most MAXLEN.  */
+/* Similar to strnlen(), wcsnlen().  */
+extern size_t
+       u8_strnlen (const uint8_t *s, size_t maxlen);
+extern size_t
+       u16_strnlen (const uint16_t *s, size_t maxlen);
+extern size_t
+       u32_strnlen (const uint32_t *s, size_t maxlen);
+
+/* Copy SRC to DEST.  */
+/* Similar to strcpy(), wcscpy().  */
+extern uint8_t *
+       u8_strcpy (uint8_t *dest, const uint8_t *src);
+extern uint16_t *
+       u16_strcpy (uint16_t *dest, const uint16_t *src);
+extern uint32_t *
+       u32_strcpy (uint32_t *dest, const uint32_t *src);
+
+/* Copy SRC to DEST, returning the address of the terminating NUL in DEST.  */
+/* Similar to stpcpy().  */
+extern uint8_t *
+       u8_stpcpy (uint8_t *dest, const uint8_t *src);
+extern uint16_t *
+       u16_stpcpy (uint16_t *dest, const uint16_t *src);
+extern uint32_t *
+       u32_stpcpy (uint32_t *dest, const uint32_t *src);
+
+/* Copy no more than N units of SRC to DEST.  */
+/* Similar to strncpy(), wcsncpy().  */
+extern uint8_t *
+       u8_strncpy (uint8_t *dest, const uint8_t *src, size_t n);
+extern uint16_t *
+       u16_strncpy (uint16_t *dest, const uint16_t *src, size_t n);
+extern uint32_t *
+       u32_strncpy (uint32_t *dest, const uint32_t *src, size_t n);
+
+/* Copy no more than N units of SRC to DEST, returning the address of
+   the last unit written into DEST.  */
+/* Similar to stpncpy().  */
+extern uint8_t *
+       u8_stpncpy (uint8_t *dest, const uint8_t *src, size_t n);
+extern uint16_t *
+       u16_stpncpy (uint16_t *dest, const uint16_t *src, size_t n);
+extern uint32_t *
+       u32_stpncpy (uint32_t *dest, const uint32_t *src, size_t n);
+
+/* Append SRC onto DEST.  */
+/* Similar to strcat(), wcscat().  */
+extern uint8_t *
+       u8_strcat (uint8_t *dest, const uint8_t *src);
+extern uint16_t *
+       u16_strcat (uint16_t *dest, const uint16_t *src);
+extern uint32_t *
+       u32_strcat (uint32_t *dest, const uint32_t *src);
+
+/* Append no more than N units of SRC onto DEST.  */
+/* Similar to strncat(), wcsncat().  */
+extern uint8_t *
+       u8_strncat (uint8_t *dest, const uint8_t *src, size_t n);
+extern uint16_t *
+       u16_strncat (uint16_t *dest, const uint16_t *src, size_t n);
+extern uint32_t *
+       u32_strncat (uint32_t *dest, const uint32_t *src, size_t n);
+
+/* Compare S1 and S2.  */
+/* Similar to strcmp(), wcscmp().  */
+extern int
+       u8_strcmp (const uint8_t *s1, const uint8_t *s2);
+extern int
+       u16_strcmp (const uint16_t *s1, const uint16_t *s2);
+extern int
+       u32_strcmp (const uint32_t *s1, const uint32_t *s2);
+
+/* Compare S1 and S2 using the collation rules of the current locale.
+   Return -1 if S1 < S2, 0 if S1 = S2, 1 if S1 > S2.
+   Upon failure, set errno and return any value.  */
+/* Similar to strcoll(), wcscoll().  */
+extern int
+       u8_strcoll (const uint8_t *s1, const uint8_t *s2);
+extern int
+       u16_strcoll (const uint16_t *s1, const uint16_t *s2);
+extern int
+       u32_strcoll (const uint32_t *s1, const uint32_t *s2);
+
+/* Compare no more than N units of S1 and S2.  */
+/* Similar to strncmp(), wcsncmp().  */
+extern int
+       u8_strncmp (const uint8_t *s1, const uint8_t *s2, size_t n);
+extern int
+       u16_strncmp (const uint16_t *s1, const uint16_t *s2, size_t n);
+extern int
+       u32_strncmp (const uint32_t *s1, const uint32_t *s2, size_t n);
+
+/* Duplicate S, returning an identical malloc'd string.  */
+/* Similar to strdup(), wcsdup().  */
+extern uint8_t *
+       u8_strdup (const uint8_t *s);
+extern uint16_t *
+       u16_strdup (const uint16_t *s);
+extern uint32_t *
+       u32_strdup (const uint32_t *s);
+
+/* Find the first occurrence of UC in STR.  */
+/* Similar to strchr(), wcschr().  */
+extern uint8_t *
+       u8_strchr (const uint8_t *str, ucs4_t uc);
+extern uint16_t *
+       u16_strchr (const uint16_t *str, ucs4_t uc);
+extern uint32_t *
+       u32_strchr (const uint32_t *str, ucs4_t uc);
+
+/* Find the last occurrence of UC in STR.  */
+/* Similar to strrchr(), wcsrchr().  */
+extern uint8_t *
+       u8_strrchr (const uint8_t *str, ucs4_t uc);
+extern uint16_t *
+       u16_strrchr (const uint16_t *str, ucs4_t uc);
+extern uint32_t *
+       u32_strrchr (const uint32_t *str, ucs4_t uc);
+
+/* Return the length of the initial segment of STR which consists entirely
+   of Unicode characters not in REJECT.  */
+/* Similar to strcspn(), wcscspn().  */
+extern size_t
+       u8_strcspn (const uint8_t *str, const uint8_t *reject);
+extern size_t
+       u16_strcspn (const uint16_t *str, const uint16_t *reject);
+extern size_t
+       u32_strcspn (const uint32_t *str, const uint32_t *reject);
+
+/* Return the length of the initial segment of STR which consists entirely
+   of Unicode characters in ACCEPT.  */
+/* Similar to strspn(), wcsspn().  */
+extern size_t
+       u8_strspn (const uint8_t *str, const uint8_t *accept);
+extern size_t
+       u16_strspn (const uint16_t *str, const uint16_t *accept);
+extern size_t
+       u32_strspn (const uint32_t *str, const uint32_t *accept);
+
+/* Find the first occurrence in STR of any character in ACCEPT.  */
+/* Similar to strpbrk(), wcspbrk().  */
+extern uint8_t *
+       u8_strpbrk (const uint8_t *str, const uint8_t *accept);
+extern uint16_t *
+       u16_strpbrk (const uint16_t *str, const uint16_t *accept);
+extern uint32_t *
+       u32_strpbrk (const uint32_t *str, const uint32_t *accept);
+
+/* Find the first occurrence of NEEDLE in HAYSTACK.  */
+/* Similar to strstr(), wcsstr().  */
+extern uint8_t *
+       u8_strstr (const uint8_t *haystack, const uint8_t *needle);
+extern uint16_t *
+       u16_strstr (const uint16_t *haystack, const uint16_t *needle);
+extern uint32_t *
+       u32_strstr (const uint32_t *haystack, const uint32_t *needle);
+
+/* Test whether STR starts with PREFIX.  */
+extern bool
+       u8_startswith (const uint8_t *str, const uint8_t *prefix);
+extern bool
+       u16_startswith (const uint16_t *str, const uint16_t *prefix);
+extern bool
+       u32_startswith (const uint32_t *str, const uint32_t *prefix);
+
+/* Test whether STR ends with SUFFIX.  */
+extern bool
+       u8_endswith (const uint8_t *str, const uint8_t *suffix);
+extern bool
+       u16_endswith (const uint16_t *str, const uint16_t *suffix);
+extern bool
+       u32_endswith (const uint32_t *str, const uint32_t *suffix);
+
+/* Divide STR into tokens separated by characters in DELIM.
+   This interface is actually more similar to wcstok than to strtok.  */
+/* Similar to strtok_r(), wcstok().  */
+extern uint8_t *
+       u8_strtok (uint8_t *str, const uint8_t *delim, uint8_t **ptr);
+extern uint16_t *
+       u16_strtok (uint16_t *str, const uint16_t *delim, uint16_t **ptr);
+extern uint32_t *
+       u32_strtok (uint32_t *str, const uint32_t *delim, uint32_t **ptr);
+
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* _UNISTR_H */
diff --git a/lib/unistr/u8-mbtouc-aux.c b/lib/unistr/u8-mbtouc-aux.c
new file mode 100644
index 000000000..53d02bf0d
--- /dev/null
+++ b/lib/unistr/u8-mbtouc-aux.c
@@ -0,0 +1,158 @@
+/* Conversion UTF-8 to UCS-4.
+   Copyright (C) 2001-2002, 2006-2007, 2009 Free Software Foundation, Inc.
+   Written by Bruno Haible <bruno@clisp.org>, 2001.
+
+   This program is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#include <config.h>
+
+/* Specification.  */
+#include "unistr.h"
+
+#if defined IN_LIBUNISTRING || HAVE_INLINE
+
+int
+u8_mbtouc_aux (ucs4_t *puc, const uint8_t *s, size_t n)
+{
+  uint8_t c = *s;
+
+  if (c >= 0xc2)
+    {
+      if (c < 0xe0)
+	{
+	  if (n >= 2)
+	    {
+	      if ((s[1] ^ 0x80) < 0x40)
+		{
+		  *puc = ((unsigned int) (c & 0x1f) << 6)
+		         | (unsigned int) (s[1] ^ 0x80);
+		  return 2;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+      else if (c < 0xf0)
+	{
+	  if (n >= 3)
+	    {
+	      if ((s[1] ^ 0x80) < 0x40 && (s[2] ^ 0x80) < 0x40
+		  && (c >= 0xe1 || s[1] >= 0xa0)
+		  && (c != 0xed || s[1] < 0xa0))
+		{
+		  *puc = ((unsigned int) (c & 0x0f) << 12)
+		         | ((unsigned int) (s[1] ^ 0x80) << 6)
+		         | (unsigned int) (s[2] ^ 0x80);
+		  return 3;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+      else if (c < 0xf8)
+	{
+	  if (n >= 4)
+	    {
+	      if ((s[1] ^ 0x80) < 0x40 && (s[2] ^ 0x80) < 0x40
+		  && (s[3] ^ 0x80) < 0x40
+		  && (c >= 0xf1 || s[1] >= 0x90)
+#if 1
+		  && (c < 0xf4 || (c == 0xf4 && s[1] < 0x90))
+#endif
+		 )
+		{
+		  *puc = ((unsigned int) (c & 0x07) << 18)
+		         | ((unsigned int) (s[1] ^ 0x80) << 12)
+		         | ((unsigned int) (s[2] ^ 0x80) << 6)
+		         | (unsigned int) (s[3] ^ 0x80);
+		  return 4;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+#if 0
+      else if (c < 0xfc)
+	{
+	  if (n >= 5)
+	    {
+	      if ((s[1] ^ 0x80) < 0x40 && (s[2] ^ 0x80) < 0x40
+		  && (s[3] ^ 0x80) < 0x40 && (s[4] ^ 0x80) < 0x40
+		  && (c >= 0xf9 || s[1] >= 0x88))
+		{
+		  *puc = ((unsigned int) (c & 0x03) << 24)
+		         | ((unsigned int) (s[1] ^ 0x80) << 18)
+		         | ((unsigned int) (s[2] ^ 0x80) << 12)
+		         | ((unsigned int) (s[3] ^ 0x80) << 6)
+		         | (unsigned int) (s[4] ^ 0x80);
+		  return 5;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+      else if (c < 0xfe)
+	{
+	  if (n >= 6)
+	    {
+	      if ((s[1] ^ 0x80) < 0x40 && (s[2] ^ 0x80) < 0x40
+		  && (s[3] ^ 0x80) < 0x40 && (s[4] ^ 0x80) < 0x40
+		  && (s[5] ^ 0x80) < 0x40
+		  && (c >= 0xfd || s[1] >= 0x84))
+		{
+		  *puc = ((unsigned int) (c & 0x01) << 30)
+		         | ((unsigned int) (s[1] ^ 0x80) << 24)
+		         | ((unsigned int) (s[2] ^ 0x80) << 18)
+		         | ((unsigned int) (s[3] ^ 0x80) << 12)
+		         | ((unsigned int) (s[4] ^ 0x80) << 6)
+		         | (unsigned int) (s[5] ^ 0x80);
+		  return 6;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+#endif
+    }
+  /* invalid multibyte character */
+  *puc = 0xfffd;
+  return 1;
+}
+
+#endif
diff --git a/lib/unistr/u8-mbtouc-unsafe-aux.c b/lib/unistr/u8-mbtouc-unsafe-aux.c
new file mode 100644
index 000000000..43e4a360f
--- /dev/null
+++ b/lib/unistr/u8-mbtouc-unsafe-aux.c
@@ -0,0 +1,168 @@
+/* Conversion UTF-8 to UCS-4.
+   Copyright (C) 2001-2002, 2006-2007, 2009 Free Software Foundation, Inc.
+   Written by Bruno Haible <bruno@clisp.org>, 2001.
+
+   This program is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#include <config.h>
+
+/* Specification.  */
+#include "unistr.h"
+
+#if defined IN_LIBUNISTRING || HAVE_INLINE
+
+int
+u8_mbtouc_unsafe_aux (ucs4_t *puc, const uint8_t *s, size_t n)
+{
+  uint8_t c = *s;
+
+  if (c >= 0xc2)
+    {
+      if (c < 0xe0)
+	{
+	  if (n >= 2)
+	    {
+#if CONFIG_UNICODE_SAFETY
+	      if ((s[1] ^ 0x80) < 0x40)
+#endif
+		{
+		  *puc = ((unsigned int) (c & 0x1f) << 6)
+		         | (unsigned int) (s[1] ^ 0x80);
+		  return 2;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+      else if (c < 0xf0)
+	{
+	  if (n >= 3)
+	    {
+#if CONFIG_UNICODE_SAFETY
+	      if ((s[1] ^ 0x80) < 0x40 && (s[2] ^ 0x80) < 0x40
+		  && (c >= 0xe1 || s[1] >= 0xa0)
+		  && (c != 0xed || s[1] < 0xa0))
+#endif
+		{
+		  *puc = ((unsigned int) (c & 0x0f) << 12)
+		         | ((unsigned int) (s[1] ^ 0x80) << 6)
+		         | (unsigned int) (s[2] ^ 0x80);
+		  return 3;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+      else if (c < 0xf8)
+	{
+	  if (n >= 4)
+	    {
+#if CONFIG_UNICODE_SAFETY
+	      if ((s[1] ^ 0x80) < 0x40 && (s[2] ^ 0x80) < 0x40
+		  && (s[3] ^ 0x80) < 0x40
+		  && (c >= 0xf1 || s[1] >= 0x90)
+#if 1
+		  && (c < 0xf4 || (c == 0xf4 && s[1] < 0x90))
+#endif
+		 )
+#endif
+		{
+		  *puc = ((unsigned int) (c & 0x07) << 18)
+		         | ((unsigned int) (s[1] ^ 0x80) << 12)
+		         | ((unsigned int) (s[2] ^ 0x80) << 6)
+		         | (unsigned int) (s[3] ^ 0x80);
+		  return 4;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+#if 0
+      else if (c < 0xfc)
+	{
+	  if (n >= 5)
+	    {
+#if CONFIG_UNICODE_SAFETY
+	      if ((s[1] ^ 0x80) < 0x40 && (s[2] ^ 0x80) < 0x40
+		  && (s[3] ^ 0x80) < 0x40 && (s[4] ^ 0x80) < 0x40
+		  && (c >= 0xf9 || s[1] >= 0x88))
+#endif
+		{
+		  *puc = ((unsigned int) (c & 0x03) << 24)
+		         | ((unsigned int) (s[1] ^ 0x80) << 18)
+		         | ((unsigned int) (s[2] ^ 0x80) << 12)
+		         | ((unsigned int) (s[3] ^ 0x80) << 6)
+		         | (unsigned int) (s[4] ^ 0x80);
+		  return 5;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+      else if (c < 0xfe)
+	{
+	  if (n >= 6)
+	    {
+#if CONFIG_UNICODE_SAFETY
+	      if ((s[1] ^ 0x80) < 0x40 && (s[2] ^ 0x80) < 0x40
+		  && (s[3] ^ 0x80) < 0x40 && (s[4] ^ 0x80) < 0x40
+		  && (s[5] ^ 0x80) < 0x40
+		  && (c >= 0xfd || s[1] >= 0x84))
+#endif
+		{
+		  *puc = ((unsigned int) (c & 0x01) << 30)
+		         | ((unsigned int) (s[1] ^ 0x80) << 24)
+		         | ((unsigned int) (s[2] ^ 0x80) << 18)
+		         | ((unsigned int) (s[3] ^ 0x80) << 12)
+		         | ((unsigned int) (s[4] ^ 0x80) << 6)
+		         | (unsigned int) (s[5] ^ 0x80);
+		  return 6;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+#endif
+    }
+  /* invalid multibyte character */
+  *puc = 0xfffd;
+  return 1;
+}
+
+#endif
diff --git a/lib/unistr/u8-mbtouc-unsafe.c b/lib/unistr/u8-mbtouc-unsafe.c
new file mode 100644
index 000000000..466156967
--- /dev/null
+++ b/lib/unistr/u8-mbtouc-unsafe.c
@@ -0,0 +1,179 @@
+/* Look at first character in UTF-8 string.
+   Copyright (C) 1999-2002, 2006-2007, 2009 Free Software Foundation, Inc.
+   Written by Bruno Haible <bruno@clisp.org>, 2001.
+
+   This program is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#include <config.h>
+
+#if defined IN_LIBUNISTRING
+/* Tell unistr.h to declare u8_mbtouc_unsafe as 'extern', not
+   'static inline'.  */
+# include "unistring-notinline.h"
+#endif
+
+/* Specification.  */
+#include "unistr.h"
+
+#if !HAVE_INLINE
+
+int
+u8_mbtouc_unsafe (ucs4_t *puc, const uint8_t *s, size_t n)
+{
+  uint8_t c = *s;
+
+  if (c < 0x80)
+    {
+      *puc = c;
+      return 1;
+    }
+  else if (c >= 0xc2)
+    {
+      if (c < 0xe0)
+	{
+	  if (n >= 2)
+	    {
+#if CONFIG_UNICODE_SAFETY
+	      if ((s[1] ^ 0x80) < 0x40)
+#endif
+		{
+		  *puc = ((unsigned int) (c & 0x1f) << 6)
+		         | (unsigned int) (s[1] ^ 0x80);
+		  return 2;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+      else if (c < 0xf0)
+	{
+	  if (n >= 3)
+	    {
+#if CONFIG_UNICODE_SAFETY
+	      if ((s[1] ^ 0x80) < 0x40 && (s[2] ^ 0x80) < 0x40
+		  && (c >= 0xe1 || s[1] >= 0xa0)
+		  && (c != 0xed || s[1] < 0xa0))
+#endif
+		{
+		  *puc = ((unsigned int) (c & 0x0f) << 12)
+		         | ((unsigned int) (s[1] ^ 0x80) << 6)
+		         | (unsigned int) (s[2] ^ 0x80);
+		  return 3;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+      else if (c < 0xf8)
+	{
+	  if (n >= 4)
+	    {
+#if CONFIG_UNICODE_SAFETY
+	      if ((s[1] ^ 0x80) < 0x40 && (s[2] ^ 0x80) < 0x40
+		  && (s[3] ^ 0x80) < 0x40
+		  && (c >= 0xf1 || s[1] >= 0x90)
+#if 1
+		  && (c < 0xf4 || (c == 0xf4 && s[1] < 0x90))
+#endif
+		 )
+#endif
+		{
+		  *puc = ((unsigned int) (c & 0x07) << 18)
+		         | ((unsigned int) (s[1] ^ 0x80) << 12)
+		         | ((unsigned int) (s[2] ^ 0x80) << 6)
+		         | (unsigned int) (s[3] ^ 0x80);
+		  return 4;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+#if 0
+      else if (c < 0xfc)
+	{
+	  if (n >= 5)
+	    {
+#if CONFIG_UNICODE_SAFETY
+	      if ((s[1] ^ 0x80) < 0x40 && (s[2] ^ 0x80) < 0x40
+		  && (s[3] ^ 0x80) < 0x40 && (s[4] ^ 0x80) < 0x40
+		  && (c >= 0xf9 || s[1] >= 0x88))
+#endif
+		{
+		  *puc = ((unsigned int) (c & 0x03) << 24)
+		         | ((unsigned int) (s[1] ^ 0x80) << 18)
+		         | ((unsigned int) (s[2] ^ 0x80) << 12)
+		         | ((unsigned int) (s[3] ^ 0x80) << 6)
+		         | (unsigned int) (s[4] ^ 0x80);
+		  return 5;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+      else if (c < 0xfe)
+	{
+	  if (n >= 6)
+	    {
+#if CONFIG_UNICODE_SAFETY
+	      if ((s[1] ^ 0x80) < 0x40 && (s[2] ^ 0x80) < 0x40
+		  && (s[3] ^ 0x80) < 0x40 && (s[4] ^ 0x80) < 0x40
+		  && (s[5] ^ 0x80) < 0x40
+		  && (c >= 0xfd || s[1] >= 0x84))
+#endif
+		{
+		  *puc = ((unsigned int) (c & 0x01) << 30)
+		         | ((unsigned int) (s[1] ^ 0x80) << 24)
+		         | ((unsigned int) (s[2] ^ 0x80) << 18)
+		         | ((unsigned int) (s[3] ^ 0x80) << 12)
+		         | ((unsigned int) (s[4] ^ 0x80) << 6)
+		         | (unsigned int) (s[5] ^ 0x80);
+		  return 6;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+#endif
+    }
+  /* invalid multibyte character */
+  *puc = 0xfffd;
+  return 1;
+}
+
+#endif
diff --git a/lib/unistr/u8-mbtouc.c b/lib/unistr/u8-mbtouc.c
new file mode 100644
index 000000000..ff624f17d
--- /dev/null
+++ b/lib/unistr/u8-mbtouc.c
@@ -0,0 +1,168 @@
+/* Look at first character in UTF-8 string.
+   Copyright (C) 1999-2002, 2006-2007, 2009 Free Software Foundation, Inc.
+   Written by Bruno Haible <bruno@clisp.org>, 2001.
+
+   This program is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#include <config.h>
+
+#if defined IN_LIBUNISTRING
+/* Tell unistr.h to declare u8_mbtouc as 'extern', not 'static inline'.  */
+# include "unistring-notinline.h"
+#endif
+
+/* Specification.  */
+#include "unistr.h"
+
+#if !HAVE_INLINE
+
+int
+u8_mbtouc (ucs4_t *puc, const uint8_t *s, size_t n)
+{
+  uint8_t c = *s;
+
+  if (c < 0x80)
+    {
+      *puc = c;
+      return 1;
+    }
+  else if (c >= 0xc2)
+    {
+      if (c < 0xe0)
+	{
+	  if (n >= 2)
+	    {
+	      if ((s[1] ^ 0x80) < 0x40)
+		{
+		  *puc = ((unsigned int) (c & 0x1f) << 6)
+		         | (unsigned int) (s[1] ^ 0x80);
+		  return 2;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+      else if (c < 0xf0)
+	{
+	  if (n >= 3)
+	    {
+	      if ((s[1] ^ 0x80) < 0x40 && (s[2] ^ 0x80) < 0x40
+		  && (c >= 0xe1 || s[1] >= 0xa0)
+		  && (c != 0xed || s[1] < 0xa0))
+		{
+		  *puc = ((unsigned int) (c & 0x0f) << 12)
+		         | ((unsigned int) (s[1] ^ 0x80) << 6)
+		         | (unsigned int) (s[2] ^ 0x80);
+		  return 3;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+      else if (c < 0xf8)
+	{
+	  if (n >= 4)
+	    {
+	      if ((s[1] ^ 0x80) < 0x40 && (s[2] ^ 0x80) < 0x40
+		  && (s[3] ^ 0x80) < 0x40
+		  && (c >= 0xf1 || s[1] >= 0x90)
+#if 1
+		  && (c < 0xf4 || (c == 0xf4 && s[1] < 0x90))
+#endif
+		 )
+		{
+		  *puc = ((unsigned int) (c & 0x07) << 18)
+		         | ((unsigned int) (s[1] ^ 0x80) << 12)
+		         | ((unsigned int) (s[2] ^ 0x80) << 6)
+		         | (unsigned int) (s[3] ^ 0x80);
+		  return 4;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+#if 0
+      else if (c < 0xfc)
+	{
+	  if (n >= 5)
+	    {
+	      if ((s[1] ^ 0x80) < 0x40 && (s[2] ^ 0x80) < 0x40
+		  && (s[3] ^ 0x80) < 0x40 && (s[4] ^ 0x80) < 0x40
+		  && (c >= 0xf9 || s[1] >= 0x88))
+		{
+		  *puc = ((unsigned int) (c & 0x03) << 24)
+		         | ((unsigned int) (s[1] ^ 0x80) << 18)
+		         | ((unsigned int) (s[2] ^ 0x80) << 12)
+		         | ((unsigned int) (s[3] ^ 0x80) << 6)
+		         | (unsigned int) (s[4] ^ 0x80);
+		  return 5;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+      else if (c < 0xfe)
+	{
+	  if (n >= 6)
+	    {
+	      if ((s[1] ^ 0x80) < 0x40 && (s[2] ^ 0x80) < 0x40
+		  && (s[3] ^ 0x80) < 0x40 && (s[4] ^ 0x80) < 0x40
+		  && (s[5] ^ 0x80) < 0x40
+		  && (c >= 0xfd || s[1] >= 0x84))
+		{
+		  *puc = ((unsigned int) (c & 0x01) << 30)
+		         | ((unsigned int) (s[1] ^ 0x80) << 24)
+		         | ((unsigned int) (s[2] ^ 0x80) << 18)
+		         | ((unsigned int) (s[3] ^ 0x80) << 12)
+		         | ((unsigned int) (s[4] ^ 0x80) << 6)
+		         | (unsigned int) (s[5] ^ 0x80);
+		  return 6;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return n;
+	    }
+	}
+#endif
+    }
+  /* invalid multibyte character */
+  *puc = 0xfffd;
+  return 1;
+}
+
+#endif
diff --git a/lib/unistr/u8-mbtoucr.c b/lib/unistr/u8-mbtoucr.c
new file mode 100644
index 000000000..dd8335247
--- /dev/null
+++ b/lib/unistr/u8-mbtoucr.c
@@ -0,0 +1,285 @@
+/* Look at first character in UTF-8 string, returning an error code.
+   Copyright (C) 1999-2002, 2006-2007 Free Software Foundation, Inc.
+   Written by Bruno Haible <bruno@clisp.org>, 2001.
+
+   This program is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#include <config.h>
+
+/* Specification.  */
+#include "unistr.h"
+
+int
+u8_mbtoucr (ucs4_t *puc, const uint8_t *s, size_t n)
+{
+  uint8_t c = *s;
+
+  if (c < 0x80)
+    {
+      *puc = c;
+      return 1;
+    }
+  else if (c >= 0xc2)
+    {
+      if (c < 0xe0)
+	{
+	  if (n >= 2)
+	    {
+	      if ((s[1] ^ 0x80) < 0x40)
+		{
+		  *puc = ((unsigned int) (c & 0x1f) << 6)
+		         | (unsigned int) (s[1] ^ 0x80);
+		  return 2;
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return -2;
+	    }
+	}
+      else if (c < 0xf0)
+	{
+	  if (n >= 2)
+	    {
+	      if ((s[1] ^ 0x80) < 0x40
+		  && (c >= 0xe1 || s[1] >= 0xa0)
+		  && (c != 0xed || s[1] < 0xa0))
+		{
+		  if (n >= 3)
+		    {
+		      if ((s[2] ^ 0x80) < 0x40)
+			{
+			  *puc = ((unsigned int) (c & 0x0f) << 12)
+			         | ((unsigned int) (s[1] ^ 0x80) << 6)
+			         | (unsigned int) (s[2] ^ 0x80);
+			  return 3;
+			}
+		      /* invalid multibyte character */
+		    }
+		  else
+		    {
+		      /* incomplete multibyte character */
+		      *puc = 0xfffd;
+		      return -2;
+		    }
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return -2;
+	    }
+	}
+      else if (c < 0xf8)
+	{
+	  if (n >= 2)
+	    {
+	      if ((s[1] ^ 0x80) < 0x40
+		  && (c >= 0xf1 || s[1] >= 0x90)
+#if 1
+		  && (c < 0xf4 || (c == 0xf4 && s[1] < 0x90))
+#endif
+		 )
+		{
+		  if (n >= 3)
+		    {
+		      if ((s[2] ^ 0x80) < 0x40)
+			{
+			  if (n >= 4)
+			    {
+			      if ((s[3] ^ 0x80) < 0x40)
+				{
+				  *puc = ((unsigned int) (c & 0x07) << 18)
+				         | ((unsigned int) (s[1] ^ 0x80) << 12)
+				         | ((unsigned int) (s[2] ^ 0x80) << 6)
+				         | (unsigned int) (s[3] ^ 0x80);
+				  return 4;
+				}
+			      /* invalid multibyte character */
+			    }
+			  else
+			    {
+			      /* incomplete multibyte character */
+			      *puc = 0xfffd;
+			      return -2;
+			    }
+			}
+		      /* invalid multibyte character */
+		    }
+		  else
+		    {
+		      /* incomplete multibyte character */
+		      *puc = 0xfffd;
+		      return -2;
+		    }
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return -2;
+	    }
+	}
+#if 0
+      else if (c < 0xfc)
+	{
+	  if (n >= 2)
+	    {
+	      if ((s[1] ^ 0x80) < 0x40
+		  && (c >= 0xf9 || s[1] >= 0x88))
+		{
+		  if (n >= 3)
+		    {
+		      if ((s[2] ^ 0x80) < 0x40)
+			{
+			  if (n >= 4)
+			    {
+			      if ((s[3] ^ 0x80) < 0x40)
+				{
+				  if (n >= 5)
+				    {
+				      if ((s[4] ^ 0x80) < 0x40)
+					{
+					  *puc = ((unsigned int) (c & 0x03) << 24)
+					         | ((unsigned int) (s[1] ^ 0x80) << 18)
+					         | ((unsigned int) (s[2] ^ 0x80) << 12)
+					         | ((unsigned int) (s[3] ^ 0x80) << 6)
+					         | (unsigned int) (s[4] ^ 0x80);
+					  return 5;
+					}
+				      /* invalid multibyte character */
+				    }
+				  else
+				    {
+				      /* incomplete multibyte character */
+				      *puc = 0xfffd;
+				      return -2;
+				    }
+				}
+			      /* invalid multibyte character */
+			    }
+			  else
+			    {
+			      /* incomplete multibyte character */
+			      *puc = 0xfffd;
+			      return -2;
+			    }
+			}
+		      /* invalid multibyte character */
+		    }
+		  else
+		    {
+		      /* incomplete multibyte character */
+		      *puc = 0xfffd;
+		      return -2;
+		    }
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return -2;
+	    }
+	}
+      else if (c < 0xfe)
+	{
+	  if (n >= 2)
+	    {
+	      if ((s[1] ^ 0x80) < 0x40
+		  && (c >= 0xfd || s[1] >= 0x84))
+		{
+		  if (n >= 3)
+		    {
+		      if ((s[2] ^ 0x80) < 0x40)
+			{
+			  if (n >= 4)
+			    {
+			      if ((s[3] ^ 0x80) < 0x40)
+				{
+				  if (n >= 5)
+				    {
+				      if ((s[4] ^ 0x80) < 0x40)
+					{
+					  if (n >= 6)
+					    {
+					      if ((s[5] ^ 0x80) < 0x40)
+						{
+						  *puc = ((unsigned int) (c & 0x01) << 30)
+						         | ((unsigned int) (s[1] ^ 0x80) << 24)
+						         | ((unsigned int) (s[2] ^ 0x80) << 18)
+						         | ((unsigned int) (s[3] ^ 0x80) << 12)
+						         | ((unsigned int) (s[4] ^ 0x80) << 6)
+						         | (unsigned int) (s[5] ^ 0x80);
+						  return 6;
+						}
+					      /* invalid multibyte character */
+					    }
+					  else
+					    {
+					      /* incomplete multibyte character */
+					      *puc = 0xfffd;
+					      return -2;
+					    }
+					}
+				      /* invalid multibyte character */
+				    }
+				  else
+				    {
+				      /* incomplete multibyte character */
+				      *puc = 0xfffd;
+				      return -2;
+				    }
+				}
+			      /* invalid multibyte character */
+			    }
+			  else
+			    {
+			      /* incomplete multibyte character */
+			      *puc = 0xfffd;
+			      return -2;
+			    }
+			}
+		      /* invalid multibyte character */
+		    }
+		  else
+		    {
+		      /* incomplete multibyte character */
+		      *puc = 0xfffd;
+		      return -2;
+		    }
+		}
+	      /* invalid multibyte character */
+	    }
+	  else
+	    {
+	      /* incomplete multibyte character */
+	      *puc = 0xfffd;
+	      return -2;
+	    }
+	}
+#endif
+    }
+  /* invalid multibyte character */
+  *puc = 0xfffd;
+  return -1;
+}
diff --git a/lib/unistr/u8-prev.c b/lib/unistr/u8-prev.c
new file mode 100644
index 000000000..245d22ff0
--- /dev/null
+++ b/lib/unistr/u8-prev.c
@@ -0,0 +1,93 @@
+/* Iterate over previous character in UTF-8 string.
+   Copyright (C) 2002, 2006-2007 Free Software Foundation, Inc.
+   Written by Bruno Haible <bruno@clisp.org>, 2002.
+
+   This program is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#include <config.h>
+
+/* Specification.  */
+#include "unistr.h"
+
+const uint8_t *
+u8_prev (ucs4_t *puc, const uint8_t *s, const uint8_t *start)
+{
+  /* Keep in sync with unistr.h and utf8-ucs4.c.  */
+  if (s != start)
+    {
+      uint8_t c_1 = s[-1];
+
+      if (c_1 < 0x80)
+	{
+	  *puc = c_1;
+	  return s - 1;
+	}
+#if CONFIG_UNICODE_SAFETY
+      if ((c_1 ^ 0x80) < 0x40)
+#endif
+	if (s - 1 != start)
+	  {
+	    uint8_t c_2 = s[-2];
+
+	    if (c_2 >= 0xc2 && c_2 < 0xe0)
+	      {
+		*puc = ((unsigned int) (c_2 & 0x1f) << 6)
+		       | (unsigned int) (c_1 ^ 0x80);
+		return s - 2;
+	      }
+#if CONFIG_UNICODE_SAFETY
+	    if ((c_2 ^ 0x80) < 0x40)
+#endif
+	      if (s - 2 != start)
+		{
+		  uint8_t c_3 = s[-3];
+
+		  if (c_3 >= 0xe0 && c_3 < 0xf0
+#if CONFIG_UNICODE_SAFETY
+		      && (c_3 >= 0xe1 || c_2 >= 0xa0)
+		      && (c_3 != 0xed || c_2 < 0xa0)
+#endif
+		     )
+		    {
+		      *puc = ((unsigned int) (c_3 & 0x0f) << 12)
+		             | ((unsigned int) (c_2 ^ 0x80) << 6)
+		             | (unsigned int) (c_1 ^ 0x80);
+		      return s - 3;
+		    }
+#if CONFIG_UNICODE_SAFETY
+		  if ((c_3 ^ 0x80) < 0x40)
+#endif
+		    if (s - 3 != start)
+		      {
+			uint8_t c_4 = s[-4];
+
+			if (c_4 >= 0xf0 && c_4 < 0xf8
+#if CONFIG_UNICODE_SAFETY
+			    && (c_4 >= 0xf1 || c_3 >= 0x90)
+			    && (c_4 < 0xf4 || (c_4 == 0xf4 && c_3 < 0x90))
+#endif
+			   )
+			  {
+			    *puc = ((unsigned int) (c_4 & 0x07) << 18)
+			           | ((unsigned int) (c_3 ^ 0x80) << 12)
+			           | ((unsigned int) (c_2 ^ 0x80) << 6)
+			           | (unsigned int) (c_1 ^ 0x80);
+			    return s - 4;
+			  }
+		      }
+		}
+	  }
+    }
+  return NULL;
+}
diff --git a/lib/unistr/u8-uctomb-aux.c b/lib/unistr/u8-uctomb-aux.c
new file mode 100644
index 000000000..c42fa5015
--- /dev/null
+++ b/lib/unistr/u8-uctomb-aux.c
@@ -0,0 +1,69 @@
+/* Conversion UCS-4 to UTF-8.
+   Copyright (C) 2002, 2006-2007 Free Software Foundation, Inc.
+   Written by Bruno Haible <bruno@clisp.org>, 2002.
+
+   This program is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#include <config.h>
+
+/* Specification.  */
+#include "unistr.h"
+
+int
+u8_uctomb_aux (uint8_t *s, ucs4_t uc, int n)
+{
+  int count;
+
+  if (uc < 0x80)
+    /* The case n >= 1 is already handled by the caller.  */
+    return -2;
+  else if (uc < 0x800)
+    count = 2;
+  else if (uc < 0x10000)
+    {
+      if (uc < 0xd800 || uc >= 0xe000)
+	count = 3;
+      else
+	return -1;
+    }
+#if 0
+  else if (uc < 0x200000)
+    count = 4;
+  else if (uc < 0x4000000)
+    count = 5;
+  else if (uc <= 0x7fffffff)
+    count = 6;
+#else
+  else if (uc < 0x110000)
+    count = 4;
+#endif
+  else
+    return -1;
+
+  if (n < count)
+    return -2;
+
+  switch (count) /* note: code falls through cases! */
+    {
+#if 0
+    case 6: s[5] = 0x80 | (uc & 0x3f); uc = uc >> 6; uc |= 0x4000000;
+    case 5: s[4] = 0x80 | (uc & 0x3f); uc = uc >> 6; uc |= 0x200000;
+#endif
+    case 4: s[3] = 0x80 | (uc & 0x3f); uc = uc >> 6; uc |= 0x10000;
+    case 3: s[2] = 0x80 | (uc & 0x3f); uc = uc >> 6; uc |= 0x800;
+    case 2: s[1] = 0x80 | (uc & 0x3f); uc = uc >> 6; uc |= 0xc0;
+  /*case 1:*/ s[0] = uc;
+    }
+  return count;
+}
diff --git a/lib/unistr/u8-uctomb.c b/lib/unistr/u8-uctomb.c
new file mode 100644
index 000000000..33921669e
--- /dev/null
+++ b/lib/unistr/u8-uctomb.c
@@ -0,0 +1,88 @@
+/* Store a character in UTF-8 string.
+   Copyright (C) 2002, 2005-2006, 2009 Free Software Foundation, Inc.
+   Written by Bruno Haible <bruno@clisp.org>, 2002.
+
+   This program is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#include <config.h>
+
+#if defined IN_LIBUNISTRING
+/* Tell unistr.h to declare u8_uctomb as 'extern', not 'static inline'.  */
+# include "unistring-notinline.h"
+#endif
+
+/* Specification.  */
+#include "unistr.h"
+
+#if !HAVE_INLINE
+
+int
+u8_uctomb (uint8_t *s, ucs4_t uc, int n)
+{
+  if (uc < 0x80)
+    {
+      if (n > 0)
+	{
+	  s[0] = uc;
+	  return 1;
+	}
+      /* else return -2, below.  */
+    }
+  else
+    {
+      int count;
+
+      if (uc < 0x800)
+	count = 2;
+      else if (uc < 0x10000)
+	{
+	  if (uc < 0xd800 || uc >= 0xe000)
+	    count = 3;
+	  else
+	    return -1;
+	}
+#if 0
+      else if (uc < 0x200000)
+	count = 4;
+      else if (uc < 0x4000000)
+	count = 5;
+      else if (uc <= 0x7fffffff)
+	count = 6;
+#else
+      else if (uc < 0x110000)
+	count = 4;
+#endif
+      else
+	return -1;
+
+      if (n >= count)
+	{
+	  switch (count) /* note: code falls through cases! */
+	    {
+#if 0
+	    case 6: s[5] = 0x80 | (uc & 0x3f); uc = uc >> 6; uc |= 0x4000000;
+	    case 5: s[4] = 0x80 | (uc & 0x3f); uc = uc >> 6; uc |= 0x200000;
+#endif
+	    case 4: s[3] = 0x80 | (uc & 0x3f); uc = uc >> 6; uc |= 0x10000;
+	    case 3: s[2] = 0x80 | (uc & 0x3f); uc = uc >> 6; uc |= 0x800;
+	    case 2: s[1] = 0x80 | (uc & 0x3f); uc = uc >> 6; uc |= 0xc0;
+	  /*case 1:*/ s[0] = uc;
+	    }
+	  return count;
+	}
+    }
+  return -2;
+}
+
+#endif
diff --git a/lib/unitypes.h b/lib/unitypes.h
new file mode 100644
index 000000000..fe8d87735
--- /dev/null
+++ b/lib/unitypes.h
@@ -0,0 +1,26 @@
+/* Elementary types for the GNU UniString library.
+   Copyright (C) 2002, 2005-2006 Free Software Foundation, Inc.
+
+   This program is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#ifndef _UNITYPES_H
+#define _UNITYPES_H
+
+/* Get uint8_t, uint16_t, uint32_t.  */
+#include <stdint.h>
+
+/* Type representing a Unicode character.  */
+typedef uint32_t ucs4_t;
+
+#endif /* _UNITYPES_H */
diff --git a/lib/vasnprintf.c b/lib/vasnprintf.c
new file mode 100644
index 000000000..c620b4c06
--- /dev/null
+++ b/lib/vasnprintf.c
@@ -0,0 +1,5487 @@
+/* vsprintf with automatic memory allocation.
+   Copyright (C) 1999, 2002-2009 Free Software Foundation, Inc.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 2, or (at your option)
+   any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License along
+   with this program; if not, write to the Free Software Foundation,
+   Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+/* This file can be parametrized with the following macros:
+     VASNPRINTF         The name of the function being defined.
+     FCHAR_T            The element type of the format string.
+     DCHAR_T            The element type of the destination (result) string.
+     FCHAR_T_ONLY_ASCII Set to 1 to enable verification that all characters
+                        in the format string are ASCII. MUST be set if
+                        FCHAR_T and DCHAR_T are not the same type.
+     DIRECTIVE          Structure denoting a format directive.
+                        Depends on FCHAR_T.
+     DIRECTIVES         Structure denoting the set of format directives of a
+                        format string.  Depends on FCHAR_T.
+     PRINTF_PARSE       Function that parses a format string.
+                        Depends on FCHAR_T.
+     DCHAR_CPY          memcpy like function for DCHAR_T[] arrays.
+     DCHAR_SET          memset like function for DCHAR_T[] arrays.
+     DCHAR_MBSNLEN      mbsnlen like function for DCHAR_T[] arrays.
+     SNPRINTF           The system's snprintf (or similar) function.
+                        This may be either snprintf or swprintf.
+     TCHAR_T            The element type of the argument and result string
+                        of the said SNPRINTF function.  This may be either
+                        char or wchar_t.  The code exploits that
+                        sizeof (TCHAR_T) | sizeof (DCHAR_T) and
+                        alignof (TCHAR_T) <= alignof (DCHAR_T).
+     DCHAR_IS_TCHAR     Set to 1 if DCHAR_T and TCHAR_T are the same type.
+     DCHAR_CONV_FROM_ENCODING A function to convert from char[] to DCHAR[].
+     DCHAR_IS_UINT8_T   Set to 1 if DCHAR_T is uint8_t.
+     DCHAR_IS_UINT16_T  Set to 1 if DCHAR_T is uint16_t.
+     DCHAR_IS_UINT32_T  Set to 1 if DCHAR_T is uint32_t.  */
+
+/* Tell glibc's <stdio.h> to provide a prototype for snprintf().
+   This must come before <config.h> because <config.h> may include
+   <features.h>, and once <features.h> has been included, it's too late.  */
+#ifndef _GNU_SOURCE
+# define _GNU_SOURCE    1
+#endif
+
+#ifndef VASNPRINTF
+# include <config.h>
+#endif
+#ifndef IN_LIBINTL
+# include <alloca.h>
+#endif
+
+/* Specification.  */
+#ifndef VASNPRINTF
+# if WIDE_CHAR_VERSION
+#  include "vasnwprintf.h"
+# else
+#  include "vasnprintf.h"
+# endif
+#endif
+
+#include <locale.h>	/* localeconv() */
+#include <stdio.h>	/* snprintf(), sprintf() */
+#include <stdlib.h>	/* abort(), malloc(), realloc(), free() */
+#include <string.h>	/* memcpy(), strlen() */
+#include <errno.h>	/* errno */
+#include <limits.h>	/* CHAR_BIT */
+#include <float.h>	/* DBL_MAX_EXP, LDBL_MAX_EXP */
+#if HAVE_NL_LANGINFO
+# include <langinfo.h>
+#endif
+#ifndef VASNPRINTF
+# if WIDE_CHAR_VERSION
+#  include "wprintf-parse.h"
+# else
+#  include "printf-parse.h"
+# endif
+#endif
+
+/* Checked size_t computations.  */
+#include "xsize.h"
+
+#if (NEED_PRINTF_DOUBLE || NEED_PRINTF_LONG_DOUBLE) && !defined IN_LIBINTL
+# include <math.h>
+# include "float+.h"
+#endif
+
+#if (NEED_PRINTF_DOUBLE || NEED_PRINTF_INFINITE_DOUBLE) && !defined IN_LIBINTL
+# include <math.h>
+# include "isnand-nolibm.h"
+#endif
+
+#if (NEED_PRINTF_LONG_DOUBLE || NEED_PRINTF_INFINITE_LONG_DOUBLE) && !defined IN_LIBINTL
+# include <math.h>
+# include "isnanl-nolibm.h"
+# include "fpucw.h"
+#endif
+
+#if (NEED_PRINTF_DIRECTIVE_A || NEED_PRINTF_DOUBLE) && !defined IN_LIBINTL
+# include <math.h>
+# include "isnand-nolibm.h"
+# include "printf-frexp.h"
+#endif
+
+#if (NEED_PRINTF_DIRECTIVE_A || NEED_PRINTF_LONG_DOUBLE) && !defined IN_LIBINTL
+# include <math.h>
+# include "isnanl-nolibm.h"
+# include "printf-frexpl.h"
+# include "fpucw.h"
+#endif
+
+/* Default parameters.  */
+#ifndef VASNPRINTF
+# if WIDE_CHAR_VERSION
+#  define VASNPRINTF vasnwprintf
+#  define FCHAR_T wchar_t
+#  define DCHAR_T wchar_t
+#  define TCHAR_T wchar_t
+#  define DCHAR_IS_TCHAR 1
+#  define DIRECTIVE wchar_t_directive
+#  define DIRECTIVES wchar_t_directives
+#  define PRINTF_PARSE wprintf_parse
+#  define DCHAR_CPY wmemcpy
+#  define DCHAR_SET wmemset
+# else
+#  define VASNPRINTF vasnprintf
+#  define FCHAR_T char
+#  define DCHAR_T char
+#  define TCHAR_T char
+#  define DCHAR_IS_TCHAR 1
+#  define DIRECTIVE char_directive
+#  define DIRECTIVES char_directives
+#  define PRINTF_PARSE printf_parse
+#  define DCHAR_CPY memcpy
+#  define DCHAR_SET memset
+# endif
+#endif
+#if WIDE_CHAR_VERSION
+  /* TCHAR_T is wchar_t.  */
+# define USE_SNPRINTF 1
+# if HAVE_DECL__SNWPRINTF
+   /* On Windows, the function swprintf() has a different signature than
+      on Unix; we use the _snwprintf() function instead.  */
+#  define SNPRINTF _snwprintf
+# else
+   /* Unix.  */
+#  define SNPRINTF swprintf
+# endif
+#else
+  /* TCHAR_T is char.  */
+  /* Use snprintf if it exists under the name 'snprintf' or '_snprintf'.
+     But don't use it on BeOS, since BeOS snprintf produces no output if the
+     size argument is >= 0x3000000.
+     Also don't use it on Linux libc5, since there snprintf with size = 1
+     writes any output without bounds, like sprintf.  */
+# if (HAVE_DECL__SNPRINTF || HAVE_SNPRINTF) && !defined __BEOS__ && !(__GNU_LIBRARY__ == 1)
+#  define USE_SNPRINTF 1
+# else
+#  define USE_SNPRINTF 0
+# endif
+# if HAVE_DECL__SNPRINTF
+   /* Windows.  */
+#  define SNPRINTF _snprintf
+# else
+   /* Unix.  */
+#  define SNPRINTF snprintf
+   /* Here we need to call the native snprintf, not rpl_snprintf.  */
+#  undef snprintf
+# endif
+#endif
+/* Here we need to call the native sprintf, not rpl_sprintf.  */
+#undef sprintf
+
+/* GCC >= 4.0 with -Wall emits unjustified "... may be used uninitialized"
+   warnings in this file.  Use -Dlint to suppress them.  */
+#ifdef lint
+# define IF_LINT(Code) Code
+#else
+# define IF_LINT(Code) /* empty */
+#endif
+
+/* Avoid some warnings from "gcc -Wshadow".
+   This file doesn't use the exp() and remainder() functions.  */
+#undef exp
+#define exp expo
+#undef remainder
+#define remainder rem
+
+#if !USE_SNPRINTF && !WIDE_CHAR_VERSION
+# if (HAVE_STRNLEN && !defined _AIX)
+#  define local_strnlen strnlen
+# else
+#  ifndef local_strnlen_defined
+#   define local_strnlen_defined 1
+static size_t
+local_strnlen (const char *string, size_t maxlen)
+{
+  const char *end = memchr (string, '\0', maxlen);
+  return end ? (size_t) (end - string) : maxlen;
+}
+#  endif
+# endif
+#endif
+
+#if (!USE_SNPRINTF || (NEED_PRINTF_DIRECTIVE_LS && !defined IN_LIBINTL)) && HAVE_WCHAR_T && (WIDE_CHAR_VERSION || DCHAR_IS_TCHAR)
+# if HAVE_WCSLEN
+#  define local_wcslen wcslen
+# else
+   /* Solaris 2.5.1 has wcslen() in a separate library libw.so. To avoid
+      a dependency towards this library, here is a local substitute.
+      Define this substitute only once, even if this file is included
+      twice in the same compilation unit.  */
+#  ifndef local_wcslen_defined
+#   define local_wcslen_defined 1
+static size_t
+local_wcslen (const wchar_t *s)
+{
+  const wchar_t *ptr;
+
+  for (ptr = s; *ptr != (wchar_t) 0; ptr++)
+    ;
+  return ptr - s;
+}
+#  endif
+# endif
+#endif
+
+#if !USE_SNPRINTF && HAVE_WCHAR_T && WIDE_CHAR_VERSION
+# if HAVE_WCSNLEN
+#  define local_wcsnlen wcsnlen
+# else
+#  ifndef local_wcsnlen_defined
+#   define local_wcsnlen_defined 1
+static size_t
+local_wcsnlen (const wchar_t *s, size_t maxlen)
+{
+  const wchar_t *ptr;
+
+  for (ptr = s; maxlen > 0 && *ptr != (wchar_t) 0; ptr++, maxlen--)
+    ;
+  return ptr - s;
+}
+#  endif
+# endif
+#endif
+
+#if (NEED_PRINTF_DIRECTIVE_A || NEED_PRINTF_LONG_DOUBLE || NEED_PRINTF_INFINITE_LONG_DOUBLE || NEED_PRINTF_DOUBLE || NEED_PRINTF_INFINITE_DOUBLE) && !defined IN_LIBINTL
+/* Determine the decimal-point character according to the current locale.  */
+# ifndef decimal_point_char_defined
+#  define decimal_point_char_defined 1
+static char
+decimal_point_char ()
+{
+  const char *point;
+  /* Determine it in a multithread-safe way.  We know nl_langinfo is
+     multithread-safe on glibc systems, but is not required to be multithread-
+     safe by POSIX.  sprintf(), however, is multithread-safe.  localeconv()
+     is rarely multithread-safe.  */
+#  if HAVE_NL_LANGINFO && __GLIBC__
+  point = nl_langinfo (RADIXCHAR);
+#  elif 1
+  char pointbuf[5];
+  sprintf (pointbuf, "%#.0f", 1.0);
+  point = &pointbuf[1];
+#  else
+  point = localeconv () -> decimal_point;
+#  endif
+  /* The decimal point is always a single byte: either '.' or ','.  */
+  return (point[0] != '\0' ? point[0] : '.');
+}
+# endif
+#endif
+
+#if NEED_PRINTF_INFINITE_DOUBLE && !NEED_PRINTF_DOUBLE && !defined IN_LIBINTL
+
+/* Equivalent to !isfinite(x) || x == 0, but does not require libm.  */
+static int
+is_infinite_or_zero (double x)
+{
+  return isnand (x) || x + x == x;
+}
+
+#endif
+
+#if NEED_PRINTF_INFINITE_LONG_DOUBLE && !NEED_PRINTF_LONG_DOUBLE && !defined IN_LIBINTL
+
+/* Equivalent to !isfinite(x) || x == 0, but does not require libm.  */
+static int
+is_infinite_or_zerol (long double x)
+{
+  return isnanl (x) || x + x == x;
+}
+
+#endif
+
+#if (NEED_PRINTF_LONG_DOUBLE || NEED_PRINTF_DOUBLE) && !defined IN_LIBINTL
+
+/* Converting 'long double' to decimal without rare rounding bugs requires
+   real bignums.  We use the naming conventions of GNU gmp, but vastly simpler
+   (and slower) algorithms.  */
+
+typedef unsigned int mp_limb_t;
+# define GMP_LIMB_BITS 32
+typedef int mp_limb_verify[2 * (sizeof (mp_limb_t) * CHAR_BIT == GMP_LIMB_BITS) - 1];
+
+typedef unsigned long long mp_twolimb_t;
+# define GMP_TWOLIMB_BITS 64
+typedef int mp_twolimb_verify[2 * (sizeof (mp_twolimb_t) * CHAR_BIT == GMP_TWOLIMB_BITS) - 1];
+
+/* Representation of a bignum >= 0.  */
+typedef struct
+{
+  size_t nlimbs;
+  mp_limb_t *limbs; /* Bits in little-endian order, allocated with malloc().  */
+} mpn_t;
+
+/* Compute the product of two bignums >= 0.
+   Return the allocated memory in case of success, NULL in case of memory
+   allocation failure.  */
+static void *
+multiply (mpn_t src1, mpn_t src2, mpn_t *dest)
+{
+  const mp_limb_t *p1;
+  const mp_limb_t *p2;
+  size_t len1;
+  size_t len2;
+
+  if (src1.nlimbs <= src2.nlimbs)
+    {
+      len1 = src1.nlimbs;
+      p1 = src1.limbs;
+      len2 = src2.nlimbs;
+      p2 = src2.limbs;
+    }
+  else
+    {
+      len1 = src2.nlimbs;
+      p1 = src2.limbs;
+      len2 = src1.nlimbs;
+      p2 = src1.limbs;
+    }
+  /* Now 0 <= len1 <= len2.  */
+  if (len1 == 0)
+    {
+      /* src1 or src2 is zero.  */
+      dest->nlimbs = 0;
+      dest->limbs = (mp_limb_t *) malloc (1);
+    }
+  else
+    {
+      /* Here 1 <= len1 <= len2.  */
+      size_t dlen;
+      mp_limb_t *dp;
+      size_t k, i, j;
+
+      dlen = len1 + len2;
+      dp = (mp_limb_t *) malloc (dlen * sizeof (mp_limb_t));
+      if (dp == NULL)
+	return NULL;
+      for (k = len2; k > 0; )
+	dp[--k] = 0;
+      for (i = 0; i < len1; i++)
+	{
+	  mp_limb_t digit1 = p1[i];
+	  mp_twolimb_t carry = 0;
+	  for (j = 0; j < len2; j++)
+	    {
+	      mp_limb_t digit2 = p2[j];
+	      carry += (mp_twolimb_t) digit1 * (mp_twolimb_t) digit2;
+	      carry += dp[i + j];
+	      dp[i + j] = (mp_limb_t) carry;
+	      carry = carry >> GMP_LIMB_BITS;
+	    }
+	  dp[i + len2] = (mp_limb_t) carry;
+	}
+      /* Normalise.  */
+      while (dlen > 0 && dp[dlen - 1] == 0)
+	dlen--;
+      dest->nlimbs = dlen;
+      dest->limbs = dp;
+    }
+  return dest->limbs;
+}
+
+/* Compute the quotient of a bignum a >= 0 and a bignum b > 0.
+   a is written as  a = q * b + r  with 0 <= r < b.  q is the quotient, r
+   the remainder.
+   Finally, round-to-even is performed: If r > b/2 or if r = b/2 and q is odd,
+   q is incremented.
+   Return the allocated memory in case of success, NULL in case of memory
+   allocation failure.  */
+static void *
+divide (mpn_t a, mpn_t b, mpn_t *q)
+{
+  /* Algorithm:
+     First normalise a and b: a=[a[m-1],...,a[0]], b=[b[n-1],...,b[0]]
+     with m>=0 and n>0 (in base beta = 2^GMP_LIMB_BITS).
+     If m<n, then q:=0 and r:=a.
+     If m>=n=1, perform a single-precision division:
+       r:=0, j:=m,
+       while j>0 do
+         {Here (q[m-1]*beta^(m-1)+...+q[j]*beta^j) * b[0] + r*beta^j =
+               = a[m-1]*beta^(m-1)+...+a[j]*beta^j und 0<=r<b[0]<beta}
+         j:=j-1, r:=r*beta+a[j], q[j]:=floor(r/b[0]), r:=r-b[0]*q[j].
+       Normalise [q[m-1],...,q[0]], yields q.
+     If m>=n>1, perform a multiple-precision division:
+       We have a/b < beta^(m-n+1).
+       s:=intDsize-1-(highest bit in b[n-1]), 0<=s<intDsize.
+       Shift a and b left by s bits, copying them. r:=a.
+       r=[r[m],...,r[0]], b=[b[n-1],...,b[0]] with b[n-1]>=beta/2.
+       For j=m-n,...,0: {Here 0 <= r < b*beta^(j+1).}
+         Compute q* :
+           q* := floor((r[j+n]*beta+r[j+n-1])/b[n-1]).
+           In case of overflow (q* >= beta) set q* := beta-1.
+           Compute c2 := ((r[j+n]*beta+r[j+n-1]) - q* * b[n-1])*beta + r[j+n-2]
+           and c3 := b[n-2] * q*.
+           {We have 0 <= c2 < 2*beta^2, even 0 <= c2 < beta^2 if no overflow
+            occurred.  Furthermore 0 <= c3 < beta^2.
+            If there was overflow and
+            r[j+n]*beta+r[j+n-1] - q* * b[n-1] >= beta, i.e. c2 >= beta^2,
+            the next test can be skipped.}
+           While c3 > c2, {Here 0 <= c2 < c3 < beta^2}
+             Put q* := q* - 1, c2 := c2 + b[n-1]*beta, c3 := c3 - b[n-2].
+           If q* > 0:
+             Put r := r - b * q* * beta^j. In detail:
+               [r[n+j],...,r[j]] := [r[n+j],...,r[j]] - q* * [b[n-1],...,b[0]].
+               hence: u:=0, for i:=0 to n-1 do
+                              u := u + q* * b[i],
+                              r[j+i]:=r[j+i]-(u mod beta) (+ beta, if carry),
+                              u:=u div beta (+ 1, if carry in subtraction)
+                      r[n+j]:=r[n+j]-u.
+               {Since always u = (q* * [b[i-1],...,b[0]] div beta^i) + 1
+                               < q* + 1 <= beta,
+                the carry u does not overflow.}
+             If a negative carry occurs, put q* := q* - 1
+               and [r[n+j],...,r[j]] := [r[n+j],...,r[j]] + [0,b[n-1],...,b[0]].
+         Set q[j] := q*.
+       Normalise [q[m-n],..,q[0]]; this yields the quotient q.
+       Shift [r[n-1],...,r[0]] right by s bits and normalise; this yields the
+       rest r.
+       The room for q[j] can be allocated at the memory location of r[n+j].
+     Finally, round-to-even:
+       Shift r left by 1 bit.
+       If r > b or if r = b and q[0] is odd, q := q+1.
+   */
+  const mp_limb_t *a_ptr = a.limbs;
+  size_t a_len = a.nlimbs;
+  const mp_limb_t *b_ptr = b.limbs;
+  size_t b_len = b.nlimbs;
+  mp_limb_t *roomptr;
+  mp_limb_t *tmp_roomptr = NULL;
+  mp_limb_t *q_ptr;
+  size_t q_len;
+  mp_limb_t *r_ptr;
+  size_t r_len;
+
+  /* Allocate room for a_len+2 digits.
+     (Need a_len+1 digits for the real division and 1 more digit for the
+     final rounding of q.)  */
+  roomptr = (mp_limb_t *) malloc ((a_len + 2) * sizeof (mp_limb_t));
+  if (roomptr == NULL)
+    return NULL;
+
+  /* Normalise a.  */
+  while (a_len > 0 && a_ptr[a_len - 1] == 0)
+    a_len--;
+
+  /* Normalise b.  */
+  for (;;)
+    {
+      if (b_len == 0)
+	/* Division by zero.  */
+	abort ();
+      if (b_ptr[b_len - 1] == 0)
+	b_len--;
+      else
+	break;
+    }
+
+  /* Here m = a_len >= 0 and n = b_len > 0.  */
+
+  if (a_len < b_len)
+    {
+      /* m<n: trivial case.  q=0, r := copy of a.  */
+      r_ptr = roomptr;
+      r_len = a_len;
+      memcpy (r_ptr, a_ptr, a_len * sizeof (mp_limb_t));
+      q_ptr = roomptr + a_len;
+      q_len = 0;
+    }
+  else if (b_len == 1)
+    {
+      /* n=1: single precision division.
+	 beta^(m-1) <= a < beta^m  ==>  beta^(m-2) <= a/b < beta^m  */
+      r_ptr = roomptr;
+      q_ptr = roomptr + 1;
+      {
+	mp_limb_t den = b_ptr[0];
+	mp_limb_t remainder = 0;
+	const mp_limb_t *sourceptr = a_ptr + a_len;
+	mp_limb_t *destptr = q_ptr + a_len;
+	size_t count;
+	for (count = a_len; count > 0; count--)
+	  {
+	    mp_twolimb_t num =
+	      ((mp_twolimb_t) remainder << GMP_LIMB_BITS) | *--sourceptr;
+	    *--destptr = num / den;
+	    remainder = num % den;
+	  }
+	/* Normalise and store r.  */
+	if (remainder > 0)
+	  {
+	    r_ptr[0] = remainder;
+	    r_len = 1;
+	  }
+	else
+	  r_len = 0;
+	/* Normalise q.  */
+	q_len = a_len;
+	if (q_ptr[q_len - 1] == 0)
+	  q_len--;
+      }
+    }
+  else
+    {
+      /* n>1: multiple precision division.
+	 beta^(m-1) <= a < beta^m, beta^(n-1) <= b < beta^n  ==>
+	 beta^(m-n-1) <= a/b < beta^(m-n+1).  */
+      /* Determine s.  */
+      size_t s;
+      {
+	mp_limb_t msd = b_ptr[b_len - 1]; /* = b[n-1], > 0 */
+	s = 31;
+	if (msd >= 0x10000)
+	  {
+	    msd = msd >> 16;
+	    s -= 16;
+	  }
+	if (msd >= 0x100)
+	  {
+	    msd = msd >> 8;
+	    s -= 8;
+	  }
+	if (msd >= 0x10)
+	  {
+	    msd = msd >> 4;
+	    s -= 4;
+	  }
+	if (msd >= 0x4)
+	  {
+	    msd = msd >> 2;
+	    s -= 2;
+	  }
+	if (msd >= 0x2)
+	  {
+	    msd = msd >> 1;
+	    s -= 1;
+	  }
+      }
+      /* 0 <= s < GMP_LIMB_BITS.
+	 Copy b, shifting it left by s bits.  */
+      if (s > 0)
+	{
+	  tmp_roomptr = (mp_limb_t *) malloc (b_len * sizeof (mp_limb_t));
+	  if (tmp_roomptr == NULL)
+	    {
+	      free (roomptr);
+	      return NULL;
+	    }
+	  {
+	    const mp_limb_t *sourceptr = b_ptr;
+	    mp_limb_t *destptr = tmp_roomptr;
+	    mp_twolimb_t accu = 0;
+	    size_t count;
+	    for (count = b_len; count > 0; count--)
+	      {
+		accu += (mp_twolimb_t) *sourceptr++ << s;
+		*destptr++ = (mp_limb_t) accu;
+		accu = accu >> GMP_LIMB_BITS;
+	      }
+	    /* accu must be zero, since that was how s was determined.  */
+	    if (accu != 0)
+	      abort ();
+	  }
+	  b_ptr = tmp_roomptr;
+	}
+      /* Copy a, shifting it left by s bits, yields r.
+	 Memory layout:
+	 At the beginning: r = roomptr[0..a_len],
+	 at the end: r = roomptr[0..b_len-1], q = roomptr[b_len..a_len]  */
+      r_ptr = roomptr;
+      if (s == 0)
+	{
+	  memcpy (r_ptr, a_ptr, a_len * sizeof (mp_limb_t));
+	  r_ptr[a_len] = 0;
+	}
+      else
+	{
+	  const mp_limb_t *sourceptr = a_ptr;
+	  mp_limb_t *destptr = r_ptr;
+	  mp_twolimb_t accu = 0;
+	  size_t count;
+	  for (count = a_len; count > 0; count--)
+	    {
+	      accu += (mp_twolimb_t) *sourceptr++ << s;
+	      *destptr++ = (mp_limb_t) accu;
+	      accu = accu >> GMP_LIMB_BITS;
+	    }
+	  *destptr++ = (mp_limb_t) accu;
+	}
+      q_ptr = roomptr + b_len;
+      q_len = a_len - b_len + 1; /* q will have m-n+1 limbs */
+      {
+	size_t j = a_len - b_len; /* m-n */
+	mp_limb_t b_msd = b_ptr[b_len - 1]; /* b[n-1] */
+	mp_limb_t b_2msd = b_ptr[b_len - 2]; /* b[n-2] */
+	mp_twolimb_t b_msdd = /* b[n-1]*beta+b[n-2] */
+	  ((mp_twolimb_t) b_msd << GMP_LIMB_BITS) | b_2msd;
+	/* Division loop, traversed m-n+1 times.
+	   j counts down, b is unchanged, beta/2 <= b[n-1] < beta.  */
+	for (;;)
+	  {
+	    mp_limb_t q_star;
+	    mp_limb_t c1;
+	    if (r_ptr[j + b_len] < b_msd) /* r[j+n] < b[n-1] ? */
+	      {
+		/* Divide r[j+n]*beta+r[j+n-1] by b[n-1], no overflow.  */
+		mp_twolimb_t num =
+		  ((mp_twolimb_t) r_ptr[j + b_len] << GMP_LIMB_BITS)
+		  | r_ptr[j + b_len - 1];
+		q_star = num / b_msd;
+		c1 = num % b_msd;
+	      }
+	    else
+	      {
+		/* Overflow, hence r[j+n]*beta+r[j+n-1] >= beta*b[n-1].  */
+		q_star = (mp_limb_t)~(mp_limb_t)0; /* q* = beta-1 */
+		/* Test whether r[j+n]*beta+r[j+n-1] - (beta-1)*b[n-1] >= beta
+		   <==> r[j+n]*beta+r[j+n-1] + b[n-1] >= beta*b[n-1]+beta
+		   <==> b[n-1] < floor((r[j+n]*beta+r[j+n-1]+b[n-1])/beta)
+		        {<= beta !}.
+		   If yes, jump directly to the subtraction loop.
+		   (Otherwise, r[j+n]*beta+r[j+n-1] - (beta-1)*b[n-1] < beta
+		    <==> floor((r[j+n]*beta+r[j+n-1]+b[n-1])/beta) = b[n-1] ) */
+		if (r_ptr[j + b_len] > b_msd
+		    || (c1 = r_ptr[j + b_len - 1] + b_msd) < b_msd)
+		  /* r[j+n] >= b[n-1]+1 or
+		     r[j+n] = b[n-1] and the addition r[j+n-1]+b[n-1] gives a
+		     carry.  */
+		  goto subtract;
+	      }
+	    /* q_star = q*,
+	       c1 = (r[j+n]*beta+r[j+n-1]) - q* * b[n-1] (>=0, <beta).  */
+	    {
+	      mp_twolimb_t c2 = /* c1*beta+r[j+n-2] */
+		((mp_twolimb_t) c1 << GMP_LIMB_BITS) | r_ptr[j + b_len - 2];
+	      mp_twolimb_t c3 = /* b[n-2] * q* */
+		(mp_twolimb_t) b_2msd * (mp_twolimb_t) q_star;
+	      /* While c2 < c3, increase c2 and decrease c3.
+		 Consider c3-c2.  While it is > 0, decrease it by
+		 b[n-1]*beta+b[n-2].  Because of b[n-1]*beta+b[n-2] >= beta^2/2
+		 this can happen only twice.  */
+	      if (c3 > c2)
+		{
+		  q_star = q_star - 1; /* q* := q* - 1 */
+		  if (c3 - c2 > b_msdd)
+		    q_star = q_star - 1; /* q* := q* - 1 */
+		}
+	    }
+	    if (q_star > 0)
+	      subtract:
+	      {
+		/* Subtract r := r - b * q* * beta^j.  */
+		mp_limb_t cr;
+		{
+		  const mp_limb_t *sourceptr = b_ptr;
+		  mp_limb_t *destptr = r_ptr + j;
+		  mp_twolimb_t carry = 0;
+		  size_t count;
+		  for (count = b_len; count > 0; count--)
+		    {
+		      /* Here 0 <= carry <= q*.  */
+		      carry =
+			carry
+			+ (mp_twolimb_t) q_star * (mp_twolimb_t) *sourceptr++
+			+ (mp_limb_t) ~(*destptr);
+		      /* Here 0 <= carry <= beta*q* + beta-1.  */
+		      *destptr++ = ~(mp_limb_t) carry;
+		      carry = carry >> GMP_LIMB_BITS; /* <= q* */
+		    }
+		  cr = (mp_limb_t) carry;
+		}
+		/* Subtract cr from r_ptr[j + b_len], then forget about
+		   r_ptr[j + b_len].  */
+		if (cr > r_ptr[j + b_len])
+		  {
+		    /* Subtraction gave a carry.  */
+		    q_star = q_star - 1; /* q* := q* - 1 */
+		    /* Add b back.  */
+		    {
+		      const mp_limb_t *sourceptr = b_ptr;
+		      mp_limb_t *destptr = r_ptr + j;
+		      mp_limb_t carry = 0;
+		      size_t count;
+		      for (count = b_len; count > 0; count--)
+			{
+			  mp_limb_t source1 = *sourceptr++;
+			  mp_limb_t source2 = *destptr;
+			  *destptr++ = source1 + source2 + carry;
+			  carry =
+			    (carry
+			     ? source1 >= (mp_limb_t) ~source2
+			     : source1 > (mp_limb_t) ~source2);
+			}
+		    }
+		    /* Forget about the carry and about r[j+n].  */
+		  }
+	      }
+	    /* q* is determined.  Store it as q[j].  */
+	    q_ptr[j] = q_star;
+	    if (j == 0)
+	      break;
+	    j--;
+	  }
+      }
+      r_len = b_len;
+      /* Normalise q.  */
+      if (q_ptr[q_len - 1] == 0)
+	q_len--;
+# if 0 /* Not needed here, since we need r only to compare it with b/2, and
+	  b is shifted left by s bits.  */
+      /* Shift r right by s bits.  */
+      if (s > 0)
+	{
+	  mp_limb_t ptr = r_ptr + r_len;
+	  mp_twolimb_t accu = 0;
+	  size_t count;
+	  for (count = r_len; count > 0; count--)
+	    {
+	      accu = (mp_twolimb_t) (mp_limb_t) accu << GMP_LIMB_BITS;
+	      accu += (mp_twolimb_t) *--ptr << (GMP_LIMB_BITS - s);
+	      *ptr = (mp_limb_t) (accu >> GMP_LIMB_BITS);
+	    }
+	}
+# endif
+      /* Normalise r.  */
+      while (r_len > 0 && r_ptr[r_len - 1] == 0)
+	r_len--;
+    }
+  /* Compare r << 1 with b.  */
+  if (r_len > b_len)
+    goto increment_q;
+  {
+    size_t i;
+    for (i = b_len;;)
+      {
+	mp_limb_t r_i =
+	  (i <= r_len && i > 0 ? r_ptr[i - 1] >> (GMP_LIMB_BITS - 1) : 0)
+	  | (i < r_len ? r_ptr[i] << 1 : 0);
+	mp_limb_t b_i = (i < b_len ? b_ptr[i] : 0);
+	if (r_i > b_i)
+	  goto increment_q;
+	if (r_i < b_i)
+	  goto keep_q;
+	if (i == 0)
+	  break;
+	i--;
+      }
+  }
+  if (q_len > 0 && ((q_ptr[0] & 1) != 0))
+    /* q is odd.  */
+    increment_q:
+    {
+      size_t i;
+      for (i = 0; i < q_len; i++)
+	if (++(q_ptr[i]) != 0)
+	  goto keep_q;
+      q_ptr[q_len++] = 1;
+    }
+  keep_q:
+  if (tmp_roomptr != NULL)
+    free (tmp_roomptr);
+  q->limbs = q_ptr;
+  q->nlimbs = q_len;
+  return roomptr;
+}
+
+/* Convert a bignum a >= 0, multiplied with 10^extra_zeroes, to decimal
+   representation.
+   Destroys the contents of a.
+   Return the allocated memory - containing the decimal digits in low-to-high
+   order, terminated with a NUL character - in case of success, NULL in case
+   of memory allocation failure.  */
+static char *
+convert_to_decimal (mpn_t a, size_t extra_zeroes)
+{
+  mp_limb_t *a_ptr = a.limbs;
+  size_t a_len = a.nlimbs;
+  /* 0.03345 is slightly larger than log(2)/(9*log(10)).  */
+  size_t c_len = 9 * ((size_t)(a_len * (GMP_LIMB_BITS * 0.03345f)) + 1);
+  char *c_ptr = (char *) malloc (xsum (c_len, extra_zeroes));
+  if (c_ptr != NULL)
+    {
+      char *d_ptr = c_ptr;
+      for (; extra_zeroes > 0; extra_zeroes--)
+	*d_ptr++ = '0';
+      while (a_len > 0)
+	{
+	  /* Divide a by 10^9, in-place.  */
+	  mp_limb_t remainder = 0;
+	  mp_limb_t *ptr = a_ptr + a_len;
+	  size_t count;
+	  for (count = a_len; count > 0; count--)
+	    {
+	      mp_twolimb_t num =
+		((mp_twolimb_t) remainder << GMP_LIMB_BITS) | *--ptr;
+	      *ptr = num / 1000000000;
+	      remainder = num % 1000000000;
+	    }
+	  /* Store the remainder as 9 decimal digits.  */
+	  for (count = 9; count > 0; count--)
+	    {
+	      *d_ptr++ = '0' + (remainder % 10);
+	      remainder = remainder / 10;
+	    }
+	  /* Normalize a.  */
+	  if (a_ptr[a_len - 1] == 0)
+	    a_len--;
+	}
+      /* Remove leading zeroes.  */
+      while (d_ptr > c_ptr && d_ptr[-1] == '0')
+	d_ptr--;
+      /* But keep at least one zero.  */
+      if (d_ptr == c_ptr)
+	*d_ptr++ = '0';
+      /* Terminate the string.  */
+      *d_ptr = '\0';
+    }
+  return c_ptr;
+}
+
+# if NEED_PRINTF_LONG_DOUBLE
+
+/* Assuming x is finite and >= 0:
+   write x as x = 2^e * m, where m is a bignum.
+   Return the allocated memory in case of success, NULL in case of memory
+   allocation failure.  */
+static void *
+decode_long_double (long double x, int *ep, mpn_t *mp)
+{
+  mpn_t m;
+  int exp;
+  long double y;
+  size_t i;
+
+  /* Allocate memory for result.  */
+  m.nlimbs = (LDBL_MANT_BIT + GMP_LIMB_BITS - 1) / GMP_LIMB_BITS;
+  m.limbs = (mp_limb_t *) malloc (m.nlimbs * sizeof (mp_limb_t));
+  if (m.limbs == NULL)
+    return NULL;
+  /* Split into exponential part and mantissa.  */
+  y = frexpl (x, &exp);
+  if (!(y >= 0.0L && y < 1.0L))
+    abort ();
+  /* x = 2^exp * y = 2^(exp - LDBL_MANT_BIT) * (y * LDBL_MANT_BIT), and the
+     latter is an integer.  */
+  /* Convert the mantissa (y * LDBL_MANT_BIT) to a sequence of limbs.
+     I'm not sure whether it's safe to cast a 'long double' value between
+     2^31 and 2^32 to 'unsigned int', therefore play safe and cast only
+     'long double' values between 0 and 2^16 (to 'unsigned int' or 'int',
+     doesn't matter).  */
+#  if (LDBL_MANT_BIT % GMP_LIMB_BITS) != 0
+#   if (LDBL_MANT_BIT % GMP_LIMB_BITS) > GMP_LIMB_BITS / 2
+    {
+      mp_limb_t hi, lo;
+      y *= (mp_limb_t) 1 << (LDBL_MANT_BIT % (GMP_LIMB_BITS / 2));
+      hi = (int) y;
+      y -= hi;
+      if (!(y >= 0.0L && y < 1.0L))
+	abort ();
+      y *= (mp_limb_t) 1 << (GMP_LIMB_BITS / 2);
+      lo = (int) y;
+      y -= lo;
+      if (!(y >= 0.0L && y < 1.0L))
+	abort ();
+      m.limbs[LDBL_MANT_BIT / GMP_LIMB_BITS] = (hi << (GMP_LIMB_BITS / 2)) | lo;
+    }
+#   else
+    {
+      mp_limb_t d;
+      y *= (mp_limb_t) 1 << (LDBL_MANT_BIT % GMP_LIMB_BITS);
+      d = (int) y;
+      y -= d;
+      if (!(y >= 0.0L && y < 1.0L))
+	abort ();
+      m.limbs[LDBL_MANT_BIT / GMP_LIMB_BITS] = d;
+    }
+#   endif
+#  endif
+  for (i = LDBL_MANT_BIT / GMP_LIMB_BITS; i > 0; )
+    {
+      mp_limb_t hi, lo;
+      y *= (mp_limb_t) 1 << (GMP_LIMB_BITS / 2);
+      hi = (int) y;
+      y -= hi;
+      if (!(y >= 0.0L && y < 1.0L))
+	abort ();
+      y *= (mp_limb_t) 1 << (GMP_LIMB_BITS / 2);
+      lo = (int) y;
+      y -= lo;
+      if (!(y >= 0.0L && y < 1.0L))
+	abort ();
+      m.limbs[--i] = (hi << (GMP_LIMB_BITS / 2)) | lo;
+    }
+#if 0 /* On FreeBSD 6.1/x86, 'long double' numbers sometimes have excess
+         precision.  */
+  if (!(y == 0.0L))
+    abort ();
+#endif
+  /* Normalise.  */
+  while (m.nlimbs > 0 && m.limbs[m.nlimbs - 1] == 0)
+    m.nlimbs--;
+  *mp = m;
+  *ep = exp - LDBL_MANT_BIT;
+  return m.limbs;
+}
+
+# endif
+
+# if NEED_PRINTF_DOUBLE
+
+/* Assuming x is finite and >= 0:
+   write x as x = 2^e * m, where m is a bignum.
+   Return the allocated memory in case of success, NULL in case of memory
+   allocation failure.  */
+static void *
+decode_double (double x, int *ep, mpn_t *mp)
+{
+  mpn_t m;
+  int exp;
+  double y;
+  size_t i;
+
+  /* Allocate memory for result.  */
+  m.nlimbs = (DBL_MANT_BIT + GMP_LIMB_BITS - 1) / GMP_LIMB_BITS;
+  m.limbs = (mp_limb_t *) malloc (m.nlimbs * sizeof (mp_limb_t));
+  if (m.limbs == NULL)
+    return NULL;
+  /* Split into exponential part and mantissa.  */
+  y = frexp (x, &exp);
+  if (!(y >= 0.0 && y < 1.0))
+    abort ();
+  /* x = 2^exp * y = 2^(exp - DBL_MANT_BIT) * (y * DBL_MANT_BIT), and the
+     latter is an integer.  */
+  /* Convert the mantissa (y * DBL_MANT_BIT) to a sequence of limbs.
+     I'm not sure whether it's safe to cast a 'double' value between
+     2^31 and 2^32 to 'unsigned int', therefore play safe and cast only
+     'double' values between 0 and 2^16 (to 'unsigned int' or 'int',
+     doesn't matter).  */
+#  if (DBL_MANT_BIT % GMP_LIMB_BITS) != 0
+#   if (DBL_MANT_BIT % GMP_LIMB_BITS) > GMP_LIMB_BITS / 2
+    {
+      mp_limb_t hi, lo;
+      y *= (mp_limb_t) 1 << (DBL_MANT_BIT % (GMP_LIMB_BITS / 2));
+      hi = (int) y;
+      y -= hi;
+      if (!(y >= 0.0 && y < 1.0))
+	abort ();
+      y *= (mp_limb_t) 1 << (GMP_LIMB_BITS / 2);
+      lo = (int) y;
+      y -= lo;
+      if (!(y >= 0.0 && y < 1.0))
+	abort ();
+      m.limbs[DBL_MANT_BIT / GMP_LIMB_BITS] = (hi << (GMP_LIMB_BITS / 2)) | lo;
+    }
+#   else
+    {
+      mp_limb_t d;
+      y *= (mp_limb_t) 1 << (DBL_MANT_BIT % GMP_LIMB_BITS);
+      d = (int) y;
+      y -= d;
+      if (!(y >= 0.0 && y < 1.0))
+	abort ();
+      m.limbs[DBL_MANT_BIT / GMP_LIMB_BITS] = d;
+    }
+#   endif
+#  endif
+  for (i = DBL_MANT_BIT / GMP_LIMB_BITS; i > 0; )
+    {
+      mp_limb_t hi, lo;
+      y *= (mp_limb_t) 1 << (GMP_LIMB_BITS / 2);
+      hi = (int) y;
+      y -= hi;
+      if (!(y >= 0.0 && y < 1.0))
+	abort ();
+      y *= (mp_limb_t) 1 << (GMP_LIMB_BITS / 2);
+      lo = (int) y;
+      y -= lo;
+      if (!(y >= 0.0 && y < 1.0))
+	abort ();
+      m.limbs[--i] = (hi << (GMP_LIMB_BITS / 2)) | lo;
+    }
+  if (!(y == 0.0))
+    abort ();
+  /* Normalise.  */
+  while (m.nlimbs > 0 && m.limbs[m.nlimbs - 1] == 0)
+    m.nlimbs--;
+  *mp = m;
+  *ep = exp - DBL_MANT_BIT;
+  return m.limbs;
+}
+
+# endif
+
+/* Assuming x = 2^e * m is finite and >= 0, and n is an integer:
+   Returns the decimal representation of round (x * 10^n).
+   Return the allocated memory - containing the decimal digits in low-to-high
+   order, terminated with a NUL character - in case of success, NULL in case
+   of memory allocation failure.  */
+static char *
+scale10_round_decimal_decoded (int e, mpn_t m, void *memory, int n)
+{
+  int s;
+  size_t extra_zeroes;
+  unsigned int abs_n;
+  unsigned int abs_s;
+  mp_limb_t *pow5_ptr;
+  size_t pow5_len;
+  unsigned int s_limbs;
+  unsigned int s_bits;
+  mpn_t pow5;
+  mpn_t z;
+  void *z_memory;
+  char *digits;
+
+  if (memory == NULL)
+    return NULL;
+  /* x = 2^e * m, hence
+     y = round (2^e * 10^n * m) = round (2^(e+n) * 5^n * m)
+       = round (2^s * 5^n * m).  */
+  s = e + n;
+  extra_zeroes = 0;
+  /* Factor out a common power of 10 if possible.  */
+  if (s > 0 && n > 0)
+    {
+      extra_zeroes = (s < n ? s : n);
+      s -= extra_zeroes;
+      n -= extra_zeroes;
+    }
+  /* Here y = round (2^s * 5^n * m) * 10^extra_zeroes.
+     Before converting to decimal, we need to compute
+     z = round (2^s * 5^n * m).  */
+  /* Compute 5^|n|, possibly shifted by |s| bits if n and s have the same
+     sign.  2.322 is slightly larger than log(5)/log(2).  */
+  abs_n = (n >= 0 ? n : -n);
+  abs_s = (s >= 0 ? s : -s);
+  pow5_ptr = (mp_limb_t *) malloc (((int)(abs_n * (2.322f / GMP_LIMB_BITS)) + 1
+				    + abs_s / GMP_LIMB_BITS + 1)
+				   * sizeof (mp_limb_t));
+  if (pow5_ptr == NULL)
+    {
+      free (memory);
+      return NULL;
+    }
+  /* Initialize with 1.  */
+  pow5_ptr[0] = 1;
+  pow5_len = 1;
+  /* Multiply with 5^|n|.  */
+  if (abs_n > 0)
+    {
+      static mp_limb_t const small_pow5[13 + 1] =
+	{
+	  1, 5, 25, 125, 625, 3125, 15625, 78125, 390625, 1953125, 9765625,
+	  48828125, 244140625, 1220703125
+	};
+      unsigned int n13;
+      for (n13 = 0; n13 <= abs_n; n13 += 13)
+	{
+	  mp_limb_t digit1 = small_pow5[n13 + 13 <= abs_n ? 13 : abs_n - n13];
+	  size_t j;
+	  mp_twolimb_t carry = 0;
+	  for (j = 0; j < pow5_len; j++)
+	    {
+	      mp_limb_t digit2 = pow5_ptr[j];
+	      carry += (mp_twolimb_t) digit1 * (mp_twolimb_t) digit2;
+	      pow5_ptr[j] = (mp_limb_t) carry;
+	      carry = carry >> GMP_LIMB_BITS;
+	    }
+	  if (carry > 0)
+	    pow5_ptr[pow5_len++] = (mp_limb_t) carry;
+	}
+    }
+  s_limbs = abs_s / GMP_LIMB_BITS;
+  s_bits = abs_s % GMP_LIMB_BITS;
+  if (n >= 0 ? s >= 0 : s <= 0)
+    {
+      /* Multiply with 2^|s|.  */
+      if (s_bits > 0)
+	{
+	  mp_limb_t *ptr = pow5_ptr;
+	  mp_twolimb_t accu = 0;
+	  size_t count;
+	  for (count = pow5_len; count > 0; count--)
+	    {
+	      accu += (mp_twolimb_t) *ptr << s_bits;
+	      *ptr++ = (mp_limb_t) accu;
+	      accu = accu >> GMP_LIMB_BITS;
+	    }
+	  if (accu > 0)
+	    {
+	      *ptr = (mp_limb_t) accu;
+	      pow5_len++;
+	    }
+	}
+      if (s_limbs > 0)
+	{
+	  size_t count;
+	  for (count = pow5_len; count > 0;)
+	    {
+	      count--;
+	      pow5_ptr[s_limbs + count] = pow5_ptr[count];
+	    }
+	  for (count = s_limbs; count > 0;)
+	    {
+	      count--;
+	      pow5_ptr[count] = 0;
+	    }
+	  pow5_len += s_limbs;
+	}
+      pow5.limbs = pow5_ptr;
+      pow5.nlimbs = pow5_len;
+      if (n >= 0)
+	{
+	  /* Multiply m with pow5.  No division needed.  */
+	  z_memory = multiply (m, pow5, &z);
+	}
+      else
+	{
+	  /* Divide m by pow5 and round.  */
+	  z_memory = divide (m, pow5, &z);
+	}
+    }
+  else
+    {
+      pow5.limbs = pow5_ptr;
+      pow5.nlimbs = pow5_len;
+      if (n >= 0)
+	{
+	  /* n >= 0, s < 0.
+	     Multiply m with pow5, then divide by 2^|s|.  */
+	  mpn_t numerator;
+	  mpn_t denominator;
+	  void *tmp_memory;
+	  tmp_memory = multiply (m, pow5, &numerator);
+	  if (tmp_memory == NULL)
+	    {
+	      free (pow5_ptr);
+	      free (memory);
+	      return NULL;
+	    }
+	  /* Construct 2^|s|.  */
+	  {
+	    mp_limb_t *ptr = pow5_ptr + pow5_len;
+	    size_t i;
+	    for (i = 0; i < s_limbs; i++)
+	      ptr[i] = 0;
+	    ptr[s_limbs] = (mp_limb_t) 1 << s_bits;
+	    denominator.limbs = ptr;
+	    denominator.nlimbs = s_limbs + 1;
+	  }
+	  z_memory = divide (numerator, denominator, &z);
+	  free (tmp_memory);
+	}
+      else
+	{
+	  /* n < 0, s > 0.
+	     Multiply m with 2^s, then divide by pow5.  */
+	  mpn_t numerator;
+	  mp_limb_t *num_ptr;
+	  num_ptr = (mp_limb_t *) malloc ((m.nlimbs + s_limbs + 1)
+					  * sizeof (mp_limb_t));
+	  if (num_ptr == NULL)
+	    {
+	      free (pow5_ptr);
+	      free (memory);
+	      return NULL;
+	    }
+	  {
+	    mp_limb_t *destptr = num_ptr;
+	    {
+	      size_t i;
+	      for (i = 0; i < s_limbs; i++)
+		*destptr++ = 0;
+	    }
+	    if (s_bits > 0)
+	      {
+		const mp_limb_t *sourceptr = m.limbs;
+		mp_twolimb_t accu = 0;
+		size_t count;
+		for (count = m.nlimbs; count > 0; count--)
+		  {
+		    accu += (mp_twolimb_t) *sourceptr++ << s_bits;
+		    *destptr++ = (mp_limb_t) accu;
+		    accu = accu >> GMP_LIMB_BITS;
+		  }
+		if (accu > 0)
+		  *destptr++ = (mp_limb_t) accu;
+	      }
+	    else
+	      {
+		const mp_limb_t *sourceptr = m.limbs;
+		size_t count;
+		for (count = m.nlimbs; count > 0; count--)
+		  *destptr++ = *sourceptr++;
+	      }
+	    numerator.limbs = num_ptr;
+	    numerator.nlimbs = destptr - num_ptr;
+	  }
+	  z_memory = divide (numerator, pow5, &z);
+	  free (num_ptr);
+	}
+    }
+  free (pow5_ptr);
+  free (memory);
+
+  /* Here y = round (x * 10^n) = z * 10^extra_zeroes.  */
+
+  if (z_memory == NULL)
+    return NULL;
+  digits = convert_to_decimal (z, extra_zeroes);
+  free (z_memory);
+  return digits;
+}
+
+# if NEED_PRINTF_LONG_DOUBLE
+
+/* Assuming x is finite and >= 0, and n is an integer:
+   Returns the decimal representation of round (x * 10^n).
+   Return the allocated memory - containing the decimal digits in low-to-high
+   order, terminated with a NUL character - in case of success, NULL in case
+   of memory allocation failure.  */
+static char *
+scale10_round_decimal_long_double (long double x, int n)
+{
+  int e IF_LINT(= 0);
+  mpn_t m;
+  void *memory = decode_long_double (x, &e, &m);
+  return scale10_round_decimal_decoded (e, m, memory, n);
+}
+
+# endif
+
+# if NEED_PRINTF_DOUBLE
+
+/* Assuming x is finite and >= 0, and n is an integer:
+   Returns the decimal representation of round (x * 10^n).
+   Return the allocated memory - containing the decimal digits in low-to-high
+   order, terminated with a NUL character - in case of success, NULL in case
+   of memory allocation failure.  */
+static char *
+scale10_round_decimal_double (double x, int n)
+{
+  int e IF_LINT(= 0);
+  mpn_t m;
+  void *memory = decode_double (x, &e, &m);
+  return scale10_round_decimal_decoded (e, m, memory, n);
+}
+
+# endif
+
+# if NEED_PRINTF_LONG_DOUBLE
+
+/* Assuming x is finite and > 0:
+   Return an approximation for n with 10^n <= x < 10^(n+1).
+   The approximation is usually the right n, but may be off by 1 sometimes.  */
+static int
+floorlog10l (long double x)
+{
+  int exp;
+  long double y;
+  double z;
+  double l;
+
+  /* Split into exponential part and mantissa.  */
+  y = frexpl (x, &exp);
+  if (!(y >= 0.0L && y < 1.0L))
+    abort ();
+  if (y == 0.0L)
+    return INT_MIN;
+  if (y < 0.5L)
+    {
+      while (y < (1.0L / (1 << (GMP_LIMB_BITS / 2)) / (1 << (GMP_LIMB_BITS / 2))))
+	{
+	  y *= 1.0L * (1 << (GMP_LIMB_BITS / 2)) * (1 << (GMP_LIMB_BITS / 2));
+	  exp -= GMP_LIMB_BITS;
+	}
+      if (y < (1.0L / (1 << 16)))
+	{
+	  y *= 1.0L * (1 << 16);
+	  exp -= 16;
+	}
+      if (y < (1.0L / (1 << 8)))
+	{
+	  y *= 1.0L * (1 << 8);
+	  exp -= 8;
+	}
+      if (y < (1.0L / (1 << 4)))
+	{
+	  y *= 1.0L * (1 << 4);
+	  exp -= 4;
+	}
+      if (y < (1.0L / (1 << 2)))
+	{
+	  y *= 1.0L * (1 << 2);
+	  exp -= 2;
+	}
+      if (y < (1.0L / (1 << 1)))
+	{
+	  y *= 1.0L * (1 << 1);
+	  exp -= 1;
+	}
+    }
+  if (!(y >= 0.5L && y < 1.0L))
+    abort ();
+  /* Compute an approximation for l = log2(x) = exp + log2(y).  */
+  l = exp;
+  z = y;
+  if (z < 0.70710678118654752444)
+    {
+      z *= 1.4142135623730950488;
+      l -= 0.5;
+    }
+  if (z < 0.8408964152537145431)
+    {
+      z *= 1.1892071150027210667;
+      l -= 0.25;
+    }
+  if (z < 0.91700404320467123175)
+    {
+      z *= 1.0905077326652576592;
+      l -= 0.125;
+    }
+  if (z < 0.9576032806985736469)
+    {
+      z *= 1.0442737824274138403;
+      l -= 0.0625;
+    }
+  /* Now 0.95 <= z <= 1.01.  */
+  z = 1 - z;
+  /* log2(1-z) = 1/log(2) * (- z - z^2/2 - z^3/3 - z^4/4 - ...)
+     Four terms are enough to get an approximation with error < 10^-7.  */
+  l -= 1.4426950408889634074 * z * (1.0 + z * (0.5 + z * ((1.0 / 3) + z * 0.25)));
+  /* Finally multiply with log(2)/log(10), yields an approximation for
+     log10(x).  */
+  l *= 0.30102999566398119523;
+  /* Round down to the next integer.  */
+  return (int) l + (l < 0 ? -1 : 0);
+}
+
+# endif
+
+# if NEED_PRINTF_DOUBLE
+
+/* Assuming x is finite and > 0:
+   Return an approximation for n with 10^n <= x < 10^(n+1).
+   The approximation is usually the right n, but may be off by 1 sometimes.  */
+static int
+floorlog10 (double x)
+{
+  int exp;
+  double y;
+  double z;
+  double l;
+
+  /* Split into exponential part and mantissa.  */
+  y = frexp (x, &exp);
+  if (!(y >= 0.0 && y < 1.0))
+    abort ();
+  if (y == 0.0)
+    return INT_MIN;
+  if (y < 0.5)
+    {
+      while (y < (1.0 / (1 << (GMP_LIMB_BITS / 2)) / (1 << (GMP_LIMB_BITS / 2))))
+	{
+	  y *= 1.0 * (1 << (GMP_LIMB_BITS / 2)) * (1 << (GMP_LIMB_BITS / 2));
+	  exp -= GMP_LIMB_BITS;
+	}
+      if (y < (1.0 / (1 << 16)))
+	{
+	  y *= 1.0 * (1 << 16);
+	  exp -= 16;
+	}
+      if (y < (1.0 / (1 << 8)))
+	{
+	  y *= 1.0 * (1 << 8);
+	  exp -= 8;
+	}
+      if (y < (1.0 / (1 << 4)))
+	{
+	  y *= 1.0 * (1 << 4);
+	  exp -= 4;
+	}
+      if (y < (1.0 / (1 << 2)))
+	{
+	  y *= 1.0 * (1 << 2);
+	  exp -= 2;
+	}
+      if (y < (1.0 / (1 << 1)))
+	{
+	  y *= 1.0 * (1 << 1);
+	  exp -= 1;
+	}
+    }
+  if (!(y >= 0.5 && y < 1.0))
+    abort ();
+  /* Compute an approximation for l = log2(x) = exp + log2(y).  */
+  l = exp;
+  z = y;
+  if (z < 0.70710678118654752444)
+    {
+      z *= 1.4142135623730950488;
+      l -= 0.5;
+    }
+  if (z < 0.8408964152537145431)
+    {
+      z *= 1.1892071150027210667;
+      l -= 0.25;
+    }
+  if (z < 0.91700404320467123175)
+    {
+      z *= 1.0905077326652576592;
+      l -= 0.125;
+    }
+  if (z < 0.9576032806985736469)
+    {
+      z *= 1.0442737824274138403;
+      l -= 0.0625;
+    }
+  /* Now 0.95 <= z <= 1.01.  */
+  z = 1 - z;
+  /* log2(1-z) = 1/log(2) * (- z - z^2/2 - z^3/3 - z^4/4 - ...)
+     Four terms are enough to get an approximation with error < 10^-7.  */
+  l -= 1.4426950408889634074 * z * (1.0 + z * (0.5 + z * ((1.0 / 3) + z * 0.25)));
+  /* Finally multiply with log(2)/log(10), yields an approximation for
+     log10(x).  */
+  l *= 0.30102999566398119523;
+  /* Round down to the next integer.  */
+  return (int) l + (l < 0 ? -1 : 0);
+}
+
+# endif
+
+/* Tests whether a string of digits consists of exactly PRECISION zeroes and
+   a single '1' digit.  */
+static int
+is_borderline (const char *digits, size_t precision)
+{
+  for (; precision > 0; precision--, digits++)
+    if (*digits != '0')
+      return 0;
+  if (*digits != '1')
+    return 0;
+  digits++;
+  return *digits == '\0';
+}
+
+#endif
+
+DCHAR_T *
+VASNPRINTF (DCHAR_T *resultbuf, size_t *lengthp,
+	    const FCHAR_T *format, va_list args)
+{
+  DIRECTIVES d;
+  arguments a;
+
+  if (PRINTF_PARSE (format, &d, &a) < 0)
+    /* errno is already set.  */
+    return NULL;
+
+#define CLEANUP() \
+  free (d.dir);								\
+  if (a.arg)								\
+    free (a.arg);
+
+  if (PRINTF_FETCHARGS (args, &a) < 0)
+    {
+      CLEANUP ();
+      errno = EINVAL;
+      return NULL;
+    }
+
+  {
+    size_t buf_neededlength;
+    TCHAR_T *buf;
+    TCHAR_T *buf_malloced;
+    const FCHAR_T *cp;
+    size_t i;
+    DIRECTIVE *dp;
+    /* Output string accumulator.  */
+    DCHAR_T *result;
+    size_t allocated;
+    size_t length;
+
+    /* Allocate a small buffer that will hold a directive passed to
+       sprintf or snprintf.  */
+    buf_neededlength =
+      xsum4 (7, d.max_width_length, d.max_precision_length, 6);
+#if HAVE_ALLOCA
+    if (buf_neededlength < 4000 / sizeof (TCHAR_T))
+      {
+	buf = (TCHAR_T *) alloca (buf_neededlength * sizeof (TCHAR_T));
+	buf_malloced = NULL;
+      }
+    else
+#endif
+      {
+	size_t buf_memsize = xtimes (buf_neededlength, sizeof (TCHAR_T));
+	if (size_overflow_p (buf_memsize))
+	  goto out_of_memory_1;
+	buf = (TCHAR_T *) malloc (buf_memsize);
+	if (buf == NULL)
+	  goto out_of_memory_1;
+	buf_malloced = buf;
+      }
+
+    if (resultbuf != NULL)
+      {
+	result = resultbuf;
+	allocated = *lengthp;
+      }
+    else
+      {
+	result = NULL;
+	allocated = 0;
+      }
+    length = 0;
+    /* Invariants:
+       result is either == resultbuf or == NULL or malloc-allocated.
+       If length > 0, then result != NULL.  */
+
+    /* Ensures that allocated >= needed.  Aborts through a jump to
+       out_of_memory if needed is SIZE_MAX or otherwise too big.  */
+#define ENSURE_ALLOCATION(needed) \
+    if ((needed) > allocated)						     \
+      {									     \
+	size_t memory_size;						     \
+	DCHAR_T *memory;						     \
+									     \
+	allocated = (allocated > 0 ? xtimes (allocated, 2) : 12);	     \
+	if ((needed) > allocated)					     \
+	  allocated = (needed);						     \
+	memory_size = xtimes (allocated, sizeof (DCHAR_T));		     \
+	if (size_overflow_p (memory_size))				     \
+	  goto out_of_memory;						     \
+	if (result == resultbuf || result == NULL)			     \
+	  memory = (DCHAR_T *) malloc (memory_size);			     \
+	else								     \
+	  memory = (DCHAR_T *) realloc (result, memory_size);		     \
+	if (memory == NULL)						     \
+	  goto out_of_memory;						     \
+	if (result == resultbuf && length > 0)				     \
+	  DCHAR_CPY (memory, result, length);				     \
+	result = memory;						     \
+      }
+
+    for (cp = format, i = 0, dp = &d.dir[0]; ; cp = dp->dir_end, i++, dp++)
+      {
+	if (cp != dp->dir_start)
+	  {
+	    size_t n = dp->dir_start - cp;
+	    size_t augmented_length = xsum (length, n);
+
+	    ENSURE_ALLOCATION (augmented_length);
+	    /* This copies a piece of FCHAR_T[] into a DCHAR_T[].  Here we
+	       need that the format string contains only ASCII characters
+	       if FCHAR_T and DCHAR_T are not the same type.  */
+	    if (sizeof (FCHAR_T) == sizeof (DCHAR_T))
+	      {
+		DCHAR_CPY (result + length, (const DCHAR_T *) cp, n);
+		length = augmented_length;
+	      }
+	    else
+	      {
+		do
+		  result[length++] = (unsigned char) *cp++;
+		while (--n > 0);
+	      }
+	  }
+	if (i == d.count)
+	  break;
+
+	/* Execute a single directive.  */
+	if (dp->conversion == '%')
+	  {
+	    size_t augmented_length;
+
+	    if (!(dp->arg_index == ARG_NONE))
+	      abort ();
+	    augmented_length = xsum (length, 1);
+	    ENSURE_ALLOCATION (augmented_length);
+	    result[length] = '%';
+	    length = augmented_length;
+	  }
+	else
+	  {
+	    if (!(dp->arg_index != ARG_NONE))
+	      abort ();
+
+	    if (dp->conversion == 'n')
+	      {
+		switch (a.arg[dp->arg_index].type)
+		  {
+		  case TYPE_COUNT_SCHAR_POINTER:
+		    *a.arg[dp->arg_index].a.a_count_schar_pointer = length;
+		    break;
+		  case TYPE_COUNT_SHORT_POINTER:
+		    *a.arg[dp->arg_index].a.a_count_short_pointer = length;
+		    break;
+		  case TYPE_COUNT_INT_POINTER:
+		    *a.arg[dp->arg_index].a.a_count_int_pointer = length;
+		    break;
+		  case TYPE_COUNT_LONGINT_POINTER:
+		    *a.arg[dp->arg_index].a.a_count_longint_pointer = length;
+		    break;
+#if HAVE_LONG_LONG_INT
+		  case TYPE_COUNT_LONGLONGINT_POINTER:
+		    *a.arg[dp->arg_index].a.a_count_longlongint_pointer = length;
+		    break;
+#endif
+		  default:
+		    abort ();
+		  }
+	      }
+#if ENABLE_UNISTDIO
+	    /* The unistdio extensions.  */
+	    else if (dp->conversion == 'U')
+	      {
+		arg_type type = a.arg[dp->arg_index].type;
+		int flags = dp->flags;
+		int has_width;
+		size_t width;
+		int has_precision;
+		size_t precision;
+
+		has_width = 0;
+		width = 0;
+		if (dp->width_start != dp->width_end)
+		  {
+		    if (dp->width_arg_index != ARG_NONE)
+		      {
+			int arg;
+
+			if (!(a.arg[dp->width_arg_index].type == TYPE_INT))
+			  abort ();
+			arg = a.arg[dp->width_arg_index].a.a_int;
+			if (arg < 0)
+			  {
+			    /* "A negative field width is taken as a '-' flag
+			        followed by a positive field width."  */
+			    flags |= FLAG_LEFT;
+			    width = (unsigned int) (-arg);
+			  }
+			else
+			  width = arg;
+		      }
+		    else
+		      {
+			const FCHAR_T *digitp = dp->width_start;
+
+			do
+			  width = xsum (xtimes (width, 10), *digitp++ - '0');
+			while (digitp != dp->width_end);
+		      }
+		    has_width = 1;
+		  }
+
+		has_precision = 0;
+		precision = 0;
+		if (dp->precision_start != dp->precision_end)
+		  {
+		    if (dp->precision_arg_index != ARG_NONE)
+		      {
+			int arg;
+
+			if (!(a.arg[dp->precision_arg_index].type == TYPE_INT))
+			  abort ();
+			arg = a.arg[dp->precision_arg_index].a.a_int;
+			/* "A negative precision is taken as if the precision
+			    were omitted."  */
+			if (arg >= 0)
+			  {
+			    precision = arg;
+			    has_precision = 1;
+			  }
+		      }
+		    else
+		      {
+			const FCHAR_T *digitp = dp->precision_start + 1;
+
+			precision = 0;
+			while (digitp != dp->precision_end)
+			  precision = xsum (xtimes (precision, 10), *digitp++ - '0');
+			has_precision = 1;
+		      }
+		  }
+
+		switch (type)
+		  {
+		  case TYPE_U8_STRING:
+		    {
+		      const uint8_t *arg = a.arg[dp->arg_index].a.a_u8_string;
+		      const uint8_t *arg_end;
+		      size_t characters;
+
+		      if (has_precision)
+			{
+			  /* Use only PRECISION characters, from the left.  */
+			  arg_end = arg;
+			  characters = 0;
+			  for (; precision > 0; precision--)
+			    {
+			      int count = u8_strmblen (arg_end);
+			      if (count == 0)
+				break;
+			      if (count < 0)
+				{
+				  if (!(result == resultbuf || result == NULL))
+				    free (result);
+				  if (buf_malloced != NULL)
+				    free (buf_malloced);
+				  CLEANUP ();
+				  errno = EILSEQ;
+				  return NULL;
+				}
+			      arg_end += count;
+			      characters++;
+			    }
+			}
+		      else if (has_width)
+			{
+			  /* Use the entire string, and count the number of
+			     characters.  */
+			  arg_end = arg;
+			  characters = 0;
+			  for (;;)
+			    {
+			      int count = u8_strmblen (arg_end);
+			      if (count == 0)
+				break;
+			      if (count < 0)
+				{
+				  if (!(result == resultbuf || result == NULL))
+				    free (result);
+				  if (buf_malloced != NULL)
+				    free (buf_malloced);
+				  CLEANUP ();
+				  errno = EILSEQ;
+				  return NULL;
+				}
+			      arg_end += count;
+			      characters++;
+			    }
+			}
+		      else
+			{
+			  /* Use the entire string.  */
+			  arg_end = arg + u8_strlen (arg);
+			  /* The number of characters doesn't matter.  */
+			  characters = 0;
+			}
+
+		      if (has_width && width > characters
+			  && !(dp->flags & FLAG_LEFT))
+			{
+			  size_t n = width - characters;
+			  ENSURE_ALLOCATION (xsum (length, n));
+			  DCHAR_SET (result + length, ' ', n);
+			  length += n;
+			}
+
+# if DCHAR_IS_UINT8_T
+		      {
+			size_t n = arg_end - arg;
+			ENSURE_ALLOCATION (xsum (length, n));
+			DCHAR_CPY (result + length, arg, n);
+			length += n;
+		      }
+# else
+		      { /* Convert.  */
+			DCHAR_T *converted = result + length;
+			size_t converted_len = allocated - length;
+#  if DCHAR_IS_TCHAR
+			/* Convert from UTF-8 to locale encoding.  */
+			converted =
+			  u8_conv_to_encoding (locale_charset (),
+					       iconveh_question_mark,
+					       arg, arg_end - arg, NULL,
+					       converted, &converted_len);
+#  else
+			/* Convert from UTF-8 to UTF-16/UTF-32.  */
+			converted =
+			  U8_TO_DCHAR (arg, arg_end - arg,
+				       converted, &converted_len);
+#  endif
+			if (converted == NULL)
+			  {
+			    int saved_errno = errno;
+			    if (!(result == resultbuf || result == NULL))
+			      free (result);
+			    if (buf_malloced != NULL)
+			      free (buf_malloced);
+			    CLEANUP ();
+			    errno = saved_errno;
+			    return NULL;
+			  }
+			if (converted != result + length)
+			  {
+			    ENSURE_ALLOCATION (xsum (length, converted_len));
+			    DCHAR_CPY (result + length, converted, converted_len);
+			    free (converted);
+			  }
+			length += converted_len;
+		      }
+# endif
+
+		      if (has_width && width > characters
+			  && (dp->flags & FLAG_LEFT))
+			{
+			  size_t n = width - characters;
+			  ENSURE_ALLOCATION (xsum (length, n));
+			  DCHAR_SET (result + length, ' ', n);
+			  length += n;
+			}
+		    }
+		    break;
+
+		  case TYPE_U16_STRING:
+		    {
+		      const uint16_t *arg = a.arg[dp->arg_index].a.a_u16_string;
+		      const uint16_t *arg_end;
+		      size_t characters;
+
+		      if (has_precision)
+			{
+			  /* Use only PRECISION characters, from the left.  */
+			  arg_end = arg;
+			  characters = 0;
+			  for (; precision > 0; precision--)
+			    {
+			      int count = u16_strmblen (arg_end);
+			      if (count == 0)
+				break;
+			      if (count < 0)
+				{
+				  if (!(result == resultbuf || result == NULL))
+				    free (result);
+				  if (buf_malloced != NULL)
+				    free (buf_malloced);
+				  CLEANUP ();
+				  errno = EILSEQ;
+				  return NULL;
+				}
+			      arg_end += count;
+			      characters++;
+			    }
+			}
+		      else if (has_width)
+			{
+			  /* Use the entire string, and count the number of
+			     characters.  */
+			  arg_end = arg;
+			  characters = 0;
+			  for (;;)
+			    {
+			      int count = u16_strmblen (arg_end);
+			      if (count == 0)
+				break;
+			      if (count < 0)
+				{
+				  if (!(result == resultbuf || result == NULL))
+				    free (result);
+				  if (buf_malloced != NULL)
+				    free (buf_malloced);
+				  CLEANUP ();
+				  errno = EILSEQ;
+				  return NULL;
+				}
+			      arg_end += count;
+			      characters++;
+			    }
+			}
+		      else
+			{
+			  /* Use the entire string.  */
+			  arg_end = arg + u16_strlen (arg);
+			  /* The number of characters doesn't matter.  */
+			  characters = 0;
+			}
+
+		      if (has_width && width > characters
+			  && !(dp->flags & FLAG_LEFT))
+			{
+			  size_t n = width - characters;
+			  ENSURE_ALLOCATION (xsum (length, n));
+			  DCHAR_SET (result + length, ' ', n);
+			  length += n;
+			}
+
+# if DCHAR_IS_UINT16_T
+		      {
+			size_t n = arg_end - arg;
+			ENSURE_ALLOCATION (xsum (length, n));
+			DCHAR_CPY (result + length, arg, n);
+			length += n;
+		      }
+# else
+		      { /* Convert.  */
+			DCHAR_T *converted = result + length;
+			size_t converted_len = allocated - length;
+#  if DCHAR_IS_TCHAR
+			/* Convert from UTF-16 to locale encoding.  */
+			converted =
+			  u16_conv_to_encoding (locale_charset (),
+						iconveh_question_mark,
+						arg, arg_end - arg, NULL,
+						converted, &converted_len);
+#  else
+			/* Convert from UTF-16 to UTF-8/UTF-32.  */
+			converted =
+			  U16_TO_DCHAR (arg, arg_end - arg,
+					converted, &converted_len);
+#  endif
+			if (converted == NULL)
+			  {
+			    int saved_errno = errno;
+			    if (!(result == resultbuf || result == NULL))
+			      free (result);
+			    if (buf_malloced != NULL)
+			      free (buf_malloced);
+			    CLEANUP ();
+			    errno = saved_errno;
+			    return NULL;
+			  }
+			if (converted != result + length)
+			  {
+			    ENSURE_ALLOCATION (xsum (length, converted_len));
+			    DCHAR_CPY (result + length, converted, converted_len);
+			    free (converted);
+			  }
+			length += converted_len;
+		      }
+# endif
+
+		      if (has_width && width > characters
+			  && (dp->flags & FLAG_LEFT))
+			{
+			  size_t n = width - characters;
+			  ENSURE_ALLOCATION (xsum (length, n));
+			  DCHAR_SET (result + length, ' ', n);
+			  length += n;
+			}
+		    }
+		    break;
+
+		  case TYPE_U32_STRING:
+		    {
+		      const uint32_t *arg = a.arg[dp->arg_index].a.a_u32_string;
+		      const uint32_t *arg_end;
+		      size_t characters;
+
+		      if (has_precision)
+			{
+			  /* Use only PRECISION characters, from the left.  */
+			  arg_end = arg;
+			  characters = 0;
+			  for (; precision > 0; precision--)
+			    {
+			      int count = u32_strmblen (arg_end);
+			      if (count == 0)
+				break;
+			      if (count < 0)
+				{
+				  if (!(result == resultbuf || result == NULL))
+				    free (result);
+				  if (buf_malloced != NULL)
+				    free (buf_malloced);
+				  CLEANUP ();
+				  errno = EILSEQ;
+				  return NULL;
+				}
+			      arg_end += count;
+			      characters++;
+			    }
+			}
+		      else if (has_width)
+			{
+			  /* Use the entire string, and count the number of
+			     characters.  */
+			  arg_end = arg;
+			  characters = 0;
+			  for (;;)
+			    {
+			      int count = u32_strmblen (arg_end);
+			      if (count == 0)
+				break;
+			      if (count < 0)
+				{
+				  if (!(result == resultbuf || result == NULL))
+				    free (result);
+				  if (buf_malloced != NULL)
+				    free (buf_malloced);
+				  CLEANUP ();
+				  errno = EILSEQ;
+				  return NULL;
+				}
+			      arg_end += count;
+			      characters++;
+			    }
+			}
+		      else
+			{
+			  /* Use the entire string.  */
+			  arg_end = arg + u32_strlen (arg);
+			  /* The number of characters doesn't matter.  */
+			  characters = 0;
+			}
+
+		      if (has_width && width > characters
+			  && !(dp->flags & FLAG_LEFT))
+			{
+			  size_t n = width - characters;
+			  ENSURE_ALLOCATION (xsum (length, n));
+			  DCHAR_SET (result + length, ' ', n);
+			  length += n;
+			}
+
+# if DCHAR_IS_UINT32_T
+		      {
+			size_t n = arg_end - arg;
+			ENSURE_ALLOCATION (xsum (length, n));
+			DCHAR_CPY (result + length, arg, n);
+			length += n;
+		      }
+# else
+		      { /* Convert.  */
+			DCHAR_T *converted = result + length;
+			size_t converted_len = allocated - length;
+#  if DCHAR_IS_TCHAR
+			/* Convert from UTF-32 to locale encoding.  */
+			converted =
+			  u32_conv_to_encoding (locale_charset (),
+						iconveh_question_mark,
+						arg, arg_end - arg, NULL,
+						converted, &converted_len);
+#  else
+			/* Convert from UTF-32 to UTF-8/UTF-16.  */
+			converted =
+			  U32_TO_DCHAR (arg, arg_end - arg,
+					converted, &converted_len);
+#  endif
+			if (converted == NULL)
+			  {
+			    int saved_errno = errno;
+			    if (!(result == resultbuf || result == NULL))
+			      free (result);
+			    if (buf_malloced != NULL)
+			      free (buf_malloced);
+			    CLEANUP ();
+			    errno = saved_errno;
+			    return NULL;
+			  }
+			if (converted != result + length)
+			  {
+			    ENSURE_ALLOCATION (xsum (length, converted_len));
+			    DCHAR_CPY (result + length, converted, converted_len);
+			    free (converted);
+			  }
+			length += converted_len;
+		      }
+# endif
+
+		      if (has_width && width > characters
+			  && (dp->flags & FLAG_LEFT))
+			{
+			  size_t n = width - characters;
+			  ENSURE_ALLOCATION (xsum (length, n));
+			  DCHAR_SET (result + length, ' ', n);
+			  length += n;
+			}
+		    }
+		    break;
+
+		  default:
+		    abort ();
+		  }
+	      }
+#endif
+#if (!USE_SNPRINTF || (NEED_PRINTF_DIRECTIVE_LS && !defined IN_LIBINTL)) && HAVE_WCHAR_T
+	    else if (dp->conversion == 's'
+# if WIDE_CHAR_VERSION
+		     && a.arg[dp->arg_index].type != TYPE_WIDE_STRING
+# else
+		     && a.arg[dp->arg_index].type == TYPE_WIDE_STRING
+# endif
+		    )
+	      {
+		/* The normal handling of the 's' directive below requires
+		   allocating a temporary buffer.  The determination of its
+		   length (tmp_length), in the case when a precision is
+		   specified, below requires a conversion between a char[]
+		   string and a wchar_t[] wide string.  It could be done, but
+		   we have no guarantee that the implementation of sprintf will
+		   use the exactly same algorithm.  Without this guarantee, it
+		   is possible to have buffer overrun bugs.  In order to avoid
+		   such bugs, we implement the entire processing of the 's'
+		   directive ourselves.  */
+		int flags = dp->flags;
+		int has_width;
+		size_t width;
+		int has_precision;
+		size_t precision;
+
+		has_width = 0;
+		width = 0;
+		if (dp->width_start != dp->width_end)
+		  {
+		    if (dp->width_arg_index != ARG_NONE)
+		      {
+			int arg;
+
+			if (!(a.arg[dp->width_arg_index].type == TYPE_INT))
+			  abort ();
+			arg = a.arg[dp->width_arg_index].a.a_int;
+			if (arg < 0)
+			  {
+			    /* "A negative field width is taken as a '-' flag
+			        followed by a positive field width."  */
+			    flags |= FLAG_LEFT;
+			    width = (unsigned int) (-arg);
+			  }
+			else
+			  width = arg;
+		      }
+		    else
+		      {
+			const FCHAR_T *digitp = dp->width_start;
+
+			do
+			  width = xsum (xtimes (width, 10), *digitp++ - '0');
+			while (digitp != dp->width_end);
+		      }
+		    has_width = 1;
+		  }
+
+		has_precision = 0;
+		precision = 6;
+		if (dp->precision_start != dp->precision_end)
+		  {
+		    if (dp->precision_arg_index != ARG_NONE)
+		      {
+			int arg;
+
+			if (!(a.arg[dp->precision_arg_index].type == TYPE_INT))
+			  abort ();
+			arg = a.arg[dp->precision_arg_index].a.a_int;
+			/* "A negative precision is taken as if the precision
+			    were omitted."  */
+			if (arg >= 0)
+			  {
+			    precision = arg;
+			    has_precision = 1;
+			  }
+		      }
+		    else
+		      {
+			const FCHAR_T *digitp = dp->precision_start + 1;
+
+			precision = 0;
+			while (digitp != dp->precision_end)
+			  precision = xsum (xtimes (precision, 10), *digitp++ - '0');
+			has_precision = 1;
+		      }
+		  }
+
+# if WIDE_CHAR_VERSION
+		/* %s in vasnwprintf.  See the specification of fwprintf.  */
+		{
+		  const char *arg = a.arg[dp->arg_index].a.a_string;
+		  const char *arg_end;
+		  size_t characters;
+
+		  if (has_precision)
+		    {
+		      /* Use only as many bytes as needed to produce PRECISION
+			 wide characters, from the left.  */
+#  if HAVE_MBRTOWC
+		      mbstate_t state;
+		      memset (&state, '\0', sizeof (mbstate_t));
+#  endif
+		      arg_end = arg;
+		      characters = 0;
+		      for (; precision > 0; precision--)
+			{
+			  int count;
+#  if HAVE_MBRTOWC
+			  count = mbrlen (arg_end, MB_CUR_MAX, &state);
+#  else
+			  count = mblen (arg_end, MB_CUR_MAX);
+#  endif
+			  if (count == 0)
+			    /* Found the terminating NUL.  */
+			    break;
+			  if (count < 0)
+			    {
+			      /* Invalid or incomplete multibyte character.  */
+			      if (!(result == resultbuf || result == NULL))
+				free (result);
+			      if (buf_malloced != NULL)
+				free (buf_malloced);
+			      CLEANUP ();
+			      errno = EILSEQ;
+			      return NULL;
+			    }
+			  arg_end += count;
+			  characters++;
+			}
+		    }
+		  else if (has_width)
+		    {
+		      /* Use the entire string, and count the number of wide
+			 characters.  */
+#  if HAVE_MBRTOWC
+		      mbstate_t state;
+		      memset (&state, '\0', sizeof (mbstate_t));
+#  endif
+		      arg_end = arg;
+		      characters = 0;
+		      for (;;)
+			{
+			  int count;
+#  if HAVE_MBRTOWC
+			  count = mbrlen (arg_end, MB_CUR_MAX, &state);
+#  else
+			  count = mblen (arg_end, MB_CUR_MAX);
+#  endif
+			  if (count == 0)
+			    /* Found the terminating NUL.  */
+			    break;
+			  if (count < 0)
+			    {
+			      /* Invalid or incomplete multibyte character.  */
+			      if (!(result == resultbuf || result == NULL))
+				free (result);
+			      if (buf_malloced != NULL)
+				free (buf_malloced);
+			      CLEANUP ();
+			      errno = EILSEQ;
+			      return NULL;
+			    }
+			  arg_end += count;
+			  characters++;
+			}
+		    }
+		  else
+		    {
+		      /* Use the entire string.  */
+		      arg_end = arg + strlen (arg);
+		      /* The number of characters doesn't matter.  */
+		      characters = 0;
+		    }
+
+		  if (has_width && width > characters
+		      && !(dp->flags & FLAG_LEFT))
+		    {
+		      size_t n = width - characters;
+		      ENSURE_ALLOCATION (xsum (length, n));
+		      DCHAR_SET (result + length, ' ', n);
+		      length += n;
+		    }
+
+		  if (has_precision || has_width)
+		    {
+		      /* We know the number of wide characters in advance.  */
+		      size_t remaining;
+#  if HAVE_MBRTOWC
+		      mbstate_t state;
+		      memset (&state, '\0', sizeof (mbstate_t));
+#  endif
+		      ENSURE_ALLOCATION (xsum (length, characters));
+		      for (remaining = characters; remaining > 0; remaining--)
+			{
+			  wchar_t wc;
+			  int count;
+#  if HAVE_MBRTOWC
+			  count = mbrtowc (&wc, arg, arg_end - arg, &state);
+#  else
+			  count = mbtowc (&wc, arg, arg_end - arg);
+#  endif
+			  if (count <= 0)
+			    /* mbrtowc not consistent with mbrlen, or mbtowc
+			       not consistent with mblen.  */
+			    abort ();
+			  result[length++] = wc;
+			  arg += count;
+			}
+		      if (!(arg == arg_end))
+			abort ();
+		    }
+		  else
+		    {
+#  if HAVE_MBRTOWC
+		      mbstate_t state;
+		      memset (&state, '\0', sizeof (mbstate_t));
+#  endif
+		      while (arg < arg_end)
+			{
+			  wchar_t wc;
+			  int count;
+#  if HAVE_MBRTOWC
+			  count = mbrtowc (&wc, arg, arg_end - arg, &state);
+#  else
+			  count = mbtowc (&wc, arg, arg_end - arg);
+#  endif
+			  if (count <= 0)
+			    /* mbrtowc not consistent with mbrlen, or mbtowc
+			       not consistent with mblen.  */
+			    abort ();
+			  ENSURE_ALLOCATION (xsum (length, 1));
+			  result[length++] = wc;
+			  arg += count;
+			}
+		    }
+
+		  if (has_width && width > characters
+		      && (dp->flags & FLAG_LEFT))
+		    {
+		      size_t n = width - characters;
+		      ENSURE_ALLOCATION (xsum (length, n));
+		      DCHAR_SET (result + length, ' ', n);
+		      length += n;
+		    }
+		}
+# else
+		/* %ls in vasnprintf.  See the specification of fprintf.  */
+		{
+		  const wchar_t *arg = a.arg[dp->arg_index].a.a_wide_string;
+		  const wchar_t *arg_end;
+		  size_t characters;
+#  if !DCHAR_IS_TCHAR
+		  /* This code assumes that TCHAR_T is 'char'.  */
+		  typedef int TCHAR_T_verify[2 * (sizeof (TCHAR_T) == 1) - 1];
+		  TCHAR_T *tmpsrc;
+		  DCHAR_T *tmpdst;
+		  size_t tmpdst_len;
+#  endif
+		  size_t w;
+
+		  if (has_precision)
+		    {
+		      /* Use only as many wide characters as needed to produce
+			 at most PRECISION bytes, from the left.  */
+#  if HAVE_WCRTOMB
+		      mbstate_t state;
+		      memset (&state, '\0', sizeof (mbstate_t));
+#  endif
+		      arg_end = arg;
+		      characters = 0;
+		      while (precision > 0)
+			{
+			  char buf[64]; /* Assume MB_CUR_MAX <= 64.  */
+			  int count;
+
+			  if (*arg_end == 0)
+			    /* Found the terminating null wide character.  */
+			    break;
+#  if HAVE_WCRTOMB
+			  count = wcrtomb (buf, *arg_end, &state);
+#  else
+			  count = wctomb (buf, *arg_end);
+#  endif
+			  if (count < 0)
+			    {
+			      /* Cannot convert.  */
+			      if (!(result == resultbuf || result == NULL))
+				free (result);
+			      if (buf_malloced != NULL)
+				free (buf_malloced);
+			      CLEANUP ();
+			      errno = EILSEQ;
+			      return NULL;
+			    }
+			  if (precision < count)
+			    break;
+			  arg_end++;
+			  characters += count;
+			  precision -= count;
+			}
+		    }
+#  if DCHAR_IS_TCHAR
+		  else if (has_width)
+#  else
+		  else
+#  endif
+		    {
+		      /* Use the entire string, and count the number of
+			 bytes.  */
+#  if HAVE_WCRTOMB
+		      mbstate_t state;
+		      memset (&state, '\0', sizeof (mbstate_t));
+#  endif
+		      arg_end = arg;
+		      characters = 0;
+		      for (;;)
+			{
+			  char buf[64]; /* Assume MB_CUR_MAX <= 64.  */
+			  int count;
+
+			  if (*arg_end == 0)
+			    /* Found the terminating null wide character.  */
+			    break;
+#  if HAVE_WCRTOMB
+			  count = wcrtomb (buf, *arg_end, &state);
+#  else
+			  count = wctomb (buf, *arg_end);
+#  endif
+			  if (count < 0)
+			    {
+			      /* Cannot convert.  */
+			      if (!(result == resultbuf || result == NULL))
+				free (result);
+			      if (buf_malloced != NULL)
+				free (buf_malloced);
+			      CLEANUP ();
+			      errno = EILSEQ;
+			      return NULL;
+			    }
+			  arg_end++;
+			  characters += count;
+			}
+		    }
+#  if DCHAR_IS_TCHAR
+		  else
+		    {
+		      /* Use the entire string.  */
+		      arg_end = arg + local_wcslen (arg);
+		      /* The number of bytes doesn't matter.  */
+		      characters = 0;
+		    }
+#  endif
+
+#  if !DCHAR_IS_TCHAR
+		  /* Convert the string into a piece of temporary memory.  */
+		  tmpsrc = (TCHAR_T *) malloc (characters * sizeof (TCHAR_T));
+		  if (tmpsrc == NULL)
+		    goto out_of_memory;
+		  {
+		    TCHAR_T *tmpptr = tmpsrc;
+		    size_t remaining;
+#   if HAVE_WCRTOMB
+		    mbstate_t state;
+		    memset (&state, '\0', sizeof (mbstate_t));
+#   endif
+		    for (remaining = characters; remaining > 0; )
+		      {
+			char buf[64]; /* Assume MB_CUR_MAX <= 64.  */
+			int count;
+
+			if (*arg == 0)
+			  abort ();
+#   if HAVE_WCRTOMB
+			count = wcrtomb (buf, *arg, &state);
+#   else
+			count = wctomb (buf, *arg);
+#   endif
+			if (count <= 0)
+			  /* Inconsistency.  */
+			  abort ();
+			memcpy (tmpptr, buf, count);
+			tmpptr += count;
+			arg++;
+			remaining -= count;
+		      }
+		    if (!(arg == arg_end))
+		      abort ();
+		  }
+
+		  /* Convert from TCHAR_T[] to DCHAR_T[].  */
+		  tmpdst =
+		    DCHAR_CONV_FROM_ENCODING (locale_charset (),
+					      iconveh_question_mark,
+					      tmpsrc, characters,
+					      NULL,
+					      NULL, &tmpdst_len);
+		  if (tmpdst == NULL)
+		    {
+		      int saved_errno = errno;
+		      free (tmpsrc);
+		      if (!(result == resultbuf || result == NULL))
+			free (result);
+		      if (buf_malloced != NULL)
+			free (buf_malloced);
+		      CLEANUP ();
+		      errno = saved_errno;
+		      return NULL;
+		    }
+		  free (tmpsrc);
+#  endif
+
+		  if (has_width)
+		    {
+#  if ENABLE_UNISTDIO
+		      /* Outside POSIX, it's preferrable to compare the width
+			 against the number of _characters_ of the converted
+			 value.  */
+		      w = DCHAR_MBSNLEN (result + length, characters);
+#  else
+		      /* The width is compared against the number of _bytes_
+			 of the converted value, says POSIX.  */
+		      w = characters;
+#  endif
+		    }
+		  else
+		    /* w doesn't matter.  */
+		    w = 0;
+
+		  if (has_width && width > w
+		      && !(dp->flags & FLAG_LEFT))
+		    {
+		      size_t n = width - w;
+		      ENSURE_ALLOCATION (xsum (length, n));
+		      DCHAR_SET (result + length, ' ', n);
+		      length += n;
+		    }
+
+#  if DCHAR_IS_TCHAR
+		  if (has_precision || has_width)
+		    {
+		      /* We know the number of bytes in advance.  */
+		      size_t remaining;
+#   if HAVE_WCRTOMB
+		      mbstate_t state;
+		      memset (&state, '\0', sizeof (mbstate_t));
+#   endif
+		      ENSURE_ALLOCATION (xsum (length, characters));
+		      for (remaining = characters; remaining > 0; )
+			{
+			  char buf[64]; /* Assume MB_CUR_MAX <= 64.  */
+			  int count;
+
+			  if (*arg == 0)
+			    abort ();
+#   if HAVE_WCRTOMB
+			  count = wcrtomb (buf, *arg, &state);
+#   else
+			  count = wctomb (buf, *arg);
+#   endif
+			  if (count <= 0)
+			    /* Inconsistency.  */
+			    abort ();
+			  memcpy (result + length, buf, count);
+			  length += count;
+			  arg++;
+			  remaining -= count;
+			}
+		      if (!(arg == arg_end))
+			abort ();
+		    }
+		  else
+		    {
+#   if HAVE_WCRTOMB
+		      mbstate_t state;
+		      memset (&state, '\0', sizeof (mbstate_t));
+#   endif
+		      while (arg < arg_end)
+			{
+			  char buf[64]; /* Assume MB_CUR_MAX <= 64.  */
+			  int count;
+
+			  if (*arg == 0)
+			    abort ();
+#   if HAVE_WCRTOMB
+			  count = wcrtomb (buf, *arg, &state);
+#   else
+			  count = wctomb (buf, *arg);
+#   endif
+			  if (count <= 0)
+			    /* Inconsistency.  */
+			    abort ();
+			  ENSURE_ALLOCATION (xsum (length, count));
+			  memcpy (result + length, buf, count);
+			  length += count;
+			  arg++;
+			}
+		    }
+#  else
+		  ENSURE_ALLOCATION (xsum (length, tmpdst_len));
+		  DCHAR_CPY (result + length, tmpdst, tmpdst_len);
+		  free (tmpdst);
+		  length += tmpdst_len;
+#  endif
+
+		  if (has_width && width > w
+		      && (dp->flags & FLAG_LEFT))
+		    {
+		      size_t n = width - w;
+		      ENSURE_ALLOCATION (xsum (length, n));
+		      DCHAR_SET (result + length, ' ', n);
+		      length += n;
+		    }
+		}
+	      }
+# endif
+#endif
+#if (NEED_PRINTF_DIRECTIVE_A || NEED_PRINTF_LONG_DOUBLE || NEED_PRINTF_DOUBLE) && !defined IN_LIBINTL
+	    else if ((dp->conversion == 'a' || dp->conversion == 'A')
+# if !(NEED_PRINTF_DIRECTIVE_A || (NEED_PRINTF_LONG_DOUBLE && NEED_PRINTF_DOUBLE))
+		     && (0
+#  if NEED_PRINTF_DOUBLE
+			 || a.arg[dp->arg_index].type == TYPE_DOUBLE
+#  endif
+#  if NEED_PRINTF_LONG_DOUBLE
+			 || a.arg[dp->arg_index].type == TYPE_LONGDOUBLE
+#  endif
+			)
+# endif
+		    )
+	      {
+		arg_type type = a.arg[dp->arg_index].type;
+		int flags = dp->flags;
+		int has_width;
+		size_t width;
+		int has_precision;
+		size_t precision;
+		size_t tmp_length;
+		DCHAR_T tmpbuf[700];
+		DCHAR_T *tmp;
+		DCHAR_T *pad_ptr;
+		DCHAR_T *p;
+
+		has_width = 0;
+		width = 0;
+		if (dp->width_start != dp->width_end)
+		  {
+		    if (dp->width_arg_index != ARG_NONE)
+		      {
+			int arg;
+
+			if (!(a.arg[dp->width_arg_index].type == TYPE_INT))
+			  abort ();
+			arg = a.arg[dp->width_arg_index].a.a_int;
+			if (arg < 0)
+			  {
+			    /* "A negative field width is taken as a '-' flag
+			        followed by a positive field width."  */
+			    flags |= FLAG_LEFT;
+			    width = (unsigned int) (-arg);
+			  }
+			else
+			  width = arg;
+		      }
+		    else
+		      {
+			const FCHAR_T *digitp = dp->width_start;
+
+			do
+			  width = xsum (xtimes (width, 10), *digitp++ - '0');
+			while (digitp != dp->width_end);
+		      }
+		    has_width = 1;
+		  }
+
+		has_precision = 0;
+		precision = 0;
+		if (dp->precision_start != dp->precision_end)
+		  {
+		    if (dp->precision_arg_index != ARG_NONE)
+		      {
+			int arg;
+
+			if (!(a.arg[dp->precision_arg_index].type == TYPE_INT))
+			  abort ();
+			arg = a.arg[dp->precision_arg_index].a.a_int;
+			/* "A negative precision is taken as if the precision
+			    were omitted."  */
+			if (arg >= 0)
+			  {
+			    precision = arg;
+			    has_precision = 1;
+			  }
+		      }
+		    else
+		      {
+			const FCHAR_T *digitp = dp->precision_start + 1;
+
+			precision = 0;
+			while (digitp != dp->precision_end)
+			  precision = xsum (xtimes (precision, 10), *digitp++ - '0');
+			has_precision = 1;
+		      }
+		  }
+
+		/* Allocate a temporary buffer of sufficient size.  */
+		if (type == TYPE_LONGDOUBLE)
+		  tmp_length =
+		    (unsigned int) ((LDBL_DIG + 1)
+				    * 0.831 /* decimal -> hexadecimal */
+				   )
+		    + 1; /* turn floor into ceil */
+		else
+		  tmp_length =
+		    (unsigned int) ((DBL_DIG + 1)
+				    * 0.831 /* decimal -> hexadecimal */
+				   )
+		    + 1; /* turn floor into ceil */
+		if (tmp_length < precision)
+		  tmp_length = precision;
+		/* Account for sign, decimal point etc. */
+		tmp_length = xsum (tmp_length, 12);
+
+		if (tmp_length < width)
+		  tmp_length = width;
+
+		tmp_length = xsum (tmp_length, 1); /* account for trailing NUL */
+
+		if (tmp_length <= sizeof (tmpbuf) / sizeof (DCHAR_T))
+		  tmp = tmpbuf;
+		else
+		  {
+		    size_t tmp_memsize = xtimes (tmp_length, sizeof (DCHAR_T));
+
+		    if (size_overflow_p (tmp_memsize))
+		      /* Overflow, would lead to out of memory.  */
+		      goto out_of_memory;
+		    tmp = (DCHAR_T *) malloc (tmp_memsize);
+		    if (tmp == NULL)
+		      /* Out of memory.  */
+		      goto out_of_memory;
+		  }
+
+		pad_ptr = NULL;
+		p = tmp;
+		if (type == TYPE_LONGDOUBLE)
+		  {
+# if NEED_PRINTF_DIRECTIVE_A || NEED_PRINTF_LONG_DOUBLE
+		    long double arg = a.arg[dp->arg_index].a.a_longdouble;
+
+		    if (isnanl (arg))
+		      {
+			if (dp->conversion == 'A')
+			  {
+			    *p++ = 'N'; *p++ = 'A'; *p++ = 'N';
+			  }
+			else
+			  {
+			    *p++ = 'n'; *p++ = 'a'; *p++ = 'n';
+			  }
+		      }
+		    else
+		      {
+			int sign = 0;
+			DECL_LONG_DOUBLE_ROUNDING
+
+			BEGIN_LONG_DOUBLE_ROUNDING ();
+
+			if (signbit (arg)) /* arg < 0.0L or negative zero */
+			  {
+			    sign = -1;
+			    arg = -arg;
+			  }
+
+			if (sign < 0)
+			  *p++ = '-';
+			else if (flags & FLAG_SHOWSIGN)
+			  *p++ = '+';
+			else if (flags & FLAG_SPACE)
+			  *p++ = ' ';
+
+			if (arg > 0.0L && arg + arg == arg)
+			  {
+			    if (dp->conversion == 'A')
+			      {
+				*p++ = 'I'; *p++ = 'N'; *p++ = 'F';
+			      }
+			    else
+			      {
+				*p++ = 'i'; *p++ = 'n'; *p++ = 'f';
+			      }
+			  }
+			else
+			  {
+			    int exponent;
+			    long double mantissa;
+
+			    if (arg > 0.0L)
+			      mantissa = printf_frexpl (arg, &exponent);
+			    else
+			      {
+				exponent = 0;
+				mantissa = 0.0L;
+			      }
+
+			    if (has_precision
+				&& precision < (unsigned int) ((LDBL_DIG + 1) * 0.831) + 1)
+			      {
+				/* Round the mantissa.  */
+				long double tail = mantissa;
+				size_t q;
+
+				for (q = precision; ; q--)
+				  {
+				    int digit = (int) tail;
+				    tail -= digit;
+				    if (q == 0)
+				      {
+					if (digit & 1 ? tail >= 0.5L : tail > 0.5L)
+					  tail = 1 - tail;
+					else
+					  tail = - tail;
+					break;
+				      }
+				    tail *= 16.0L;
+				  }
+				if (tail != 0.0L)
+				  for (q = precision; q > 0; q--)
+				    tail *= 0.0625L;
+				mantissa += tail;
+			      }
+
+			    *p++ = '0';
+			    *p++ = dp->conversion - 'A' + 'X';
+			    pad_ptr = p;
+			    {
+			      int digit;
+
+			      digit = (int) mantissa;
+			      mantissa -= digit;
+			      *p++ = '0' + digit;
+			      if ((flags & FLAG_ALT)
+				  || mantissa > 0.0L || precision > 0)
+				{
+				  *p++ = decimal_point_char ();
+				  /* This loop terminates because we assume
+				     that FLT_RADIX is a power of 2.  */
+				  while (mantissa > 0.0L)
+				    {
+				      mantissa *= 16.0L;
+				      digit = (int) mantissa;
+				      mantissa -= digit;
+				      *p++ = digit
+					     + (digit < 10
+						? '0'
+						: dp->conversion - 10);
+				      if (precision > 0)
+					precision--;
+				    }
+				  while (precision > 0)
+				    {
+				      *p++ = '0';
+				      precision--;
+				    }
+				}
+			      }
+			      *p++ = dp->conversion - 'A' + 'P';
+#  if WIDE_CHAR_VERSION
+			      {
+				static const wchar_t decimal_format[] =
+				  { '%', '+', 'd', '\0' };
+				SNPRINTF (p, 6 + 1, decimal_format, exponent);
+			      }
+			      while (*p != '\0')
+				p++;
+#  else
+			      if (sizeof (DCHAR_T) == 1)
+				{
+				  sprintf ((char *) p, "%+d", exponent);
+				  while (*p != '\0')
+				    p++;
+				}
+			      else
+				{
+				  char expbuf[6 + 1];
+				  const char *ep;
+				  sprintf (expbuf, "%+d", exponent);
+				  for (ep = expbuf; (*p = *ep) != '\0'; ep++)
+				    p++;
+				}
+#  endif
+			  }
+
+			END_LONG_DOUBLE_ROUNDING ();
+		      }
+# else
+		    abort ();
+# endif
+		  }
+		else
+		  {
+# if NEED_PRINTF_DIRECTIVE_A || NEED_PRINTF_DOUBLE
+		    double arg = a.arg[dp->arg_index].a.a_double;
+
+		    if (isnand (arg))
+		      {
+			if (dp->conversion == 'A')
+			  {
+			    *p++ = 'N'; *p++ = 'A'; *p++ = 'N';
+			  }
+			else
+			  {
+			    *p++ = 'n'; *p++ = 'a'; *p++ = 'n';
+			  }
+		      }
+		    else
+		      {
+			int sign = 0;
+
+			if (signbit (arg)) /* arg < 0.0 or negative zero */
+			  {
+			    sign = -1;
+			    arg = -arg;
+			  }
+
+			if (sign < 0)
+			  *p++ = '-';
+			else if (flags & FLAG_SHOWSIGN)
+			  *p++ = '+';
+			else if (flags & FLAG_SPACE)
+			  *p++ = ' ';
+
+			if (arg > 0.0 && arg + arg == arg)
+			  {
+			    if (dp->conversion == 'A')
+			      {
+				*p++ = 'I'; *p++ = 'N'; *p++ = 'F';
+			      }
+			    else
+			      {
+				*p++ = 'i'; *p++ = 'n'; *p++ = 'f';
+			      }
+			  }
+			else
+			  {
+			    int exponent;
+			    double mantissa;
+
+			    if (arg > 0.0)
+			      mantissa = printf_frexp (arg, &exponent);
+			    else
+			      {
+				exponent = 0;
+				mantissa = 0.0;
+			      }
+
+			    if (has_precision
+				&& precision < (unsigned int) ((DBL_DIG + 1) * 0.831) + 1)
+			      {
+				/* Round the mantissa.  */
+				double tail = mantissa;
+				size_t q;
+
+				for (q = precision; ; q--)
+				  {
+				    int digit = (int) tail;
+				    tail -= digit;
+				    if (q == 0)
+				      {
+					if (digit & 1 ? tail >= 0.5 : tail > 0.5)
+					  tail = 1 - tail;
+					else
+					  tail = - tail;
+					break;
+				      }
+				    tail *= 16.0;
+				  }
+				if (tail != 0.0)
+				  for (q = precision; q > 0; q--)
+				    tail *= 0.0625;
+				mantissa += tail;
+			      }
+
+			    *p++ = '0';
+			    *p++ = dp->conversion - 'A' + 'X';
+			    pad_ptr = p;
+			    {
+			      int digit;
+
+			      digit = (int) mantissa;
+			      mantissa -= digit;
+			      *p++ = '0' + digit;
+			      if ((flags & FLAG_ALT)
+				  || mantissa > 0.0 || precision > 0)
+				{
+				  *p++ = decimal_point_char ();
+				  /* This loop terminates because we assume
+				     that FLT_RADIX is a power of 2.  */
+				  while (mantissa > 0.0)
+				    {
+				      mantissa *= 16.0;
+				      digit = (int) mantissa;
+				      mantissa -= digit;
+				      *p++ = digit
+					     + (digit < 10
+						? '0'
+						: dp->conversion - 10);
+				      if (precision > 0)
+					precision--;
+				    }
+				  while (precision > 0)
+				    {
+				      *p++ = '0';
+				      precision--;
+				    }
+				}
+			      }
+			      *p++ = dp->conversion - 'A' + 'P';
+#  if WIDE_CHAR_VERSION
+			      {
+				static const wchar_t decimal_format[] =
+				  { '%', '+', 'd', '\0' };
+				SNPRINTF (p, 6 + 1, decimal_format, exponent);
+			      }
+			      while (*p != '\0')
+				p++;
+#  else
+			      if (sizeof (DCHAR_T) == 1)
+				{
+				  sprintf ((char *) p, "%+d", exponent);
+				  while (*p != '\0')
+				    p++;
+				}
+			      else
+				{
+				  char expbuf[6 + 1];
+				  const char *ep;
+				  sprintf (expbuf, "%+d", exponent);
+				  for (ep = expbuf; (*p = *ep) != '\0'; ep++)
+				    p++;
+				}
+#  endif
+			  }
+		      }
+# else
+		    abort ();
+# endif
+		  }
+		/* The generated string now extends from tmp to p, with the
+		   zero padding insertion point being at pad_ptr.  */
+		if (has_width && p - tmp < width)
+		  {
+		    size_t pad = width - (p - tmp);
+		    DCHAR_T *end = p + pad;
+
+		    if (flags & FLAG_LEFT)
+		      {
+			/* Pad with spaces on the right.  */
+			for (; pad > 0; pad--)
+			  *p++ = ' ';
+		      }
+		    else if ((flags & FLAG_ZERO) && pad_ptr != NULL)
+		      {
+			/* Pad with zeroes.  */
+			DCHAR_T *q = end;
+
+			while (p > pad_ptr)
+			  *--q = *--p;
+			for (; pad > 0; pad--)
+			  *p++ = '0';
+		      }
+		    else
+		      {
+			/* Pad with spaces on the left.  */
+			DCHAR_T *q = end;
+
+			while (p > tmp)
+			  *--q = *--p;
+			for (; pad > 0; pad--)
+			  *p++ = ' ';
+		      }
+
+		    p = end;
+		  }
+
+		{
+		  size_t count = p - tmp;
+
+		  if (count >= tmp_length)
+		    /* tmp_length was incorrectly calculated - fix the
+		       code above!  */
+		    abort ();
+
+		  /* Make room for the result.  */
+		  if (count >= allocated - length)
+		    {
+		      size_t n = xsum (length, count);
+
+		      ENSURE_ALLOCATION (n);
+		    }
+
+		  /* Append the result.  */
+		  memcpy (result + length, tmp, count * sizeof (DCHAR_T));
+		  if (tmp != tmpbuf)
+		    free (tmp);
+		  length += count;
+		}
+	      }
+#endif
+#if (NEED_PRINTF_INFINITE_DOUBLE || NEED_PRINTF_DOUBLE || NEED_PRINTF_INFINITE_LONG_DOUBLE || NEED_PRINTF_LONG_DOUBLE) && !defined IN_LIBINTL
+	    else if ((dp->conversion == 'f' || dp->conversion == 'F'
+		      || dp->conversion == 'e' || dp->conversion == 'E'
+		      || dp->conversion == 'g' || dp->conversion == 'G'
+		      || dp->conversion == 'a' || dp->conversion == 'A')
+		     && (0
+# if NEED_PRINTF_DOUBLE
+			 || a.arg[dp->arg_index].type == TYPE_DOUBLE
+# elif NEED_PRINTF_INFINITE_DOUBLE
+			 || (a.arg[dp->arg_index].type == TYPE_DOUBLE
+			     /* The systems (mingw) which produce wrong output
+				for Inf, -Inf, and NaN also do so for -0.0.
+				Therefore we treat this case here as well.  */
+			     && is_infinite_or_zero (a.arg[dp->arg_index].a.a_double))
+# endif
+# if NEED_PRINTF_LONG_DOUBLE
+			 || a.arg[dp->arg_index].type == TYPE_LONGDOUBLE
+# elif NEED_PRINTF_INFINITE_LONG_DOUBLE
+			 || (a.arg[dp->arg_index].type == TYPE_LONGDOUBLE
+			     /* Some systems produce wrong output for Inf,
+				-Inf, and NaN.  Some systems in this category
+				(IRIX 5.3) also do so for -0.0.  Therefore we
+				treat this case here as well.  */
+			     && is_infinite_or_zerol (a.arg[dp->arg_index].a.a_longdouble))
+# endif
+			))
+	      {
+# if (NEED_PRINTF_DOUBLE || NEED_PRINTF_INFINITE_DOUBLE) && (NEED_PRINTF_LONG_DOUBLE || NEED_PRINTF_INFINITE_LONG_DOUBLE)
+		arg_type type = a.arg[dp->arg_index].type;
+# endif
+		int flags = dp->flags;
+		int has_width;
+		size_t width;
+		int has_precision;
+		size_t precision;
+		size_t tmp_length;
+		DCHAR_T tmpbuf[700];
+		DCHAR_T *tmp;
+		DCHAR_T *pad_ptr;
+		DCHAR_T *p;
+
+		has_width = 0;
+		width = 0;
+		if (dp->width_start != dp->width_end)
+		  {
+		    if (dp->width_arg_index != ARG_NONE)
+		      {
+			int arg;
+
+			if (!(a.arg[dp->width_arg_index].type == TYPE_INT))
+			  abort ();
+			arg = a.arg[dp->width_arg_index].a.a_int;
+			if (arg < 0)
+			  {
+			    /* "A negative field width is taken as a '-' flag
+			        followed by a positive field width."  */
+			    flags |= FLAG_LEFT;
+			    width = (unsigned int) (-arg);
+			  }
+			else
+			  width = arg;
+		      }
+		    else
+		      {
+			const FCHAR_T *digitp = dp->width_start;
+
+			do
+			  width = xsum (xtimes (width, 10), *digitp++ - '0');
+			while (digitp != dp->width_end);
+		      }
+		    has_width = 1;
+		  }
+
+		has_precision = 0;
+		precision = 0;
+		if (dp->precision_start != dp->precision_end)
+		  {
+		    if (dp->precision_arg_index != ARG_NONE)
+		      {
+			int arg;
+
+			if (!(a.arg[dp->precision_arg_index].type == TYPE_INT))
+			  abort ();
+			arg = a.arg[dp->precision_arg_index].a.a_int;
+			/* "A negative precision is taken as if the precision
+			    were omitted."  */
+			if (arg >= 0)
+			  {
+			    precision = arg;
+			    has_precision = 1;
+			  }
+		      }
+		    else
+		      {
+			const FCHAR_T *digitp = dp->precision_start + 1;
+
+			precision = 0;
+			while (digitp != dp->precision_end)
+			  precision = xsum (xtimes (precision, 10), *digitp++ - '0');
+			has_precision = 1;
+		      }
+		  }
+
+		/* POSIX specifies the default precision to be 6 for %f, %F,
+		   %e, %E, but not for %g, %G.  Implementations appear to use
+		   the same default precision also for %g, %G.  But for %a, %A,
+		   the default precision is 0.  */
+		if (!has_precision)
+		  if (!(dp->conversion == 'a' || dp->conversion == 'A'))
+		    precision = 6;
+
+		/* Allocate a temporary buffer of sufficient size.  */
+# if NEED_PRINTF_DOUBLE && NEED_PRINTF_LONG_DOUBLE
+		tmp_length = (type == TYPE_LONGDOUBLE ? LDBL_DIG + 1 : DBL_DIG + 1);
+# elif NEED_PRINTF_INFINITE_DOUBLE && NEED_PRINTF_LONG_DOUBLE
+		tmp_length = (type == TYPE_LONGDOUBLE ? LDBL_DIG + 1 : 0);
+# elif NEED_PRINTF_LONG_DOUBLE
+		tmp_length = LDBL_DIG + 1;
+# elif NEED_PRINTF_DOUBLE
+		tmp_length = DBL_DIG + 1;
+# else
+		tmp_length = 0;
+# endif
+		if (tmp_length < precision)
+		  tmp_length = precision;
+# if NEED_PRINTF_LONG_DOUBLE
+#  if NEED_PRINTF_DOUBLE || NEED_PRINTF_INFINITE_DOUBLE
+		if (type == TYPE_LONGDOUBLE)
+#  endif
+		  if (dp->conversion == 'f' || dp->conversion == 'F')
+		    {
+		      long double arg = a.arg[dp->arg_index].a.a_longdouble;
+		      if (!(isnanl (arg) || arg + arg == arg))
+			{
+			  /* arg is finite and nonzero.  */
+			  int exponent = floorlog10l (arg < 0 ? -arg : arg);
+			  if (exponent >= 0 && tmp_length < exponent + precision)
+			    tmp_length = exponent + precision;
+			}
+		    }
+# endif
+# if NEED_PRINTF_DOUBLE
+#  if NEED_PRINTF_LONG_DOUBLE || NEED_PRINTF_INFINITE_LONG_DOUBLE
+		if (type == TYPE_DOUBLE)
+#  endif
+		  if (dp->conversion == 'f' || dp->conversion == 'F')
+		    {
+		      double arg = a.arg[dp->arg_index].a.a_double;
+		      if (!(isnand (arg) || arg + arg == arg))
+			{
+			  /* arg is finite and nonzero.  */
+			  int exponent = floorlog10 (arg < 0 ? -arg : arg);
+			  if (exponent >= 0 && tmp_length < exponent + precision)
+			    tmp_length = exponent + precision;
+			}
+		    }
+# endif
+		/* Account for sign, decimal point etc. */
+		tmp_length = xsum (tmp_length, 12);
+
+		if (tmp_length < width)
+		  tmp_length = width;
+
+		tmp_length = xsum (tmp_length, 1); /* account for trailing NUL */
+
+		if (tmp_length <= sizeof (tmpbuf) / sizeof (DCHAR_T))
+		  tmp = tmpbuf;
+		else
+		  {
+		    size_t tmp_memsize = xtimes (tmp_length, sizeof (DCHAR_T));
+
+		    if (size_overflow_p (tmp_memsize))
+		      /* Overflow, would lead to out of memory.  */
+		      goto out_of_memory;
+		    tmp = (DCHAR_T *) malloc (tmp_memsize);
+		    if (tmp == NULL)
+		      /* Out of memory.  */
+		      goto out_of_memory;
+		  }
+
+		pad_ptr = NULL;
+		p = tmp;
+
+# if NEED_PRINTF_LONG_DOUBLE || NEED_PRINTF_INFINITE_LONG_DOUBLE
+#  if NEED_PRINTF_DOUBLE || NEED_PRINTF_INFINITE_DOUBLE
+		if (type == TYPE_LONGDOUBLE)
+#  endif
+		  {
+		    long double arg = a.arg[dp->arg_index].a.a_longdouble;
+
+		    if (isnanl (arg))
+		      {
+			if (dp->conversion >= 'A' && dp->conversion <= 'Z')
+			  {
+			    *p++ = 'N'; *p++ = 'A'; *p++ = 'N';
+			  }
+			else
+			  {
+			    *p++ = 'n'; *p++ = 'a'; *p++ = 'n';
+			  }
+		      }
+		    else
+		      {
+			int sign = 0;
+			DECL_LONG_DOUBLE_ROUNDING
+
+			BEGIN_LONG_DOUBLE_ROUNDING ();
+
+			if (signbit (arg)) /* arg < 0.0L or negative zero */
+			  {
+			    sign = -1;
+			    arg = -arg;
+			  }
+
+			if (sign < 0)
+			  *p++ = '-';
+			else if (flags & FLAG_SHOWSIGN)
+			  *p++ = '+';
+			else if (flags & FLAG_SPACE)
+			  *p++ = ' ';
+
+			if (arg > 0.0L && arg + arg == arg)
+			  {
+			    if (dp->conversion >= 'A' && dp->conversion <= 'Z')
+			      {
+				*p++ = 'I'; *p++ = 'N'; *p++ = 'F';
+			      }
+			    else
+			      {
+				*p++ = 'i'; *p++ = 'n'; *p++ = 'f';
+			      }
+			  }
+			else
+			  {
+#  if NEED_PRINTF_LONG_DOUBLE
+			    pad_ptr = p;
+
+			    if (dp->conversion == 'f' || dp->conversion == 'F')
+			      {
+				char *digits;
+				size_t ndigits;
+
+				digits =
+				  scale10_round_decimal_long_double (arg, precision);
+				if (digits == NULL)
+				  {
+				    END_LONG_DOUBLE_ROUNDING ();
+				    goto out_of_memory;
+				  }
+				ndigits = strlen (digits);
+
+				if (ndigits > precision)
+				  do
+				    {
+				      --ndigits;
+				      *p++ = digits[ndigits];
+				    }
+				  while (ndigits > precision);
+				else
+				  *p++ = '0';
+				/* Here ndigits <= precision.  */
+				if ((flags & FLAG_ALT) || precision > 0)
+				  {
+				    *p++ = decimal_point_char ();
+				    for (; precision > ndigits; precision--)
+				      *p++ = '0';
+				    while (ndigits > 0)
+				      {
+					--ndigits;
+					*p++ = digits[ndigits];
+				      }
+				  }
+
+				free (digits);
+			      }
+			    else if (dp->conversion == 'e' || dp->conversion == 'E')
+			      {
+				int exponent;
+
+				if (arg == 0.0L)
+				  {
+				    exponent = 0;
+				    *p++ = '0';
+				    if ((flags & FLAG_ALT) || precision > 0)
+				      {
+					*p++ = decimal_point_char ();
+					for (; precision > 0; precision--)
+					  *p++ = '0';
+				      }
+				  }
+				else
+				  {
+				    /* arg > 0.0L.  */
+				    int adjusted;
+				    char *digits;
+				    size_t ndigits;
+
+				    exponent = floorlog10l (arg);
+				    adjusted = 0;
+				    for (;;)
+				      {
+					digits =
+					  scale10_round_decimal_long_double (arg,
+									     (int)precision - exponent);
+					if (digits == NULL)
+					  {
+					    END_LONG_DOUBLE_ROUNDING ();
+					    goto out_of_memory;
+					  }
+					ndigits = strlen (digits);
+
+					if (ndigits == precision + 1)
+					  break;
+					if (ndigits < precision
+					    || ndigits > precision + 2)
+					  /* The exponent was not guessed
+					     precisely enough.  */
+					  abort ();
+					if (adjusted)
+					  /* None of two values of exponent is
+					     the right one.  Prevent an endless
+					     loop.  */
+					  abort ();
+					free (digits);
+					if (ndigits == precision)
+					  exponent -= 1;
+					else
+					  exponent += 1;
+					adjusted = 1;
+				      }
+				    /* Here ndigits = precision+1.  */
+				    if (is_borderline (digits, precision))
+				      {
+					/* Maybe the exponent guess was too high
+					   and a smaller exponent can be reached
+					   by turning a 10...0 into 9...9x.  */
+					char *digits2 =
+					  scale10_round_decimal_long_double (arg,
+									     (int)precision - exponent + 1);
+					if (digits2 == NULL)
+					  {
+					    free (digits);
+					    END_LONG_DOUBLE_ROUNDING ();
+					    goto out_of_memory;
+					  }
+					if (strlen (digits2) == precision + 1)
+					  {
+					    free (digits);
+					    digits = digits2;
+					    exponent -= 1;
+					  }
+					else
+					  free (digits2);
+				      }
+				    /* Here ndigits = precision+1.  */
+
+				    *p++ = digits[--ndigits];
+				    if ((flags & FLAG_ALT) || precision > 0)
+				      {
+					*p++ = decimal_point_char ();
+					while (ndigits > 0)
+					  {
+					    --ndigits;
+					    *p++ = digits[ndigits];
+					  }
+				      }
+
+				    free (digits);
+				  }
+
+				*p++ = dp->conversion; /* 'e' or 'E' */
+#   if WIDE_CHAR_VERSION
+				{
+				  static const wchar_t decimal_format[] =
+				    { '%', '+', '.', '2', 'd', '\0' };
+				  SNPRINTF (p, 6 + 1, decimal_format, exponent);
+				}
+				while (*p != '\0')
+				  p++;
+#   else
+				if (sizeof (DCHAR_T) == 1)
+				  {
+				    sprintf ((char *) p, "%+.2d", exponent);
+				    while (*p != '\0')
+				      p++;
+				  }
+				else
+				  {
+				    char expbuf[6 + 1];
+				    const char *ep;
+				    sprintf (expbuf, "%+.2d", exponent);
+				    for (ep = expbuf; (*p = *ep) != '\0'; ep++)
+				      p++;
+				  }
+#   endif
+			      }
+			    else if (dp->conversion == 'g' || dp->conversion == 'G')
+			      {
+				if (precision == 0)
+				  precision = 1;
+				/* precision >= 1.  */
+
+				if (arg == 0.0L)
+				  /* The exponent is 0, >= -4, < precision.
+				     Use fixed-point notation.  */
+				  {
+				    size_t ndigits = precision;
+				    /* Number of trailing zeroes that have to be
+				       dropped.  */
+				    size_t nzeroes =
+				      (flags & FLAG_ALT ? 0 : precision - 1);
+
+				    --ndigits;
+				    *p++ = '0';
+				    if ((flags & FLAG_ALT) || ndigits > nzeroes)
+				      {
+					*p++ = decimal_point_char ();
+					while (ndigits > nzeroes)
+					  {
+					    --ndigits;
+					    *p++ = '0';
+					  }
+				      }
+				  }
+				else
+				  {
+				    /* arg > 0.0L.  */
+				    int exponent;
+				    int adjusted;
+				    char *digits;
+				    size_t ndigits;
+				    size_t nzeroes;
+
+				    exponent = floorlog10l (arg);
+				    adjusted = 0;
+				    for (;;)
+				      {
+					digits =
+					  scale10_round_decimal_long_double (arg,
+									     (int)(precision - 1) - exponent);
+					if (digits == NULL)
+					  {
+					    END_LONG_DOUBLE_ROUNDING ();
+					    goto out_of_memory;
+					  }
+					ndigits = strlen (digits);
+
+					if (ndigits == precision)
+					  break;
+					if (ndigits < precision - 1
+					    || ndigits > precision + 1)
+					  /* The exponent was not guessed
+					     precisely enough.  */
+					  abort ();
+					if (adjusted)
+					  /* None of two values of exponent is
+					     the right one.  Prevent an endless
+					     loop.  */
+					  abort ();
+					free (digits);
+					if (ndigits < precision)
+					  exponent -= 1;
+					else
+					  exponent += 1;
+					adjusted = 1;
+				      }
+				    /* Here ndigits = precision.  */
+				    if (is_borderline (digits, precision - 1))
+				      {
+					/* Maybe the exponent guess was too high
+					   and a smaller exponent can be reached
+					   by turning a 10...0 into 9...9x.  */
+					char *digits2 =
+					  scale10_round_decimal_long_double (arg,
+									     (int)(precision - 1) - exponent + 1);
+					if (digits2 == NULL)
+					  {
+					    free (digits);
+					    END_LONG_DOUBLE_ROUNDING ();
+					    goto out_of_memory;
+					  }
+					if (strlen (digits2) == precision)
+					  {
+					    free (digits);
+					    digits = digits2;
+					    exponent -= 1;
+					  }
+					else
+					  free (digits2);
+				      }
+				    /* Here ndigits = precision.  */
+
+				    /* Determine the number of trailing zeroes
+				       that have to be dropped.  */
+				    nzeroes = 0;
+				    if ((flags & FLAG_ALT) == 0)
+				      while (nzeroes < ndigits
+					     && digits[nzeroes] == '0')
+					nzeroes++;
+
+				    /* The exponent is now determined.  */
+				    if (exponent >= -4
+					&& exponent < (long)precision)
+				      {
+					/* Fixed-point notation:
+					   max(exponent,0)+1 digits, then the
+					   decimal point, then the remaining
+					   digits without trailing zeroes.  */
+					if (exponent >= 0)
+					  {
+					    size_t count = exponent + 1;
+					    /* Note: count <= precision = ndigits.  */
+					    for (; count > 0; count--)
+					      *p++ = digits[--ndigits];
+					    if ((flags & FLAG_ALT) || ndigits > nzeroes)
+					      {
+						*p++ = decimal_point_char ();
+						while (ndigits > nzeroes)
+						  {
+						    --ndigits;
+						    *p++ = digits[ndigits];
+						  }
+					      }
+					  }
+					else
+					  {
+					    size_t count = -exponent - 1;
+					    *p++ = '0';
+					    *p++ = decimal_point_char ();
+					    for (; count > 0; count--)
+					      *p++ = '0';
+					    while (ndigits > nzeroes)
+					      {
+						--ndigits;
+						*p++ = digits[ndigits];
+					      }
+					  }
+				      }
+				    else
+				      {
+					/* Exponential notation.  */
+					*p++ = digits[--ndigits];
+					if ((flags & FLAG_ALT) || ndigits > nzeroes)
+					  {
+					    *p++ = decimal_point_char ();
+					    while (ndigits > nzeroes)
+					      {
+						--ndigits;
+						*p++ = digits[ndigits];
+					      }
+					  }
+					*p++ = dp->conversion - 'G' + 'E'; /* 'e' or 'E' */
+#   if WIDE_CHAR_VERSION
+					{
+					  static const wchar_t decimal_format[] =
+					    { '%', '+', '.', '2', 'd', '\0' };
+					  SNPRINTF (p, 6 + 1, decimal_format, exponent);
+					}
+					while (*p != '\0')
+					  p++;
+#   else
+					if (sizeof (DCHAR_T) == 1)
+					  {
+					    sprintf ((char *) p, "%+.2d", exponent);
+					    while (*p != '\0')
+					      p++;
+					  }
+					else
+					  {
+					    char expbuf[6 + 1];
+					    const char *ep;
+					    sprintf (expbuf, "%+.2d", exponent);
+					    for (ep = expbuf; (*p = *ep) != '\0'; ep++)
+					      p++;
+					  }
+#   endif
+				      }
+
+				    free (digits);
+				  }
+			      }
+			    else
+			      abort ();
+#  else
+			    /* arg is finite.  */
+			    if (!(arg == 0.0L))
+			      abort ();
+
+			    pad_ptr = p;
+
+			    if (dp->conversion == 'f' || dp->conversion == 'F')
+			      {
+				*p++ = '0';
+				if ((flags & FLAG_ALT) || precision > 0)
+				  {
+				    *p++ = decimal_point_char ();
+				    for (; precision > 0; precision--)
+				      *p++ = '0';
+				  }
+			      }
+			    else if (dp->conversion == 'e' || dp->conversion == 'E')
+			      {
+				*p++ = '0';
+				if ((flags & FLAG_ALT) || precision > 0)
+				  {
+				    *p++ = decimal_point_char ();
+				    for (; precision > 0; precision--)
+				      *p++ = '0';
+				  }
+				*p++ = dp->conversion; /* 'e' or 'E' */
+				*p++ = '+';
+				*p++ = '0';
+				*p++ = '0';
+			      }
+			    else if (dp->conversion == 'g' || dp->conversion == 'G')
+			      {
+				*p++ = '0';
+				if (flags & FLAG_ALT)
+				  {
+				    size_t ndigits =
+				      (precision > 0 ? precision - 1 : 0);
+				    *p++ = decimal_point_char ();
+				    for (; ndigits > 0; --ndigits)
+				      *p++ = '0';
+				  }
+			      }
+			    else if (dp->conversion == 'a' || dp->conversion == 'A')
+			      {
+				*p++ = '0';
+				*p++ = dp->conversion - 'A' + 'X';
+				pad_ptr = p;
+				*p++ = '0';
+				if ((flags & FLAG_ALT) || precision > 0)
+				  {
+				    *p++ = decimal_point_char ();
+				    for (; precision > 0; precision--)
+				      *p++ = '0';
+				  }
+				*p++ = dp->conversion - 'A' + 'P';
+				*p++ = '+';
+				*p++ = '0';
+			      }
+			    else
+			      abort ();
+#  endif
+			  }
+
+			END_LONG_DOUBLE_ROUNDING ();
+		      }
+		  }
+#  if NEED_PRINTF_DOUBLE || NEED_PRINTF_INFINITE_DOUBLE
+		else
+#  endif
+# endif
+# if NEED_PRINTF_DOUBLE || NEED_PRINTF_INFINITE_DOUBLE
+		  {
+		    double arg = a.arg[dp->arg_index].a.a_double;
+
+		    if (isnand (arg))
+		      {
+			if (dp->conversion >= 'A' && dp->conversion <= 'Z')
+			  {
+			    *p++ = 'N'; *p++ = 'A'; *p++ = 'N';
+			  }
+			else
+			  {
+			    *p++ = 'n'; *p++ = 'a'; *p++ = 'n';
+			  }
+		      }
+		    else
+		      {
+			int sign = 0;
+
+			if (signbit (arg)) /* arg < 0.0 or negative zero */
+			  {
+			    sign = -1;
+			    arg = -arg;
+			  }
+
+			if (sign < 0)
+			  *p++ = '-';
+			else if (flags & FLAG_SHOWSIGN)
+			  *p++ = '+';
+			else if (flags & FLAG_SPACE)
+			  *p++ = ' ';
+
+			if (arg > 0.0 && arg + arg == arg)
+			  {
+			    if (dp->conversion >= 'A' && dp->conversion <= 'Z')
+			      {
+				*p++ = 'I'; *p++ = 'N'; *p++ = 'F';
+			      }
+			    else
+			      {
+				*p++ = 'i'; *p++ = 'n'; *p++ = 'f';
+			      }
+			  }
+			else
+			  {
+#  if NEED_PRINTF_DOUBLE
+			    pad_ptr = p;
+
+			    if (dp->conversion == 'f' || dp->conversion == 'F')
+			      {
+				char *digits;
+				size_t ndigits;
+
+				digits =
+				  scale10_round_decimal_double (arg, precision);
+				if (digits == NULL)
+				  goto out_of_memory;
+				ndigits = strlen (digits);
+
+				if (ndigits > precision)
+				  do
+				    {
+				      --ndigits;
+				      *p++ = digits[ndigits];
+				    }
+				  while (ndigits > precision);
+				else
+				  *p++ = '0';
+				/* Here ndigits <= precision.  */
+				if ((flags & FLAG_ALT) || precision > 0)
+				  {
+				    *p++ = decimal_point_char ();
+				    for (; precision > ndigits; precision--)
+				      *p++ = '0';
+				    while (ndigits > 0)
+				      {
+					--ndigits;
+					*p++ = digits[ndigits];
+				      }
+				  }
+
+				free (digits);
+			      }
+			    else if (dp->conversion == 'e' || dp->conversion == 'E')
+			      {
+				int exponent;
+
+				if (arg == 0.0)
+				  {
+				    exponent = 0;
+				    *p++ = '0';
+				    if ((flags & FLAG_ALT) || precision > 0)
+				      {
+					*p++ = decimal_point_char ();
+					for (; precision > 0; precision--)
+					  *p++ = '0';
+				      }
+				  }
+				else
+				  {
+				    /* arg > 0.0.  */
+				    int adjusted;
+				    char *digits;
+				    size_t ndigits;
+
+				    exponent = floorlog10 (arg);
+				    adjusted = 0;
+				    for (;;)
+				      {
+					digits =
+					  scale10_round_decimal_double (arg,
+									(int)precision - exponent);
+					if (digits == NULL)
+					  goto out_of_memory;
+					ndigits = strlen (digits);
+
+					if (ndigits == precision + 1)
+					  break;
+					if (ndigits < precision
+					    || ndigits > precision + 2)
+					  /* The exponent was not guessed
+					     precisely enough.  */
+					  abort ();
+					if (adjusted)
+					  /* None of two values of exponent is
+					     the right one.  Prevent an endless
+					     loop.  */
+					  abort ();
+					free (digits);
+					if (ndigits == precision)
+					  exponent -= 1;
+					else
+					  exponent += 1;
+					adjusted = 1;
+				      }
+				    /* Here ndigits = precision+1.  */
+				    if (is_borderline (digits, precision))
+				      {
+					/* Maybe the exponent guess was too high
+					   and a smaller exponent can be reached
+					   by turning a 10...0 into 9...9x.  */
+					char *digits2 =
+					  scale10_round_decimal_double (arg,
+									(int)precision - exponent + 1);
+					if (digits2 == NULL)
+					  {
+					    free (digits);
+					    goto out_of_memory;
+					  }
+					if (strlen (digits2) == precision + 1)
+					  {
+					    free (digits);
+					    digits = digits2;
+					    exponent -= 1;
+					  }
+					else
+					  free (digits2);
+				      }
+				    /* Here ndigits = precision+1.  */
+
+				    *p++ = digits[--ndigits];
+				    if ((flags & FLAG_ALT) || precision > 0)
+				      {
+					*p++ = decimal_point_char ();
+					while (ndigits > 0)
+					  {
+					    --ndigits;
+					    *p++ = digits[ndigits];
+					  }
+				      }
+
+				    free (digits);
+				  }
+
+				*p++ = dp->conversion; /* 'e' or 'E' */
+#   if WIDE_CHAR_VERSION
+				{
+				  static const wchar_t decimal_format[] =
+				    /* Produce the same number of exponent digits
+				       as the native printf implementation.  */
+#    if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
+				    { '%', '+', '.', '3', 'd', '\0' };
+#    else
+				    { '%', '+', '.', '2', 'd', '\0' };
+#    endif
+				  SNPRINTF (p, 6 + 1, decimal_format, exponent);
+				}
+				while (*p != '\0')
+				  p++;
+#   else
+				{
+				  static const char decimal_format[] =
+				    /* Produce the same number of exponent digits
+				       as the native printf implementation.  */
+#    if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
+				    "%+.3d";
+#    else
+				    "%+.2d";
+#    endif
+				  if (sizeof (DCHAR_T) == 1)
+				    {
+				      sprintf ((char *) p, decimal_format, exponent);
+				      while (*p != '\0')
+					p++;
+				    }
+				  else
+				    {
+				      char expbuf[6 + 1];
+				      const char *ep;
+				      sprintf (expbuf, decimal_format, exponent);
+				      for (ep = expbuf; (*p = *ep) != '\0'; ep++)
+					p++;
+				    }
+				}
+#   endif
+			      }
+			    else if (dp->conversion == 'g' || dp->conversion == 'G')
+			      {
+				if (precision == 0)
+				  precision = 1;
+				/* precision >= 1.  */
+
+				if (arg == 0.0)
+				  /* The exponent is 0, >= -4, < precision.
+				     Use fixed-point notation.  */
+				  {
+				    size_t ndigits = precision;
+				    /* Number of trailing zeroes that have to be
+				       dropped.  */
+				    size_t nzeroes =
+				      (flags & FLAG_ALT ? 0 : precision - 1);
+
+				    --ndigits;
+				    *p++ = '0';
+				    if ((flags & FLAG_ALT) || ndigits > nzeroes)
+				      {
+					*p++ = decimal_point_char ();
+					while (ndigits > nzeroes)
+					  {
+					    --ndigits;
+					    *p++ = '0';
+					  }
+				      }
+				  }
+				else
+				  {
+				    /* arg > 0.0.  */
+				    int exponent;
+				    int adjusted;
+				    char *digits;
+				    size_t ndigits;
+				    size_t nzeroes;
+
+				    exponent = floorlog10 (arg);
+				    adjusted = 0;
+				    for (;;)
+				      {
+					digits =
+					  scale10_round_decimal_double (arg,
+									(int)(precision - 1) - exponent);
+					if (digits == NULL)
+					  goto out_of_memory;
+					ndigits = strlen (digits);
+
+					if (ndigits == precision)
+					  break;
+					if (ndigits < precision - 1
+					    || ndigits > precision + 1)
+					  /* The exponent was not guessed
+					     precisely enough.  */
+					  abort ();
+					if (adjusted)
+					  /* None of two values of exponent is
+					     the right one.  Prevent an endless
+					     loop.  */
+					  abort ();
+					free (digits);
+					if (ndigits < precision)
+					  exponent -= 1;
+					else
+					  exponent += 1;
+					adjusted = 1;
+				      }
+				    /* Here ndigits = precision.  */
+				    if (is_borderline (digits, precision - 1))
+				      {
+					/* Maybe the exponent guess was too high
+					   and a smaller exponent can be reached
+					   by turning a 10...0 into 9...9x.  */
+					char *digits2 =
+					  scale10_round_decimal_double (arg,
+									(int)(precision - 1) - exponent + 1);
+					if (digits2 == NULL)
+					  {
+					    free (digits);
+					    goto out_of_memory;
+					  }
+					if (strlen (digits2) == precision)
+					  {
+					    free (digits);
+					    digits = digits2;
+					    exponent -= 1;
+					  }
+					else
+					  free (digits2);
+				      }
+				    /* Here ndigits = precision.  */
+
+				    /* Determine the number of trailing zeroes
+				       that have to be dropped.  */
+				    nzeroes = 0;
+				    if ((flags & FLAG_ALT) == 0)
+				      while (nzeroes < ndigits
+					     && digits[nzeroes] == '0')
+					nzeroes++;
+
+				    /* The exponent is now determined.  */
+				    if (exponent >= -4
+					&& exponent < (long)precision)
+				      {
+					/* Fixed-point notation:
+					   max(exponent,0)+1 digits, then the
+					   decimal point, then the remaining
+					   digits without trailing zeroes.  */
+					if (exponent >= 0)
+					  {
+					    size_t count = exponent + 1;
+					    /* Note: count <= precision = ndigits.  */
+					    for (; count > 0; count--)
+					      *p++ = digits[--ndigits];
+					    if ((flags & FLAG_ALT) || ndigits > nzeroes)
+					      {
+						*p++ = decimal_point_char ();
+						while (ndigits > nzeroes)
+						  {
+						    --ndigits;
+						    *p++ = digits[ndigits];
+						  }
+					      }
+					  }
+					else
+					  {
+					    size_t count = -exponent - 1;
+					    *p++ = '0';
+					    *p++ = decimal_point_char ();
+					    for (; count > 0; count--)
+					      *p++ = '0';
+					    while (ndigits > nzeroes)
+					      {
+						--ndigits;
+						*p++ = digits[ndigits];
+					      }
+					  }
+				      }
+				    else
+				      {
+					/* Exponential notation.  */
+					*p++ = digits[--ndigits];
+					if ((flags & FLAG_ALT) || ndigits > nzeroes)
+					  {
+					    *p++ = decimal_point_char ();
+					    while (ndigits > nzeroes)
+					      {
+						--ndigits;
+						*p++ = digits[ndigits];
+					      }
+					  }
+					*p++ = dp->conversion - 'G' + 'E'; /* 'e' or 'E' */
+#   if WIDE_CHAR_VERSION
+					{
+					  static const wchar_t decimal_format[] =
+					    /* Produce the same number of exponent digits
+					       as the native printf implementation.  */
+#    if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
+					    { '%', '+', '.', '3', 'd', '\0' };
+#    else
+					    { '%', '+', '.', '2', 'd', '\0' };
+#    endif
+					  SNPRINTF (p, 6 + 1, decimal_format, exponent);
+					}
+					while (*p != '\0')
+					  p++;
+#   else
+					{
+					  static const char decimal_format[] =
+					    /* Produce the same number of exponent digits
+					       as the native printf implementation.  */
+#    if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
+					    "%+.3d";
+#    else
+					    "%+.2d";
+#    endif
+					  if (sizeof (DCHAR_T) == 1)
+					    {
+					      sprintf ((char *) p, decimal_format, exponent);
+					      while (*p != '\0')
+						p++;
+					    }
+					  else
+					    {
+					      char expbuf[6 + 1];
+					      const char *ep;
+					      sprintf (expbuf, decimal_format, exponent);
+					      for (ep = expbuf; (*p = *ep) != '\0'; ep++)
+						p++;
+					    }
+					}
+#   endif
+				      }
+
+				    free (digits);
+				  }
+			      }
+			    else
+			      abort ();
+#  else
+			    /* arg is finite.  */
+			    if (!(arg == 0.0))
+			      abort ();
+
+			    pad_ptr = p;
+
+			    if (dp->conversion == 'f' || dp->conversion == 'F')
+			      {
+				*p++ = '0';
+				if ((flags & FLAG_ALT) || precision > 0)
+				  {
+				    *p++ = decimal_point_char ();
+				    for (; precision > 0; precision--)
+				      *p++ = '0';
+				  }
+			      }
+			    else if (dp->conversion == 'e' || dp->conversion == 'E')
+			      {
+				*p++ = '0';
+				if ((flags & FLAG_ALT) || precision > 0)
+				  {
+				    *p++ = decimal_point_char ();
+				    for (; precision > 0; precision--)
+				      *p++ = '0';
+				  }
+				*p++ = dp->conversion; /* 'e' or 'E' */
+				*p++ = '+';
+				/* Produce the same number of exponent digits as
+				   the native printf implementation.  */
+#   if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
+				*p++ = '0';
+#   endif
+				*p++ = '0';
+				*p++ = '0';
+			      }
+			    else if (dp->conversion == 'g' || dp->conversion == 'G')
+			      {
+				*p++ = '0';
+				if (flags & FLAG_ALT)
+				  {
+				    size_t ndigits =
+				      (precision > 0 ? precision - 1 : 0);
+				    *p++ = decimal_point_char ();
+				    for (; ndigits > 0; --ndigits)
+				      *p++ = '0';
+				  }
+			      }
+			    else
+			      abort ();
+#  endif
+			  }
+		      }
+		  }
+# endif
+
+		/* The generated string now extends from tmp to p, with the
+		   zero padding insertion point being at pad_ptr.  */
+		if (has_width && p - tmp < width)
+		  {
+		    size_t pad = width - (p - tmp);
+		    DCHAR_T *end = p + pad;
+
+		    if (flags & FLAG_LEFT)
+		      {
+			/* Pad with spaces on the right.  */
+			for (; pad > 0; pad--)
+			  *p++ = ' ';
+		      }
+		    else if ((flags & FLAG_ZERO) && pad_ptr != NULL)
+		      {
+			/* Pad with zeroes.  */
+			DCHAR_T *q = end;
+
+			while (p > pad_ptr)
+			  *--q = *--p;
+			for (; pad > 0; pad--)
+			  *p++ = '0';
+		      }
+		    else
+		      {
+			/* Pad with spaces on the left.  */
+			DCHAR_T *q = end;
+
+			while (p > tmp)
+			  *--q = *--p;
+			for (; pad > 0; pad--)
+			  *p++ = ' ';
+		      }
+
+		    p = end;
+		  }
+
+		{
+		  size_t count = p - tmp;
+
+		  if (count >= tmp_length)
+		    /* tmp_length was incorrectly calculated - fix the
+		       code above!  */
+		    abort ();
+
+		  /* Make room for the result.  */
+		  if (count >= allocated - length)
+		    {
+		      size_t n = xsum (length, count);
+
+		      ENSURE_ALLOCATION (n);
+		    }
+
+		  /* Append the result.  */
+		  memcpy (result + length, tmp, count * sizeof (DCHAR_T));
+		  if (tmp != tmpbuf)
+		    free (tmp);
+		  length += count;
+		}
+	      }
+#endif
+	    else
+	      {
+		arg_type type = a.arg[dp->arg_index].type;
+		int flags = dp->flags;
+#if !USE_SNPRINTF || !DCHAR_IS_TCHAR || ENABLE_UNISTDIO || NEED_PRINTF_FLAG_LEFTADJUST || NEED_PRINTF_FLAG_ZERO || NEED_PRINTF_UNBOUNDED_PRECISION
+		int has_width;
+		size_t width;
+#endif
+#if !USE_SNPRINTF || NEED_PRINTF_UNBOUNDED_PRECISION
+		int has_precision;
+		size_t precision;
+#endif
+#if NEED_PRINTF_UNBOUNDED_PRECISION
+		int prec_ourselves;
+#else
+#		define prec_ourselves 0
+#endif
+#if NEED_PRINTF_FLAG_LEFTADJUST
+#		define pad_ourselves 1
+#elif !DCHAR_IS_TCHAR || ENABLE_UNISTDIO || NEED_PRINTF_FLAG_ZERO || NEED_PRINTF_UNBOUNDED_PRECISION
+		int pad_ourselves;
+#else
+#		define pad_ourselves 0
+#endif
+		TCHAR_T *fbp;
+		unsigned int prefix_count;
+		int prefixes[2] IF_LINT (= { 0 });
+#if !USE_SNPRINTF
+		size_t tmp_length;
+		TCHAR_T tmpbuf[700];
+		TCHAR_T *tmp;
+#endif
+
+#if !USE_SNPRINTF || !DCHAR_IS_TCHAR || ENABLE_UNISTDIO || NEED_PRINTF_FLAG_LEFTADJUST || NEED_PRINTF_FLAG_ZERO || NEED_PRINTF_UNBOUNDED_PRECISION
+		has_width = 0;
+		width = 0;
+		if (dp->width_start != dp->width_end)
+		  {
+		    if (dp->width_arg_index != ARG_NONE)
+		      {
+			int arg;
+
+			if (!(a.arg[dp->width_arg_index].type == TYPE_INT))
+			  abort ();
+			arg = a.arg[dp->width_arg_index].a.a_int;
+			if (arg < 0)
+			  {
+			    /* "A negative field width is taken as a '-' flag
+			        followed by a positive field width."  */
+			    flags |= FLAG_LEFT;
+			    width = (unsigned int) (-arg);
+			  }
+			else
+			  width = arg;
+		      }
+		    else
+		      {
+			const FCHAR_T *digitp = dp->width_start;
+
+			do
+			  width = xsum (xtimes (width, 10), *digitp++ - '0');
+			while (digitp != dp->width_end);
+		      }
+		    has_width = 1;
+		  }
+#endif
+
+#if !USE_SNPRINTF || NEED_PRINTF_UNBOUNDED_PRECISION
+		has_precision = 0;
+		precision = 6;
+		if (dp->precision_start != dp->precision_end)
+		  {
+		    if (dp->precision_arg_index != ARG_NONE)
+		      {
+			int arg;
+
+			if (!(a.arg[dp->precision_arg_index].type == TYPE_INT))
+			  abort ();
+			arg = a.arg[dp->precision_arg_index].a.a_int;
+			/* "A negative precision is taken as if the precision
+			    were omitted."  */
+			if (arg >= 0)
+			  {
+			    precision = arg;
+			    has_precision = 1;
+			  }
+		      }
+		    else
+		      {
+			const FCHAR_T *digitp = dp->precision_start + 1;
+
+			precision = 0;
+			while (digitp != dp->precision_end)
+			  precision = xsum (xtimes (precision, 10), *digitp++ - '0');
+			has_precision = 1;
+		      }
+		  }
+#endif
+
+		/* Decide whether to handle the precision ourselves.  */
+#if NEED_PRINTF_UNBOUNDED_PRECISION
+		switch (dp->conversion)
+		  {
+		  case 'd': case 'i': case 'u':
+		  case 'o':
+		  case 'x': case 'X': case 'p':
+		    prec_ourselves = has_precision && (precision > 0);
+		    break;
+		  default:
+		    prec_ourselves = 0;
+		    break;
+		  }
+#endif
+
+		/* Decide whether to perform the padding ourselves.  */
+#if !NEED_PRINTF_FLAG_LEFTADJUST && (!DCHAR_IS_TCHAR || ENABLE_UNISTDIO || NEED_PRINTF_FLAG_ZERO || NEED_PRINTF_UNBOUNDED_PRECISION)
+		switch (dp->conversion)
+		  {
+# if !DCHAR_IS_TCHAR || ENABLE_UNISTDIO
+		  /* If we need conversion from TCHAR_T[] to DCHAR_T[], we need
+		     to perform the padding after this conversion.  Functions
+		     with unistdio extensions perform the padding based on
+		     character count rather than element count.  */
+		  case 'c': case 's':
+# endif
+# if NEED_PRINTF_FLAG_ZERO
+		  case 'f': case 'F': case 'e': case 'E': case 'g': case 'G':
+		  case 'a': case 'A':
+# endif
+		    pad_ourselves = 1;
+		    break;
+		  default:
+		    pad_ourselves = prec_ourselves;
+		    break;
+		  }
+#endif
+
+#if !USE_SNPRINTF
+		/* Allocate a temporary buffer of sufficient size for calling
+		   sprintf.  */
+		{
+		  switch (dp->conversion)
+		    {
+
+		    case 'd': case 'i': case 'u':
+# if HAVE_LONG_LONG_INT
+		      if (type == TYPE_LONGLONGINT || type == TYPE_ULONGLONGINT)
+			tmp_length =
+			  (unsigned int) (sizeof (unsigned long long) * CHAR_BIT
+					  * 0.30103 /* binary -> decimal */
+					 )
+			  + 1; /* turn floor into ceil */
+		      else
+# endif
+		      if (type == TYPE_LONGINT || type == TYPE_ULONGINT)
+			tmp_length =
+			  (unsigned int) (sizeof (unsigned long) * CHAR_BIT
+					  * 0.30103 /* binary -> decimal */
+					 )
+			  + 1; /* turn floor into ceil */
+		      else
+			tmp_length =
+			  (unsigned int) (sizeof (unsigned int) * CHAR_BIT
+					  * 0.30103 /* binary -> decimal */
+					 )
+			  + 1; /* turn floor into ceil */
+		      if (tmp_length < precision)
+			tmp_length = precision;
+		      /* Multiply by 2, as an estimate for FLAG_GROUP.  */
+		      tmp_length = xsum (tmp_length, tmp_length);
+		      /* Add 1, to account for a leading sign.  */
+		      tmp_length = xsum (tmp_length, 1);
+		      break;
+
+		    case 'o':
+# if HAVE_LONG_LONG_INT
+		      if (type == TYPE_LONGLONGINT || type == TYPE_ULONGLONGINT)
+			tmp_length =
+			  (unsigned int) (sizeof (unsigned long long) * CHAR_BIT
+					  * 0.333334 /* binary -> octal */
+					 )
+			  + 1; /* turn floor into ceil */
+		      else
+# endif
+		      if (type == TYPE_LONGINT || type == TYPE_ULONGINT)
+			tmp_length =
+			  (unsigned int) (sizeof (unsigned long) * CHAR_BIT
+					  * 0.333334 /* binary -> octal */
+					 )
+			  + 1; /* turn floor into ceil */
+		      else
+			tmp_length =
+			  (unsigned int) (sizeof (unsigned int) * CHAR_BIT
+					  * 0.333334 /* binary -> octal */
+					 )
+			  + 1; /* turn floor into ceil */
+		      if (tmp_length < precision)
+			tmp_length = precision;
+		      /* Add 1, to account for a leading sign.  */
+		      tmp_length = xsum (tmp_length, 1);
+		      break;
+
+		    case 'x': case 'X':
+# if HAVE_LONG_LONG_INT
+		      if (type == TYPE_LONGLONGINT || type == TYPE_ULONGLONGINT)
+			tmp_length =
+			  (unsigned int) (sizeof (unsigned long long) * CHAR_BIT
+					  * 0.25 /* binary -> hexadecimal */
+					 )
+			  + 1; /* turn floor into ceil */
+		      else
+# endif
+		      if (type == TYPE_LONGINT || type == TYPE_ULONGINT)
+			tmp_length =
+			  (unsigned int) (sizeof (unsigned long) * CHAR_BIT
+					  * 0.25 /* binary -> hexadecimal */
+					 )
+			  + 1; /* turn floor into ceil */
+		      else
+			tmp_length =
+			  (unsigned int) (sizeof (unsigned int) * CHAR_BIT
+					  * 0.25 /* binary -> hexadecimal */
+					 )
+			  + 1; /* turn floor into ceil */
+		      if (tmp_length < precision)
+			tmp_length = precision;
+		      /* Add 2, to account for a leading sign or alternate form.  */
+		      tmp_length = xsum (tmp_length, 2);
+		      break;
+
+		    case 'f': case 'F':
+		      if (type == TYPE_LONGDOUBLE)
+			tmp_length =
+			  (unsigned int) (LDBL_MAX_EXP
+					  * 0.30103 /* binary -> decimal */
+					  * 2 /* estimate for FLAG_GROUP */
+					 )
+			  + 1 /* turn floor into ceil */
+			  + 10; /* sign, decimal point etc. */
+		      else
+			tmp_length =
+			  (unsigned int) (DBL_MAX_EXP
+					  * 0.30103 /* binary -> decimal */
+					  * 2 /* estimate for FLAG_GROUP */
+					 )
+			  + 1 /* turn floor into ceil */
+			  + 10; /* sign, decimal point etc. */
+		      tmp_length = xsum (tmp_length, precision);
+		      break;
+
+		    case 'e': case 'E': case 'g': case 'G':
+		      tmp_length =
+			12; /* sign, decimal point, exponent etc. */
+		      tmp_length = xsum (tmp_length, precision);
+		      break;
+
+		    case 'a': case 'A':
+		      if (type == TYPE_LONGDOUBLE)
+			tmp_length =
+			  (unsigned int) (LDBL_DIG
+					  * 0.831 /* decimal -> hexadecimal */
+					 )
+			  + 1; /* turn floor into ceil */
+		      else
+			tmp_length =
+			  (unsigned int) (DBL_DIG
+					  * 0.831 /* decimal -> hexadecimal */
+					 )
+			  + 1; /* turn floor into ceil */
+		      if (tmp_length < precision)
+			tmp_length = precision;
+		      /* Account for sign, decimal point etc. */
+		      tmp_length = xsum (tmp_length, 12);
+		      break;
+
+		    case 'c':
+# if HAVE_WINT_T && !WIDE_CHAR_VERSION
+		      if (type == TYPE_WIDE_CHAR)
+			tmp_length = MB_CUR_MAX;
+		      else
+# endif
+			tmp_length = 1;
+		      break;
+
+		    case 's':
+# if HAVE_WCHAR_T
+		      if (type == TYPE_WIDE_STRING)
+			{
+#  if WIDE_CHAR_VERSION
+			  /* ISO C says about %ls in fwprintf:
+			       "If the precision is not specified or is greater
+				than the size of the array, the array shall
+				contain a null wide character."
+			     So if there is a precision, we must not use
+			     wcslen.  */
+			  const wchar_t *arg =
+			    a.arg[dp->arg_index].a.a_wide_string;
+
+			  if (has_precision)
+			    tmp_length = local_wcsnlen (arg, precision);
+			  else
+			    tmp_length = local_wcslen (arg);
+#  else
+			  /* ISO C says about %ls in fprintf:
+			       "If a precision is specified, no more than that
+				many bytes are written (including shift
+				sequences, if any), and the array shall contain
+				a null wide character if, to equal the
+				multibyte character sequence length given by
+				the precision, the function would need to
+				access a wide character one past the end of the
+				array."
+			     So if there is a precision, we must not use
+			     wcslen.  */
+			  /* This case has already been handled above.  */
+			  abort ();
+#  endif
+			}
+		      else
+# endif
+			{
+# if WIDE_CHAR_VERSION
+			  /* ISO C says about %s in fwprintf:
+			       "If the precision is not specified or is greater
+				than the size of the converted array, the
+				converted array shall contain a null wide
+				character."
+			     So if there is a precision, we must not use
+			     strlen.  */
+			  /* This case has already been handled above.  */
+			  abort ();
+# else
+			  /* ISO C says about %s in fprintf:
+			       "If the precision is not specified or greater
+				than the size of the array, the array shall
+				contain a null character."
+			     So if there is a precision, we must not use
+			     strlen.  */
+			  const char *arg = a.arg[dp->arg_index].a.a_string;
+
+			  if (has_precision)
+			    tmp_length = local_strnlen (arg, precision);
+			  else
+			    tmp_length = strlen (arg);
+# endif
+			}
+		      break;
+
+		    case 'p':
+		      tmp_length =
+			(unsigned int) (sizeof (void *) * CHAR_BIT
+					* 0.25 /* binary -> hexadecimal */
+				       )
+			  + 1 /* turn floor into ceil */
+			  + 2; /* account for leading 0x */
+		      break;
+
+		    default:
+		      abort ();
+		    }
+
+		  if (!pad_ourselves)
+		    {
+# if ENABLE_UNISTDIO
+		      /* Padding considers the number of characters, therefore
+			 the number of elements after padding may be
+			   > max (tmp_length, width)
+			 but is certainly
+			   <= tmp_length + width.  */
+		      tmp_length = xsum (tmp_length, width);
+# else
+		      /* Padding considers the number of elements,
+			 says POSIX.  */
+		      if (tmp_length < width)
+			tmp_length = width;
+# endif
+		    }
+
+		  tmp_length = xsum (tmp_length, 1); /* account for trailing NUL */
+		}
+
+		if (tmp_length <= sizeof (tmpbuf) / sizeof (TCHAR_T))
+		  tmp = tmpbuf;
+		else
+		  {
+		    size_t tmp_memsize = xtimes (tmp_length, sizeof (TCHAR_T));
+
+		    if (size_overflow_p (tmp_memsize))
+		      /* Overflow, would lead to out of memory.  */
+		      goto out_of_memory;
+		    tmp = (TCHAR_T *) malloc (tmp_memsize);
+		    if (tmp == NULL)
+		      /* Out of memory.  */
+		      goto out_of_memory;
+		  }
+#endif
+
+		/* Construct the format string for calling snprintf or
+		   sprintf.  */
+		fbp = buf;
+		*fbp++ = '%';
+#if NEED_PRINTF_FLAG_GROUPING
+		/* The underlying implementation doesn't support the ' flag.
+		   Produce no grouping characters in this case; this is
+		   acceptable because the grouping is locale dependent.  */
+#else
+		if (flags & FLAG_GROUP)
+		  *fbp++ = '\'';
+#endif
+		if (flags & FLAG_LEFT)
+		  *fbp++ = '-';
+		if (flags & FLAG_SHOWSIGN)
+		  *fbp++ = '+';
+		if (flags & FLAG_SPACE)
+		  *fbp++ = ' ';
+		if (flags & FLAG_ALT)
+		  *fbp++ = '#';
+		if (!pad_ourselves)
+		  {
+		    if (flags & FLAG_ZERO)
+		      *fbp++ = '0';
+		    if (dp->width_start != dp->width_end)
+		      {
+			size_t n = dp->width_end - dp->width_start;
+			/* The width specification is known to consist only
+			   of standard ASCII characters.  */
+			if (sizeof (FCHAR_T) == sizeof (TCHAR_T))
+			  {
+			    memcpy (fbp, dp->width_start, n * sizeof (TCHAR_T));
+			    fbp += n;
+			  }
+			else
+			  {
+			    const FCHAR_T *mp = dp->width_start;
+			    do
+			      *fbp++ = (unsigned char) *mp++;
+			    while (--n > 0);
+			  }
+		      }
+		  }
+		if (!prec_ourselves)
+		  {
+		    if (dp->precision_start != dp->precision_end)
+		      {
+			size_t n = dp->precision_end - dp->precision_start;
+			/* The precision specification is known to consist only
+			   of standard ASCII characters.  */
+			if (sizeof (FCHAR_T) == sizeof (TCHAR_T))
+			  {
+			    memcpy (fbp, dp->precision_start, n * sizeof (TCHAR_T));
+			    fbp += n;
+			  }
+			else
+			  {
+			    const FCHAR_T *mp = dp->precision_start;
+			    do
+			      *fbp++ = (unsigned char) *mp++;
+			    while (--n > 0);
+			  }
+		      }
+		  }
+
+		switch (type)
+		  {
+#if HAVE_LONG_LONG_INT
+		  case TYPE_LONGLONGINT:
+		  case TYPE_ULONGLONGINT:
+# if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
+		    *fbp++ = 'I';
+		    *fbp++ = '6';
+		    *fbp++ = '4';
+		    break;
+# else
+		    *fbp++ = 'l';
+		    /*FALLTHROUGH*/
+# endif
+#endif
+		  case TYPE_LONGINT:
+		  case TYPE_ULONGINT:
+#if HAVE_WINT_T
+		  case TYPE_WIDE_CHAR:
+#endif
+#if HAVE_WCHAR_T
+		  case TYPE_WIDE_STRING:
+#endif
+		    *fbp++ = 'l';
+		    break;
+		  case TYPE_LONGDOUBLE:
+		    *fbp++ = 'L';
+		    break;
+		  default:
+		    break;
+		  }
+#if NEED_PRINTF_DIRECTIVE_F
+		if (dp->conversion == 'F')
+		  *fbp = 'f';
+		else
+#endif
+		  *fbp = dp->conversion;
+#if USE_SNPRINTF
+# if !(__GLIBC__ > 2 || (__GLIBC__ == 2 && __GLIBC_MINOR__ >= 3) || ((defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__))
+		fbp[1] = '%';
+		fbp[2] = 'n';
+		fbp[3] = '\0';
+# else
+		/* On glibc2 systems from glibc >= 2.3 - probably also older
+		   ones - we know that snprintf's returns value conforms to
+		   ISO C 99: the gl_SNPRINTF_DIRECTIVE_N test passes.
+		   Therefore we can avoid using %n in this situation.
+		   On glibc2 systems from 2004-10-18 or newer, the use of %n
+		   in format strings in writable memory may crash the program
+		   (if compiled with _FORTIFY_SOURCE=2), so we should avoid it
+		   in this situation.  */
+		/* On native Win32 systems (such as mingw), we can avoid using
+		   %n because:
+		     - Although the gl_SNPRINTF_TRUNCATION_C99 test fails,
+		       snprintf does not write more than the specified number
+		       of bytes. (snprintf (buf, 3, "%d %d", 4567, 89) writes
+		       '4', '5', '6' into buf, not '4', '5', '\0'.)
+		     - Although the gl_SNPRINTF_RETVAL_C99 test fails, snprintf
+		       allows us to recognize the case of an insufficient
+		       buffer size: it returns -1 in this case.
+		   On native Win32 systems (such as mingw) where the OS is
+		   Windows Vista, the use of %n in format strings by default
+		   crashes the program. See
+		     <http://gcc.gnu.org/ml/gcc/2007-06/msg00122.html> and
+		     <http://msdn2.microsoft.com/en-us/library/ms175782(VS.80).aspx>
+		   So we should avoid %n in this situation.  */
+		fbp[1] = '\0';
+# endif
+#else
+		fbp[1] = '\0';
+#endif
+
+		/* Construct the arguments for calling snprintf or sprintf.  */
+		prefix_count = 0;
+		if (!pad_ourselves && dp->width_arg_index != ARG_NONE)
+		  {
+		    if (!(a.arg[dp->width_arg_index].type == TYPE_INT))
+		      abort ();
+		    prefixes[prefix_count++] = a.arg[dp->width_arg_index].a.a_int;
+		  }
+		if (!prec_ourselves && dp->precision_arg_index != ARG_NONE)
+		  {
+		    if (!(a.arg[dp->precision_arg_index].type == TYPE_INT))
+		      abort ();
+		    prefixes[prefix_count++] = a.arg[dp->precision_arg_index].a.a_int;
+		  }
+
+#if USE_SNPRINTF
+		/* The SNPRINTF result is appended after result[0..length].
+		   The latter is an array of DCHAR_T; SNPRINTF appends an
+		   array of TCHAR_T to it.  This is possible because
+		   sizeof (TCHAR_T) divides sizeof (DCHAR_T) and
+		   alignof (TCHAR_T) <= alignof (DCHAR_T).  */
+# define TCHARS_PER_DCHAR (sizeof (DCHAR_T) / sizeof (TCHAR_T))
+		/* Ensure that maxlen below will be >= 2.  Needed on BeOS,
+		   where an snprintf() with maxlen==1 acts like sprintf().  */
+		ENSURE_ALLOCATION (xsum (length,
+					 (2 + TCHARS_PER_DCHAR - 1)
+					 / TCHARS_PER_DCHAR));
+		/* Prepare checking whether snprintf returns the count
+		   via %n.  */
+		*(TCHAR_T *) (result + length) = '\0';
+#endif
+
+		for (;;)
+		  {
+		    int count = -1;
+
+#if USE_SNPRINTF
+		    int retcount = 0;
+		    size_t maxlen = allocated - length;
+		    /* SNPRINTF can fail if its second argument is
+		       > INT_MAX.  */
+		    if (maxlen > INT_MAX / TCHARS_PER_DCHAR)
+		      maxlen = INT_MAX / TCHARS_PER_DCHAR;
+		    maxlen = maxlen * TCHARS_PER_DCHAR;
+# define SNPRINTF_BUF(arg) \
+		    switch (prefix_count)				    \
+		      {							    \
+		      case 0:						    \
+			retcount = SNPRINTF ((TCHAR_T *) (result + length), \
+					     maxlen, buf,		    \
+					     arg, &count);		    \
+			break;						    \
+		      case 1:						    \
+			retcount = SNPRINTF ((TCHAR_T *) (result + length), \
+					     maxlen, buf,		    \
+					     prefixes[0], arg, &count);	    \
+			break;						    \
+		      case 2:						    \
+			retcount = SNPRINTF ((TCHAR_T *) (result + length), \
+					     maxlen, buf,		    \
+					     prefixes[0], prefixes[1], arg, \
+					     &count);			    \
+			break;						    \
+		      default:						    \
+			abort ();					    \
+		      }
+#else
+# define SNPRINTF_BUF(arg) \
+		    switch (prefix_count)				    \
+		      {							    \
+		      case 0:						    \
+			count = sprintf (tmp, buf, arg);		    \
+			break;						    \
+		      case 1:						    \
+			count = sprintf (tmp, buf, prefixes[0], arg);	    \
+			break;						    \
+		      case 2:						    \
+			count = sprintf (tmp, buf, prefixes[0], prefixes[1],\
+					 arg);				    \
+			break;						    \
+		      default:						    \
+			abort ();					    \
+		      }
+#endif
+
+		    switch (type)
+		      {
+		      case TYPE_SCHAR:
+			{
+			  int arg = a.arg[dp->arg_index].a.a_schar;
+			  SNPRINTF_BUF (arg);
+			}
+			break;
+		      case TYPE_UCHAR:
+			{
+			  unsigned int arg = a.arg[dp->arg_index].a.a_uchar;
+			  SNPRINTF_BUF (arg);
+			}
+			break;
+		      case TYPE_SHORT:
+			{
+			  int arg = a.arg[dp->arg_index].a.a_short;
+			  SNPRINTF_BUF (arg);
+			}
+			break;
+		      case TYPE_USHORT:
+			{
+			  unsigned int arg = a.arg[dp->arg_index].a.a_ushort;
+			  SNPRINTF_BUF (arg);
+			}
+			break;
+		      case TYPE_INT:
+			{
+			  int arg = a.arg[dp->arg_index].a.a_int;
+			  SNPRINTF_BUF (arg);
+			}
+			break;
+		      case TYPE_UINT:
+			{
+			  unsigned int arg = a.arg[dp->arg_index].a.a_uint;
+			  SNPRINTF_BUF (arg);
+			}
+			break;
+		      case TYPE_LONGINT:
+			{
+			  long int arg = a.arg[dp->arg_index].a.a_longint;
+			  SNPRINTF_BUF (arg);
+			}
+			break;
+		      case TYPE_ULONGINT:
+			{
+			  unsigned long int arg = a.arg[dp->arg_index].a.a_ulongint;
+			  SNPRINTF_BUF (arg);
+			}
+			break;
+#if HAVE_LONG_LONG_INT
+		      case TYPE_LONGLONGINT:
+			{
+			  long long int arg = a.arg[dp->arg_index].a.a_longlongint;
+			  SNPRINTF_BUF (arg);
+			}
+			break;
+		      case TYPE_ULONGLONGINT:
+			{
+			  unsigned long long int arg = a.arg[dp->arg_index].a.a_ulonglongint;
+			  SNPRINTF_BUF (arg);
+			}
+			break;
+#endif
+		      case TYPE_DOUBLE:
+			{
+			  double arg = a.arg[dp->arg_index].a.a_double;
+			  SNPRINTF_BUF (arg);
+			}
+			break;
+		      case TYPE_LONGDOUBLE:
+			{
+			  long double arg = a.arg[dp->arg_index].a.a_longdouble;
+			  SNPRINTF_BUF (arg);
+			}
+			break;
+		      case TYPE_CHAR:
+			{
+			  int arg = a.arg[dp->arg_index].a.a_char;
+			  SNPRINTF_BUF (arg);
+			}
+			break;
+#if HAVE_WINT_T
+		      case TYPE_WIDE_CHAR:
+			{
+			  wint_t arg = a.arg[dp->arg_index].a.a_wide_char;
+			  SNPRINTF_BUF (arg);
+			}
+			break;
+#endif
+		      case TYPE_STRING:
+			{
+			  const char *arg = a.arg[dp->arg_index].a.a_string;
+			  SNPRINTF_BUF (arg);
+			}
+			break;
+#if HAVE_WCHAR_T
+		      case TYPE_WIDE_STRING:
+			{
+			  const wchar_t *arg = a.arg[dp->arg_index].a.a_wide_string;
+			  SNPRINTF_BUF (arg);
+			}
+			break;
+#endif
+		      case TYPE_POINTER:
+			{
+			  void *arg = a.arg[dp->arg_index].a.a_pointer;
+			  SNPRINTF_BUF (arg);
+			}
+			break;
+		      default:
+			abort ();
+		      }
+
+#if USE_SNPRINTF
+		    /* Portability: Not all implementations of snprintf()
+		       are ISO C 99 compliant.  Determine the number of
+		       bytes that snprintf() has produced or would have
+		       produced.  */
+		    if (count >= 0)
+		      {
+			/* Verify that snprintf() has NUL-terminated its
+			   result.  */
+			if (count < maxlen
+			    && ((TCHAR_T *) (result + length)) [count] != '\0')
+			  abort ();
+			/* Portability hack.  */
+			if (retcount > count)
+			  count = retcount;
+		      }
+		    else
+		      {
+			/* snprintf() doesn't understand the '%n'
+			   directive.  */
+			if (fbp[1] != '\0')
+			  {
+			    /* Don't use the '%n' directive; instead, look
+			       at the snprintf() return value.  */
+			    fbp[1] = '\0';
+			    continue;
+			  }
+			else
+			  {
+			    /* Look at the snprintf() return value.  */
+			    if (retcount < 0)
+			      {
+				/* HP-UX 10.20 snprintf() is doubly deficient:
+				   It doesn't understand the '%n' directive,
+				   *and* it returns -1 (rather than the length
+				   that would have been required) when the
+				   buffer is too small.  */
+				size_t bigger_need =
+				  xsum (xtimes (allocated, 2), 12);
+				ENSURE_ALLOCATION (bigger_need);
+				continue;
+			      }
+			    else
+			      count = retcount;
+			  }
+		      }
+#endif
+
+		    /* Attempt to handle failure.  */
+		    if (count < 0)
+		      {
+			if (!(result == resultbuf || result == NULL))
+			  free (result);
+			if (buf_malloced != NULL)
+			  free (buf_malloced);
+			CLEANUP ();
+			errno = EINVAL;
+			return NULL;
+		      }
+
+#if USE_SNPRINTF
+		    /* Handle overflow of the allocated buffer.
+		       If such an overflow occurs, a C99 compliant snprintf()
+		       returns a count >= maxlen.  However, a non-compliant
+		       snprintf() function returns only count = maxlen - 1.  To
+		       cover both cases, test whether count >= maxlen - 1.  */
+		    if ((unsigned int) count + 1 >= maxlen)
+		      {
+			/* If maxlen already has attained its allowed maximum,
+			   allocating more memory will not increase maxlen.
+			   Instead of looping, bail out.  */
+			if (maxlen == INT_MAX / TCHARS_PER_DCHAR)
+			  goto overflow;
+			else
+			  {
+			    /* Need at least (count + 1) * sizeof (TCHAR_T)
+			       bytes.  (The +1 is for the trailing NUL.)
+			       But ask for (count + 2) * sizeof (TCHAR_T)
+			       bytes, so that in the next round, we likely get
+			         maxlen > (unsigned int) count + 1
+			       and so we don't get here again.
+			       And allocate proportionally, to avoid looping
+			       eternally if snprintf() reports a too small
+			       count.  */
+			    size_t n =
+			      xmax (xsum (length,
+					  ((unsigned int) count + 2
+					   + TCHARS_PER_DCHAR - 1)
+					  / TCHARS_PER_DCHAR),
+				    xtimes (allocated, 2));
+
+			    ENSURE_ALLOCATION (n);
+			    continue;
+			  }
+		      }
+#endif
+
+#if NEED_PRINTF_UNBOUNDED_PRECISION
+		    if (prec_ourselves)
+		      {
+			/* Handle the precision.  */
+			TCHAR_T *prec_ptr =
+# if USE_SNPRINTF
+			  (TCHAR_T *) (result + length);
+# else
+			  tmp;
+# endif
+			size_t prefix_count;
+			size_t move;
+
+			prefix_count = 0;
+			/* Put the additional zeroes after the sign.  */
+			if (count >= 1
+			    && (*prec_ptr == '-' || *prec_ptr == '+'
+				|| *prec_ptr == ' '))
+			  prefix_count = 1;
+			/* Put the additional zeroes after the 0x prefix if
+			   (flags & FLAG_ALT) || (dp->conversion == 'p').  */
+			else if (count >= 2
+				 && prec_ptr[0] == '0'
+				 && (prec_ptr[1] == 'x' || prec_ptr[1] == 'X'))
+			  prefix_count = 2;
+
+			move = count - prefix_count;
+			if (precision > move)
+			  {
+			    /* Insert zeroes.  */
+			    size_t insert = precision - move;
+			    TCHAR_T *prec_end;
+
+# if USE_SNPRINTF
+			    size_t n =
+			      xsum (length,
+				    (count + insert + TCHARS_PER_DCHAR - 1)
+				    / TCHARS_PER_DCHAR);
+			    length += (count + TCHARS_PER_DCHAR - 1) / TCHARS_PER_DCHAR;
+			    ENSURE_ALLOCATION (n);
+			    length -= (count + TCHARS_PER_DCHAR - 1) / TCHARS_PER_DCHAR;
+			    prec_ptr = (TCHAR_T *) (result + length);
+# endif
+
+			    prec_end = prec_ptr + count;
+			    prec_ptr += prefix_count;
+
+			    while (prec_end > prec_ptr)
+			      {
+				prec_end--;
+				prec_end[insert] = prec_end[0];
+			      }
+
+			    prec_end += insert;
+			    do
+			      *--prec_end = '0';
+			    while (prec_end > prec_ptr);
+
+			    count += insert;
+			  }
+		      }
+#endif
+
+#if !USE_SNPRINTF
+		    if (count >= tmp_length)
+		      /* tmp_length was incorrectly calculated - fix the
+			 code above!  */
+		      abort ();
+#endif
+
+#if !DCHAR_IS_TCHAR
+		    /* Convert from TCHAR_T[] to DCHAR_T[].  */
+		    if (dp->conversion == 'c' || dp->conversion == 's')
+		      {
+			/* type = TYPE_CHAR or TYPE_WIDE_CHAR or TYPE_STRING
+			   TYPE_WIDE_STRING.
+			   The result string is not certainly ASCII.  */
+			const TCHAR_T *tmpsrc;
+			DCHAR_T *tmpdst;
+			size_t tmpdst_len;
+			/* This code assumes that TCHAR_T is 'char'.  */
+			typedef int TCHAR_T_verify
+				    [2 * (sizeof (TCHAR_T) == 1) - 1];
+# if USE_SNPRINTF
+			tmpsrc = (TCHAR_T *) (result + length);
+# else
+			tmpsrc = tmp;
+# endif
+			tmpdst =
+			  DCHAR_CONV_FROM_ENCODING (locale_charset (),
+						    iconveh_question_mark,
+						    tmpsrc, count,
+						    NULL,
+						    NULL, &tmpdst_len);
+			if (tmpdst == NULL)
+			  {
+			    int saved_errno = errno;
+			    if (!(result == resultbuf || result == NULL))
+			      free (result);
+			    if (buf_malloced != NULL)
+			      free (buf_malloced);
+			    CLEANUP ();
+			    errno = saved_errno;
+			    return NULL;
+			  }
+			ENSURE_ALLOCATION (xsum (length, tmpdst_len));
+			DCHAR_CPY (result + length, tmpdst, tmpdst_len);
+			free (tmpdst);
+			count = tmpdst_len;
+		      }
+		    else
+		      {
+			/* The result string is ASCII.
+			   Simple 1:1 conversion.  */
+# if USE_SNPRINTF
+			/* If sizeof (DCHAR_T) == sizeof (TCHAR_T), it's a
+			   no-op conversion, in-place on the array starting
+			   at (result + length).  */
+			if (sizeof (DCHAR_T) != sizeof (TCHAR_T))
+# endif
+			  {
+			    const TCHAR_T *tmpsrc;
+			    DCHAR_T *tmpdst;
+			    size_t n;
+
+# if USE_SNPRINTF
+			    if (result == resultbuf)
+			      {
+				tmpsrc = (TCHAR_T *) (result + length);
+				/* ENSURE_ALLOCATION will not move tmpsrc
+				   (because it's part of resultbuf).  */
+				ENSURE_ALLOCATION (xsum (length, count));
+			      }
+			    else
+			      {
+				/* ENSURE_ALLOCATION will move the array
+				   (because it uses realloc().  */
+				ENSURE_ALLOCATION (xsum (length, count));
+				tmpsrc = (TCHAR_T *) (result + length);
+			      }
+# else
+			    tmpsrc = tmp;
+			    ENSURE_ALLOCATION (xsum (length, count));
+# endif
+			    tmpdst = result + length;
+			    /* Copy backwards, because of overlapping.  */
+			    tmpsrc += count;
+			    tmpdst += count;
+			    for (n = count; n > 0; n--)
+			      *--tmpdst = (unsigned char) *--tmpsrc;
+			  }
+		      }
+#endif
+
+#if DCHAR_IS_TCHAR && !USE_SNPRINTF
+		    /* Make room for the result.  */
+		    if (count > allocated - length)
+		      {
+			/* Need at least count elements.  But allocate
+			   proportionally.  */
+			size_t n =
+			  xmax (xsum (length, count), xtimes (allocated, 2));
+
+			ENSURE_ALLOCATION (n);
+		      }
+#endif
+
+		    /* Here count <= allocated - length.  */
+
+		    /* Perform padding.  */
+#if !DCHAR_IS_TCHAR || ENABLE_UNISTDIO || NEED_PRINTF_FLAG_LEFTADJUST || NEED_PRINTF_FLAG_ZERO || NEED_PRINTF_UNBOUNDED_PRECISION
+		    if (pad_ourselves && has_width)
+		      {
+			size_t w;
+# if ENABLE_UNISTDIO
+			/* Outside POSIX, it's preferrable to compare the width
+			   against the number of _characters_ of the converted
+			   value.  */
+			w = DCHAR_MBSNLEN (result + length, count);
+# else
+			/* The width is compared against the number of _bytes_
+			   of the converted value, says POSIX.  */
+			w = count;
+# endif
+			if (w < width)
+			  {
+			    size_t pad = width - w;
+
+			    /* Make room for the result.  */
+			    if (xsum (count, pad) > allocated - length)
+			      {
+				/* Need at least count + pad elements.  But
+				   allocate proportionally.  */
+				size_t n =
+				  xmax (xsum3 (length, count, pad),
+					xtimes (allocated, 2));
+
+# if USE_SNPRINTF
+				length += count;
+				ENSURE_ALLOCATION (n);
+				length -= count;
+# else
+				ENSURE_ALLOCATION (n);
+# endif
+			      }
+			    /* Here count + pad <= allocated - length.  */
+
+			    {
+# if !DCHAR_IS_TCHAR || USE_SNPRINTF
+			      DCHAR_T * const rp = result + length;
+# else
+			      DCHAR_T * const rp = tmp;
+# endif
+			      DCHAR_T *p = rp + count;
+			      DCHAR_T *end = p + pad;
+			      DCHAR_T *pad_ptr;
+# if !DCHAR_IS_TCHAR || ENABLE_UNISTDIO
+			      if (dp->conversion == 'c'
+				  || dp->conversion == 's')
+				/* No zero-padding for string directives.  */
+				pad_ptr = NULL;
+			      else
+# endif
+				{
+				  pad_ptr = (*rp == '-' ? rp + 1 : rp);
+				  /* No zero-padding of "inf" and "nan".  */
+				  if ((*pad_ptr >= 'A' && *pad_ptr <= 'Z')
+				      || (*pad_ptr >= 'a' && *pad_ptr <= 'z'))
+				    pad_ptr = NULL;
+				}
+			      /* The generated string now extends from rp to p,
+				 with the zero padding insertion point being at
+				 pad_ptr.  */
+
+			      count = count + pad; /* = end - rp */
+
+			      if (flags & FLAG_LEFT)
+				{
+				  /* Pad with spaces on the right.  */
+				  for (; pad > 0; pad--)
+				    *p++ = ' ';
+				}
+			      else if ((flags & FLAG_ZERO) && pad_ptr != NULL)
+				{
+				  /* Pad with zeroes.  */
+				  DCHAR_T *q = end;
+
+				  while (p > pad_ptr)
+				    *--q = *--p;
+				  for (; pad > 0; pad--)
+				    *p++ = '0';
+				}
+			      else
+				{
+				  /* Pad with spaces on the left.  */
+				  DCHAR_T *q = end;
+
+				  while (p > rp)
+				    *--q = *--p;
+				  for (; pad > 0; pad--)
+				    *p++ = ' ';
+				}
+			    }
+			  }
+		      }
+#endif
+
+		    /* Here still count <= allocated - length.  */
+
+#if !DCHAR_IS_TCHAR || USE_SNPRINTF
+		    /* The snprintf() result did fit.  */
+#else
+		    /* Append the sprintf() result.  */
+		    memcpy (result + length, tmp, count * sizeof (DCHAR_T));
+#endif
+#if !USE_SNPRINTF
+		    if (tmp != tmpbuf)
+		      free (tmp);
+#endif
+
+#if NEED_PRINTF_DIRECTIVE_F
+		    if (dp->conversion == 'F')
+		      {
+			/* Convert the %f result to upper case for %F.  */
+			DCHAR_T *rp = result + length;
+			size_t rc;
+			for (rc = count; rc > 0; rc--, rp++)
+			  if (*rp >= 'a' && *rp <= 'z')
+			    *rp = *rp - 'a' + 'A';
+		      }
+#endif
+
+		    length += count;
+		    break;
+		  }
+	      }
+	  }
+      }
+
+    /* Add the final NUL.  */
+    ENSURE_ALLOCATION (xsum (length, 1));
+    result[length] = '\0';
+
+    if (result != resultbuf && length + 1 < allocated)
+      {
+	/* Shrink the allocated memory if possible.  */
+	DCHAR_T *memory;
+
+	memory = (DCHAR_T *) realloc (result, (length + 1) * sizeof (DCHAR_T));
+	if (memory != NULL)
+	  result = memory;
+      }
+
+    if (buf_malloced != NULL)
+      free (buf_malloced);
+    CLEANUP ();
+    *lengthp = length;
+    /* Note that we can produce a big string of a length > INT_MAX.  POSIX
+       says that snprintf() fails with errno = EOVERFLOW in this case, but
+       that's only because snprintf() returns an 'int'.  This function does
+       not have this limitation.  */
+    return result;
+
+#if USE_SNPRINTF
+  overflow:
+    if (!(result == resultbuf || result == NULL))
+      free (result);
+    if (buf_malloced != NULL)
+      free (buf_malloced);
+    CLEANUP ();
+    errno = EOVERFLOW;
+    return NULL;
+#endif
+
+  out_of_memory:
+    if (!(result == resultbuf || result == NULL))
+      free (result);
+    if (buf_malloced != NULL)
+      free (buf_malloced);
+  out_of_memory_1:
+    CLEANUP ();
+    errno = ENOMEM;
+    return NULL;
+  }
+}
+
+#undef TCHARS_PER_DCHAR
+#undef SNPRINTF
+#undef USE_SNPRINTF
+#undef DCHAR_CPY
+#undef PRINTF_PARSE
+#undef DIRECTIVES
+#undef DIRECTIVE
+#undef DCHAR_IS_TCHAR
+#undef TCHAR_T
+#undef DCHAR_T
+#undef FCHAR_T
+#undef VASNPRINTF
diff --git a/lib/vasnprintf.h b/lib/vasnprintf.h
new file mode 100644
index 000000000..5ceab4475
--- /dev/null
+++ b/lib/vasnprintf.h
@@ -0,0 +1,81 @@
+/* vsprintf with automatic memory allocation.
+   Copyright (C) 2002-2004, 2007-2008 Free Software Foundation, Inc.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 2, or (at your option)
+   any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License along
+   with this program; if not, write to the Free Software Foundation,
+   Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+#ifndef _VASNPRINTF_H
+#define _VASNPRINTF_H
+
+/* Get va_list.  */
+#include <stdarg.h>
+
+/* Get size_t.  */
+#include <stddef.h>
+
+#ifndef __attribute__
+/* This feature is available in gcc versions 2.5 and later.  */
+# if __GNUC__ < 2 || (__GNUC__ == 2 && __GNUC_MINOR__ < 5)
+#  define __attribute__(Spec) /* empty */
+# endif
+/* The __-protected variants of `format' and `printf' attributes
+   are accepted by gcc versions 2.6.4 (effectively 2.7) and later.  */
+# if __GNUC__ < 2 || (__GNUC__ == 2 && __GNUC_MINOR__ < 7)
+#  define __format__ format
+#  define __printf__ printf
+# endif
+#endif
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/* Write formatted output to a string dynamically allocated with malloc().
+   You can pass a preallocated buffer for the result in RESULTBUF and its
+   size in *LENGTHP; otherwise you pass RESULTBUF = NULL.
+   If successful, return the address of the string (this may be = RESULTBUF
+   if no dynamic memory allocation was necessary) and set *LENGTHP to the
+   number of resulting bytes, excluding the trailing NUL.  Upon error, set
+   errno and return NULL.
+
+   When dynamic memory allocation occurs, the preallocated buffer is left
+   alone (with possibly modified contents).  This makes it possible to use
+   a statically allocated or stack-allocated buffer, like this:
+
+          char buf[100];
+          size_t len = sizeof (buf);
+          char *output = vasnprintf (buf, &len, format, args);
+          if (output == NULL)
+            ... error handling ...;
+          else
+            {
+              ... use the output string ...;
+              if (output != buf)
+                free (output);
+            }
+  */
+#if REPLACE_VASNPRINTF
+# define asnprintf rpl_asnprintf
+# define vasnprintf rpl_vasnprintf
+#endif
+extern char * asnprintf (char *resultbuf, size_t *lengthp, const char *format, ...)
+       __attribute__ ((__format__ (__printf__, 3, 4)));
+extern char * vasnprintf (char *resultbuf, size_t *lengthp, const char *format, va_list args)
+       __attribute__ ((__format__ (__printf__, 3, 0)));
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* _VASNPRINTF_H */
diff --git a/lib/verify.h b/lib/verify.h
new file mode 100644
index 000000000..e82fa02d9
--- /dev/null
+++ b/lib/verify.h
@@ -0,0 +1,140 @@
+/* Compile-time assert-like macros.
+
+   Copyright (C) 2005, 2006 Free Software Foundation, Inc.
+
+   This program is free software: you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+/* Written by Paul Eggert, Bruno Haible, and Jim Meyering.  */
+
+#ifndef VERIFY_H
+# define VERIFY_H 1
+
+/* Each of these macros verifies that its argument R is nonzero.  To
+   be portable, R should be an integer constant expression.  Unlike
+   assert (R), there is no run-time overhead.
+
+   There are two macros, since no single macro can be used in all
+   contexts in C.  verify_true (R) is for scalar contexts, including
+   integer constant expression contexts.  verify (R) is for declaration
+   contexts, e.g., the top level.
+
+   Symbols ending in "__" are private to this header.
+
+   The code below uses several ideas.
+
+   * The first step is ((R) ? 1 : -1).  Given an expression R, of
+     integral or boolean or floating-point type, this yields an
+     expression of integral type, whose value is later verified to be
+     constant and nonnegative.
+
+   * Next this expression W is wrapped in a type
+     struct verify_type__ { unsigned int verify_error_if_negative_size__: W; }.
+     If W is negative, this yields a compile-time error.  No compiler can
+     deal with a bit-field of negative size.
+
+     One might think that an array size check would have the same
+     effect, that is, that the type struct { unsigned int dummy[W]; }
+     would work as well.  However, inside a function, some compilers
+     (such as C++ compilers and GNU C) allow local parameters and
+     variables inside array size expressions.  With these compilers,
+     an array size check would not properly diagnose this misuse of
+     the verify macro:
+
+       void function (int n) { verify (n < 0); }
+
+   * For the verify macro, the struct verify_type__ will need to
+     somehow be embedded into a declaration.  To be portable, this
+     declaration must declare an object, a constant, a function, or a
+     typedef name.  If the declared entity uses the type directly,
+     such as in
+
+       struct dummy {...};
+       typedef struct {...} dummy;
+       extern struct {...} *dummy;
+       extern void dummy (struct {...} *);
+       extern struct {...} *dummy (void);
+
+     two uses of the verify macro would yield colliding declarations
+     if the entity names are not disambiguated.  A workaround is to
+     attach the current line number to the entity name:
+
+       #define GL_CONCAT0(x, y) x##y
+       #define GL_CONCAT(x, y) GL_CONCAT0 (x, y)
+       extern struct {...} * GL_CONCAT(dummy,__LINE__);
+
+     But this has the problem that two invocations of verify from
+     within the same macro would collide, since the __LINE__ value
+     would be the same for both invocations.
+
+     A solution is to use the sizeof operator.  It yields a number,
+     getting rid of the identity of the type.  Declarations like
+
+       extern int dummy [sizeof (struct {...})];
+       extern void dummy (int [sizeof (struct {...})]);
+       extern int (*dummy (void)) [sizeof (struct {...})];
+
+     can be repeated.
+
+   * Should the implementation use a named struct or an unnamed struct?
+     Which of the following alternatives can be used?
+
+       extern int dummy [sizeof (struct {...})];
+       extern int dummy [sizeof (struct verify_type__ {...})];
+       extern void dummy (int [sizeof (struct {...})]);
+       extern void dummy (int [sizeof (struct verify_type__ {...})]);
+       extern int (*dummy (void)) [sizeof (struct {...})];
+       extern int (*dummy (void)) [sizeof (struct verify_type__ {...})];
+
+     In the second and sixth case, the struct type is exported to the
+     outer scope; two such declarations therefore collide.  GCC warns
+     about the first, third, and fourth cases.  So the only remaining
+     possibility is the fifth case:
+
+       extern int (*dummy (void)) [sizeof (struct {...})];
+
+   * This implementation exploits the fact that GCC does not warn about
+     the last declaration mentioned above.  If a future version of GCC
+     introduces a warning for this, the problem could be worked around
+     by using code specialized to GCC, e.g.,:
+
+       #if 4 <= __GNUC__
+       # define verify(R) \
+	   extern int (* verify_function__ (void)) \
+		      [__builtin_constant_p (R) && (R) ? 1 : -1]
+       #endif
+
+   * In C++, any struct definition inside sizeof is invalid.
+     Use a template type to work around the problem.  */
+
+
+/* Verify requirement R at compile-time, as an integer constant expression.
+   Return 1.  */
+
+# ifdef __cplusplus
+template <int w>
+  struct verify_type__ { unsigned int verify_error_if_negative_size__: w; };
+#  define verify_true(R) \
+     (!!sizeof (verify_type__<(R) ? 1 : -1>))
+# else
+#  define verify_true(R) \
+     (!!sizeof \
+      (struct { unsigned int verify_error_if_negative_size__: (R) ? 1 : -1; }))
+# endif
+
+/* Verify requirement R at compile-time, as a declaration without a
+   trailing ';'.  */
+
+# define verify(R) extern int (* verify_function__ (void)) [verify_true (R)]
+
+#endif
diff --git a/lib/vsnprintf.c b/lib/vsnprintf.c
new file mode 100644
index 000000000..1fdfb6bc8
--- /dev/null
+++ b/lib/vsnprintf.c
@@ -0,0 +1,71 @@
+/* Formatted output to strings.
+   Copyright (C) 2004, 2006-2008 Free Software Foundation, Inc.
+   Written by Simon Josefsson and Yoann Vandoorselaere <yoann@prelude-ids.org>.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 2, or (at your option)
+   any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License along
+   with this program; if not, write to the Free Software Foundation,
+   Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+/* Specification.  */
+#include <stdio.h>
+
+#include <errno.h>
+#include <limits.h>
+#include <stdarg.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "vasnprintf.h"
+
+/* Print formatted output to string STR.  Similar to vsprintf, but
+   additional length SIZE limit how much is written into STR.  Returns
+   string length of formatted string (which may be larger than SIZE).
+   STR may be NULL, in which case nothing will be written.  On error,
+   return a negative value.  */
+int
+vsnprintf (char *str, size_t size, const char *format, va_list args)
+{
+  char *output;
+  size_t len;
+  size_t lenbuf = size;
+
+  output = vasnprintf (str, &lenbuf, format, args);
+  len = lenbuf;
+
+  if (!output)
+    return -1;
+
+  if (output != str)
+    {
+      if (size)
+	{
+	  size_t pruned_len = (len < size ? len : size - 1);
+	  memcpy (str, output, pruned_len);
+	  str[pruned_len] = '\0';
+	}
+
+      free (output);
+    }
+
+  if (len > INT_MAX)
+    {
+      errno = EOVERFLOW;
+      return -1;
+    }
+
+  return len;
+}
diff --git a/lib/wchar.in.h b/lib/wchar.in.h
index 3425062ab..1f1f13098 100644
--- a/lib/wchar.in.h
+++ b/lib/wchar.in.h
@@ -1,6 +1,6 @@
 /* A substitute for ISO C99 <wchar.h>, for platforms that have issues.
 
-   Copyright (C) 2007-2008 Free Software Foundation, Inc.
+   Copyright (C) 2007-2009 Free Software Foundation, Inc.
 
    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU Lesser General Public License as published by
@@ -30,8 +30,18 @@
 @PRAGMA_SYSTEM_HEADER@
 #endif
 
-#ifdef __need_mbstate_t
-/* Special invocation convention inside uClibc header files.  */
+#if defined __need_mbstate_t || (defined __hpux && ((defined _INTTYPES_INCLUDED && !defined strtoimax) || defined _GL_JUST_INCLUDE_SYSTEM_WCHAR_H)) || defined _GL_ALREADY_INCLUDING_WCHAR_H
+/* Special invocation convention:
+   - Inside uClibc header files.
+   - On HP-UX 11.00 we have a sequence of nested includes
+     <wchar.h> -> <stdlib.h> -> <stdint.h>, and the latter includes <wchar.h>,
+     once indirectly <stdint.h> -> <sys/types.h> -> <inttypes.h> -> <wchar.h>
+     and once directly.  In both situations 'wint_t' is not yet defined,
+     therefore we cannot provide the function overrides; instead include only
+     the system's <wchar.h>.
+   - On IRIX 6.5, similarly, we have an include <wchar.h> -> <wctype.h>, and
+     the latter includes <wchar.h>.  But here, we have no way to detect whether
+     <wctype.h> is completely included or is still being included.  */
 
 #@INCLUDE_NEXT@ @NEXT_WCHAR_H@
 
@@ -40,6 +50,8 @@
 
 #ifndef _GL_WCHAR_H
 
+#define _GL_ALREADY_INCLUDING_WCHAR_H
+
 /* Tru64 with Desktop Toolkit C has a bug: <stdio.h> must be included before
    <wchar.h>.
    BSD/OS 4.0.1 has a bug: <stddef.h>, <stdio.h> and <time.h> must be
@@ -55,6 +67,8 @@
 # @INCLUDE_NEXT@ @NEXT_WCHAR_H@
 #endif
 
+#undef _GL_ALREADY_INCLUDING_WCHAR_H
+
 #ifndef _GL_WCHAR_H
 #define _GL_WCHAR_H
 
@@ -250,7 +264,11 @@ extern size_t wcsrtombs (char *dest, const wchar_t **srcp, size_t len, mbstate_t
 
 /* Convert a wide string to a string.  */
 #if @GNULIB_WCSNRTOMBS@
-# if !@HAVE_WCSNRTOMBS@
+# if @REPLACE_WCSNRTOMBS@
+#  undef wcsnrtombs
+#  define wcsnrtombs rpl_wcsnrtombs
+# endif
+# if !@HAVE_WCSNRTOMBS@ || @REPLACE_WCSNRTOMBS@
 extern size_t wcsnrtombs (char *dest, const wchar_t **srcp, size_t srclen, size_t len, mbstate_t *ps);
 # endif
 #elif defined GNULIB_POSIXCHECK
diff --git a/lib/xsize.h b/lib/xsize.h
new file mode 100644
index 000000000..0b30045e8
--- /dev/null
+++ b/lib/xsize.h
@@ -0,0 +1,108 @@
+/* xsize.h -- Checked size_t computations.
+
+   Copyright (C) 2003, 2008 Free Software Foundation, Inc.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published by
+   the Free Software Foundation; either version 2, or (at your option)
+   any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public License
+   along with this program; if not, write to the Free Software Foundation,
+   Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  */
+
+#ifndef _XSIZE_H
+#define _XSIZE_H
+
+/* Get size_t.  */
+#include <stddef.h>
+
+/* Get SIZE_MAX.  */
+#include <limits.h>
+#if HAVE_STDINT_H
+# include <stdint.h>
+#endif
+
+/* The size of memory objects is often computed through expressions of
+   type size_t. Example:
+      void* p = malloc (header_size + n * element_size).
+   These computations can lead to overflow.  When this happens, malloc()
+   returns a piece of memory that is way too small, and the program then
+   crashes while attempting to fill the memory.
+   To avoid this, the functions and macros in this file check for overflow.
+   The convention is that SIZE_MAX represents overflow.
+   malloc (SIZE_MAX) is not guaranteed to fail -- think of a malloc
+   implementation that uses mmap --, it's recommended to use size_overflow_p()
+   or size_in_bounds_p() before invoking malloc().
+   The example thus becomes:
+      size_t size = xsum (header_size, xtimes (n, element_size));
+      void *p = (size_in_bounds_p (size) ? malloc (size) : NULL);
+*/
+
+/* Convert an arbitrary value >= 0 to type size_t.  */
+#define xcast_size_t(N) \
+  ((N) <= SIZE_MAX ? (size_t) (N) : SIZE_MAX)
+
+/* Sum of two sizes, with overflow check.  */
+static inline size_t
+#if __GNUC__ >= 3
+__attribute__ ((__pure__))
+#endif
+xsum (size_t size1, size_t size2)
+{
+  size_t sum = size1 + size2;
+  return (sum >= size1 ? sum : SIZE_MAX);
+}
+
+/* Sum of three sizes, with overflow check.  */
+static inline size_t
+#if __GNUC__ >= 3
+__attribute__ ((__pure__))
+#endif
+xsum3 (size_t size1, size_t size2, size_t size3)
+{
+  return xsum (xsum (size1, size2), size3);
+}
+
+/* Sum of four sizes, with overflow check.  */
+static inline size_t
+#if __GNUC__ >= 3
+__attribute__ ((__pure__))
+#endif
+xsum4 (size_t size1, size_t size2, size_t size3, size_t size4)
+{
+  return xsum (xsum (xsum (size1, size2), size3), size4);
+}
+
+/* Maximum of two sizes, with overflow check.  */
+static inline size_t
+#if __GNUC__ >= 3
+__attribute__ ((__pure__))
+#endif
+xmax (size_t size1, size_t size2)
+{
+  /* No explicit check is needed here, because for any n:
+     max (SIZE_MAX, n) == SIZE_MAX and max (n, SIZE_MAX) == SIZE_MAX.  */
+  return (size1 >= size2 ? size1 : size2);
+}
+
+/* Multiplication of a count with an element size, with overflow check.
+   The count must be >= 0 and the element size must be > 0.
+   This is a macro, not an inline function, so that it works correctly even
+   when N is of a wider type and N > SIZE_MAX.  */
+#define xtimes(N, ELSIZE) \
+  ((N) <= SIZE_MAX / (ELSIZE) ? (size_t) (N) * (ELSIZE) : SIZE_MAX)
+
+/* Check for overflow.  */
+#define size_overflow_p(SIZE) \
+  ((SIZE) == SIZE_MAX)
+/* Check against overflow.  */
+#define size_in_bounds_p(SIZE) \
+  ((SIZE) != SIZE_MAX)
+
+#endif /* _XSIZE_H */
diff --git a/libguile.h b/libguile.h
index 40122dfa2..74674d5b9 100644
--- a/libguile.h
+++ b/libguile.h
@@ -1,21 +1,22 @@
 #ifndef SCM_LIBGUILE_H
 #define SCM_LIBGUILE_H
 
-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2004, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2004, 2006, 2008, 2009 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -30,8 +31,13 @@ extern "C" {
 #include "libguile/__scm.h"
 #include "libguile/alist.h"
 #include "libguile/arbiters.h"
+#include "libguile/array-handle.h"
+#include "libguile/array-map.h"
+#include "libguile/arrays.h"
 #include "libguile/async.h"
 #include "libguile/boolean.h"
+#include "libguile/bitvectors.h"
+#include "libguile/bytevectors.h"
 #include "libguile/chars.h"
 #include "libguile/continuations.h"
 #include "libguile/dynl.h"
@@ -48,6 +54,8 @@ extern "C" {
 #include "libguile/futures.h"
 #include "libguile/gc.h"
 #include "libguile/gdbint.h"
+#include "libguile/generalized-arrays.h"
+#include "libguile/generalized-vectors.h"
 #include "libguile/goops.h"
 #include "libguile/gsubr.h"
 #include "libguile/guardians.h"
@@ -75,7 +83,7 @@ extern "C" {
 #include "libguile/procprop.h"
 #include "libguile/properties.h"
 #include "libguile/procs.h"
-#include "libguile/ramap.h"
+#include "libguile/r6rs-ports.h"
 #include "libguile/random.h"
 #include "libguile/read.h"
 #include "libguile/root.h"
@@ -98,7 +106,7 @@ extern "C" {
 #include "libguile/symbols.h"
 #include "libguile/tags.h"
 #include "libguile/throw.h"
-#include "libguile/unif.h"
+#include "libguile/uniform.h"
 #include "libguile/validate.h"
 #include "libguile/values.h"
 #include "libguile/variable.h"
diff --git a/libguile/.gitignore b/libguile/.gitignore
index 41f7909d2..09f1b06b7 100644
--- a/libguile/.gitignore
+++ b/libguile/.gitignore
@@ -13,3 +13,4 @@ guile_filter_doc_snarfage
 libpath.h
 scmconfig.h
 version.h
+vm-i-*.i
diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index 9b05f01be..046ce21cc 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -4,20 +4,20 @@
 ##
 ##   This file is part of GUILE.
 ##
-##   GUILE 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
+##   GUILE is free software; you can redistribute it and/or modify it
+##   under the terms of the GNU Lesser General Public License as
+##   published by the Free Software Foundation; either version 3, or
 ##   (at your option) any later version.
 ##
 ##   GUILE is distributed in the hope that 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.
+##   GNU Lesser General Public License for more details.
 ##
-##   You should have received a copy of the GNU General Public
-##   License along with GUILE; see the file COPYING.  If not, write
-##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-##   Floor, Boston, MA 02110-1301 USA
+##   You should have received a copy of the GNU Lesser General Public
+##   License along with GUILE; see the file COPYING.LESSER.  If not,
+##   write to the Free Software Foundation, Inc., 51 Franklin Street,
+##   Fifth Floor, Boston, MA 02110-1301 USA
 
 AUTOMAKE_OPTIONS = gnu
 
@@ -32,10 +32,10 @@ DEFAULT_INCLUDES =
 ## Check for headers in $(srcdir)/.., so that #include
 ## <libguile/MUMBLE.h> will find MUMBLE.h in this dir when we're
 ## building.  Also look for Gnulib headers in `lib'.
-AM_CPPFLAGS = -I$(top_srcdir) -I$(top_builddir)		\
+AM_CPPFLAGS = -DBUILDING_LIBGUILE=1 -I$(top_srcdir) -I$(top_builddir) \
 	      -I$(top_srcdir)/lib -I$(top_builddir)/lib
 
-AM_CFLAGS = $(GCC_CFLAGS)
+AM_CFLAGS = $(GCC_CFLAGS) $(CFLAG_VISIBILITY)
 
 ## The Gnulib Libtool archive.
 gnulib_library = $(top_builddir)/lib/libgnu.la
@@ -85,7 +85,7 @@ c-tokenize.$(OBJEXT): c-tokenize.c
 	if [ "$(cross_compiling)" = "yes" ]; then \
 		$(CC_FOR_BUILD) $(DEFS) $(AM_CPPFLAGS) -c -o $@ $<; \
 	else \
-		$(COMPILE) -c -o $@ $<; \
+		$(filter-out -Werror,$(COMPILE)) -c -o $@ $<; \
 	fi
 
 ## Override default rule; this should run on BUILD host.
@@ -105,21 +105,103 @@ guile_LDFLAGS = $(GUILE_CFLAGS)
 
 libguile_la_CFLAGS = $(GUILE_CFLAGS) $(AM_CFLAGS)
 
-libguile_la_SOURCES = alist.c arbiters.c async.c backtrace.c boolean.c	\
-    chars.c continuations.c convert.c debug.c deprecation.c		\
-    deprecated.c discouraged.c dynwind.c eq.c error.c	\
-    eval.c evalext.c extensions.c feature.c fluids.c fports.c		\
-    futures.c gc.c gc-malloc.c						\
-    gdbint.c gettext.c goops.c gsubr.c					\
-    guardians.c hash.c hashtab.c hooks.c init.c inline.c		\
-    ioext.c keywords.c lang.c list.c load.c macros.c mallocs.c		\
-    modules.c numbers.c objects.c objprop.c options.c pairs.c ports.c	\
-    print.c procprop.c procs.c properties.c random.c rdelim.c read.c	\
-    root.c rw.c scmsigs.c script.c simpos.c smob.c sort.c srcprop.c	\
-    stackchk.c stacks.c stime.c strings.c srfi-4.c srfi-13.c srfi-14.c	\
-    strorder.c strports.c struct.c symbols.c threads.c null-threads.c	\
-    throw.c values.c variable.c vectors.c version.c vports.c weaks.c	\
-    ramap.c unif.c
+libguile_la_SOURCES =				\
+	alist.c					\
+	arbiters.c				\
+	array-handle.c				\
+	array-map.c				\
+	arrays.c				\
+	async.c					\
+	backtrace.c				\
+	boolean.c				\
+	bitvectors.c				\
+	bytevectors.c				\
+	chars.c					\
+	continuations.c				\
+	debug.c					\
+	deprecated.c				\
+	deprecation.c				\
+	discouraged.c				\
+	dynwind.c				\
+	eq.c					\
+	error.c					\
+	eval.c					\
+	evalext.c				\
+	extensions.c				\
+	feature.c				\
+	fluids.c				\
+	fports.c				\
+	frames.c				\
+	futures.c				\
+	gc-malloc.c				\
+	gc.c					\
+	gdbint.c				\
+	gettext.c				\
+	generalized-arrays.c			\
+	generalized-vectors.c			\
+	goops.c					\
+	gsubr.c					\
+	guardians.c				\
+	hash.c					\
+	hashtab.c				\
+	hooks.c					\
+	init.c					\
+	inline.c				\
+	instructions.c				\
+	ioext.c					\
+	keywords.c				\
+	lang.c					\
+	list.c					\
+	load.c					\
+	macros.c				\
+	mallocs.c				\
+	modules.c				\
+	null-threads.c				\
+	numbers.c				\
+	objcodes.c				\
+	objects.c				\
+	objprop.c				\
+	options.c				\
+	pairs.c					\
+	ports.c					\
+	print.c					\
+	procprop.c				\
+	procs.c					\
+	programs.c				\
+	properties.c				\
+	r6rs-ports.c				\
+	random.c				\
+	rdelim.c				\
+	read.c					\
+	root.c					\
+	rw.c					\
+	scmsigs.c				\
+	script.c				\
+	simpos.c				\
+	smob.c					\
+	sort.c					\
+	srcprop.c				\
+	srfi-13.c				\
+	srfi-14.c				\
+	srfi-4.c				\
+	stackchk.c				\
+	stacks.c				\
+	stime.c					\
+	strings.c				\
+	strorder.c				\
+	strports.c				\
+	struct.c				\
+	symbols.c				\
+	threads.c				\
+	throw.c					\
+	uniform.c				\
+	values.c				\
+	variable.c				\
+	vectors.c				\
+	version.c				\
+	vm.c					\
+	vports.c				\
+	weaks.c
 
 libguile_i18n_v_@LIBGUILE_I18N_MAJOR@_la_SOURCES = i18n.c
 libguile_i18n_v_@LIBGUILE_I18N_MAJOR@_la_CFLAGS =	\
@@ -130,45 +212,205 @@ libguile_i18n_v_@LIBGUILE_I18N_MAJOR@_la_LDFLAGS =	\
    -module -L$(builddir) -lguile				\
    -version-info @LIBGUILE_I18N_INTERFACE@
 
-DOT_X_FILES = alist.x arbiters.x async.x backtrace.x boolean.x chars.x	\
-    continuations.x debug.x deprecation.x deprecated.x discouraged.x	\
-    dynl.x dynwind.x environments.x eq.x error.x eval.x evalext.x	\
-    extensions.x feature.x fluids.x fports.x futures.x gc.x		\
-    gettext.x goops.x gsubr.x guardians.x				\
-    hash.x hashtab.x hooks.x i18n.x init.x ioext.x keywords.x lang.x	\
-    list.x load.x macros.x mallocs.x modules.x numbers.x objects.x	\
-    objprop.x options.x pairs.x ports.x print.x procprop.x procs.x	\
-    properties.x random.x rdelim.x read.x root.x rw.x scmsigs.x		\
-    script.x simpos.x smob.x sort.x srcprop.x stackchk.x stacks.x	\
-    stime.x strings.x srfi-4.x srfi-13.x srfi-14.x strorder.x		\
-    strports.x struct.x symbols.x threads.x throw.x values.x		\
-    variable.x vectors.x version.x vports.x weaks.x ramap.x unif.x
+DOT_X_FILES =					\
+	alist.x					\
+	arbiters.x				\
+	array-handle.x				\
+	array-map.x				\
+	arrays.x				\
+	async.x					\
+	backtrace.x				\
+	boolean.x				\
+	bitvectors.x				\
+	bytevectors.x				\
+	chars.x					\
+	continuations.x				\
+	debug.x					\
+	deprecated.x				\
+	deprecation.x				\
+	discouraged.x				\
+	dynl.x					\
+	dynwind.x				\
+	eq.x					\
+	error.x					\
+	eval.x					\
+	evalext.x				\
+	extensions.x				\
+	feature.x				\
+	fluids.x				\
+	fports.x				\
+	futures.x				\
+	gc-malloc.x				\
+	gc.x					\
+	gettext.x				\
+	generalized-arrays.x			\
+	generalized-vectors.x			\
+	goops.x					\
+	gsubr.x					\
+	guardians.x				\
+	hash.x					\
+	hashtab.x				\
+	hooks.x					\
+	i18n.x					\
+	init.x					\
+	ioext.x					\
+	keywords.x				\
+	lang.x					\
+	list.x					\
+	load.x					\
+	macros.x				\
+	mallocs.x				\
+	modules.x				\
+	numbers.x				\
+	objects.x				\
+	objprop.x				\
+	options.x				\
+	pairs.x					\
+	ports.x					\
+	print.x					\
+	procprop.x				\
+	procs.x					\
+	properties.x				\
+	r6rs-ports.x				\
+	random.x				\
+	rdelim.x				\
+	read.x					\
+	root.x					\
+	rw.x					\
+	scmsigs.x				\
+	script.x				\
+	simpos.x				\
+	smob.x					\
+	sort.x					\
+	srcprop.x				\
+	srfi-13.x				\
+	srfi-14.x				\
+	srfi-4.x				\
+	stackchk.x				\
+	stacks.x				\
+	stime.x					\
+	strings.x				\
+	strorder.x				\
+	strports.x				\
+	struct.x				\
+	symbols.x				\
+	threads.x				\
+	throw.x					\
+	uniform.x				\
+	values.x				\
+	variable.x				\
+	vectors.x				\
+	version.x				\
+	vports.x				\
+	weaks.x
+
+# vm-related snarfs
+DOT_X_FILES += frames.x instructions.x objcodes.x programs.x vm.x
 
 EXTRA_DOT_X_FILES = @EXTRA_DOT_X_FILES@
 
-DOT_DOC_FILES = alist.doc arbiters.doc async.doc backtrace.doc		\
-    boolean.doc chars.doc continuations.doc debug.doc deprecation.doc	\
-    deprecated.doc discouraged.doc dynl.doc dynwind.doc			\
-    eq.doc error.doc eval.doc evalext.doc		\
-    extensions.doc feature.doc fluids.doc fports.doc futures.doc	\
-    gc.doc goops.doc gsubr.doc						\
-    gc-malloc.doc gettext.doc guardians.doc hash.doc hashtab.doc	\
-    hooks.doc i18n.doc init.doc ioext.doc keywords.doc lang.doc		\
-    list.doc load.doc macros.doc mallocs.doc modules.doc numbers.doc	\
-    objects.doc objprop.doc options.doc pairs.doc ports.doc print.doc	\
-    procprop.doc procs.doc properties.doc random.doc rdelim.doc		\
-    read.doc root.doc rw.doc scmsigs.doc script.doc simpos.doc		\
-    smob.doc sort.doc srcprop.doc stackchk.doc stacks.doc stime.doc	\
-    strings.doc srfi-4.doc srfi-13.doc srfi-14.doc strorder.doc		\
-    strports.doc struct.doc symbols.doc threads.doc throw.doc		\
-    values.doc variable.doc vectors.doc version.doc vports.doc		\
-    weaks.doc ramap.doc unif.doc
+DOT_DOC_FILES = 				\
+	alist.doc				\
+	arbiters.doc				\
+	array-handle.doc			\
+	array-map.doc				\
+	arrays.doc				\
+	async.doc				\
+	backtrace.doc				\
+	boolean.doc				\
+	bitvectors.doc				\
+	bytevectors.doc				\
+	chars.doc				\
+	continuations.doc			\
+	debug.doc				\
+	deprecated.doc				\
+	deprecation.doc				\
+	discouraged.doc				\
+	dynl.doc				\
+	dynwind.doc				\
+	eq.doc					\
+	error.doc				\
+	eval.doc				\
+	evalext.doc				\
+	extensions.doc				\
+	feature.doc				\
+	fluids.doc				\
+	fports.doc				\
+	futures.doc				\
+	gc-malloc.doc				\
+	gc.doc					\
+	gettext.doc				\
+	generalized-arrays.doc			\
+	generalized-vectors.doc			\
+	goops.doc				\
+	gsubr.doc				\
+	guardians.doc				\
+	hash.doc				\
+	hashtab.doc				\
+	hooks.doc				\
+	i18n.doc				\
+	init.doc				\
+	ioext.doc				\
+	keywords.doc				\
+	lang.doc				\
+	list.doc				\
+	load.doc				\
+	macros.doc				\
+	mallocs.doc				\
+	modules.doc				\
+	numbers.doc				\
+	objects.doc				\
+	objprop.doc				\
+	options.doc				\
+	pairs.doc				\
+	ports.doc				\
+	print.doc				\
+	procprop.doc				\
+	procs.doc				\
+	properties.doc				\
+	r6rs-ports.doc				\
+	random.doc				\
+	rdelim.doc				\
+	read.doc				\
+	root.doc				\
+	rw.doc					\
+	scmsigs.doc				\
+	script.doc				\
+	simpos.doc				\
+	smob.doc				\
+	sort.doc				\
+	srcprop.doc				\
+	srfi-13.doc				\
+	srfi-14.doc				\
+	srfi-4.doc				\
+	stackchk.doc				\
+	stacks.doc				\
+	stime.doc				\
+	strings.doc				\
+	strorder.doc				\
+	strports.doc				\
+	struct.doc				\
+	symbols.doc				\
+	threads.doc				\
+	throw.doc				\
+	uniform.doc				\
+	values.doc				\
+	variable.doc				\
+	vectors.doc				\
+	version.doc				\
+	vports.doc				\
+	weaks.doc
 
 EXTRA_DOT_DOC_FILES = @EXTRA_DOT_DOC_FILES@
 
+DOT_I_FILES = vm-i-system.i vm-i-scheme.i vm-i-loader.i
+
+.c.i:
+	grep '^VM_DEFINE' $< > $@
+
 BUILT_SOURCES = cpp_err_symbols.c cpp_sig_symbols.c libpath.h \
     version.h scmconfig.h \
-    $(DOT_X_FILES) $(EXTRA_DOT_X_FILES)
+    $(DOT_I_FILES) $(DOT_X_FILES) $(EXTRA_DOT_X_FILES)
 
 EXTRA_libguile_la_SOURCES = _scm.h		\
     inet_aton.c memmove.c putenv.c strerror.c	\
@@ -188,41 +430,145 @@ install-exec-hook:
 ## compile, since they are #included.  So instead we list them here.
 ## Perhaps we can deal with them normally once the merge seems to be
 ## working.
-noinst_HEADERS = convert.i.c					\
-                 conv-integer.i.c conv-uinteger.i.c		\
-                 eval.i.c					\
-                 srfi-4.i.c					\
+noinst_HEADERS = conv-integer.i.c conv-uinteger.i.c		\
+                 eval.i.c ieee-754.h				\
+                 srfi-4.i.c srfi-14.i.c				\
                  quicksort.i.c                                  \
                  win32-uname.h win32-dirent.h win32-socket.h	\
 	         private-gc.h private-options.h
 
+# vm instructions
+noinst_HEADERS += vm-engine.c vm-i-system.c vm-i-scheme.c vm-i-loader.c
+
 libguile_la_DEPENDENCIES = @LIBLOBJS@
-libguile_la_LIBADD = @LIBLOBJS@ $(gnulib_library)
+libguile_la_LIBADD = @LIBLOBJS@ $(gnulib_library) $(LTLIBGMP) $(LTLIBUNISTRING)
 libguile_la_LDFLAGS = @LTLIBINTL@ -version-info @LIBGUILE_INTERFACE_CURRENT@:@LIBGUILE_INTERFACE_REVISION@:@LIBGUILE_INTERFACE_AGE@ -export-dynamic -no-undefined
 
+if HAVE_LD_VERSION_SCRIPT
+
+libguile_la_LDFLAGS += -Wl,--version-script="$(srcdir)/libguile.map"
+
+endif HAVE_LD_VERSION_SCRIPT
+
+
 # These are headers visible as <guile/mumble.h>
 pkginclude_HEADERS = 
 
 # These are headers visible as <libguile/mumble.h>.
 modincludedir = $(includedir)/libguile
-modinclude_HEADERS = __scm.h alist.h arbiters.h async.h backtrace.h	\
-    boehm-gc.h								\
-    boolean.h chars.h continuations.h convert.h debug.h debug-malloc.h	\
-    deprecation.h deprecated.h discouraged.h dynl.h dynwind.h		\
-    eq.h error.h eval.h evalext.h extensions.h		\
-    feature.h filesys.h fluids.h fports.h futures.h gc.h		\
-    gdb_interface.h gdbint.h gettext.h goops.h				\
-    gsubr.h guardians.h hash.h						\
-    hashtab.h hooks.h i18n.h init.h inline.h ioext.h iselect.h		\
-    keywords.h lang.h list.h load.h macros.h mallocs.h modules.h	\
-    net_db.h numbers.h objects.h objprop.h options.h pairs.h ports.h	\
-    posix.h regex-posix.h print.h procprop.h procs.h properties.h	\
-    random.h ramap.h rdelim.h read.h root.h rw.h scmsigs.h validate.h	\
-    script.h simpos.h smob.h snarf.h socket.h sort.h srcprop.h		\
-    stackchk.h stacks.h stime.h strings.h srfi-4.h srfi-13.h srfi-14.h	\
-    strorder.h strports.h struct.h symbols.h tags.h threads.h		\
-    pthread-threads.h null-threads.h throw.h unif.h values.h		\
-    variable.h vectors.h vports.h weaks.h
+modinclude_HEADERS =				\
+	__scm.h					\
+	alist.h					\
+	arbiters.h				\
+	array-handle.h				\
+	array-map.h				\
+	arrays.h				\
+	async.h					\
+	backtrace.h				\
+	boolean.h				\
+	bitvectors.h				\
+	bytevectors.h				\
+	chars.h					\
+	continuations.h				\
+	debug-malloc.h				\
+	debug.h					\
+	deprecated.h				\
+	deprecation.h				\
+	discouraged.h				\
+	dynl.h					\
+	dynwind.h				\
+	eq.h					\
+	error.h					\
+	eval.h					\
+	evalext.h				\
+	extensions.h				\
+	feature.h				\
+	filesys.h				\
+	fluids.h				\
+	fports.h				\
+	frames.h				\
+	futures.h				\
+	gc.h					\
+	gdb_interface.h				\
+	gdbint.h				\
+	gettext.h				\
+	generalized-arrays.h			\
+	generalized-vectors.h			\
+	goops.h					\
+	gsubr.h					\
+	guardians.h				\
+	hash.h					\
+	hashtab.h				\
+	hooks.h					\
+	i18n.h					\
+	init.h					\
+	inline.h				\
+	instructions.h				\
+	ioext.h					\
+	iselect.h				\
+	keywords.h				\
+	lang.h					\
+	list.h					\
+	load.h					\
+	macros.h				\
+	mallocs.h				\
+	modules.h				\
+	net_db.h				\
+	null-threads.h				\
+	numbers.h				\
+	objcodes.h				\
+	objects.h				\
+	objprop.h				\
+	options.h				\
+	pairs.h					\
+	ports.h					\
+	posix.h					\
+	print.h					\
+	procprop.h				\
+	procs.h					\
+	programs.h				\
+	properties.h				\
+	pthread-threads.h			\
+	r6rs-ports.h				\
+	random.h				\
+	rdelim.h				\
+	read.h					\
+	regex-posix.h				\
+	root.h					\
+	rw.h					\
+	scmsigs.h				\
+	script.h				\
+	simpos.h				\
+	smob.h					\
+	snarf.h					\
+	socket.h				\
+	sort.h					\
+	srcprop.h				\
+	srfi-13.h				\
+	srfi-14.h				\
+	srfi-4.h				\
+	stackchk.h				\
+	stacks.h				\
+	stime.h					\
+	strings.h				\
+	strorder.h				\
+	strports.h				\
+	struct.h				\
+	symbols.h				\
+	tags.h					\
+	threads.h				\
+	throw.h					\
+	validate.h				\
+	uniform.h				\
+	values.h				\
+	variable.h				\
+	vectors.h				\
+	vm-bootstrap.h				\
+	vm-engine.h				\
+	vm-expand.h				\
+	vm.h					\
+	vports.h				\
+	weaks.h
 
 nodist_modinclude_HEADERS = version.h scmconfig.h
 
@@ -237,7 +583,7 @@ EXTRA_DIST = ChangeLog-scm ChangeLog-threads		\
     cpp_errno.c cpp_err_symbols.in cpp_err_symbols.c			\
     cpp_sig_symbols.c cpp_sig_symbols.in cpp_cnvt.awk			\
     c-tokenize.lex version.h.in						\
-    scmconfig.h.top libgettext.h measure-hwm.scm
+    scmconfig.h.top libgettext.h unidata_to_charset.pl libguile.map
 #    $(DOT_DOC_FILES) $(EXTRA_DOT_DOC_FILES) \
 #    guile-procedures.txt guile.texi
 
@@ -259,6 +605,8 @@ libpath.h: $(srcdir)/Makefile.in  $(top_builddir)/config.status
 	@echo '#define SCM_PKGDATA_DIR "$(pkgdatadir)"' >> libpath.tmp
 	@echo '#define SCM_LIBRARY_DIR "$(pkgdatadir)/$(GUILE_EFFECTIVE_VERSION)"'>>libpath.tmp
 	@echo '#define SCM_SITE_DIR "$(pkgdatadir)/site"' >> libpath.tmp
+	@echo '#define SCM_CCACHE_DIR "$(pkglibdir)/$(GUILE_EFFECTIVE_VERSION)/ccache"' >> libpath.tmp
+	@echo '#define SCM_EFFECTIVE_VERSION "$(GUILE_EFFECTIVE_VERSION)"' >> libpath.tmp
 	@echo '#define SCM_BUILD_INFO { \' >> libpath.tmp
 	@echo '	{ "srcdir", "'"`cd @srcdir@; pwd`"'" }, \' >> libpath.tmp
 	@echo ' { "top_srcdir",    "@top_srcdir_absolute@" }, \' >> libpath.tmp
@@ -272,12 +620,13 @@ libpath.h: $(srcdir)/Makefile.in  $(top_builddir)/config.status
 	@echo '	{ "sharedstatedir", "@sharedstatedir@" }, \' >> libpath.tmp
 	@echo '	{ "localstatedir", "@localstatedir@" }, \' >> libpath.tmp
 	@echo '	{ "libdir",	   "@libdir@" }, \' >> libpath.tmp
+	@echo '	{ "ccachedir",	   SCM_CCACHE_DIR }, \' >> libpath.tmp
 	@echo '	{ "infodir",	   "@infodir@" }, \' >> libpath.tmp
 	@echo '	{ "mandir",	   "@mandir@" }, \' >> libpath.tmp
 	@echo '	{ "includedir",	   "@includedir@" }, \' >> libpath.tmp
-	@echo '	{ "pkgdatadir",	   "$(datadir)/@PACKAGE@" }, \' >> libpath.tmp
-	@echo '	{ "pkglibdir",	   "$(libdir)/@PACKAGE@" }, \' >> libpath.tmp
-	@echo '	{ "pkgincludedir", "$(includedir)/@PACKAGE@" }, \' \
+	@echo '	{ "pkgdatadir",	   "@pkgdatadir@" }, \' >> libpath.tmp
+	@echo '	{ "pkglibdir",	   "@pkglibdir@" }, \' >> libpath.tmp
+	@echo '	{ "pkgincludedir", "@pkgincludedir@" }, \' \
 		>> libpath.tmp
 	@echo '	{ "guileversion", "@GUILE_VERSION@" }, \' >> libpath.tmp
 	@echo '	{ "libguileinterface", "@LIBGUILE_INTERFACE@" }, \' \
@@ -307,10 +656,8 @@ error.x: cpp_err_symbols.c
 posix.x: cpp_sig_symbols.c
 load.x: libpath.h
 
-include $(top_srcdir)/am/pre-inst-guile
-
 alldotdocfiles    = $(DOT_DOC_FILES) $(EXTRA_DOT_DOC_FILES)
-snarf2checkedtexi = GUILE="$(GUILE_FOR_BUILD)" $(top_srcdir)/scripts/snarf-check-and-output-texi
+snarf2checkedtexi = GUILE_AUTO_COMPILE=0 $(top_builddir)/meta/uninstalled-env guile-tools snarf-check-and-output-texi
 dotdoc2texi       = cat $(alldotdocfiles) | $(snarf2checkedtexi)
 
 guile.texi: $(alldotdocfiles) guile$(EXEEXT)
@@ -332,29 +679,6 @@ guile-procedures.txt: guile-procedures.texi
 
 endif
 
-# Stack limit calibration for `make check'.  (For why we do this, see
-# the comments in measure-hwm.scm.)  We're relying here on a couple of
-# bits of Automake magic.
-#
-# 1. The fact that "libguile" comes before "test-suite" in SUBDIRS in
-# our toplevel Makefile.am.  This ensures that the
-# stack-limit-calibration.scm "test" will be run before any of the
-# tests under test-suite.
-#
-# 2. The fact that each test is invoked as $TESTS_ENVIRONMENT $test.
-# This allows us to ensure that the test will be considered to have
-# passed, by using `true' as TESTS_ENVIRONMENT.
-#
-# Why don't we care about the test "actually passing"?  Because the
-# important thing about stack-limit-calibration.scm is just that it is
-# generated in the first place, so that other tests under test-suite
-# can use it.
-TESTS = stack-limit-calibration.scm
-TESTS_ENVIRONMENT = true
-
-stack-limit-calibration.scm: measure-hwm.scm guile$(EXEEXT)
-	$(preinstguile) -s $(srcdir)/measure-hwm.scm > $@
-
 c-tokenize.c: c-tokenize.lex
 	flex -t $(srcdir)/c-tokenize.lex > $@ || { rm $@; false; }
 
@@ -409,8 +733,9 @@ MOSTLYCLEANFILES = \
 	cpp_err_symbols_here cpp_err_symbols_diff cpp_err_symbols_new \
 	cpp_sig_symbols_here cpp_sig_symbols_diff cpp_sig_symbols_new \
 	version.h version.h.tmp \
-	scmconfig.h scmconfig.h.tmp stack-limit-calibration.scm
+	scmconfig.h scmconfig.h.tmp
 
-CLEANFILES = libpath.h *.x *.doc guile-procedures.txt guile-procedures.texi guile.texi
+CLEANFILES = libpath.h *.x *.doc guile-procedures.txt guile-procedures.texi guile.texi \
+	vm-i-*.i
 
 MAINTAINERCLEANFILES = c-tokenize.c
diff --git a/libguile/__scm.h b/libguile/__scm.h
index a9f05ba46..32b52df51 100644
--- a/libguile/__scm.h
+++ b/libguile/__scm.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2003, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -98,13 +99,10 @@
 #define SCM_UNLIKELY(_expr)  SCM_EXPECT ((_expr), 0)
 
 /* The SCM_INTERNAL macro makes it possible to explicitly declare a function
- * as having "internal" linkage.  */
-#if (defined __GNUC__) && \
-  ((__GNUC__ >= 4) || (__GNUC__ == 3 && __GNUC_MINOR__ == 3))
-# define SCM_INTERNAL  extern __attribute__ ((__visibility__ ("internal")))
-#else
-# define SCM_INTERNAL  extern
-#endif
+ * as having "internal" linkage.  However our current tack on this problem is
+ * to use GCC 4's -fvisibility=hidden, making functions internal by default,
+ * and then SCM_API marks them for export. */
+#define SCM_INTERNAL  extern
 
 /* The SCM_ALIGNED macro, when defined, can be used to instruct the compiler
  * to honor the given alignment constraint.  */
@@ -164,13 +162,14 @@
 
 
 /* SCM_API is a macro prepended to all function and data definitions
-   which should be exported or imported in the resulting dynamic link
-   library (DLL) in the Win32 port. */
-
-#if defined (SCM_IMPORT)
-# define SCM_API __declspec (dllimport) extern
-#elif defined (SCM_EXPORT) || defined (DLL_EXPORT)
-# define SCM_API __declspec (dllexport) extern
+   which should be exported from libguile. */
+
+#if BUILDING_LIBGUILE && HAVE_VISIBILITY
+# define SCM_API extern __attribute__((__visibility__("default")))
+#elif BUILDING_LIBGUILE && defined _MSC_VER
+# define SCM_API __declspec(dllexport) extern
+#elif defined _MSC_VER
+# define SCM_API __declspec(dllimport) extern
 #else
 # define SCM_API extern
 #endif
@@ -434,19 +433,28 @@
     typedef struct {
       ucontext_t ctx;
       int fresh;
-    } jmp_buf;
-#   define setjmp(JB)				        \
+    } scm_i_jmp_buf;
+#   define SCM_I_SETJMP(JB)			        \
       ( (JB).fresh = 1,				        \
         getcontext (&((JB).ctx)),			\
         ((JB).fresh ? ((JB).fresh = 0, 0) : 1) )
-#   define longjmp(JB,VAL) scm_ia64_longjmp (&(JB), VAL)
-    void scm_ia64_longjmp (jmp_buf *, int);
+#   define SCM_I_LONGJMP(JB,VAL) scm_ia64_longjmp (&(JB), VAL)
+    void scm_ia64_longjmp (scm_i_jmp_buf *, int);
 #  else                 	/* ndef __ia64__ */
 #   include <setjmp.h>
 #  endif			/* ndef __ia64__ */
 # endif				/* ndef _CRAY1 */
 #endif				/* ndef vms */
 
+/* For any platform where SCM_I_SETJMP hasn't been defined in some
+   special way above, map SCM_I_SETJMP, SCM_I_LONGJMP and
+   scm_i_jmp_buf to setjmp, longjmp and jmp_buf. */
+#ifndef SCM_I_SETJMP
+#define scm_i_jmp_buf jmp_buf
+#define SCM_I_SETJMP setjmp
+#define SCM_I_LONGJMP longjmp
+#endif
+
 /* 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.
@@ -567,6 +575,13 @@ SCM_API SCM scm_call_generic_1 (SCM gf, SCM a1);
   return (SCM_UNPACK (gf)					\
 	  ? scm_call_generic_1 ((gf), (a1))			\
 	  : (scm_wrong_type_arg ((subr), (pos), (a1)), SCM_UNSPECIFIED))
+
+/* This form is for dispatching a subroutine.  */
+#define SCM_WTA_DISPATCH_1_SUBR(subr, a1, pos)				\
+  return (SCM_UNPACK ((*SCM_SUBR_GENERIC (subr)))			\
+	  ? scm_call_generic_1 ((*SCM_SUBR_GENERIC (subr)), (a1))	\
+	  : (scm_i_wrong_type_arg_symbol (SCM_SUBR_NAME (subr), (pos), (a1)), SCM_UNSPECIFIED))
+
 #define SCM_GASSERT1(cond, gf, a1, pos, subr)		\
   if (SCM_UNLIKELY (!(cond)))			\
     SCM_WTA_DISPATCH_1((gf), (a1), (pos), (subr))
diff --git a/libguile/_scm.h b/libguile/_scm.h
index ff033ded0..9907adf24 100644
--- a/libguile/_scm.h
+++ b/libguile/_scm.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,2000,2001, 2002, 2006, 2008, 2009 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -58,6 +59,7 @@
 #endif
 
 #include <errno.h>
+#include <verify.h>
 #include "libguile/__scm.h"
 
 /* Include headers for those files central to the implementation.  The
@@ -79,20 +81,6 @@
 #include "libguile/inline.h"
 #include "libguile/strings.h"
 
-/* SCM_SYSCALL retries system calls that have been interrupted (EINTR).
-   However this can be avoided if the operating system can restart
-   system calls automatically.  We assume this is the case if
-   sigaction is available and SA_RESTART is defined; they will be used
-   when installing signal handlers.
-   */
-
-#ifdef HAVE_RESTARTABLE_SYSCALLS
-#if ! SCM_USE_PTHREAD_THREADS /* However, don't assume SA_RESTART 
-                                 works with pthreads... */
-#define SCM_SYSCALL(line) line
-#endif
-#endif
-
 #ifndef SCM_SYSCALL
 #ifdef vms
 # ifndef __GNUC__
@@ -170,6 +158,36 @@
 #define scm_from_off64_t  scm_from_int64
 
 
+/* The endianness marker in objcode.  */
+#ifdef WORDS_BIGENDIAN
+# define SCM_OBJCODE_ENDIANNESS "BE"
+#else
+# define SCM_OBJCODE_ENDIANNESS "LE"
+#endif
+
+#define _SCM_CPP_STRINGIFY(x)  # x
+#define SCM_CPP_STRINGIFY(x)   _SCM_CPP_STRINGIFY (x)
+
+/* The word size marker in objcode.  */
+#define SCM_OBJCODE_WORD_SIZE  SCM_CPP_STRINGIFY (SIZEOF_VOID_P)
+
+/* Major and minor versions must be single characters. */
+#define SCM_OBJCODE_MAJOR_VERSION 0
+#define SCM_OBJCODE_MINOR_VERSION D
+#define SCM_OBJCODE_MAJOR_VERSION_STRING        \
+  SCM_CPP_STRINGIFY(SCM_OBJCODE_MAJOR_VERSION)
+#define SCM_OBJCODE_MINOR_VERSION_STRING        \
+  SCM_CPP_STRINGIFY(SCM_OBJCODE_MINOR_VERSION)
+#define SCM_OBJCODE_VERSION_STRING                                      \
+  SCM_OBJCODE_MAJOR_VERSION_STRING "." SCM_OBJCODE_MINOR_VERSION_STRING
+#define SCM_OBJCODE_MACHINE_VERSION_STRING                              \
+  SCM_OBJCODE_VERSION_STRING "-" SCM_OBJCODE_ENDIANNESS "-" SCM_OBJCODE_WORD_SIZE
+
+/* The objcode magic header.  */
+#define SCM_OBJCODE_COOKIE                              \
+  "GOOF-" SCM_OBJCODE_MACHINE_VERSION_STRING "---"
+
+
 #endif  /* SCM__SCM_H */
 
 /*
diff --git a/libguile/alist.c b/libguile/alist.c
index ca55b082c..919bd224e 100644
--- a/libguile/alist.c
+++ b/libguile/alist.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1995, 96, 97, 98, 99, 2000, 2001, 2004, 2006, 2008 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/alist.h b/libguile/alist.h
index 76cccba2b..77c565608 100644
--- a/libguile/alist.h
+++ b/libguile/alist.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,2000, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/arbiters.c b/libguile/arbiters.c
index a3e4d81df..3567c909e 100644
--- a/libguile/arbiters.c
+++ b/libguile/arbiters.c
@@ -1,18 +1,19 @@
 /*	Copyright (C) 1995,1996, 1997, 2000, 2001, 2004, 2005, 2006, 2008 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/arbiters.h b/libguile/arbiters.h
index 7a7dfd3fa..214e92a34 100644
--- a/libguile/arbiters.h
+++ b/libguile/arbiters.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,2000, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/array-handle.c b/libguile/array-handle.c
new file mode 100644
index 000000000..cd5a46698
--- /dev/null
+++ b/libguile/array-handle.c
@@ -0,0 +1,162 @@
+/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009 Free Software Foundation, Inc.
+ * 
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+
+
+
+#ifdef HAVE_CONFIG_H
+#  include <config.h>
+#endif
+
+#include "libguile/_scm.h"
+#include "libguile/__scm.h"
+
+#include "libguile/array-handle.h"
+
+
+SCM scm_i_array_element_types[SCM_ARRAY_ELEMENT_TYPE_LAST + 1];
+
+
+#define ARRAY_IMPLS_N_STATIC_ALLOC 7
+static scm_t_array_implementation array_impls[ARRAY_IMPLS_N_STATIC_ALLOC];
+static int num_array_impls_registered = 0;
+
+
+void
+scm_i_register_array_implementation (scm_t_array_implementation *impl)
+{
+  if (num_array_impls_registered >= ARRAY_IMPLS_N_STATIC_ALLOC)
+    /* need to increase ARRAY_IMPLS_N_STATIC_ALLOC, buster */
+    abort ();
+  else
+    array_impls[num_array_impls_registered++] = *impl;
+}
+
+scm_t_array_implementation*
+scm_i_array_implementation_for_obj (SCM obj)
+{
+  int i;
+  for (i = 0; i < num_array_impls_registered; i++)
+    if (SCM_NIMP (obj)
+        && (SCM_CELL_TYPE (obj) & array_impls[i].mask) == array_impls[i].tag)
+      return &array_impls[i];
+  return NULL;
+}
+
+void
+scm_array_get_handle (SCM array, scm_t_array_handle *h)
+{
+  scm_t_array_implementation *impl = scm_i_array_implementation_for_obj (array);
+  if (!impl)
+    scm_wrong_type_arg_msg (NULL, 0, array, "array");
+  h->array = array;
+  h->impl = impl;
+  h->base = 0;
+  h->ndims = 0;
+  h->dims = NULL;
+  h->element_type = SCM_ARRAY_ELEMENT_TYPE_SCM; /* have to default to
+                                                   something... */
+  h->elements = NULL;
+  h->writable_elements = NULL;
+  h->impl->get_handle (array, h);
+}
+
+ssize_t
+scm_array_handle_pos (scm_t_array_handle *h, SCM indices)
+{
+  scm_t_array_dim *s = scm_array_handle_dims (h);
+  ssize_t pos = 0, i;
+  size_t k = scm_array_handle_rank (h);
+  
+  while (k > 0 && scm_is_pair (indices))
+    {
+      i = scm_to_signed_integer (SCM_CAR (indices), s->lbnd, s->ubnd);
+      pos += (i - s->lbnd) * s->inc;
+      k--;
+      s++;
+      indices = SCM_CDR (indices);
+    }
+  if (k > 0 || !scm_is_null (indices))
+    scm_misc_error (NULL, "wrong number of indices, expecting ~a",
+		    scm_list_1 (scm_from_size_t (scm_array_handle_rank (h))));
+  return pos;
+}
+
+SCM
+scm_array_handle_element_type (scm_t_array_handle *h)
+{
+  if (h->element_type < 0 || h->element_type > SCM_ARRAY_ELEMENT_TYPE_LAST)
+    abort (); /* guile programming error */
+  return scm_i_array_element_types[h->element_type];
+}
+
+void
+scm_array_handle_release (scm_t_array_handle *h)
+{
+  /* Nothing to do here until arrays need to be reserved for real.
+   */
+}
+
+const SCM *
+scm_array_handle_elements (scm_t_array_handle *h)
+{
+  if (h->element_type != SCM_ARRAY_ELEMENT_TYPE_SCM)
+    scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array");
+  return ((const SCM*)h->elements) + h->base;
+}
+
+SCM *
+scm_array_handle_writable_elements (scm_t_array_handle *h)
+{
+  if (h->element_type != SCM_ARRAY_ELEMENT_TYPE_SCM)
+    scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array");
+  return ((SCM*)h->elements) + h->base;
+}
+
+void
+scm_init_array_handle (void)
+{
+#define DEFINE_ARRAY_TYPE(tag, TAG)                             \
+  scm_i_array_element_types[SCM_ARRAY_ELEMENT_TYPE_##TAG]   \
+    = (scm_permanent_object (scm_from_locale_symbol (#tag)))
+  
+  scm_i_array_element_types[SCM_ARRAY_ELEMENT_TYPE_SCM] = SCM_BOOL_T;
+  DEFINE_ARRAY_TYPE (a, CHAR);
+  DEFINE_ARRAY_TYPE (b, BIT);
+  DEFINE_ARRAY_TYPE (vu8, VU8);
+  DEFINE_ARRAY_TYPE (u8, U8);
+  DEFINE_ARRAY_TYPE (s8, S8);
+  DEFINE_ARRAY_TYPE (u16, U16);
+  DEFINE_ARRAY_TYPE (s16, S16);
+  DEFINE_ARRAY_TYPE (u32, U32);
+  DEFINE_ARRAY_TYPE (s32, S32);
+  DEFINE_ARRAY_TYPE (u64, U64);
+  DEFINE_ARRAY_TYPE (s64, S64);
+  DEFINE_ARRAY_TYPE (f32, F32);
+  DEFINE_ARRAY_TYPE (f64, F64);
+  DEFINE_ARRAY_TYPE (c32, C32);
+  DEFINE_ARRAY_TYPE (c64, C64);
+
+#include "libguile/array-handle.x"
+}
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/array-handle.h b/libguile/array-handle.h
new file mode 100644
index 000000000..caf9cefbf
--- /dev/null
+++ b/libguile/array-handle.h
@@ -0,0 +1,129 @@
+/* classes: h_files */
+
+#ifndef SCM_ARRAY_HANDLE_H
+#define SCM_ARRAY_HANDLE_H
+
+/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009 Free Software Foundation, Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+
+
+#include "libguile/__scm.h"
+
+
+
+struct scm_t_array_handle;
+
+typedef SCM (*scm_i_t_array_ref) (struct scm_t_array_handle *, size_t);
+typedef void (*scm_i_t_array_set) (struct scm_t_array_handle *, size_t, SCM);
+
+typedef struct
+{
+  scm_t_bits tag;
+  scm_t_bits mask;
+  scm_i_t_array_ref vref;
+  scm_i_t_array_set vset;
+  void (*get_handle)(SCM, struct scm_t_array_handle*);
+} scm_t_array_implementation;
+  
+#define SCM_ARRAY_IMPLEMENTATION(tag_,mask_,vref_,vset_,handle_) \
+  SCM_SNARF_INIT ({                                                     \
+      scm_t_array_implementation impl;                                  \
+      impl.tag = tag_; impl.mask = mask_;                               \
+      impl.vref = vref_; impl.vset = vset_;                             \
+      impl.get_handle = handle_;                                        \
+      scm_i_register_array_implementation (&impl);                      \
+  })
+  
+
+SCM_INTERNAL void scm_i_register_array_implementation (scm_t_array_implementation *impl);
+SCM_INTERNAL scm_t_array_implementation* scm_i_array_implementation_for_obj (SCM obj);
+
+
+
+
+typedef struct scm_t_array_dim
+{
+  ssize_t lbnd;
+  ssize_t ubnd;
+  ssize_t inc;
+} scm_t_array_dim;
+
+typedef enum {    
+  SCM_ARRAY_ELEMENT_TYPE_SCM = 0, /* SCM values */
+  SCM_ARRAY_ELEMENT_TYPE_CHAR = 1, /* characters */
+  SCM_ARRAY_ELEMENT_TYPE_BIT = 2, /* packed numeric values */
+  SCM_ARRAY_ELEMENT_TYPE_VU8 = 3,
+  SCM_ARRAY_ELEMENT_TYPE_U8 = 4,
+  SCM_ARRAY_ELEMENT_TYPE_S8 = 5,
+  SCM_ARRAY_ELEMENT_TYPE_U16 = 6,
+  SCM_ARRAY_ELEMENT_TYPE_S16 = 7,
+  SCM_ARRAY_ELEMENT_TYPE_U32 = 8,
+  SCM_ARRAY_ELEMENT_TYPE_S32 = 9,
+  SCM_ARRAY_ELEMENT_TYPE_U64 = 10,
+  SCM_ARRAY_ELEMENT_TYPE_S64 = 11,
+  SCM_ARRAY_ELEMENT_TYPE_F32 = 12,
+  SCM_ARRAY_ELEMENT_TYPE_F64 = 13,
+  SCM_ARRAY_ELEMENT_TYPE_C32 = 14,
+  SCM_ARRAY_ELEMENT_TYPE_C64 = 15,
+  SCM_ARRAY_ELEMENT_TYPE_LAST = 15,
+} scm_t_array_element_type;
+
+SCM_INTERNAL SCM scm_i_array_element_types[];
+
+
+typedef struct scm_t_array_handle {
+  SCM array;
+  scm_t_array_implementation *impl;
+  /* `Base' is an offset into elements or writable_elements, corresponding to
+     the first element in the array. It would be nicer just to adjust the
+     elements/writable_elements pointer, but we can't because that element might
+     not even be byte-addressable, as is the case with bitvectors. A nicer
+     solution would be, well, nice.
+   */
+  size_t base;
+  size_t ndims; /* ndims == the rank of the array */
+  scm_t_array_dim *dims;
+  scm_t_array_dim dim0;
+  scm_t_array_element_type element_type;
+  const void *elements;
+  void *writable_elements;
+} scm_t_array_handle;
+
+#define scm_array_handle_rank(h) ((h)->ndims)
+#define scm_array_handle_dims(h) ((h)->dims)
+
+SCM_API void scm_array_get_handle (SCM array, scm_t_array_handle *h);
+SCM_API ssize_t scm_array_handle_pos (scm_t_array_handle *h, SCM indices);
+SCM_API SCM scm_array_handle_element_type (scm_t_array_handle *h);
+SCM_API void scm_array_handle_release (scm_t_array_handle *h);
+SCM_API const SCM* scm_array_handle_elements (scm_t_array_handle *h);
+SCM_API SCM* scm_array_handle_writable_elements (scm_t_array_handle *h);
+
+/* See inline.h for scm_array_handle_ref and scm_array_handle_set */
+
+SCM_INTERNAL void scm_init_array_handle (void);
+
+
+#endif  /* SCM_ARRAY_HANDLE_H */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/ramap.c b/libguile/array-map.c
index 1bc4fdd38..fb9ceea37 100644
--- a/libguile/ramap.c
+++ b/libguile/array-map.c
@@ -1,25 +1,22 @@
-/* Copyright (C) 1996,1998,2000,2001,2004,2005, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1996,1998,2000,2001,2004,2005, 2006, 2008, 2009 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
-/*
-  HWN:FIXME::
-  Someone should rename this to arraymap.c; that would reflect the
-  contents better.  */
 
 
 
@@ -30,7 +27,7 @@
 
 #include "libguile/_scm.h"
 #include "libguile/strings.h"
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
 #include "libguile/smob.h"
 #include "libguile/chars.h"
 #include "libguile/eq.h"
@@ -38,11 +35,14 @@
 #include "libguile/feature.h"
 #include "libguile/root.h"
 #include "libguile/vectors.h"
+#include "libguile/bitvectors.h"
 #include "libguile/srfi-4.h"
 #include "libguile/dynwind.h"
+#include "libguile/generalized-arrays.h"
+#include "libguile/generalized-vectors.h"
 
 #include "libguile/validate.h"
-#include "libguile/ramap.h"
+#include "libguile/array-map.h"
 
 
 typedef struct
@@ -222,7 +222,7 @@ scm_ramapc (int (*cproc)(), SCM data, SCM ra0, SCM lra, const char *what)
       if (!SCM_I_ARRAYP (vra0))
 	{
 	  size_t length = scm_c_generalized_vector_length (vra0);
-	  vra1 = scm_i_make_ra (1, 0);
+	  vra1 = scm_i_make_array (1);
 	  SCM_I_ARRAY_BASE (vra1) = 0;
 	  SCM_I_ARRAY_DIMS (vra1)->lbnd = 0;
 	  SCM_I_ARRAY_DIMS (vra1)->ubnd = length - 1;
@@ -235,7 +235,7 @@ scm_ramapc (int (*cproc)(), SCM data, SCM ra0, SCM lra, const char *what)
       for (z = lra; SCM_NIMP (z); z = SCM_CDR (z))
 	{
 	  ra1 = SCM_CAR (z);
-	  vra1 = scm_i_make_ra (1, 0);
+	  vra1 = scm_i_make_array (1);
 	  SCM_I_ARRAY_DIMS (vra1)->lbnd = SCM_I_ARRAY_DIMS (vra0)->lbnd;
 	  SCM_I_ARRAY_DIMS (vra1)->ubnd = SCM_I_ARRAY_DIMS (vra0)->ubnd;
 	  if (!SCM_I_ARRAYP (ra1))
@@ -258,7 +258,7 @@ scm_ramapc (int (*cproc)(), SCM data, SCM ra0, SCM lra, const char *what)
       return (SCM_UNBNDP (data) ? cproc(vra0, lvra) : cproc(vra0, data, lvra));
     case 1:
     gencase:			/* Have to loop over all dimensions. */
-    vra0 = scm_i_make_ra (1, 0);
+      vra0 = scm_i_make_array (1);
     if (SCM_I_ARRAYP (ra0))
       {
 	kmax = SCM_I_ARRAY_NDIM (ra0) - 1;
@@ -293,7 +293,7 @@ scm_ramapc (int (*cproc)(), SCM data, SCM ra0, SCM lra, const char *what)
     for (z = lra; SCM_NIMP (z); z = SCM_CDR (z))
       {
 	ra1 = SCM_CAR (z);
-	vra1 = scm_i_make_ra (1, 0);
+	vra1 = scm_i_make_array (1);
 	SCM_I_ARRAY_DIMS (vra1)->lbnd = SCM_I_ARRAY_DIMS (vra0)->lbnd;
 	SCM_I_ARRAY_DIMS (vra1)->ubnd = SCM_I_ARRAY_DIMS (vra0)->ubnd;
 	if (SCM_I_ARRAYP (ra1))
@@ -1221,13 +1221,13 @@ init_raprocs (ra_iproc *subra)
 
 
 void
-scm_init_ramap ()
+scm_init_array_map (void)
 {
   init_raprocs (ra_rpsubrs);
   init_raprocs (ra_asubrs);
   scm_c_define_subr (s_array_equal_p, scm_tc7_rpsubr, scm_array_equal_p);
   scm_smobs[SCM_TC2SMOBNUM (scm_i_tc16_array)].equalp = scm_raequal;
-#include "libguile/ramap.x"
+#include "libguile/array-map.x"
   scm_add_feature (s_scm_array_for_each);
 }
 
diff --git a/libguile/ramap.h b/libguile/array-map.h
index 9d870389a..a198099f3 100644
--- a/libguile/ramap.h
+++ b/libguile/array-map.h
@@ -1,23 +1,24 @@
 /* classes: h_files */
 
-#ifndef SCM_RAMAP_H
-#define SCM_RAMAP_H
+#ifndef SCM_ARRAY_MAP_H
+#define SCM_ARRAY_MAP_H
 
-/* Copyright (C) 1995,1996,1997,2000, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,2000, 2006, 2008, 2009 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -47,9 +48,9 @@ SCM_API SCM scm_array_for_each (SCM proc, SCM ra0, SCM lra);
 SCM_API SCM scm_array_index_map_x (SCM ra, SCM proc);
 SCM_API SCM scm_raequal (SCM ra0, SCM ra1);
 SCM_API SCM scm_array_equal_p (SCM ra0, SCM ra1);
-SCM_INTERNAL void scm_init_ramap (void);
+SCM_INTERNAL void scm_init_array_map (void);
 
-#endif  /* SCM_RAMAP_H */
+#endif  /* SCM_ARRAY_MAP_H */
 
 /*
   Local Variables:
diff --git a/libguile/arrays.c b/libguile/arrays.c
new file mode 100644
index 000000000..2be9ec3f0
--- /dev/null
+++ b/libguile/arrays.c
@@ -0,0 +1,1156 @@
+/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009 Free Software Foundation, Inc.
+ * 
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+
+
+
+#ifdef HAVE_CONFIG_H
+#  include <config.h>
+#endif
+
+#include <stdio.h>
+#include <errno.h>
+#include <string.h>
+
+#include "libguile/_scm.h"
+#include "libguile/__scm.h"
+#include "libguile/eq.h"
+#include "libguile/chars.h"
+#include "libguile/eval.h"
+#include "libguile/fports.h"
+#include "libguile/smob.h"
+#include "libguile/feature.h"
+#include "libguile/root.h"
+#include "libguile/strings.h"
+#include "libguile/srfi-13.h"
+#include "libguile/srfi-4.h"
+#include "libguile/vectors.h"
+#include "libguile/bitvectors.h"
+#include "libguile/bytevectors.h"
+#include "libguile/list.h"
+#include "libguile/dynwind.h"
+#include "libguile/read.h"
+
+#include "libguile/validate.h"
+#include "libguile/arrays.h"
+#include "libguile/array-map.h"
+#include "libguile/generalized-vectors.h"
+#include "libguile/generalized-arrays.h"
+#include "libguile/uniform.h"
+
+
+scm_t_bits scm_i_tc16_array;
+#define SCM_SET_ARRAY_CONTIGUOUS_FLAG(x) \
+  (SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) | SCM_I_ARRAY_FLAG_CONTIGUOUS))
+#define SCM_CLR_ARRAY_CONTIGUOUS_FLAG(x) \
+  (SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) & ~SCM_I_ARRAY_FLAG_CONTIGUOUS))
+
+
+SCM_DEFINE (scm_shared_array_root, "shared-array-root", 1, 0, 0, 
+           (SCM ra),
+	    "Return the root vector of a shared array.")
+#define FUNC_NAME s_scm_shared_array_root
+{
+  if (SCM_I_ARRAYP (ra))
+    return SCM_I_ARRAY_V (ra);
+  else if (scm_is_generalized_vector (ra))
+    return ra;
+  scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, ra, "array");
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_shared_array_offset, "shared-array-offset", 1, 0, 0, 
+           (SCM ra),
+	    "Return the root vector index of the first element in the array.")
+#define FUNC_NAME s_scm_shared_array_offset
+{
+  scm_t_array_handle handle;
+  SCM res;
+
+  scm_array_get_handle (ra, &handle);
+  res = scm_from_size_t (handle.base);
+  scm_array_handle_release (&handle);
+  return res;
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_shared_array_increments, "shared-array-increments", 1, 0, 0, 
+           (SCM ra),
+	    "For each dimension, return the distance between elements in the root vector.")
+#define FUNC_NAME s_scm_shared_array_increments
+{
+  scm_t_array_handle handle;
+  SCM res = SCM_EOL;
+  size_t k;
+  scm_t_array_dim *s;
+
+  scm_array_get_handle (ra, &handle);
+  k = scm_array_handle_rank (&handle);
+  s = scm_array_handle_dims (&handle);
+  while (k--)
+    res = scm_cons (scm_from_ssize_t (s[k].inc), res);
+  scm_array_handle_release (&handle);
+  return res;
+}
+#undef FUNC_NAME
+
+SCM 
+scm_i_make_array (int ndim)
+{
+  SCM ra;
+  SCM_NEWSMOB(ra, ((scm_t_bits) ndim << 17) + scm_i_tc16_array,
+              scm_gc_malloc ((sizeof (scm_i_t_array) +
+			      ndim * sizeof (scm_t_array_dim)),
+			     "array"));
+  SCM_I_ARRAY_V (ra) = SCM_BOOL_F;
+  return ra;
+}
+
+static char s_bad_spec[] = "Bad scm_array dimension";
+
+
+/* Increments will still need to be set. */
+
+static SCM 
+scm_i_shap2ra (SCM args)
+{
+  scm_t_array_dim *s;
+  SCM ra, spec, sp;
+  int ndim = scm_ilength (args);
+  if (ndim < 0)
+    scm_misc_error (NULL, s_bad_spec, SCM_EOL);
+
+  ra = scm_i_make_array (ndim);
+  SCM_I_ARRAY_BASE (ra) = 0;
+  s = SCM_I_ARRAY_DIMS (ra);
+  for (; !scm_is_null (args); s++, args = SCM_CDR (args))
+    {
+      spec = SCM_CAR (args);
+      if (scm_is_integer (spec))
+	{
+	  if (scm_to_long (spec) < 0)
+	    scm_misc_error (NULL, s_bad_spec, SCM_EOL);
+	  s->lbnd = 0;
+	  s->ubnd = scm_to_long (spec) - 1;
+	  s->inc = 1;
+	}
+      else
+	{
+	  if (!scm_is_pair (spec) || !scm_is_integer (SCM_CAR (spec)))
+	    scm_misc_error (NULL, s_bad_spec, SCM_EOL);
+	  s->lbnd = scm_to_long (SCM_CAR (spec));
+	  sp = SCM_CDR (spec);
+	  if (!scm_is_pair (sp) 
+	      || !scm_is_integer (SCM_CAR (sp))
+	      || !scm_is_null (SCM_CDR (sp)))
+	    scm_misc_error (NULL, s_bad_spec, SCM_EOL);
+	  s->ubnd = scm_to_long (SCM_CAR (sp));
+	  s->inc = 1;
+	}
+    }
+  return ra;
+}
+
+SCM_DEFINE (scm_make_typed_array, "make-typed-array", 2, 0, 1,
+	    (SCM type, SCM fill, SCM bounds),
+	    "Create and return an array of type @var{type}.")
+#define FUNC_NAME s_scm_make_typed_array
+{
+  size_t k, rlen = 1;
+  scm_t_array_dim *s;
+  SCM ra;
+  
+  ra = scm_i_shap2ra (bounds);
+  SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
+  s = SCM_I_ARRAY_DIMS (ra);
+  k = SCM_I_ARRAY_NDIM (ra);
+
+  while (k--)
+    {
+      s[k].inc = rlen;
+      SCM_ASSERT_RANGE (1, bounds, s[k].lbnd <= s[k].ubnd + 1);
+      rlen = (s[k].ubnd - s[k].lbnd + 1) * s[k].inc;
+    }
+
+  if (scm_is_eq (fill, SCM_UNSPECIFIED))
+    fill = SCM_UNDEFINED;
+
+  SCM_I_ARRAY_V (ra) =
+    scm_make_generalized_vector (type, scm_from_size_t (rlen), fill);
+
+  if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
+    if (s->ubnd < s->lbnd || (0 == s->lbnd && 1 == s->inc))
+      return SCM_I_ARRAY_V (ra);
+  return ra;
+}
+#undef FUNC_NAME
+
+SCM
+scm_from_contiguous_typed_array (SCM type, SCM bounds, const void *bytes,
+                                 size_t byte_len)
+#define FUNC_NAME "scm_from_contiguous_typed_array"
+{
+  size_t k, rlen = 1;
+  scm_t_array_dim *s;
+  SCM ra;
+  scm_t_array_handle h;
+  void *base;
+  size_t sz;
+  
+  ra = scm_i_shap2ra (bounds);
+  SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
+  s = SCM_I_ARRAY_DIMS (ra);
+  k = SCM_I_ARRAY_NDIM (ra);
+
+  while (k--)
+    {
+      s[k].inc = rlen;
+      SCM_ASSERT_RANGE (1, bounds, s[k].lbnd <= s[k].ubnd + 1);
+      rlen = (s[k].ubnd - s[k].lbnd + 1) * s[k].inc;
+    }
+  SCM_I_ARRAY_V (ra) =
+    scm_make_generalized_vector (type, scm_from_size_t (rlen), SCM_UNDEFINED);
+
+
+  scm_array_get_handle (ra, &h);
+  base = scm_array_handle_uniform_writable_elements (&h);
+  sz = scm_array_handle_uniform_element_size (&h);
+  scm_array_handle_release (&h);
+
+  if (byte_len % sz)
+    SCM_MISC_ERROR ("byte length not a multiple of the unit size", SCM_EOL);
+  if (byte_len / sz != rlen)
+    SCM_MISC_ERROR ("byte length and dimensions do not match", SCM_EOL);
+
+  memcpy (base, bytes, byte_len);
+
+  if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
+    if (s->ubnd < s->lbnd || (0 == s->lbnd && 1 == s->inc))
+      return SCM_I_ARRAY_V (ra);
+  return ra;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_make_array, "make-array", 1, 0, 1,
+	    (SCM fill, SCM bounds),
+	    "Create and return an array.")
+#define FUNC_NAME s_scm_make_array
+{
+  return scm_make_typed_array (SCM_BOOL_T, fill, bounds);
+}
+#undef FUNC_NAME
+
+static void 
+scm_i_ra_set_contp (SCM ra)
+{
+  size_t k = SCM_I_ARRAY_NDIM (ra);
+  if (k)
+    {
+      long inc = SCM_I_ARRAY_DIMS (ra)[k - 1].inc;
+      while (k--)
+	{
+	  if (inc != SCM_I_ARRAY_DIMS (ra)[k].inc)
+	    {
+	      SCM_CLR_ARRAY_CONTIGUOUS_FLAG (ra);
+	      return;
+	    }
+	  inc *= (SCM_I_ARRAY_DIMS (ra)[k].ubnd 
+		  - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1);
+	}
+    }
+  SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
+}
+
+
+SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
+           (SCM oldra, SCM mapfunc, SCM dims),
+	    "@code{make-shared-array} can be used to create shared subarrays of other\n"
+	    "arrays.  The @var{mapper} is a function that translates coordinates in\n"
+	    "the new array into coordinates in the old array.  A @var{mapper} must be\n"
+	    "linear, and its range must stay within the bounds of the old array, but\n"
+	    "it can be otherwise arbitrary.  A simple example:\n"
+	    "@lisp\n"
+	    "(define fred (make-array #f 8 8))\n"
+	    "(define freds-diagonal\n"
+	    "  (make-shared-array fred (lambda (i) (list i i)) 8))\n"
+	    "(array-set! freds-diagonal 'foo 3)\n"
+	    "(array-ref fred 3 3) @result{} foo\n"
+	    "(define freds-center\n"
+	    "  (make-shared-array fred (lambda (i j) (list (+ 3 i) (+ 3 j))) 2 2))\n"
+	    "(array-ref freds-center 0 0) @result{} foo\n"
+	    "@end lisp")
+#define FUNC_NAME s_scm_make_shared_array
+{
+  scm_t_array_handle old_handle;
+  SCM ra;
+  SCM inds, indptr;
+  SCM imap;
+  size_t k;
+  ssize_t i;
+  long old_base, old_min, new_min, old_max, new_max;
+  scm_t_array_dim *s;
+
+  SCM_VALIDATE_REST_ARGUMENT (dims);
+  SCM_VALIDATE_PROC (2, mapfunc);
+  ra = scm_i_shap2ra (dims);
+
+  scm_array_get_handle (oldra, &old_handle);
+
+  if (SCM_I_ARRAYP (oldra))
+    {
+      SCM_I_ARRAY_V (ra) = SCM_I_ARRAY_V (oldra);
+      old_base = old_min = old_max = SCM_I_ARRAY_BASE (oldra);
+      s = scm_array_handle_dims (&old_handle);
+      k = scm_array_handle_rank (&old_handle);
+      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_I_ARRAY_V (ra) = oldra;
+      old_base = old_min = 0;
+      old_max = scm_c_generalized_vector_length (oldra) - 1;
+    }
+
+  inds = SCM_EOL;
+  s = SCM_I_ARRAY_DIMS (ra);
+  for (k = 0; k < SCM_I_ARRAY_NDIM (ra); k++)
+    {
+      inds = scm_cons (scm_from_long (s[k].lbnd), inds);
+      if (s[k].ubnd < s[k].lbnd)
+	{
+	  if (1 == SCM_I_ARRAY_NDIM (ra))
+	    ra = scm_make_generalized_vector (scm_array_type (ra),
+                                              SCM_INUM0, SCM_UNDEFINED);
+	  else
+	    SCM_I_ARRAY_V (ra) =
+              scm_make_generalized_vector (scm_array_type (ra),
+                                           SCM_INUM0, SCM_UNDEFINED);
+	  scm_array_handle_release (&old_handle);
+	  return ra;
+	}
+    }
+
+  imap = scm_apply_0 (mapfunc, scm_reverse (inds));
+  i = scm_array_handle_pos (&old_handle, imap);
+  SCM_I_ARRAY_BASE (ra) = new_min = new_max = i + old_base;
+  indptr = inds;
+  k = SCM_I_ARRAY_NDIM (ra);
+  while (k--)
+    {
+      if (s[k].ubnd > s[k].lbnd)
+	{
+	  SCM_SETCAR (indptr, scm_sum (SCM_CAR (indptr), scm_from_int (1)));
+	  imap = scm_apply_0 (mapfunc, scm_reverse (inds));
+	  s[k].inc = scm_array_handle_pos (&old_handle, 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_array_handle_release (&old_handle);
+
+  if (old_min > new_min || old_max < new_max)
+    SCM_MISC_ERROR ("mapping out of range", SCM_EOL);
+  if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
+    {
+      SCM v = SCM_I_ARRAY_V (ra);
+      size_t length = scm_c_generalized_vector_length (v);
+      if (1 == s->inc && 0 == s->lbnd && length == 1 + s->ubnd)
+	return v;
+      if (s->ubnd < s->lbnd)
+	return scm_make_generalized_vector (scm_array_type (ra), SCM_INUM0,
+                                            SCM_UNDEFINED);
+    }
+  scm_i_ra_set_contp (ra);
+  return ra;
+}
+#undef FUNC_NAME
+
+
+/* args are RA . DIMS */
+SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1, 
+           (SCM ra, SCM args),
+	    "Return an array sharing contents with @var{array}, but with\n"
+	    "dimensions arranged in a different order.  There must be one\n"
+	    "@var{dim} argument for each dimension of @var{array}.\n"
+	    "@var{dim0}, @var{dim1}, @dots{} should be integers between 0\n"
+	    "and the rank of the array to be returned.  Each integer in that\n"
+	    "range must appear at least once in the argument list.\n"
+	    "\n"
+	    "The values of @var{dim0}, @var{dim1}, @dots{} correspond to\n"
+	    "dimensions in the array to be returned, their positions in the\n"
+	    "argument list to dimensions of @var{array}.  Several @var{dim}s\n"
+	    "may have the same value, in which case the returned array will\n"
+	    "have smaller rank than @var{array}.\n"
+	    "\n"
+	    "@lisp\n"
+	    "(transpose-array '#2((a b) (c d)) 1 0) @result{} #2((a c) (b d))\n"
+	    "(transpose-array '#2((a b) (c d)) 0 0) @result{} #1(a d)\n"
+	    "(transpose-array '#3(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1 1 0) @result{}\n"
+	    "                #2((a 4) (b 5) (c 6))\n"
+	    "@end lisp")
+#define FUNC_NAME s_scm_transpose_array
+{
+  SCM res, vargs;
+  scm_t_array_dim *s, *r;
+  int ndim, i, k;
+
+  SCM_VALIDATE_REST_ARGUMENT (args);
+  SCM_ASSERT (SCM_NIMP (ra), ra, SCM_ARG1, FUNC_NAME);
+
+  if (scm_is_generalized_vector (ra))
+    {
+      /* Make sure that we are called with a single zero as
+	 arguments. 
+      */
+      if (scm_is_null (args) || !scm_is_null (SCM_CDR (args)))
+	SCM_WRONG_NUM_ARGS ();
+      SCM_VALIDATE_INT_COPY (SCM_ARG2, SCM_CAR (args), i);
+      SCM_ASSERT_RANGE (SCM_ARG2, SCM_CAR (args), i == 0);
+      return ra;
+    }
+
+  if (SCM_I_ARRAYP (ra))
+    {
+      vargs = scm_vector (args);
+      if (SCM_SIMPLE_VECTOR_LENGTH (vargs) != SCM_I_ARRAY_NDIM (ra))
+	SCM_WRONG_NUM_ARGS ();
+      ndim = 0;
+      for (k = 0; k < SCM_I_ARRAY_NDIM (ra); k++)
+	{
+	  i = scm_to_signed_integer (SCM_SIMPLE_VECTOR_REF (vargs, k),
+				     0, SCM_I_ARRAY_NDIM(ra));
+	  if (ndim < i)
+	    ndim = i;
+	}
+      ndim++;
+      res = scm_i_make_array (ndim);
+      SCM_I_ARRAY_V (res) = SCM_I_ARRAY_V (ra);
+      SCM_I_ARRAY_BASE (res) = SCM_I_ARRAY_BASE (ra);
+      for (k = ndim; k--;)
+	{
+	  SCM_I_ARRAY_DIMS (res)[k].lbnd = 0;
+	  SCM_I_ARRAY_DIMS (res)[k].ubnd = -1;
+	}
+      for (k = SCM_I_ARRAY_NDIM (ra); k--;)
+	{
+	  i = scm_to_int (SCM_SIMPLE_VECTOR_REF (vargs, k));
+	  s = &(SCM_I_ARRAY_DIMS (ra)[k]);
+	  r = &(SCM_I_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_I_ARRAY_BASE (res) += (s->lbnd - r->lbnd) * r->inc;
+		  r->lbnd = s->lbnd;
+		}
+	      r->inc += s->inc;
+	    }
+	}
+      if (ndim > 0)
+	SCM_MISC_ERROR ("bad argument list", SCM_EOL);
+      scm_i_ra_set_contp (res);
+      return res;
+    }
+
+  scm_wrong_type_arg_msg (NULL, 0, ra, "array");
+}
+#undef FUNC_NAME
+
+/* attempts to unroll an array into a one-dimensional array.
+   returns the unrolled array or #f if it can't be done.  */
+  /* if strict is not SCM_UNDEFINED, return #f if returned array
+		     wouldn't have contiguous elements.  */
+SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0,
+           (SCM ra, SCM strict),
+	    "If @var{array} may be @dfn{unrolled} into a one dimensional shared array\n"
+	    "without changing their order (last subscript changing fastest), then\n"
+	    "@code{array-contents} returns that shared array, otherwise it returns\n"
+	    "@code{#f}.  All arrays made by @var{make-array} and\n"
+	    "@var{make-uniform-array} may be unrolled, some arrays made by\n"
+	    "@var{make-shared-array} may not be.\n\n"
+	    "If the optional argument @var{strict} is provided, a shared array will\n"
+	    "be returned only if its elements are stored internally contiguous in\n"
+	    "memory.")
+#define FUNC_NAME s_scm_array_contents
+{
+  SCM sra;
+
+  if (scm_is_generalized_vector (ra))
+    return ra;
+
+  if (SCM_I_ARRAYP (ra))
+    {
+      size_t k, ndim = SCM_I_ARRAY_NDIM (ra), len = 1;
+      if (!SCM_I_ARRAYP (ra) || !SCM_I_ARRAY_CONTP (ra))
+	return SCM_BOOL_F;
+      for (k = 0; k < ndim; k++)
+	len *= SCM_I_ARRAY_DIMS (ra)[k].ubnd - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1;
+      if (!SCM_UNBNDP (strict) && scm_is_true (strict))
+	{
+	  if (ndim && (1 != SCM_I_ARRAY_DIMS (ra)[ndim - 1].inc))
+	    return SCM_BOOL_F;
+	  if (scm_is_bitvector (SCM_I_ARRAY_V (ra)))
+	    {
+	      if (len != scm_c_bitvector_length (SCM_I_ARRAY_V (ra)) ||
+		  SCM_I_ARRAY_BASE (ra) % SCM_LONG_BIT ||
+		  len % SCM_LONG_BIT)
+		return SCM_BOOL_F;
+	    }
+	}
+      
+      {
+	SCM v = SCM_I_ARRAY_V (ra);
+	size_t length = scm_c_generalized_vector_length (v);
+	if ((len == length) && 0 == SCM_I_ARRAY_BASE (ra) && SCM_I_ARRAY_DIMS (ra)->inc)
+	  return v;
+      }
+      
+      sra = scm_i_make_array (1);
+      SCM_I_ARRAY_DIMS (sra)->lbnd = 0;
+      SCM_I_ARRAY_DIMS (sra)->ubnd = len - 1;
+      SCM_I_ARRAY_V (sra) = SCM_I_ARRAY_V (ra);
+      SCM_I_ARRAY_BASE (sra) = SCM_I_ARRAY_BASE (ra);
+      SCM_I_ARRAY_DIMS (sra)->inc = (ndim ? SCM_I_ARRAY_DIMS (ra)[ndim - 1].inc : 1);
+      return sra;
+    }
+  else
+    scm_wrong_type_arg_msg (NULL, 0, ra, "array");
+}
+#undef FUNC_NAME
+
+
+SCM 
+scm_ra2contig (SCM ra, int copy)
+{
+  SCM ret;
+  long inc = 1;
+  size_t k, len = 1;
+  for (k = SCM_I_ARRAY_NDIM (ra); k--;)
+    len *= SCM_I_ARRAY_DIMS (ra)[k].ubnd - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1;
+  k = SCM_I_ARRAY_NDIM (ra);
+  if (SCM_I_ARRAY_CONTP (ra) && ((0 == k) || (1 == SCM_I_ARRAY_DIMS (ra)[k - 1].inc)))
+    {
+      if (!scm_is_bitvector (SCM_I_ARRAY_V (ra)))
+	return ra;
+      if ((len == scm_c_bitvector_length (SCM_I_ARRAY_V (ra)) &&
+	   0 == SCM_I_ARRAY_BASE (ra) % SCM_LONG_BIT &&
+	   0 == len % SCM_LONG_BIT))
+	return ra;
+    }
+  ret = scm_i_make_array (k);
+  SCM_I_ARRAY_BASE (ret) = 0;
+  while (k--)
+    {
+      SCM_I_ARRAY_DIMS (ret)[k].lbnd = SCM_I_ARRAY_DIMS (ra)[k].lbnd;
+      SCM_I_ARRAY_DIMS (ret)[k].ubnd = SCM_I_ARRAY_DIMS (ra)[k].ubnd;
+      SCM_I_ARRAY_DIMS (ret)[k].inc = inc;
+      inc *= SCM_I_ARRAY_DIMS (ra)[k].ubnd - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1;
+    }
+  SCM_I_ARRAY_V (ret) = scm_make_generalized_vector (scm_array_type (ra),
+                                                     scm_from_long (inc),
+                                                     SCM_UNDEFINED);
+  if (copy)
+    scm_array_copy_x (ra, ret);
+  return ret;
+}
+
+
+
+SCM_DEFINE (scm_uniform_array_read_x, "uniform-array-read!", 1, 3, 0,
+           (SCM ura, SCM port_or_fd, SCM start, SCM end),
+	    "@deffnx {Scheme Procedure} uniform-vector-read! uve [port-or-fdes] [start] [end]\n"
+	    "Attempt to read all elements of @var{ura}, in lexicographic order, as\n"
+	    "binary objects from @var{port-or-fdes}.\n"
+	    "If an end of file is encountered,\n"
+	    "the objects up to that point are put into @var{ura}\n"
+	    "(starting at the beginning) and the remainder of the array is\n"
+	    "unchanged.\n\n"
+	    "The optional arguments @var{start} and @var{end} allow\n"
+	    "a specified region of a vector (or linearized array) to be read,\n"
+	    "leaving the remainder of the vector unchanged.\n\n"
+	    "@code{uniform-array-read!} returns the number of objects read.\n"
+	    "@var{port-or-fdes} may be omitted, in which case it defaults to the value\n"
+	    "returned by @code{(current-input-port)}.")
+#define FUNC_NAME s_scm_uniform_array_read_x
+{
+  if (SCM_UNBNDP (port_or_fd))
+    port_or_fd = scm_current_input_port ();
+
+  if (scm_is_uniform_vector (ura))
+    {
+      return scm_uniform_vector_read_x (ura, port_or_fd, start, end);
+    }
+  else if (SCM_I_ARRAYP (ura))
+    {
+      size_t base, vlen, cstart, cend;
+      SCM cra, ans;
+      
+      cra = scm_ra2contig (ura, 0);
+      base = SCM_I_ARRAY_BASE (cra);
+      vlen = SCM_I_ARRAY_DIMS (cra)->inc *
+	(SCM_I_ARRAY_DIMS (cra)->ubnd - SCM_I_ARRAY_DIMS (cra)->lbnd + 1);
+
+      cstart = 0;
+      cend = vlen;
+      if (!SCM_UNBNDP (start))
+	{
+	  cstart = scm_to_unsigned_integer (start, 0, vlen);
+	  if (!SCM_UNBNDP (end))
+	    cend = scm_to_unsigned_integer (end, cstart, vlen);
+	}
+
+      ans = scm_uniform_vector_read_x (SCM_I_ARRAY_V (cra), port_or_fd,
+				       scm_from_size_t (base + cstart),
+				       scm_from_size_t (base + cend));
+
+      if (!scm_is_eq (cra, ura))
+	scm_array_copy_x (cra, ura);
+      return ans;
+    }
+  else
+    scm_wrong_type_arg_msg (NULL, 0, ura, "array");
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_uniform_array_write, "uniform-array-write", 1, 3, 0,
+           (SCM ura, SCM port_or_fd, SCM start, SCM end),
+	    "Writes all elements of @var{ura} as binary objects to\n"
+	    "@var{port-or-fdes}.\n\n"
+	    "The optional arguments @var{start}\n"
+	    "and @var{end} allow\n"
+	    "a specified region of a vector (or linearized array) to be written.\n\n"
+	    "The number of objects actually written is returned.\n"
+	    "@var{port-or-fdes} may be\n"
+	    "omitted, in which case it defaults to the value returned by\n"
+	    "@code{(current-output-port)}.")
+#define FUNC_NAME s_scm_uniform_array_write
+{
+  if (SCM_UNBNDP (port_or_fd))
+    port_or_fd = scm_current_output_port ();
+
+  if (scm_is_uniform_vector (ura))
+    {
+      return scm_uniform_vector_write (ura, port_or_fd, start, end);
+    }
+  else if (SCM_I_ARRAYP (ura))
+    {
+      size_t base, vlen, cstart, cend;
+      SCM cra, ans;
+      
+      cra = scm_ra2contig (ura, 1);
+      base = SCM_I_ARRAY_BASE (cra);
+      vlen = SCM_I_ARRAY_DIMS (cra)->inc *
+	(SCM_I_ARRAY_DIMS (cra)->ubnd - SCM_I_ARRAY_DIMS (cra)->lbnd + 1);
+
+      cstart = 0;
+      cend = vlen;
+      if (!SCM_UNBNDP (start))
+	{
+	  cstart = scm_to_unsigned_integer (start, 0, vlen);
+	  if (!SCM_UNBNDP (end))
+	    cend = scm_to_unsigned_integer (end, cstart, vlen);
+	}
+
+      ans = scm_uniform_vector_write (SCM_I_ARRAY_V (cra), port_or_fd,
+				      scm_from_size_t (base + cstart),
+				      scm_from_size_t (base + cend));
+
+      return ans;
+    }
+  else
+    scm_wrong_type_arg_msg (NULL, 0, ura, "array");
+}
+#undef FUNC_NAME
+
+
+static void
+list_to_array (SCM lst, scm_t_array_handle *handle, ssize_t pos, size_t k)
+{
+  if (k == scm_array_handle_rank (handle))
+    scm_array_handle_set (handle, pos, lst);
+  else
+    {
+      scm_t_array_dim *dim = scm_array_handle_dims (handle) + k;
+      ssize_t inc = dim->inc;
+      size_t len = 1 + dim->ubnd - dim->lbnd, n;
+      char *errmsg = NULL;
+
+      n = len;
+      while (n > 0 && scm_is_pair (lst))
+	{
+	  list_to_array (SCM_CAR (lst), handle, pos, k + 1);
+	  pos += inc;
+	  lst = SCM_CDR (lst);
+	  n -= 1;
+	}
+      if (n != 0)
+	errmsg = "too few elements for array dimension ~a, need ~a";
+      if (!scm_is_null (lst))
+	errmsg = "too many elements for array dimension ~a, want ~a";
+      if (errmsg)
+	scm_misc_error (NULL, errmsg, scm_list_2 (scm_from_ulong (k),
+						  scm_from_size_t (len)));
+    }
+}
+  
+
+SCM_DEFINE (scm_list_to_typed_array, "list->typed-array", 3, 0, 0,
+           (SCM type, SCM shape, SCM lst),
+	    "Return an array of the type @var{type}\n"
+	    "with elements the same as those of @var{lst}.\n"
+	    "\n"
+	    "The argument @var{shape} determines the number of dimensions\n"
+	    "of the array and their shape.  It is either an exact integer,\n"
+	    "giving the\n"
+	    "number of dimensions directly, or a list whose length\n"
+	    "specifies the number of dimensions and each element specified\n"
+	    "the lower and optionally the upper bound of the corresponding\n"
+	    "dimension.\n"
+	    "When the element is list of two elements, these elements\n"
+	    "give the lower and upper bounds.  When it is an exact\n"
+	    "integer, it gives only the lower bound.")
+#define FUNC_NAME s_scm_list_to_typed_array
+{
+  SCM row;
+  SCM ra;
+  scm_t_array_handle handle;
+
+  row = lst;
+  if (scm_is_integer (shape))
+    {
+      size_t k = scm_to_size_t (shape);
+      shape = SCM_EOL;
+      while (k-- > 0)
+	{
+	  shape = scm_cons (scm_length (row), shape);
+	  if (k > 0 && !scm_is_null (row))
+	    row = scm_car (row);
+	}
+    }
+  else
+    {
+      SCM shape_spec = shape;
+      shape = SCM_EOL;
+      while (1)
+	{
+	  SCM spec = scm_car (shape_spec);
+	  if (scm_is_pair (spec))
+	    shape = scm_cons (spec, shape);
+	  else
+	    shape = scm_cons (scm_list_2 (spec,
+					  scm_sum (scm_sum (spec,
+							    scm_length (row)),
+						   scm_from_int (-1))),
+			      shape);
+	  shape_spec = scm_cdr (shape_spec);
+	  if (scm_is_pair (shape_spec))
+	    {
+	      if (!scm_is_null (row))
+		row = scm_car (row);
+	    }
+	  else
+	    break;
+	}
+    }
+
+  ra = scm_make_typed_array (type, SCM_UNSPECIFIED,
+			     scm_reverse_x (shape, SCM_EOL));
+
+  scm_array_get_handle (ra, &handle);
+  list_to_array (lst, &handle, 0, 0);
+  scm_array_handle_release (&handle);
+
+  return ra;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_list_to_array, "list->array", 2, 0, 0,
+           (SCM ndim, SCM lst),
+	    "Return an array with elements the same as those of @var{lst}.")
+#define FUNC_NAME s_scm_list_to_array
+{
+  return scm_list_to_typed_array (SCM_BOOL_T, ndim, lst);
+}
+#undef FUNC_NAME
+
+/* Print dimension DIM of ARRAY.
+ */
+
+static int
+scm_i_print_array_dimension (scm_t_array_handle *h, int dim, int pos,
+			     SCM port, scm_print_state *pstate)
+{
+  if (dim == h->ndims)
+    scm_iprin1 (scm_array_handle_ref (h, pos), port, pstate);
+  else
+    {
+      ssize_t i;
+      scm_putc ('(', port);
+      for (i = h->dims[dim].lbnd; i <= h->dims[dim].ubnd;
+           i++, pos += h->dims[dim].inc)
+        {
+          scm_i_print_array_dimension (h, dim+1, pos, port, pstate);
+          if (i < h->dims[dim].ubnd)
+            scm_putc (' ', port);
+        }
+      scm_putc (')', port);
+    }
+  return 1;
+}
+
+/* Print an array.
+*/
+
+static int
+scm_i_print_array (SCM array, SCM port, scm_print_state *pstate)
+{
+  scm_t_array_handle h;
+  long i;
+  int print_lbnds = 0, zero_size = 0, print_lens = 0;
+
+  scm_array_get_handle (array, &h);
+
+  scm_putc ('#', port);
+  if (h.ndims != 1 || h.dims[0].lbnd != 0)
+    scm_intprint (h.ndims, 10, port);
+  if (h.element_type != SCM_ARRAY_ELEMENT_TYPE_SCM)
+    scm_write (scm_array_handle_element_type (&h), port);
+  
+  for (i = 0; i < h.ndims; i++)
+    {
+      if (h.dims[i].lbnd != 0)
+	print_lbnds = 1;
+      if (h.dims[i].ubnd - h.dims[i].lbnd + 1 == 0)
+	zero_size = 1;
+      else if (zero_size)
+	print_lens = 1;
+    }
+
+  if (print_lbnds || print_lens)
+    for (i = 0; i < h.ndims; i++)
+      {
+	if (print_lbnds)
+	  {
+	    scm_putc ('@', port);
+	    scm_intprint (h.dims[i].lbnd, 10, port);
+	  }
+	if (print_lens)
+	  {
+	    scm_putc (':', port);
+	    scm_intprint (h.dims[i].ubnd - h.dims[i].lbnd + 1,
+			  10, port);
+	  }
+      }
+
+  if (h.ndims == 0)
+    {
+      /* Rank zero arrays, which are really just scalars, are printed
+	 specially.  The consequent way would be to print them as
+
+            #0 OBJ
+
+         where OBJ is the printed representation of the scalar, but we
+         print them instead as
+
+            #0(OBJ)
+
+         to make them look less strange.
+
+	 Just printing them as
+
+            OBJ
+
+         would be correct in a way as well, but zero rank arrays are
+         not really the same as Scheme values since they are boxed and
+         can be modified with array-set!, say.
+      */
+      scm_putc ('(', port);
+      scm_i_print_array_dimension (&h, 0, 0, port, pstate);
+      scm_putc (')', port);
+      return 1;
+    }
+  else
+    return scm_i_print_array_dimension (&h, 0, 0, port, pstate);
+}
+
+/* Read an array.  This function can also read vectors and uniform
+   vectors.  Also, the conflict between '#f' and '#f32' and '#f64' is
+   handled here.
+
+   C is the first character read after the '#'.
+*/
+
+static SCM
+tag_to_type (const char *tag, SCM port)
+{
+  if (*tag == '\0')
+    return SCM_BOOL_T;
+  else
+    return scm_from_locale_symbol (tag);
+}
+
+static int
+read_decimal_integer (SCM port, int c, ssize_t *resp)
+{
+  ssize_t sign = 1;
+  ssize_t res = 0;
+  int got_it = 0;
+
+  if (c == '-')
+    {
+      sign = -1;
+      c = scm_getc (port);
+    }
+
+  while ('0' <= c && c <= '9')
+    {
+      res = 10*res + c-'0';
+      got_it = 1;
+      c = scm_getc (port);
+    }
+
+  if (got_it)
+    *resp = sign * res;
+  return c;
+}
+
+SCM
+scm_i_read_array (SCM port, int c)
+{
+  ssize_t rank;
+  int got_rank;
+  char tag[80];
+  int tag_len;
+
+  SCM shape = SCM_BOOL_F, elements;
+
+  /* XXX - shortcut for ordinary vectors.  Shouldn't be necessary but
+     the array code can not deal with zero-length dimensions yet, and
+     we want to allow zero-length vectors, of course.
+  */
+  if (c == '(')
+    {
+      scm_ungetc (c, port);
+      return scm_vector (scm_read (port));
+    }
+
+  /* Disambiguate between '#f' and uniform floating point vectors.
+   */
+  if (c == 'f')
+    {
+      c = scm_getc (port);
+      if (c != '3' && c != '6')
+	{
+	  if (c != EOF)
+	    scm_ungetc (c, port);
+	  return SCM_BOOL_F;
+	}
+      rank = 1;
+      got_rank = 1;
+      tag[0] = 'f';
+      tag_len = 1;
+      goto continue_reading_tag;
+    }
+
+  /* Read rank. 
+   */
+  rank = 1;
+  c = read_decimal_integer (port, c, &rank);
+  if (rank < 0)
+    scm_i_input_error (NULL, port, "array rank must be non-negative",
+		       SCM_EOL);
+
+  /* Read tag. 
+   */
+  tag_len = 0;
+ continue_reading_tag:
+  while (c != EOF && c != '(' && c != '@' && c != ':' && tag_len < 80)
+    {
+      tag[tag_len++] = c;
+      c = scm_getc (port);
+    }
+  tag[tag_len] = '\0';
+  
+  /* Read shape. 
+   */
+  if (c == '@' || c == ':')
+    {
+      shape = SCM_EOL;
+      
+      do
+	{
+	  ssize_t lbnd = 0, len = 0;
+	  SCM s;
+
+	  if (c == '@')
+	    {
+	      c = scm_getc (port);
+	      c = read_decimal_integer (port, c, &lbnd);
+	    }
+	  
+	  s = scm_from_ssize_t (lbnd);
+
+	  if (c == ':')
+	    {
+	      c = scm_getc (port);
+	      c = read_decimal_integer (port, c, &len);
+	      if (len < 0)
+		scm_i_input_error (NULL, port,
+				   "array length must be non-negative",
+				   SCM_EOL);
+
+	      s = scm_list_2 (s, scm_from_ssize_t (lbnd+len-1));
+	    }
+
+	  shape = scm_cons (s, shape);
+	} while (c == '@' || c == ':');
+
+      shape = scm_reverse_x (shape, SCM_EOL);
+    }
+
+  /* Read nested lists of elements.
+   */
+  if (c != '(')
+    scm_i_input_error (NULL, port,
+		       "missing '(' in vector or array literal",
+		       SCM_EOL);
+  scm_ungetc (c, port);
+  elements = scm_read (port);
+
+  if (scm_is_false (shape))
+    shape = scm_from_ssize_t (rank);
+  else if (scm_ilength (shape) != rank)
+    scm_i_input_error 
+      (NULL, port,
+       "the number of shape specifications must match the array rank",
+       SCM_EOL);
+
+  /* Handle special print syntax of rank zero arrays; see
+     scm_i_print_array for a rationale.
+  */
+  if (rank == 0)
+    {
+      if (!scm_is_pair (elements))
+	scm_i_input_error (NULL, port,
+			   "too few elements in array literal, need 1",
+			   SCM_EOL);
+      if (!scm_is_null (SCM_CDR (elements)))
+	scm_i_input_error (NULL, port,
+			   "too many elements in array literal, want 1",
+			   SCM_EOL);
+      elements = SCM_CAR (elements);
+    }
+
+  /* Construct array. 
+   */
+  return scm_list_to_typed_array (tag_to_type (tag, port), shape, elements);
+}
+
+
+static SCM
+array_mark (SCM ptr)
+{
+  return SCM_I_ARRAY_V (ptr);
+}
+
+static size_t
+array_free (SCM ptr)
+{
+  scm_gc_free (SCM_I_ARRAY_MEM (ptr),
+	       (sizeof (scm_i_t_array) 
+		+ SCM_I_ARRAY_NDIM (ptr) * sizeof (scm_t_array_dim)),
+	       "array");
+  return 0;
+}
+
+static SCM
+array_handle_ref (scm_t_array_handle *h, size_t pos)
+{
+  return scm_c_generalized_vector_ref (SCM_I_ARRAY_V (h->array), pos);
+}
+
+static void
+array_handle_set (scm_t_array_handle *h, size_t pos, SCM val)
+{
+  scm_c_generalized_vector_set_x (SCM_I_ARRAY_V (h->array), pos, val);
+}
+
+/* FIXME: should be handle for vect? maybe not, because of dims */
+static void
+array_get_handle (SCM array, scm_t_array_handle *h)
+{
+  scm_t_array_handle vh;
+  scm_array_get_handle (SCM_I_ARRAY_V (array), &vh);
+  h->element_type = vh.element_type;
+  h->elements = vh.elements;
+  h->writable_elements = vh.writable_elements;
+  scm_array_handle_release (&vh);
+
+  h->dims = SCM_I_ARRAY_DIMS (array);
+  h->ndims = SCM_I_ARRAY_NDIM (array);
+  h->base = SCM_I_ARRAY_BASE (array);
+}
+
+SCM_ARRAY_IMPLEMENTATION (scm_i_tc16_array, 0xffff,
+                          array_handle_ref, array_handle_set,
+                          array_get_handle);
+
+void
+scm_init_arrays ()
+{
+  scm_i_tc16_array = scm_make_smob_type ("array", 0);
+  scm_set_smob_mark (scm_i_tc16_array, array_mark);
+  scm_set_smob_free (scm_i_tc16_array, array_free);
+  scm_set_smob_print (scm_i_tc16_array, scm_i_print_array);
+  scm_set_smob_equalp (scm_i_tc16_array, scm_array_equal_p);
+
+  scm_add_feature ("array");
+
+#include "libguile/arrays.x"
+
+}
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/arrays.h b/libguile/arrays.h
new file mode 100644
index 000000000..35e5471bf
--- /dev/null
+++ b/libguile/arrays.h
@@ -0,0 +1,91 @@
+/* classes: h_files */
+
+#ifndef SCM_ARRAY_H
+#define SCM_ARRAY_H
+
+/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009 Free Software Foundation, Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+
+
+#include "libguile/__scm.h"
+#include "libguile/print.h"
+
+
+
+/* Multidimensional arrays. Woo hoo!
+   Also see ....
+ */
+
+
+/** Arrays */
+
+SCM_API SCM scm_make_array (SCM fill, SCM bounds);
+SCM_API SCM scm_make_typed_array (SCM type, SCM fill, SCM bounds);
+SCM_API SCM scm_from_contiguous_typed_array (SCM type, SCM bounds,
+                                             const void *bytes,
+                                             size_t byte_len);
+SCM_API SCM scm_shared_array_root (SCM ra);
+SCM_API SCM scm_shared_array_offset (SCM ra);
+SCM_API SCM scm_shared_array_increments (SCM ra);
+SCM_API SCM scm_make_shared_array (SCM oldra, SCM mapfunc, SCM dims);
+SCM_API SCM scm_transpose_array (SCM ra, SCM args);
+SCM_API SCM scm_array_contents (SCM ra, SCM strict);
+SCM_API SCM scm_uniform_array_read_x (SCM ra, SCM port_or_fd,
+				      SCM start, SCM end);
+SCM_API SCM scm_uniform_array_write (SCM v, SCM port_or_fd,
+				     SCM start, SCM end);
+SCM_API SCM scm_list_to_array (SCM ndim, SCM lst);
+SCM_API SCM scm_list_to_typed_array (SCM type, SCM ndim, SCM lst);
+
+SCM_API SCM scm_ra2contig (SCM ra, int copy);
+
+/* internal. */
+
+typedef struct scm_i_t_array
+{
+  SCM v;  /* the contents of the array, e.g., a vector or uniform vector.  */
+  unsigned long base;
+} scm_i_t_array;
+
+SCM_API scm_t_bits scm_i_tc16_array;
+
+#define SCM_I_ARRAY_FLAG_CONTIGUOUS (1 << 16)
+
+#define SCM_I_ARRAYP(a)	    SCM_TYP16_PREDICATE (scm_i_tc16_array, a)
+#define SCM_I_ARRAY_NDIM(x)  ((size_t) (SCM_CELL_WORD_0 (x) >> 17))
+#define SCM_I_ARRAY_CONTP(x) (SCM_CELL_WORD_0(x) & SCM_I_ARRAY_FLAG_CONTIGUOUS)
+
+#define SCM_I_ARRAY_MEM(a)  ((scm_i_t_array *) SCM_CELL_WORD_1 (a))
+#define SCM_I_ARRAY_V(a)    (SCM_I_ARRAY_MEM (a)->v)
+#define SCM_I_ARRAY_BASE(a) (SCM_I_ARRAY_MEM (a)->base)
+#define SCM_I_ARRAY_DIMS(a) \
+  ((scm_t_array_dim *)((char *) SCM_I_ARRAY_MEM (a) + sizeof (scm_i_t_array)))
+
+SCM_INTERNAL SCM scm_i_make_array (int ndim);
+SCM_INTERNAL SCM scm_i_read_array (SCM port, int c);
+
+SCM_INTERNAL void scm_init_arrays (void);
+
+#endif  /* SCM_ARRAYS_H */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/async.c b/libguile/async.c
index 040082fb8..3e5a581c6 100644
--- a/libguile/async.c
+++ b/libguile/async.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2004, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -174,7 +175,7 @@ scm_async_click ()
 SCM_DEFINE (scm_system_async, "system-async", 1, 0, 0,
             (SCM thunk),
 	    "This function is deprecated.  You can use @var{thunk} directly\n"
-            "instead of explicitely creating an async object.\n")
+            "instead of explicitly creating an async object.\n")
 #define FUNC_NAME s_scm_system_async
 {
   scm_c_issue_deprecation_warning 
diff --git a/libguile/async.h b/libguile/async.h
index c01bde031..427d9b4c8 100644
--- a/libguile/async.h
+++ b/libguile/async.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2004, 2005, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/backtrace.c b/libguile/backtrace.c
index 798ade197..83579055f 100644
--- a/libguile/backtrace.c
+++ b/libguile/backtrace.c
@@ -2,18 +2,19 @@
  * Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004, 2006 Free Software Foundation
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 #ifdef HAVE_CONFIG_H
@@ -467,8 +468,21 @@ static void
 display_backtrace_get_file_line (SCM frame, SCM *file, SCM *line)
 {
   SCM source = SCM_FRAME_SOURCE (frame);
-  *file = SCM_MEMOIZEDP (source) ? scm_source_property (source, scm_sym_filename) : SCM_BOOL_F;
-  *line = (SCM_MEMOIZEDP (source)) ? scm_source_property (source, scm_sym_line) : SCM_BOOL_F;
+  *file = *line = SCM_BOOL_F;
+  if (SCM_MEMOIZEDP (source))
+    {
+      *file = scm_source_property (source, scm_sym_filename);
+      *line = scm_source_property (source, scm_sym_line);
+    }
+  else if (scm_is_pair (source)
+           && scm_is_pair (scm_cdr (source))
+           && scm_is_pair (scm_cddr (source))
+           && !scm_is_pair (scm_cdddr (source)))
+    {
+      /* (addr . (filename . (line . column))), from vm compilation */
+      *file = scm_cadr (source);
+      *line = scm_caddr (source);
+    }
 }
 
 static void
diff --git a/libguile/backtrace.h b/libguile/backtrace.h
index e11cb85de..c0651667c 100644
--- a/libguile/backtrace.h
+++ b/libguile/backtrace.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1996,1998,1999,2000,2001, 2004, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/bitvectors.c b/libguile/bitvectors.c
new file mode 100644
index 000000000..f1d8473d9
--- /dev/null
+++ b/libguile/bitvectors.c
@@ -0,0 +1,910 @@
+/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009 Free Software Foundation, Inc.
+ * 
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+
+
+
+#ifdef HAVE_CONFIG_H
+#  include <config.h>
+#endif
+
+#include <string.h>
+
+#include "libguile/_scm.h"
+#include "libguile/__scm.h"
+#include "libguile/smob.h"
+#include "libguile/strings.h"
+#include "libguile/array-handle.h"
+#include "libguile/bitvectors.h"
+#include "libguile/arrays.h"
+#include "libguile/generalized-vectors.h"
+#include "libguile/srfi-4.h"
+
+/* Bit vectors. Would be nice if they were implemented on top of bytevectors,
+ * but alack, all we have is this crufty C.
+ */
+
+static scm_t_bits scm_tc16_bitvector;
+
+#define IS_BITVECTOR(obj)       SCM_SMOB_PREDICATE(scm_tc16_bitvector,(obj))
+#define BITVECTOR_BITS(obj)     ((scm_t_uint32 *)SCM_SMOB_DATA(obj))
+#define BITVECTOR_LENGTH(obj)   ((size_t)SCM_SMOB_DATA_2(obj))
+
+static size_t
+bitvector_free (SCM vec)
+{
+  scm_gc_free (BITVECTOR_BITS (vec),
+	       sizeof (scm_t_uint32) * ((BITVECTOR_LENGTH (vec)+31)/32),
+	       "bitvector");
+  return 0;
+}
+
+static int
+bitvector_print (SCM vec, SCM port, scm_print_state *pstate)
+{
+  size_t bit_len = BITVECTOR_LENGTH (vec);
+  size_t word_len = (bit_len+31)/32;
+  scm_t_uint32 *bits = BITVECTOR_BITS (vec);
+  size_t i, j;
+
+  scm_puts ("#*", port);
+  for (i = 0; i < word_len; i++, bit_len -= 32)
+    {
+      scm_t_uint32 mask = 1;
+      for (j = 0; j < 32 && j < bit_len; j++, mask <<= 1)
+	scm_putc ((bits[i] & mask)? '1' : '0', port);
+    }
+    
+  return 1;
+}
+
+static SCM
+bitvector_equalp (SCM vec1, SCM vec2)
+{
+  size_t bit_len = BITVECTOR_LENGTH (vec1);
+  size_t word_len = (bit_len + 31) / 32;
+  scm_t_uint32 last_mask =  ((scm_t_uint32)-1) >> (32*word_len - bit_len);
+  scm_t_uint32 *bits1 = BITVECTOR_BITS (vec1);
+  scm_t_uint32 *bits2 = BITVECTOR_BITS (vec2);
+
+  /* compare lengths */
+  if (BITVECTOR_LENGTH (vec2) != bit_len)
+    return SCM_BOOL_F;
+  /* avoid underflow in word_len-1 below. */
+  if (bit_len == 0)
+    return SCM_BOOL_T;
+  /* compare full words */
+  if (memcmp (bits1, bits2, sizeof (scm_t_uint32) * (word_len-1)))
+    return SCM_BOOL_F;
+  /* compare partial last words */
+  if ((bits1[word_len-1] & last_mask) != (bits2[word_len-1] & last_mask))
+    return SCM_BOOL_F;
+  return SCM_BOOL_T;
+}
+
+int
+scm_is_bitvector (SCM vec)
+{
+  return IS_BITVECTOR (vec);
+}
+
+SCM_DEFINE (scm_bitvector_p, "bitvector?", 1, 0, 0,
+	    (SCM obj),
+	    "Return @code{#t} when @var{obj} is a bitvector, else\n"
+	    "return @code{#f}.")
+#define FUNC_NAME s_scm_bitvector_p
+{
+  return scm_from_bool (scm_is_bitvector (obj));
+}
+#undef FUNC_NAME
+
+SCM
+scm_c_make_bitvector (size_t len, SCM fill)
+{
+  size_t word_len = (len + 31) / 32;
+  scm_t_uint32 *bits;
+  SCM res;
+
+  bits = scm_gc_malloc (sizeof (scm_t_uint32) * word_len,
+			"bitvector");
+  SCM_NEWSMOB2 (res, scm_tc16_bitvector, bits, len);
+
+  if (!SCM_UNBNDP (fill))
+    scm_bitvector_fill_x (res, fill);
+      
+  return res;
+}
+
+SCM_DEFINE (scm_make_bitvector, "make-bitvector", 1, 1, 0,
+	    (SCM len, SCM fill),
+	    "Create a new bitvector of length @var{len} and\n"
+	    "optionally initialize all elements to @var{fill}.")
+#define FUNC_NAME s_scm_make_bitvector
+{
+  return scm_c_make_bitvector (scm_to_size_t (len), fill);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bitvector, "bitvector", 0, 0, 1,
+	    (SCM bits),
+	    "Create a new bitvector with the arguments as elements.")
+#define FUNC_NAME s_scm_bitvector
+{
+  return scm_list_to_bitvector (bits);
+}
+#undef FUNC_NAME
+
+size_t
+scm_c_bitvector_length (SCM vec)
+{
+  scm_assert_smob_type (scm_tc16_bitvector, vec);
+  return BITVECTOR_LENGTH (vec);
+}
+
+SCM_DEFINE (scm_bitvector_length, "bitvector-length", 1, 0, 0,
+	    (SCM vec),
+	    "Return the length of the bitvector @var{vec}.")
+#define FUNC_NAME s_scm_bitvector_length
+{
+  return scm_from_size_t (scm_c_bitvector_length (vec));
+}
+#undef FUNC_NAME
+
+const scm_t_uint32 *
+scm_array_handle_bit_elements (scm_t_array_handle *h)
+{
+  return scm_array_handle_bit_writable_elements (h);
+}
+
+scm_t_uint32 *
+scm_array_handle_bit_writable_elements (scm_t_array_handle *h)
+{
+  SCM vec = h->array;
+  if (SCM_I_ARRAYP (vec))
+    vec = SCM_I_ARRAY_V (vec);
+  if (IS_BITVECTOR (vec))
+    return BITVECTOR_BITS (vec) + h->base/32;
+  scm_wrong_type_arg_msg (NULL, 0, h->array, "bit array");
+}
+
+size_t
+scm_array_handle_bit_elements_offset (scm_t_array_handle *h)
+{
+  return h->base % 32;
+}
+
+const scm_t_uint32 *
+scm_bitvector_elements (SCM vec,
+			scm_t_array_handle *h,
+			size_t *offp,
+			size_t *lenp,
+			ssize_t *incp)
+{
+  return scm_bitvector_writable_elements (vec, h, offp, lenp, incp);
+}
+
+
+scm_t_uint32 *
+scm_bitvector_writable_elements (SCM vec,
+				 scm_t_array_handle *h,
+				 size_t *offp,
+				 size_t *lenp,
+				 ssize_t *incp)
+{
+  scm_generalized_vector_get_handle (vec, h);
+  if (offp)
+    {
+      scm_t_array_dim *dim = scm_array_handle_dims (h);
+      *offp = scm_array_handle_bit_elements_offset (h);
+      *lenp = dim->ubnd - dim->lbnd + 1;
+      *incp = dim->inc;
+    }
+  return scm_array_handle_bit_writable_elements (h);
+}
+
+SCM
+scm_c_bitvector_ref (SCM vec, size_t idx)
+{
+  scm_t_array_handle handle;
+  const scm_t_uint32 *bits;
+
+  if (IS_BITVECTOR (vec))
+    {
+      if (idx >= BITVECTOR_LENGTH (vec))
+	scm_out_of_range (NULL, scm_from_size_t (idx));
+      bits = BITVECTOR_BITS(vec);
+      return scm_from_bool (bits[idx/32] & (1L << (idx%32)));
+    }
+  else
+    {
+      SCM res;
+      size_t len, off;
+      ssize_t inc;
+  
+      bits = scm_bitvector_elements (vec, &handle, &off, &len, &inc);
+      if (idx >= len)
+	scm_out_of_range (NULL, scm_from_size_t (idx));
+      idx = idx*inc + off;
+      res = scm_from_bool (bits[idx/32] & (1L << (idx%32)));
+      scm_array_handle_release (&handle);
+      return res;
+    }
+}
+
+SCM_DEFINE (scm_bitvector_ref, "bitvector-ref", 2, 0, 0,
+	    (SCM vec, SCM idx),
+	    "Return the element at index @var{idx} of the bitvector\n"
+	    "@var{vec}.")
+#define FUNC_NAME s_scm_bitvector_ref
+{
+  return scm_c_bitvector_ref (vec, scm_to_size_t (idx));
+}
+#undef FUNC_NAME
+
+void
+scm_c_bitvector_set_x (SCM vec, size_t idx, SCM val)
+{
+  scm_t_array_handle handle;
+  scm_t_uint32 *bits, mask;
+
+  if (IS_BITVECTOR (vec))
+    {
+      if (idx >= BITVECTOR_LENGTH (vec))
+	scm_out_of_range (NULL, scm_from_size_t (idx));
+      bits = BITVECTOR_BITS(vec);
+    }
+  else
+    {
+      size_t len, off;
+      ssize_t inc;
+  
+      bits = scm_bitvector_writable_elements (vec, &handle, &off, &len, &inc);
+      if (idx >= len)
+	scm_out_of_range (NULL, scm_from_size_t (idx));
+      idx = idx*inc + off;
+    }
+
+  mask = 1L << (idx%32);
+  if (scm_is_true (val))
+    bits[idx/32] |= mask;
+  else
+    bits[idx/32] &= ~mask;
+
+  if (!IS_BITVECTOR (vec))
+      scm_array_handle_release (&handle);
+}
+
+SCM_DEFINE (scm_bitvector_set_x, "bitvector-set!", 3, 0, 0,
+	    (SCM vec, SCM idx, SCM val),
+	    "Set the element at index @var{idx} of the bitvector\n"
+	    "@var{vec} when @var{val} is true, else clear it.")
+#define FUNC_NAME s_scm_bitvector_set_x
+{
+  scm_c_bitvector_set_x (vec, scm_to_size_t (idx), val);
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bitvector_fill_x, "bitvector-fill!", 2, 0, 0,
+	    (SCM vec, SCM val),
+	    "Set all elements of the bitvector\n"
+	    "@var{vec} when @var{val} is true, else clear them.")
+#define FUNC_NAME s_scm_bitvector_fill_x
+{
+  scm_t_array_handle handle;
+  size_t off, len;
+  ssize_t inc;
+  scm_t_uint32 *bits;
+
+  bits = scm_bitvector_writable_elements (vec, &handle,
+					  &off, &len, &inc);
+
+  if (off == 0 && inc == 1 && len > 0)
+    {
+      /* the usual case
+       */
+      size_t word_len = (len + 31) / 32;
+      scm_t_uint32 last_mask =  ((scm_t_uint32)-1) >> (32*word_len - len);
+
+      if (scm_is_true (val))
+	{
+	  memset (bits, 0xFF, sizeof(scm_t_uint32)*(word_len-1));
+	  bits[word_len-1] |= last_mask;
+	}
+      else
+	{
+	  memset (bits, 0x00, sizeof(scm_t_uint32)*(word_len-1));
+	  bits[word_len-1] &= ~last_mask;
+	}
+    }
+  else
+    {
+      size_t i;
+      for (i = 0; i < len; i++)
+	scm_array_handle_set (&handle, i*inc, val);
+    }
+
+  scm_array_handle_release (&handle);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_list_to_bitvector, "list->bitvector", 1, 0, 0,
+	    (SCM list),
+	    "Return a new bitvector initialized with the elements\n"
+	    "of @var{list}.")
+#define FUNC_NAME s_scm_list_to_bitvector
+{
+  size_t bit_len = scm_to_size_t (scm_length (list));
+  SCM vec = scm_c_make_bitvector (bit_len, SCM_UNDEFINED);
+  size_t word_len = (bit_len+31)/32;
+  scm_t_array_handle handle;
+  scm_t_uint32 *bits = scm_bitvector_writable_elements (vec, &handle,
+							NULL, NULL, NULL);
+  size_t i, j;
+
+  for (i = 0; i < word_len && scm_is_pair (list); i++, bit_len -= 32)
+    {
+      scm_t_uint32 mask = 1;
+      bits[i] = 0;
+      for (j = 0; j < 32 && j < bit_len;
+	   j++, mask <<= 1, list = SCM_CDR (list))
+	if (scm_is_true (SCM_CAR (list)))
+	  bits[i] |= mask;
+    }
+
+  scm_array_handle_release (&handle);
+
+  return vec;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bitvector_to_list, "bitvector->list", 1, 0, 0,
+	    (SCM vec),
+	    "Return a new list initialized with the elements\n"
+	    "of the bitvector @var{vec}.")
+#define FUNC_NAME s_scm_bitvector_to_list
+{
+  scm_t_array_handle handle;
+  size_t off, len;
+  ssize_t inc;
+  scm_t_uint32 *bits;
+  SCM res = SCM_EOL;
+
+  bits = scm_bitvector_writable_elements (vec, &handle,
+					  &off, &len, &inc);
+
+  if (off == 0 && inc == 1)
+    {
+      /* the usual case
+       */
+      size_t word_len = (len + 31) / 32;
+      size_t i, j;
+
+      for (i = 0; i < word_len; i++, len -= 32)
+	{
+	  scm_t_uint32 mask = 1;
+	  for (j = 0; j < 32 && j < len; j++, mask <<= 1)
+	    res = scm_cons ((bits[i] & mask)? SCM_BOOL_T : SCM_BOOL_F, res);
+	}
+    }
+  else
+    {
+      size_t i;
+      for (i = 0; i < len; i++)
+	res = scm_cons (scm_array_handle_ref (&handle, i*inc), res);
+    }
+
+  scm_array_handle_release (&handle);
+  
+  return scm_reverse_x (res, SCM_EOL);
+}
+#undef FUNC_NAME
+
+/* From mmix-arith.w by Knuth.
+
+  Here's a fun way to count the number of bits in a tetrabyte.
+
+  [This classical trick is called the ``Gillies--Miller method for
+  sideways addition'' in {\sl The Preparation of Programs for an
+  Electronic Digital Computer\/} by Wilkes, Wheeler, and Gill, second
+  edition (Reading, Mass.:\ Addison--Wesley, 1957), 191--193. Some of
+  the tricks used here were suggested by Balbir Singh, Peter
+  Rossmanith, and Stefan Schwoon.]
+*/
+
+static size_t
+count_ones (scm_t_uint32 x)
+{
+  x=x-((x>>1)&0x55555555);
+  x=(x&0x33333333)+((x>>2)&0x33333333);
+  x=(x+(x>>4))&0x0f0f0f0f;
+  x=x+(x>>8);
+  return (x+(x>>16)) & 0xff;
+}
+
+SCM_DEFINE (scm_bit_count, "bit-count", 2, 0, 0,
+	    (SCM b, SCM bitvector),
+	    "Return the number of occurrences of the boolean @var{b} in\n"
+	    "@var{bitvector}.")
+#define FUNC_NAME s_scm_bit_count
+{
+  scm_t_array_handle handle;
+  size_t off, len;
+  ssize_t inc;
+  scm_t_uint32 *bits;
+  int bit = scm_to_bool (b);
+  size_t count = 0;
+
+  bits = scm_bitvector_writable_elements (bitvector, &handle,
+					  &off, &len, &inc);
+
+  if (off == 0 && inc == 1 && len > 0)
+    {
+      /* the usual case
+       */
+      size_t word_len = (len + 31) / 32;
+      scm_t_uint32 last_mask =  ((scm_t_uint32)-1) >> (32*word_len - len);
+      size_t i;
+
+      for (i = 0; i < word_len-1; i++)
+	count += count_ones (bits[i]);
+      count += count_ones (bits[i] & last_mask);
+    }
+  else
+    {
+      size_t i;
+      for (i = 0; i < len; i++)
+	if (scm_is_true (scm_array_handle_ref (&handle, i*inc)))
+	  count++;
+    }
+  
+  scm_array_handle_release (&handle);
+
+  return scm_from_size_t (bit? count : len-count);
+}
+#undef FUNC_NAME
+
+/* returns 32 for x == 0. 
+*/
+static size_t
+find_first_one (scm_t_uint32 x)
+{
+  size_t pos = 0;
+  /* do a binary search in x. */
+  if ((x & 0xFFFF) == 0)
+    x >>= 16, pos += 16;
+  if ((x & 0xFF) == 0)
+    x >>= 8, pos += 8;
+  if ((x & 0xF) == 0)
+    x >>= 4, pos += 4;
+  if ((x & 0x3) == 0)
+    x >>= 2, pos += 2;
+  if ((x & 0x1) == 0)
+    pos += 1;
+  return pos;
+}
+
+SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0,
+           (SCM item, SCM v, SCM k),
+	    "Return the index of the first occurrance of @var{item} in bit\n"
+	    "vector @var{v}, starting from @var{k}.  If there is no\n"
+	    "@var{item} entry between @var{k} and the end of\n"
+	    "@var{bitvector}, then return @code{#f}.  For example,\n"
+	    "\n"
+	    "@example\n"
+	    "(bit-position #t #*000101 0)  @result{} 3\n"
+	    "(bit-position #f #*0001111 3) @result{} #f\n"
+	    "@end example")
+#define FUNC_NAME s_scm_bit_position
+{
+  scm_t_array_handle handle;
+  size_t off, len, first_bit;
+  ssize_t inc;
+  const scm_t_uint32 *bits;
+  int bit = scm_to_bool (item);
+  SCM res = SCM_BOOL_F;
+  
+  bits = scm_bitvector_elements (v, &handle, &off, &len, &inc);
+  first_bit = scm_to_unsigned_integer (k, 0, len);
+
+  if (off == 0 && inc == 1 && len > 0)
+    {
+      size_t i, word_len = (len + 31) / 32;
+      scm_t_uint32 last_mask =  ((scm_t_uint32)-1) >> (32*word_len - len);
+      size_t first_word = first_bit / 32;
+      scm_t_uint32 first_mask =
+	((scm_t_uint32)-1) << (first_bit - 32*first_word);
+      scm_t_uint32 w;
+      
+      for (i = first_word; i < word_len; i++)
+	{
+	  w = (bit? bits[i] : ~bits[i]);
+	  if (i == first_word)
+	    w &= first_mask;
+	  if (i == word_len-1)
+	    w &= last_mask;
+	  if (w)
+	    {
+	      res = scm_from_size_t (32*i + find_first_one (w));
+	      break;
+	    }
+	}
+    }
+  else
+    {
+      size_t i;
+      for (i = first_bit; i < len; i++)
+	{
+	  SCM elt = scm_array_handle_ref (&handle, i*inc);
+	  if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt)))
+	    {
+	      res = scm_from_size_t (i);
+	      break;
+	    }
+	}
+    }
+
+  scm_array_handle_release (&handle);
+
+  return res;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0,
+	    (SCM v, SCM kv, SCM obj),
+	    "Set entries of bit vector @var{v} to @var{obj}, with @var{kv}\n"
+	    "selecting the entries to change.  The return value is\n"
+	    "unspecified.\n"
+	    "\n"
+	    "If @var{kv} is a bit vector, then those entries where it has\n"
+	    "@code{#t} are the ones in @var{v} which are set to @var{obj}.\n"
+	    "@var{kv} and @var{v} must be the same length.  When @var{obj}\n"
+	    "is @code{#t} it's like @var{kv} is OR'ed into @var{v}.  Or when\n"
+	    "@var{obj} is @code{#f} it can be seen as an ANDNOT.\n"
+	    "\n"
+	    "@example\n"
+	    "(define bv #*01000010)\n"
+	    "(bit-set*! bv #*10010001 #t)\n"
+	    "bv\n"
+	    "@result{} #*11010011\n"
+	    "@end example\n"
+	    "\n"
+	    "If @var{kv} is a u32vector, then its elements are\n"
+	    "indices into @var{v} which are set to @var{obj}.\n"
+	    "\n"
+	    "@example\n"
+	    "(define bv #*01000010)\n"
+	    "(bit-set*! bv #u32(5 2 7) #t)\n"
+	    "bv\n"
+	    "@result{} #*01100111\n"
+	    "@end example")
+#define FUNC_NAME s_scm_bit_set_star_x
+{
+  scm_t_array_handle v_handle;
+  size_t v_off, v_len;
+  ssize_t v_inc;
+  scm_t_uint32 *v_bits;
+  int bit;
+
+  /* Validate that OBJ is a boolean so this is done even if we don't
+     need BIT.
+  */
+  bit = scm_to_bool (obj);
+
+  v_bits = scm_bitvector_writable_elements (v, &v_handle,
+					    &v_off, &v_len, &v_inc);
+
+  if (scm_is_bitvector (kv))
+    {
+      scm_t_array_handle kv_handle;
+      size_t kv_off, kv_len;
+      ssize_t kv_inc;
+      const scm_t_uint32 *kv_bits;
+      
+      kv_bits = scm_bitvector_elements (v, &kv_handle,
+					&kv_off, &kv_len, &kv_inc);
+
+      if (v_len != kv_len)
+	scm_misc_error (NULL,
+			"bit vectors must have equal length",
+			SCM_EOL);
+
+      if (v_off == 0 && v_inc == 1 && kv_off == 0 && kv_inc == 1 && kv_len > 0)
+	{
+	  size_t word_len = (kv_len + 31) / 32;
+	  scm_t_uint32 last_mask = ((scm_t_uint32)-1) >> (32*word_len - kv_len);
+	  size_t i;
+ 
+	  if (bit == 0)
+	    {
+	      for (i = 0; i < word_len-1; i++)
+		v_bits[i] &= ~kv_bits[i];
+	      v_bits[i] &= ~(kv_bits[i] & last_mask);
+	    }
+	  else
+	    {
+	      for (i = 0; i < word_len-1; i++)
+		v_bits[i] |= kv_bits[i];
+	      v_bits[i] |= kv_bits[i] & last_mask;
+	    }
+	}
+      else
+	{
+	  size_t i;
+	  for (i = 0; i < kv_len; i++)
+	    if (scm_is_true (scm_array_handle_ref (&kv_handle, i*kv_inc)))
+	      scm_array_handle_set (&v_handle, i*v_inc, obj);
+	}
+      
+      scm_array_handle_release (&kv_handle);
+
+    }
+  else if (scm_is_true (scm_u32vector_p (kv)))
+    {
+      scm_t_array_handle kv_handle;
+      size_t i, kv_len;
+      ssize_t kv_inc;
+      const scm_t_uint32 *kv_elts;
+
+      kv_elts = scm_u32vector_elements (kv, &kv_handle, &kv_len, &kv_inc);
+      for (i = 0; i < kv_len; i++, kv_elts += kv_inc)
+	scm_array_handle_set (&v_handle, (*kv_elts)*v_inc, obj);
+
+      scm_array_handle_release (&kv_handle);
+    }
+  else 
+    scm_wrong_type_arg_msg (NULL, 0, kv, "bitvector or u32vector");
+
+  scm_array_handle_release (&v_handle);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0,
+           (SCM v, SCM kv, SCM obj),
+	    "Return a count of how many entries in bit vector @var{v} are\n"
+	    "equal to @var{obj}, with @var{kv} selecting the entries to\n"
+	    "consider.\n"
+	    "\n"
+	    "If @var{kv} is a bit vector, then those entries where it has\n"
+	    "@code{#t} are the ones in @var{v} which are considered.\n"
+	    "@var{kv} and @var{v} must be the same length.\n"
+	    "\n"
+	    "If @var{kv} is a u32vector, then it contains\n"
+	    "the indexes in @var{v} to consider.\n"
+	    "\n"
+	    "For example,\n"
+	    "\n"
+	    "@example\n"
+	    "(bit-count* #*01110111 #*11001101 #t) @result{} 3\n"
+	    "(bit-count* #*01110111 #u32(7 0 4) #f)  @result{} 2\n"
+	    "@end example")
+#define FUNC_NAME s_scm_bit_count_star
+{
+  scm_t_array_handle v_handle;
+  size_t v_off, v_len;
+  ssize_t v_inc;
+  const scm_t_uint32 *v_bits;
+  size_t count = 0;
+  int bit;
+
+  /* Validate that OBJ is a boolean so this is done even if we don't
+     need BIT.
+  */
+  bit = scm_to_bool (obj);
+
+  v_bits = scm_bitvector_elements (v, &v_handle,
+				   &v_off, &v_len, &v_inc);
+
+  if (scm_is_bitvector (kv))
+    {
+      scm_t_array_handle kv_handle;
+      size_t kv_off, kv_len;
+      ssize_t kv_inc;
+      const scm_t_uint32 *kv_bits;
+      
+      kv_bits = scm_bitvector_elements (v, &kv_handle,
+					&kv_off, &kv_len, &kv_inc);
+
+      if (v_len != kv_len)
+	scm_misc_error (NULL,
+			"bit vectors must have equal length",
+			SCM_EOL);
+
+      if (v_off == 0 && v_inc == 1 && kv_off == 0 && kv_inc == 1 && kv_len > 0)
+	{
+	  size_t i, word_len = (kv_len + 31) / 32;
+	  scm_t_uint32 last_mask = ((scm_t_uint32)-1) >> (32*word_len - kv_len);
+	  scm_t_uint32 xor_mask = bit? 0 : ((scm_t_uint32)-1);
+
+	  for (i = 0; i < word_len-1; i++)
+	    count += count_ones ((v_bits[i]^xor_mask) & kv_bits[i]);
+	  count += count_ones ((v_bits[i]^xor_mask) & kv_bits[i] & last_mask);
+ 	}
+      else
+	{
+	  size_t i;
+	  for (i = 0; i < kv_len; i++)
+	    if (scm_is_true (scm_array_handle_ref (&kv_handle, i)))
+	      {
+		SCM elt = scm_array_handle_ref (&v_handle, i*v_inc);
+		if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt)))
+		  count++;
+	      }
+	}
+      
+      scm_array_handle_release (&kv_handle);
+
+    }
+  else if (scm_is_true (scm_u32vector_p (kv)))
+    {
+      scm_t_array_handle kv_handle;
+      size_t i, kv_len;
+      ssize_t kv_inc;
+      const scm_t_uint32 *kv_elts;
+
+      kv_elts = scm_u32vector_elements (kv, &kv_handle, &kv_len, &kv_inc);
+      for (i = 0; i < kv_len; i++, kv_elts += kv_inc)
+	{
+	  SCM elt = scm_array_handle_ref (&v_handle, (*kv_elts)*v_inc);
+	  if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt)))
+	    count++;
+	}
+
+      scm_array_handle_release (&kv_handle);
+    }
+  else 
+    scm_wrong_type_arg_msg (NULL, 0, kv, "bitvector or u32vector");
+
+  scm_array_handle_release (&v_handle);
+
+  return scm_from_size_t (count);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bit_invert_x, "bit-invert!", 1, 0, 0, 
+           (SCM v),
+	    "Modify the bit vector @var{v} by replacing each element with\n"
+	    "its negation.")
+#define FUNC_NAME s_scm_bit_invert_x
+{
+  scm_t_array_handle handle;
+  size_t off, len;
+  ssize_t inc;
+  scm_t_uint32 *bits;
+
+  bits = scm_bitvector_writable_elements (v, &handle, &off, &len, &inc);
+  
+  if (off == 0 && inc == 1 && len > 0)
+    {
+      size_t word_len = (len + 31) / 32;
+      scm_t_uint32 last_mask = ((scm_t_uint32)-1) >> (32*word_len - len);
+      size_t i;
+
+      for (i = 0; i < word_len-1; i++)
+	bits[i] = ~bits[i];
+      bits[i] = bits[i] ^ last_mask;
+    }
+  else
+    {
+      size_t i;
+      for (i = 0; i < len; i++)
+	scm_array_handle_set (&handle, i*inc,
+			      scm_not (scm_array_handle_ref (&handle, i*inc)));
+    }
+
+  scm_array_handle_release (&handle);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
+SCM
+scm_istr2bve (SCM str)
+{
+  scm_t_array_handle handle;
+  size_t len = scm_i_string_length (str);
+  SCM vec = scm_c_make_bitvector (len, SCM_UNDEFINED);
+  SCM res = vec;
+
+  scm_t_uint32 mask;
+  size_t k, j;
+  const char *c_str;
+  scm_t_uint32 *data;
+
+  data = scm_bitvector_writable_elements (vec, &handle, NULL, NULL, NULL);
+  c_str = scm_i_string_chars (str);
+
+  for (k = 0; k < (len + 31) / 32; k++)
+    {
+      data[k] = 0L;
+      j = len - k * 32;
+      if (j > 32)
+	j = 32;
+      for (mask = 1L; j--; mask <<= 1)
+	switch (*c_str++)
+	  {
+	  case '0':
+	    break;
+	  case '1':
+	    data[k] |= mask;
+	    break;
+	  default:
+	    res = SCM_BOOL_F;
+	    goto exit;
+	  }
+    }
+  
+ exit:
+  scm_array_handle_release (&handle);
+  scm_remember_upto_here_1 (str);
+  return res;
+}
+
+/* FIXME: h->array should be h->vector */
+static SCM
+bitvector_handle_ref (scm_t_array_handle *h, size_t pos)
+{
+  return scm_c_bitvector_ref (h->array, pos);
+}
+
+static void
+bitvector_handle_set (scm_t_array_handle *h, size_t pos, SCM val)
+{
+  scm_c_bitvector_set_x (h->array, pos, val);
+}
+
+static void
+bitvector_get_handle (SCM bv, scm_t_array_handle *h)
+{
+  h->array = bv;
+  h->ndims = 1;
+  h->dims = &h->dim0;
+  h->dim0.lbnd = 0;
+  h->dim0.ubnd = BITVECTOR_LENGTH (bv) - 1;
+  h->dim0.inc = 1;
+  h->element_type = SCM_ARRAY_ELEMENT_TYPE_BIT;
+  h->elements = h->writable_elements = BITVECTOR_BITS (bv);
+}
+
+SCM_ARRAY_IMPLEMENTATION (scm_tc16_bitvector, 0xffff,
+                          bitvector_handle_ref, bitvector_handle_set,
+                          bitvector_get_handle);
+SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_BIT, scm_make_bitvector);
+
+void
+scm_init_bitvectors ()
+{
+  scm_tc16_bitvector = scm_make_smob_type ("bitvector", 0);
+  scm_set_smob_free (scm_tc16_bitvector, bitvector_free);
+  scm_set_smob_print (scm_tc16_bitvector, bitvector_print);
+  scm_set_smob_equalp (scm_tc16_bitvector, bitvector_equalp);
+
+#include "libguile/bitvectors.x"
+}
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/bitvectors.h b/libguile/bitvectors.h
new file mode 100644
index 000000000..b6cf38357
--- /dev/null
+++ b/libguile/bitvectors.h
@@ -0,0 +1,81 @@
+/* classes: h_files */
+
+#ifndef SCM_BITVECTORS_H
+#define SCM_BITVECTORS_H
+
+/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009 Free Software Foundation, Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+
+
+#include "libguile/__scm.h"
+#include "libguile/array-handle.h"
+
+
+
+/* Bitvectors. Exciting stuff, maybe!
+ */
+
+
+/** Bit vectors */
+
+SCM_API SCM scm_bitvector_p (SCM vec);
+SCM_API SCM scm_bitvector (SCM bits);
+SCM_API SCM scm_make_bitvector (SCM len, SCM fill);
+SCM_API SCM scm_bitvector_length (SCM vec);
+SCM_API SCM scm_bitvector_ref (SCM vec, SCM idx);
+SCM_API SCM scm_bitvector_set_x (SCM vec, SCM idx, SCM val);
+SCM_API SCM scm_list_to_bitvector (SCM list);
+SCM_API SCM scm_bitvector_to_list (SCM vec);
+SCM_API SCM scm_bitvector_fill_x (SCM vec, SCM val);
+
+SCM_API SCM scm_bit_count (SCM item, SCM seq);
+SCM_API SCM scm_bit_position (SCM item, SCM v, SCM k);
+SCM_API SCM scm_bit_set_star_x (SCM v, SCM kv, SCM obj);
+SCM_API SCM scm_bit_count_star (SCM v, SCM kv, SCM obj);
+SCM_API SCM scm_bit_invert_x (SCM v);
+SCM_API SCM scm_istr2bve (SCM str);
+
+SCM_API int scm_is_bitvector (SCM obj);
+SCM_API SCM scm_c_make_bitvector (size_t len, SCM fill);
+SCM_API size_t scm_c_bitvector_length (SCM vec);
+SCM_API SCM scm_c_bitvector_ref (SCM vec, size_t idx);
+SCM_API void scm_c_bitvector_set_x (SCM vec, size_t idx, SCM val);
+SCM_API const scm_t_uint32 *scm_array_handle_bit_elements (scm_t_array_handle *h);
+SCM_API scm_t_uint32 *scm_array_handle_bit_writable_elements (scm_t_array_handle *h);
+SCM_API size_t scm_array_handle_bit_elements_offset (scm_t_array_handle *h);
+SCM_API const scm_t_uint32 *scm_bitvector_elements (SCM vec,
+						    scm_t_array_handle *h,
+						    size_t *offp,
+						    size_t *lenp,
+						    ssize_t *incp);
+SCM_API scm_t_uint32 *scm_bitvector_writable_elements (SCM vec, 
+						       scm_t_array_handle *h,
+						       size_t *offp,
+						       size_t *lenp,
+						       ssize_t *incp);
+
+SCM_INTERNAL void scm_init_bitvectors (void);
+
+#endif  /* SCM_BITVECTORS_H */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/boehm-gc.h b/libguile/boehm-gc.h
index ab842bc1b..9a92d08b2 100644
--- a/libguile/boehm-gc.h
+++ b/libguile/boehm-gc.h
@@ -20,9 +20,9 @@
 
 /* Correct header inclusion.  */
 
-#include "libguile/gen-scmconfig.h"
+#include "libguile/scmconfig.h"
 
-#ifdef SCM_I_GSC_USE_PTHREAD_THREADS
+#ifdef SCM_USE_PTHREAD_THREADS
 
 /* When pthreads are used, let `libgc' know about it and redirect allocation
    calls such as `GC_MALLOC ()' to (contention-free, faster) thread-local
diff --git a/libguile/boolean.c b/libguile/boolean.c
index 4b06e04e2..d79bf7979 100644
--- a/libguile/boolean.c
+++ b/libguile/boolean.c
@@ -1,18 +1,19 @@
 /*	Copyright (C) 1995, 1996, 2000, 2001, 2006, 2008 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/boolean.h b/libguile/boolean.h
index 1388c2fdc..5a8379713 100644
--- a/libguile/boolean.h
+++ b/libguile/boolean.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,2000, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
new file mode 100644
index 000000000..4246f0111
--- /dev/null
+++ b/libguile/bytevectors.c
@@ -0,0 +1,2250 @@
+/* Copyright (C) 2009 Free Software Foundation, Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <alloca.h>
+
+#include <gmp.h>
+
+#include "libguile/_scm.h"
+#include "libguile/extensions.h"
+#include "libguile/bytevectors.h"
+#include "libguile/strings.h"
+#include "libguile/validate.h"
+#include "libguile/ieee-754.h"
+#include "libguile/arrays.h"
+#include "libguile/array-handle.h"
+#include "libguile/uniform.h"
+#include "libguile/srfi-4.h"
+
+#include <byteswap.h>
+#include <striconveh.h>
+#include <uniconv.h>
+
+#ifdef HAVE_LIMITS_H
+# include <limits.h>
+#else
+/* Assuming 32-bit longs.  */
+# define ULONG_MAX 4294967295UL
+#endif
+
+#include <string.h>
+
+
+
+/* Utilities.  */
+
+/* Convenience macros.  These are used by the various templates (macros) that
+   are parameterized by integer signedness.  */
+#define INT8_T_signed           scm_t_int8
+#define INT8_T_unsigned         scm_t_uint8
+#define INT16_T_signed          scm_t_int16
+#define INT16_T_unsigned        scm_t_uint16
+#define INT32_T_signed          scm_t_int32
+#define INT32_T_unsigned        scm_t_uint32
+#define is_signed_int8(_x)      (((_x) >= -128L) && ((_x) <= 127L))
+#define is_unsigned_int8(_x)    ((_x) <= 255UL)
+#define is_signed_int16(_x)     (((_x) >= -32768L) && ((_x) <= 32767L))
+#define is_unsigned_int16(_x)   ((_x) <= 65535UL)
+#define is_signed_int32(_x)     (((_x) >= -2147483648L) && ((_x) <= 2147483647L))
+#define is_unsigned_int32(_x)   ((_x) <= 4294967295UL)
+#define SIGNEDNESS_signed       1
+#define SIGNEDNESS_unsigned     0
+
+#define INT_TYPE(_size, _sign)  INT ## _size ## _T_ ## _sign
+#define INT_SWAP(_size)         bswap_ ## _size
+#define INT_VALID_P(_size, _sign) is_ ## _sign ## _int ## _size
+#define SIGNEDNESS(_sign)       SIGNEDNESS_ ## _sign
+
+
+#define INTEGER_ACCESSOR_PROLOGUE(_len, _sign)			\
+  size_t c_len, c_index;					\
+  _sign char *c_bv;						\
+								\
+  SCM_VALIDATE_BYTEVECTOR (1, bv);				\
+  c_index = scm_to_uint (index);				\
+								\
+  c_len = SCM_BYTEVECTOR_LENGTH (bv);				\
+  c_bv = (_sign char *) SCM_BYTEVECTOR_CONTENTS (bv);		\
+								\
+  if (SCM_UNLIKELY (c_index + ((_len) >> 3UL) - 1 >= c_len))	\
+    scm_out_of_range (FUNC_NAME, index);
+
+/* Template for fixed-size integer access (only 8, 16 or 32-bit).  */
+#define INTEGER_REF(_len, _sign)                                \
+  SCM result;                                                   \
+                                                                \
+  INTEGER_ACCESSOR_PROLOGUE (_len, _sign);                      \
+  SCM_VALIDATE_SYMBOL (3, endianness);                          \
+                                                                \
+  {                                                             \
+      INT_TYPE (_len, _sign)  c_result;                         \
+                                                                \
+    memcpy (&c_result, &c_bv[c_index], (_len) / 8);             \
+    if (!scm_is_eq (endianness, scm_i_native_endianness))       \
+      c_result = INT_SWAP (_len) (c_result);                    \
+                                                                \
+    result = SCM_I_MAKINUM (c_result);                          \
+  }                                                             \
+                                                                \
+  return result;
+
+/* Template for fixed-size integer access using the native endianness.  */
+#define INTEGER_NATIVE_REF(_len, _sign)			\
+  SCM result;						\
+							\
+  INTEGER_ACCESSOR_PROLOGUE (_len, _sign);		\
+							\
+  {							\
+    INT_TYPE (_len, _sign)  c_result;			\
+							\
+    memcpy (&c_result, &c_bv[c_index], (_len) / 8);	\
+    result = SCM_I_MAKINUM (c_result);			\
+  }							\
+							\
+  return result;
+
+/* Template for fixed-size integer modification (only 8, 16 or 32-bit).  */
+#define INTEGER_SET(_len, _sign)				\
+  INTEGER_ACCESSOR_PROLOGUE (_len, _sign);			\
+  SCM_VALIDATE_SYMBOL (3, endianness);				\
+								\
+  {								\
+    _sign long c_value;						\
+    INT_TYPE (_len, _sign) c_value_short;			\
+								\
+    if (SCM_UNLIKELY (!SCM_I_INUMP (value)))			\
+      scm_wrong_type_arg (FUNC_NAME, 3, value);			\
+								\
+    c_value = SCM_I_INUM (value);				\
+    if (SCM_UNLIKELY (!INT_VALID_P (_len, _sign) (c_value)))	\
+      scm_out_of_range (FUNC_NAME, value);			\
+								\
+    c_value_short = (INT_TYPE (_len, _sign)) c_value;		\
+    if (!scm_is_eq (endianness, scm_i_native_endianness))       \
+      c_value_short = INT_SWAP (_len) (c_value_short);		\
+								\
+    memcpy (&c_bv[c_index], &c_value_short, (_len) / 8);	\
+  }								\
+								\
+  return SCM_UNSPECIFIED;
+
+/* Template for fixed-size integer modification using the native
+   endianness.  */
+#define INTEGER_NATIVE_SET(_len, _sign)				\
+  INTEGER_ACCESSOR_PROLOGUE (_len, _sign);			\
+								\
+  {								\
+    _sign long c_value;						\
+    INT_TYPE (_len, _sign) c_value_short;			\
+								\
+    if (SCM_UNLIKELY (!SCM_I_INUMP (value)))			\
+      scm_wrong_type_arg (FUNC_NAME, 3, value);			\
+								\
+    c_value = SCM_I_INUM (value);				\
+    if (SCM_UNLIKELY (!INT_VALID_P (_len, _sign) (c_value)))	\
+      scm_out_of_range (FUNC_NAME, value);			\
+								\
+    c_value_short = (INT_TYPE (_len, _sign)) c_value;		\
+								\
+    memcpy (&c_bv[c_index], &c_value_short, (_len) / 8);	\
+  }								\
+								\
+  return SCM_UNSPECIFIED;
+
+
+
+/* Bytevector type.  */
+
+#define SCM_BYTEVECTOR_HEADER_BYTES		\
+  (SCM_BYTEVECTOR_HEADER_SIZE * sizeof (SCM))
+
+#define SCM_BYTEVECTOR_SET_LENGTH(_bv, _len)            \
+  SCM_SET_CELL_WORD_1 ((_bv), (scm_t_bits) (_len))
+
+#define SCM_BYTEVECTOR_SET_ELEMENT_TYPE(bv, hint)	\
+  SCM_SET_BYTEVECTOR_FLAGS ((bv), (hint))
+#define SCM_BYTEVECTOR_TYPE_SIZE(var)                           \
+  (scm_i_array_element_type_sizes[SCM_BYTEVECTOR_ELEMENT_TYPE (var)]/8)
+#define SCM_BYTEVECTOR_TYPED_LENGTH(var)                        \
+  SCM_BYTEVECTOR_LENGTH (var) / SCM_BYTEVECTOR_TYPE_SIZE (var)
+
+/* The empty bytevector.  */
+SCM scm_null_bytevector = SCM_UNSPECIFIED;
+
+
+static inline SCM
+make_bytevector (size_t len, scm_t_array_element_type element_type)
+{
+  SCM ret;
+  size_t c_len;
+
+  if (SCM_UNLIKELY (element_type > SCM_ARRAY_ELEMENT_TYPE_LAST
+                    || scm_i_array_element_type_sizes[element_type] < 8
+                    || len >= (SCM_I_SIZE_MAX
+                               / (scm_i_array_element_type_sizes[element_type]/8))))
+    /* This would be an internal Guile programming error */
+    abort ();
+
+  if (SCM_UNLIKELY (len == 0 && element_type == SCM_ARRAY_ELEMENT_TYPE_VU8
+		    && SCM_BYTEVECTOR_P (scm_null_bytevector)))
+    ret = scm_null_bytevector;
+  else
+    {
+      c_len = len * (scm_i_array_element_type_sizes[element_type] / 8);
+
+      ret = PTR2SCM (scm_gc_malloc_pointerless (SCM_BYTEVECTOR_HEADER_BYTES + c_len,
+						SCM_GC_BYTEVECTOR));
+
+      SCM_SET_CELL_TYPE (ret, scm_tc7_bytevector);
+      SCM_BYTEVECTOR_SET_LENGTH (ret, c_len);
+      SCM_BYTEVECTOR_SET_ELEMENT_TYPE (ret, element_type);
+    }
+
+  return ret;
+}
+
+/* Return a bytevector of LEN elements of type ELEMENT_TYPE, with element
+   values taken from CONTENTS.  */
+static inline SCM
+make_bytevector_from_buffer (size_t len, void *contents,
+			     scm_t_array_element_type element_type)
+{
+  SCM ret;
+
+  /* We actually never reuse storage from CONTENTS.  Hans Boehm says in
+     <gc/gc.h> that realloc(3) "shouldn't have been invented" and he may well
+     be right.  */
+  ret = make_bytevector (len, element_type);
+
+  if (len > 0)
+    {
+      size_t c_len;
+
+      c_len = len * (scm_i_array_element_type_sizes[element_type] / 8);
+      memcpy (SCM_BYTEVECTOR_CONTENTS (ret),
+	      contents,
+	      c_len);
+
+      scm_gc_free (contents, c_len, SCM_GC_BYTEVECTOR);
+    }
+
+  return ret;
+}
+
+
+/* Return a new bytevector of size LEN octets.  */
+SCM
+scm_c_make_bytevector (size_t len)
+{
+  return make_bytevector (len, SCM_ARRAY_ELEMENT_TYPE_VU8);
+}
+
+/* Return a new bytevector of size LEN elements.  */
+SCM
+scm_i_make_typed_bytevector (size_t len, scm_t_array_element_type element_type)
+{
+  return make_bytevector (len, element_type);
+}
+
+/* Return a bytevector of size LEN made up of CONTENTS.  The area pointed to
+   by CONTENTS must have been allocated using `scm_gc_malloc ()'.  */
+SCM
+scm_c_take_bytevector (signed char *contents, size_t len)
+{
+  return make_bytevector_from_buffer (len, contents, SCM_ARRAY_ELEMENT_TYPE_VU8);
+}
+
+SCM
+scm_c_take_typed_bytevector (signed char *contents, size_t len,
+                             scm_t_array_element_type element_type)
+{
+  return make_bytevector_from_buffer (len, contents, element_type);
+}
+
+/* Shrink BV to C_NEW_LEN (which is assumed to be smaller than its current
+   size) and return the new bytevector (possibly different from BV).  */
+SCM
+scm_c_shrink_bytevector (SCM bv, size_t c_new_len)
+{
+  SCM new_bv;
+  size_t c_len;
+
+  if (SCM_UNLIKELY (c_new_len % SCM_BYTEVECTOR_TYPE_SIZE (bv)))
+    /* This would be an internal Guile programming error */
+    abort ();
+
+  c_len = SCM_BYTEVECTOR_LENGTH (bv);
+  if (SCM_UNLIKELY (c_new_len > c_len))
+    abort ();
+
+  SCM_BYTEVECTOR_SET_LENGTH (bv, c_new_len);
+
+  /* Resize the existing buffer.  */
+  new_bv = PTR2SCM (scm_gc_realloc (SCM2PTR (bv),
+				    c_len + SCM_BYTEVECTOR_HEADER_BYTES,
+				    c_new_len + SCM_BYTEVECTOR_HEADER_BYTES,
+				    SCM_GC_BYTEVECTOR));
+
+  return new_bv;
+}
+
+int
+scm_is_bytevector (SCM obj)
+{
+  return SCM_BYTEVECTOR_P (obj);
+}
+
+size_t
+scm_c_bytevector_length (SCM bv)
+#define FUNC_NAME "scm_c_bytevector_length"
+{
+  SCM_VALIDATE_BYTEVECTOR (1, bv);
+
+  return SCM_BYTEVECTOR_LENGTH (bv);
+}
+#undef FUNC_NAME
+
+scm_t_uint8
+scm_c_bytevector_ref (SCM bv, size_t index)
+#define FUNC_NAME "scm_c_bytevector_ref"
+{
+  size_t c_len;
+  const scm_t_uint8 *c_bv;
+
+  SCM_VALIDATE_BYTEVECTOR (1, bv);
+
+  c_len = SCM_BYTEVECTOR_LENGTH (bv);
+  c_bv = (scm_t_uint8 *) SCM_BYTEVECTOR_CONTENTS (bv);
+
+  if (SCM_UNLIKELY (index >= c_len))
+    scm_out_of_range (FUNC_NAME, scm_from_size_t (index));
+
+  return c_bv[index];
+}
+#undef FUNC_NAME
+
+void
+scm_c_bytevector_set_x (SCM bv, size_t index, scm_t_uint8 value)
+#define FUNC_NAME "scm_c_bytevector_set_x"
+{
+  size_t c_len;
+  scm_t_uint8 *c_bv;
+
+  SCM_VALIDATE_BYTEVECTOR (1, bv);
+
+  c_len = SCM_BYTEVECTOR_LENGTH (bv);
+  c_bv = (scm_t_uint8 *) SCM_BYTEVECTOR_CONTENTS (bv);
+
+  if (SCM_UNLIKELY (index >= c_len))
+    scm_out_of_range (FUNC_NAME, scm_from_size_t (index));
+
+  c_bv[index] = value;
+}
+#undef FUNC_NAME
+
+
+
+int
+scm_i_print_bytevector (SCM bv, SCM port, scm_print_state *pstate SCM_UNUSED)
+{
+  ssize_t ubnd, inc, i;
+  scm_t_array_handle h;
+  
+  scm_array_get_handle (bv, &h);
+
+  scm_putc ('#', port);
+  scm_write (scm_array_handle_element_type (&h), port);
+  scm_putc ('(', port);
+  for (i = h.dims[0].lbnd, ubnd = h.dims[0].ubnd, inc = h.dims[0].inc;
+       i <= ubnd; i += inc)
+    {
+      if (i > 0)
+	scm_putc (' ', port);
+      scm_write (scm_array_handle_ref (&h, i), port);
+    }
+  scm_putc (')', port);
+
+  return 1;
+}
+
+
+/* General operations.  */
+
+SCM_SYMBOL (scm_sym_big, "big");
+SCM_SYMBOL (scm_sym_little, "little");
+
+SCM scm_endianness_big, scm_endianness_little;
+
+/* Host endianness (a symbol).  */
+SCM scm_i_native_endianness = SCM_UNSPECIFIED;
+
+/* Byte-swapping.  */
+#ifndef bswap_24
+# define bswap_24(_x)				\
+  ((((_x) & 0xff0000) >> 16) |			\
+   (((_x) & 0x00ff00))       |			\
+   (((_x) & 0x0000ff) << 16))
+#endif
+
+
+SCM_DEFINE (scm_native_endianness, "native-endianness", 0, 0, 0,
+	    (void),
+	    "Return a symbol denoting the machine's native endianness.")
+#define FUNC_NAME s_scm_native_endianness
+{
+  return scm_i_native_endianness;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_p, "bytevector?", 1, 0, 0,
+	    (SCM obj),
+	    "Return true if @var{obj} is a bytevector.")
+#define FUNC_NAME s_scm_bytevector_p
+{
+  return scm_from_bool (scm_is_bytevector (obj));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_make_bytevector, "make-bytevector", 1, 1, 0,
+	    (SCM len, SCM fill),
+	    "Return a newly allocated bytevector of @var{len} bytes, "
+	    "optionally filled with @var{fill}.")
+#define FUNC_NAME s_scm_make_bytevector
+{
+  SCM bv;
+  unsigned c_len;
+  signed char c_fill = '\0';
+
+  SCM_VALIDATE_UINT_COPY (1, len, c_len);
+  if (fill != SCM_UNDEFINED)
+    {
+      int value;
+
+      value = scm_to_int (fill);
+      if (SCM_UNLIKELY ((value < -128) || (value > 255)))
+	scm_out_of_range (FUNC_NAME, fill);
+      c_fill = (signed char) value;
+    }
+
+  bv = make_bytevector (c_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
+  if (fill != SCM_UNDEFINED)
+    {
+      unsigned i;
+      signed char *contents;
+
+      contents = SCM_BYTEVECTOR_CONTENTS (bv);
+      for (i = 0; i < c_len; i++)
+	contents[i] = c_fill;
+    }
+
+  return bv;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_length, "bytevector-length", 1, 0, 0,
+	    (SCM bv),
+	    "Return the length (in bytes) of @var{bv}.")
+#define FUNC_NAME s_scm_bytevector_length
+{
+  return scm_from_uint (scm_c_bytevector_length (bv));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_eq_p, "bytevector=?", 2, 0, 0,
+	    (SCM bv1, SCM bv2),
+	    "Return is @var{bv1} equals to @var{bv2}---i.e., if they "
+	    "have the same length and contents.")
+#define FUNC_NAME s_scm_bytevector_eq_p
+{
+  SCM result = SCM_BOOL_F;
+  unsigned c_len1, c_len2;
+
+  SCM_VALIDATE_BYTEVECTOR (1, bv1);
+  SCM_VALIDATE_BYTEVECTOR (2, bv2);
+
+  c_len1 = SCM_BYTEVECTOR_LENGTH (bv1);
+  c_len2 = SCM_BYTEVECTOR_LENGTH (bv2);
+
+  if (c_len1 == c_len2)
+    {
+      signed char *c_bv1, *c_bv2;
+
+      c_bv1 = SCM_BYTEVECTOR_CONTENTS (bv1);
+      c_bv2 = SCM_BYTEVECTOR_CONTENTS (bv2);
+
+      result = scm_from_bool (!memcmp (c_bv1, c_bv2, c_len1));
+    }
+
+  return result;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_fill_x, "bytevector-fill!", 2, 0, 0,
+	    (SCM bv, SCM fill),
+	    "Fill bytevector @var{bv} with @var{fill}, a byte.")
+#define FUNC_NAME s_scm_bytevector_fill_x
+{
+  unsigned c_len, i;
+  signed char *c_bv, c_fill;
+
+  SCM_VALIDATE_BYTEVECTOR (1, bv);
+  c_fill = scm_to_int8 (fill);
+
+  c_len = SCM_BYTEVECTOR_LENGTH (bv);
+  c_bv = SCM_BYTEVECTOR_CONTENTS (bv);
+
+  for (i = 0; i < c_len; i++)
+    c_bv[i] = c_fill;
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_copy_x, "bytevector-copy!", 5, 0, 0,
+	    (SCM source, SCM source_start, SCM target, SCM target_start,
+	     SCM len),
+	    "Copy @var{len} bytes from @var{source} into @var{target}, "
+	    "starting reading from @var{source_start} (a positive index "
+	    "within @var{source}) and start writing at "
+	    "@var{target_start}.")
+#define FUNC_NAME s_scm_bytevector_copy_x
+{
+  unsigned c_len, c_source_len, c_target_len;
+  unsigned c_source_start, c_target_start;
+  signed char *c_source, *c_target;
+
+  SCM_VALIDATE_BYTEVECTOR (1, source);
+  SCM_VALIDATE_BYTEVECTOR (3, target);
+
+  c_len = scm_to_uint (len);
+  c_source_start = scm_to_uint (source_start);
+  c_target_start = scm_to_uint (target_start);
+
+  c_source = SCM_BYTEVECTOR_CONTENTS (source);
+  c_target = SCM_BYTEVECTOR_CONTENTS (target);
+  c_source_len = SCM_BYTEVECTOR_LENGTH (source);
+  c_target_len = SCM_BYTEVECTOR_LENGTH (target);
+
+  if (SCM_UNLIKELY (c_source_start + c_len > c_source_len))
+    scm_out_of_range (FUNC_NAME, source_start);
+  if (SCM_UNLIKELY (c_target_start + c_len > c_target_len))
+    scm_out_of_range (FUNC_NAME, target_start);
+
+  memcpy (c_target + c_target_start,
+	  c_source + c_source_start,
+	  c_len);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_copy, "bytevector-copy", 1, 0, 0,
+	    (SCM bv),
+	    "Return a newly allocated copy of @var{bv}.")
+#define FUNC_NAME s_scm_bytevector_copy
+{
+  SCM copy;
+  unsigned c_len;
+  signed char *c_bv, *c_copy;
+
+  SCM_VALIDATE_BYTEVECTOR (1, bv);
+
+  c_len = SCM_BYTEVECTOR_LENGTH (bv);
+  c_bv = SCM_BYTEVECTOR_CONTENTS (bv);
+
+  copy = make_bytevector (c_len, SCM_BYTEVECTOR_ELEMENT_TYPE (bv));
+  c_copy = SCM_BYTEVECTOR_CONTENTS (copy);
+  memcpy (c_copy, c_bv, c_len);
+
+  return copy;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_uniform_array_to_bytevector, "uniform-array->bytevector",
+            1, 0, 0, (SCM array),
+	    "Return a newly allocated bytevector whose contents\n"
+            "will be copied from the uniform array @var{array}.")
+#define FUNC_NAME s_scm_uniform_array_to_bytevector
+{
+  SCM contents, ret;
+  size_t len;
+  scm_t_array_handle h;
+  const void *base;
+  size_t sz;
+  
+  contents = scm_array_contents (array, SCM_BOOL_T);
+  if (scm_is_false (contents))
+    scm_wrong_type_arg_msg (FUNC_NAME, 0, array, "uniform contiguous array");
+
+  scm_array_get_handle (contents, &h);
+
+  base = scm_array_handle_uniform_elements (&h);
+  len = h.dims->inc * (h.dims->ubnd - h.dims->lbnd + 1);
+  sz = scm_array_handle_uniform_element_size (&h);
+
+  ret = make_bytevector (len * sz, SCM_ARRAY_ELEMENT_TYPE_VU8);
+  memcpy (SCM_BYTEVECTOR_CONTENTS (ret), base, len * sz);
+
+  scm_array_handle_release (&h);
+
+  return ret;
+}
+#undef FUNC_NAME
+
+
+/* Operations on bytes and octets.  */
+
+SCM_DEFINE (scm_bytevector_u8_ref, "bytevector-u8-ref", 2, 0, 0,
+	    (SCM bv, SCM index),
+	    "Return the octet located at @var{index} in @var{bv}.")
+#define FUNC_NAME s_scm_bytevector_u8_ref
+{
+  INTEGER_NATIVE_REF (8, unsigned);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s8_ref, "bytevector-s8-ref", 2, 0, 0,
+	    (SCM bv, SCM index),
+	    "Return the byte located at @var{index} in @var{bv}.")
+#define FUNC_NAME s_scm_bytevector_s8_ref
+{
+  INTEGER_NATIVE_REF (8, signed);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_u8_set_x, "bytevector-u8-set!", 3, 0, 0,
+	    (SCM bv, SCM index, SCM value),
+	    "Return the octet located at @var{index} in @var{bv}.")
+#define FUNC_NAME s_scm_bytevector_u8_set_x
+{
+  INTEGER_NATIVE_SET (8, unsigned);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s8_set_x, "bytevector-s8-set!", 3, 0, 0,
+	    (SCM bv, SCM index, SCM value),
+	    "Return the octet located at @var{index} in @var{bv}.")
+#define FUNC_NAME s_scm_bytevector_s8_set_x
+{
+  INTEGER_NATIVE_SET (8, signed);
+}
+#undef FUNC_NAME
+
+#undef OCTET_ACCESSOR_PROLOGUE
+
+
+SCM_DEFINE (scm_bytevector_to_u8_list, "bytevector->u8-list", 1, 0, 0,
+	    (SCM bv),
+	    "Return a newly allocated list of octets containing the "
+	    "contents of @var{bv}.")
+#define FUNC_NAME s_scm_bytevector_to_u8_list
+{
+  SCM lst, pair;
+  unsigned c_len, i;
+  unsigned char *c_bv;
+
+  SCM_VALIDATE_BYTEVECTOR (1, bv);
+
+  c_len = SCM_BYTEVECTOR_LENGTH (bv);
+  c_bv = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
+
+  lst = scm_make_list (scm_from_uint (c_len), SCM_UNSPECIFIED);
+  for (i = 0, pair = lst;
+       i < c_len;
+       i++, pair = SCM_CDR (pair))
+    {
+      SCM_SETCAR (pair, SCM_I_MAKINUM (c_bv[i]));
+    }
+
+  return lst;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_u8_list_to_bytevector, "u8-list->bytevector", 1, 0, 0,
+	    (SCM lst),
+	    "Turn @var{lst}, a list of octets, into a bytevector.")
+#define FUNC_NAME s_scm_u8_list_to_bytevector
+{
+  SCM bv, item;
+  long c_len, i;
+  unsigned char *c_bv;
+
+  SCM_VALIDATE_LIST_COPYLEN (1, lst, c_len);
+
+  bv = make_bytevector (c_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
+  c_bv = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
+
+  for (i = 0; i < c_len; lst = SCM_CDR (lst), i++)
+    {
+      item = SCM_CAR (lst);
+
+      if (SCM_LIKELY (SCM_I_INUMP (item)))
+	{
+	  long c_item;
+
+	  c_item = SCM_I_INUM (item);
+	  if (SCM_LIKELY ((c_item >= 0) && (c_item < 256)))
+	    c_bv[i] = (unsigned char) c_item;
+	  else
+	    goto type_error;
+	}
+      else
+	goto type_error;
+    }
+
+  return bv;
+
+ type_error:
+  scm_wrong_type_arg (FUNC_NAME, 1, item);
+
+  return SCM_BOOL_F;
+}
+#undef FUNC_NAME
+
+/* Compute the two's complement of VALUE (a positive integer) on SIZE octets
+   using (2^(SIZE * 8) - VALUE).  */
+static inline void
+twos_complement (mpz_t value, size_t size)
+{
+  unsigned long bit_count;
+
+  /* We expect BIT_COUNT to fit in a unsigned long thanks to the range
+     checking on SIZE performed earlier.  */
+  bit_count = (unsigned long) size << 3UL;
+
+  if (SCM_LIKELY (bit_count < sizeof (unsigned long)))
+    mpz_ui_sub (value, 1UL << bit_count, value);
+  else
+    {
+      mpz_t max;
+
+      mpz_init (max);
+      mpz_ui_pow_ui (max, 2, bit_count);
+      mpz_sub (value, max, value);
+      mpz_clear (max);
+    }
+}
+
+static inline SCM
+bytevector_large_ref (const char *c_bv, size_t c_size, int signed_p,
+		      SCM endianness)
+{
+  SCM result;
+  mpz_t c_mpz;
+  int c_endianness, negative_p = 0;
+
+  if (signed_p)
+    {
+      if (scm_is_eq (endianness, scm_sym_big))
+	negative_p = c_bv[0] & 0x80;
+      else
+	negative_p = c_bv[c_size - 1] & 0x80;
+    }
+
+  c_endianness = scm_is_eq (endianness, scm_sym_big) ? 1 : -1;
+
+  mpz_init (c_mpz);
+  mpz_import (c_mpz, 1 /* 1 word */, 1 /* word order doesn't matter */,
+	      c_size /* word is C_SIZE-byte long */,
+	      c_endianness,
+	      0 /* nails */, c_bv);
+
+  if (signed_p && negative_p)
+    {
+      twos_complement (c_mpz, c_size);
+      mpz_neg (c_mpz, c_mpz);
+    }
+
+  result = scm_from_mpz (c_mpz);
+  mpz_clear (c_mpz);  /* FIXME: Needed? */
+
+  return result;
+}
+
+static inline int
+bytevector_large_set (char *c_bv, size_t c_size, int signed_p,
+		      SCM value, SCM endianness)
+{
+  mpz_t c_mpz;
+  int c_endianness, c_sign, err = 0;
+
+  c_endianness = scm_is_eq (endianness, scm_sym_big) ? 1 : -1;
+
+  mpz_init (c_mpz);
+  scm_to_mpz (value, c_mpz);
+
+  c_sign = mpz_sgn (c_mpz);
+  if (c_sign < 0)
+    {
+      if (SCM_LIKELY (signed_p))
+	{
+	  mpz_neg (c_mpz, c_mpz);
+	  twos_complement (c_mpz, c_size);
+	}
+      else
+	{
+	  err = -1;
+	  goto finish;
+	}
+    }
+
+  if (c_sign == 0)
+    /* Zero.  */
+    memset (c_bv, 0, c_size);
+  else
+    {
+      size_t word_count, value_size;
+
+      value_size = (mpz_sizeinbase (c_mpz, 2) + (8 * c_size)) / (8 * c_size);
+      if (SCM_UNLIKELY (value_size > c_size))
+	{
+	  err = -2;
+	  goto finish;
+	}
+
+
+      mpz_export (c_bv, &word_count, 1 /* word order doesn't matter */,
+		  c_size, c_endianness,
+		  0 /* nails */, c_mpz);
+      if (SCM_UNLIKELY (word_count != 1))
+	/* Shouldn't happen since we already checked with VALUE_SIZE.  */
+	abort ();
+    }
+
+ finish:
+  mpz_clear (c_mpz);
+
+  return err;
+}
+
+#define GENERIC_INTEGER_ACCESSOR_PROLOGUE(_sign)			\
+  unsigned long c_len, c_index, c_size;					\
+  char *c_bv;								\
+									\
+  SCM_VALIDATE_BYTEVECTOR (1, bv);					\
+  c_index = scm_to_ulong (index);					\
+  c_size = scm_to_ulong (size);						\
+									\
+  c_len = SCM_BYTEVECTOR_LENGTH (bv);					\
+  c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);				\
+									\
+  /* C_SIZE must have its 3 higher bits set to zero so that		\
+     multiplying it by 8 yields a number that fits in an		\
+     unsigned long.  */							\
+  if (SCM_UNLIKELY ((c_size == 0) || (c_size >= (ULONG_MAX >> 3L))))	\
+    scm_out_of_range (FUNC_NAME, size);					\
+  if (SCM_UNLIKELY (c_index + c_size > c_len))				\
+    scm_out_of_range (FUNC_NAME, index);
+
+
+/* Template of an integer reference function.  */
+#define GENERIC_INTEGER_REF(_sign)					\
+  SCM result;								\
+									\
+  if (c_size < 3)							\
+    {									\
+      int swap;								\
+      _sign int value;							\
+									\
+      swap = !scm_is_eq (endianness, scm_i_native_endianness);		\
+      switch (c_size)							\
+	{								\
+	case 1:								\
+	  {								\
+	    _sign char c_value8;					\
+	    memcpy (&c_value8, c_bv, 1);				\
+	    value = c_value8;						\
+	  }								\
+	  break;							\
+	case 2:								\
+	  {								\
+	    INT_TYPE (16, _sign)  c_value16;				\
+	    memcpy (&c_value16, c_bv, 2);				\
+	    if (swap)							\
+	      value = (INT_TYPE (16, _sign)) bswap_16 (c_value16);	\
+	    else							\
+	      value = c_value16;					\
+	  }								\
+	  break;							\
+	default:							\
+	  abort ();							\
+	}								\
+									\
+      result = SCM_I_MAKINUM ((_sign int) value);			\
+    }									\
+  else									\
+    result = bytevector_large_ref ((char *) c_bv,			\
+				   c_size, SIGNEDNESS (_sign),		\
+				   endianness);				\
+									\
+  return result;
+
+static inline SCM
+bytevector_signed_ref (const char *c_bv, size_t c_size, SCM endianness)
+{
+  GENERIC_INTEGER_REF (signed);
+}
+
+static inline SCM
+bytevector_unsigned_ref (const char *c_bv, size_t c_size, SCM endianness)
+{
+  GENERIC_INTEGER_REF (unsigned);
+}
+
+
+/* Template of an integer assignment function.  */
+#define GENERIC_INTEGER_SET(_sign)					\
+  if (c_size < 3)							\
+    {									\
+      _sign int c_value;						\
+									\
+      if (SCM_UNLIKELY (!SCM_I_INUMP (value)))				\
+	goto range_error;						\
+									\
+      c_value = SCM_I_INUM (value);					\
+      switch (c_size)							\
+	{								\
+	case 1:								\
+	  if (SCM_LIKELY (INT_VALID_P (8, _sign) (c_value)))		\
+	    {								\
+	      _sign char c_value8;					\
+	      c_value8 = (_sign char) c_value;				\
+	      memcpy (c_bv, &c_value8, 1);				\
+	    }								\
+	  else								\
+	    goto range_error;						\
+	  break;							\
+									\
+	case 2:								\
+	  if (SCM_LIKELY (INT_VALID_P (16, _sign) (c_value)))		\
+	    {								\
+	      int swap;							\
+	      INT_TYPE (16, _sign)  c_value16;				\
+									\
+	      swap = !scm_is_eq (endianness, scm_i_native_endianness);	\
+									\
+	      if (swap)							\
+		c_value16 = (INT_TYPE (16, _sign)) bswap_16 (c_value);	\
+	      else							\
+		c_value16 = c_value;					\
+									\
+	      memcpy (c_bv, &c_value16, 2);				\
+	    }								\
+	  else								\
+	    goto range_error;						\
+	  break;							\
+									\
+	default:							\
+	  abort ();							\
+	}								\
+    }									\
+  else									\
+    {									\
+      int err;								\
+									\
+      err = bytevector_large_set (c_bv, c_size,				\
+				  SIGNEDNESS (_sign),			\
+				  value, endianness);			\
+      if (err)								\
+	goto range_error;						\
+    }									\
+									\
+  return;								\
+									\
+ range_error:								\
+  scm_out_of_range (FUNC_NAME, value);					\
+  return;
+
+static inline void
+bytevector_signed_set (char *c_bv, size_t c_size,
+		       SCM value, SCM endianness,
+		       const char *func_name)
+#define FUNC_NAME func_name
+{
+  GENERIC_INTEGER_SET (signed);
+}
+#undef FUNC_NAME
+
+static inline void
+bytevector_unsigned_set (char *c_bv, size_t c_size,
+			 SCM value, SCM endianness,
+			 const char *func_name)
+#define FUNC_NAME func_name
+{
+  GENERIC_INTEGER_SET (unsigned);
+}
+#undef FUNC_NAME
+
+#undef GENERIC_INTEGER_SET
+#undef GENERIC_INTEGER_REF
+
+
+SCM_DEFINE (scm_bytevector_uint_ref, "bytevector-uint-ref", 4, 0, 0,
+	    (SCM bv, SCM index, SCM endianness, SCM size),
+	    "Return the @var{size}-octet long unsigned integer at index "
+	    "@var{index} in @var{bv}.")
+#define FUNC_NAME s_scm_bytevector_uint_ref
+{
+  GENERIC_INTEGER_ACCESSOR_PROLOGUE (unsigned);
+
+  return (bytevector_unsigned_ref (&c_bv[c_index], c_size, endianness));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_sint_ref, "bytevector-sint-ref", 4, 0, 0,
+	    (SCM bv, SCM index, SCM endianness, SCM size),
+	    "Return the @var{size}-octet long unsigned integer at index "
+	    "@var{index} in @var{bv}.")
+#define FUNC_NAME s_scm_bytevector_sint_ref
+{
+  GENERIC_INTEGER_ACCESSOR_PROLOGUE (signed);
+
+  return (bytevector_signed_ref (&c_bv[c_index], c_size, endianness));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_uint_set_x, "bytevector-uint-set!", 5, 0, 0,
+	    (SCM bv, SCM index, SCM value, SCM endianness, SCM size),
+	    "Set the @var{size}-octet long unsigned integer at @var{index} "
+	    "to @var{value}.")
+#define FUNC_NAME s_scm_bytevector_uint_set_x
+{
+  GENERIC_INTEGER_ACCESSOR_PROLOGUE (unsigned);
+
+  bytevector_unsigned_set (&c_bv[c_index], c_size, value, endianness,
+			   FUNC_NAME);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_sint_set_x, "bytevector-sint-set!", 5, 0, 0,
+	    (SCM bv, SCM index, SCM value, SCM endianness, SCM size),
+	    "Set the @var{size}-octet long signed integer at @var{index} "
+	    "to @var{value}.")
+#define FUNC_NAME s_scm_bytevector_sint_set_x
+{
+  GENERIC_INTEGER_ACCESSOR_PROLOGUE (signed);
+
+  bytevector_signed_set (&c_bv[c_index], c_size, value, endianness,
+			 FUNC_NAME);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
+
+/* Operations on integers of arbitrary size.  */
+
+#define INTEGERS_TO_LIST(_sign)						\
+  SCM lst, pair;							\
+  size_t i, c_len, c_size;						\
+									\
+  SCM_VALIDATE_BYTEVECTOR (1, bv);					\
+  SCM_VALIDATE_SYMBOL (2, endianness);					\
+  c_size = scm_to_uint (size);						\
+									\
+  c_len = SCM_BYTEVECTOR_LENGTH (bv);					\
+  if (SCM_UNLIKELY (c_len == 0))					\
+    lst = SCM_EOL;							\
+  else if (SCM_UNLIKELY (c_len < c_size))				\
+    scm_out_of_range (FUNC_NAME, size);					\
+  else									\
+    {									\
+      const char *c_bv;							\
+									\
+      c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);			\
+									\
+      lst = scm_make_list (scm_from_uint (c_len / c_size),		\
+			   SCM_UNSPECIFIED);				\
+      for (i = 0, pair = lst;						\
+	   i <= c_len - c_size;						\
+	   i += c_size, c_bv += c_size, pair = SCM_CDR (pair))		\
+	{								\
+	  SCM_SETCAR (pair,						\
+		      bytevector_ ## _sign ## _ref (c_bv, c_size,	\
+						    endianness));	\
+	}								\
+    }									\
+									\
+  return lst;
+
+SCM_DEFINE (scm_bytevector_to_sint_list, "bytevector->sint-list",
+	    3, 0, 0,
+	    (SCM bv, SCM endianness, SCM size),
+	    "Return a list of signed integers of @var{size} octets "
+	    "representing the contents of @var{bv}.")
+#define FUNC_NAME s_scm_bytevector_to_sint_list
+{
+  INTEGERS_TO_LIST (signed);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_to_uint_list, "bytevector->uint-list",
+	    3, 0, 0,
+	    (SCM bv, SCM endianness, SCM size),
+	    "Return a list of unsigned integers of @var{size} octets "
+	    "representing the contents of @var{bv}.")
+#define FUNC_NAME s_scm_bytevector_to_uint_list
+{
+  INTEGERS_TO_LIST (unsigned);
+}
+#undef FUNC_NAME
+
+#undef INTEGER_TO_LIST
+
+
+#define INTEGER_LIST_TO_BYTEVECTOR(_sign)				\
+  SCM bv;								\
+  long c_len;								\
+  size_t c_size;							\
+  char *c_bv, *c_bv_ptr;						\
+									\
+  SCM_VALIDATE_LIST_COPYLEN (1, lst, c_len);				\
+  SCM_VALIDATE_SYMBOL (2, endianness);					\
+  c_size = scm_to_uint (size);						\
+									\
+  if (SCM_UNLIKELY ((c_size == 0) || (c_size >= (ULONG_MAX >> 3L))))	\
+    scm_out_of_range (FUNC_NAME, size);					\
+									\
+  bv = make_bytevector (c_len * c_size, SCM_ARRAY_ELEMENT_TYPE_VU8);     \
+  c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);				\
+									\
+  for (c_bv_ptr = c_bv;							\
+       !scm_is_null (lst);						\
+       lst = SCM_CDR (lst), c_bv_ptr += c_size)				\
+    {									\
+      bytevector_ ## _sign ## _set (c_bv_ptr, c_size,			\
+				    SCM_CAR (lst), endianness,		\
+				    FUNC_NAME);				\
+    }									\
+									\
+  return bv;
+
+
+SCM_DEFINE (scm_uint_list_to_bytevector, "uint-list->bytevector",
+	    3, 0, 0,
+	    (SCM lst, SCM endianness, SCM size),
+	    "Return a bytevector containing the unsigned integers "
+	    "listed in @var{lst} and encoded on @var{size} octets "
+	    "according to @var{endianness}.")
+#define FUNC_NAME s_scm_uint_list_to_bytevector
+{
+  INTEGER_LIST_TO_BYTEVECTOR (unsigned);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_sint_list_to_bytevector, "sint-list->bytevector",
+	    3, 0, 0,
+	    (SCM lst, SCM endianness, SCM size),
+	    "Return a bytevector containing the signed integers "
+	    "listed in @var{lst} and encoded on @var{size} octets "
+	    "according to @var{endianness}.")
+#define FUNC_NAME s_scm_sint_list_to_bytevector
+{
+  INTEGER_LIST_TO_BYTEVECTOR (signed);
+}
+#undef FUNC_NAME
+
+#undef INTEGER_LIST_TO_BYTEVECTOR
+
+
+
+/* Operations on 16-bit integers.  */
+
+SCM_DEFINE (scm_bytevector_u16_ref, "bytevector-u16-ref",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM endianness),
+	    "Return the unsigned 16-bit integer from @var{bv} at "
+	    "@var{index}.")
+#define FUNC_NAME s_scm_bytevector_u16_ref
+{
+  INTEGER_REF (16, unsigned);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s16_ref, "bytevector-s16-ref",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM endianness),
+	    "Return the signed 16-bit integer from @var{bv} at "
+	    "@var{index}.")
+#define FUNC_NAME s_scm_bytevector_s16_ref
+{
+  INTEGER_REF (16, signed);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_u16_native_ref, "bytevector-u16-native-ref",
+	    2, 0, 0,
+	    (SCM bv, SCM index),
+	    "Return the unsigned 16-bit integer from @var{bv} at "
+	    "@var{index} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_u16_native_ref
+{
+  INTEGER_NATIVE_REF (16, unsigned);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s16_native_ref, "bytevector-s16-native-ref",
+	    2, 0, 0,
+	    (SCM bv, SCM index),
+	    "Return the unsigned 16-bit integer from @var{bv} at "
+	    "@var{index} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_s16_native_ref
+{
+  INTEGER_NATIVE_REF (16, signed);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_u16_set_x, "bytevector-u16-set!",
+	    4, 0, 0,
+	    (SCM bv, SCM index, SCM value, SCM endianness),
+	    "Store @var{value} in @var{bv} at @var{index} according to "
+	    "@var{endianness}.")
+#define FUNC_NAME s_scm_bytevector_u16_set_x
+{
+  INTEGER_SET (16, unsigned);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s16_set_x, "bytevector-s16-set!",
+	    4, 0, 0,
+	    (SCM bv, SCM index, SCM value, SCM endianness),
+	    "Store @var{value} in @var{bv} at @var{index} according to "
+	    "@var{endianness}.")
+#define FUNC_NAME s_scm_bytevector_s16_set_x
+{
+  INTEGER_SET (16, signed);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_u16_native_set_x, "bytevector-u16-native-set!",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM value),
+	    "Store the unsigned integer @var{value} at index @var{index} "
+	    "of @var{bv} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_u16_native_set_x
+{
+  INTEGER_NATIVE_SET (16, unsigned);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s16_native_set_x, "bytevector-s16-native-set!",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM value),
+	    "Store the signed integer @var{value} at index @var{index} "
+	    "of @var{bv} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_s16_native_set_x
+{
+  INTEGER_NATIVE_SET (16, signed);
+}
+#undef FUNC_NAME
+
+
+
+/* Operations on 32-bit integers.  */
+
+/* Unfortunately, on 32-bit machines `SCM' is not large enough to hold
+   arbitrary 32-bit integers.  Thus we fall back to using the
+   `large_{ref,set}' variants on 32-bit machines.  */
+
+#define LARGE_INTEGER_REF(_len, _sign)					\
+  INTEGER_ACCESSOR_PROLOGUE(_len, _sign);				\
+  SCM_VALIDATE_SYMBOL (3, endianness);					\
+									\
+  return (bytevector_large_ref ((char *) c_bv + c_index, _len / 8,	\
+				SIGNEDNESS (_sign), endianness));
+
+#define LARGE_INTEGER_SET(_len, _sign)					\
+  int err;								\
+  INTEGER_ACCESSOR_PROLOGUE (_len, _sign);				\
+  SCM_VALIDATE_SYMBOL (4, endianness);					\
+									\
+  err = bytevector_large_set ((char *) c_bv + c_index, _len / 8,	\
+			      SIGNEDNESS (_sign), value, endianness);	\
+  if (SCM_UNLIKELY (err))						\
+     scm_out_of_range (FUNC_NAME, value);				\
+									\
+  return SCM_UNSPECIFIED;
+
+#define LARGE_INTEGER_NATIVE_REF(_len, _sign)				 \
+  INTEGER_ACCESSOR_PROLOGUE(_len, _sign);				 \
+  return (bytevector_large_ref ((char *) c_bv + c_index, _len / 8,	 \
+				SIGNEDNESS (_sign), scm_i_native_endianness));
+
+#define LARGE_INTEGER_NATIVE_SET(_len, _sign)				\
+  int err;								\
+  INTEGER_ACCESSOR_PROLOGUE (_len, _sign);				\
+									\
+  err = bytevector_large_set ((char *) c_bv + c_index, _len / 8,	\
+			      SIGNEDNESS (_sign), value,		\
+			      scm_i_native_endianness);			\
+  if (SCM_UNLIKELY (err))						\
+     scm_out_of_range (FUNC_NAME, value);				\
+									\
+  return SCM_UNSPECIFIED;
+
+
+SCM_DEFINE (scm_bytevector_u32_ref, "bytevector-u32-ref",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM endianness),
+	    "Return the unsigned 32-bit integer from @var{bv} at "
+	    "@var{index}.")
+#define FUNC_NAME s_scm_bytevector_u32_ref
+{
+#if SIZEOF_VOID_P > 4
+  INTEGER_REF (32, unsigned);
+#else
+  LARGE_INTEGER_REF (32, unsigned);
+#endif
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s32_ref, "bytevector-s32-ref",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM endianness),
+	    "Return the signed 32-bit integer from @var{bv} at "
+	    "@var{index}.")
+#define FUNC_NAME s_scm_bytevector_s32_ref
+{
+#if SIZEOF_VOID_P > 4
+  INTEGER_REF (32, signed);
+#else
+  LARGE_INTEGER_REF (32, signed);
+#endif
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_u32_native_ref, "bytevector-u32-native-ref",
+	    2, 0, 0,
+	    (SCM bv, SCM index),
+	    "Return the unsigned 32-bit integer from @var{bv} at "
+	    "@var{index} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_u32_native_ref
+{
+#if SIZEOF_VOID_P > 4
+  INTEGER_NATIVE_REF (32, unsigned);
+#else
+  LARGE_INTEGER_NATIVE_REF (32, unsigned);
+#endif
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s32_native_ref, "bytevector-s32-native-ref",
+	    2, 0, 0,
+	    (SCM bv, SCM index),
+	    "Return the unsigned 32-bit integer from @var{bv} at "
+	    "@var{index} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_s32_native_ref
+{
+#if SIZEOF_VOID_P > 4
+  INTEGER_NATIVE_REF (32, signed);
+#else
+  LARGE_INTEGER_NATIVE_REF (32, signed);
+#endif
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_u32_set_x, "bytevector-u32-set!",
+	    4, 0, 0,
+	    (SCM bv, SCM index, SCM value, SCM endianness),
+	    "Store @var{value} in @var{bv} at @var{index} according to "
+	    "@var{endianness}.")
+#define FUNC_NAME s_scm_bytevector_u32_set_x
+{
+#if SIZEOF_VOID_P > 4
+  INTEGER_SET (32, unsigned);
+#else
+  LARGE_INTEGER_SET (32, unsigned);
+#endif
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s32_set_x, "bytevector-s32-set!",
+	    4, 0, 0,
+	    (SCM bv, SCM index, SCM value, SCM endianness),
+	    "Store @var{value} in @var{bv} at @var{index} according to "
+	    "@var{endianness}.")
+#define FUNC_NAME s_scm_bytevector_s32_set_x
+{
+#if SIZEOF_VOID_P > 4
+  INTEGER_SET (32, signed);
+#else
+  LARGE_INTEGER_SET (32, signed);
+#endif
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_u32_native_set_x, "bytevector-u32-native-set!",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM value),
+	    "Store the unsigned integer @var{value} at index @var{index} "
+	    "of @var{bv} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_u32_native_set_x
+{
+#if SIZEOF_VOID_P > 4
+  INTEGER_NATIVE_SET (32, unsigned);
+#else
+  LARGE_INTEGER_NATIVE_SET (32, unsigned);
+#endif
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s32_native_set_x, "bytevector-s32-native-set!",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM value),
+	    "Store the signed integer @var{value} at index @var{index} "
+	    "of @var{bv} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_s32_native_set_x
+{
+#if SIZEOF_VOID_P > 4
+  INTEGER_NATIVE_SET (32, signed);
+#else
+  LARGE_INTEGER_NATIVE_SET (32, signed);
+#endif
+}
+#undef FUNC_NAME
+
+
+
+/* Operations on 64-bit integers.  */
+
+/* For 64-bit integers, we use only the `large_{ref,set}' variant.  */
+
+SCM_DEFINE (scm_bytevector_u64_ref, "bytevector-u64-ref",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM endianness),
+	    "Return the unsigned 64-bit integer from @var{bv} at "
+	    "@var{index}.")
+#define FUNC_NAME s_scm_bytevector_u64_ref
+{
+  LARGE_INTEGER_REF (64, unsigned);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s64_ref, "bytevector-s64-ref",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM endianness),
+	    "Return the signed 64-bit integer from @var{bv} at "
+	    "@var{index}.")
+#define FUNC_NAME s_scm_bytevector_s64_ref
+{
+  LARGE_INTEGER_REF (64, signed);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_u64_native_ref, "bytevector-u64-native-ref",
+	    2, 0, 0,
+	    (SCM bv, SCM index),
+	    "Return the unsigned 64-bit integer from @var{bv} at "
+	    "@var{index} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_u64_native_ref
+{
+  LARGE_INTEGER_NATIVE_REF (64, unsigned);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s64_native_ref, "bytevector-s64-native-ref",
+	    2, 0, 0,
+	    (SCM bv, SCM index),
+	    "Return the unsigned 64-bit integer from @var{bv} at "
+	    "@var{index} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_s64_native_ref
+{
+  LARGE_INTEGER_NATIVE_REF (64, signed);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_u64_set_x, "bytevector-u64-set!",
+	    4, 0, 0,
+	    (SCM bv, SCM index, SCM value, SCM endianness),
+	    "Store @var{value} in @var{bv} at @var{index} according to "
+	    "@var{endianness}.")
+#define FUNC_NAME s_scm_bytevector_u64_set_x
+{
+  LARGE_INTEGER_SET (64, unsigned);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s64_set_x, "bytevector-s64-set!",
+	    4, 0, 0,
+	    (SCM bv, SCM index, SCM value, SCM endianness),
+	    "Store @var{value} in @var{bv} at @var{index} according to "
+	    "@var{endianness}.")
+#define FUNC_NAME s_scm_bytevector_s64_set_x
+{
+  LARGE_INTEGER_SET (64, signed);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_u64_native_set_x, "bytevector-u64-native-set!",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM value),
+	    "Store the unsigned integer @var{value} at index @var{index} "
+	    "of @var{bv} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_u64_native_set_x
+{
+  LARGE_INTEGER_NATIVE_SET (64, unsigned);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s64_native_set_x, "bytevector-s64-native-set!",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM value),
+	    "Store the signed integer @var{value} at index @var{index} "
+	    "of @var{bv} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_s64_native_set_x
+{
+  LARGE_INTEGER_NATIVE_SET (64, signed);
+}
+#undef FUNC_NAME
+
+
+
+/* Operations on IEEE-754 numbers.  */
+
+/* There are two possible word endians, visible in glibc's <ieee754.h>.
+   However, in R6RS, when the endianness is `little', little endian is
+   assumed for both the byte order and the word order.  This is clear from
+   Section 2.1 of R6RS-lib (in response to
+   http://www.r6rs.org/formal-comments/comment-187.txt).  */
+
+
+/* Convert to/from a floating-point number with different endianness.  This
+   method is probably not the most efficient but it should be portable.  */
+
+static inline void
+float_to_foreign_endianness (union scm_ieee754_float *target,
+			     float source)
+{
+  union scm_ieee754_float src;
+
+  src.f = source;
+
+#ifdef WORDS_BIGENDIAN
+  /* Assuming little endian for both byte and word order.  */
+  target->little_endian.negative = src.big_endian.negative;
+  target->little_endian.exponent = src.big_endian.exponent;
+  target->little_endian.mantissa = src.big_endian.mantissa;
+#else
+  target->big_endian.negative = src.little_endian.negative;
+  target->big_endian.exponent = src.little_endian.exponent;
+  target->big_endian.mantissa = src.little_endian.mantissa;
+#endif
+}
+
+static inline float
+float_from_foreign_endianness (const union scm_ieee754_float *source)
+{
+  union scm_ieee754_float result;
+
+#ifdef WORDS_BIGENDIAN
+  /* Assuming little endian for both byte and word order.  */
+  result.big_endian.negative = source->little_endian.negative;
+  result.big_endian.exponent = source->little_endian.exponent;
+  result.big_endian.mantissa = source->little_endian.mantissa;
+#else
+  result.little_endian.negative = source->big_endian.negative;
+  result.little_endian.exponent = source->big_endian.exponent;
+  result.little_endian.mantissa = source->big_endian.mantissa;
+#endif
+
+  return (result.f);
+}
+
+static inline void
+double_to_foreign_endianness (union scm_ieee754_double *target,
+			      double source)
+{
+  union scm_ieee754_double src;
+
+  src.d = source;
+
+#ifdef WORDS_BIGENDIAN
+  /* Assuming little endian for both byte and word order.  */
+  target->little_little_endian.negative  = src.big_endian.negative;
+  target->little_little_endian.exponent  = src.big_endian.exponent;
+  target->little_little_endian.mantissa0 = src.big_endian.mantissa0;
+  target->little_little_endian.mantissa1 = src.big_endian.mantissa1;
+#else
+  target->big_endian.negative  = src.little_little_endian.negative;
+  target->big_endian.exponent  = src.little_little_endian.exponent;
+  target->big_endian.mantissa0 = src.little_little_endian.mantissa0;
+  target->big_endian.mantissa1 = src.little_little_endian.mantissa1;
+#endif
+}
+
+static inline double
+double_from_foreign_endianness (const union scm_ieee754_double *source)
+{
+  union scm_ieee754_double result;
+
+#ifdef WORDS_BIGENDIAN
+  /* Assuming little endian for both byte and word order.  */
+  result.big_endian.negative  = source->little_little_endian.negative;
+  result.big_endian.exponent  = source->little_little_endian.exponent;
+  result.big_endian.mantissa0 = source->little_little_endian.mantissa0;
+  result.big_endian.mantissa1 = source->little_little_endian.mantissa1;
+#else
+  result.little_little_endian.negative  = source->big_endian.negative;
+  result.little_little_endian.exponent  = source->big_endian.exponent;
+  result.little_little_endian.mantissa0 = source->big_endian.mantissa0;
+  result.little_little_endian.mantissa1 = source->big_endian.mantissa1;
+#endif
+
+  return (result.d);
+}
+
+/* Template macros to abstract over doubles and floats.
+   XXX: Guile can only convert to/from doubles.  */
+#define IEEE754_UNION(_c_type)           union scm_ieee754_ ## _c_type
+#define IEEE754_TO_SCM(_c_type)          scm_from_double
+#define IEEE754_FROM_SCM(_c_type)        scm_to_double
+#define IEEE754_FROM_FOREIGN_ENDIANNESS(_c_type)	\
+   _c_type ## _from_foreign_endianness
+#define IEEE754_TO_FOREIGN_ENDIANNESS(_c_type)	\
+   _c_type ## _to_foreign_endianness
+
+
+/* FIXME: SCM_VALIDATE_REAL rejects integers, etc. grrr */
+#define VALIDATE_REAL(pos, v) \
+  do { \
+    SCM_ASSERT_TYPE (scm_is_true (scm_rational_p (v)), v, pos, FUNC_NAME, "real"); \
+  } while (0)
+
+/* Templace getters and setters.  */
+
+#define IEEE754_ACCESSOR_PROLOGUE(_type)			\
+  INTEGER_ACCESSOR_PROLOGUE (sizeof (_type) << 3UL, signed);
+
+#define IEEE754_REF(_type)					\
+  _type c_result;						\
+								\
+  IEEE754_ACCESSOR_PROLOGUE (_type);				\
+  SCM_VALIDATE_SYMBOL (3, endianness);				\
+								\
+  if (scm_is_eq (endianness, scm_i_native_endianness))		\
+    memcpy (&c_result, &c_bv[c_index], sizeof (c_result));	\
+  else								\
+    {								\
+      IEEE754_UNION (_type) c_raw;				\
+								\
+      memcpy (&c_raw, &c_bv[c_index], sizeof (c_raw));		\
+      c_result =						\
+	IEEE754_FROM_FOREIGN_ENDIANNESS (_type) (&c_raw);	\
+    }								\
+								\
+  return (IEEE754_TO_SCM (_type) (c_result));
+
+#define IEEE754_NATIVE_REF(_type)				\
+  _type c_result;						\
+								\
+  IEEE754_ACCESSOR_PROLOGUE (_type);				\
+								\
+  memcpy (&c_result, &c_bv[c_index], sizeof (c_result));	\
+  return (IEEE754_TO_SCM (_type) (c_result));
+
+#define IEEE754_SET(_type)					\
+  _type c_value;						\
+								\
+  IEEE754_ACCESSOR_PROLOGUE (_type);				\
+  VALIDATE_REAL (3, value);					\
+  SCM_VALIDATE_SYMBOL (4, endianness);				\
+  c_value = IEEE754_FROM_SCM (_type) (value);			\
+								\
+  if (scm_is_eq (endianness, scm_i_native_endianness))		\
+    memcpy (&c_bv[c_index], &c_value, sizeof (c_value));	\
+  else								\
+    {								\
+      IEEE754_UNION (_type) c_raw;				\
+								\
+      IEEE754_TO_FOREIGN_ENDIANNESS (_type) (&c_raw, c_value);	\
+      memcpy (&c_bv[c_index], &c_raw, sizeof (c_raw));		\
+    }								\
+								\
+  return SCM_UNSPECIFIED;
+
+#define IEEE754_NATIVE_SET(_type)			\
+  _type c_value;					\
+							\
+  IEEE754_ACCESSOR_PROLOGUE (_type);			\
+  VALIDATE_REAL (3, value);				\
+  c_value = IEEE754_FROM_SCM (_type) (value);		\
+							\
+  memcpy (&c_bv[c_index], &c_value, sizeof (c_value));	\
+  return SCM_UNSPECIFIED;
+
+
+/* Single precision.  */
+
+SCM_DEFINE (scm_bytevector_ieee_single_ref,
+	    "bytevector-ieee-single-ref",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM endianness),
+	    "Return the IEEE-754 single from @var{bv} at "
+	    "@var{index}.")
+#define FUNC_NAME s_scm_bytevector_ieee_single_ref
+{
+  IEEE754_REF (float);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_ieee_single_native_ref,
+	    "bytevector-ieee-single-native-ref",
+	    2, 0, 0,
+	    (SCM bv, SCM index),
+	    "Return the IEEE-754 single from @var{bv} at "
+	    "@var{index} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_ieee_single_native_ref
+{
+  IEEE754_NATIVE_REF (float);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_ieee_single_set_x,
+	    "bytevector-ieee-single-set!",
+	    4, 0, 0,
+	    (SCM bv, SCM index, SCM value, SCM endianness),
+	    "Store real @var{value} in @var{bv} at @var{index} according to "
+	    "@var{endianness}.")
+#define FUNC_NAME s_scm_bytevector_ieee_single_set_x
+{
+  IEEE754_SET (float);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_ieee_single_native_set_x,
+	    "bytevector-ieee-single-native-set!",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM value),
+	    "Store the real @var{value} at index @var{index} "
+	    "of @var{bv} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_ieee_single_native_set_x
+{
+  IEEE754_NATIVE_SET (float);
+}
+#undef FUNC_NAME
+
+
+/* Double precision.  */
+
+SCM_DEFINE (scm_bytevector_ieee_double_ref,
+	    "bytevector-ieee-double-ref",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM endianness),
+	    "Return the IEEE-754 double from @var{bv} at "
+	    "@var{index}.")
+#define FUNC_NAME s_scm_bytevector_ieee_double_ref
+{
+  IEEE754_REF (double);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_ieee_double_native_ref,
+	    "bytevector-ieee-double-native-ref",
+	    2, 0, 0,
+	    (SCM bv, SCM index),
+	    "Return the IEEE-754 double from @var{bv} at "
+	    "@var{index} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_ieee_double_native_ref
+{
+  IEEE754_NATIVE_REF (double);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_ieee_double_set_x,
+	    "bytevector-ieee-double-set!",
+	    4, 0, 0,
+	    (SCM bv, SCM index, SCM value, SCM endianness),
+	    "Store real @var{value} in @var{bv} at @var{index} according to "
+	    "@var{endianness}.")
+#define FUNC_NAME s_scm_bytevector_ieee_double_set_x
+{
+  IEEE754_SET (double);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_ieee_double_native_set_x,
+	    "bytevector-ieee-double-native-set!",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM value),
+	    "Store the real @var{value} at index @var{index} "
+	    "of @var{bv} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_ieee_double_native_set_x
+{
+  IEEE754_NATIVE_SET (double);
+}
+#undef FUNC_NAME
+
+
+#undef IEEE754_UNION
+#undef IEEE754_TO_SCM
+#undef IEEE754_FROM_SCM
+#undef IEEE754_FROM_FOREIGN_ENDIANNESS
+#undef IEEE754_TO_FOREIGN_ENDIANNESS
+#undef IEEE754_REF
+#undef IEEE754_NATIVE_REF
+#undef IEEE754_SET
+#undef IEEE754_NATIVE_SET
+
+
+/* Operations on strings.  */
+
+
+/* Produce a function that returns the length of a UTF-encoded string.  */
+#define UTF_STRLEN_FUNCTION(_utf_width)					\
+static inline size_t							\
+utf ## _utf_width ## _strlen (const uint ## _utf_width ## _t *str)	\
+{									\
+  size_t len = 0;							\
+  const uint ## _utf_width ## _t *ptr;					\
+  for (ptr = str;							\
+       *ptr != 0;							\
+       ptr++)								\
+    {									\
+      len++;								\
+    }									\
+									\
+  return (len * ((_utf_width) / 8));					\
+}
+
+UTF_STRLEN_FUNCTION (8)
+
+
+/* Return the length (in bytes) of STR, a UTF-(UTF_WIDTH) encoded string.  */
+#define UTF_STRLEN(_utf_width, _str)		\
+  utf ## _utf_width ## _strlen (_str)
+
+/* Return the "portable" name of the UTF encoding of size UTF_WIDTH and
+   ENDIANNESS (Gnulib's `iconv_open' module guarantees the portability of the
+   encoding name).  */
+static inline void
+utf_encoding_name (char *name, size_t utf_width, SCM endianness)
+{
+  strcpy (name, "UTF-");
+  strcat (name, ((utf_width == 8)
+		 ? "8"
+		 : ((utf_width == 16)
+		    ? "16"
+		    : ((utf_width == 32)
+		       ? "32"
+		       : "??"))));
+  strcat (name,
+	  ((scm_is_eq (endianness, scm_sym_big))
+	   ? "BE"
+	   : ((scm_is_eq (endianness, scm_sym_little))
+	      ? "LE"
+	      : "unknown")));
+}
+
+/* Maximum length of a UTF encoding name.  */
+#define MAX_UTF_ENCODING_NAME_LEN  16
+
+/* Produce the body of a `string->utf' function.  */
+#define STRING_TO_UTF(_utf_width)					\
+  SCM utf;								\
+  int err;								\
+  char *c_str;								\
+  char c_utf_name[MAX_UTF_ENCODING_NAME_LEN];				\
+  char *c_utf = NULL, *c_locale;					\
+  size_t c_strlen, c_raw_strlen, c_utf_len = 0;				\
+									\
+  SCM_VALIDATE_STRING (1, str);						\
+  if (endianness == SCM_UNDEFINED)					\
+    endianness = scm_sym_big;						\
+  else									\
+    SCM_VALIDATE_SYMBOL (2, endianness);				\
+									\
+  c_strlen = scm_c_string_length (str);					\
+  c_raw_strlen = c_strlen * ((_utf_width) / 8);				\
+  do									\
+    {									\
+      c_str = (char *) alloca (c_raw_strlen + 1);			\
+      c_raw_strlen = scm_to_locale_stringbuf (str, c_str, c_strlen);	\
+    }									\
+  while (c_raw_strlen > c_strlen);					\
+  c_str[c_raw_strlen] = '\0';						\
+									\
+  utf_encoding_name (c_utf_name, (_utf_width), endianness);		\
+									\
+  c_locale = (char *) alloca (strlen (locale_charset ()) + 1);		\
+  strcpy (c_locale, locale_charset ());					\
+									\
+  err = mem_iconveh (c_str, c_raw_strlen,				\
+		     c_locale, c_utf_name,				\
+		     iconveh_question_mark, NULL,			\
+		     &c_utf, &c_utf_len);				\
+  if (SCM_UNLIKELY (err))						\
+    scm_syserror_msg (FUNC_NAME, "failed to convert string: ~A",	\
+		      scm_list_1 (str), err);				\
+  else									\
+    {									\
+      /* C_UTF is null-terminated.  It is malloc(3)-allocated, so we cannot \
+	 use `scm_c_take_bytevector ()'.  */				\
+      scm_dynwind_begin (0);						\
+      scm_dynwind_free (c_utf);						\
+									\
+      utf = make_bytevector (c_utf_len,					\
+                             SCM_ARRAY_ELEMENT_TYPE_VU8);		\
+      memcpy (SCM_BYTEVECTOR_CONTENTS (utf), c_utf,			\
+	      c_utf_len);						\
+									\
+      scm_dynwind_end ();						\
+    }									\
+									\
+  return (utf);
+
+
+
+SCM_DEFINE (scm_string_to_utf8, "string->utf8",
+	    1, 0, 0,
+	    (SCM str),
+	    "Return a newly allocated bytevector that contains the UTF-8 "
+	    "encoding of @var{str}.")
+#define FUNC_NAME s_scm_string_to_utf8
+{
+  SCM utf;
+  char *c_str;
+  uint8_t *c_utf;
+  size_t c_strlen, c_raw_strlen;
+
+  SCM_VALIDATE_STRING (1, str);
+
+  c_strlen = scm_c_string_length (str);
+  c_raw_strlen = c_strlen;
+  do
+    {
+      c_str = (char *) alloca (c_raw_strlen + 1);
+      c_raw_strlen = scm_to_locale_stringbuf (str, c_str, c_strlen);
+    }
+  while (c_raw_strlen > c_strlen);
+  c_str[c_raw_strlen] = '\0';
+
+  c_utf = u8_strconv_from_locale (c_str);
+  if (SCM_UNLIKELY (c_utf == NULL))
+    scm_syserror (FUNC_NAME);
+  else
+    {
+      /* C_UTF is null-terminated.  It is malloc(3)-allocated, so we cannot
+	 use `scm_c_take_bytevector ()'.  */
+      scm_dynwind_begin (0);
+      scm_dynwind_free (c_utf);
+
+      utf = make_bytevector (UTF_STRLEN (8, c_utf),
+			     SCM_ARRAY_ELEMENT_TYPE_VU8);
+      memcpy (SCM_BYTEVECTOR_CONTENTS (utf), c_utf,
+	      UTF_STRLEN (8, c_utf));
+
+      scm_dynwind_end ();
+    }
+
+  return (utf);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_string_to_utf16, "string->utf16",
+	    1, 1, 0,
+	    (SCM str, SCM endianness),
+	    "Return a newly allocated bytevector that contains the UTF-16 "
+	    "encoding of @var{str}.")
+#define FUNC_NAME s_scm_string_to_utf16
+{
+  STRING_TO_UTF (16);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_string_to_utf32, "string->utf32",
+	    1, 1, 0,
+	    (SCM str, SCM endianness),
+	    "Return a newly allocated bytevector that contains the UTF-32 "
+	    "encoding of @var{str}.")
+#define FUNC_NAME s_scm_string_to_utf32
+{
+  STRING_TO_UTF (32);
+}
+#undef FUNC_NAME
+
+
+/* Produce the body of a function that converts a UTF-encoded bytevector to a
+   string.  */
+#define UTF_TO_STRING(_utf_width)					\
+  SCM str = SCM_BOOL_F;							\
+  int err;								\
+  char *c_str = NULL, *c_locale;					\
+  char c_utf_name[MAX_UTF_ENCODING_NAME_LEN];				\
+  const char *c_utf;							\
+  size_t c_strlen = 0, c_utf_len;					\
+									\
+  SCM_VALIDATE_BYTEVECTOR (1, utf);					\
+  if (endianness == SCM_UNDEFINED)					\
+    endianness = scm_sym_big;						\
+  else									\
+    SCM_VALIDATE_SYMBOL (2, endianness);				\
+									\
+  c_utf_len = SCM_BYTEVECTOR_LENGTH (utf);				\
+  c_utf = (char *) SCM_BYTEVECTOR_CONTENTS (utf);			\
+  utf_encoding_name (c_utf_name, (_utf_width), endianness);		\
+									\
+  c_locale = (char *) alloca (strlen (locale_charset ()) + 1);		\
+  strcpy (c_locale, locale_charset ());					\
+									\
+  err = mem_iconveh (c_utf, c_utf_len,					\
+		     c_utf_name, c_locale,				\
+		     iconveh_question_mark, NULL,			\
+		     &c_str, &c_strlen);				\
+  if (SCM_UNLIKELY (err))						\
+    scm_syserror_msg (FUNC_NAME, "failed to convert to string: ~A",	\
+		      scm_list_1 (utf), err);				\
+  else									\
+    /* C_STR is null-terminated.  */					\
+    str = scm_take_locale_stringn (c_str, c_strlen);			\
+									\
+  return (str);
+
+
+SCM_DEFINE (scm_utf8_to_string, "utf8->string",
+	    1, 0, 0,
+	    (SCM utf),
+	    "Return a newly allocate string that contains from the UTF-8-"
+	    "encoded contents of bytevector @var{utf}.")
+#define FUNC_NAME s_scm_utf8_to_string
+{
+  SCM str;
+  int err;
+  char *c_str = NULL, *c_locale;
+  const char *c_utf;
+  size_t c_utf_len, c_strlen = 0;
+
+  SCM_VALIDATE_BYTEVECTOR (1, utf);
+
+  c_utf_len = SCM_BYTEVECTOR_LENGTH (utf);
+
+  c_locale = (char *) alloca (strlen (locale_charset ()) + 1);
+  strcpy (c_locale, locale_charset ());
+
+  c_utf = (char *) SCM_BYTEVECTOR_CONTENTS (utf);
+  err = mem_iconveh (c_utf, c_utf_len,
+		     "UTF-8", c_locale,
+		     iconveh_question_mark, NULL,
+		     &c_str, &c_strlen);
+  if (SCM_UNLIKELY (err))
+    scm_syserror_msg (FUNC_NAME, "failed to convert to string: ~A",
+		      scm_list_1 (utf), err);
+  else
+    /* C_STR is null-terminated.  */
+    str = scm_take_locale_stringn (c_str, c_strlen);
+
+  return (str);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_utf16_to_string, "utf16->string",
+	    1, 1, 0,
+	    (SCM utf, SCM endianness),
+	    "Return a newly allocate string that contains from the UTF-16-"
+	    "encoded contents of bytevector @var{utf}.")
+#define FUNC_NAME s_scm_utf16_to_string
+{
+  UTF_TO_STRING (16);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_utf32_to_string, "utf32->string",
+	    1, 1, 0,
+	    (SCM utf, SCM endianness),
+	    "Return a newly allocate string that contains from the UTF-32-"
+	    "encoded contents of bytevector @var{utf}.")
+#define FUNC_NAME s_scm_utf32_to_string
+{
+  UTF_TO_STRING (32);
+}
+#undef FUNC_NAME
+
+
+
+/* Bytevectors as generalized vectors & arrays.  */
+
+
+static SCM
+bytevector_ref_c32 (SCM bv, SCM idx)
+{ /* FIXME add some checks */
+  const float *contents = (const float*)SCM_BYTEVECTOR_CONTENTS (bv);
+  size_t i = scm_to_size_t (idx);
+  return scm_c_make_rectangular (contents[i/8], contents[i/8 + 1]);
+}
+
+static SCM
+bytevector_ref_c64 (SCM bv, SCM idx)
+{ /* FIXME add some checks */
+  const double *contents = (const double*)SCM_BYTEVECTOR_CONTENTS (bv);
+  size_t i = scm_to_size_t (idx);
+  return scm_c_make_rectangular (contents[i/16], contents[i/16 + 1]);
+}
+
+typedef SCM (*scm_t_bytevector_ref_fn)(SCM, SCM);
+
+const scm_t_bytevector_ref_fn bytevector_ref_fns[SCM_ARRAY_ELEMENT_TYPE_LAST + 1] = 
+{
+  NULL, /* SCM */
+  NULL, /* CHAR */
+  NULL, /* BIT */
+  scm_bytevector_u8_ref, /* VU8 */
+  scm_bytevector_u8_ref, /* U8 */
+  scm_bytevector_s8_ref,
+  scm_bytevector_u16_native_ref,
+  scm_bytevector_s16_native_ref,
+  scm_bytevector_u32_native_ref,
+  scm_bytevector_s32_native_ref,
+  scm_bytevector_u64_native_ref,
+  scm_bytevector_s64_native_ref,
+  scm_bytevector_ieee_single_native_ref,
+  scm_bytevector_ieee_double_native_ref,
+  bytevector_ref_c32,
+  bytevector_ref_c64
+};
+
+static SCM
+bv_handle_ref (scm_t_array_handle *h, size_t index)
+{
+  SCM byte_index;
+  scm_t_bytevector_ref_fn ref_fn;
+  
+  ref_fn = bytevector_ref_fns[h->element_type];
+  byte_index =
+    scm_from_size_t (index * scm_array_handle_uniform_element_size (h));
+  return ref_fn (h->array, byte_index);
+}
+
+static SCM
+bytevector_set_c32 (SCM bv, SCM idx, SCM val)
+{ /* checks are unnecessary here */
+  float *contents = (float*)SCM_BYTEVECTOR_CONTENTS (bv);
+  size_t i = scm_to_size_t (idx);
+  contents[i/8] = scm_c_real_part (val);
+  contents[i/8 + 1] = scm_c_imag_part (val);
+  return SCM_UNSPECIFIED;
+}
+
+static SCM
+bytevector_set_c64 (SCM bv, SCM idx, SCM val)
+{ /* checks are unnecessary here */
+  double *contents = (double*)SCM_BYTEVECTOR_CONTENTS (bv);
+  size_t i = scm_to_size_t (idx);
+  contents[i/16] = scm_c_real_part (val);
+  contents[i/16 + 1] = scm_c_imag_part (val);
+  return SCM_UNSPECIFIED;
+}
+
+typedef SCM (*scm_t_bytevector_set_fn)(SCM, SCM, SCM);
+
+const scm_t_bytevector_set_fn bytevector_set_fns[SCM_ARRAY_ELEMENT_TYPE_LAST + 1] = 
+{
+  NULL, /* SCM */
+  NULL, /* CHAR */
+  NULL, /* BIT */
+  scm_bytevector_u8_set_x, /* VU8 */
+  scm_bytevector_u8_set_x, /* U8 */
+  scm_bytevector_s8_set_x,
+  scm_bytevector_u16_native_set_x,
+  scm_bytevector_s16_native_set_x,
+  scm_bytevector_u32_native_set_x,
+  scm_bytevector_s32_native_set_x,
+  scm_bytevector_u64_native_set_x,
+  scm_bytevector_s64_native_set_x,
+  scm_bytevector_ieee_single_native_set_x,
+  scm_bytevector_ieee_double_native_set_x,
+  bytevector_set_c32,
+  bytevector_set_c64
+};
+
+static void
+bv_handle_set_x (scm_t_array_handle *h, size_t index, SCM val)
+{
+  SCM byte_index;
+  scm_t_bytevector_set_fn set_fn;
+  
+  set_fn = bytevector_set_fns[h->element_type];
+  byte_index =
+    scm_from_size_t (index * scm_array_handle_uniform_element_size (h));
+  set_fn (h->array, byte_index, val);
+}
+
+static void
+bytevector_get_handle (SCM v, scm_t_array_handle *h)
+{
+  h->array = v;
+  h->ndims = 1;
+  h->dims = &h->dim0;
+  h->dim0.lbnd = 0;
+  h->dim0.ubnd = SCM_BYTEVECTOR_TYPED_LENGTH (v) - 1;
+  h->dim0.inc = 1;
+  h->element_type = SCM_BYTEVECTOR_ELEMENT_TYPE (v);
+  h->elements = h->writable_elements = SCM_BYTEVECTOR_CONTENTS (v);
+}
+
+
+/* Initialization.  */
+
+void
+scm_bootstrap_bytevectors (void)
+{
+  /* This must be instantiated here because the generalized-vector API may
+     want to access bytevectors even though `(rnrs bytevector)' hasn't been
+     loaded.  */
+  scm_null_bytevector =
+    scm_gc_protect_object (make_bytevector (0, SCM_ARRAY_ELEMENT_TYPE_VU8));
+
+#ifdef WORDS_BIGENDIAN
+  scm_i_native_endianness = scm_permanent_object (scm_from_locale_symbol ("big"));
+#else
+  scm_i_native_endianness = scm_permanent_object (scm_from_locale_symbol ("little"));
+#endif
+
+  scm_c_register_extension ("libguile", "scm_init_bytevectors",
+			    (scm_t_extension_init_func) scm_init_bytevectors,
+			    NULL);
+
+  {
+    scm_t_array_implementation impl;
+
+    impl.tag = scm_tc7_bytevector;
+    impl.mask = 0x7f;
+    impl.vref = bv_handle_ref;
+    impl.vset = bv_handle_set_x;
+    impl.get_handle = bytevector_get_handle;
+    scm_i_register_array_implementation (&impl);
+    scm_i_register_vector_constructor
+      (scm_i_array_element_types[SCM_ARRAY_ELEMENT_TYPE_VU8],
+       scm_make_bytevector);
+  }
+}
+
+void
+scm_init_bytevectors (void)
+{
+#include "libguile/bytevectors.x"
+
+  scm_endianness_big = scm_sym_big;
+  scm_endianness_little = scm_sym_little;
+}
diff --git a/libguile/bytevectors.h b/libguile/bytevectors.h
new file mode 100644
index 000000000..506312638
--- /dev/null
+++ b/libguile/bytevectors.h
@@ -0,0 +1,148 @@
+#ifndef SCM_BYTEVECTORS_H
+#define SCM_BYTEVECTORS_H
+
+/* Copyright (C) 2009 Free Software Foundation, Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+
+
+#include "libguile/__scm.h"
+
+
+/* R6RS bytevectors.  */
+
+/* The size in words of the bytevector header (type tag, flags, and
+   length).  */
+#define SCM_BYTEVECTOR_HEADER_SIZE   2U
+
+#define SCM_BYTEVECTOR_LENGTH(_bv)		\
+  ((size_t) SCM_CELL_WORD_1 (_bv))
+#define SCM_BYTEVECTOR_CONTENTS(_bv)					\
+  ((signed char *) SCM_CELL_OBJECT_LOC ((_bv),				\
+					SCM_BYTEVECTOR_HEADER_SIZE))
+
+
+SCM_API SCM scm_endianness_big;
+SCM_API SCM scm_endianness_little;
+
+SCM_API SCM scm_c_make_bytevector (size_t);
+SCM_API int scm_is_bytevector (SCM);
+SCM_API size_t scm_c_bytevector_length (SCM);
+SCM_API scm_t_uint8 scm_c_bytevector_ref (SCM, size_t);
+SCM_API void scm_c_bytevector_set_x (SCM, size_t, scm_t_uint8);
+
+SCM_API SCM scm_make_bytevector (SCM, SCM);
+SCM_API SCM scm_native_endianness (void);
+SCM_API SCM scm_bytevector_p (SCM);
+SCM_API SCM scm_bytevector_length (SCM);
+SCM_API SCM scm_bytevector_eq_p (SCM, SCM);
+SCM_API SCM scm_bytevector_fill_x (SCM, SCM);
+SCM_API SCM scm_bytevector_copy_x (SCM, SCM, SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_copy (SCM);
+
+SCM_API SCM scm_uniform_array_to_bytevector (SCM);
+
+SCM_API SCM scm_bytevector_to_u8_list (SCM);
+SCM_API SCM scm_u8_list_to_bytevector (SCM);
+SCM_API SCM scm_uint_list_to_bytevector (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_to_uint_list (SCM, SCM, SCM);
+SCM_API SCM scm_sint_list_to_bytevector (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_to_sint_list (SCM, SCM, SCM);
+
+SCM_API SCM scm_bytevector_u16_native_ref (SCM, SCM);
+SCM_API SCM scm_bytevector_s16_native_ref (SCM, SCM);
+SCM_API SCM scm_bytevector_u32_native_ref (SCM, SCM);
+SCM_API SCM scm_bytevector_s32_native_ref (SCM, SCM);
+SCM_API SCM scm_bytevector_u64_native_ref (SCM, SCM);
+SCM_API SCM scm_bytevector_s64_native_ref (SCM, SCM);
+SCM_API SCM scm_bytevector_u8_ref (SCM, SCM);
+SCM_API SCM scm_bytevector_s8_ref (SCM, SCM);
+SCM_API SCM scm_bytevector_uint_ref (SCM, SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_sint_ref (SCM, SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_u16_ref (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_s16_ref (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_u32_ref (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_s32_ref (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_u64_ref (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_s64_ref (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_u16_native_set_x (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_s16_native_set_x (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_u32_native_set_x (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_s32_native_set_x (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_u64_native_set_x (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_s64_native_set_x (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_u8_set_x (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_s8_set_x (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_uint_set_x (SCM, SCM, SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_sint_set_x (SCM, SCM, SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_u16_set_x (SCM, SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_s16_set_x (SCM, SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_u32_set_x (SCM, SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_s32_set_x (SCM, SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_u64_set_x (SCM, SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_s64_set_x (SCM, SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_ieee_single_ref (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_ieee_single_native_ref (SCM, SCM);
+SCM_API SCM scm_bytevector_ieee_single_set_x (SCM, SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_ieee_single_native_set_x (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_ieee_double_ref (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_ieee_double_native_ref (SCM, SCM);
+SCM_API SCM scm_bytevector_ieee_double_set_x (SCM, SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_ieee_double_native_set_x (SCM, SCM, SCM);
+SCM_API SCM scm_string_to_utf8 (SCM);
+SCM_API SCM scm_string_to_utf16 (SCM, SCM);
+SCM_API SCM scm_string_to_utf32 (SCM, SCM);
+SCM_API SCM scm_utf8_to_string (SCM);
+SCM_API SCM scm_utf16_to_string (SCM, SCM);
+SCM_API SCM scm_utf32_to_string (SCM, SCM);
+
+
+
+/* Internal API.  */
+
+#define SCM_BYTEVECTOR_P(x)				\
+  (!SCM_IMP (x) && SCM_TYP7(x) == scm_tc7_bytevector)
+#define SCM_BYTEVECTOR_FLAGS(_bv)		\
+  (SCM_CELL_TYPE (_bv) >> 7UL)
+#define SCM_SET_BYTEVECTOR_FLAGS(_bv, _f)				\
+  SCM_SET_CELL_TYPE ((_bv),						\
+		     scm_tc7_bytevector | ((scm_t_bits)(_f) << 7UL))
+
+#define SCM_BYTEVECTOR_ELEMENT_TYPE(_bv)	\
+  (SCM_BYTEVECTOR_FLAGS (_bv))
+
+/* Hint that is passed to `scm_gc_malloc ()' and friends.  */
+#define SCM_GC_BYTEVECTOR "bytevector"
+
+SCM_INTERNAL SCM scm_i_make_typed_bytevector (size_t, scm_t_array_element_type);
+SCM_INTERNAL SCM scm_c_take_typed_bytevector (signed char *, size_t,
+                                              scm_t_array_element_type);
+
+SCM_INTERNAL void scm_bootstrap_bytevectors (void);
+SCM_INTERNAL void scm_init_bytevectors (void);
+
+SCM_INTERNAL SCM scm_i_native_endianness;
+SCM_INTERNAL SCM scm_c_take_bytevector (signed char *, size_t);
+
+SCM_INTERNAL int scm_i_print_bytevector (SCM, SCM, scm_print_state *);
+
+SCM_INTERNAL SCM scm_c_shrink_bytevector (SCM, size_t);
+SCM_INTERNAL void scm_i_bytevector_generalized_set_x (SCM, size_t, SCM);
+SCM_INTERNAL SCM scm_null_bytevector;
+
+#endif /* SCM_BYTEVECTORS_H */
diff --git a/libguile/chars.c b/libguile/chars.c
index 909e11d57..c7cb09c47 100644
--- a/libguile/chars.c
+++ b/libguile/chars.c
@@ -1,18 +1,19 @@
-/*	Copyright (C) 1995,1996,1998, 2000, 2001, 2004, 2006, 2008 Free Software Foundation, Inc.
+/*	Copyright (C) 1995,1996,1998, 2000, 2001, 2004, 2006, 2008, 2009 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -23,6 +24,8 @@
 
 #include <ctype.h>
 #include <limits.h>
+#include <unicase.h>
+
 #include "libguile/_scm.h"
 #include "libguile/validate.h"
 
@@ -54,7 +57,7 @@ SCM_DEFINE1 (scm_char_eq_p, "char=?", scm_tc7_rpsubr,
 
 SCM_DEFINE1 (scm_char_less_p, "char<?", scm_tc7_rpsubr, 
              (SCM x, SCM y),
-	     "Return @code{#t} iff @var{x} is less than @var{y} in the ASCII sequence,\n"
+	     "Return @code{#t} iff @var{x} is less than @var{y} in the Unicode sequence,\n"
 	     "else @code{#f}.")
 #define FUNC_NAME s_scm_char_less_p
 {
@@ -67,7 +70,7 @@ SCM_DEFINE1 (scm_char_less_p, "char<?", scm_tc7_rpsubr,
 SCM_DEFINE1 (scm_char_leq_p, "char<=?", scm_tc7_rpsubr,
              (SCM x, SCM y),
 	     "Return @code{#t} iff @var{x} is less than or equal to @var{y} in the\n"
-	     "ASCII sequence, else @code{#f}.")
+	     "Unicode sequence, else @code{#f}.")
 #define FUNC_NAME s_scm_char_leq_p
 {
   SCM_VALIDATE_CHAR (1, x);
@@ -78,7 +81,7 @@ SCM_DEFINE1 (scm_char_leq_p, "char<=?", scm_tc7_rpsubr,
 
 SCM_DEFINE1 (scm_char_gr_p, "char>?", scm_tc7_rpsubr,
              (SCM x, SCM y),
-	     "Return @code{#t} iff @var{x} is greater than @var{y} in the ASCII\n"
+	     "Return @code{#t} iff @var{x} is greater than @var{y} in the Unicode\n"
 	     "sequence, else @code{#f}.")
 #define FUNC_NAME s_scm_char_gr_p
 {
@@ -91,7 +94,7 @@ SCM_DEFINE1 (scm_char_gr_p, "char>?", scm_tc7_rpsubr,
 SCM_DEFINE1 (scm_char_geq_p, "char>=?", scm_tc7_rpsubr,
              (SCM x, SCM y),
 	     "Return @code{#t} iff @var{x} is greater than or equal to @var{y} in the\n"
-	     "ASCII sequence, else @code{#f}.")
+	     "Unicode sequence, else @code{#f}.")
 #define FUNC_NAME s_scm_char_geq_p
 {
   SCM_VALIDATE_CHAR (1, x);
@@ -103,7 +106,7 @@ SCM_DEFINE1 (scm_char_geq_p, "char>=?", scm_tc7_rpsubr,
 SCM_DEFINE1 (scm_char_ci_eq_p, "char-ci=?", scm_tc7_rpsubr,
              (SCM x, SCM y),
 	     "Return @code{#t} iff @var{x} is the same character as @var{y} ignoring\n"
-	     "case, else @code{#f}.")
+	     "case, else @code{#f}.  Case is locale free and not context sensitive.")
 #define FUNC_NAME s_scm_char_ci_eq_p
 {
   SCM_VALIDATE_CHAR (1, x);
@@ -114,8 +117,9 @@ SCM_DEFINE1 (scm_char_ci_eq_p, "char-ci=?", scm_tc7_rpsubr,
 
 SCM_DEFINE1 (scm_char_ci_less_p, "char-ci<?", scm_tc7_rpsubr,
              (SCM x, SCM y),
-	     "Return @code{#t} iff @var{x} is less than @var{y} in the ASCII sequence\n"
-	     "ignoring case, else @code{#f}.")
+	     "Return @code{#t} iff the Unicode uppercase form of @var{x} is less\n"
+	     "than the Unicode uppercase form @var{y} in the Unicode sequence,\n"
+	     "else @code{#f}.")
 #define FUNC_NAME s_scm_char_ci_less_p
 {
   SCM_VALIDATE_CHAR (1, x);
@@ -126,8 +130,9 @@ SCM_DEFINE1 (scm_char_ci_less_p, "char-ci<?", scm_tc7_rpsubr,
 
 SCM_DEFINE1 (scm_char_ci_leq_p, "char-ci<=?", scm_tc7_rpsubr,
              (SCM x, SCM y),
-	     "Return @code{#t} iff @var{x} is less than or equal to @var{y} in the\n"
-	     "ASCII sequence ignoring case, else @code{#f}.")
+	     "Return @code{#t} iff the Unicode uppercase form of @var{x} is less\n"
+	     "than or equal to the Unicode uppercase form of @var{y} in the\n"
+	     "Unicode  sequence, else @code{#f}.")
 #define FUNC_NAME s_scm_char_ci_leq_p
 {
   SCM_VALIDATE_CHAR (1, x);
@@ -138,8 +143,9 @@ SCM_DEFINE1 (scm_char_ci_leq_p, "char-ci<=?", scm_tc7_rpsubr,
 
 SCM_DEFINE1 (scm_char_ci_gr_p, "char-ci>?", scm_tc7_rpsubr,
              (SCM x, SCM y),
-	     "Return @code{#t} iff @var{x} is greater than @var{y} in the ASCII\n"
-	     "sequence ignoring case, else @code{#f}.")
+	     "Return @code{#t} iff the Unicode uppercase form of @var{x} is greater\n"
+	     "than the Unicode uppercase form of @var{y} in the Unicode\n"
+	     "sequence, else @code{#f}.")
 #define FUNC_NAME s_scm_char_ci_gr_p
 {
   SCM_VALIDATE_CHAR (1, x);
@@ -150,8 +156,9 @@ SCM_DEFINE1 (scm_char_ci_gr_p, "char-ci>?", scm_tc7_rpsubr,
 
 SCM_DEFINE1 (scm_char_ci_geq_p, "char-ci>=?", scm_tc7_rpsubr,
              (SCM x, SCM y),
-	     "Return @code{#t} iff @var{x} is greater than or equal to @var{y} in the\n"
-	     "ASCII sequence ignoring case, else @code{#f}.")
+	     "Return @code{#t} iff the Unicode uppercase form of @var{x} is greater\n"
+	     "than or equal to the Unicode uppercase form of @var{y} in the\n"
+	     "Unicode sequence, else @code{#f}.")
 #define FUNC_NAME s_scm_char_ci_geq_p
 {
   SCM_VALIDATE_CHAR (1, x);
@@ -232,7 +239,7 @@ SCM_DEFINE (scm_char_to_integer, "char->integer", 1, 0, 0,
 #define FUNC_NAME s_scm_char_to_integer
 {
   SCM_VALIDATE_CHAR (1, chr);
-  return scm_from_ulong (SCM_CHAR(chr));
+  return scm_from_uint32 (SCM_CHAR(chr));
 }
 #undef FUNC_NAME
 
@@ -243,7 +250,15 @@ SCM_DEFINE (scm_integer_to_char, "integer->char", 1, 0, 0,
 	    "Return the character at position @var{n} in the ASCII sequence.")
 #define FUNC_NAME s_scm_integer_to_char
 {
-  return SCM_MAKE_CHAR (scm_to_uchar (n));
+  scm_t_wchar cn;
+
+  cn = scm_to_wchar (n);
+
+  /* Avoid the surrogates.  */
+  if (!SCM_IS_UNICODE_CHAR (cn))
+    scm_out_of_range (FUNC_NAME, n);
+
+  return SCM_MAKE_CHAR (cn);
 }
 #undef FUNC_NAME
 
@@ -254,7 +269,7 @@ SCM_DEFINE (scm_char_upcase, "char-upcase", 1, 0, 0,
 #define FUNC_NAME s_scm_char_upcase
 {
   SCM_VALIDATE_CHAR (1, chr);
-  return SCM_MAKE_CHAR (toupper (SCM_CHAR (chr)));
+  return SCM_MAKE_CHAR (scm_c_upcase (SCM_CHAR (chr)));
 }
 #undef FUNC_NAME
 
@@ -265,7 +280,7 @@ SCM_DEFINE (scm_char_downcase, "char-downcase", 1, 0, 0,
 #define FUNC_NAME s_scm_char_downcase
 {
   SCM_VALIDATE_CHAR (1, chr);
-  return SCM_MAKE_CHAR (tolower (SCM_CHAR(chr)));
+  return SCM_MAKE_CHAR (scm_c_downcase (SCM_CHAR(chr)));
 }
 #undef FUNC_NAME
 
@@ -278,80 +293,115 @@ TODO: change name  to scm_i_.. ? --hwn
 */
 
 
-int
-scm_c_upcase (unsigned int c)
+scm_t_wchar
+scm_c_upcase (scm_t_wchar c)
 {
-  if (c <= UCHAR_MAX)
-    return toupper (c);
-  else
-    return c;
+  return uc_toupper ((int) c);
 }
 
 
-int
-scm_c_downcase (unsigned int c)
+scm_t_wchar
+scm_c_downcase (scm_t_wchar c)
 {
-  if (c <= UCHAR_MAX)
-    return tolower (c);
-  else
-    return c;
+  return uc_tolower ((int) 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 */
+/* There are a few sets of character names: R5RS, Guile
+   extensions for control characters, and leftover Guile extensions.
+   They are listed in order of precedence.  */
+
+static const char *const scm_r5rs_charnames[] = {
+  "space", "newline"
+};
+
+static const scm_t_uint32 const scm_r5rs_charnums[] = {
+  0x20, 0x0A
+};
+
+#define SCM_N_R5RS_CHARNAMES (sizeof (scm_r5rs_charnames) / sizeof (char *))
+
+/* The abbreviated names for control characters.  */
+static const char *const scm_C0_control_charnames[] = {
+  /* C0 controls */
+  "nul", "soh", "stx", "etx", "eot", "enq", "ack", "bel",
+  "bs",  "ht",  "lf",  "vt",  "ff",  "cr",  "so",  "si",
+  "dle", "dc1", "dc2", "dc3", "dc4", "nak", "syn", "etb", 
+  "can", "em",  "sub", "esc", "fs",  "gs",  "rs",  "us",
+  "sp", "del"
+};
+
+static const scm_t_uint32 const scm_C0_control_charnums[] = {
+  0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07,
+  0x08, 0x09, 0x0a, 0x0b, 0x0c, 0x0d, 0x0e, 0x0f,
+  0x10, 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17,
+  0x18, 0x19, 0x1a, 0x1b, 0x1c, 0x1d, 0x1e, 0x1f,
+  0x20, 0x7f
+};
+
+#define SCM_N_C0_CONTROL_CHARNAMES (sizeof (scm_C0_control_charnames) / sizeof (char *))
+
+static const char *const scm_alt_charnames[] = {
+  "null", "backspace", "tab", "nl", "newline", "np", "page", "return",
+};
+
+static const scm_t_uint32 const scm_alt_charnums[] = {
+  0x00, 0x08, 0x09, 0x0a, 0x0a, 0x0c, 0x0c, 0x0d
+};
+
+#define SCM_N_ALT_CHARNAMES (sizeof (scm_alt_charnames) / sizeof (char *))
+
+/* Returns the string charname for a character if it exists, or NULL
+   otherwise.  */
+const char *
+scm_i_charname (SCM chr)
+{
+  size_t c;
+  scm_t_uint32 i = SCM_CHAR (chr);
 
+  for (c = 0; c < SCM_N_R5RS_CHARNAMES; c++)
+    if (scm_r5rs_charnums[c] == i)
+      return scm_r5rs_charnames[c];
 
-#ifdef EBCDIC
-char *const 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"};
-
-const 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 *const scm_charnames[] =
-{
-  "nul","soh","stx","etx","eot","enq","ack","bel",
-   "bs", "ht", "newline", "vt", "np", "cr", "so", "si",
-  "dle","dc1","dc2","dc3","dc4","nak","syn","etb",
-  "can", "em","sub","esc", "fs", "gs", "rs", "us",
-  "space", "sp", "nl", "tab", "backspace", "return", "page", "null", "del"};
-const 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 *);
+  for (c = 0; c < SCM_N_C0_CONTROL_CHARNAMES; c++)
+    if (scm_C0_control_charnums[c] == i)
+      return scm_C0_control_charnames[c];
+
+  for (c = 0; c < SCM_N_ALT_CHARNAMES; c++)
+    if (scm_alt_charnums[c] == i)
+      return scm_alt_charnames[i];
 
+  return NULL;
+}
+
+/* Return a character from a string charname.  */
+SCM
+scm_i_charname_to_char (const char *charname, size_t charname_len)
+{
+  size_t c;
+
+  /* The R5RS charnames.  These are supposed to be case
+     insensitive. */
+  for (c = 0; c < SCM_N_R5RS_CHARNAMES; c++)
+    if ((strlen (scm_r5rs_charnames[c]) == charname_len)
+	&& (!strncasecmp (scm_r5rs_charnames[c], charname, charname_len)))
+      return SCM_MAKE_CHAR (scm_r5rs_charnums[c]);
+
+  /* Then come the controls.  These are not case sensitive.  */
+  for (c = 0; c < SCM_N_C0_CONTROL_CHARNAMES; c++)
+    if ((strlen (scm_C0_control_charnames[c]) == charname_len)
+	&& (!strncasecmp (scm_C0_control_charnames[c], charname, charname_len)))
+      return SCM_MAKE_CHAR (scm_C0_control_charnums[c]);
+
+  /* Lastly are some old names carried over for compatibility.  */
+  for (c = 0; c < SCM_N_ALT_CHARNAMES; c++)
+    if ((strlen (scm_alt_charnames[c]) == charname_len)
+	&& (!strncasecmp (scm_alt_charnames[c], charname, charname_len)))
+      return SCM_MAKE_CHAR (scm_alt_charnums[c]);
+
+  return SCM_BOOL_F;
+}
 
 
 
diff --git a/libguile/chars.h b/libguile/chars.h
index 97c611af4..85b16739a 100644
--- a/libguile/chars.h
+++ b/libguile/chars.h
@@ -3,39 +3,54 @@
 #ifndef SCM_CHARS_H
 #define SCM_CHARS_H
 
-/* Copyright (C) 1995,1996,2000,2001,2004, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,2000,2001,2004, 2006, 2008, 2009 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
 
 #include "libguile/__scm.h"
 
+#ifndef SCM_T_WCHAR_DEFINED
+typedef scm_t_int32 scm_t_wchar;
+#define SCM_T_WCHAR_DEFINED
+#endif /* SCM_T_WCHAR_DEFINED */
+
 
 /* Immediate Characters
  */
 #define SCM_CHARP(x) (SCM_ITAG8(x) == scm_tc8_char)
-#define SCM_CHAR(x) ((unsigned int)SCM_ITAG8_DATA(x))
-#define SCM_MAKE_CHAR(x) SCM_MAKE_ITAG8((scm_t_bits) (unsigned char) (x), scm_tc8_char)
+#define SCM_CHAR(x) ((scm_t_wchar)SCM_ITAG8_DATA(x))
 
-
+/* SCM_MAKE_CHAR maps signed chars (-128 to 127) and unsigned chars (0
+   to 255) to Latin-1 codepoints (0 to 255) while allowing higher
+   codepoints (256 to 1114111) to pass through unchanged.
+
+   This macro evaluates x twice, which may lead to side effects if not
+   used properly. */
+#define SCM_MAKE_CHAR(x)                                                \
+  ((x) <= 1                                                             \
+   ? SCM_MAKE_ITAG8 ((scm_t_bits) (unsigned char) (x), scm_tc8_char)    \
+   : SCM_MAKE_ITAG8 ((scm_t_bits) (x), scm_tc8_char))
 
-SCM_API char *const scm_charnames[];
-SCM_API int scm_n_charnames;
-SCM_API const char scm_charnums[];
+#define SCM_CODEPOINT_MAX (0x10ffff)
+#define SCM_IS_UNICODE_CHAR(c)                                          \
+  ((scm_t_wchar) (c) <= 0xd7ff                                          \
+   || ((scm_t_wchar) (c) >= 0xe000 && (scm_t_wchar) (c) <= SCM_CODEPOINT_MAX))
 
 
 
@@ -60,8 +75,11 @@ SCM_API SCM scm_char_to_integer (SCM chr);
 SCM_API SCM scm_integer_to_char (SCM n);
 SCM_API SCM scm_char_upcase (SCM chr);
 SCM_API SCM scm_char_downcase (SCM chr);
-SCM_API int scm_c_upcase (unsigned int c);
-SCM_API int scm_c_downcase (unsigned int c);
+SCM_API scm_t_wchar scm_c_upcase (scm_t_wchar c);
+SCM_API scm_t_wchar scm_c_downcase (scm_t_wchar c);
+SCM_INTERNAL const char *scm_i_charname (SCM chr);
+SCM_INTERNAL SCM scm_i_charname_to_char (const char *charname, 
+                                         size_t charname_len);
 SCM_INTERNAL void scm_init_chars (void);
 
 #endif  /* SCM_CHARS_H */
diff --git a/libguile/continuations.c b/libguile/continuations.c
index e8ee4db82..aa1fb334e 100644
--- a/libguile/continuations.c
+++ b/libguile/continuations.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1995,1996,1998,2000,2001,2004, 2006, 2008 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -35,6 +36,7 @@
 #include "libguile/dynwind.h"
 #include "libguile/values.h"
 #include "libguile/eval.h"
+#include "libguile/vm.h"
 
 #include "libguile/validate.h"
 #include "libguile/continuations.h"
@@ -84,15 +86,16 @@ scm_make_continuation (int *first)
   continuation->root = thread->continuation_root;
   continuation->dframe = scm_i_last_debug_frame ();
   src = thread->continuation_base;
-  SCM_NEWSMOB (cont, scm_tc16_continuation, continuation);
-
 #if ! SCM_STACK_GROWS_UP
   src -= stack_size;
 #endif
   continuation->offset = continuation->stack - src;
   memcpy (continuation->stack, src, sizeof (SCM_STACKITEM) * stack_size);
+  continuation->vm_conts = scm_vm_capture_continuations ();
+
+  SCM_NEWSMOB (cont, scm_tc16_continuation, continuation);
 
-  *first = !setjmp (continuation->jmpbuf);
+  *first = !SCM_I_SETJMP (continuation->jmpbuf);
   if (*first)
     {
 #ifdef __ia64__
@@ -169,6 +172,7 @@ copy_stack (void *data)
   copy_stack_data *d = (copy_stack_data *)data;
   memcpy (d->dst, d->continuation->stack,
 	  sizeof (SCM_STACKITEM) * d->continuation->num_stack_items);
+  scm_vm_reinstate_continuations (d->continuation->vm_conts);
 #ifdef __ia64__
   SCM_I_CURRENT_THREAD->pending_rbs_continuation = d->continuation;
 #endif
@@ -189,12 +193,12 @@ copy_stack_and_call (scm_t_contregs *continuation, SCM val,
   scm_i_set_last_debug_frame (continuation->dframe);
 
   continuation->throw_value = val;
-  longjmp (continuation->jmpbuf, 1);
+  SCM_I_LONGJMP (continuation->jmpbuf, 1);
 }
 
 #ifdef __ia64__
 void
-scm_ia64_longjmp (jmp_buf *JB, int VAL)
+scm_ia64_longjmp (scm_i_jmp_buf *JB, int VAL)
 {
   scm_i_thread *t = SCM_I_CURRENT_THREAD;
 
diff --git a/libguile/continuations.h b/libguile/continuations.h
index 1a648dd28..82cf178b0 100644
--- a/libguile/continuations.h
+++ b/libguile/continuations.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,2000,2001, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -43,7 +44,7 @@ SCM_API scm_t_bits scm_tc16_continuation;
 typedef struct 
 {
   SCM throw_value;
-  jmp_buf jmpbuf;
+  scm_i_jmp_buf jmpbuf;
   SCM dynenv;
 #ifdef __ia64__
   void *backing_store;
@@ -51,6 +52,7 @@ typedef struct
 #endif /* __ia64__ */
   size_t num_stack_items;   /* size of the saved stack.  */
   SCM root;                 /* continuation root identifier.  */
+  SCM vm_conts;             /* vm continuations (they use separate stacks) */
 
   /* The offset from the live stack location to this copy.  This is
      used to adjust pointers from within the copied stack to the stack
diff --git a/libguile/conv-uinteger.i.c b/libguile/conv-uinteger.i.c
index ff0d28012..52f49f772 100644
--- a/libguile/conv-uinteger.i.c
+++ b/libguile/conv-uinteger.i.c
@@ -53,10 +53,17 @@ SCM_TO_TYPE_PROTO (SCM val)
 #if SIZEOF_TYPE != 0 && SIZEOF_TYPE > SCM_SIZEOF_LONG
 	      return n;
 #else
-	      if (n >= TYPE_MIN && n <= TYPE_MAX)
-		return n;
-	      else
-		goto out_of_range;
+
+#if TYPE_MIN == 0 
+              if (n <= TYPE_MAX)
+                return n;
+#else /* TYPE_MIN != 0 */
+              if (n >= TYPE_MIN && n <= TYPE_MAX)
+                return n;
+#endif /* TYPE_MIN != 0 */
+              else
+                goto out_of_range;
+
 #endif
 	    }
 	  else
@@ -76,10 +83,16 @@ SCM_TO_TYPE_PROTO (SCM val)
 	  
 	  mpz_export (&n, &count, 1, sizeof (TYPE), 0, 0, SCM_I_BIG_MPZ (val));
 
+#if TYPE_MIN == 0
+	  if (n <= TYPE_MAX)
+	    return n;
+#else /* TYPE_MIN != 0 */
 	  if (n >= TYPE_MIN && n <= TYPE_MAX)
 	    return n;
-	  else
-	    goto out_of_range;
+#endif /* TYPE_MIN != 0 */
+          else
+            goto out_of_range;
+
 	}
     }
   else
diff --git a/libguile/convert.c b/libguile/convert.c
deleted file mode 100644
index 700deaa87..000000000
--- a/libguile/convert.c
+++ /dev/null
@@ -1,146 +0,0 @@
-/* Copyright (C) 2002, 2006 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
- */
-
-
-#ifdef HAVE_CONFIG_H
-#  include <config.h>
-#endif
-
-#include "libguile/_scm.h"
-#include "libguile/validate.h"
-#include "libguile/strings.h"
-#include "libguile/vectors.h"
-#include "libguile/pairs.h"
-#include "libguile/unif.h"
-#include "libguile/srfi-4.h"
-
-#include "libguile/convert.h"
-
-#ifdef HAVE_STRING_H
-#include <string.h>
-#endif
-
-/* char *scm_c_scm2chars (SCM obj, char *dst);
-   SCM   scm_c_chars2scm (const char *src, long n);
-   SCM   scm_c_chars2byvect (const char *src, long n);
-*/
-
-#define CTYPE            char
-#define FROM_CTYPE       scm_from_char
-#define SCM2CTYPES       scm_c_scm2chars
-#define CTYPES2SCM       scm_c_chars2scm
-#define CTYPES2UVECT     scm_c_chars2byvect
-#if CHAR_MIN == 0
-/* 'char' is unsigned. */
-#define UVEC_TAG         u8
-#define UVEC_CTYPE       scm_t_uint8
-#else
-/* 'char' is signed. */
-#define UVEC_TAG         s8
-#define UVEC_CTYPE       scm_t_int8
-#endif
-#include "libguile/convert.i.c"
-
-/* short *scm_c_scm2shorts (SCM obj, short *dst);
-   SCM scm_c_shorts2scm (const short *src, long n);
-   SCM scm_c_shorts2svect (const short *src, long n);
-*/
-
-#define CTYPE            short
-#define FROM_CTYPE       scm_from_short
-#define SCM2CTYPES       scm_c_scm2shorts
-#define CTYPES2SCM       scm_c_shorts2scm
-#define CTYPES2UVECT     scm_c_shorts2svect
-#define UVEC_TAG         s16
-#define UVEC_CTYPE       scm_t_int16
-#include "libguile/convert.i.c"
-
-/* int *scm_c_scm2ints (SCM obj, int *dst);
-   SCM scm_c_ints2scm (const int *src, long n);
-   SCM scm_c_ints2ivect (const int *src, long n);
-   SCM scm_c_uints2uvect (const unsigned int *src, long n);
-*/
-
-#define CTYPE            int
-#define FROM_CTYPE       scm_from_int
-#define SCM2CTYPES       scm_c_scm2ints
-#define CTYPES2SCM       scm_c_ints2scm
-#define CTYPES2UVECT     scm_c_ints2ivect
-#define UVEC_TAG         s32
-#define UVEC_CTYPE       scm_t_int32
-
-#define CTYPES2UVECT_2   scm_c_uints2uvect
-#define CTYPE_2          unsigned int
-#define UVEC_TAG_2       u32
-#define UVEC_CTYPE_2     scm_t_uint32
-
-#include "libguile/convert.i.c"
-
-/* long *scm_c_scm2longs (SCM obj, long *dst);
-   SCM scm_c_longs2scm (const long *src, long n);
-   SCM scm_c_longs2ivect (const long *src, long n);
-   SCM scm_c_ulongs2uvect (const unsigned long *src, long n);
-*/
-
-#define CTYPE            long
-#define FROM_CTYPE       scm_from_long
-#define SCM2CTYPES       scm_c_scm2longs
-#define CTYPES2SCM       scm_c_longs2scm
-#define CTYPES2UVECT     scm_c_longs2ivect
-#define UVEC_TAG         s32
-#define UVEC_CTYPE       scm_t_int32
-
-#define CTYPES2UVECT_2   scm_c_ulongs2uvect
-#define CTYPE_2          unsigned int
-#define UVEC_TAG_2       u32
-#define UVEC_CTYPE_2     scm_t_uint32
-
-#include "libguile/convert.i.c"
-
-/* float *scm_c_scm2floats (SCM obj, float *dst);
-   SCM scm_c_floats2scm (const float *src, long n);
-   SCM scm_c_floats2fvect (const float *src, long n);
-*/
-
-#define CTYPE            float
-#define FROM_CTYPE       scm_from_double
-#define SCM2CTYPES       scm_c_scm2floats
-#define CTYPES2SCM       scm_c_floats2scm
-#define CTYPES2UVECT     scm_c_floats2fvect
-#define UVEC_TAG         f32
-#define UVEC_CTYPE       float
-#include "libguile/convert.i.c"
-
-/* double *scm_c_scm2doubles (SCM obj, double *dst);
-   SCM scm_c_doubles2scm (const double *src, long n);
-   SCM scm_c_doubles2dvect (const double *src, long n);
-*/
-
-#define CTYPE            double
-#define FROM_CTYPE       scm_from_double
-#define SCM2CTYPES       scm_c_scm2doubles
-#define CTYPES2SCM       scm_c_doubles2scm
-#define CTYPES2UVECT     scm_c_doubles2dvect
-#define UVEC_TAG         f64
-#define UVEC_CTYPE       double
-#include "libguile/convert.i.c"
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/convert.h b/libguile/convert.h
deleted file mode 100644
index f834a6b1d..000000000
--- a/libguile/convert.h
+++ /dev/null
@@ -1,50 +0,0 @@
-/* classes: h_files */
-
-#ifndef SCM_CONVERT_H
-#define SCM_CONVERT_H
-
-/* Copyright (C) 2002, 2006 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
- */
-
-
-
-#include "libguile/__scm.h"
-
-SCM_API char *scm_c_scm2chars (SCM obj, char *dst);
-SCM_API short *scm_c_scm2shorts (SCM obj, short *dst);
-SCM_API int *scm_c_scm2ints (SCM obj, int *dst);
-SCM_API long *scm_c_scm2longs (SCM obj, long *dst);
-SCM_API float *scm_c_scm2floats (SCM obj, float *dst);
-SCM_API double *scm_c_scm2doubles (SCM obj, double *dst);
-
-SCM_API SCM scm_c_chars2scm (const char *src, long n);
-SCM_API SCM scm_c_shorts2scm (const short *src, long n);
-SCM_API SCM scm_c_ints2scm (const int *src, long n);
-SCM_API SCM scm_c_longs2scm (const long *src, long n);
-SCM_API SCM scm_c_floats2scm (const float *src, long n);
-SCM_API SCM scm_c_doubles2scm (const double *src, long n);
-
-SCM_API SCM scm_c_chars2byvect (const char *src, long n);
-SCM_API SCM scm_c_shorts2svect (const short *src, long n);
-SCM_API SCM scm_c_ints2ivect (const int *src, long n);
-SCM_API SCM scm_c_uints2uvect (const unsigned int *src, long n);
-SCM_API SCM scm_c_longs2ivect (const long *src, long n);
-SCM_API SCM scm_c_ulongs2uvect (const unsigned long *src, long n);
-SCM_API SCM scm_c_floats2fvect (const float *src, long n);
-SCM_API SCM scm_c_doubles2dvect (const double *src, long n);
-
-#endif /* SCM_CONVERT_H */
diff --git a/libguile/convert.i.c b/libguile/convert.i.c
deleted file mode 100644
index 4e73bf970..000000000
--- a/libguile/convert.i.c
+++ /dev/null
@@ -1,171 +0,0 @@
-/* this file is #include'd (x times) by convert.c */
-
-/* You need to define the following macros before including this
-   template.  They are undefined at the end of this file to give a
-   clean slate for the next inclusion.
-
-   - CTYPE
-
-   The type of an element of the C array, for example 'char'.
-
-   - FROM_CTYPE
-
-   The function that converts a CTYPE to a SCM, for example
-   scm_from_char.
-
-   - UVEC_TAG
-
-   The tag of a suitable uniform vector that can hold the CTYPE, for
-   example 's8'.
-
-   - UVEC_CTYPE
-
-   The C type of an element of the uniform vector, for example
-   scm_t_int8.
-
-   - SCM2CTYPES
-
-   The name of the 'SCM-to-C' function, for example scm_c_scm2chars.
-
-   - CTYPES2SCM
-
-   The name of the 'C-to-SCM' function, for example, scm_c_chars2scm.
-
-   - CTYPES2UVECT
-
-   The name of the 'C-to-uniform-vector' function, for example
-   scm_c_chars2byvect.  It will create a uniform vector of kind
-   UVEC_TAG.
-
-   - CTYPES2UVECT_2
-
-   The name of a second 'C-to-uniform-vector' function.  Leave
-   undefined if you want only one such function.
-
-   - CTYPE_2
-   - UVEC_TAG_2
-   - UVEC_CTYPE_2
-
-   The tag and C type of the second kind of uniform vector, for use
-   with the function described above.
-
-*/
-
-/* The first level does not expand macros in the arguments. */
-#define paste(a1,a2,a3)   a1##a2##a3
-#define stringify(a)      #a
-
-/* But the second level does. */
-#define F(pre,T,suf)   paste(pre,T,suf)
-#define S(T)           stringify(T)
-
-/* Convert a vector, list or uniform vector into a C array.  If the
-   result array in argument 2 is NULL, malloc() a new one.
-*/
-
-CTYPE *
-SCM2CTYPES (SCM obj, CTYPE *data)
-{
-  scm_t_array_handle handle;
-  size_t i, len;
-  ssize_t inc;
-  const UVEC_CTYPE *uvec_elements;
-
-  obj = F(scm_any_to_,UVEC_TAG,vector) (obj);
-  uvec_elements = F(scm_,UVEC_TAG,vector_elements) (obj, &handle, &len, &inc);
-
-  if (data == NULL)
-    data = scm_malloc (len * sizeof (CTYPE));
-  for (i = 0; i < len; i++, uvec_elements += inc)
-    data[i] = uvec_elements[i];
-
-  scm_array_handle_release (&handle);
-
-  return data;
-}
-
-/* Converts a C array into a vector. */
-
-SCM
-CTYPES2SCM (const CTYPE *data, long n)
-{
-  long i;
-  SCM v;
-  
-  v = scm_c_make_vector (n, SCM_UNSPECIFIED);
-
-  for (i = 0; i < n; i++)
-    SCM_SIMPLE_VECTOR_SET (v, i, FROM_CTYPE (data[i]));
-
-  return v;
-}
-
-/* Converts a C array into a uniform vector. */
-
-SCM
-CTYPES2UVECT (const CTYPE *data, long n)
-{
-  scm_t_array_handle handle;
-  long i;
-  SCM uvec;
-  UVEC_CTYPE *uvec_elements;
-  
-  uvec = F(scm_make_,UVEC_TAG,vector) (scm_from_long (n), SCM_UNDEFINED);
-  uvec_elements = F(scm_,UVEC_TAG,vector_writable_elements) (uvec, &handle,
-							     NULL, NULL);
-  for (i = 0; i < n; i++)
-    uvec_elements[i] = data[i];
-
-  scm_array_handle_release (&handle);
-
-  return uvec;
-}
-
-#ifdef CTYPE2UVECT_2
-
-SCM
-CTYPES2UVECT_2 (const CTYPE_2 *data, long n)
-{
-  scm_t_array_handle handle;
-  long i;
-  SCM uvec;
-  UVEC_CTYPE_2 *uvec_elements;
-  
-  uvec = F(scm_make_,UVEC_TAG_2,vector) (scm_from_long (n), SCM_UNDEFINED);
-  uvec_elements = F(scm_,UVEC_TAG_2,vector_writable_elements) (uvec, &handle,
-							       NULL, NULL);
-
-  for (i = 0; i < n; i++)
-    uvec_elements[i] = data[i];
-
-  scm_array_handle_release (&handle);
-
-  return uvec;
-}
-
-#endif
-
-#undef paste
-#undef stringify
-#undef F
-#undef S
-
-#undef CTYPE
-#undef FROM_CTYPE
-#undef UVEC_TAG
-#undef UVEC_CTYPE
-#undef SCM2CTYPES
-#undef CTYPES2SCM
-#undef CTYPES2UVECT
-#ifdef CTYPES2UVECT_2
-#undef CTYPES2UVECT_2
-#undef CTYPE_2
-#undef UVEC_TAG_2
-#undef UVEC_CTYPE_2
-#endif
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/debug-malloc.c b/libguile/debug-malloc.c
index 4d04df5db..fa3612de2 100644
--- a/libguile/debug-malloc.c
+++ b/libguile/debug-malloc.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 2000, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 #ifdef HAVE_CONFIG_H
diff --git a/libguile/debug-malloc.h b/libguile/debug-malloc.h
index 1aa5221c6..7830adbac 100644
--- a/libguile/debug-malloc.h
+++ b/libguile/debug-malloc.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 2000,2001, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/debug.c b/libguile/debug.c
index a8ccdf8d3..5b42dddd9 100644
--- a/libguile/debug.c
+++ b/libguile/debug.c
@@ -2,18 +2,19 @@
  * Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006, 2008, 2009 Free Software Foundation
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -21,6 +22,11 @@
 # include <config.h>
 #endif
 
+#ifdef HAVE_GETRLIMIT
+#include <sys/time.h>
+#include <sys/resource.h>
+#endif
+
 #include "libguile/_scm.h"
 #include "libguile/async.h"
 #include "libguile/eval.h"
@@ -42,6 +48,7 @@
 #include "libguile/root.h"
 #include "libguile/fluids.h"
 #include "libguile/objects.h"
+#include "libguile/programs.h"
 
 #include "libguile/validate.h"
 #include "libguile/debug.h"
@@ -72,7 +79,9 @@ SCM_DEFINE (scm_debug_options, "debug-options-interface", 0, 1, 0,
       SCM_OUT_OF_RANGE (1, setting);
     }
   SCM_RESET_DEBUG_MODE;
+#ifdef STACK_CHECKING
   scm_stack_checking_enabled_p = SCM_STACK_CHECKING_P;
+#endif
   scm_debug_eframe_size = 2 * SCM_N_FRAMES;
 
   scm_dynwind_end ();
@@ -300,7 +309,7 @@ SCM_DEFINE (scm_procedure_name, "procedure-name", 1, 0, 0,
   SCM_VALIDATE_PROC (1, proc);
   switch (SCM_TYP7 (proc)) {
   case scm_tcs_subrs:
-    return SCM_SNAME (proc);
+    return SCM_SUBR_NAME (proc);
   default:
     {
       SCM name = scm_procedure_property (proc, scm_sym_name);
@@ -312,6 +321,8 @@ SCM_DEFINE (scm_procedure_name, "procedure-name", 1, 0, 0,
 #endif
       if (scm_is_false (name) && SCM_CLOSUREP (proc))
 	name = scm_reverse_lookup (SCM_ENV (proc), proc);
+      if (scm_is_false (name) && SCM_PROGRAM_P (proc))
+        name = scm_program_name (proc);
       return name;
     }
   }
@@ -352,6 +363,7 @@ SCM_DEFINE (scm_procedure_source, "procedure-source", 1, 0, 0,
     if (!SCM_SMOB_DESCRIPTOR (proc).apply)
       break;
   case scm_tcs_subrs:
+  case scm_tc7_program:
   procprop:
     /* It would indeed be a nice thing if we supplied source even for
        built in procedures! */
@@ -390,6 +402,21 @@ SCM_DEFINE (scm_procedure_environment, "procedure-environment", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (scm_procedure_module, "procedure-module", 1, 0, 0, 
+           (SCM proc),
+	    "Return the module that was current when @var{proc} was defined.")
+#define FUNC_NAME s_scm_procedure_module
+{
+  SCM_VALIDATE_PROC (SCM_ARG1, proc);
+
+  if (scm_is_true (scm_program_p (proc)))
+    return scm_program_module (proc);
+  else
+    return scm_env_module (scm_procedure_environment (proc));
+}
+#undef FUNC_NAME
+
+
 
 
 /* Eval in a local environment.  We would like to have the ability to
@@ -440,8 +467,10 @@ scm_reverse_lookup (SCM env, SCM data)
   return SCM_BOOL_F;
 }
 
-SCM
-scm_start_stack (SCM id, SCM exp, SCM env)
+SCM_DEFINE (scm_sys_start_stack, "%start-stack", 2, 0, 0,
+            (SCM id, SCM thunk),
+	    "Call @var{thunk} on an evaluator stack tagged with @var{id}.")
+#define FUNC_NAME s_scm_sys_start_stack
 {
   SCM answer;
   scm_t_debug_frame vframe;
@@ -451,27 +480,12 @@ scm_start_stack (SCM id, SCM exp, SCM env)
   vframe.vect = &vframe_vect_body;
   vframe.vect[0].id = id;
   scm_i_set_last_debug_frame (&vframe);
-  answer = scm_i_eval (exp, env);
+  answer = scm_call_0 (thunk);
   scm_i_set_last_debug_frame (vframe.prev);
   return answer;
 }
-
-SCM_SYNTAX(s_start_stack, "start-stack", scm_makacro, scm_m_start_stack);
-
-static SCM
-scm_m_start_stack (SCM exp, SCM env)
-#define FUNC_NAME s_start_stack
-{
-  exp = SCM_CDR (exp);
-  if (!scm_is_pair (exp) 
-      || !scm_is_pair (SCM_CDR (exp))
-      || !scm_is_null (SCM_CDDR (exp)))
-    SCM_WRONG_NUM_ARGS ();
-  return scm_start_stack (scm_eval_car (exp, env), SCM_CADR (exp), env);
-}
 #undef FUNC_NAME
 
-
 /* {Debug Objects}
  *
  * The debugging evaluator throws these on frame traps.
@@ -521,11 +535,32 @@ SCM_DEFINE (scm_debug_hang, "debug-hang", 0, 1, 0,
 #undef FUNC_NAME
 #endif
 
+static void
+init_stack_limit (void)
+{
+#ifdef HAVE_GETRLIMIT
+  struct rlimit lim;
+  if (getrlimit (RLIMIT_STACK, &lim) == 0)
+      {
+        rlim_t bytes = lim.rlim_cur;
+
+        /* set our internal stack limit to 80% of the rlimit. */
+        if (bytes == RLIM_INFINITY)
+          bytes = lim.rlim_max;
+
+        if (bytes != RLIM_INFINITY)
+          SCM_STACK_LIMIT = bytes * 8 / 10 / sizeof (scm_t_bits);
+      }
+  errno = 0;
+#endif
+}
+
 
 
 void
 scm_init_debug ()
 {
+  init_stack_limit ();
   scm_init_opts (scm_debug_options, scm_debug_opts);
 
   scm_tc16_memoized = scm_make_smob_type ("memoized", 0);
diff --git a/libguile/debug.h b/libguile/debug.h
index 607716230..20febdb71 100644
--- a/libguile/debug.h
+++ b/libguile/debug.h
@@ -7,18 +7,19 @@
  * Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -138,8 +139,9 @@ SCM_API scm_t_bits scm_tc16_memoized;
 SCM_API SCM scm_debug_object_p (SCM obj);
 SCM_API SCM scm_local_eval (SCM exp, SCM env);
 SCM_API SCM scm_reverse_lookup (SCM env, SCM data);
-SCM_API SCM scm_start_stack (SCM info_id, SCM exp, SCM env);
+SCM_API SCM scm_sys_start_stack (SCM info_id, SCM thunk);
 SCM_API SCM scm_procedure_environment (SCM proc);
+SCM_API SCM scm_procedure_module (SCM proc);
 SCM_API SCM scm_procedure_source (SCM proc);
 SCM_API SCM scm_procedure_name (SCM proc);
 SCM_API SCM scm_memoized_environment (SCM m);
diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index 979de84e1..d0669969c 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -2,21 +2,22 @@
    deprecate something, move it here when that is feasible.
 */
 
-/* Copyright (C) 2003, 2004, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 2003, 2004, 2006, 2008, 2009 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 #ifdef HAVE_CONFIG_H
@@ -33,6 +34,7 @@
 #include "libguile/strings.h"
 #include "libguile/srfi-13.h"
 #include "libguile/modules.h"
+#include "libguile/generalized-arrays.h"
 #include "libguile/eval.h"
 #include "libguile/smob.h"
 #include "libguile/procprop.h"
@@ -748,17 +750,13 @@ scm_sym2ovcell (SCM sym, SCM obarray)
    return (SYMBOL . SCM_UNDEFINED).  */
 
 
-SCM 
-scm_intern_obarray_soft (const char *name,size_t len,SCM obarray,unsigned int softness)
+static SCM 
+intern_obarray_soft (SCM symbol, SCM obarray, unsigned int softness)
 {
-  SCM symbol = scm_from_locale_symboln (name, len);
   size_t raw_hash = scm_i_symbol_hash (symbol);
   size_t hash;
   SCM lsym;
 
-  scm_c_issue_deprecation_warning ("`scm_intern_obarray_soft' is deprecated. "
-				   "Use hashtables instead.");
-
   if (scm_is_false (obarray))
     {
       if (softness)
@@ -794,6 +792,18 @@ scm_intern_obarray_soft (const char *name,size_t len,SCM obarray,unsigned int so
 }
 
 
+SCM 
+scm_intern_obarray_soft (const char *name, size_t len, SCM obarray,
+                         unsigned int softness)
+{
+  SCM symbol = scm_from_locale_symboln (name, len);
+
+  scm_c_issue_deprecation_warning ("`scm_intern_obarray_soft' is deprecated. "
+				   "Use hashtables instead.");
+
+  return intern_obarray_soft (symbol, obarray, softness);
+}
+  
 SCM
 scm_intern_obarray (const char *name,size_t len,SCM obarray)
 {
@@ -849,10 +859,7 @@ SCM_DEFINE (scm_string_to_obarray_symbol, "string->obarray-symbol", 2, 1, 0,
   else if (scm_is_eq (o, SCM_BOOL_T))
     o = SCM_BOOL_F;
     
-  vcell = scm_intern_obarray_soft (scm_i_string_chars (s),
-				   scm_i_string_length (s),
-				   o,
-				   softness);
+  vcell = intern_obarray_soft (scm_string_to_symbol (s), o, softness);
   if (scm_is_false (vcell))
     return vcell;
   answer = SCM_CAR (vcell);
@@ -1069,7 +1076,8 @@ SCM_DEFINE (scm_gentemp, "gentemp", 0, 2, 0,
 {
   char buf[MAX_PREFIX_LENGTH + SCM_INTBUFLEN];
   char *name = buf;
-  int len, n_digits;
+  int n_digits;
+  size_t len;
 
   scm_c_issue_deprecation_warning ("`gentemp' is deprecated. "
 				   "Use `gensym' instead.");
@@ -1083,9 +1091,8 @@ SCM_DEFINE (scm_gentemp, "gentemp", 0, 2, 0,
     {
       SCM_VALIDATE_STRING (1, prefix);
       len = scm_i_string_length (prefix);
-      if (len > MAX_PREFIX_LENGTH)
-	name = SCM_MUST_MALLOC (MAX_PREFIX_LENGTH + SCM_INTBUFLEN);
-      strncpy (name, scm_i_string_chars (prefix), len);
+      name = scm_to_locale_stringn (prefix, &len);
+      name = scm_realloc (name, len + SCM_INTBUFLEN);
     }
 
   if (SCM_UNBNDP (obarray))
@@ -1107,7 +1114,7 @@ SCM_DEFINE (scm_gentemp, "gentemp", 0, 2, 0,
 					 obarray,
 					 0);
     if (name != buf)
-      scm_must_free (name);
+      free (name);
     return SCM_CAR (vcell);
   }
 }
@@ -1308,7 +1315,7 @@ scm_i_arrayp (SCM a)
 {
   scm_c_issue_deprecation_warning
     ("SCM_ARRAYP is deprecated.  Use scm_is_array instead.");
-  return SCM_I_ARRAYP(a) || SCM_I_ENCLOSED_ARRAYP(a);
+  return SCM_I_ARRAYP(a);
 }
 
 size_t
@@ -1496,6 +1503,29 @@ SCM_DEFINE (scm_destroy_guardian_x, "destroy-guardian!", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+
+/* GC-related things.  */
+
+unsigned long scm_mallocated, scm_mtrigger;
+size_t scm_max_segment_size;
+
+#if defined (GUILE_DEBUG) || defined (GUILE_DEBUG_FREELIST)
+SCM
+scm_map_free_list (void)
+{
+  return SCM_EOL;
+}
+#endif
+
+#if defined (GUILE_DEBUG_FREELIST)
+SCM
+scm_gc_set_debug_check_freelist_x (SCM flag)
+{
+  return SCM_UNSPECIFIED;
+}
+#endif
+
+
 void
 scm_i_init_deprecated ()
 {
diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index 9a0862c3e..f428f7de8 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -5,24 +5,26 @@
 #ifndef SCM_DEPRECATED_H
 #define SCM_DEPRECATED_H
 
-/* Copyright (C) 2003,2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+/* Copyright (C) 2003,2004, 2005, 2006, 2007, 2009 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 #include "libguile/__scm.h"
+#include "libguile/arrays.h"
 #include "libguile/strings.h"
 
 #if (SCM_ENABLE_DEPRECATED == 1)
@@ -116,8 +118,8 @@ SCM_API SCM scm_unprotect_object (SCM obj);
   (SCM_SETCDR ((x), SCM_PACK (SCM_UNPACK (SCM_CDR (x)) & (y))))
 #define SCM_SETOR_CDR(x, y)\
   (SCM_SETCDR ((x), SCM_PACK (SCM_UNPACK (SCM_CDR (x)) | (y))))
-#define SCM_FREEP(x) (SCM_FREE_CELL_P (x))
-#define SCM_NFREEP(x) (!SCM_FREE_CELL_P (x))
+#define SCM_FREEP(x) (0)
+#define SCM_NFREEP(x) (1)
 #define SCM_GC8MARKP(x) SCM_GC_MARK_P (x)
 #define SCM_SETGC8MARK(x) SCM_SET_GC_MARK (x)
 #define SCM_CLRGC8MARK(x) SCM_CLEAR_GC_MARK (x)
@@ -581,6 +583,25 @@ SCM_API SCM scm_destroy_guardian_x (SCM guardian);
 SCM_API SCM scm_guardian_greedy_p (SCM guardian);
 SCM_API SCM scm_guardian_destroyed_p (SCM guardian);
 
+
+/* GC-related things deprecated with the move to BDW-GC starting from 1.9.3
+   (2009-09-15).  */
+
+SCM_API unsigned long scm_mallocated;
+SCM_API unsigned long scm_mtrigger;
+
+SCM_API size_t scm_max_segment_size;
+
+#if defined (GUILE_DEBUG) || defined (GUILE_DEBUG_FREELIST)
+SCM_API SCM scm_map_free_list (void);
+#endif
+
+#if defined (GUILE_DEBUG_FREELIST)
+SCM_API SCM scm_gc_set_debug_check_freelist_x (SCM flag);
+#endif
+
+
+
 void scm_i_init_deprecated (void);
 
 #endif
diff --git a/libguile/deprecation.c b/libguile/deprecation.c
index 338c47c20..af8b93610 100644
--- a/libguile/deprecation.c
+++ b/libguile/deprecation.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 2001, 2006 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -41,8 +42,6 @@
 
 
 
-#if (SCM_ENABLE_DEPRECATED == 1)
-
 struct issued_warning {
   struct issued_warning *prev;
   const char *message;
@@ -138,8 +137,6 @@ print_deprecation_summary (void)
     }
 }
 
-#endif /* SCM_ENABLE_DEPRECATED == 1 */
-
 SCM_DEFINE(scm_include_deprecated_features,
 	   "include-deprecated-features", 0, 0, 0,
 	   (),
@@ -157,7 +154,6 @@ SCM_DEFINE(scm_include_deprecated_features,
 void
 scm_init_deprecation ()
 {
-#if (SCM_ENABLE_DEPRECATED == 1)
   const char *level = getenv ("GUILE_WARN_DEPRECATED");
   if (level == NULL)
     level = SCM_WARN_DEPRECATED_DEFAULT;
@@ -170,11 +166,11 @@ scm_init_deprecation ()
       SCM_WARN_DEPRECATED = 0;
       atexit (print_deprecation_summary);
     }
-#endif
 #include "libguile/deprecation.x"
 }
 
 /*
   Local Variables:
   c-file-style: "gnu"
-  End: */
+  End:
+ */
diff --git a/libguile/deprecation.h b/libguile/deprecation.h
index 78853277b..06027c694 100644
--- a/libguile/deprecation.h
+++ b/libguile/deprecation.h
@@ -3,21 +3,22 @@
 #ifndef SCM_DEPRECATION_H
 #define SCM_DEPRECATION_H
 
-/* Copyright (C) 2001, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2006, 2008, 2009 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -26,20 +27,14 @@
 
 
 
-#if (SCM_ENABLE_DEPRECATED == 1)
-
-/* These functions are _not_ deprecated, but we exclude them along
-   with the really deprecated features to be sure that no-one is
-   trying to emit deprecation warnings when libguile is supposed to be
-   clean of them.
-*/
+/* These functions are a possibly useful part of the API and not only used
+   internally, thus they are exported always, not depending on
+   SCM_ENABLE_DEPRECATED.  */
 
 SCM_API void scm_c_issue_deprecation_warning (const char *msg);
 SCM_API void scm_c_issue_deprecation_warning_fmt (const char *msg, ...);
 SCM_API SCM scm_issue_deprecation_warning (SCM msgs);
 
-#endif
-
 SCM_API SCM scm_include_deprecated_features (void);
 SCM_INTERNAL void scm_init_deprecation (void);
 
diff --git a/libguile/discouraged.c b/libguile/discouraged.c
index 9efd92a00..262142890 100644
--- a/libguile/discouraged.c
+++ b/libguile/discouraged.c
@@ -5,18 +5,19 @@
 /* Copyright (C) 2003, 2004, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 #ifdef HAVE_CONFIG_H
@@ -264,7 +265,7 @@ SCM_DEFINE (scm_make_keyword_from_dash_symbol, "make-keyword-from-dash-symbol",
   SCM dash_string, non_dash_symbol;
 
   SCM_ASSERT (scm_is_symbol (symbol)
-	      && ('-' == scm_i_symbol_chars(symbol)[0]),
+	      && (scm_i_symbol_ref (symbol, 0) == '-'),
 	      symbol, SCM_ARG1, FUNC_NAME);
 
   dash_string = scm_symbol_to_string (symbol);
diff --git a/libguile/discouraged.h b/libguile/discouraged.h
index 6e537bf1e..1be05f0bc 100644
--- a/libguile/discouraged.h
+++ b/libguile/discouraged.h
@@ -16,18 +16,19 @@
 /* Copyright (C) 2004, 2006 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 #include "libguile/__scm.h"
diff --git a/libguile/dynl.c b/libguile/dynl.c
index 1326b8bd4..dc98e7d17 100644
--- a/libguile/dynl.c
+++ b/libguile/dynl.c
@@ -4,18 +4,19 @@
  * 2003, 2008, 2009 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/dynl.h b/libguile/dynl.h
index 72dc92ea4..eb318ae98 100644
--- a/libguile/dynl.h
+++ b/libguile/dynl.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1996,1998,2000,2001, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/dynwind.c b/libguile/dynwind.c
index 39ff47f79..b34f9bef3 100644
--- a/libguile/dynwind.c
+++ b/libguile/dynwind.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2004, 2006, 2008 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -315,7 +316,7 @@ scm_i_dowinds (SCM to, long delta, void (*turn_func) (void *), void *data)
 		  if (SCM_VARIABLEP (SCM_CAR (wind_key)))
 		    scm_swap_bindings (wind_key, SCM_CDR (wind_elt));
 		}
-	      else if (SCM_TYP3 (wind_key) == scm_tc3_closure)
+	      else if (scm_is_true (scm_thunk_p (wind_key)))
 		scm_call_0 (wind_key);
 	    }
 	}
@@ -351,7 +352,7 @@ scm_i_dowinds (SCM to, long delta, void (*turn_func) (void *), void *data)
 		  if (SCM_VARIABLEP (SCM_CAR (wind_key)))
 		    scm_swap_bindings (wind_key, SCM_CDR (wind_elt));
 		}
-	      else if (SCM_TYP3 (wind_key) == scm_tc3_closure)
+	      else if (scm_is_true (scm_thunk_p (wind_key)))
 		scm_call_0 (SCM_CDR (wind_elt));
 	    }
 	}
diff --git a/libguile/dynwind.h b/libguile/dynwind.h
index dd39dae5a..b178bc429 100644
--- a/libguile/dynwind.h
+++ b/libguile/dynwind.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,1998,1999,2000,2003,2004, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/environments.c b/libguile/environments.c
index 78ccd286d..fd4b88300 100644
--- a/libguile/environments.c
+++ b/libguile/environments.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1999,2000,2001, 2003, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/environments.h b/libguile/environments.h
index 2d8765a38..143963254 100644
--- a/libguile/environments.h
+++ b/libguile/environments.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1999,2000, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/eq.c b/libguile/eq.c
index b54a7043a..fadd75620 100644
--- a/libguile/eq.c
+++ b/libguile/eq.c
@@ -1,18 +1,19 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001,2003, 2004, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001,2003, 2004, 2006, 2009 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -21,14 +22,15 @@
 #endif
 
 #include "libguile/_scm.h"
-#include "libguile/ramap.h"
+#include "libguile/array-map.h"
 #include "libguile/stackchk.h"
 #include "libguile/strorder.h"
 #include "libguile/async.h"
 #include "libguile/root.h"
 #include "libguile/smob.h"
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
 #include "libguile/vectors.h"
+#include "libguile/bytevectors.h"
 
 #include "libguile/struct.h"
 #include "libguile/goops.h"
@@ -238,6 +240,8 @@ SCM_PRIMITIVE_GENERIC_1 (scm_equal_p, "equal?", scm_tc7_rpsubr,
     }
   if (SCM_TYP7 (x) == scm_tc7_string && SCM_TYP7 (y) == scm_tc7_string)
     return scm_string_equal_p (x, y);
+  if (SCM_TYP7 (x) == scm_tc7_bytevector && SCM_TYP7 (y) == scm_tc7_bytevector)
+    return scm_bytevector_eq_p (x, y);
   if (SCM_TYP7 (x) == scm_tc7_smob && SCM_TYP16 (x) == SCM_TYP16 (y))
     {
       int i = SCM_SMOBNUM (x);
diff --git a/libguile/eq.h b/libguile/eq.h
index af6959fe8..1aeb1c496 100644
--- a/libguile/eq.h
+++ b/libguile/eq.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,2000, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/error.c b/libguile/error.c
index e18db9e82..bcbcd9cd1 100644
--- a/libguile/error.c
+++ b/libguile/error.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1995,1996,1997,1998,2000,2001, 2004, 2006 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -232,6 +233,19 @@ scm_wrong_type_arg (const char *subr, int pos, SCM bad_value)
 }
 
 void
+scm_i_wrong_type_arg_symbol (SCM symbol, int pos, SCM bad_value)
+{
+  scm_error_scm (scm_arg_type_key,
+		 scm_symbol_to_string (symbol),
+		 (pos == 0) ? scm_from_locale_string ("Wrong type: ~S")
+		 : scm_from_locale_string ("Wrong type argument in position ~A: ~S"),
+		 (pos == 0) ? scm_list_1 (bad_value)
+		 : scm_list_2 (scm_from_int (pos), bad_value),
+		 scm_list_1 (bad_value));
+  scm_remember_upto_here_2 (symbol, bad_value);
+}
+
+void
 scm_wrong_type_arg_msg (const char *subr, int pos, SCM bad_value, const char *szMessage)
 {
   SCM msg = scm_from_locale_string (szMessage);
diff --git a/libguile/error.h b/libguile/error.h
index 042fb4d14..8cc68b752 100644
--- a/libguile/error.h
+++ b/libguile/error.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -52,6 +53,8 @@ SCM_API void scm_wrong_num_args (SCM proc) SCM_NORETURN;
 SCM_API void scm_error_num_args_subr (const char* subr) SCM_NORETURN;
 SCM_API void scm_wrong_type_arg (const char *subr, int pos,
 				 SCM bad_value) SCM_NORETURN;
+SCM_INTERNAL void scm_i_wrong_type_arg_symbol (SCM symbol, int pos,
+					       SCM bad_value) SCM_NORETURN;
 SCM_API void scm_wrong_type_arg_msg (const char *subr, int pos,
 				     SCM bad_value, const char *sz) SCM_NORETURN;
 SCM_API void scm_memory_error (const char *subr) SCM_NORETURN;
diff --git a/libguile/eval.c b/libguile/eval.c
index 18cd3b11f..e58c05410 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -2,18 +2,19 @@
  * Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -52,6 +53,7 @@
 #include "libguile/ports.h"
 #include "libguile/print.h"
 #include "libguile/procprop.h"
+#include "libguile/programs.h"
 #include "libguile/root.h"
 #include "libguile/smob.h"
 #include "libguile/srcprop.h"
@@ -62,6 +64,7 @@
 #include "libguile/validate.h"
 #include "libguile/values.h"
 #include "libguile/vectors.h"
+#include "libguile/vm.h"
 
 #include "libguile/eval.h"
 #include "libguile/private-options.h"
@@ -304,6 +307,9 @@ syntax_error (const char* const msg, const SCM form, const SCM expr)
   { if (SCM_UNLIKELY (!(cond)))			\
       syntax_error (message, form, expr); }
 
+static void error_unbound_variable (SCM symbol) SCM_NORETURN;
+static void error_defined_variable (SCM symbol) SCM_NORETURN;
+
 
 
 /* {Ilocs}
@@ -704,6 +710,101 @@ is_system_macro_p (const SCM syntactic_keyword, const SCM form, const SCM env)
   return 0;
 }
 
+static SCM
+macroexp (SCM x, SCM env)
+{
+  SCM res, proc, orig_sym;
+
+  /* Don't bother to produce error messages here.  We get them when we
+     eventually execute the code for real. */
+
+ macro_tail:
+  orig_sym = SCM_CAR (x);
+  if (!scm_is_symbol (orig_sym))
+    return x;
+
+  {
+    SCM *proc_ptr = scm_lookupcar1 (x, env, 0);
+    if (proc_ptr == NULL)
+      {
+	/* We have lost the race. */
+	goto macro_tail;
+      }
+    proc = *proc_ptr;
+  }
+  
+  /* Only handle memoizing macros.  `Acros' and `macros' are really
+     special forms and should not be evaluated here. */
+
+  if (!SCM_MACROP (proc)
+      || (SCM_MACRO_TYPE (proc) != 2 && !SCM_BUILTIN_MACRO_P (proc)))
+    return x;
+
+  SCM_SETCAR (x, orig_sym);  /* Undo memoizing effect of lookupcar */
+  res = scm_call_2 (SCM_MACRO_CODE (proc), x, env);
+
+  if (scm_ilength (res) <= 0)
+    /* Result of expansion is not a list.  */
+    return (scm_list_2 (SCM_IM_BEGIN, res));
+  else
+    {
+      /* njrev: Several queries here: (1) I don't see how it can be
+	 correct that the SCM_SETCAR 2 lines below this comment needs
+	 protection, but the SCM_SETCAR 6 lines above does not, so
+	 something here is probably wrong.  (2) macroexp() is now only
+	 used in one place - scm_m_generalized_set_x - whereas all other
+	 macro expansion happens through expand_user_macros.  Therefore
+	 (2.1) perhaps macroexp() could be eliminated completely now?
+	 (2.2) Does expand_user_macros need any critical section
+	 protection? */
+
+      SCM_CRITICAL_SECTION_START;
+      SCM_SETCAR (x, SCM_CAR (res));
+      SCM_SETCDR (x, SCM_CDR (res));
+      SCM_CRITICAL_SECTION_END;
+
+      goto macro_tail;
+    }
+}
+
+
+/* Start of the memoizers for the standard R5RS builtin macros.  */
+
+static SCM scm_m_quote (SCM xorig, SCM env);
+static SCM scm_m_begin (SCM xorig, SCM env);
+static SCM scm_m_if (SCM xorig, SCM env);
+static SCM scm_m_set_x (SCM xorig, SCM env);
+static SCM scm_m_and (SCM xorig, SCM env);
+static SCM scm_m_or (SCM xorig, SCM env);
+static SCM scm_m_case (SCM xorig, SCM env);
+static SCM scm_m_cond (SCM xorig, SCM env);
+static SCM scm_m_lambda (SCM xorig, SCM env);
+static SCM scm_m_letstar (SCM xorig, SCM env);
+static SCM scm_m_do (SCM xorig, SCM env);
+static SCM scm_m_quasiquote (SCM xorig, SCM env);
+static SCM scm_m_delay (SCM xorig, SCM env);
+static SCM scm_m_generalized_set_x (SCM xorig, SCM env);
+#if 0  /* Futures are disabled, see "futures.h".  */
+static SCM scm_m_future (SCM xorig, SCM env);
+#endif
+static SCM scm_m_define (SCM x, SCM env);
+static SCM scm_m_letrec (SCM xorig, SCM env);
+static SCM scm_m_let (SCM xorig, SCM env);
+static SCM scm_m_at (SCM xorig, SCM env);
+static SCM scm_m_atat (SCM xorig, SCM env);
+static SCM scm_m_atslot_ref (SCM xorig, SCM env);
+static SCM scm_m_atslot_set_x (SCM xorig, SCM env);
+static SCM scm_m_apply (SCM xorig, SCM env);
+static SCM scm_m_cont (SCM xorig, SCM env);
+#if SCM_ENABLE_ELISP
+static SCM scm_m_nil_cond (SCM xorig, SCM env);
+static SCM scm_m_atfop (SCM xorig, SCM env);
+#endif /* SCM_ENABLE_ELISP */
+static SCM scm_m_atbind (SCM xorig, SCM env);
+static SCM scm_m_at_call_with_values (SCM xorig, SCM env);
+static SCM scm_m_eval_when (SCM xorig, SCM env);
+
+
 static void
 m_expand_body (const SCM forms, const SCM env)
 {
@@ -826,70 +927,10 @@ m_expand_body (const SCM forms, const SCM env)
     }
 }
 
-static SCM
-macroexp (SCM x, SCM env)
-{
-  SCM res, proc, orig_sym;
-
-  /* Don't bother to produce error messages here.  We get them when we
-     eventually execute the code for real. */
-
- macro_tail:
-  orig_sym = SCM_CAR (x);
-  if (!scm_is_symbol (orig_sym))
-    return x;
-
-  {
-    SCM *proc_ptr = scm_lookupcar1 (x, env, 0);
-    if (proc_ptr == NULL)
-      {
-	/* We have lost the race. */
-	goto macro_tail;
-      }
-    proc = *proc_ptr;
-  }
-  
-  /* Only handle memoizing macros.  `Acros' and `macros' are really
-     special forms and should not be evaluated here. */
-
-  if (!SCM_MACROP (proc)
-      || (SCM_MACRO_TYPE (proc) != 2 && !SCM_BUILTIN_MACRO_P (proc)))
-    return x;
-
-  SCM_SETCAR (x, orig_sym);  /* Undo memoizing effect of lookupcar */
-  res = scm_call_2 (SCM_MACRO_CODE (proc), x, env);
-
-  if (scm_ilength (res) <= 0)
-    /* Result of expansion is not a list.  */
-    return (scm_list_2 (SCM_IM_BEGIN, res));
-  else
-    {
-      /* njrev: Several queries here: (1) I don't see how it can be
-	 correct that the SCM_SETCAR 2 lines below this comment needs
-	 protection, but the SCM_SETCAR 6 lines above does not, so
-	 something here is probably wrong.  (2) macroexp() is now only
-	 used in one place - scm_m_generalized_set_x - whereas all other
-	 macro expansion happens through expand_user_macros.  Therefore
-	 (2.1) perhaps macroexp() could be eliminated completely now?
-	 (2.2) Does expand_user_macros need any critical section
-	 protection? */
-
-      SCM_CRITICAL_SECTION_START;
-      SCM_SETCAR (x, SCM_CAR (res));
-      SCM_SETCDR (x, SCM_CDR (res));
-      SCM_CRITICAL_SECTION_END;
-
-      goto macro_tail;
-    }
-}
-
-/* Start of the memoizers for the standard R5RS builtin macros.  */
-
-
 SCM_SYNTAX (s_and, "and", scm_i_makbimacro, scm_m_and);
-SCM_GLOBAL_SYMBOL (scm_sym_and, s_and);
+SCM_GLOBAL_SYMBOL (scm_sym_and, "and");
 
-SCM
+static SCM
 scm_m_and (SCM expr, SCM env SCM_UNUSED)
 {
   const SCM cdr_expr = SCM_CDR (expr);
@@ -917,9 +958,9 @@ unmemoize_and (const SCM expr, const SCM env)
 
 
 SCM_SYNTAX (s_begin, "begin", scm_i_makbimacro, scm_m_begin);
-SCM_GLOBAL_SYMBOL (scm_sym_begin, s_begin);
+SCM_GLOBAL_SYMBOL (scm_sym_begin, "begin");
 
-SCM
+static SCM
 scm_m_begin (SCM expr, SCM env SCM_UNUSED)
 {
   const SCM cdr_expr = SCM_CDR (expr);
@@ -940,10 +981,10 @@ unmemoize_begin (const SCM expr, const SCM env)
 
 
 SCM_SYNTAX (s_case, "case", scm_i_makbimacro, scm_m_case);
-SCM_GLOBAL_SYMBOL (scm_sym_case, s_case);
+SCM_GLOBAL_SYMBOL (scm_sym_case, "case");
 SCM_GLOBAL_SYMBOL (scm_sym_else, "else");
 
-SCM
+static SCM
 scm_m_case (SCM expr, SCM env)
 {
   SCM clauses;
@@ -1036,10 +1077,10 @@ unmemoize_case (const SCM expr, const SCM env)
 
 
 SCM_SYNTAX (s_cond, "cond", scm_i_makbimacro, scm_m_cond);
-SCM_GLOBAL_SYMBOL (scm_sym_cond, s_cond);
+SCM_GLOBAL_SYMBOL (scm_sym_cond, "cond");
 SCM_GLOBAL_SYMBOL (scm_sym_arrow, "=>");
 
-SCM
+static SCM
 scm_m_cond (SCM expr, SCM env)
 {
   /* Check, whether 'else or '=> is a literal, i. e. not bound to a value. */
@@ -1139,7 +1180,7 @@ unmemoize_cond (const SCM expr, const SCM env)
 
 
 SCM_SYNTAX (s_define, "define", scm_i_makbimacro, scm_m_define);
-SCM_GLOBAL_SYMBOL (scm_sym_define, s_define);
+SCM_GLOBAL_SYMBOL (scm_sym_define, "define");
 
 /* Guile provides an extension to R5RS' define syntax to represent function
  * currying in a compact way.  With this extension, it is allowed to write
@@ -1201,7 +1242,7 @@ canonicalize_define (const SCM expr)
    operation.  However, EXPRESSION _can_ be evaluated before VARIABLE is
    bound.  This means that EXPRESSION won't necessarily be able to assign
    values to VARIABLE as in `(define foo (begin (set! foo 1) (+ foo 1)))'.  */
-SCM
+static SCM
 scm_m_define (SCM expr, SCM env)
 {
   ASSERT_SYNTAX (SCM_TOP_LEVEL (env), s_bad_define, expr);
@@ -1250,13 +1291,13 @@ memoize_as_thunk_prototype (const SCM expr, const SCM env SCM_UNUSED)
 
 
 SCM_SYNTAX (s_delay, "delay", scm_i_makbimacro, scm_m_delay);
-SCM_GLOBAL_SYMBOL (scm_sym_delay, s_delay);
+SCM_GLOBAL_SYMBOL (scm_sym_delay, "delay");
 
 /* Promises are implemented as closures with an empty parameter list.  Thus,
  * (delay <expression>) is transformed into (#@delay '() <expression>), where
  * the empty list represents the empty parameter list.  This representation
  * allows for easy creation of the closure during evaluation.  */
-SCM
+static SCM
 scm_m_delay (SCM expr, SCM env)
 {
   const SCM new_expr = memoize_as_thunk_prototype (expr, env);
@@ -1279,7 +1320,7 @@ unmemoize_delay (const SCM expr, const SCM env)
 
 
 SCM_SYNTAX(s_do, "do", scm_i_makbimacro, scm_m_do);
-SCM_GLOBAL_SYMBOL(scm_sym_do, s_do);
+SCM_GLOBAL_SYMBOL(scm_sym_do, "do");
 
 /* DO gets the most radically altered syntax.  The order of the vars is
  * reversed here.  During the evaluation this allows for simple consing of the
@@ -1299,7 +1340,7 @@ SCM_GLOBAL_SYMBOL(scm_sym_do, s_do);
          (<body>)
      <step1> <step2> ... <stepn>) ;; missing steps replaced by var
  */
-SCM 
+static SCM
 scm_m_do (SCM expr, SCM env SCM_UNUSED)
 {
   SCM variables = SCM_EOL;
@@ -1395,9 +1436,9 @@ unmemoize_do (const SCM expr, const SCM env)
 
 
 SCM_SYNTAX (s_if, "if", scm_i_makbimacro, scm_m_if);
-SCM_GLOBAL_SYMBOL (scm_sym_if, s_if);
+SCM_GLOBAL_SYMBOL (scm_sym_if, "if");
 
-SCM
+static SCM
 scm_m_if (SCM expr, SCM env SCM_UNUSED)
 {
   const SCM cdr_expr = SCM_CDR (expr);
@@ -1429,7 +1470,7 @@ unmemoize_if (const SCM expr, const SCM env)
 
 
 SCM_SYNTAX (s_lambda, "lambda", scm_i_makbimacro, scm_m_lambda);
-SCM_GLOBAL_SYMBOL (scm_sym_lambda, s_lambda);
+SCM_GLOBAL_SYMBOL (scm_sym_lambda, "lambda");
 
 /* A helper function for memoize_lambda to support checking for duplicate
  * formal arguments: Return true if OBJ is `eq?' to one of the elements of
@@ -1447,7 +1488,7 @@ c_improper_memq (SCM obj, SCM list)
   return scm_is_eq (list, obj);
 }
 
-SCM
+static SCM
 scm_m_lambda (SCM expr, SCM env SCM_UNUSED)
 {
   SCM formals;
@@ -1577,7 +1618,7 @@ transform_bindings (
 
 
 SCM_SYNTAX(s_let, "let", scm_i_makbimacro, scm_m_let);
-SCM_GLOBAL_SYMBOL(scm_sym_let, s_let);
+SCM_GLOBAL_SYMBOL(scm_sym_let, "let");
 
 /* This function is a helper function for memoize_let.  It transforms
  * (let name ((var init) ...) body ...) into
@@ -1617,7 +1658,7 @@ memoize_named_let (const SCM expr, const SCM env SCM_UNUSED)
 
 /* (let ((v1 i1) (v2 i2) ...) body) with variables v1 .. vn and initializers
  * i1 .. in is transformed to (#@let (vn ... v2 v1) (i1 i2 ...) body).  */
-SCM
+static SCM
 scm_m_let (SCM expr, SCM env)
 {
   SCM bindings;
@@ -1689,9 +1730,9 @@ unmemoize_let (const SCM expr, const SCM env)
 
 
 SCM_SYNTAX(s_letrec, "letrec", scm_i_makbimacro, scm_m_letrec);
-SCM_GLOBAL_SYMBOL(scm_sym_letrec, s_letrec);
+SCM_GLOBAL_SYMBOL(scm_sym_letrec, "letrec");
 
-SCM 
+static SCM
 scm_m_letrec (SCM expr, SCM env)
 {
   SCM bindings;
@@ -1738,11 +1779,11 @@ unmemoize_letrec (const SCM expr, const SCM env)
 
 
 SCM_SYNTAX (s_letstar, "let*", scm_i_makbimacro, scm_m_letstar);
-SCM_GLOBAL_SYMBOL (scm_sym_letstar, s_letstar);
+SCM_GLOBAL_SYMBOL (scm_sym_letstar, "let*");
 
 /* (let* ((v1 i1) (v2 i2) ...) body) with variables v1 .. vn and initializers
  * i1 .. in is transformed into the form (#@let* (v1 i1 v2 i2 ...) body).  */
-SCM
+static SCM
 scm_m_letstar (SCM expr, SCM env SCM_UNUSED)
 {
   SCM binding_idx;
@@ -1813,9 +1854,9 @@ unmemoize_letstar (const SCM expr, const SCM env)
 
 
 SCM_SYNTAX (s_or, "or", scm_i_makbimacro, scm_m_or);
-SCM_GLOBAL_SYMBOL (scm_sym_or, s_or);
+SCM_GLOBAL_SYMBOL (scm_sym_or, "or");
 
-SCM
+static SCM
 scm_m_or (SCM expr, SCM env SCM_UNUSED)
 {
   const SCM cdr_expr = SCM_CDR (expr);
@@ -1843,7 +1884,7 @@ unmemoize_or (const SCM expr, const SCM env)
 
 
 SCM_SYNTAX (s_quasiquote, "quasiquote", scm_makacro, scm_m_quasiquote);
-SCM_GLOBAL_SYMBOL (scm_sym_quasiquote, s_quasiquote);
+SCM_GLOBAL_SYMBOL (scm_sym_quasiquote, "quasiquote");
 SCM_GLOBAL_SYMBOL (scm_sym_unquote, "unquote");
 SCM_GLOBAL_SYMBOL (scm_sym_uq_splicing, "unquote-splicing");
 
@@ -1899,7 +1940,7 @@ iqq (SCM form, SCM env, unsigned long int depth)
     return form;
 }
 
-SCM 
+static SCM
 scm_m_quasiquote (SCM expr, SCM env)
 {
   const SCM cdr_expr = SCM_CDR (expr);
@@ -1910,9 +1951,9 @@ scm_m_quasiquote (SCM expr, SCM env)
 
 
 SCM_SYNTAX (s_quote, "quote", scm_i_makbimacro, scm_m_quote);
-SCM_GLOBAL_SYMBOL (scm_sym_quote, s_quote);
+SCM_GLOBAL_SYMBOL (scm_sym_quote, "quote");
 
-SCM
+static SCM
 scm_m_quote (SCM expr, SCM env SCM_UNUSED)
 {
   SCM quotee;
@@ -1938,10 +1979,9 @@ unmemoize_quote (const SCM expr, const SCM env SCM_UNUSED)
 
 /* Will go into the RnRS module when Guile is factorized.
 SCM_SYNTAX (s_set_x, "set!", scm_i_makbimacro, scm_m_set_x); */
-static const char s_set_x[] = "set!";
-SCM_GLOBAL_SYMBOL (scm_sym_set_x, s_set_x);
+SCM_GLOBAL_SYMBOL (scm_sym_set_x, "set!");
 
-SCM
+static SCM
 scm_m_set_x (SCM expr, SCM env SCM_UNUSED)
 {
   SCM variable;
@@ -1971,14 +2011,57 @@ unmemoize_set_x (const SCM expr, const SCM env)
 }
 
 
+
 /* Start of the memoizers for non-R5RS builtin macros.  */
 
 
+SCM_SYNTAX (s_at, "@", scm_makmmacro, scm_m_at);
+SCM_GLOBAL_SYMBOL (scm_sym_at, "@");
+
+static SCM
+scm_m_at (SCM expr, SCM env SCM_UNUSED)
+{
+  SCM mod, var;
+  ASSERT_SYNTAX (scm_ilength (expr) == 3, s_bad_expression, expr);
+  ASSERT_SYNTAX (scm_ilength (scm_cadr (expr)) > 0, s_bad_expression, expr);
+  ASSERT_SYNTAX (scm_is_symbol (scm_caddr (expr)), s_bad_expression, expr);
+
+  mod = scm_resolve_module (scm_cadr (expr));
+  if (scm_is_false (mod))
+    error_unbound_variable (expr);
+  var = scm_module_variable (scm_module_public_interface (mod), scm_caddr (expr));
+  if (scm_is_false (var))
+    error_unbound_variable (expr);
+  
+  return var;
+}
+
+SCM_SYNTAX (s_atat, "@@", scm_makmmacro, scm_m_atat);
+SCM_GLOBAL_SYMBOL (scm_sym_atat, "@@");
+
+static SCM
+scm_m_atat (SCM expr, SCM env SCM_UNUSED)
+{
+  SCM mod, var;
+  ASSERT_SYNTAX (scm_ilength (expr) == 3, s_bad_expression, expr);
+  ASSERT_SYNTAX (scm_ilength (scm_cadr (expr)) > 0, s_bad_expression, expr);
+  ASSERT_SYNTAX (scm_is_symbol (scm_caddr (expr)), s_bad_expression, expr);
+
+  mod = scm_resolve_module (scm_cadr (expr));
+  if (scm_is_false (mod))
+    error_unbound_variable (expr);
+  var = scm_module_variable (mod, scm_caddr (expr));
+  if (scm_is_false (var))
+    error_unbound_variable (expr);
+  
+  return var;
+}
+
 SCM_SYNTAX (s_atapply, "@apply", scm_i_makbimacro, scm_m_apply);
-SCM_GLOBAL_SYMBOL (scm_sym_atapply, s_atapply);
-SCM_GLOBAL_SYMBOL (scm_sym_apply, s_atapply + 1);
+SCM_GLOBAL_SYMBOL (scm_sym_atapply, "@apply");
+SCM_GLOBAL_SYMBOL (scm_sym_apply, "apply");
 
-SCM 
+static SCM
 scm_m_apply (SCM expr, SCM env SCM_UNUSED)
 {
   const SCM cdr_expr = SCM_CDR (expr);
@@ -2015,7 +2098,7 @@ SCM_SYNTAX (s_atbind, "@bind", scm_i_makbimacro, scm_m_atbind);
  *
  * FIXME - also implement `@bind*'.
  */
-SCM
+static SCM
 scm_m_atbind (SCM expr, SCM env)
 {
   SCM bindings;
@@ -2052,9 +2135,9 @@ scm_m_atbind (SCM expr, SCM env)
 
 
 SCM_SYNTAX(s_atcall_cc, "@call-with-current-continuation", scm_i_makbimacro, scm_m_cont);
-SCM_GLOBAL_SYMBOL(scm_sym_atcall_cc, s_atcall_cc);
+SCM_GLOBAL_SYMBOL(scm_sym_atcall_cc, "@call-with-current-continuation");
 
-SCM 
+static SCM
 scm_m_cont (SCM expr, SCM env SCM_UNUSED)
 {
   const SCM cdr_expr = SCM_CDR (expr);
@@ -2073,9 +2156,9 @@ unmemoize_atcall_cc (const SCM expr, const SCM env)
 
 
 SCM_SYNTAX (s_at_call_with_values, "@call-with-values", scm_i_makbimacro, scm_m_at_call_with_values);
-SCM_GLOBAL_SYMBOL(scm_sym_at_call_with_values, s_at_call_with_values);
+SCM_GLOBAL_SYMBOL(scm_sym_at_call_with_values, "@call-with-values");
 
-SCM
+static SCM
 scm_m_at_call_with_values (SCM expr, SCM env SCM_UNUSED)
 {
   const SCM cdr_expr = SCM_CDR (expr);
@@ -2093,20 +2176,39 @@ unmemoize_at_call_with_values (const SCM expr, const SCM env)
                      unmemoize_exprs (SCM_CDR (expr), env));
 }
 
+SCM_SYNTAX (s_eval_when, "eval-when", scm_makmmacro, scm_m_eval_when);
+SCM_GLOBAL_SYMBOL (scm_sym_eval_when, "eval-when");
+SCM_SYMBOL (sym_eval, "eval");
+SCM_SYMBOL (sym_load, "load");
+
+
+static SCM
+scm_m_eval_when (SCM expr, SCM env SCM_UNUSED)
+{
+  ASSERT_SYNTAX (scm_ilength (expr) >= 3, s_bad_expression, expr);
+  ASSERT_SYNTAX (scm_ilength (scm_cadr (expr)) > 0, s_bad_expression, expr);
+
+  if (scm_is_true (scm_memq (sym_eval, scm_cadr (expr)))
+      || scm_is_true (scm_memq (sym_load, scm_cadr (expr))))
+    return scm_cons (SCM_IM_BEGIN, scm_cddr (expr));
+  
+  return scm_list_1 (SCM_IM_BEGIN);
+}
+
 #if 0
 
 /* See futures.h for a comment why futures are not enabled.
  */
 
 SCM_SYNTAX (s_future, "future", scm_i_makbimacro, scm_m_future);
-SCM_GLOBAL_SYMBOL (scm_sym_future, s_future);
+SCM_GLOBAL_SYMBOL (scm_sym_future, "future");
 
 /* Like promises, futures are implemented as closures with an empty
  * parameter list.  Thus, (future <expression>) is transformed into
  * (#@future '() <expression>), where the empty list represents the
  * empty parameter list.  This representation allows for easy creation
  * of the closure during evaluation.  */
-SCM
+static SCM
 scm_m_future (SCM expr, SCM env)
 {
   const SCM new_expr = memoize_as_thunk_prototype (expr, env);
@@ -2126,7 +2228,7 @@ unmemoize_future (const SCM expr, const SCM env)
 SCM_SYNTAX (s_gset_x, "set!", scm_i_makbimacro, scm_m_generalized_set_x);
 SCM_SYMBOL (scm_sym_setter, "setter");
 
-SCM 
+static SCM
 scm_m_generalized_set_x (SCM expr, SCM env)
 {
   SCM target, exp_target;
@@ -2183,9 +2285,11 @@ scm_m_generalized_set_x (SCM expr, SCM env)
  * arbitrary modules during the startup phase, the code from goops.c should be
  * moved here.  */
 
+SCM_SYNTAX (s_atslot_ref, "@slot-ref", scm_i_makbimacro, scm_m_atslot_ref);
+SCM_SYNTAX (s_atslot_set_x, "@slot-set!", scm_i_makbimacro, scm_m_atslot_set_x);
 SCM_SYMBOL (sym_atslot_ref, "@slot-ref");
 
-SCM
+static SCM
 scm_m_atslot_ref (SCM expr, SCM env SCM_UNUSED)
 {
   SCM slot_nr;
@@ -2218,7 +2322,7 @@ unmemoize_atslot_ref (const SCM expr, const SCM env)
 
 SCM_SYMBOL (sym_atslot_set_x, "@slot-set!");
 
-SCM
+static SCM
 scm_m_atslot_set_x (SCM expr, SCM env SCM_UNUSED)
 {
   SCM slot_nr;
@@ -2256,7 +2360,7 @@ SCM_SYNTAX (s_nil_cond, "nil-cond", scm_i_makbimacro, scm_m_nil_cond);
 
 /* nil-cond expressions have the form
  *   (nil-cond COND VAL COND VAL ... ELSEVAL)  */
-SCM
+static SCM
 scm_m_nil_cond (SCM expr, SCM env SCM_UNUSED)
 {
   const long length = scm_ilength (SCM_CDR (expr));
@@ -2279,7 +2383,7 @@ SCM_SYNTAX (s_atfop, "@fop", scm_i_makbimacro, scm_m_atfop);
  * if the value of var (across all aliasing) is not a macro, or
  *    (<un-aliased var> <expr> ...)
  * if var is a macro. */
-SCM
+static SCM
 scm_m_atfop (SCM expr, SCM env SCM_UNUSED)
 {
   SCM location;
@@ -2450,20 +2554,11 @@ scm_i_unmemocopy_body (SCM forms, SCM env)
 
 #if (SCM_ENABLE_DEPRECATED == 1)
 
-/* Deprecated in guile 1.7.0 on 2003-11-09.  */
-SCM
-scm_m_expand_body (SCM exprs, SCM env)
-{
-  scm_c_issue_deprecation_warning 
-    ("`scm_m_expand_body' is deprecated.");
-  m_expand_body (exprs, env);
-  return exprs;
-}
-
+static SCM scm_m_undefine (SCM expr, SCM env);
 
 SCM_SYNTAX (s_undefine, "undefine", scm_makacro, scm_m_undefine);
 
-SCM
+static SCM
 scm_m_undefine (SCM expr, SCM env)
 {
   SCM variable;
@@ -2487,55 +2582,10 @@ scm_m_undefine (SCM expr, SCM env)
   return SCM_UNSPECIFIED;
 }
 
-SCM
-scm_macroexp (SCM x, SCM env)
-{
-  scm_c_issue_deprecation_warning
-    ("`scm_macroexp' is deprecated.");
-  return macroexp (x, env);
-}
-
-#endif
-
-
-#if (SCM_ENABLE_DEPRECATED == 1)
-
-SCM
-scm_unmemocar (SCM form, SCM env)
-{
-  scm_c_issue_deprecation_warning 
-    ("`scm_unmemocar' is deprecated.");
-
-  if (!scm_is_pair (form))
-    return form;
-  else
-    {
-      SCM c = SCM_CAR (form);
-      if (SCM_VARIABLEP (c))
-	{
-	  SCM sym = scm_module_reverse_lookup (scm_env_module (env), c);
-	  if (scm_is_false (sym))
-	    sym = sym_three_question_marks;
-	  SCM_SETCAR (form, sym);
-	}
-      else if (SCM_ILOCP (c))
-	{
-	  unsigned long int ir;
-
-	  for (ir = SCM_IFRAME (c); ir != 0; --ir)
-	    env = SCM_CDR (env);
-	  env = SCM_CAAR (env);
-	  for (ir = SCM_IDIST (c); ir != 0; --ir)
-	    env = SCM_CDR (env);
-
-	  SCM_SETCAR (form, SCM_ICDRP (c) ? env : SCM_CAR (env));
-	}
-      return form;
-    }
-}
+#endif /* SCM_ENABLE_DEPRECATED */
 
-#endif
 
+
 /*****************************************************************************/
 /*****************************************************************************/
 /*                 The definitions for execution start here.                 */
@@ -2660,9 +2710,6 @@ scm_ilookup (SCM iloc, SCM env)
 
 SCM_SYMBOL (scm_unbound_variable_key, "unbound-variable");
 
-static void error_unbound_variable (SCM symbol) SCM_NORETURN;
-static void error_defined_variable (SCM symbol) SCM_NORETURN;
-
 /* Call this for variables that are unfound.
  */
 static void
@@ -2965,8 +3012,19 @@ scm_t_option scm_debug_opts[] = {
   { SCM_OPTION_INTEGER, "depth", 20, "Maximal length of printed backtrace." },
   { SCM_OPTION_BOOLEAN, "backtrace", 0, "Show backtrace on error." },
   { SCM_OPTION_BOOLEAN, "debug", 0, "Use the debugging evaluator." },
+  /* This default stack limit will be overridden by debug.c:init_stack_limit(),
+     if we have getrlimit() and the stack limit is not INFINITY. But it is still
+     important, as some systems have both the soft and the hard limits set to
+     INFINITY; in that case we fall back to this value.
 
-  { SCM_OPTION_INTEGER, "stack", 20000, "Stack size limit (measured in words; 0 = no check)." },
+     The situation is aggravated by certain compilers, which can consume
+     "beaucoup de stack", as they say in France.
+
+     See http://thread.gmane.org/gmane.lisp.guile.devel/8599/focus=8662 for
+     more discussion. This setting is 640 KB on 32-bit arches (should be enough
+     for anyone!) or a whoppin' 1280 KB on 64-bit arches.
+  */
+  { SCM_OPTION_INTEGER, "stack", 160000, "Stack size limit (measured in words; 0 = no check)." },
   { SCM_OPTION_SCM, "show-file-name", (unsigned long)SCM_BOOL_T,
     "Show file names and line numbers "
     "in backtraces when not `#f'.  A value of `base' "
@@ -3050,32 +3108,56 @@ SCM_DEFINE (scm_evaluator_traps, "evaluator-traps-interface", 0, 1, 0,
 SCM
 scm_call_0 (SCM proc)
 {
-  return scm_apply (proc, SCM_EOL, SCM_EOL);
+  if (SCM_PROGRAM_P (proc))
+    return scm_c_vm_run (scm_the_vm (), proc, NULL, 0);
+  else
+    return scm_apply (proc, SCM_EOL, SCM_EOL);
 }
 
 SCM
 scm_call_1 (SCM proc, SCM arg1)
 {
-  return scm_apply (proc, arg1, scm_listofnull);
+  if (SCM_PROGRAM_P (proc))
+    return scm_c_vm_run (scm_the_vm (), proc, &arg1, 1);
+  else
+    return scm_apply (proc, arg1, scm_listofnull);
 }
 
 SCM
 scm_call_2 (SCM proc, SCM arg1, SCM arg2)
 {
-  return scm_apply (proc, arg1, scm_cons (arg2, scm_listofnull));
+  if (SCM_PROGRAM_P (proc))
+    {
+      SCM args[] = { arg1, arg2 };
+      return scm_c_vm_run (scm_the_vm (), proc, args, 2);
+    }
+  else
+    return scm_apply (proc, arg1, scm_cons (arg2, scm_listofnull));
 }
 
 SCM
 scm_call_3 (SCM proc, SCM arg1, SCM arg2, SCM arg3)
 {
-  return scm_apply (proc, arg1, scm_cons2 (arg2, arg3, scm_listofnull));
+  if (SCM_PROGRAM_P (proc))
+    {
+      SCM args[] = { arg1, arg2, arg3 };
+      return scm_c_vm_run (scm_the_vm (), proc, args, 3);
+    }
+  else
+    return scm_apply (proc, arg1, scm_cons2 (arg2, arg3, scm_listofnull));
 }
 
 SCM
 scm_call_4 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM arg4)
 {
-  return scm_apply (proc, arg1, scm_cons2 (arg2, arg3,
-					   scm_cons (arg4, scm_listofnull)));
+  if (SCM_PROGRAM_P (proc))
+    {
+      SCM args[] = { arg1, arg2, arg3, arg4 };
+      return scm_c_vm_run (scm_the_vm (), proc, args, 4);
+    }
+  else
+    return scm_apply (proc, arg1, scm_cons2 (arg2, arg3,
+                                             scm_cons (arg4, scm_listofnull)));
 }
 
 /* Simple procedure applies
@@ -3245,6 +3327,7 @@ scm_trampoline_0 (SCM proc)
     case scm_tc7_rpsubr:
     case scm_tc7_gsubr:
     case scm_tc7_pws:
+    case scm_tc7_program:
       trampoline = scm_call_0;
       break;
     default:
@@ -3297,8 +3380,7 @@ call_dsubr_1 (SCM proc, SCM arg1)
     {
       return (scm_from_double (SCM_DSUBRF (proc) (scm_i_fraction2double (arg1))));
     }
-  SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), arg1,
-		      SCM_ARG1, scm_i_symbol_chars (SCM_SNAME (proc)));
+  SCM_WTA_DISPATCH_1_SUBR (proc, arg1, SCM_ARG1);
 }
 
 static SCM
@@ -3371,6 +3453,7 @@ scm_trampoline_1 (SCM proc)
     case scm_tc7_rpsubr:
     case scm_tc7_gsubr:
     case scm_tc7_pws:
+    case scm_tc7_program:
       trampoline = scm_call_1;
       break;
     default:
@@ -3465,6 +3548,7 @@ scm_trampoline_2 (SCM proc)
       break;
     case scm_tc7_gsubr:
     case scm_tc7_pws:
+    case scm_tc7_program:
       trampoline = scm_call_2;
       break;
     default:
@@ -3663,13 +3747,23 @@ scm_closure (SCM code, SCM env)
 
 scm_t_bits scm_tc16_promise;
 
-SCM 
-scm_makprom (SCM code)
-{
+SCM_DEFINE (scm_make_promise, "make-promise", 1, 0, 0, 
+	    (SCM thunk),
+	    "Create a new promise object.\n\n"
+            "@code{make-promise} is a procedural form of @code{delay}.\n"
+            "These two expressions are equivalent:\n"
+            "@lisp\n"
+	    "(delay @var{exp})\n"
+	    "(make-promise (lambda () @var{exp}))\n"
+            "@end lisp\n")
+#define FUNC_NAME s_scm_make_promise
+{
+  SCM_VALIDATE_THUNK (1, thunk);
   SCM_RETURN_NEWSMOB2 (scm_tc16_promise,
-		       SCM_UNPACK (code),
+		       SCM_UNPACK (thunk),
 		       scm_make_recursive_mutex ());
 }
+#undef FUNC_NAME
 
 
 static int 
@@ -4020,11 +4114,12 @@ SCM_DEFINE (scm_eval, "eval", 2, 0, 0,
   scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
   if (scm_is_dynamic_state (module_or_state))
     scm_dynwind_current_dynamic_state (module_or_state);
-  else
+  else if (scm_module_system_booted_p)
     {
       SCM_VALIDATE_MODULE (2, module_or_state);
       scm_dynwind_current_module (module_or_state);
     }
+  /* otherwise if the module system isn't booted, ignore the module arg */
 
   res = scm_primitive_eval (exp);
 
diff --git a/libguile/eval.h b/libguile/eval.h
index bf6279b82..4467358f5 100644
--- a/libguile/eval.h
+++ b/libguile/eval.h
@@ -3,22 +3,23 @@
 #ifndef SCM_EVAL_H
 #define SCM_EVAL_H
 
-/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2003,2004,2008
+/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2003,2004,2008,2009
  * Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -94,10 +95,13 @@ SCM_API SCM scm_sym_quasiquote;
 SCM_API SCM scm_sym_unquote;
 SCM_API SCM scm_sym_uq_splicing;
 
+SCM_API SCM scm_sym_at;
+SCM_API SCM scm_sym_atat;
 SCM_API SCM scm_sym_atapply;
 SCM_API SCM scm_sym_atcall_cc;
 SCM_API SCM scm_sym_at_call_with_values;
 SCM_API SCM scm_sym_delay;
+SCM_API SCM scm_sym_eval_when;
 SCM_API SCM scm_sym_arrow;
 SCM_API SCM scm_sym_else;
 SCM_API SCM scm_sym_apply;
@@ -111,37 +115,6 @@ SCM_API SCM * scm_lookupcar (SCM vloc, SCM genv, int check);
 SCM_API SCM scm_eval_car (SCM pair, SCM env);
 SCM_API SCM scm_eval_body (SCM code, SCM env);
 SCM_API SCM scm_eval_args (SCM i, SCM env, SCM proc);
-SCM_API SCM scm_m_quote (SCM xorig, SCM env);
-SCM_API SCM scm_m_begin (SCM xorig, SCM env);
-SCM_API SCM scm_m_if (SCM xorig, SCM env);
-SCM_API SCM scm_m_set_x (SCM xorig, SCM env);
-SCM_API SCM scm_m_vref (SCM xorig, SCM env);
-SCM_API SCM scm_m_vset (SCM xorig, SCM env);
-SCM_API SCM scm_m_and (SCM xorig, SCM env);
-SCM_API SCM scm_m_or (SCM xorig, SCM env);
-SCM_API SCM scm_m_case (SCM xorig, SCM env);
-SCM_API SCM scm_m_cond (SCM xorig, SCM env);
-SCM_API SCM scm_m_lambda (SCM xorig, SCM env);
-SCM_API SCM scm_m_letstar (SCM xorig, SCM env);
-SCM_API SCM scm_m_do (SCM xorig, SCM env);
-SCM_API SCM scm_m_quasiquote (SCM xorig, SCM env);
-SCM_API SCM scm_m_delay (SCM xorig, SCM env);
-SCM_API SCM scm_m_generalized_set_x (SCM xorig, SCM env);
-SCM_API SCM scm_m_future (SCM xorig, SCM env);
-SCM_API SCM scm_m_define (SCM x, SCM env);
-SCM_API SCM scm_m_letrec (SCM xorig, SCM env);
-SCM_API SCM scm_m_let (SCM xorig, SCM env);
-SCM_API SCM scm_m_apply (SCM xorig, SCM env);
-SCM_API SCM scm_m_cont (SCM xorig, SCM env);
-#if SCM_ENABLE_ELISP
-SCM_API SCM scm_m_nil_cond (SCM xorig, SCM env);
-SCM_API SCM scm_m_atfop (SCM xorig, SCM env);
-#endif /* SCM_ENABLE_ELISP */
-SCM_API SCM scm_m_atbind (SCM xorig, SCM env);
-SCM_API SCM scm_m_atslot_ref (SCM xorig, SCM env);
-SCM_API SCM scm_m_atslot_set_x (SCM xorig, SCM env);
-SCM_API SCM scm_m_atdispatch (SCM xorig, SCM env);
-SCM_API SCM scm_m_at_call_with_values (SCM xorig, SCM env);
 SCM_API int scm_badargsp (SCM formals, SCM args);
 SCM_API SCM scm_call_0 (SCM proc);
 SCM_API SCM scm_call_1 (SCM proc, SCM arg1);
@@ -162,7 +135,7 @@ SCM_API SCM scm_dapply (SCM proc, SCM arg1, SCM args);
 SCM_API SCM scm_map (SCM proc, SCM arg1, SCM args);
 SCM_API SCM scm_for_each (SCM proc, SCM arg1, SCM args);
 SCM_API SCM scm_closure (SCM code, SCM env);
-SCM_API SCM scm_makprom (SCM code);
+SCM_API SCM scm_make_promise (SCM thunk);
 SCM_API SCM scm_force (SCM x);
 SCM_API SCM scm_promise_p (SCM x);
 SCM_API SCM scm_cons_source (SCM xorig, SCM x, SCM y);
@@ -183,15 +156,6 @@ SCM_INTERNAL void scm_init_eval (void);
 
 #if (SCM_ENABLE_DEPRECATED == 1)
 
-SCM_API SCM scm_m_undefine (SCM x, SCM env);
-
-/* Deprecated in guile 1.7.0 on 2003-11-09.  */
-SCM_API SCM scm_m_expand_body (SCM xorig, SCM env);
-
-/* Deprecated in guile 1.7.0 on 2003-11-16.  */
-SCM_API SCM scm_unmemocar (SCM form, SCM env);
-SCM_API SCM scm_macroexp (SCM x, SCM env);
-
 /* Deprecated in guile 1.7.0 on 2004-03-29.  */
 SCM_API SCM scm_ceval (SCM x, SCM env);
 SCM_API SCM scm_deval (SCM x, SCM env);
diff --git a/libguile/eval.i.c b/libguile/eval.i.c
index ae666d415..25abf6cb9 100644
--- a/libguile/eval.i.c
+++ b/libguile/eval.i.c
@@ -4,18 +4,19 @@
  * Copyright (C) 2002, 03, 04, 05, 06, 07, 09 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 #undef RETURN
@@ -732,7 +733,7 @@ dispatch:
 
 
 	case (ISYMNUM (SCM_IM_DELAY)):
-	  RETURN (scm_makprom (scm_closure (SCM_CDR (x), env)));
+	  RETURN (scm_make_promise (scm_closure (SCM_CDR (x), env)));
 
 #if 0
 	  /* See futures.h for a comment why futures are not enabled.
@@ -855,9 +856,12 @@ dispatch:
 		      args = SCM_CDR (args);
 		      z = SCM_CDR (z);
 		    }
-		  /* Fewer arguments than specifiers => CAR != ENV */
-		  if (scm_is_null (SCM_CAR (z)) || scm_is_pair (SCM_CAR (z)))
-		    goto apply_cmethod;
+		  /* Fewer arguments than specifiers => CAR != CLASS */
+                  if (!scm_is_pair (z))
+                    goto apply_vm_cmethod;
+                  else if (!SCM_CLASSP (SCM_CAR (z))
+                           && !scm_is_symbol (SCM_CAR (z)))
+                    goto apply_memoized_cmethod;
 		next_method:
 		  hash_value = (hash_value + 1) & mask;
 		} while (hash_value != cache_end_pos);
@@ -865,13 +869,21 @@ dispatch:
 	      /* No appropriate method was found in the cache.  */
 	      z = scm_memoize_method (x, arg1);
 
-	    apply_cmethod: /* inputs: z, arg1 */
-	      {
-		SCM formals = SCM_CMETHOD_FORMALS (z);
-		env = SCM_EXTEND_ENV (formals, arg1, SCM_CMETHOD_ENV (z));
-		x = SCM_CMETHOD_BODY (z);
-		goto nontoplevel_begin;
-	      }
+              if (scm_is_pair (z))
+                goto apply_memoized_cmethod;
+              
+            apply_vm_cmethod:
+              proc = z;
+              PREP_APPLY (proc, arg1);
+              goto apply_proc;
+
+	    apply_memoized_cmethod: /* inputs: z, arg1 */
+              {
+                SCM formals = SCM_CMETHOD_FORMALS (z);
+                env = SCM_EXTEND_ENV (formals, arg1, SCM_CMETHOD_ENV (z));
+                x = SCM_CMETHOD_BODY (z);
+                goto nontoplevel_begin;
+              }
 	    }
 	  }
 
@@ -1120,6 +1132,8 @@ dispatch:
 	RETURN (SCM_BOOL_T);
       case scm_tc7_asubr:
 	RETURN (SCM_SUBRF (proc) (SCM_UNDEFINED, SCM_UNDEFINED));
+      case scm_tc7_program:
+        RETURN (scm_c_vm_run (scm_the_vm (), proc, NULL, 0));
       case scm_tc7_smob:
 	if (!SCM_SMOB_APPLICABLE_P (proc))
 	  goto badfun;
@@ -1224,13 +1238,13 @@ dispatch:
 	      {
                 RETURN (scm_from_double (SCM_DSUBRF (proc) (scm_i_fraction2double (arg1))));
 	      }
-	    SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), arg1,
-                                SCM_ARG1,
-				scm_i_symbol_chars (SCM_SNAME (proc)));
+	    SCM_WTA_DISPATCH_1_SUBR (proc, arg1, SCM_ARG1);
 	  case scm_tc7_cxr:
 	    RETURN (scm_i_chase_pairs (arg1, (scm_t_bits) SCM_SUBRF (proc)));
 	  case scm_tc7_rpsubr:
 	    RETURN (SCM_BOOL_T);
+          case scm_tc7_program:
+            RETURN (scm_c_vm_run (scm_the_vm (), proc, &arg1, 1));
 	  case scm_tc7_asubr:
 	    RETURN (SCM_SUBRF (proc) (arg1, SCM_UNDEFINED));
 	  case scm_tc7_lsubr:
@@ -1341,6 +1355,12 @@ dispatch:
 	  case scm_tc7_rpsubr:
 	  case scm_tc7_asubr:
 	    RETURN (SCM_SUBRF (proc) (arg1, arg2));
+          case scm_tc7_program:
+            { SCM args[2];
+              args[0] = arg1;
+              args[1] = arg2;
+              RETURN (scm_c_vm_run (scm_the_vm (), proc, args, 2));
+            }
 	  case scm_tc7_smob:
 	    if (!SCM_SMOB_APPLICABLE_P (proc))
 	      goto badfun;
@@ -1480,6 +1500,8 @@ dispatch:
 				    SCM_CDDR (debug.info->a.args)));
 	case scm_tc7_gsubr:
 	  RETURN (scm_i_gsubr_apply_list (proc, debug.info->a.args));
+        case scm_tc7_program:
+          RETURN (scm_vm_apply (scm_the_vm (), proc, debug.info->a.args));
 	case scm_tc7_pws:
 	  proc = SCM_PROCEDURE (proc);
 	  debug.info->a.proc = proc;
@@ -1551,6 +1573,11 @@ dispatch:
 					    scm_cons2 (arg1, arg2,
 						       scm_ceval_args (x, env,
 								       proc))));
+        case scm_tc7_program:
+          RETURN (scm_vm_apply
+                  (scm_the_vm (), proc,
+                   scm_cons (arg1, scm_cons (arg2,
+                                             scm_ceval_args (x, env, proc)))));
 	case scm_tc7_pws:
 	  proc = SCM_PROCEDURE (proc);
 	  if (!SCM_CLOSUREP (proc))
@@ -1752,8 +1779,7 @@ tail:
 	{
 	  RETURN (scm_from_double (SCM_DSUBRF (proc) (scm_i_fraction2double (arg1))));
 	}
-      SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), arg1,
-                          SCM_ARG1, scm_i_symbol_chars (SCM_SNAME (proc)));
+      SCM_WTA_DISPATCH_1_SUBR (proc, arg1, SCM_ARG1);
     case scm_tc7_cxr:
       if (SCM_UNLIKELY (SCM_UNBNDP (arg1) || !scm_is_null (args)))
 	scm_wrong_num_args (proc);
@@ -1786,6 +1812,11 @@ tail:
 	  args = SCM_CDR (args);
 	}
       RETURN (arg1);
+    case scm_tc7_program:
+      if (SCM_UNBNDP (arg1))
+        RETURN (scm_c_vm_run (scm_the_vm (), proc, NULL, 0));
+      else
+        RETURN (scm_vm_apply (scm_the_vm (), proc, scm_cons (arg1, args)));
     case scm_tc7_rpsubr:
       if (scm_is_null (args))
 	RETURN (SCM_BOOL_T);
diff --git a/libguile/evalext.c b/libguile/evalext.c
index 5ca78066d..78b666f65 100644
--- a/libguile/evalext.c
+++ b/libguile/evalext.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006, 2008, 2009 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -30,49 +31,23 @@
 #include "libguile/evalext.h"
 
 SCM_DEFINE (scm_defined_p, "defined?", 1, 1, 0,
-            (SCM sym, SCM env),
-	    "Return @code{#t} if @var{sym} is defined in the lexical "
-	    "environment @var{env}.  When @var{env} is not specified, "
-	    "look in the top-level environment as defined by the "
-	    "current module.")
+            (SCM sym, SCM module),
+	    "Return @code{#t} if @var{sym} is defined in the module "
+	    "@var{module} or the current module when @var{module} is not"
+	    "specified.")
 #define FUNC_NAME s_scm_defined_p
 {
   SCM var;
 
   SCM_VALIDATE_SYMBOL (1, sym);
 
-  if (SCM_UNBNDP (env))
-    var = scm_sym2var (sym, scm_current_module_lookup_closure (),
-			 SCM_BOOL_F);
+  if (SCM_UNBNDP (module))
+    module = scm_current_module ();
   else
-    {
-      SCM frames = env;
-      register SCM b;
-      for (; SCM_NIMP (frames); frames = SCM_CDR (frames))
-	{
-	  SCM_ASSERT (scm_is_pair (frames), env, SCM_ARG2, FUNC_NAME);
-	  b = SCM_CAR (frames);
-	  if (scm_is_true (scm_procedure_p (b)))
-	    break;
-	  SCM_ASSERT (scm_is_pair (b), env, SCM_ARG2, FUNC_NAME);
-	  for (b = SCM_CAR (b); SCM_NIMP (b); b = SCM_CDR (b))
-	    {
-	      if (!scm_is_pair (b))
-		{
-		  if (scm_is_eq (b, sym))
-		    return SCM_BOOL_T;
-		  else
-		    break;
-		}
-	      if (scm_is_eq (SCM_CAR (b), sym))
-		return SCM_BOOL_T;
-	    }
-	}
-      var = scm_sym2var (sym,
-			 SCM_NIMP (frames) ? SCM_CAR (frames) : SCM_BOOL_F,
-			 SCM_BOOL_F);
-    }
-	      
+    SCM_VALIDATE_MODULE (2, module);
+
+  var = scm_module_variable (module, sym);
+
   return (scm_is_false (var) || SCM_UNBNDP (SCM_VARIABLE_REF (var))
 	  ? SCM_BOOL_F
 	  : SCM_BOOL_T);
@@ -107,6 +82,8 @@ SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0, 0,
 	case scm_tc7_string:
 	case scm_tc7_smob:
 	case scm_tc7_pws:
+	case scm_tc7_program:
+	case scm_tc7_bytevector:
 	case scm_tcs_subrs:
 	case scm_tcs_struct:
 	  return SCM_BOOL_T;
diff --git a/libguile/evalext.h b/libguile/evalext.h
index a6a4a9fdc..fc3f1e617 100644
--- a/libguile/evalext.h
+++ b/libguile/evalext.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1998,1999,2000, 2003, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/extensions.c b/libguile/extensions.c
index 1090b8bd5..d01e9c656 100644
--- a/libguile/extensions.c
+++ b/libguile/extensions.c
@@ -1,20 +1,21 @@
 /* extensions.c - registering and loading extensions.
  *
- * Copyright (C) 2001, 2006 Free Software Foundation, Inc.
+ * Copyright (C) 2001, 2006, 2009 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 #ifdef HAVE_CONFIG_H
@@ -40,7 +41,7 @@ typedef struct extension_t
   void *data;
 } extension_t;
 
-static extension_t *registered_extensions;
+static extension_t *registered_extensions = NULL;
 
 /* Register a LIB/INIT pair for use by `scm_load_extension'.  LIB is
    allowed to be NULL and then only INIT is used to identify the
@@ -76,6 +77,7 @@ load_extension (SCM lib, SCM init)
     {
       extension_t *ext;
       char *clib, *cinit;
+      int found = 0;
 
       scm_dynwind_begin (0);
 
@@ -89,10 +91,14 @@ load_extension (SCM lib, SCM init)
 	    && !strcmp (ext->init, cinit))
 	  {
 	    ext->func (ext->data);
+            found = 1;
 	    break;
 	  }
 
       scm_dynwind_end ();
+
+      if (found)
+        return;
     }
 
   /* Dynamically link the library. */
@@ -151,7 +157,6 @@ SCM_DEFINE (scm_load_extension, "load-extension", 2, 0, 0,
 void
 scm_init_extensions ()
 {
-  registered_extensions = NULL;
 #include "libguile/extensions.x"
 }
 
diff --git a/libguile/extensions.h b/libguile/extensions.h
index 596b43ae0..765f9bee1 100644
--- a/libguile/extensions.h
+++ b/libguile/extensions.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 2001, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -26,6 +27,8 @@
 
 
 
+typedef void (*scm_t_extension_init_func)(void*);
+
 SCM_API void scm_c_register_extension (const char *lib, const char *init,
 				       void (*func) (void *), void *data);
 
diff --git a/libguile/feature.c b/libguile/feature.c
index 8283cd6f5..9ef4b658e 100644
--- a/libguile/feature.c
+++ b/libguile/feature.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1995,1996,1998,1999,2000,2001,2002, 2003, 2004, 2006, 2007 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/feature.h b/libguile/feature.h
index 8c6371e94..d373bc773 100644
--- a/libguile/feature.h
+++ b/libguile/feature.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,1999,2000,2001, 2006, 2007, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/filesys.c b/libguile/filesys.c
index ec33328b1..c602f6735 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1996,1997,1998,1999,2000,2001, 2002, 2004, 2006 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -29,6 +30,7 @@
 #endif
 
 #include <alloca.h>
+#include <canonicalize.h>
 
 #include <stdio.h>
 #include <errno.h>
@@ -580,17 +582,23 @@ static int fstat_Win32 (int fdes, struct stat *buf)
 }
 #endif /* __MINGW32__ */
 
-SCM_DEFINE (scm_stat, "stat", 1, 0, 0, 
-            (SCM object),
+SCM_DEFINE (scm_stat, "stat", 1, 1, 0, 
+            (SCM object, SCM exception_on_error),
 	    "Return an object containing various information about the file\n"
 	    "determined by @var{obj}.  @var{obj} can be a string containing\n"
 	    "a file name or a port or integer file descriptor which is open\n"
 	    "on a file (in which case @code{fstat} is used as the underlying\n"
 	    "system call).\n"
 	    "\n"
-	    "The object returned by @code{stat} can be passed as a single\n"
-	    "parameter to the following procedures, all of which return\n"
-	    "integers:\n"
+            "If the optional @var{exception_on_error} argument is true, which\n"
+            "is the default, an exception will be raised if the underlying\n"
+            "system call returns an error, for example if the file is not\n"
+            "found or is not readable. Otherwise, an error will cause\n"
+            "@code{stat} to return @code{#f}."
+	    "\n"
+	    "The object returned by a successful call to @code{stat} can be\n"
+            "passed as a single parameter to the following procedures, all of\n"
+            "which return integers:\n"
 	    "\n"
 	    "@table @code\n"
 	    "@item stat:dev\n"
@@ -678,12 +686,16 @@ SCM_DEFINE (scm_stat, "stat", 1, 0, 0,
 
   if (rv == -1)
     {
-      int en = errno;
-
-      SCM_SYSERROR_MSG ("~A: ~S",
-			scm_list_2 (scm_strerror (scm_from_int (en)),
-				    object),
-			en);
+      if (SCM_UNBNDP (exception_on_error) || scm_is_true (exception_on_error))
+        {
+          int en = errno;
+          SCM_SYSERROR_MSG ("~A: ~S",
+                            scm_list_2 (scm_strerror (scm_from_int (en)),
+                                        object),
+                            en);
+        }
+      else
+        return SCM_BOOL_F;
     }
   return scm_stat2scm (&stat_temp);
 }
@@ -1561,31 +1573,39 @@ SCM_DEFINE (scm_dirname, "dirname", 1, 0, 0,
 	    "component, @code{.} is returned.")
 #define FUNC_NAME s_scm_dirname
 {
-  const char *s;
   long int i;
   unsigned long int len;
 
   SCM_VALIDATE_STRING (1, filename);
 
-  s = scm_i_string_chars (filename);
   len = scm_i_string_length (filename);
 
   i = len - 1;
 #ifdef __MINGW32__
-  while (i >= 0 && (s[i] == '/' || s[i] == '\\')) --i;
-  while (i >= 0 && (s[i] != '/' && s[i] != '\\')) --i;
-  while (i >= 0 && (s[i] == '/' || s[i] == '\\')) --i;
+  while (i >= 0 && (scm_i_string_ref (filename, i) == '/'
+		    || scm_i_string_ref (filename, i) == '\\')) 
+    --i;
+  while (i >= 0 && (scm_i_string_ref (filename, i) != '/'
+		    && scm_i_string_ref (filename, i) != '\\')) 
+    --i;
+  while (i >= 0 && (scm_i_string_ref (filename, i) == '/'
+		    || scm_i_string_ref (filename, i) == '\\')) 
+    --i;
 #else
-  while (i >= 0 && s[i] == '/') --i;
-  while (i >= 0 && s[i] != '/') --i;
-  while (i >= 0 && s[i] == '/') --i;
+  while (i >= 0 && scm_i_string_ref (filename, i) == '/') 
+    --i;
+  while (i >= 0 && scm_i_string_ref (filename, i) != '/') 
+    --i;
+  while (i >= 0 && scm_i_string_ref (filename, i) == '/') 
+    --i;
 #endif /* ndef __MINGW32__ */
   if (i < 0)
     {
 #ifdef __MINGW32__
-      if (len > 0 && (s[0] == '/' || s[0] == '\\'))
+      if (len > 0 && (scm_i_string_ref (filename, 0) == '/'
+		      || scm_i_string_ref (filename, 0) == '\\'))
 #else
-      if (len > 0 && s[0] == '/')
+      if (len > 0 && scm_i_string_ref (filename, 0) == '/')
 #endif /* ndef __MINGW32__ */
 	return scm_c_substring (filename, 0, 1);
       else
@@ -1604,11 +1624,9 @@ SCM_DEFINE (scm_basename, "basename", 1, 1, 0,
 	    "@var{basename}, it is removed also.")
 #define FUNC_NAME s_scm_basename
 {
-  const char *f, *s = 0;
   int i, j, len, end;
 
   SCM_VALIDATE_STRING (1, filename);
-  f = scm_i_string_chars (filename);
   len = scm_i_string_length (filename);
 
   if (SCM_UNBNDP (suffix))
@@ -1616,32 +1634,44 @@ SCM_DEFINE (scm_basename, "basename", 1, 1, 0,
   else
     {
       SCM_VALIDATE_STRING (2, suffix);
-      s = scm_i_string_chars (suffix);
       j = scm_i_string_length (suffix) - 1;
     }
   i = len - 1;
 #ifdef __MINGW32__
-  while (i >= 0 && (f[i] == '/' || f[i] == '\\')) --i;
+  while (i >= 0 && (scm_i_string_ref (filename, i) == '/'
+		    || scm_i_string_ref (filename, i) ==  '\\'))
+    --i;
 #else
-  while (i >= 0 && f[i] == '/') --i;
+  while (i >= 0 && scm_i_string_ref (filename, i) == '/')
+    --i;
 #endif /* ndef __MINGW32__ */
   end = i;
-  while (i >= 0 && j >= 0 && f[i] == s[j]) --i, --j;
+  while (i >= 0 && j >= 0 
+	 && (scm_i_string_ref (filename, i)
+	     == scm_i_string_ref (suffix, j)))
+    {
+      --i;
+      --j;
+    }
   if (j == -1)
     end = i;
 #ifdef __MINGW32__
-  while (i >= 0 && f[i] != '/' && f[i] != '\\') --i;
+  while (i >= 0 && (scm_i_string_ref (filename, i) != '/'
+		    && scm_i_string_ref (filename, i) != '\\'))
+    --i;
 #else
-  while (i >= 0 && f[i] != '/') --i;
+  while (i >= 0 && scm_i_string_ref (filename, i) != '/')
+    --i;
 #endif /* ndef __MINGW32__ */
   if (i == end)
     {
 #ifdef __MINGW32__
-      if (len > 0 && (f[0] == '/' || f[0] == '\\'))
+      if (len > 0 && (scm_i_string_ref (filename, 0) ==  '/'
+		      || scm_i_string_ref (filename, 0) ==  '\\'))
 #else
-      if (len > 0 && f[0] == '/')
+      if (len > 0 && scm_i_string_ref (filename, 0) == '/')
 #endif /* ndef __MINGW32__ */
-	return scm_c_substring (filename, 0, 1);
+        return scm_c_substring (filename, 0, 1);
       else
 	return scm_dot_string;
     }
@@ -1650,6 +1680,27 @@ SCM_DEFINE (scm_basename, "basename", 1, 1, 0,
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (scm_canonicalize_path, "canonicalize-path", 1, 0, 0, 
+            (SCM path),
+	    "Return the canonical path of @var{path}. A canonical path has\n"
+            "no @code{.} or @code{..} components, nor any repeated path\n"
+            "separators (@code{/}) nor symlinks.\n\n"
+            "Raises an error if any component of @var{path} does not exist.")
+#define FUNC_NAME s_scm_canonicalize_path
+{ char *str, *canon;
+  
+  SCM_VALIDATE_STRING (1, path);
+
+  str = scm_to_locale_string (path);
+  canon = canonicalize_file_name (str);
+  free (str);
+  
+  if (canon)
+    return scm_take_locale_string (canon);
+  else
+    SCM_SYSERROR;
+}
+#undef FUNC_NAME
 
 
 
diff --git a/libguile/filesys.h b/libguile/filesys.h
index a38a5b594..b9a6ca8a6 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1997,1998,1999,2000,2001, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -42,7 +43,7 @@ SCM_API SCM scm_open_fdes (SCM path, SCM flags, SCM mode);
 SCM_API SCM scm_open (SCM path, SCM flags, SCM mode);
 SCM_API SCM scm_close (SCM fd_or_port);
 SCM_API SCM scm_close_fdes (SCM fd);
-SCM_API SCM scm_stat (SCM object);
+SCM_API SCM scm_stat (SCM object, SCM exception_on_error);
 SCM_API SCM scm_link (SCM oldpath, SCM newpath);
 SCM_API SCM scm_rename (SCM oldname, SCM newname);
 SCM_API SCM scm_delete_file (SCM str);
@@ -64,6 +65,7 @@ SCM_API SCM scm_lstat (SCM str);
 SCM_API SCM scm_copy_file (SCM oldfile, SCM newfile);
 SCM_API SCM scm_dirname (SCM filename);
 SCM_API SCM scm_basename (SCM filename, SCM suffix);
+SCM_API SCM scm_canonicalize_path (SCM path);
 
 SCM_INTERNAL void scm_init_filesys (void);
 
diff --git a/libguile/fluids.c b/libguile/fluids.c
index 02eff9f20..75dcccf75 100644
--- a/libguile/fluids.c
+++ b/libguile/fluids.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1996,1997,2000,2001, 2004, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 #ifdef HAVE_CONFIG_H
diff --git a/libguile/fluids.h b/libguile/fluids.h
index c88ffa88f..2bfcce52f 100644
--- a/libguile/fluids.h
+++ b/libguile/fluids.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1996,2000,2001, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/fports.c b/libguile/fports.c
index ab4538028..5d374950f 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -1,18 +1,19 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2007, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -593,7 +594,7 @@ static void fport_flush (SCM port);
 
 /* fill a port's read-buffer with a single read.  returns the first
    char or EOF if end of file.  */
-static int
+static scm_t_wchar
 fport_fill_input (SCM port)
 {
   long count;
@@ -607,7 +608,7 @@ fport_fill_input (SCM port)
   if (count == -1)
     scm_syserror ("fport_fill_input");
   if (count == 0)
-    return EOF;
+    return (scm_t_wchar) EOF;
   else
     {
       pt->read_pos = pt->read_buf;
@@ -616,8 +617,8 @@ fport_fill_input (SCM port)
     }
 }
 
-static off_t_or_off64_t
-fport_seek_or_seek64 (SCM port, off_t_or_off64_t offset, int whence)
+static scm_t_off
+fport_seek (SCM port, scm_t_off offset, int whence)
 {
   scm_t_port *pt = SCM_PTAB_ENTRY (port);
   scm_t_fport *fp = SCM_FSTREAM (port);
@@ -668,41 +669,8 @@ fport_seek_or_seek64 (SCM port, off_t_or_off64_t offset, int whence)
   return result;
 }
 
-/* If we've got largefile and off_t isn't already off64_t then
-   fport_seek_or_seek64 needs a range checking wrapper to be fport_seek in
-   the port descriptor.
-
-   Otherwise if no largefile, or off_t is the same as off64_t (which is the
-   case on NetBSD apparently), then fport_seek_or_seek64 is right to be
-   fport_seek already.  */
-
-#if GUILE_USE_64_CALLS && HAVE_STAT64 && SIZEOF_OFF_T != SIZEOF_OFF64_T
-static off_t
-fport_seek (SCM port, off_t offset, int whence)
-{
-  off64_t rv = fport_seek_or_seek64 (port, (off64_t) offset, whence);
-  if (rv > OFF_T_MAX || rv < OFF_T_MIN)
-    {
-      errno = EOVERFLOW;
-      scm_syserror ("fport_seek");
-    }
-  return (off_t) rv;
-
-}
-#else
-#define fport_seek   fport_seek_or_seek64
-#endif
-
-/* `how' has been validated and is one of SEEK_SET, SEEK_CUR or SEEK_END */
-SCM
-scm_i_fport_seek (SCM port, SCM offset, int how)
-{
-  return scm_from_off_t_or_off64_t
-    (fport_seek_or_seek64 (port, scm_to_off_t_or_off64_t (offset), how));
-}
-
 static void
-fport_truncate (SCM port, off_t length)
+fport_truncate (SCM port, scm_t_off length)
 {
   scm_t_fport *fp = SCM_FSTREAM (port);
 
@@ -710,13 +678,6 @@ fport_truncate (SCM port, off_t length)
     scm_syserror ("ftruncate");
 }
 
-int
-scm_i_fport_truncate (SCM port, SCM length)
-{
-  scm_t_fport *fp = SCM_FSTREAM (port);
-  return ftruncate_or_ftruncate64 (fp->fdes, scm_to_off_t_or_off64_t (length));
-}
-
 /* helper for fport_write: try to write data, using multiple system
    calls if required.  */
 #define FUNC_NAME "write_all"
@@ -754,7 +715,7 @@ fport_write (SCM port, const void *data, size_t size)
     }
 
   {
-    off_t space = pt->write_end - pt->write_pos;
+    scm_t_off space = pt->write_end - pt->write_pos;
 
     if (size <= space)
       {
diff --git a/libguile/fports.h b/libguile/fports.h
index c737b1eaa..cbef0f8ec 100644
--- a/libguile/fports.h
+++ b/libguile/fports.h
@@ -3,21 +3,22 @@
 #ifndef SCM_FPORTS_H
 #define SCM_FPORTS_H
 
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2006, 2008, 2009 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -58,8 +59,6 @@ SCM_INTERNAL void scm_init_fports (void);
 /* internal functions */
 
 SCM_INTERNAL SCM scm_i_fdes_to_port (int fdes, long mode_bits, SCM name);
-SCM_INTERNAL int scm_i_fport_truncate (SCM, SCM);
-SCM_INTERNAL SCM scm_i_fport_seek (SCM, SCM, int);
 
 
 #endif  /* SCM_FPORTS_H */
diff --git a/libguile/frames.c b/libguile/frames.c
new file mode 100644
index 000000000..a6835fbb4
--- /dev/null
+++ b/libguile/frames.c
@@ -0,0 +1,272 @@
+/* Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+ * 
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+#if HAVE_CONFIG_H
+#  include <config.h>
+#endif
+
+#include <stdlib.h>
+#include <string.h>
+#include "_scm.h"
+#include "vm-bootstrap.h"
+#include "frames.h"
+
+
+scm_t_bits scm_tc16_vm_frame;
+
+#define RELOC(frame, val) (val + SCM_VM_FRAME_OFFSET (frame))
+
+SCM
+scm_c_make_vm_frame (SCM stack_holder, SCM *fp, SCM *sp,
+                     scm_t_uint8 *ip, scm_t_ptrdiff offset)
+{
+  struct scm_vm_frame *p = scm_gc_malloc (sizeof (struct scm_vm_frame),
+                                          "vmframe");
+  p->stack_holder = stack_holder;
+  p->fp = fp;
+  p->sp = sp;
+  p->ip = ip;
+  p->offset = offset;
+  SCM_RETURN_NEWSMOB (scm_tc16_vm_frame, p);
+}
+
+static int
+vm_frame_print (SCM frame, SCM port, scm_print_state *pstate)
+{
+  scm_puts ("#<vm-frame ", port);
+  scm_uintprint (SCM_UNPACK (frame), 16, port);
+  scm_putc (' ', port);
+  scm_write (scm_vm_frame_program (frame), port);
+  /* don't write args, they can get us into trouble. */
+  scm_puts (">", port);
+
+  return 1;
+}
+
+
+/* Scheme interface */
+
+SCM_DEFINE (scm_vm_frame_p, "vm-frame?", 1, 0, 0,
+	    (SCM obj),
+	    "")
+#define FUNC_NAME s_scm_vm_frame_p
+{
+  return SCM_BOOL (SCM_VM_FRAME_P (obj));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_frame_program, "vm-frame-program", 1, 0, 0,
+	    (SCM frame),
+	    "")
+#define FUNC_NAME s_scm_vm_frame_program
+{
+  SCM_VALIDATE_VM_FRAME (1, frame);
+  return SCM_FRAME_PROGRAM (SCM_VM_FRAME_FP (frame));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_frame_arguments, "vm-frame-arguments", 1, 0, 0,
+	    (SCM frame),
+	    "")
+#define FUNC_NAME s_scm_vm_frame_arguments
+{
+  SCM *fp;
+  int i;
+  struct scm_objcode *bp;
+  SCM ret;
+  
+  SCM_VALIDATE_VM_FRAME (1, frame);
+
+  fp = SCM_VM_FRAME_FP (frame);
+  bp = SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp));
+
+  if (!bp->nargs)
+    return SCM_EOL;
+  else if (bp->nrest)
+    ret = SCM_FRAME_VARIABLE (fp, bp->nargs - 1);
+  else
+    ret = scm_cons (SCM_FRAME_VARIABLE (fp, bp->nargs - 1), SCM_EOL);
+  
+  for (i = bp->nargs - 2; i >= 0; i--)
+    ret = scm_cons (SCM_FRAME_VARIABLE (fp, i), ret);
+  
+  return ret;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_frame_source, "vm-frame-source", 1, 0, 0,
+	    (SCM frame),
+	    "")
+#define FUNC_NAME s_scm_vm_frame_source
+{
+  SCM *fp;
+  struct scm_objcode *bp;
+  
+  SCM_VALIDATE_VM_FRAME (1, frame);
+
+  fp = SCM_VM_FRAME_FP (frame);
+  bp = SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp));
+
+  return scm_c_program_source (SCM_FRAME_PROGRAM (fp),
+                               SCM_VM_FRAME_IP (frame) - bp->base);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_frame_local_ref, "vm-frame-local-ref", 2, 0, 0,
+	    (SCM frame, SCM index),
+	    "")
+#define FUNC_NAME s_scm_vm_frame_local_ref
+{
+  SCM *fp;
+  unsigned int i;
+  struct scm_objcode *bp;
+  
+  SCM_VALIDATE_VM_FRAME (1, frame);
+
+  fp = SCM_VM_FRAME_FP (frame);
+  bp = SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp));
+
+  SCM_VALIDATE_UINT_COPY (2, index, i);
+  SCM_ASSERT_RANGE (2, index, i < bp->nargs + bp->nlocs);
+
+  return SCM_FRAME_VARIABLE (fp, i);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_frame_local_set_x, "vm-frame-local-set!", 3, 0, 0,
+	    (SCM frame, SCM index, SCM val),
+	    "")
+#define FUNC_NAME s_scm_vm_frame_local_set_x
+{
+  SCM *fp;
+  unsigned int i;
+  struct scm_objcode *bp;
+  
+  SCM_VALIDATE_VM_FRAME (1, frame);
+
+  fp = SCM_VM_FRAME_FP (frame);
+  bp = SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp));
+
+  SCM_VALIDATE_UINT_COPY (2, index, i);
+  SCM_ASSERT_RANGE (2, index, i < bp->nargs + bp->nlocs);
+
+  SCM_FRAME_VARIABLE (fp, i) = val;
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_frame_return_address, "vm-frame-return-address", 1, 0, 0,
+	    (SCM frame),
+	    "")
+#define FUNC_NAME s_scm_vm_frame_return_address
+{
+  SCM_VALIDATE_VM_FRAME (1, frame);
+  return scm_from_ulong ((unsigned long)
+			 (SCM_FRAME_RETURN_ADDRESS
+			  (SCM_VM_FRAME_FP (frame))));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_frame_mv_return_address, "vm-frame-mv-return-address", 1, 0, 0,
+	    (SCM frame),
+	    "")
+#define FUNC_NAME s_scm_vm_frame_mv_return_address
+{
+  SCM_VALIDATE_VM_FRAME (1, frame);
+  return scm_from_ulong ((unsigned long)
+			 (SCM_FRAME_MV_RETURN_ADDRESS
+			  (SCM_VM_FRAME_FP (frame))));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_frame_dynamic_link, "vm-frame-dynamic-link", 1, 0, 0,
+	    (SCM frame),
+	    "")
+#define FUNC_NAME s_scm_vm_frame_dynamic_link
+{
+  SCM_VALIDATE_VM_FRAME (1, frame);
+  /* fixme: munge fp if holder is a continuation */
+  return scm_from_ulong
+    ((unsigned long)
+     RELOC (frame,
+            SCM_FRAME_DYNAMIC_LINK (SCM_VM_FRAME_FP (frame))));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_frame_stack, "vm-frame-stack", 1, 0, 0,
+	    (SCM frame),
+	    "")
+#define FUNC_NAME s_scm_vm_frame_stack
+{
+  SCM *top, *bottom, ret = SCM_EOL;
+
+  SCM_VALIDATE_VM_FRAME (1, frame);
+
+  top = SCM_VM_FRAME_SP (frame);
+  bottom = SCM_FRAME_UPPER_ADDRESS (SCM_VM_FRAME_FP (frame));
+  while (bottom <= top)
+    ret = scm_cons (*bottom++, ret);
+
+  return ret;
+}
+#undef FUNC_NAME
+
+extern SCM
+scm_c_vm_frame_prev (SCM frame)
+{
+  SCM *this_fp, *new_fp, *new_sp;
+  this_fp = SCM_VM_FRAME_FP (frame);
+  new_fp = SCM_FRAME_DYNAMIC_LINK (this_fp);
+  if (new_fp) 
+    { new_fp = RELOC (frame, new_fp);
+      new_sp = SCM_FRAME_LOWER_ADDRESS (this_fp) - 1;
+      return scm_c_make_vm_frame (SCM_VM_FRAME_STACK_HOLDER (frame),
+                                  new_fp, new_sp,
+                                  SCM_FRAME_RETURN_ADDRESS (this_fp),
+                                  SCM_VM_FRAME_OFFSET (frame));
+    }
+  else
+    return SCM_BOOL_F;
+}
+
+
+void
+scm_bootstrap_frames (void)
+{
+  scm_tc16_vm_frame = scm_make_smob_type ("vm-frame", 0);
+  scm_set_smob_print (scm_tc16_vm_frame, vm_frame_print);
+  scm_c_register_extension ("libguile", "scm_init_frames",
+                            (scm_t_extension_init_func)scm_init_frames, NULL);
+}
+
+void
+scm_init_frames (void)
+{
+  scm_bootstrap_vm ();
+
+#ifndef SCM_MAGIC_SNARFER
+#include "libguile/frames.x"
+#endif
+}
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/frames.h b/libguile/frames.h
new file mode 100644
index 000000000..0165924a7
--- /dev/null
+++ b/libguile/frames.h
@@ -0,0 +1,126 @@
+/* Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+ * * 
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+#ifndef _SCM_FRAMES_H_
+#define _SCM_FRAMES_H_
+
+#include <libguile.h>
+#include "programs.h"
+
+
+/*
+ * VM frames
+ */
+
+/* VM Frame Layout
+   ---------------
+
+   | ...              |
+   | Intermed. val. 0 | <- fp + bp->nargs + bp->nlocs = SCM_FRAME_UPPER_ADDRESS (fp)
+   +==================+
+   | Local variable 1 |
+   | Local variable 0 | <- fp + bp->nargs
+   | Argument 1       |
+   | Argument 0       | <- fp
+   | Program          | <- fp - 1
+   +------------------+    
+   | Return address   |
+   | MV return address|
+   | Dynamic link     | <- fp - 4 = SCM_FRAME_DATA_ADDRESS (fp) = SCM_FRAME_LOWER_ADDRESS (fp)
+   +==================+
+   |                  |
+
+   As can be inferred from this drawing, it is assumed that
+   `sizeof (SCM *) == sizeof (SCM)', since pointers (the `link' parts) are
+   assumed to be as long as SCM objects.  */
+
+#define SCM_FRAME_DATA_ADDRESS(fp)	(fp - 4)
+#define SCM_FRAME_UPPER_ADDRESS(fp)                             \
+  (fp                                                           \
+   + SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp))->nargs           \
+   + SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp))->nlocs)
+#define SCM_FRAME_LOWER_ADDRESS(fp)	(fp - 4)
+
+#define SCM_FRAME_BYTE_CAST(x)		((scm_t_uint8 *) SCM_UNPACK (x))
+#define SCM_FRAME_STACK_CAST(x)		((SCM *) SCM_UNPACK (x))
+
+#define SCM_FRAME_RETURN_ADDRESS(fp)				\
+  (SCM_FRAME_BYTE_CAST (SCM_FRAME_DATA_ADDRESS (fp)[2]))
+#define SCM_FRAME_SET_RETURN_ADDRESS(fp, ra)			\
+  ((SCM_FRAME_DATA_ADDRESS (fp)[2])) = (SCM)(ra);
+#define SCM_FRAME_MV_RETURN_ADDRESS(fp)				\
+  (SCM_FRAME_BYTE_CAST (SCM_FRAME_DATA_ADDRESS (fp)[1]))
+#define SCM_FRAME_SET_MV_RETURN_ADDRESS(fp, mvra)		\
+  ((SCM_FRAME_DATA_ADDRESS (fp)[1])) = (SCM)(mvra);
+#define SCM_FRAME_DYNAMIC_LINK(fp)				\
+  (SCM_FRAME_STACK_CAST (SCM_FRAME_DATA_ADDRESS (fp)[0]))
+#define SCM_FRAME_SET_DYNAMIC_LINK(fp, dl)			\
+  ((SCM_FRAME_DATA_ADDRESS (fp)[0])) = (SCM)(dl);
+#define SCM_FRAME_VARIABLE(fp,i)	fp[i]
+#define SCM_FRAME_PROGRAM(fp)		fp[-1]
+
+
+/*
+ * Heap frames
+ */
+
+SCM_API scm_t_bits scm_tc16_vm_frame;
+
+struct scm_vm_frame 
+{
+  SCM stack_holder;
+  SCM *fp;
+  SCM *sp;
+  scm_t_uint8 *ip;
+  scm_t_ptrdiff offset;
+};
+
+#define SCM_VM_FRAME_P(x)	SCM_SMOB_PREDICATE (scm_tc16_vm_frame, x)
+#define SCM_VM_FRAME_DATA(x)	((struct scm_vm_frame*)SCM_SMOB_DATA (x))
+#define SCM_VM_FRAME_STACK_HOLDER(f)	SCM_VM_FRAME_DATA(f)->stack_holder
+#define SCM_VM_FRAME_FP(f)	SCM_VM_FRAME_DATA(f)->fp
+#define SCM_VM_FRAME_SP(f)	SCM_VM_FRAME_DATA(f)->sp
+#define SCM_VM_FRAME_IP(f)	SCM_VM_FRAME_DATA(f)->ip
+#define SCM_VM_FRAME_OFFSET(f)	SCM_VM_FRAME_DATA(f)->offset
+#define SCM_VALIDATE_VM_FRAME(p,x)	SCM_MAKE_VALIDATE (p, x, VM_FRAME_P)
+
+SCM_API SCM scm_c_make_vm_frame (SCM stack_holder, SCM *fp, SCM *sp,
+                                 scm_t_uint8 *ip, scm_t_ptrdiff offset);
+SCM_API SCM scm_vm_frame_p (SCM obj);
+SCM_API SCM scm_vm_frame_program (SCM frame);
+SCM_API SCM scm_vm_frame_arguments (SCM frame);
+SCM_API SCM scm_vm_frame_source (SCM frame);
+SCM_API SCM scm_vm_frame_local_ref (SCM frame, SCM index);
+SCM_API SCM scm_vm_frame_local_set_x (SCM frame, SCM index, SCM val);
+SCM_API SCM scm_vm_frame_return_address (SCM frame);
+SCM_API SCM scm_vm_frame_mv_return_address (SCM frame);
+SCM_API SCM scm_vm_frame_dynamic_link (SCM frame);
+SCM_API SCM scm_vm_frame_stack (SCM frame);
+
+SCM_API SCM scm_c_vm_frame_prev (SCM frame);
+
+SCM_INTERNAL void scm_bootstrap_frames (void);
+SCM_INTERNAL void scm_init_frames (void);
+
+#endif /* _SCM_FRAMES_H_ */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/futures.c b/libguile/futures.c
index 1bba960b3..b330f4ded 100644
--- a/libguile/futures.c
+++ b/libguile/futures.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2006, 2008 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/futures.h b/libguile/futures.h
index 95916f33b..5d7712e1a 100644
--- a/libguile/futures.h
+++ b/libguile/futures.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 2002, 2003, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/gc-malloc.c b/libguile/gc-malloc.c
index 6839ba832..e48d2cfd1 100644
--- a/libguile/gc-malloc.c
+++ b/libguile/gc-malloc.c
@@ -1,18 +1,19 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2008, 2009 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -36,7 +37,7 @@ extern unsigned long * __libc_ia64_register_backing_store_base;
 #include "libguile/stackchk.h"
 #include "libguile/struct.h"
 #include "libguile/smob.h"
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
 #include "libguile/async.h"
 #include "libguile/ports.h"
 #include "libguile/root.h"
@@ -77,25 +78,6 @@ extern unsigned long * __libc_ia64_register_backing_store_base;
 
 /* #define DEBUGINFO */
 
-static int scm_i_minyield_malloc;
-
-void
-scm_gc_init_malloc (void)
-{
-  scm_mtrigger = scm_getenv_int ("GUILE_INIT_MALLOC_LIMIT",
-				 SCM_DEFAULT_INIT_MALLOC_LIMIT);
-  scm_i_minyield_malloc = scm_getenv_int ("GUILE_MIN_YIELD_MALLOC",
-					  SCM_DEFAULT_MALLOC_MINYIELD);
-
-  if (scm_i_minyield_malloc >= 100)
-    scm_i_minyield_malloc = 99;
-  if (scm_i_minyield_malloc < 1)
-    scm_i_minyield_malloc = 1;
-
-  if (scm_mtrigger < 0)
-    scm_mtrigger = SCM_DEFAULT_INIT_MALLOC_LIMIT;
-}
-
 
 
 /* Function for non-cell memory management.
diff --git a/libguile/gc-segment-table.c b/libguile/gc-segment-table.c
deleted file mode 100644
index 3e92c8c5c..000000000
--- a/libguile/gc-segment-table.c
+++ /dev/null
@@ -1,299 +0,0 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2006, 2008 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
- */
-
-#ifdef HAVE_CONFIG_H
-# include <config.h>
-#endif
-
-#include <assert.h> 
-#include <stdio.h>
-#include <string.h>
-
-#include "libguile/_scm.h"
-#include "libguile/pairs.h"
-#include "libguile/gc.h"
-#include "libguile/private-gc.h"
-
-
-/*
-  Heap segment table.
-
-  The table is sorted by the address of the data itself. This makes
-  for easy lookups. This is not portable: according to ANSI C,
-  pointers can only be compared within the same object (i.e. the same
-  block of malloced memory.). For machines with weird architectures,
-  this should be revised.
-  
-  (Apparently, for this reason 1.6 and earlier had macros for pointer
-  comparison. )
-  
-  perhaps it is worthwhile to remove the 2nd level of indirection in
-  the table, but this certainly makes for cleaner code.
-*/
-scm_t_heap_segment **scm_i_heap_segment_table;
-size_t scm_i_heap_segment_table_size;
-static scm_t_cell *lowest_cell;
-static scm_t_cell *highest_cell; 
-
-
-/*
-  RETURN: index of inserted segment.
- */
-int
-scm_i_insert_segment (scm_t_heap_segment *seg)
-{
-  size_t size = (scm_i_heap_segment_table_size + 1) * sizeof (scm_t_heap_segment *);
-  SCM_SYSCALL (scm_i_heap_segment_table
-	      = ((scm_t_heap_segment **)
-		 realloc ((char *)scm_i_heap_segment_table, size)));
-
-  /*
-    We can't alloc 4 more bytes. This is hopeless.
-   */
-  if (!scm_i_heap_segment_table)
-    {
-      fprintf (stderr, "scm_i_get_new_heap_segment: Could not grow heap segment table.\n");
-      abort ();
-    }
-
-  if (!lowest_cell)
-    {
-      lowest_cell = seg->bounds[0];
-      highest_cell = seg->bounds[1];
-    }
-  else
-    {
-      lowest_cell = SCM_MIN (lowest_cell, seg->bounds[0]);
-      highest_cell = SCM_MAX (highest_cell, seg->bounds[1]);
-    }
-
-
-  {
-    int i = 0;
-    int j = 0;
-
-    while (i < scm_i_heap_segment_table_size
-	   && scm_i_heap_segment_table[i]->bounds[0] <= seg->bounds[0])
-      i++;
-
-    /*
-      We insert a new entry; if that happens to be before the
-      "current" segment of a freelist, we must move the freelist index
-      as well.
-    */
-    if (scm_i_master_freelist.heap_segment_idx >= i)
-      scm_i_master_freelist.heap_segment_idx ++;
-    if (scm_i_master_freelist2.heap_segment_idx >= i)
-      scm_i_master_freelist2.heap_segment_idx ++;
-
-    for (j = scm_i_heap_segment_table_size; j > i; --j)
-      scm_i_heap_segment_table[j] = scm_i_heap_segment_table[j - 1];
-
-    scm_i_heap_segment_table[i] = seg;
-    scm_i_heap_segment_table_size ++;
-
-    return i;
-  }
-}
-
-
-/*
-  Determine whether the given value does actually represent a cell in
-  some heap segment.  If this is the case, the number of the heap
-  segment is returned.  Otherwise, -1 is returned.  Binary search is
-  used to determine the heap segment that contains the cell.
-
-  I think this function is too long to be inlined. --hwn
-*/
-
-int
-scm_i_find_heap_segment_containing_object (SCM obj)
-{
-  if (!CELL_P (obj))
-    return -1;
-
-  scm_i_find_heap_calls ++;
-  if ((scm_t_cell *) obj < lowest_cell || (scm_t_cell *) obj >= highest_cell)
-    return -1;
-  
-  {
-    scm_t_cell *ptr = SCM2PTR (obj);
-    unsigned int i = 0;
-    unsigned int j = scm_i_heap_segment_table_size - 1;
-
-    if (ptr < scm_i_heap_segment_table[i]->bounds[0])
-      return -1;
-    else if (scm_i_heap_segment_table[j]->bounds[1] <= ptr)
-      return -1;
-    else
-      {
-	while (i < j)
-	  {
-	    if (ptr < scm_i_heap_segment_table[i]->bounds[1])
-	      {
-		break;
-	      }
-	    else if (scm_i_heap_segment_table[j]->bounds[0] <= ptr)
-	      {
-		i = j;
-		break;
-	      }
-	    else
-	      {
-		unsigned long int k = (i + j) / 2;
-
-		if (k == i)
-		  return -1;
-		else if (ptr <  scm_i_heap_segment_table[k]->bounds[1])
-		  {
-		    j = k;
-		    ++i;
-		    if (ptr <  scm_i_heap_segment_table[i]->bounds[0])
-		      return -1;
-		  }
-		else if (scm_i_heap_segment_table[k]->bounds[0] <= ptr)
-		  {
-		    i = k;
-		    --j;
-		    if (scm_i_heap_segment_table[j]->bounds[1] <= ptr)
-		      return -1;
-		  }
-	      }
-	  }
-
-	if (!SCM_DOUBLECELL_ALIGNED_P (obj) && scm_i_heap_segment_table[i]->span == 2)
-	  return -1;
-	else if (SCM_GC_IN_CARD_HEADERP (ptr))
-	  return -1;
-	else
-	  return i;
-      }
-  }
-}
-
-
-int
-scm_i_marked_count (void)
-{
-  int i = 0;
-  int c = 0;
-  for (; i < scm_i_heap_segment_table_size; i++)
-    {
-      c += scm_i_heap_segment_marked_count (scm_i_heap_segment_table[i]);
-    }
-  return c;
-}
-
-
-SCM
-scm_i_sweep_some_segments (scm_t_cell_type_statistics *freelist,
-			   scm_t_sweep_statistics *sweep_stats)
-{
-  int i = freelist->heap_segment_idx;
-  SCM collected = SCM_EOL;
-
-  if (i == -1)			/* huh? --hwn */
-    i++;
-
-  for (;
-       i < scm_i_heap_segment_table_size; i++)
-    {
-      if (scm_i_heap_segment_table[i]->freelist != freelist)
-	continue;
-
-      collected = scm_i_sweep_some_cards (scm_i_heap_segment_table[i],
-					  sweep_stats,
-					  DEFAULT_SWEEP_AMOUNT);
-
-      if (collected != SCM_EOL)       /* Don't increment i */
-	break;
-    }
-
-  freelist->heap_segment_idx = i;
-
-  return collected;
-}
-
-void
-scm_i_reset_segments (void)
-{
-  int i = 0;
-  for (; i < scm_i_heap_segment_table_size; i++)
-    {
-      scm_t_heap_segment *seg = scm_i_heap_segment_table[i];
-      seg->next_free_card = seg->bounds[0];
-    }
-}
-
-
-
-
-/*
-  Return a hashtab with counts of live objects, with tags as keys.
- */
-SCM
-scm_i_all_segments_statistics (SCM tab)
-{
-  int i = 0;
-  for (; i < scm_i_heap_segment_table_size; i++)
-    {
-      scm_t_heap_segment *seg = scm_i_heap_segment_table[i];
-      scm_i_heap_segment_statistics (seg, tab);
-    }
-
-  return tab;
-}
-
-
-unsigned long*
-scm_i_segment_table_info (int* size)
-{
-  *size = scm_i_heap_segment_table_size;  
-  unsigned long *bounds = malloc (sizeof (unsigned long) * *size * 2);
-  int i;
-  if (!bounds)
-    abort ();
-  for (i = *size; i-- > 0; )
-    {
-      bounds[2*i] = (unsigned long)scm_i_heap_segment_table[i]->bounds[0];
-      bounds[2*i+1] = (unsigned long)scm_i_heap_segment_table[i]->bounds[1];
-    }
-  return bounds;
-}
-
-
-void
-scm_i_sweep_all_segments (char const *reason,
-			  scm_t_sweep_statistics *sweep_stats)
-{
-  unsigned i= 0;
-  for (i = 0; i < scm_i_heap_segment_table_size; i++)
-    {
-      scm_i_sweep_segment (scm_i_heap_segment_table[i], sweep_stats);
-    }
-}
-
-
-void
-scm_i_clear_mark_space (void)
-{
-  int i = 0;
-  for (; i < scm_i_heap_segment_table_size; i++)
-    {
-      scm_i_clear_segment_mark_space (scm_i_heap_segment_table[i]);
-    }
-}
diff --git a/libguile/gc.c b/libguile/gc.c
index bb39efd91..d3c53c748 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -1,18 +1,19 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006, 2008, 2009 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 /* #define DEBUGINFO */
@@ -39,7 +40,7 @@ extern unsigned long * __libc_ia64_register_backing_store_base;
 #include "libguile/stackchk.h"
 #include "libguile/struct.h"
 #include "libguile/smob.h"
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
 #include "libguile/async.h"
 #include "libguile/ports.h"
 #include "libguile/root.h"
@@ -106,13 +107,6 @@ int scm_i_cell_validation_already_running ;
 void
 scm_i_expensive_validation_check (SCM cell)
 {
-  if (!scm_in_heap_p (cell))
-    {
-      fprintf (stderr, "scm_assert_cell_valid: this object does not live in the heap: %lux\n",
-	       (unsigned long) SCM_UNPACK (cell));
-      abort ();
-    }
-
   /* If desired, perform additional garbage collections after a user
    * defined number of cell accesses.
    */
@@ -214,17 +208,10 @@ scm_t_c_hook scm_after_sweep_c_hook;
 scm_t_c_hook scm_after_gc_c_hook;
 
 
-/* scm_mtrigger
- * is the number of bytes of malloc allocation needed to trigger gc.
- */
-unsigned long scm_mtrigger;
-
 /* GC Statistics Keeping
  */
-unsigned long scm_mallocated = 0;
 unsigned long scm_gc_ports_collected = 0;
 
-
 static unsigned long protected_obj_count = 0;
 
 
@@ -679,8 +666,6 @@ scm_init_storage ()
   while (j)
     scm_sys_protects[--j] = SCM_BOOL_F;
 
-  j = SCM_HEAP_SEG_SIZE;
-
 #if 0
   /* We can't have a cleanup handler since we have no thread to run it
      in. */
@@ -769,15 +754,10 @@ scm_i_tag_name (scm_t_bits tag)
 {
   if (tag >= 255)
     {
-      if (tag == scm_tc_free_cell)
-	return "free cell";
-
-      {
-	int k = 0xff & (tag >> 8);
-	return (scm_smobs[k].name);
-      }
+      int k = 0xff & (tag >> 8);
+      return (scm_smobs[k].name);
     }
-  
+
   switch (tag) /* 7 bits */
     {
     case scm_tcs_struct:
diff --git a/libguile/gc.h b/libguile/gc.h
index 4692a4935..40dab2ff5 100644
--- a/libguile/gc.h
+++ b/libguile/gc.h
@@ -3,21 +3,22 @@
 #ifndef SCM_GC_H
 #define SCM_GC_H
 
-/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2007, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -115,15 +116,6 @@ typedef struct scm_t_cell
 #define SCM_CELL_TYPE(x) SCM_CELL_WORD_0 (x)
 #define SCM_SET_CELL_TYPE(x, t) SCM_SET_CELL_WORD_0 ((x), (t))
 
-/* Freelists consist of linked cells where the type entry holds the value
- * scm_tc_free_cell and the second entry holds a pointer to the next cell of
- * the freelist.  Due to this structure, freelist cells are not cons cells
- * and thus may not be accessed using SCM_CAR and SCM_CDR.  */
-
-#define SCM_FREE_CELL_CDR(x) \
-  (SCM_GC_CELL_OBJECT ((x), 1))
-#define SCM_SET_FREE_CELL_CDR(x, v) \
-  (SCM_GC_SET_CELL_OBJECT ((x), 1, (v)))
 
 #if (SCM_DEBUG_CELL_ACCESSES == 1)
 /* Set this to != 0 if every cell that is accessed shall be checked:
@@ -160,17 +152,7 @@ SCM_API size_t scm_default_max_segment_size;
 #define  scm_default_max_segment_size deprecated
 #endif
 
-
-SCM_API size_t scm_max_segment_size;
-
-#define SCM_SET_FREELIST_LOC(key,ptr) scm_i_pthread_setspecific ((key), (ptr))
-#define SCM_FREELIST_LOC(key) ((SCM *) scm_i_pthread_getspecific (key))
-SCM_API struct scm_t_cell_type_statistics scm_i_master_freelist;
-SCM_API struct scm_t_cell_type_statistics scm_i_master_freelist2;
-
-SCM_API unsigned long scm_mallocated;
 SCM_API unsigned long scm_gc_ports_collected;
-SCM_API unsigned long scm_mtrigger;
 
 SCM_API SCM scm_after_gc_hook;
 
@@ -180,18 +162,6 @@ SCM_API scm_t_c_hook scm_before_sweep_c_hook;
 SCM_API scm_t_c_hook scm_after_sweep_c_hook;
 SCM_API scm_t_c_hook scm_after_gc_c_hook;
 
-#if defined (GUILE_DEBUG) || defined (GUILE_DEBUG_FREELIST)
-#if (SCM_ENABLE_DEPRECATED == 1)
-SCM scm_map_free_list (void);
-#else
-#define scm_map_free_list deprecated
-#define scm_free_list_length deprecated
-#endif
-#endif
-
-#if (SCM_ENABLE_DEPRECATED == 1) && defined (GUILE_DEBUG_FREELIST)
-SCM_API SCM scm_gc_set_debug_check_freelist_x (SCM flag);
-#endif
 
 
 #if (SCM_DEBUG_CELL_ACCESSES == 1)
@@ -210,7 +180,6 @@ SCM_API SCM scm_gc_live_object_stats (void);
 SCM_API SCM scm_gc (void);
 SCM_API void scm_i_gc (const char *what);
 SCM_API void scm_gc_mark (SCM p);
-SCM_API int scm_in_heap_p (SCM value);
 SCM_API void scm_gc_sweep (void);
 
 SCM_API void *scm_malloc (size_t size);
diff --git a/libguile/gdb_interface.h b/libguile/gdb_interface.h
index 5be4d0786..2278fc2c2 100644
--- a/libguile/gdb_interface.h
+++ b/libguile/gdb_interface.h
@@ -5,19 +5,20 @@
 /* Simple interpreter interface for GDB, the GNU debugger.
    Copyright (C) 1996, 2000, 2001, 2006 Free Software Foundation
 
- This library is free software; you can redistribute it and/or
- modify it under the terms of the GNU Lesser General Public
- License as published by the Free Software Foundation; either
- version 2.1 of the License, or (at your option) any later version.
-
- This library is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- Lesser General Public License for more details.
-
- You should have received a copy of the GNU Lesser General Public
- License along with this library; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
 
 The author can be reached at djurfeldt@nada.kth.se
 Mikael Djurfeldt, SANS/NADA KTH, 10044 STOCKHOLM, SWEDEN  */
diff --git a/libguile/gdbint.c b/libguile/gdbint.c
index 4ec9ad48c..0d55e7de4 100644
--- a/libguile/gdbint.c
+++ b/libguile/gdbint.c
@@ -3,18 +3,19 @@
  * Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 #ifdef HAVE_CONFIG_H
diff --git a/libguile/gdbint.h b/libguile/gdbint.h
index 64b9559c9..d7c6cf31e 100644
--- a/libguile/gdbint.h
+++ b/libguile/gdbint.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1996,2000, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/gen-scmconfig.c b/libguile/gen-scmconfig.c
index 85ebfaed7..0e897ca8c 100644
--- a/libguile/gen-scmconfig.c
+++ b/libguile/gen-scmconfig.c
@@ -125,6 +125,7 @@
 
 #include <stdio.h>
 #include <string.h>
+#include <uniconv.h>
 
 #define pf printf
 
@@ -279,21 +280,6 @@ main (int argc, char *argv[])
   pf ("#define SCM_SIZEOF_LONG_LONG %d\n", SIZEOF_LONG_LONG);
   pf ("#define SCM_SIZEOF_UNSIGNED_LONG_LONG %d\n", SIZEOF_UNSIGNED_LONG_LONG);
 
-  pf("\n");
-  pf("/* handling for the deprecated long_long and ulong_long types */\n");  
-  pf("/* If anything suitable is available, it'll be defined here.  */\n");  
-  pf("#if (SCM_ENABLE_DEPRECATED == 1)\n");
-  if (SIZEOF_LONG_LONG != 0)
-    pf ("typedef long long long_long;\n");
-  else if (SIZEOF___INT64 != 0)
-    pf ("typedef __int64 long_long;\n");
-  
-  if (SIZEOF_UNSIGNED_LONG_LONG != 0)
-    pf ("typedef unsigned long long ulong_long;\n");
-  else if (SIZEOF_UNSIGNED___INT64 != 0)
-    pf ("typedef unsigned __int64 ulong_long;\n");
-  pf("#endif /* SCM_ENABLE_DEPRECATED == 1 */\n");
-
   pf ("\n");
   pf ("/* These are always defined. */\n");
   pf ("typedef %s scm_t_int8;\n", SCM_I_GSC_T_INT8);
@@ -400,6 +386,24 @@ main (int argc, char *argv[])
   pf ("#define SCM_HAVE_READDIR64_R 0 /* 0 or 1 */\n");
 #endif
 
+  /* Arrange so that we have a file offset type that reflects the one
+     used when compiling Guile, regardless of what the application's
+     `_FILE_OFFSET_BITS' says.  See
+     http://lists.gnu.org/archive/html/bug-guile/2009-06/msg00018.html
+     for the original bug report.
+
+     Note that we can't define `scm_t_off' in terms of `off_t' or
+     `off64_t' because they may or may not be available depending on
+     how the application that uses Guile is compiled.  */
+
+#if defined GUILE_USE_64_CALLS && defined HAVE_STAT64
+  pf ("typedef scm_t_int64 scm_t_off;\n");
+#elif SIZEOF_OFF_T == SIZEOF_INT
+  pf ("typedef int scm_t_off;\n");
+#else
+  pf ("typedef long int scm_t_off;\n");
+#endif
+
 #if USE_DLL_IMPORT
   pf ("\n");
   pf ("/* Define some additional CPP macros on Win32 platforms. */\n");
@@ -421,6 +425,14 @@ main (int argc, char *argv[])
 
   pf ("#define SCM_HAVE_ARRAYS 1 /* always true now */\n");
 
+  pf ("\n");
+  pf ("/* Constants from uniconv.h.  */\n");
+  pf ("#define SCM_ICONVEH_ERROR %d\n", (int) iconveh_error);
+  pf ("#define SCM_ICONVEH_QUESTION_MARK %d\n", 
+      (int) iconveh_question_mark);
+  pf ("#define SCM_ICONVEH_ESCAPE_SEQUENCE %d\n",
+      (int) iconveh_escape_sequence);  
+
   printf ("#endif\n");
 
   return 0;
diff --git a/libguile/generalized-arrays.c b/libguile/generalized-arrays.c
new file mode 100644
index 000000000..6394405dd
--- /dev/null
+++ b/libguile/generalized-arrays.c
@@ -0,0 +1,276 @@
+/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009 Free Software Foundation, Inc.
+ * 
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+
+
+
+#ifdef HAVE_CONFIG_H
+#  include <config.h>
+#endif
+
+#include <stdio.h>
+#include <errno.h>
+#include <string.h>
+
+#include "libguile/_scm.h"
+#include "libguile/__scm.h"
+#include "libguile/array-handle.h"
+#include "libguile/generalized-arrays.h"
+
+
+int
+scm_is_array (SCM obj)
+{
+  return scm_i_array_implementation_for_obj (obj) ? 1 : 0;
+}
+
+SCM_DEFINE (scm_array_p, "array?", 1, 0, 0,
+           (SCM obj),
+	    "Return @code{#t} if the @var{obj} is an array, and @code{#f} if\n"
+	    "not.")
+#define FUNC_NAME s_scm_array_p
+{
+  return scm_from_bool (scm_is_array (obj));
+}
+#undef FUNC_NAME
+
+int
+scm_is_typed_array (SCM obj, SCM type)
+{
+  int ret = 0;
+  if (scm_i_array_implementation_for_obj (obj))
+    {
+      scm_t_array_handle h;
+
+      scm_array_get_handle (obj, &h);
+      ret = scm_is_eq (scm_array_handle_element_type (&h), type);
+      scm_array_handle_release (&h);
+    }
+
+  return ret;
+}
+
+SCM_DEFINE (scm_typed_array_p, "typed-array?", 2, 0, 0,
+           (SCM obj, SCM type),
+	    "Return @code{#t} if the @var{obj} is an array of type\n"
+	    "@var{type}, and @code{#f} if not.")
+#define FUNC_NAME s_scm_typed_array_p
+{
+  return scm_from_bool (scm_is_typed_array (obj, type));
+}
+#undef FUNC_NAME
+
+size_t
+scm_c_array_rank (SCM array)
+{
+  scm_t_array_handle handle;
+  size_t res;
+
+  scm_array_get_handle (array, &handle);
+  res = scm_array_handle_rank (&handle);
+  scm_array_handle_release (&handle);
+  return res;
+}
+
+SCM_DEFINE (scm_array_rank, "array-rank", 1, 0, 0, 
+           (SCM array),
+	    "Return the number of dimensions of the array @var{array.}\n")
+#define FUNC_NAME s_scm_array_rank
+{
+  return scm_from_size_t (scm_c_array_rank (array));
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_array_dimensions, "array-dimensions", 1, 0, 0, 
+           (SCM ra),
+	    "@code{array-dimensions} is similar to @code{array-shape} but replaces\n"
+	    "elements with a @code{0} minimum with one greater than the maximum. So:\n"
+	    "@lisp\n"
+	    "(array-dimensions (make-array 'foo '(-1 3) 5)) @result{} ((-1 3) 5)\n"
+	    "@end lisp")
+#define FUNC_NAME s_scm_array_dimensions
+{
+  scm_t_array_handle handle;
+  scm_t_array_dim *s;
+  SCM res = SCM_EOL;
+  size_t k;
+      
+  scm_array_get_handle (ra, &handle);
+  s = scm_array_handle_dims (&handle);
+  k = scm_array_handle_rank (&handle);
+
+  while (k--)
+    res = scm_cons (s[k].lbnd
+		    ? scm_cons2 (scm_from_ssize_t (s[k].lbnd),
+				 scm_from_ssize_t (s[k].ubnd),
+				 SCM_EOL)
+		    : scm_from_ssize_t (1 + s[k].ubnd),
+		    res);
+
+  scm_array_handle_release (&handle);
+  return res;
+}
+#undef FUNC_NAME
+
+/* HACK*/
+#include "libguile/bytevectors.h"
+
+SCM_DEFINE (scm_array_type, "array-type", 1, 0, 0, 
+           (SCM ra),
+	    "")
+#define FUNC_NAME s_scm_array_type
+{
+  scm_t_array_handle h;
+  SCM type;
+
+  /* a hack, until srfi-4 and bytevectors are reunited */
+  if (scm_is_bytevector (ra))
+    return scm_from_locale_symbol ("vu8");
+
+  scm_array_get_handle (ra, &h);
+  type = scm_array_handle_element_type (&h);
+  scm_array_handle_release (&h);
+  
+  return type;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_array_in_bounds_p, "array-in-bounds?", 1, 0, 1, 
+           (SCM ra, SCM args),
+	    "Return @code{#t} if its arguments would be acceptable to\n"
+	    "@code{array-ref}.")
+#define FUNC_NAME s_scm_array_in_bounds_p
+{
+  SCM res = SCM_BOOL_T;
+  size_t k, ndim;
+  scm_t_array_dim *s;
+  scm_t_array_handle handle;
+
+  SCM_VALIDATE_REST_ARGUMENT (args);
+
+  scm_array_get_handle (ra, &handle);
+  s = scm_array_handle_dims (&handle);
+  ndim = scm_array_handle_rank (&handle);
+
+  for (k = 0; k < ndim; k++)
+    {
+      long ind;
+
+      if (!scm_is_pair (args))
+        SCM_WRONG_NUM_ARGS ();
+      ind = scm_to_long (SCM_CAR (args));
+      args = SCM_CDR (args);
+
+      if (ind < s[k].lbnd || ind > s[k].ubnd)
+        {
+          res = SCM_BOOL_F;
+          /* We do not stop the checking after finding a violation
+             since we want to validate the type-correctness and
+             number of arguments in any case.
+          */
+        }
+    }
+
+  scm_array_handle_release (&handle);
+  return res;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_array_ref, "array-ref", 1, 0, 1,
+           (SCM v, SCM args),
+	    "Return the element at the @code{(index1, index2)} element in\n"
+	    "@var{array}.")
+#define FUNC_NAME s_scm_array_ref
+{
+  scm_t_array_handle handle;
+  SCM res;
+
+  scm_array_get_handle (v, &handle);
+  res = scm_array_handle_ref (&handle, scm_array_handle_pos (&handle, args));
+  scm_array_handle_release (&handle);
+  return res;
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1, 
+           (SCM v, SCM obj, SCM args),
+	    "Set the element at the @code{(index1, index2)} element in @var{array} to\n"
+	    "@var{new-value}.  The value returned by array-set! is unspecified.")
+#define FUNC_NAME s_scm_array_set_x           
+{
+  scm_t_array_handle handle;
+
+  scm_array_get_handle (v, &handle);
+  scm_array_handle_set (&handle, scm_array_handle_pos (&handle, args), obj);
+  scm_array_handle_release (&handle);
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+static SCM 
+array_to_list (scm_t_array_handle *h, size_t dim, unsigned long pos)
+{
+  if (dim == scm_array_handle_rank (h))
+    return scm_array_handle_ref (h, pos);
+  else
+    {
+      SCM res = SCM_EOL;
+      long inc;
+      size_t i, lbnd;
+
+      i = h->dims[dim].ubnd;
+      lbnd = h->dims[dim].lbnd;
+      inc = h->dims[dim].inc;
+      pos += (i - h->dims[dim].ubnd) * inc;
+
+      for (; i >= lbnd; i--, pos -= inc)
+        res = scm_cons (array_to_list (h, dim + 1, pos), res);
+      return res;
+    }
+}
+
+SCM_DEFINE (scm_array_to_list, "array->list", 1, 0, 0, 
+            (SCM array),
+	    "FIXME description a list consisting of all the elements, in order, of\n"
+	    "@var{array}.")
+#define FUNC_NAME s_scm_array_to_list
+{
+  scm_t_array_handle h;
+  SCM res;  
+  
+  scm_array_get_handle (array, &h);
+  res = array_to_list (&h, 0, 0);
+  scm_array_handle_release (&h);
+
+  return res;
+}
+#undef FUNC_NAME
+
+void
+scm_init_generalized_arrays ()
+{
+#include "libguile/generalized-arrays.x"
+}
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/generalized-arrays.h b/libguile/generalized-arrays.h
new file mode 100644
index 000000000..cc7214e8b
--- /dev/null
+++ b/libguile/generalized-arrays.h
@@ -0,0 +1,63 @@
+/* classes: h_files */
+
+#ifndef SCM_GENERALIZED_ARRAYS_H
+#define SCM_GENERALIZED_ARRAYS_H
+
+/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009 Free Software Foundation, Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+
+
+#include "libguile/__scm.h"
+#include "libguile/array-handle.h"
+
+
+
+/* These functions operate on all kinds of arrays that Guile knows about.
+ */
+
+
+/** Arrays */
+
+SCM_API int scm_is_array (SCM obj);
+SCM_API SCM scm_array_p (SCM v);
+
+SCM_API int scm_is_typed_array (SCM obj, SCM type);
+SCM_API SCM scm_typed_array_p (SCM v, SCM type);
+
+SCM_API size_t scm_c_array_rank (SCM ra);
+SCM_API SCM scm_array_rank (SCM ra);
+
+SCM_API SCM scm_array_dimensions (SCM ra);
+SCM_API SCM scm_array_type (SCM ra);
+SCM_API SCM scm_array_in_bounds_p (SCM v, SCM args);
+
+SCM_API SCM scm_array_ref (SCM v, SCM args);
+SCM_API SCM scm_array_set_x (SCM v, SCM obj, SCM args);
+SCM_API SCM scm_array_to_list (SCM v);
+
+SCM_INTERNAL void scm_init_generalized_arrays (void);
+
+
+#endif  /* SCM_GENERALIZED_ARRAYS_H */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/generalized-vectors.c b/libguile/generalized-vectors.c
new file mode 100644
index 000000000..2d437a475
--- /dev/null
+++ b/libguile/generalized-vectors.c
@@ -0,0 +1,201 @@
+/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009 Free Software Foundation, Inc.
+ * 
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+
+
+
+#ifdef HAVE_CONFIG_H
+#  include <config.h>
+#endif
+
+#include "libguile/_scm.h"
+#include "libguile/__scm.h"
+
+#include "libguile/array-handle.h"
+#include "libguile/generalized-arrays.h"
+#include "libguile/generalized-vectors.h"
+
+
+struct scm_t_vector_ctor
+{
+  SCM tag;
+  SCM (*ctor)(SCM, SCM);
+};
+
+#define VECTOR_CTORS_N_STATIC_ALLOC 20
+static struct scm_t_vector_ctor vector_ctors[VECTOR_CTORS_N_STATIC_ALLOC];
+static int num_vector_ctors_registered = 0;
+
+void
+scm_i_register_vector_constructor (SCM type, SCM (*ctor)(SCM, SCM))
+{
+  if (num_vector_ctors_registered >= VECTOR_CTORS_N_STATIC_ALLOC)
+    /* need to increase VECTOR_CTORS_N_STATIC_ALLOC, buster */
+    abort ();
+  else
+    { 
+      vector_ctors[num_vector_ctors_registered].tag = type;
+      vector_ctors[num_vector_ctors_registered].ctor = ctor;
+      num_vector_ctors_registered++;
+    }
+}
+
+SCM_DEFINE (scm_make_generalized_vector, "make-generalized-vector", 2, 1, 0,
+            (SCM type, SCM len, SCM fill),
+            "Make a generalized vector")
+#define FUNC_NAME s_scm_make_generalized_vector
+{
+  int i;
+  for (i = 0; i < num_vector_ctors_registered; i++)
+    if (vector_ctors[i].tag == type)
+      return vector_ctors[i].ctor(len, fill);
+  scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, type, "array type");
+}
+#undef FUNC_NAME
+
+int
+scm_is_generalized_vector (SCM obj)
+{
+  int ret = 0;
+  if (scm_is_array (obj))
+    {
+      scm_t_array_handle h;
+      scm_array_get_handle (obj, &h);
+      ret = scm_array_handle_rank (&h) == 1;
+      scm_array_handle_release (&h);
+    }
+  return ret;
+}
+
+SCM_DEFINE (scm_generalized_vector_p, "generalized-vector?", 1, 0, 0,
+	    (SCM obj),
+	    "Return @code{#t} if @var{obj} is a vector, string,\n"
+	    "bitvector, or uniform numeric vector.")
+#define FUNC_NAME s_scm_generalized_vector_p
+{
+  return scm_from_bool (scm_is_generalized_vector (obj));
+}
+#undef FUNC_NAME
+
+#define SCM_VALIDATE_VECTOR_WITH_HANDLE(pos, val, handle)   \
+  scm_generalized_vector_get_handle (val, handle)
+   
+
+void
+scm_generalized_vector_get_handle (SCM vec, scm_t_array_handle *h)
+{
+  scm_array_get_handle (vec, h);
+  if (scm_array_handle_rank (h) != 1)
+    {
+      scm_array_handle_release (h);
+      scm_wrong_type_arg_msg (NULL, 0, vec, "vector");
+    }
+}
+
+size_t
+scm_c_generalized_vector_length (SCM v)
+{
+  scm_t_array_handle h;
+  size_t ret;
+  scm_generalized_vector_get_handle (v, &h);
+  ret = h.dims[0].ubnd - h.dims[0].lbnd + 1;
+  scm_array_handle_release (&h);
+  return ret;
+}
+
+SCM_DEFINE (scm_generalized_vector_length, "generalized-vector-length", 1, 0, 0,
+	    (SCM v),
+	    "Return the length of the generalized vector @var{v}.")
+#define FUNC_NAME s_scm_generalized_vector_length
+{
+  return scm_from_size_t (scm_c_generalized_vector_length (v));
+}
+#undef FUNC_NAME
+
+SCM
+scm_c_generalized_vector_ref (SCM v, size_t idx)
+{
+  scm_t_array_handle h;
+  SCM ret;
+  scm_generalized_vector_get_handle (v, &h);
+  ret = h.impl->vref (&h, idx);
+  scm_array_handle_release (&h);
+  return ret;
+}
+
+SCM_DEFINE (scm_generalized_vector_ref, "generalized-vector-ref", 2, 0, 0,
+	    (SCM v, SCM idx),
+	    "Return the element at index @var{idx} of the\n"
+	    "generalized vector @var{v}.")
+#define FUNC_NAME s_scm_generalized_vector_ref
+{
+  return scm_c_generalized_vector_ref (v, scm_to_size_t (idx));
+}
+#undef FUNC_NAME
+
+void
+scm_c_generalized_vector_set_x (SCM v, size_t idx, SCM val)
+{
+  scm_t_array_handle h;
+  scm_generalized_vector_get_handle (v, &h);
+  h.impl->vset (&h, idx, val);
+  scm_array_handle_release (&h);
+}
+
+SCM_DEFINE (scm_generalized_vector_set_x, "generalized-vector-set!", 3, 0, 0,
+	    (SCM v, SCM idx, SCM val),
+	    "Set the element at index @var{idx} of the\n"
+	    "generalized vector @var{v} to @var{val}.")
+#define FUNC_NAME s_scm_generalized_vector_set_x
+{
+  scm_c_generalized_vector_set_x (v, scm_to_size_t (idx), val);
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_generalized_vector_to_list, "generalized-vector->list", 1, 0, 0,
+	    (SCM v),
+	    "Return a new list whose elements are the elements of the\n"
+	    "generalized vector @var{v}.")
+#define FUNC_NAME s_scm_generalized_vector_to_list
+{
+  SCM ret = SCM_EOL;
+  ssize_t pos, i = 0;
+  scm_t_array_handle h;
+  scm_generalized_vector_get_handle (v, &h);
+  // FIXME CHECKME
+  for (pos = h.dims[0].ubnd, i = (h.dims[0].ubnd - h.dims[0].lbnd + 1);
+       i >= 0;
+       pos += h.dims[0].inc)
+    ret = scm_cons (h.impl->vref (&h, pos), ret);
+  scm_array_handle_release (&h);
+  return ret;
+}
+#undef FUNC_NAME
+
+void
+scm_init_generalized_vectors ()
+{
+#include "libguile/generalized-vectors.x"
+}
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/generalized-vectors.h b/libguile/generalized-vectors.h
new file mode 100644
index 000000000..71b58d291
--- /dev/null
+++ b/libguile/generalized-vectors.h
@@ -0,0 +1,61 @@
+/* classes: h_files */
+
+#ifndef SCM_GENERALIZED_VECTORS_H
+#define SCM_GENERALIZED_VECTORS_H
+
+/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009 Free Software Foundation, Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+
+
+#include "libguile/__scm.h"
+#include "libguile/array-handle.h"
+
+
+
+/* Generalized vectors */
+
+SCM_API SCM scm_generalized_vector_p (SCM v);
+SCM_API SCM scm_generalized_vector_length (SCM v);
+SCM_API SCM scm_generalized_vector_ref (SCM v, SCM idx);
+SCM_API SCM scm_generalized_vector_set_x (SCM v, SCM idx, SCM val);
+SCM_API SCM scm_generalized_vector_to_list (SCM v);
+
+SCM_API int scm_is_generalized_vector (SCM obj);
+SCM_API size_t scm_c_generalized_vector_length (SCM v);
+SCM_API SCM scm_c_generalized_vector_ref (SCM v, size_t idx);
+SCM_API void scm_c_generalized_vector_set_x (SCM v, size_t idx, SCM val);
+SCM_API void scm_generalized_vector_get_handle (SCM vec,
+						scm_t_array_handle *h);
+
+SCM_API SCM scm_make_generalized_vector (SCM type, SCM len, SCM fill);
+SCM_INTERNAL void scm_i_register_vector_constructor (SCM type, SCM (*ctor)(SCM, SCM));
+
+#define SCM_VECTOR_IMPLEMENTATION(type, ctor)                   \
+  SCM_SNARF_INIT (scm_i_register_vector_constructor             \
+                  (scm_i_array_element_types[type], ctor))
+
+SCM_INTERNAL void scm_init_generalized_vectors (void);
+
+#endif  /* SCM_GENERALIZED_VECTORS_H */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/gettext.c b/libguile/gettext.c
index e74f9f351..2ae3ae5e4 100644
--- a/libguile/gettext.c
+++ b/libguile/gettext.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 2004, 2006 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/gettext.h b/libguile/gettext.h
index 8a13307d5..d4576bd6a 100644
--- a/libguile/gettext.h
+++ b/libguile/gettext.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 2004, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 #include "libguile/__scm.h"
diff --git a/libguile/goops.c b/libguile/goops.c
index bbeb58433..4616fa240 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -2,18 +2,19 @@
  * Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -59,24 +60,32 @@
 
 #define SPEC_OF(x)  SCM_SLOT (x, scm_si_specializers)
 
-#define DEFVAR(v, val) \
-{ scm_eval (scm_list_3 (scm_sym_define_public, (v), (val)), \
-	    scm_module_goops); }
-/* Temporary hack until we get the new module system */
-/*fixme* Should optimize by keeping track of the variable object itself */
-#define GETVAR(v) (SCM_VARIABLE_REF (scm_call_2 (scm_goops_lookup_closure,  \
-						 (v), SCM_BOOL_F)))
-
-/* Fixme: Should use already interned symbols */
-
-#define CALL_GF1(name, a)	(scm_call_1 (GETVAR (scm_from_locale_symbol (name)), \
-					     a))
-#define CALL_GF2(name, a, b)	(scm_call_2 (GETVAR (scm_from_locale_symbol (name)), \
-					     a, b))
-#define CALL_GF3(name, a, b, c)	(scm_call_3 (GETVAR (scm_from_locale_symbol (name)), \
-					     a, b, c))
-#define CALL_GF4(name, a, b, c, d)	(scm_call_4 (GETVAR (scm_from_locale_symbol (name)), \
-					     a, b, c, d))
+/* this file is a mess. in theory, though, we shouldn't have many SCM references
+   -- most of the references should be to vars. */
+
+static SCM var_slot_unbound = SCM_BOOL_F;
+static SCM var_slot_missing = SCM_BOOL_F;
+static SCM var_compute_cpl = SCM_BOOL_F;
+static SCM var_no_applicable_method = SCM_BOOL_F;
+static SCM var_memoize_method_x = SCM_BOOL_F;
+static SCM var_change_class = SCM_BOOL_F;
+
+SCM_SYMBOL (sym_slot_unbound, "slot-unbound");
+SCM_SYMBOL (sym_slot_missing, "slot-missing");
+SCM_SYMBOL (sym_compute_cpl, "compute-cpl");
+SCM_SYMBOL (sym_no_applicable_method, "no-applicable-method");
+SCM_SYMBOL (sym_memoize_method_x, "memoize-method!");
+SCM_SYMBOL (sym_change_class, "change-class");
+
+SCM_VARIABLE (scm_var_make_extended_generic, "make-extended-generic");
+
+
+/* FIXME, exports should come from the scm file only */
+#define DEFVAR(v, val)                                          \
+  { scm_module_define (scm_module_goops, (v), (val));           \
+    scm_module_export (scm_module_goops, scm_list_1 ((v)));     \
+  }
+
 
 /* Class redefinition protocol:
 
@@ -119,8 +128,6 @@
 static int goops_loaded_p = 0;
 static scm_t_rstate *goops_rstate;
 
-static SCM scm_goops_lookup_closure;
-
 /* These variables are filled in by the object system when loaded. */
 SCM scm_class_boolean, scm_class_char, scm_class_pair;
 SCM scm_class_procedure, scm_class_string, scm_class_symbol;
@@ -169,6 +176,8 @@ static SCM scm_unbound_p (SCM obj);
 static SCM scm_assert_bound (SCM value, SCM obj);
 static SCM scm_at_assert_bound_ref (SCM obj, SCM index);
 static SCM scm_sys_goops_loaded (void);
+static SCM scm_make_extended_class_from_symbol (SCM type_name_sym, 
+						int applicablep);
 
 /* This function is used for efficient type dispatch.  */
 SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
@@ -234,6 +243,7 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
 	  else
 	    return scm_class_procedure;
 	case scm_tc7_gsubr:
+	case scm_tc7_program:
 	  return scm_class_procedure;
 	case scm_tc7_pws:
 	  return scm_class_procedure_with_setter;
@@ -273,9 +283,9 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
 	      else
 		{
 		  SCM name = SCM_STRUCT_TABLE_NAME (SCM_CDR (handle));
-		  SCM class = scm_make_extended_class (scm_is_true (name)
-						       ? scm_i_symbol_chars (name)
-						       : 0,
+		  SCM class = scm_make_extended_class_from_symbol (scm_is_true (name)
+						       ? name
+						       : scm_nullstr,
 						       SCM_I_OPERATORP (x));
 		  SCM_SET_STRUCT_TABLE_CLASS (SCM_CDR (handle), class);
 		  return class;
@@ -346,7 +356,7 @@ static SCM
 compute_cpl (SCM class)
 {
   if (goops_loaded_p)
-    return CALL_GF1 ("compute-cpl", class);
+    return scm_call_1 (SCM_VARIABLE_REF (var_compute_cpl), class);
   else
     {
       SCM supers = SCM_SLOT (class, scm_si_direct_supers);
@@ -588,13 +598,10 @@ SCM_DEFINE (scm_sys_initialize_object, "%initialize-object", 2, 0, 0,
 	    {
 	      slot_value = get_slot_value (class, obj, SCM_CAR (get_n_set));
 	      if (SCM_GOOPS_UNBOUNDP (slot_value))
-		{
-		  SCM env = SCM_EXTEND_ENV (SCM_EOL, SCM_EOL, SCM_ENV (tmp));
-		  set_slot_value (class,
-				  obj,
-				  SCM_CAR (get_n_set),
-				  scm_eval_body (SCM_CLOSURE_BODY (tmp), env));
-		}
+                set_slot_value (class,
+                                obj,
+                                SCM_CAR (get_n_set),
+                                scm_call_0 (tmp));
 	    }
 	}
     }
@@ -1195,7 +1202,7 @@ SCM_DEFINE (scm_assert_bound, "assert-bound", 2, 0, 0,
 #define FUNC_NAME s_scm_assert_bound
 {
   if (SCM_GOOPS_UNBOUNDP (value))
-    return CALL_GF1 ("slot-unbound", obj);
+    return scm_call_1 (SCM_VARIABLE_REF (var_slot_unbound), obj);
   return value;
 }
 #undef FUNC_NAME
@@ -1208,7 +1215,7 @@ SCM_DEFINE (scm_at_assert_bound_ref, "@assert-bound-ref", 2, 0, 0,
 {
   SCM value = SCM_SLOT (obj, scm_to_int (index));
   if (SCM_GOOPS_UNBOUNDP (value))
-    return CALL_GF1 ("slot-unbound", obj);
+    return scm_call_1 (SCM_VARIABLE_REF (var_slot_unbound), obj);
   return value;
 }
 #undef FUNC_NAME
@@ -1250,10 +1257,7 @@ SCM_DEFINE (scm_sys_fast_slot_set_x, "%fast-slot-set!", 3, 0, 0,
 #undef FUNC_NAME
 
 
-SCM_SYNTAX (s_atslot_ref, "@slot-ref", scm_i_makbimacro, scm_m_atslot_ref);
-SCM_SYNTAX (s_atslot_set_x, "@slot-set!", scm_i_makbimacro, scm_m_atslot_set_x);
-
-
+
 /** Utilities **/
 
 /* In the future, this function will return the effective slot
@@ -1296,7 +1300,7 @@ get_slot_value (SCM class SCM_UNUSED, SCM obj, SCM slotdef)
 
       code = SCM_CAR (access);
       if (!SCM_CLOSUREP (code))
-	return SCM_SUBRF (code) (obj);
+	return scm_call_1 (code, obj);
       env  = SCM_EXTEND_ENV (SCM_CLOSURE_FORMALS (code),
 			     scm_list_1 (obj),
 			     SCM_ENV (code));
@@ -1313,7 +1317,7 @@ get_slot_value_using_name (SCM class, SCM obj, SCM slot_name)
   if (scm_is_true (slotdef))
     return get_slot_value (class, obj, slotdef);
   else
-    return CALL_GF3 ("slot-missing", class, obj, slot_name);
+    return scm_call_3 (SCM_VARIABLE_REF (var_slot_missing), class, obj, slot_name);
 }
 
 static SCM
@@ -1339,7 +1343,7 @@ set_slot_value (SCM class SCM_UNUSED, SCM obj, SCM slotdef, SCM value)
 
       code = SCM_CADR (access);
       if (!SCM_CLOSUREP (code))
-	SCM_SUBRF (code) (obj, value);
+	scm_call_2 (code, obj, value);
       else
 	{
 	  env  = SCM_EXTEND_ENV (SCM_CLOSURE_FORMALS (code),
@@ -1360,7 +1364,7 @@ set_slot_value_using_name (SCM class, SCM obj, SCM slot_name, SCM value)
   if (scm_is_true (slotdef))
     return set_slot_value (class, obj, slotdef, value);
   else
-    return CALL_GF4 ("slot-missing", class, obj, slot_name, value);
+    return scm_call_4 (SCM_VARIABLE_REF (var_slot_missing), class, obj, slot_name, value);
 }
 
 static SCM
@@ -1390,7 +1394,7 @@ SCM_DEFINE (scm_slot_ref_using_class, "slot-ref-using-class", 3, 0, 0,
 
   res = get_slot_value_using_name (class, obj, slot_name);
   if (SCM_GOOPS_UNBOUNDP (res))
-    return CALL_GF3 ("slot-unbound", class, obj, slot_name);
+    return scm_call_3 (SCM_VARIABLE_REF (var_slot_unbound), class, obj, slot_name);
   return res;
 }
 #undef FUNC_NAME
@@ -1453,7 +1457,7 @@ SCM_DEFINE (scm_slot_ref, "slot-ref", 2, 0, 0,
 
   res = get_slot_value_using_name (class, obj, slot_name);
   if (SCM_GOOPS_UNBOUNDP (res))
-    return CALL_GF3 ("slot-unbound", class, obj, slot_name);
+    return scm_call_3 (SCM_VARIABLE_REF (var_slot_unbound), class, obj, slot_name);
   return res;
 }
 #undef FUNC_NAME
@@ -1522,11 +1526,11 @@ wrap_init (SCM class, SCM *m, long n)
 {
   long i;
   scm_t_bits slayout = SCM_STRUCT_DATA (class)[scm_vtable_index_layout];
-  const char *layout = scm_i_symbol_chars (SCM_PACK (slayout));
+  SCM layout = SCM_PACK (slayout);
 
   /* Set all SCM-holding slots to unbound */
   for (i = 0; i < n; i++)
-    if (layout[i*2] == 'p')
+    if (scm_i_symbol_ref (layout, i*2) == 'p')
       m[i] = SCM_GOOPS_UNBOUND;
     else
       m[i] = 0;
@@ -1742,7 +1746,7 @@ SCM_SYMBOL (scm_sym_change_class, "change-class");
 static SCM
 purgatory (void *args)
 {
-  return scm_apply_0 (GETVAR (scm_sym_change_class),
+  return scm_apply_0 (SCM_VARIABLE_REF (var_change_class),
 		      SCM_PACK ((scm_t_bits) args));
 }
 
@@ -1856,7 +1860,7 @@ SCM_DEFINE (scm_enable_primitive_generic_x, "enable-primitive-generic!", 0, 0, 1
       *SCM_SUBR_GENERIC (subr)
 	= scm_make (scm_list_3 (scm_class_generic,
 				k_name,
-				SCM_SNAME (subr)));
+				SCM_SUBR_NAME (subr)));
       subrs = SCM_CDR (subrs);
     }
   return SCM_UNSPECIFIED;
@@ -1904,7 +1908,7 @@ scm_c_extend_primitive_generic (SCM extended, SCM extension)
       gf = *SCM_SUBR_GENERIC (extended);
       gext = scm_call_2 (SCM_VARIABLE_REF (scm_var_make_extended_generic),
 			 gf,
-			 SCM_SNAME (extension));
+			 SCM_SUBR_NAME (extension));
       SCM_SET_SUBR_GENERIC (extension, gext);
     }
   else
@@ -2143,7 +2147,7 @@ scm_compute_applicable_methods (SCM gf, SCM args, long len, int find_method_p)
     {
       if (find_method_p)
 	return SCM_BOOL_F;
-      CALL_GF2 ("no-applicable-method", gf, save);
+      scm_call_2 (SCM_VARIABLE_REF (var_no_applicable_method), gf, save);
       /* if we are here, it's because no-applicable-method hasn't signaled an error */
       return SCM_BOOL_F;
     }
@@ -2200,8 +2204,13 @@ call_memoize_method (void *a)
   SCM cmethod = scm_mcache_lookup_cmethod (x, SCM_CDDR (args));
   if (scm_is_true (cmethod))
     return cmethod;
-  /*fixme* Use scm_apply */
-  return CALL_GF3 ("memoize-method!", gf, SCM_CDDR (args), x);
+
+  if (SCM_UNLIKELY (scm_is_false (var_memoize_method_x)))
+    var_memoize_method_x =
+      scm_permanent_object
+      (scm_module_variable (scm_module_goops, sym_memoize_method_x));
+      
+  return scm_call_3 (SCM_VARIABLE_REF (var_memoize_method_x), gf, SCM_CDDR (args), x);
 }
 
 SCM
@@ -2229,6 +2238,9 @@ scm_memoize_method (SCM x, SCM args)
 SCM_KEYWORD (k_setter,		"setter");
 SCM_KEYWORD (k_specializers,	"specializers");
 SCM_KEYWORD (k_procedure,	"procedure");
+SCM_KEYWORD (k_formals,		"formals");
+SCM_KEYWORD (k_body,		"body");
+SCM_KEYWORD (k_make_procedure,	"make-procedure");
 SCM_KEYWORD (k_dsupers,		"dsupers");
 SCM_KEYWORD (k_slots,		"slots");
 SCM_KEYWORD (k_gf,		"generic-function");
@@ -2292,9 +2304,27 @@ SCM_DEFINE (scm_make, "make",  0, 0, 1,
 	    scm_i_get_keyword (k_procedure,
 			       args,
 			       len - 1,
-			       SCM_EOL,
+			       SCM_BOOL_F,
 			       FUNC_NAME));
 	  SCM_SET_SLOT (z, scm_si_code_table, SCM_EOL);
+	  SCM_SET_SLOT (z, scm_si_formals,
+	    scm_i_get_keyword (k_formals,
+			       args,
+			       len - 1,
+			       SCM_EOL,
+			       FUNC_NAME));
+	  SCM_SET_SLOT (z, scm_si_body,
+	    scm_i_get_keyword (k_body,
+			       args,
+			       len - 1,
+			       SCM_EOL,
+			       FUNC_NAME));
+	  SCM_SET_SLOT (z, scm_si_make_procedure,
+	    scm_i_get_keyword (k_make_procedure,
+			       args,
+			       len - 1,
+			       SCM_BOOL_F,
+			       FUNC_NAME));
 	}
       else
 	{
@@ -2434,10 +2464,14 @@ static void
 create_standard_classes (void)
 {
   SCM slots;
-  SCM method_slots = scm_list_4 (scm_from_locale_symbol ("generic-function"),
+  SCM method_slots = scm_list_n (scm_from_locale_symbol ("generic-function"),
 				 scm_from_locale_symbol ("specializers"),
 				 sym_procedure,
-				 scm_from_locale_symbol ("code-table"));
+				 scm_from_locale_symbol ("code-table"),
+				 scm_from_locale_symbol ("formals"),
+				 scm_from_locale_symbol ("body"),
+				 scm_from_locale_symbol ("make-procedure"),
+                                 SCM_UNDEFINED);
   SCM amethod_slots = scm_list_1 (scm_list_3 (scm_from_locale_symbol ("slot-definition"),
 					      k_init_keyword,
 					      k_slot_definition));
@@ -2646,7 +2680,35 @@ make_class_from_template (char const *template, char const *type_name, SCM super
 
   /* Only define name if doesn't already exist. */
   if (!SCM_GOOPS_UNBOUNDP (name)
-      && scm_is_false (scm_call_2 (scm_goops_lookup_closure, name, SCM_BOOL_F)))
+      && scm_is_false (scm_module_variable (scm_module_goops, name)))
+    DEFVAR (name, class);
+  return class;
+}
+
+static SCM
+make_class_from_symbol (SCM type_name_sym, SCM supers, int applicablep)
+{
+  SCM class, name;
+  if (type_name_sym != SCM_BOOL_F)
+    {
+      name = scm_string_append (scm_list_3 (scm_from_locale_string ("<"),
+					    scm_symbol_to_string (type_name_sym),
+					    scm_from_locale_string (">")));
+      name = scm_string_to_symbol (name);
+    }
+  else
+    name = SCM_GOOPS_UNBOUND;
+
+  class = scm_permanent_object (scm_basic_make_class (applicablep
+						      ? scm_class_procedure_class
+						      : scm_class_class,
+						      name,
+						      supers,
+						      SCM_EOL));
+
+  /* Only define name if doesn't already exist. */
+  if (!SCM_GOOPS_UNBOUNDP (name)
+      && scm_is_false (scm_module_variable (scm_module_goops, name)))
     DEFVAR (name, class);
   return class;
 }
@@ -2662,6 +2724,16 @@ scm_make_extended_class (char const *type_name, int applicablep)
 				   applicablep);
 }
 
+static SCM
+scm_make_extended_class_from_symbol (SCM type_name_sym, int applicablep)
+{
+  return make_class_from_symbol (type_name_sym,
+				 scm_list_1 (applicablep
+					     ? scm_class_applicable
+					     : scm_class_top),
+				 applicablep);
+}
+
 void
 scm_i_inherit_applicable (SCM c)
 {
@@ -2754,11 +2826,16 @@ static SCM
 make_struct_class (void *closure SCM_UNUSED,
 		   SCM vtable, SCM data, SCM prev SCM_UNUSED)
 {
-  if (scm_is_true (SCM_STRUCT_TABLE_NAME (data)))
-    SCM_SET_STRUCT_TABLE_CLASS (data,
-				scm_make_extended_class
-				(scm_i_symbol_chars (SCM_STRUCT_TABLE_NAME (data)),
-				 SCM_CLASS_FLAGS (vtable) & SCM_CLASSF_OPERATOR));
+  SCM sym = SCM_STRUCT_TABLE_NAME (data);
+  if (scm_is_true (sym))
+    {
+      int applicablep = SCM_CLASS_FLAGS (vtable) & SCM_CLASSF_OPERATOR;
+
+      SCM_SET_STRUCT_TABLE_CLASS (data, 
+				  scm_make_extended_class_from_symbol (sym, applicablep));
+    }
+
+  scm_remember_upto_here_2 (data, vtable);
   return SCM_UNSPECIFIED;
 }
 
@@ -2978,8 +3055,23 @@ SCM_DEFINE (scm_sys_goops_loaded, "%goops-loaded", 0, 0, 0,
 {
   goops_loaded_p = 1;
   var_compute_applicable_methods =
-    scm_sym2var (sym_compute_applicable_methods, scm_goops_lookup_closure,
-		 SCM_BOOL_F);
+    scm_permanent_object
+    (scm_module_variable (scm_module_goops, sym_compute_applicable_methods));
+  var_slot_unbound =
+    scm_permanent_object
+    (scm_module_variable (scm_module_goops, sym_slot_unbound));
+  var_slot_missing =
+    scm_permanent_object
+    (scm_module_variable (scm_module_goops, sym_slot_missing));
+  var_compute_cpl =
+    scm_permanent_object
+    (scm_module_variable (scm_module_goops, sym_compute_cpl));
+  var_no_applicable_method =
+    scm_permanent_object
+    (scm_module_variable (scm_module_goops, sym_no_applicable_method));
+  var_change_class =
+    scm_permanent_object
+    (scm_module_variable (scm_module_goops, sym_change_class));
   setup_extended_primitive_generics ();
   return SCM_UNSPECIFIED;
 }
@@ -2991,12 +3083,10 @@ SCM
 scm_init_goops_builtins (void)
 {
   scm_module_goops = scm_current_module ();
-  scm_goops_lookup_closure = scm_module_lookup_closure (scm_module_goops);
 
   /* Not really necessary right now, but who knows...
    */
   scm_permanent_object (scm_module_goops);
-  scm_permanent_object (scm_goops_lookup_closure);
 
   scm_components = scm_permanent_object (scm_make_weak_key_hash_table
 					 (scm_from_int (37)));
diff --git a/libguile/goops.h b/libguile/goops.h
index 0dc0cd238..8d138237a 100644
--- a/libguile/goops.h
+++ b/libguile/goops.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006, 2008, 2009 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -149,9 +150,11 @@ typedef struct scm_t_method {
 
 #define scm_si_generic_function	 0  /* offset of gf    slot in a <method> */
 #define scm_si_specializers	 1  /* offset of spec. slot in a <method> */
-
 #define scm_si_procedure 	 2  /* offset of proc. slot in a <method> */
 #define scm_si_code_table	 3  /* offset of code. slot in a <method> */
+#define scm_si_formals		 4  /* offset of form. slot in a <method> */
+#define scm_si_body		 5  /* offset of body  slot in a <method> */
+#define scm_si_make_procedure	 6  /* offset of makep.slot in a <method> */
 
 /* C interface */
 SCM_API SCM scm_class_boolean;
diff --git a/libguile/gsubr.c b/libguile/gsubr.c
index 2b9a29dd1..3b7315565 100644
--- a/libguile/gsubr.c
+++ b/libguile/gsubr.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2006, 2008, 2009 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -20,6 +21,8 @@
 # include <config.h>
 #endif
 
+#include <alloca.h>
+
 #include <stdio.h>
 #include <stdarg.h>
 
@@ -91,7 +94,7 @@ create_gsubr (int define, const char *name,
     }
 
   if (define)
-    scm_define (SCM_SNAME (subr), subr);
+    scm_define (SCM_SUBR_NAME (subr), subr);
 
   return subr;
 }
@@ -146,7 +149,7 @@ create_gsubr_with_generic (int define,
       subr = scm_c_make_subr_with_generic (name, scm_tc7_lsubr_2, fcn, gf);
     create_subr:
       if (define)
-	scm_define (SCM_SNAME (subr), subr);
+	scm_define (SCM_SUBR_NAME (subr), subr);
       return subr;
     default:
       ;
@@ -193,7 +196,7 @@ gsubr_apply_raw (SCM proc, unsigned int argc, const SCM *argv)
 
   if (SCM_UNLIKELY (argc != argc_max))
     /* We expect the exact argument count.  */
-    scm_wrong_num_args (SCM_SNAME (proc));
+    scm_wrong_num_args (SCM_SUBR_NAME (proc));
 
   fcn = SCM_SUBRF (proc);
 
@@ -226,7 +229,7 @@ gsubr_apply_raw (SCM proc, unsigned int argc, const SCM *argv)
       return (*fcn) (argv[0], argv[1], argv[2], argv[3], argv[4], argv[5],
 		     argv[6], argv[7], argv[8], argv[9]);
     default:
-      scm_misc_error ((char *) SCM_SNAME (proc),
+      scm_misc_error ((char *) SCM_SUBR_NAME (proc),
 		      "gsubr invocation with more than 10 arguments not implemented",
 		      SCM_EOL);
     }
@@ -255,7 +258,7 @@ scm_i_gsubr_apply (SCM proc, SCM arg, ...)
     argv[argc] = arg;
 
   if (SCM_UNLIKELY (argc < SCM_GSUBR_REQ (type)))
-    scm_wrong_num_args (SCM_SNAME (proc));
+    scm_wrong_num_args (SCM_SUBR_NAME (proc));
 
   /* Fill in optional arguments that were not passed.  */
   while (argc < argc_max)
@@ -293,7 +296,7 @@ scm_i_gsubr_apply_list (SCM self, SCM args)
 
   for (i = 0; i < SCM_GSUBR_REQ (typ); i++) {
     if (scm_is_null (args))
-      scm_wrong_num_args (SCM_SNAME (self));
+      scm_wrong_num_args (SCM_SUBR_NAME (self));
     v[i] = SCM_CAR(args);
     args = SCM_CDR(args);
   }
@@ -308,7 +311,7 @@ scm_i_gsubr_apply_list (SCM self, SCM args)
   if (SCM_GSUBR_REST(typ))
     v[i] = args;
   else if (!scm_is_null (args))
-    scm_wrong_num_args (SCM_SNAME (self));
+    scm_wrong_num_args (SCM_SUBR_NAME (self));
 
   return gsubr_apply_raw (self, n, v);
 }
diff --git a/libguile/gsubr.h b/libguile/gsubr.h
index 65680a02c..298181b15 100644
--- a/libguile/gsubr.h
+++ b/libguile/gsubr.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,1998,2000,2001, 2006, 2008, 2009 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/guardians.c b/libguile/guardians.c
index 73730fc45..580e212d0 100644
--- a/libguile/guardians.c
+++ b/libguile/guardians.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1998,1999,2000,2001, 2006, 2008 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/guardians.h b/libguile/guardians.h
index 295092edf..a23026d6c 100644
--- a/libguile/guardians.h
+++ b/libguile/guardians.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1998,2000,2001, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/guile-doc-snarf.in b/libguile/guile-doc-snarf.in
index 49be29185..a787d5a46 100755
--- a/libguile/guile-doc-snarf.in
+++ b/libguile/guile-doc-snarf.in
@@ -4,19 +4,19 @@
 #  Copyright (C) 1999, 2000, 2001, 2006 Free Software Foundation, Inc.
 #
 # This program is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2, or (at your option)
-# any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this software; see the file COPYING.  If not, write to
-# the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-# Boston, MA 02110-1301 USA
+# it under the terms of the GNU Lesser General Public License as
+# published by the Free Software Foundation; either version 3, or (at
+# your option) any later version.
+# 
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# Lesser General Public License for more details.
+# 
+# You should have received a copy of the GNU Lesser General Public
+# License along with this software; see the file COPYING.LESSER.  If
+# not, write to the Free Software Foundation, Inc., 51 Franklin
+# Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 fullfilename=$1
 
diff --git a/libguile/guile-func-name-check.in b/libguile/guile-func-name-check.in
index 7f0114e0b..8b4924e91 100644
--- a/libguile/guile-func-name-check.in
+++ b/libguile/guile-func-name-check.in
@@ -3,19 +3,19 @@
 #  Copyright (C) 2000, 2001, 2006 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.
+# it under the terms of the GNU Lesser General Public License as
+# published by the Free Software Foundation; either version 3, 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.
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# Lesser General Public License for more details.
 # 
-# You should have received a copy of the GNU General Public License
-# along with this software; see the file COPYING.  If not, write to
-# the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-# Boston, MA 02110-1301 USA
+# You should have received a copy of the GNU Lesser General Public
+# License along with this software; see the file COPYING.LESSER.  If
+# not, write to the Free Software Foundation, Inc., 51 Franklin
+# Street, Fifth Floor, Boston, MA 02110-1301 USA
 #
 # Written by Greg J. Badros, <gjb@cs.washington.edu>
 # 11-Jan-2000
diff --git a/libguile/guile-snarf-docs.in b/libguile/guile-snarf-docs.in
index 9cba3dc56..1e57f2624 100755
--- a/libguile/guile-snarf-docs.in
+++ b/libguile/guile-snarf-docs.in
@@ -4,19 +4,19 @@
 #  Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2006 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.
+# it under the terms of the GNU Lesser General Public License as
+# published by the Free Software Foundation; either version 3, 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.
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# Lesser General Public License for more details.
 # 
-# You should have received a copy of the GNU General Public License
-# along with this software; see the file COPYING.  If not, write to
-# the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-# Boston, MA 02110-1301 USA
+# You should have received a copy of the GNU Lesser General Public
+# License along with this software; see the file COPYING.LESSER.  If
+# not, write to the Free Software Foundation, Inc., 51 Franklin
+# Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 bindir=`dirname $0`
 
diff --git a/libguile/guile-snarf.awk.in b/libguile/guile-snarf.awk.in
index be3b1236d..8a720a002 100644
--- a/libguile/guile-snarf.awk.in
+++ b/libguile/guile-snarf.awk.in
@@ -1,19 +1,19 @@
 #  Copyright (C) 1999, 2000, 2001, 2006 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.
+# it under the terms of the GNU Lesser General Public License as
+# published by the Free Software Foundation; either version 3, 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.
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# Lesser General Public License for more details.
 # 
-# You should have received a copy of the GNU General Public License
-# along with this software; see the file COPYING.  If not, write to
-# the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-# Boston, MA 02110-1301 USA
+# You should have received a copy of the GNU Lesser General Public
+# License along with this software; see the file COPYING.LESSER.  If
+# not, write to the Free Software Foundation, Inc., 51 Franklin
+# Street, Fifth Floor, Boston, MA 02110-1301 USA
 #
 # Written by Greg J. Badros, <gjb@cs.washington.edu>
 # 12-Dec-1999
diff --git a/libguile/guile-snarf.in b/libguile/guile-snarf.in
index 4d79f43bf..043b3ed0d 100644
--- a/libguile/guile-snarf.in
+++ b/libguile/guile-snarf.in
@@ -4,19 +4,19 @@
 #  Copyright (C) 1996, 97, 98, 99, 2000, 2001, 2002, 2004, 2006, 2008, 2009 Free Software Foundation, Inc.
 #
 # This program is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2, or (at your option)
-# any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this software; see the file COPYING.  If not, write to
-# the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-# Boston, MA 02110-1301 USA
+# it under the terms of the GNU Lesser General Public License as
+# published by the Free Software Foundation; either version 3, or (at
+# your option) any later version.
+# 
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# Lesser General Public License for more details.
+# 
+# You should have received a copy of the GNU Lesser General Public
+# License along with this software; see the file COPYING.LESSER.  If
+# not, write to the Free Software Foundation, Inc., 51 Franklin
+# Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 # Commentary:
 
diff --git a/libguile/guile.c b/libguile/guile.c
index c8341c24f..6da547b75 100644
--- a/libguile/guile.c
+++ b/libguile/guile.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1996,1997,2000,2001, 2006, 2008 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 /* This is the 'main' function for the `guile' executable.  It is not
diff --git a/libguile/hash.c b/libguile/hash.c
index 7a49de6b4..e6e38ba50 100644
--- a/libguile/hash.c
+++ b/libguile/hash.c
@@ -1,18 +1,19 @@
 /*	Copyright (C) 1995,1996,1997, 2000, 2001, 2003, 2004, 2006, 2008 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -49,6 +50,20 @@ scm_string_hash (const unsigned char *str, size_t len)
   return h;
 }
 
+unsigned long 
+scm_i_string_hash (SCM str)
+{
+  size_t len = scm_i_string_length (str);
+  size_t i = 0;
+
+  unsigned long h = 0;
+  while (len-- > 0)
+    h = (unsigned long) scm_i_string_ref (str, i++) + h * 37;
+
+  scm_remember_upto_here_1 (str);
+  return h;
+}
+
 
 /* Dirk:FIXME:: why downcase for characters? (2x: scm_hasher, scm_ihashv) */
 /* Dirk:FIXME:: scm_hasher could be made static. */
@@ -114,8 +129,7 @@ scm_hasher(SCM obj, unsigned long n, size_t d)
     case scm_tc7_string:
       {
 	unsigned long hash =
-	  scm_string_hash ((const unsigned char *) scm_i_string_chars (obj),
-			   scm_i_string_length (obj)) % n;
+	  scm_i_string_hash (obj) % n;
 	scm_remember_upto_here_1 (obj);
 	return hash;
       }
diff --git a/libguile/hash.h b/libguile/hash.h
index bbf9b2562..2ebc05352 100644
--- a/libguile/hash.h
+++ b/libguile/hash.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,2000, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -27,6 +28,7 @@
 
 
 SCM_API unsigned long scm_string_hash (const unsigned char *str, size_t len);
+SCM_INTERNAL unsigned long scm_i_string_hash (SCM str);
 SCM_API unsigned long scm_hasher (SCM obj, unsigned long n, size_t d);
 SCM_API unsigned long scm_ihashq (SCM obj, unsigned long n);
 SCM_API SCM scm_hashq (SCM obj, SCM n);
diff --git a/libguile/hashtab.c b/libguile/hashtab.c
index 50553d295..5c03d281f 100644
--- a/libguile/hashtab.c
+++ b/libguile/hashtab.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2004, 2006, 2008 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/hashtab.h b/libguile/hashtab.h
index 005fd57aa..8f8ebf9ce 100644
--- a/libguile/hashtab.h
+++ b/libguile/hashtab.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,1999,2000,2001, 2003, 2004, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/hooks.c b/libguile/hooks.c
index d175be127..c6541fadd 100644
--- a/libguile/hooks.c
+++ b/libguile/hooks.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2006, 2008, 2009 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/hooks.h b/libguile/hooks.h
index 49ea55350..15b57fabb 100644
--- a/libguile/hooks.h
+++ b/libguile/hooks.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,1999,2000,2001, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/i18n.c b/libguile/i18n.c
index 8cacf5f8d..fd15227b5 100644
--- a/libguile/i18n.c
+++ b/libguile/i18n.c
@@ -1,18 +1,19 @@
-/* Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 #ifdef HAVE_CONFIG_H
@@ -229,26 +230,6 @@ SCM_SMOB_FREE (scm_tc16_locale_smob_type, smob_locale_free, locale)
   return 0;
 }
 
-#ifndef USE_GNU_LOCALE_API
-static SCM
-smob_locale_mark (SCM locale)
-{
-  register SCM dependency;
-
-  if (!scm_is_eq (locale, SCM_VARIABLE_REF (scm_global_locale)))
-    {
-      scm_t_locale c_locale;
-
-      c_locale = (scm_t_locale) SCM_SMOB_DATA (locale);
-      dependency = (c_locale->base_locale);
-    }
-  else
-    dependency = SCM_BOOL_F;
-
-  return dependency;
-}
-#endif
-
 
 static void inline scm_locale_error (const char *, int) SCM_NORETURN;
 
@@ -1721,10 +1702,6 @@ scm_init_i18n ()
 
 #include "libguile/i18n.x"
 
-#ifndef USE_GNU_LOCALE_API
-  scm_set_smob_mark (scm_tc16_locale_smob_type, smob_locale_mark);
-#endif
-
   /* Initialize the global locale object with a special `locale' SMOB.  */
   SCM_NEWSMOB (global_locale_smob, scm_tc16_locale_smob_type, NULL);
   SCM_VARIABLE_SET (scm_global_locale, global_locale_smob);
diff --git a/libguile/i18n.h b/libguile/i18n.h
index 57f1654a3..df2970b4e 100644
--- a/libguile/i18n.h
+++ b/libguile/i18n.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 #include "libguile/__scm.h"
diff --git a/libguile/ieee-754.h b/libguile/ieee-754.h
new file mode 100644
index 000000000..e345efaae
--- /dev/null
+++ b/libguile/ieee-754.h
@@ -0,0 +1,90 @@
+/* Copyright (C) 1992, 1995, 1996, 1999 Free Software Foundation, Inc.
+   This file is part of the GNU C Library.
+
+   The GNU C Library is free software; you can redistribute it and/or
+   modify it under the terms of the GNU Lesser General Public
+   License as published by the Free Software Foundation; either
+   version 2.1 of the License, or (at your option) any later version.
+
+   The GNU C Library is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with the GNU C Library; if not, write to the Free
+   Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+   02111-1307 USA.  */
+
+#ifndef SCM_IEEE_754_H
+#define SCM_IEEE_754_H 1
+
+/* Based on glibc's <ieee754.h> and modified by Ludovic Court�s to include
+   all possible IEEE-754 double-precision representations.  */
+
+
+/* IEEE 754 simple-precision format (32-bit).  */
+
+union scm_ieee754_float
+  {
+    float f;
+
+    struct
+      {
+	unsigned int negative:1;
+	unsigned int exponent:8;
+	unsigned int mantissa:23;
+      } big_endian;
+
+    struct
+      {
+      	unsigned int mantissa:23;
+	unsigned int exponent:8;
+	unsigned int negative:1;
+      } little_endian;
+  };
+
+
+
+/* IEEE 754 double-precision format (64-bit).  */
+
+union scm_ieee754_double
+  {
+    double d;
+
+    struct
+      {
+	/* Big endian.  */
+
+	unsigned int negative:1;
+	unsigned int exponent:11;
+	/* Together these comprise the mantissa.  */
+	unsigned int mantissa0:20;
+	unsigned int mantissa1:32;
+      } big_endian;
+
+    struct
+      {
+	/* Both byte order and word order are little endian.  */
+
+	/* Together these comprise the mantissa.  */
+	unsigned int mantissa1:32;
+	unsigned int mantissa0:20;
+	unsigned int exponent:11;
+	unsigned int negative:1;
+      } little_little_endian;
+
+    struct
+      {
+	/* Byte order is little endian but word order is big endian.  Not
+	   sure this is very wide spread.  */
+	unsigned int mantissa0:20;
+	unsigned int exponent:11;
+	unsigned int negative:1;
+	unsigned int mantissa1:32;
+      } little_big_endian;
+
+  };
+
+
+#endif /* SCM_IEEE_754_H */
diff --git a/libguile/init.c b/libguile/init.c
index 56c34c8bc..940d515f6 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2009 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -36,7 +37,9 @@
 #include "libguile/arbiters.h"
 #include "libguile/async.h"
 #include "libguile/backtrace.h"
+#include "libguile/bitvectors.h"
 #include "libguile/boolean.h"
+#include "libguile/bytevectors.h"
 #include "libguile/chars.h"
 #include "libguile/continuations.h"
 #include "libguile/debug.h"
@@ -60,6 +63,8 @@
 #include "libguile/futures.h"
 #include "libguile/gc.h"
 #include "libguile/gdbint.h"
+#include "libguile/generalized-arrays.h"
+#include "libguile/generalized-vectors.h"
 #include "libguile/goops.h"
 #include "libguile/gsubr.h"
 #include "libguile/hash.h"
@@ -90,7 +95,7 @@
 #include "libguile/procprop.h"
 #include "libguile/procs.h"
 #include "libguile/properties.h"
-#include "libguile/ramap.h"
+#include "libguile/array-map.h"
 #include "libguile/random.h"
 #include "libguile/rdelim.h"
 #include "libguile/read.h"
@@ -113,15 +118,17 @@
 #include "libguile/struct.h"
 #include "libguile/symbols.h"
 #include "libguile/throw.h"
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
 #include "libguile/values.h"
 #include "libguile/variable.h"
 #include "libguile/vectors.h"
 #include "libguile/version.h"
+#include "libguile/vm-bootstrap.h"
 #include "libguile/vports.h"
 #include "libguile/weaks.h"
 #include "libguile/guardians.h"
 #include "libguile/extensions.h"
+#include "libguile/uniform.h"
 #include "libguile/srfi-4.h"
 #include "libguile/discouraged.h"
 #include "libguile/deprecated.h"
@@ -281,7 +288,7 @@ scm_load_startup_files ()
   /* Load Ice-9.  */
   if (!scm_ice_9_already_loaded)
     {
-      scm_primitive_load_path (scm_from_locale_string ("ice-9/boot-9.scm"));
+      scm_c_primitive_load_path ("ice-9/boot-9");
 
       /* Load the init.scm file.  */
       if (scm_is_true (init_path))
@@ -516,7 +523,19 @@ scm_i_init_guile (SCM_STACKITEM *base)
   scm_init_sort ();
   scm_init_srcprop ();
   scm_init_stackchk ();
-  scm_init_strings ();
+
+  scm_init_array_handle ();
+  scm_init_generalized_arrays ();
+  scm_init_generalized_vectors ();
+  scm_init_vectors ();
+  scm_init_uniform ();
+  scm_init_bitvectors ();
+  scm_bootstrap_bytevectors ();
+  scm_init_srfi_4 ();
+  scm_init_arrays ();
+  scm_init_array_map ();
+
+  scm_init_strings ();  /* Requires array-handle */
   scm_init_struct ();   /* Requires strings */
   scm_init_stacks ();   /* Requires strings, struct */
   scm_init_symbols ();
@@ -530,7 +549,6 @@ scm_i_init_guile (SCM_STACKITEM *base)
   scm_init_srfi_13 ();
   scm_init_srfi_14 ();
   scm_init_throw ();
-  scm_init_vectors ();
   scm_init_version ();
   scm_init_weaks ();
   scm_init_guardians ();
@@ -539,8 +557,6 @@ scm_i_init_guile (SCM_STACKITEM *base)
   scm_init_evalext ();
   scm_init_debug ();	/* Requires macro smobs */
   scm_init_random ();
-  scm_init_ramap ();
-  scm_init_unif ();
   scm_init_simpos ();
   scm_init_load_path ();
   scm_init_standard_ports ();  /* Requires fports */
@@ -549,7 +565,6 @@ scm_i_init_guile (SCM_STACKITEM *base)
   scm_init_lang ();
 #endif /* SCM_ENABLE_ELISP */
   scm_init_script ();
-  scm_init_srfi_4 ();
 
   scm_init_goops ();
 
@@ -573,6 +588,8 @@ scm_i_init_guile (SCM_STACKITEM *base)
   scm_init_rw ();
   scm_init_extensions ();
 
+  scm_bootstrap_vm ();
+
   atexit (cleanup_for_exit);
   scm_load_startup_files ();
 }
diff --git a/libguile/init.h b/libguile/init.h
index 3ae27d8cc..7cfae76d5 100644
--- a/libguile/init.h
+++ b/libguile/init.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,1997,2000, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/inline.c b/libguile/inline.c
index a0c25003f..79728ff13 100644
--- a/libguile/inline.c
+++ b/libguile/inline.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 2001, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 #ifdef HAVE_CONFIG_H
diff --git a/libguile/inline.h b/libguile/inline.h
index ff8d2d4d1..49431697f 100644
--- a/libguile/inline.h
+++ b/libguile/inline.h
@@ -3,21 +3,22 @@
 #ifndef SCM_INLINE_H
 #define SCM_INLINE_H
 
-/* Copyright (C) 2001, 2002, 2003, 2004, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2002, 2003, 2004, 2006, 2008, 2009 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 /* This file is for inline functions.  On platforms that don't support
@@ -33,8 +34,9 @@
 #include "libguile/pairs.h"
 #include "libguile/gc.h"
 #include "libguile/threads.h"
-#include "libguile/unif.h"
+#include "libguile/array-handle.h"
 #include "libguile/ports.h"
+#include "libguile/numbers.h"
 #include "libguile/error.h"
 
 
@@ -91,7 +93,7 @@ SCM_API void scm_array_handle_set (scm_t_array_handle *h, ssize_t pos, SCM val);
 
 SCM_API int scm_is_pair (SCM x);
 
-SCM_API int scm_getc (SCM port);
+SCM_API int scm_get_byte_or_eof (SCM port);
 SCM_API void scm_putc (char c, SCM port);
 SCM_API void scm_puts (const char *str_data, SCM port);
 
@@ -241,7 +243,11 @@ SCM_C_EXTERN_INLINE
 SCM
 scm_array_handle_ref (scm_t_array_handle *h, ssize_t p)
 {
-  return h->ref (h, p);
+  if (SCM_UNLIKELY (p < 0 && -p > h->base))
+    /* catch overflow */
+    scm_out_of_range (NULL, scm_from_ssize_t (p));
+  /* perhaps should catch overflow here too */
+  return h->impl->vref (h, h->base + p);
 }
 
 #ifndef SCM_INLINE_C_INCLUDING_INLINE_H
@@ -250,7 +256,11 @@ SCM_C_EXTERN_INLINE
 void
 scm_array_handle_set (scm_t_array_handle *h, ssize_t p, SCM v)
 {
-  h->set (h, p, v);
+  if (SCM_UNLIKELY (p < 0 && -p > h->base))
+    /* catch overflow */
+    scm_out_of_range (NULL, scm_from_ssize_t (p));
+  /* perhaps should catch overflow here too */
+  h->impl->vset (h, h->base + p, v);
 }
 
 #ifndef SCM_INLINE_C_INCLUDING_INLINE_H
@@ -290,7 +300,7 @@ scm_is_pair (SCM x)
 SCM_C_EXTERN_INLINE
 #endif
 int
-scm_getc (SCM port)
+scm_get_byte_or_eof (SCM port)
 {
   int c;
   scm_t_port *pt = SCM_PTAB_ENTRY (port);
@@ -310,27 +320,6 @@ scm_getc (SCM port)
 
   c = *(pt->read_pos++);
 
-  switch (c)
-    {
-      case '\a':
-        break;
-      case '\b':
-        SCM_DECCOL (port);
-        break;
-      case '\n':
-        SCM_INCLINE (port);
-        break;
-      case '\r':
-        SCM_ZEROCOL (port);
-        break;
-      case '\t':
-        SCM_TABCOL (port);
-        break;
-      default:
-        SCM_INCCOL (port);
-        break;
-    }
-
   return c;
 }
 
diff --git a/libguile/instructions.c b/libguile/instructions.c
new file mode 100644
index 000000000..04180e5e3
--- /dev/null
+++ b/libguile/instructions.c
@@ -0,0 +1,218 @@
+/* Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+ * 
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+#if HAVE_CONFIG_H
+#  include <config.h>
+#endif
+
+#include <string.h>
+
+#include "_scm.h"
+#include "vm-bootstrap.h"
+#include "instructions.h"
+
+struct scm_instruction {
+  enum scm_opcode opcode;	/* opcode */
+  const char *name;		/* instruction name */
+  signed char len;		/* Instruction length.  This may be -1 for
+				   the loader (see the `VM_LOADER'
+				   macro).  */
+  signed char npop;		/* The number of values popped.  This may be
+				   -1 for insns like `call' which can take
+				   any number of arguments.  */
+  char npush;			/* the number of values pushed */
+  SCM symname;                  /* filled in later */
+};
+
+#define SCM_VALIDATE_LOOKUP_INSTRUCTION(pos, var, cvar)               \
+  do {                                                                \
+    cvar = scm_lookup_instruction_by_name (var);                      \
+    SCM_ASSERT_TYPE (cvar, var, pos, FUNC_NAME, "INSTRUCTION_P");     \
+  } while (0)
+
+
+static struct scm_instruction*
+fetch_instruction_table ()
+{
+  static struct scm_instruction *table = NULL;
+
+  if (SCM_UNLIKELY (!table))
+    {
+      size_t bytes = SCM_VM_NUM_INSTRUCTIONS * sizeof(struct scm_instruction);
+      int i;
+      table = malloc (bytes);
+      memset (table, 0, bytes);
+#define VM_INSTRUCTION_TO_TABLE 1
+#include <libguile/vm-expand.h>
+#include <libguile/vm-i-system.i>
+#include <libguile/vm-i-scheme.i>
+#include <libguile/vm-i-loader.i>
+#undef VM_INSTRUCTION_TO_TABLE
+      for (i = 0; i < SCM_VM_NUM_INSTRUCTIONS; i++)
+        {
+          table[i].opcode = i;
+          if (table[i].name)
+            table[i].symname =
+              scm_permanent_object (scm_from_locale_symbol (table[i].name));
+          else
+            table[i].symname = SCM_BOOL_F;
+        }
+    }
+  return table;
+}
+
+static struct scm_instruction *
+scm_lookup_instruction_by_name (SCM name)
+{
+  static SCM instructions_by_name = SCM_BOOL_F;
+  struct scm_instruction *table = fetch_instruction_table ();
+  SCM op;
+
+  if (SCM_UNLIKELY (SCM_FALSEP (instructions_by_name)))
+    { 
+      int i;
+      instructions_by_name = scm_permanent_object
+        (scm_make_hash_table (SCM_I_MAKINUM (SCM_VM_NUM_INSTRUCTIONS)));
+      for (i = 0; i < SCM_VM_NUM_INSTRUCTIONS; i++)
+        if (scm_is_true (table[i].symname))
+          scm_hashq_set_x (instructions_by_name, table[i].symname,
+                           SCM_I_MAKINUM (i));
+    }
+  
+  op = scm_hashq_ref (instructions_by_name, name, SCM_UNDEFINED);
+  if (SCM_I_INUMP (op))
+    return &table[SCM_I_INUM (op)];
+
+  return NULL;
+}
+
+
+/* Scheme interface */
+
+SCM_DEFINE (scm_instruction_list, "instruction-list", 0, 0, 0,
+	    (void),
+	    "")
+#define FUNC_NAME s_scm_instruction_list
+{
+  SCM list = SCM_EOL;
+  int i;
+  struct scm_instruction *ip = fetch_instruction_table ();
+  for (i = 0; i < SCM_VM_NUM_INSTRUCTIONS; i++)
+    if (ip[i].name)
+      list = scm_cons (ip[i].symname, list);
+  return scm_reverse_x (list, SCM_EOL);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_instruction_p, "instruction?", 1, 0, 0,
+	    (SCM obj),
+	    "")
+#define FUNC_NAME s_scm_instruction_p
+{
+  return SCM_BOOL (scm_lookup_instruction_by_name (obj));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_instruction_length, "instruction-length", 1, 0, 0,
+	    (SCM inst),
+	    "")
+#define FUNC_NAME s_scm_instruction_length
+{
+  struct scm_instruction *ip;
+  SCM_VALIDATE_LOOKUP_INSTRUCTION (1, inst, ip);
+  return SCM_I_MAKINUM (ip->len);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_instruction_pops, "instruction-pops", 1, 0, 0,
+	    (SCM inst),
+	    "")
+#define FUNC_NAME s_scm_instruction_pops
+{
+  struct scm_instruction *ip;
+  SCM_VALIDATE_LOOKUP_INSTRUCTION (1, inst, ip);
+  return SCM_I_MAKINUM (ip->npop);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_instruction_pushes, "instruction-pushes", 1, 0, 0,
+	    (SCM inst),
+	    "")
+#define FUNC_NAME s_scm_instruction_pushes
+{
+  struct scm_instruction *ip;
+  SCM_VALIDATE_LOOKUP_INSTRUCTION (1, inst, ip);
+  return SCM_I_MAKINUM (ip->npush);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_instruction_to_opcode, "instruction->opcode", 1, 0, 0,
+	    (SCM inst),
+	    "")
+#define FUNC_NAME s_scm_instruction_to_opcode
+{
+  struct scm_instruction *ip;
+  SCM_VALIDATE_LOOKUP_INSTRUCTION (1, inst, ip);
+  return SCM_I_MAKINUM (ip->opcode);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_opcode_to_instruction, "opcode->instruction", 1, 0, 0,
+	    (SCM op),
+	    "")
+#define FUNC_NAME s_scm_opcode_to_instruction
+{
+  int opcode;
+  SCM ret = SCM_BOOL_F;
+
+  SCM_MAKE_VALIDATE (1, op, I_INUMP);
+  opcode = SCM_I_INUM (op);
+
+  if (opcode >= 0 && opcode < SCM_VM_NUM_INSTRUCTIONS)
+    ret = fetch_instruction_table ()[opcode].symname;
+
+  if (scm_is_false (ret))
+    scm_wrong_type_arg_msg (FUNC_NAME, 1, op, "INSTRUCTION_P");
+
+  return ret;
+}
+#undef FUNC_NAME
+
+void
+scm_bootstrap_instructions (void)
+{
+  scm_c_register_extension ("libguile", "scm_init_instructions",
+                            (scm_t_extension_init_func)scm_init_instructions,
+                            NULL);
+}
+
+void
+scm_init_instructions (void)
+{
+  scm_bootstrap_vm ();
+
+#ifndef SCM_MAGIC_SNARFER
+#include "libguile/instructions.x"
+#endif
+}
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/instructions.h b/libguile/instructions.h
new file mode 100644
index 000000000..a2263228f
--- /dev/null
+++ b/libguile/instructions.h
@@ -0,0 +1,53 @@
+/* Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+ * 
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+#ifndef _SCM_INSTRUCTIONS_H_
+#define _SCM_INSTRUCTIONS_H_
+
+#include <libguile.h>
+
+#define SCM_VM_NUM_INSTRUCTIONS (1<<8)
+#define SCM_VM_INSTRUCTION_MASK (SCM_VM_NUM_INSTRUCTIONS-1)
+
+enum scm_opcode {
+#define VM_INSTRUCTION_TO_OPCODE 1
+#include <libguile/vm-expand.h>
+#include <libguile/vm-i-system.i>
+#include <libguile/vm-i-scheme.i>
+#include <libguile/vm-i-loader.i>
+#undef VM_INSTRUCTION_TO_OPCODE
+};
+
+SCM_API SCM scm_instruction_list (void);
+SCM_API SCM scm_instruction_p (SCM obj);
+SCM_API SCM scm_instruction_length (SCM inst);
+SCM_API SCM scm_instruction_pops (SCM inst);
+SCM_API SCM scm_instruction_pushes (SCM inst);
+SCM_API SCM scm_instruction_to_opcode (SCM inst);
+SCM_API SCM scm_opcode_to_instruction (SCM op);
+
+SCM_INTERNAL void scm_bootstrap_instructions (void);
+SCM_INTERNAL void scm_init_instructions (void);
+
+#endif /* _SCM_INSTRUCTIONS_H_ */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/ioext.c b/libguile/ioext.c
index b542664eb..6b0c9b88c 100644
--- a/libguile/ioext.c
+++ b/libguile/ioext.c
@@ -1,18 +1,19 @@
 /* 	Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2006 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/ioext.h b/libguile/ioext.h
index 18289ea3c..1b7b93aaf 100644
--- a/libguile/ioext.h
+++ b/libguile/ioext.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,1997,1998,2000,2001, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/iselect.h b/libguile/iselect.h
index 5a4b30da6..760d959d8 100644
--- a/libguile/iselect.h
+++ b/libguile/iselect.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1997,1998,2000,2001, 2002, 2006 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/keywords.c b/libguile/keywords.c
index 5afa9e9e7..c415ccbab 100644
--- a/libguile/keywords.c
+++ b/libguile/keywords.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2008 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/keywords.h b/libguile/keywords.h
index a80e31bff..bfffe5923 100644
--- a/libguile/keywords.h
+++ b/libguile/keywords.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,1999,2000,2001, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/lang.c b/libguile/lang.c
index 7f3986cec..85da68034 100644
--- a/libguile/lang.c
+++ b/libguile/lang.c
@@ -1,18 +1,19 @@
 /*	Copyright (C) 1999, 2000, 2001, 2006, 2008 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/lang.h b/libguile/lang.h
index 991e9ca76..47128de57 100644
--- a/libguile/lang.h
+++ b/libguile/lang.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1998, 2004, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/libguile.map b/libguile/libguile.map
new file mode 100644
index 000000000..2586e0abf
--- /dev/null
+++ b/libguile/libguile.map
@@ -0,0 +1,44 @@
+# Linker version script for libguile.           -*- ld-script -*-
+#
+# Copyright (C) 2009 Free Software Foundation, Inc.
+#
+# This file is part of GUILE.
+#
+# GUILE is free software; you can redistribute it and/or modify it
+# under the terms of the GNU Lesser General Public License as
+# published by the Free Software Foundation; either version 3, or
+# (at your option) any later version.
+#
+# GUILE is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU Lesser General Public License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public
+# License along with GUILE; see the file COPYING.LESSER.  If not,
+# write to the Free Software Foundation, Inc., 51 Franklin Street,
+# Fifth Floor, Boston, MA 02110-1301 USA
+
+GUILE_2.0
+{
+  global:
+    # Note: This includes `scm_i_' symbols declared as `SCM_API' (e.g.,
+    # symbols from `deprecated.c' or symbols used by public inline
+    # functions or macros).
+    scm_*;
+
+    # GDB interface.
+    gdb_options;
+    gdb_language;
+    gdb_result;
+    gdb_output;
+    gdb_output_length;
+    gdb_maybe_valid_type_p;
+    gdb_read;
+    gdb_eval;
+    gdb_print;
+    gdb_binding;
+
+  local:
+    *;
+};
diff --git a/libguile/list.c b/libguile/list.c
index 07b96f5a7..70f527755 100644
--- a/libguile/list.c
+++ b/libguile/list.c
@@ -2,18 +2,19 @@
  * Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/list.h b/libguile/list.h
index 733432d76..427dcb84d 100644
--- a/libguile/list.h
+++ b/libguile/list.h
@@ -7,18 +7,19 @@
  * Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/load.c b/libguile/load.c
index 155bdbdab..fa25b0f84 100644
--- a/libguile/load.c
+++ b/libguile/load.c
@@ -1,18 +1,19 @@
-/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2004, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2004, 2006, 2008, 2009 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -44,6 +45,8 @@
 #include "libguile/load.h"
 #include "libguile/fluids.h"
 
+#include "libguile/vm.h" /* for load-compiled/vm */
+
 #include <sys/types.h>
 #include <sys/stat.h>
 
@@ -51,6 +54,10 @@
 #include <unistd.h>
 #endif /* HAVE_UNISTD_H */
 
+#ifdef HAVE_PWD_H
+#include <pwd.h>
+#endif /* HAVE_PWD_H */
+
 #ifndef R_OK
 #define R_OK 4
 #endif
@@ -78,6 +85,7 @@ SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0,
 #define FUNC_NAME s_scm_primitive_load
 {
   SCM hook = *scm_loc_load_hook;
+  char *encoding;
   SCM_VALIDATE_STRING (1, filename);
   if (scm_is_true (hook) && scm_is_false (scm_procedure_p (hook)))
     SCM_MISC_ERROR ("value of %load-hook is neither a procedure nor #f",
@@ -90,7 +98,15 @@ SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0,
     SCM port = scm_open_file (filename, scm_from_locale_string ("r"));
     scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
     scm_i_dynwind_current_load_port (port);
-
+    encoding = scm_scan_for_encoding (port);
+    if (encoding)
+      {
+	scm_i_set_port_encoding_x (port, encoding);
+	free (encoding);
+      }
+    else
+      /* The file has no encoding declaraed.  We'll presume Latin-1.  */
+      scm_i_set_port_encoding_x (port, NULL);
     while (1)
       {
 	SCM reader, form;
@@ -172,6 +188,15 @@ static SCM *scm_loc_load_path;
 /* List of extensions we try adding to the filenames.  */
 static SCM *scm_loc_load_extensions;
 
+/* Like %load-path and %load-extensions, but for compiled files. */
+static SCM *scm_loc_load_compiled_path;
+static SCM *scm_loc_load_compiled_extensions;
+
+/* Whether we should try to auto-compile. */
+static SCM *scm_loc_load_should_autocompile;
+
+/* The fallback path for autocompilation */
+static SCM *scm_loc_compile_fallback_path;
 
 SCM_DEFINE (scm_parse_path, "parse-path", 1, 1, 0, 
             (SCM path, SCM tail),
@@ -204,18 +229,68 @@ scm_init_load_path ()
 {
   char *env;
   SCM path = SCM_EOL;
+  SCM cpath = SCM_EOL;
 
 #ifdef SCM_LIBRARY_DIR
-  path = scm_list_3 (scm_from_locale_string (SCM_SITE_DIR),
-		     scm_from_locale_string (SCM_LIBRARY_DIR),
-		     scm_from_locale_string (SCM_PKGDATA_DIR));
+  env = getenv ("GUILE_SYSTEM_PATH");
+  if (env && strcmp (env, "") == 0)
+    /* special-case interpret system-path=="" as meaning no system path instead
+       of '("") */
+    ; 
+  else if (env)
+    path = scm_parse_path (scm_from_locale_string (env), path);
+  else
+    path = scm_list_3 (scm_from_locale_string (SCM_SITE_DIR),
+                       scm_from_locale_string (SCM_LIBRARY_DIR),
+                       scm_from_locale_string (SCM_PKGDATA_DIR));
+
+  env = getenv ("GUILE_SYSTEM_COMPILED_PATH");
+  if (env && strcmp (env, "") == 0)
+    /* like above */
+    ; 
+  else if (env)
+    cpath = scm_parse_path (scm_from_locale_string (env), cpath);
+  else
+    cpath = scm_cons (scm_from_locale_string (SCM_CCACHE_DIR), cpath);
+
 #endif /* SCM_LIBRARY_DIR */
 
+  {
+    char cachedir[1024];
+    char *e;
+#ifdef HAVE_GETPWENT
+    struct passwd *pwd;
+#endif
+
+#define FALLBACK_DIR \
+    "guile/ccache/" SCM_EFFECTIVE_VERSION "-" SCM_OBJCODE_MACHINE_VERSION_STRING
+
+    if ((e = getenv ("XDG_CACHE_HOME")))
+      snprintf (cachedir, sizeof(cachedir), "%s/" FALLBACK_DIR, e);
+    else if ((e = getenv ("HOME")))
+      snprintf (cachedir, sizeof(cachedir), "%s/.cache/" FALLBACK_DIR, e);
+#ifdef HAVE_GETPWENT
+    else if ((pwd = getpwuid (getuid ())) && pwd->pw_dir)
+      snprintf (cachedir, sizeof(cachedir), "%s/.cache/" FALLBACK_DIR,
+                pwd->pw_dir);
+#endif /* HAVE_GETPWENT */
+    else
+      cachedir[0] = 0;
+
+    if (cachedir[0])
+      *scm_loc_compile_fallback_path = scm_from_locale_string (cachedir);
+  }
+
   env = getenv ("GUILE_LOAD_PATH");
   if (env)
     path = scm_parse_path (scm_from_locale_string (env), path);
 
+  env = getenv ("GUILE_LOAD_COMPILED_PATH");
+  if (env)
+    cpath = scm_parse_path (scm_from_locale_string (env), cpath);
+
   *scm_loc_load_path = path;
+  *scm_loc_load_compiled_path = cpath;
 }
 
 SCM scm_listofnullstr;
@@ -291,14 +366,33 @@ stringbuf_cat (struct stringbuf *buf, char *str)
 }
 
   
+static int
+scm_c_string_has_an_ext (char *str, size_t len, SCM extensions)
+{
+  for (; !scm_is_null (extensions); extensions = SCM_CDR (extensions))
+    {
+      char *ext;
+      size_t extlen;
+      int match;
+      ext = scm_to_locale_string (SCM_CAR (extensions));
+      extlen = strlen (ext);
+      match = (len > extlen && str[len - extlen - 1] == '.'
+               && strncmp (str + (len - extlen), ext, extlen) == 0);
+      free (ext);
+      if (match)
+        return 1;
+    }
+  return 0;
+}
+
 /* Search PATH for a directory containing a file named FILENAME.
    The file must be readable, and not a directory.
    If we find one, return its full filename; otherwise, return #f.
    If FILENAME is absolute, return it unchanged.
    If given, EXTENSIONS is a list of strings; for each directory 
    in PATH, we search for FILENAME concatenated with each EXTENSION.  */
-SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0,
-           (SCM path, SCM filename, SCM extensions),
+SCM_DEFINE (scm_search_path, "search-path", 2, 2, 0,
+            (SCM path, SCM filename, SCM extensions, SCM require_exts),
 	    "Search @var{path} for a directory containing a file named\n"
 	    "@var{filename}. The file must be readable, and not a directory.\n"
 	    "If we find one, return its full filename; otherwise, return\n"
@@ -316,6 +410,9 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0,
   if (SCM_UNBNDP (extensions))
     extensions = SCM_EOL;
 
+  if (SCM_UNBNDP (require_exts))
+    require_exts = SCM_BOOL_F;
+
   scm_dynwind_begin (0);
 
   filename_chars = scm_to_locale_string (filename);
@@ -334,8 +431,14 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0,
   if (filename_len >= 1 && filename_chars[0] == '/')
 #endif
     {
+      SCM res = filename;
+      if (scm_is_true (require_exts) &&
+          !scm_c_string_has_an_ext (filename_chars, filename_len,
+                                    extensions))
+        res = SCM_BOOL_F;
+
       scm_dynwind_end ();
-      return filename;
+      return res;
     }
 
   /* If FILENAME has an extension, don't try to add EXTENSIONS to it.  */
@@ -348,6 +451,15 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0,
       {
 	if (*endp == '.')
 	  {
+            if (scm_is_true (require_exts) &&
+                !scm_c_string_has_an_ext (filename_chars, filename_len,
+                                          extensions))
+              {
+                /* This filename has an extension, but not one of the right
+                   ones... */
+                scm_dynwind_end ();
+                return SCM_BOOL_F;
+              }
 	    /* This filename already has an extension, so cancel the
                list of extensions.  */
 	    extensions = SCM_EOL;
@@ -453,35 +565,214 @@ SCM_DEFINE (scm_sys_search_load_path, "%search-load-path", 1, 0, 0,
     SCM_MISC_ERROR ("%load-path is not a proper list", SCM_EOL);
   if (scm_ilength (exts) < 0)
     SCM_MISC_ERROR ("%load-extension list is not a proper list", SCM_EOL);
-  return scm_search_path (path, filename, exts);
+  return scm_search_path (path, filename, exts, SCM_UNDEFINED);
 }
 #undef FUNC_NAME
 
 
-SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 1, 0, 0, 
-	    (SCM filename),
+static int
+compiled_is_fresh (SCM full_filename, SCM compiled_filename)
+{
+  char *source, *compiled;
+  struct stat stat_source, stat_compiled;
+  int res;
+
+  source = scm_to_locale_string (full_filename);
+  compiled = scm_to_locale_string (compiled_filename);
+    
+  if (stat (source, &stat_source) == 0
+      && stat (compiled, &stat_compiled) == 0
+      && stat_source.st_mtime == stat_compiled.st_mtime) 
+    {
+      res = 1;
+    }
+  else
+    {
+      scm_puts (";;; note: source file ", scm_current_error_port ());
+      scm_puts (source, scm_current_error_port ());
+      scm_puts ("\n;;;       newer than compiled ", scm_current_error_port ());
+      scm_puts (compiled, scm_current_error_port ());
+      scm_puts ("\n", scm_current_error_port ());
+      res = 0;
+    }
+
+  free (source);
+  free (compiled);
+  return res;
+}
+
+static SCM
+do_try_autocompile (void *data)
+{
+  SCM source = PTR2SCM (data);
+  SCM comp_mod, compile_file;
+
+  scm_puts (";;; compiling ", scm_current_error_port ());
+  scm_display (source, scm_current_error_port ());
+  scm_newline (scm_current_error_port ());
+
+  comp_mod = scm_c_resolve_module ("system base compile");
+  compile_file = scm_module_variable
+    (comp_mod, scm_from_locale_symbol ("compile-file"));
+
+  if (scm_is_true (compile_file))
+    {
+      SCM res = scm_call_1 (scm_variable_ref (compile_file), source);
+      scm_puts (";;; compiled ", scm_current_error_port ());
+      scm_display (res, scm_current_error_port ());
+      scm_newline (scm_current_error_port ());
+      return res;
+    }
+  else
+    {
+      scm_puts (";;; it seems ", scm_current_error_port ());
+      scm_display (source, scm_current_error_port ());
+      scm_puts ("\n;;; is part of the compiler; skipping autocompilation\n",
+                scm_current_error_port ());
+      return SCM_BOOL_F;
+    }
+}
+
+static SCM
+autocompile_catch_handler (void *data, SCM tag, SCM throw_args)
+{
+  SCM source = PTR2SCM (data);
+  scm_puts (";;; WARNING: compilation of ", scm_current_error_port ());
+  scm_display (source, scm_current_error_port ());
+  scm_puts (" failed:\n", scm_current_error_port ());
+  scm_puts (";;; key ", scm_current_error_port ());
+  scm_write (tag, scm_current_error_port ());
+  scm_puts (", throw args ", scm_current_error_port ());
+  scm_write (throw_args, scm_current_error_port ());
+  scm_newline (scm_current_error_port ());
+  return SCM_BOOL_F;
+}
+
+SCM_DEFINE (scm_sys_warn_autocompilation_enabled, "%warn-autocompilation-enabled", 0, 0, 0,
+	    (void), "")
+#define FUNC_NAME s_scm_sys_warn_autocompilation_enabled
+{
+  static int message_shown = 0;
+
+  if (!message_shown)
+    {
+      scm_puts (";;; note: autocompilation is enabled, set GUILE_AUTO_COMPILE=0\n"
+                ";;;       or pass the --no-autocompile argument to disable.\n",
+                scm_current_error_port ());
+      message_shown = 1;
+    }
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+static SCM
+scm_try_autocompile (SCM source)
+{
+  if (scm_is_false (*scm_loc_load_should_autocompile))
+    return SCM_BOOL_F;
+
+  scm_sys_warn_autocompilation_enabled ();
+  return scm_c_catch (SCM_BOOL_T,
+                      do_try_autocompile,
+                      SCM2PTR (source),
+                      autocompile_catch_handler,
+                      SCM2PTR (source),
+                      NULL, NULL);
+}
+
+SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 1, 1, 0, 
+	    (SCM filename, SCM exception_on_not_found),
 	    "Search @var{%load-path} for the file named @var{filename} and\n"
 	    "load it into the top-level environment.  If @var{filename} is a\n"
 	    "relative pathname and is not found in the list of search paths,\n"
-	    "an error is signalled.")
+	    "an error is signalled, unless the optional argument\n"
+            "@var{exception_on_not_found} is @code{#f}, in which case\n"
+            "@code{#f} is returned instead.")
 #define FUNC_NAME s_scm_primitive_load_path
 {
-  SCM full_filename;
+  SCM full_filename, compiled_filename;
+  int compiled_is_fallback = 0;
+
+  if (SCM_UNBNDP (exception_on_not_found))
+    exception_on_not_found = SCM_BOOL_T;
 
   full_filename = scm_sys_search_load_path (filename);
+  compiled_filename = scm_search_path (*scm_loc_load_compiled_path,
+                                       filename,
+                                       *scm_loc_load_compiled_extensions,
+                                       SCM_BOOL_T);
+  
+  if (scm_is_false (compiled_filename)
+      && scm_is_true (full_filename)
+      && scm_is_true (*scm_loc_compile_fallback_path)
+      && scm_is_pair (*scm_loc_load_compiled_extensions)
+      && scm_is_string (scm_car (*scm_loc_load_compiled_extensions)))
+    {
+      SCM fallback = scm_string_append
+        (scm_list_3 (*scm_loc_compile_fallback_path,
+                     full_filename,
+                     scm_car (*scm_loc_load_compiled_extensions)));
+      if (scm_is_true (scm_stat (fallback, SCM_BOOL_F)))
+        {
+          compiled_filename = fallback;
+          compiled_is_fallback = 1;
+        }
+    }
+  
+  if (scm_is_false (full_filename) && scm_is_false (compiled_filename))
+    {
+      if (scm_is_true (exception_on_not_found))
+        SCM_MISC_ERROR ("Unable to find file ~S in load path",
+                        scm_list_1 (filename));
+      else
+        return SCM_BOOL_F;
+    }
 
-  if (scm_is_false (full_filename))
-    SCM_MISC_ERROR ("Unable to find file ~S in load path",
-		    scm_list_1 (filename));
+  if (scm_is_false (full_filename)
+      || (scm_is_true (compiled_filename)
+          && compiled_is_fresh (full_filename, compiled_filename)))
+    return scm_load_compiled_with_vm (compiled_filename);
 
-  return scm_primitive_load (full_filename);
+  /* Perhaps there was the installed .go that was stale, but our fallback is
+     fresh. Let's try that. Duplicating code, but perhaps that's OK. */
+
+  if (!compiled_is_fallback
+      && scm_is_true (*scm_loc_compile_fallback_path)
+      && scm_is_pair (*scm_loc_load_compiled_extensions)
+      && scm_is_string (scm_car (*scm_loc_load_compiled_extensions)))
+    {
+      SCM fallback = scm_string_append
+        (scm_list_3 (*scm_loc_compile_fallback_path,
+                     full_filename,
+                     scm_car (*scm_loc_load_compiled_extensions)));
+      if (scm_is_true (scm_stat (fallback, SCM_BOOL_F))
+          && compiled_is_fresh (full_filename, fallback))
+        {
+          scm_puts (";;; found fresh local cache at ", scm_current_error_port ());
+          scm_display (fallback, scm_current_error_port ());
+          scm_newline (scm_current_error_port ());
+          return scm_load_compiled_with_vm (compiled_filename);
+        }
+    }
+
+  /* Otherwise, we bottom out here. */
+  {
+    SCM freshly_compiled = scm_try_autocompile (full_filename);
+
+    if (scm_is_true (freshly_compiled))
+      return scm_load_compiled_with_vm (freshly_compiled);
+    else
+      return scm_primitive_load (full_filename);
+  }
 }
 #undef FUNC_NAME
 
 SCM
 scm_c_primitive_load_path (const char *filename)
 {
-  return scm_primitive_load_path (scm_from_locale_string (filename));
+  return scm_primitive_load_path (scm_from_locale_string (filename),
+                                  SCM_BOOL_T);
 }
 
 
@@ -514,8 +805,19 @@ scm_init_load ()
     = SCM_VARIABLE_LOC (scm_c_define ("%load-extensions",
 				      scm_list_2 (scm_from_locale_string (".scm"),
 						  scm_nullstr)));
+  scm_loc_load_compiled_path
+    = SCM_VARIABLE_LOC (scm_c_define ("%load-compiled-path", SCM_EOL));
+  scm_loc_load_compiled_extensions
+    = SCM_VARIABLE_LOC (scm_c_define ("%load-compiled-extensions",
+				      scm_list_1 (scm_from_locale_string (".go"))));
   scm_loc_load_hook = SCM_VARIABLE_LOC (scm_c_define ("%load-hook", SCM_BOOL_F));
 
+  scm_loc_compile_fallback_path
+    = SCM_VARIABLE_LOC (scm_c_define ("%compile-fallback-path", SCM_BOOL_F));
+
+  scm_loc_load_should_autocompile
+    = SCM_VARIABLE_LOC (scm_c_define ("%load-should-autocompile", SCM_BOOL_F));
+
   the_reader = scm_make_fluid ();
   scm_fluid_set_x (the_reader, SCM_BOOL_F);
   scm_c_define("current-reader", the_reader);
diff --git a/libguile/load.h b/libguile/load.h
index 57cc7e8ac..1a1a86528 100644
--- a/libguile/load.h
+++ b/libguile/load.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,1998,2000,2001, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -31,10 +32,11 @@ SCM_API SCM scm_c_primitive_load (const char *filename);
 SCM_API SCM scm_sys_package_data_dir (void);
 SCM_API SCM scm_sys_library_dir (void);
 SCM_API SCM scm_sys_site_dir (void);
-SCM_API SCM scm_search_path (SCM path, SCM filename, SCM exts);
+SCM_API SCM scm_search_path (SCM path, SCM filename, SCM exts, SCM require_exts);
 SCM_API SCM scm_sys_search_load_path (SCM filename);
-SCM_API SCM scm_primitive_load_path (SCM filename);
+SCM_API SCM scm_primitive_load_path (SCM filename, SCM exception_on_not_found);
 SCM_API SCM scm_c_primitive_load_path (const char *filename);
+SCM_INTERNAL SCM scm_sys_warn_autocompilation_enabled (void);
 SCM_INTERNAL void scm_init_load_path (void);
 SCM_INTERNAL void scm_init_load (void);
 
diff --git a/libguile/locale-categories.h b/libguile/locale-categories.h
index cbe9684a3..26b030dc5 100644
--- a/libguile/locale-categories.h
+++ b/libguile/locale-categories.h
@@ -1,18 +1,19 @@
 /* Copyright (C) 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 /* A list of all available locale categories, not including `ALL'.  */
diff --git a/libguile/macros.c b/libguile/macros.c
index e8899f5a0..3e0942c43 100644
--- a/libguile/macros.c
+++ b/libguile/macros.c
@@ -1,18 +1,19 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003, 2006, 2008, 2009 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -31,6 +32,7 @@
 #include "libguile/deprecation.h"
 
 #include "libguile/validate.h"
+#include "libguile/programs.h"
 #include "libguile/macros.h"
 
 #include "libguile/private-options.h"
@@ -47,10 +49,13 @@ macro_print (SCM macro, SCM port, scm_print_state *pstate)
       || scm_is_false (scm_printer_apply (SCM_PRINT_CLOSURE,
 					macro, port, pstate)))
     {
-      if (!SCM_CLOSUREP (code))
-	scm_puts ("#<primitive-", port);
-      else
-	scm_puts ("#<", port);
+      scm_puts ("#<", port);
+
+      if (SCM_MACRO_TYPE (macro) < 4 && SCM_MACRO_IS_EXTENDED (macro))
+	scm_puts ("extended-", port);
+
+      if (!SCM_CLOSUREP (code) && !SCM_PROGRAM_P (code))
+	scm_puts ("primitive-", port);
 
       if (SCM_MACRO_TYPE (macro) == 0)
 	scm_puts ("syntax", port);
@@ -62,6 +67,8 @@ macro_print (SCM macro, SCM port, scm_print_state *pstate)
 	scm_puts ("macro!", port);
       if (SCM_MACRO_TYPE (macro) == 3)
 	scm_puts ("builtin-macro!", port);
+      if (SCM_MACRO_TYPE (macro) == 4)
+	scm_puts ("syncase-macro", port);
 
       scm_putc (' ', port);
       scm_iprin1 (scm_macro_name (macro), port, pstate);
@@ -76,6 +83,14 @@ macro_print (SCM macro, SCM port, scm_print_state *pstate)
 	  scm_iprin1 (src, port, pstate);
 	}
 
+      if (SCM_MACRO_IS_EXTENDED (macro))
+        {
+          scm_putc (' ', port);
+          scm_write (SCM_SMOB_OBJECT_2 (macro), port);
+          scm_putc (' ', port);
+          scm_write (SCM_SMOB_OBJECT_3 (macro), port);
+        }
+
       scm_putc ('>', port);
     }
 
@@ -163,11 +178,45 @@ SCM_DEFINE (scm_makmacro, "procedure->macro", 1, 0, 0,
 
 #endif
 
+SCM_DEFINE (scm_make_syncase_macro, "make-syncase-macro", 2, 0, 0,
+            (SCM type, SCM binding),
+	    "Return a @dfn{macro} that requires expansion by syntax-case.\n"
+            "While users should not call this function, it is useful to know\n"
+            "that syntax-case macros are represented as Guile primitive macros.")
+#define FUNC_NAME s_scm_make_syncase_macro
+{
+  SCM z;
+  SCM_VALIDATE_SYMBOL (1, type);
+
+  SCM_NEWSMOB3 (z, scm_tc16_macro, SCM_UNPACK (binding), SCM_UNPACK (type),
+                SCM_UNPACK (binding));
+  SCM_SET_SMOB_FLAGS (z, 4 | SCM_F_MACRO_EXTENDED);
+  return z;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_make_extended_syncase_macro, "make-extended-syncase-macro", 3, 0, 0,
+            (SCM m, SCM type, SCM binding),
+	    "Extend a core macro @var{m} with a syntax-case binding.")
+#define FUNC_NAME s_scm_make_extended_syncase_macro
+{
+  SCM z;
+  SCM_VALIDATE_SMOB (1, m, macro);
+  SCM_VALIDATE_SYMBOL (2, type);
+
+  SCM_NEWSMOB3 (z, scm_tc16_macro, SCM_SMOB_DATA (m), SCM_UNPACK (type),
+                SCM_UNPACK (binding));
+  SCM_SET_SMOB_FLAGS (z, SCM_SMOB_FLAGS (m) | SCM_F_MACRO_EXTENDED);
+  return z;
+}
+#undef FUNC_NAME
+
+
 
 SCM_DEFINE (scm_macro_p, "macro?", 1, 0, 0, 
             (SCM obj),
-	    "Return @code{#t} if @var{obj} is a regular macro, a memoizing macro or a\n"
-	    "syntax transformer.")
+	    "Return @code{#t} if @var{obj} is a regular macro, a memoizing macro, a\n"
+	    "syntax transformer, or a syntax-case macro.")
 #define FUNC_NAME s_scm_macro_p
 {
   return scm_from_bool (SCM_SMOB_PREDICATE (scm_tc16_macro, obj));
@@ -181,14 +230,15 @@ SCM_SYMBOL (scm_sym_macro, "macro");
 #endif
 SCM_SYMBOL (scm_sym_mmacro, "macro!");
 SCM_SYMBOL (scm_sym_bimacro, "builtin-macro!");
+SCM_SYMBOL (scm_sym_syncase_macro, "syncase-macro");
 
 SCM_DEFINE (scm_macro_type, "macro-type", 1, 0, 0, 
             (SCM m),
-	    "Return one of the symbols @code{syntax}, @code{macro} or\n"
-	    "@code{macro!}, depending on whether @var{m} is a syntax\n"
-	    "transformer, a regular macro, or a memoizing macro,\n"
-	    "respectively.  If @var{m} is not a macro, @code{#f} is\n"
-	    "returned.")
+	    "Return one of the symbols @code{syntax}, @code{macro},\n"
+	    "@code{macro!}, or @code{syntax-case}, depending on whether\n"
+            "@var{m} is a syntax transformer, a regular macro, a memoizing\n"
+            "macro, or a syntax-case macro, respectively.  If @var{m} is\n"
+            "not a macro, @code{#f} is returned.")
 #define FUNC_NAME s_scm_macro_type
 {
   if (!SCM_SMOB_PREDICATE (scm_tc16_macro, m))
@@ -201,6 +251,7 @@ SCM_DEFINE (scm_macro_type, "macro-type", 1, 0, 0,
 #endif
     case 2: return scm_sym_mmacro;
     case 3: return scm_sym_bimacro;
+    case 4: return scm_sym_syncase_macro;
     default: scm_wrong_type_arg (FUNC_NAME, 1, m);
     }
 }
@@ -213,7 +264,9 @@ SCM_DEFINE (scm_macro_name, "macro-name", 1, 0, 0,
 #define FUNC_NAME s_scm_macro_name
 {
   SCM_VALIDATE_SMOB (1, m, macro);
-  return scm_procedure_name (SCM_PACK (SCM_SMOB_DATA (m)));
+  if (scm_is_true (scm_procedure_p (SCM_SMOB_OBJECT (m))))
+    return scm_procedure_name (SCM_SMOB_OBJECT (m));
+  return SCM_BOOL_F;
 }
 #undef FUNC_NAME
 
@@ -223,9 +276,43 @@ SCM_DEFINE (scm_macro_transformer, "macro-transformer", 1, 0, 0,
 	    "Return the transformer of the macro @var{m}.")
 #define FUNC_NAME s_scm_macro_transformer
 {
+  SCM data;
+
+  SCM_VALIDATE_SMOB (1, m, macro);
+  data = SCM_PACK (SCM_SMOB_DATA (m));
+  
+  if (SCM_CLOSUREP (data) || SCM_PROGRAM_P (data))
+    return data;
+  else
+    return SCM_BOOL_F;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_syncase_macro_type, "syncase-macro-type", 1, 0, 0, 
+            (SCM m),
+	    "Return the type of the macro @var{m}.")
+#define FUNC_NAME s_scm_syncase_macro_type
+{
+  SCM_VALIDATE_SMOB (1, m, macro);
+
+  if (SCM_MACRO_IS_EXTENDED (m))
+    return SCM_SMOB_OBJECT_2 (m);
+  else
+    return SCM_BOOL_F;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_syncase_macro_binding, "syncase-macro-binding", 1, 0, 0, 
+            (SCM m),
+	    "Return the binding of the macro @var{m}.")
+#define FUNC_NAME s_scm_syncase_macro_binding
+{
   SCM_VALIDATE_SMOB (1, m, macro);
-  return ((SCM_CLOSUREP (SCM_PACK (SCM_SMOB_DATA (m)))) ?
-	  SCM_PACK(SCM_SMOB_DATA (m)) : SCM_BOOL_F);
+
+  if (SCM_MACRO_IS_EXTENDED (m))
+    return SCM_SMOB_OBJECT_3 (m);
+  else
+    return SCM_BOOL_F;
 }
 #undef FUNC_NAME
 
diff --git a/libguile/macros.h b/libguile/macros.h
index e1de77ff9..8ff41c4a4 100644
--- a/libguile/macros.h
+++ b/libguile/macros.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1998,2000,2001,2002,2003, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -29,9 +30,15 @@
 #define SCM_ASSYNT(_cond, _msg, _subr) \
   if (!(_cond)) scm_misc_error (_subr, _msg, SCM_EOL);
 
+#define SCM_MACRO_TYPE_BITS  (3)
+#define SCM_MACRO_TYPE_MASK  ((1<<SCM_MACRO_TYPE_BITS)-1)
+#define SCM_F_MACRO_EXTENDED (1<<SCM_MACRO_TYPE_BITS)
+
 #define SCM_MACROP(x) SCM_SMOB_PREDICATE (scm_tc16_macro, (x))
-#define SCM_MACRO_TYPE(m) SCM_SMOB_FLAGS (m)
+#define SCM_MACRO_TYPE(m) (SCM_SMOB_FLAGS (m) & SCM_MACRO_TYPE_MASK)
+#define SCM_MACRO_IS_EXTENDED(m) (SCM_SMOB_FLAGS (m) & SCM_F_MACRO_EXTENDED)
 #define SCM_BUILTIN_MACRO_P(x) (SCM_MACROP (x) && SCM_MACRO_TYPE (x) == 3)
+#define SCM_SYNCASE_MACRO_P(x) (SCM_MACROP (x) && SCM_MACRO_TYPE (x) == 4)
 #define SCM_MACRO_CODE(m) SCM_SMOB_OBJECT (m)
 
 SCM_API scm_t_bits scm_tc16_macro;
@@ -39,10 +46,15 @@ SCM_API scm_t_bits scm_tc16_macro;
 SCM_INTERNAL SCM scm_i_makbimacro (SCM code);
 SCM_API SCM scm_makmmacro (SCM code);
 SCM_API SCM scm_makacro (SCM code);
+SCM_API SCM scm_make_syncase_macro (SCM type, SCM binding);
+SCM_API SCM scm_make_extended_syncase_macro (SCM builtin, SCM type,
+                                             SCM binding);
 SCM_API SCM scm_macro_p (SCM obj);
 SCM_API SCM scm_macro_type (SCM m);
 SCM_API SCM scm_macro_name (SCM m);
 SCM_API SCM scm_macro_transformer (SCM m);
+SCM_API SCM scm_syncase_macro_type (SCM m);
+SCM_API SCM scm_syncase_macro_binding (SCM m);
 SCM_API SCM scm_make_synt (const char *name,
 			   SCM (*macroizer) (SCM),
 			   SCM (*fcn) ());
diff --git a/libguile/mallocs.c b/libguile/mallocs.c
index 8fb3ab0ba..6a366aeea 100644
--- a/libguile/mallocs.c
+++ b/libguile/mallocs.c
@@ -2,18 +2,19 @@
  * Copyright (C) 1995,1997,1998,2000,2001, 2006 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/mallocs.h b/libguile/mallocs.h
index f711ddb94..9c797e9f8 100644
--- a/libguile/mallocs.h
+++ b/libguile/mallocs.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,2000, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/measure-hwm.scm b/libguile/measure-hwm.scm
deleted file mode 100644
index 53a30d560..000000000
--- a/libguile/measure-hwm.scm
+++ /dev/null
@@ -1,136 +0,0 @@
-;;;; Copyright (C) 2008 Free Software Foundation, Inc.
-;;;;
-;;;; This library is free software; you can redistribute it and/or
-;;;; modify it under the terms of the GNU Lesser General Public
-;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
-;;;; 
-;;;; This library is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;;; Lesser General Public License for more details.
-;;;; 
-;;;; You should have received a copy of the GNU Lesser General Public
-;;;; License along with this library; if not, write to the Free Software
-;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-;;;;
-
-;;; Commentary:
-
-;;; This code is run during the Guile build, in order to set the stack
-;;; limit to a value that will allow the `make check' tests to pass,
-;;; taking into account the average stack usage on the build platform.
-;;; For more detail, see the text below that gets written out to the
-;;; stack limit calibration file.
-
-;;; Code:
-
-;; Store off Guile's default stack limit.
-(define default-stack-limit (cadr (memq 'stack (debug-options))))
-
-;; Now disable the stack limit, so that we don't get a stack overflow
-;; while running this code!
-(debug-set! stack 0)
-
-;; Define a variable to hold the measured stack high water mark (HWM).
-(define top-repl-hwm-measured 0)
-
-;; Use an evaluator trap to measure the stack size at every
-;; evaluation step, and increase top-repl-hwm-measured if it is less
-;; than the measured stack size.
-(trap-set! enter-frame-handler
-	   (lambda _
-	     (let ((stack-size (%get-stack-size)))
-	       (if (< top-repl-hwm-measured stack-size)
-		   (set! top-repl-hwm-measured stack-size)))))
-(trap-enable 'enter-frame)
-(trap-enable 'traps)
-
-;; Call (turn-on-debugging) and (top-repl) in order to simulate as
-;; closely as possible what happens - and in particular, how much
-;; stack is used - when a standard Guile REPL is started up.
-;;
-;; `make check' stack overflow errors have been reported in the past
-;; for:
-;;
-;; - test-suite/standalone/test-use-srfi, which runs `guile -q
-;;   --use-srfi=...' a few times, with standard input for the REPL
-;;   coming from a shell script
-;;
-;; - test-suite/tests/elisp.test, which does not involve the REPL, but
-;;   has a lot of `use-modules' calls.
-;;
-;; Stack high water mark (HWM) measurements show that the HWM is
-;; higher in the test-use-srfi case - specifically because of the
-;; complexity of (top-repl) - so that is what we simulate for our
-;; calibration model here.
-(turn-on-debugging)
-(with-output-to-port (%make-void-port "w")
-  (lambda ()
-    (with-input-from-string "\n" top-repl)))
-
-;; top-repl-hwm-measured now contains the stack HWM that resulted from
-;; running that code.
-
-;; This is the value of top-repl-hwm-measured that we get on a
-;; `canonical' build platform.  (See text below for what that means.)
-(define top-repl-hwm-i686-pc-linux-gnu 9461)
-
-;; Using the above results, output code that tests can run in order to
-;; configure the stack limit correctly for the current build platform.
-(format #t "\
-;; Stack limit calibration file.
-;;
-;; This file is automatically generated by Guile when it builds, in
-;; order to set the stack limit to a value that reflects the stack
-;; usage of the build platform (OS + compiler + compilation options),
-;; specifically so that none of Guile's own tests (which are run by
-;; `make check') fail because of a benign stack overflow condition.
-;;
-;; By a `benign' stack overflow condition, we mean one where the test
-;; code is behaving correctly, but exceeds the configured stack limit
-;; because the limit is set too low.  A non-benign stack overflow
-;; condition would be if a piece of test code behaved significantly
-;; differently on some platform to how it does normally, and as a
-;; result consumed a lot more stack.  Although they seem pretty
-;; unlikely, we would want to catch non-benign conditions like this,
-;; and that is why we don't just do `(debug-set! stack 0)' when
-;; running `make check'.
-;;
-;; Although the primary purpose of this file is to prevent `make
-;; check' from failing without good reason, Guile developers and users
-;; may also find the following information useful, when determining
-;; what stack limit to configure for their own programs.
-
- (let (;; The stack high water mark measured when starting up the
-       ;; standard Guile REPL on the current build platform.
-       (top-repl-hwm-measured ~a)
-
-       ;; The value of top-repl-hwm-measured that we get when building
-       ;; Guile on an i686 PC GNU/Linux system, after configuring with
-       ;; `./configure --enable-maintainer-mode --with-threads'.
-       ;; (Hereafter referred to as the `canonical' build platform.)
-       (top-repl-hwm-i686-pc-linux-gnu ~a)
-
-       ;; Guile's default stack limit (i.e. the initial, C-coded value
-       ;; of the 'stack debug option).  In the context of this file,
-       ;; the important thing about this number is that we know that
-       ;; it allows all of the `make check' tests to pass on the
-       ;; canonical build platform.
-       (default-stack-limit ~a)
-
-       ;; Calibrated stack limit.  This is the default stack limit,
-       ;; scaled by the factor between top-repl-hwm-i686-pc-linux-gnu
-       ;; and top-repl-hwm-measured.
-       (calibrated-stack-limit ~a))
-
-   ;; Configure the calibrated stack limit.
-   (debug-set! stack calibrated-stack-limit))
-"
-	top-repl-hwm-measured
-	top-repl-hwm-i686-pc-linux-gnu
-	default-stack-limit
-	;; Use quotient here to get an integer result, rather than a
-	;; rational.
-	(quotient (* default-stack-limit top-repl-hwm-measured)
-		  top-repl-hwm-i686-pc-linux-gnu))
diff --git a/libguile/modules.c b/libguile/modules.c
index 04527a529..deae23a59 100644
--- a/libguile/modules.c
+++ b/libguile/modules.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1998,2000,2001,2002,2003,2004,2006,2007,2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -345,6 +346,8 @@ resolve_duplicate_binding (SCM module, SCM sym,
   return result;
 }
 
+SCM scm_pre_modules_obarray;
+
 /* Lookup SYM as an imported variable of MODULE.  */
 static inline SCM
 module_imported_variable (SCM module, SCM sym)
@@ -416,13 +419,13 @@ SCM_DEFINE (scm_module_local_variable, "module-local-variable", 2, 0, 0,
 
   register SCM b;
 
-  /* SCM_MODULE_TAG is not initialized yet when `boot-9.scm' is being
-     evaluated.  */
   if (scm_module_system_booted_p)
     SCM_VALIDATE_MODULE (1, module);
 
   SCM_VALIDATE_SYMBOL (2, sym);
 
+  if (scm_is_false (module))
+    return scm_hashq_ref (scm_pre_modules_obarray, sym, SCM_UNDEFINED);
 
   /* 1. Check module obarray */
   b = scm_hashq_ref (SCM_MODULE_OBARRAY (module), sym, SCM_UNDEFINED);
@@ -471,6 +474,9 @@ SCM_DEFINE (scm_module_variable, "module-variable", 2, 0, 0,
 
   SCM_VALIDATE_SYMBOL (2, sym);
 
+  if (scm_is_false (module))
+    return scm_hashq_ref (scm_pre_modules_obarray, sym, SCM_UNDEFINED);
+
   /* 1. Check module obarray */
   var = scm_hashq_ref (SCM_MODULE_OBARRAY (module), sym, SCM_UNDEFINED);
   if (SCM_BOUND_THING_P (var))
@@ -545,6 +551,21 @@ SCM_DEFINE (scm_standard_interface_eval_closure,
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (scm_eval_closure_module,
+	    "eval-closure-module", 1, 0, 0,
+	    (SCM eval_closure),
+	    "Return the module associated with this eval closure.")
+/* the idea is that eval closures are really not the way to do things, they're
+   superfluous given our module system. this function lets mmacros migrate away
+   from eval closures. */
+#define FUNC_NAME s_scm_eval_closure_module
+{
+  SCM_MAKE_VALIDATE_MSG (SCM_ARG1, eval_closure, EVAL_CLOSURE_P,
+                         "eval-closure");
+  return SCM_SMOB_OBJECT (eval_closure);
+}
+#undef FUNC_NAME
+
 SCM
 scm_module_lookup_closure (SCM module)
 {
@@ -563,11 +584,20 @@ scm_current_module_lookup_closure ()
     return SCM_BOOL_F;
 }
 
+SCM_SYMBOL (sym_sys_pre_modules_transformer, "%pre-modules-transformer");
+
 SCM
 scm_module_transformer (SCM module)
 {
-  if (scm_is_false (module))
-    return SCM_BOOL_F;
+  if (SCM_UNLIKELY (scm_is_false (module)))
+    { SCM v = scm_hashq_ref (scm_pre_modules_obarray,
+                             sym_sys_pre_modules_transformer,
+                             SCM_BOOL_F);
+      if (scm_is_false (v))
+        return SCM_BOOL_F;
+      else
+        return SCM_VARIABLE_REF (v);
+    }
   else
     return SCM_MODULE_TRANSFORMER (module);
 }
@@ -575,10 +605,7 @@ scm_module_transformer (SCM module)
 SCM
 scm_current_module_transformer ()
 {
-  if (scm_module_system_booted_p)
-    return scm_module_transformer (scm_current_module ());
-  else
-    return SCM_BOOL_F;
+  return scm_module_transformer (scm_current_module ());
 }
 
 SCM_DEFINE (scm_module_import_interface, "module-import-interface", 2, 0, 0,
@@ -624,6 +651,25 @@ SCM_DEFINE (scm_module_import_interface, "module-import-interface", 2, 0, 0,
 }
 #undef FUNC_NAME
 
+SCM_SYMBOL (sym_sys_module_public_interface, "%module-public-interface");
+
+SCM_DEFINE (scm_module_public_interface, "module-public-interface", 1, 0, 0,
+	    (SCM module),
+	    "Return the public interface of @var{module}.\n\n"
+            "If @var{module} has no public interface, @code{#f} is returned.")
+#define FUNC_NAME s_scm_module_public_interface
+{
+  SCM var;
+
+  SCM_VALIDATE_MODULE (1, module);
+  var = scm_module_local_variable (module, sym_sys_module_public_interface);
+  if (scm_is_true (var))
+    return SCM_VARIABLE_REF (var);
+  else
+    return SCM_BOOL_F;
+}
+#undef FUNC_NAME
+
 /* scm_sym2var
  *
  * looks up the variable bound to SYM according to PROC.  PROC should be
@@ -637,8 +683,6 @@ SCM_DEFINE (scm_module_import_interface, "module-import-interface", 2, 0, 0,
  * the scm_pre_modules_obarray (a `eq' hash table).
  */
 
-SCM scm_pre_modules_obarray;
-
 SCM 
 scm_sym2var (SCM sym, SCM proc, SCM definep)
 #define FUNC_NAME "scm_sym2var"
diff --git a/libguile/modules.h b/libguile/modules.h
index afac9f4e4..8108ac3e1 100644
--- a/libguile/modules.h
+++ b/libguile/modules.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1998, 2000, 2001, 2002, 2003, 2006, 2007, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -100,6 +101,7 @@ SCM_API void scm_c_export (const char *name, ...);
 
 SCM_API SCM scm_sym2var (SCM sym, SCM thunk, SCM definep);
 
+SCM_API SCM scm_module_public_interface (SCM module);
 SCM_API SCM scm_module_import_interface (SCM module, SCM sym);
 SCM_API SCM scm_module_lookup_closure (SCM module);
 SCM_API SCM scm_module_transformer (SCM module);
@@ -108,6 +110,7 @@ SCM_API SCM scm_current_module_transformer (void);
 SCM_API SCM scm_eval_closure_lookup (SCM eclo, SCM sym, SCM definep);
 SCM_API SCM scm_standard_eval_closure (SCM module);
 SCM_API SCM scm_standard_interface_eval_closure (SCM module);
+SCM_API SCM scm_eval_closure_module (SCM eval_closure); /* deprecated already */
 SCM_API SCM scm_get_pre_modules_obarray (void);
 SCM_API SCM scm_lookup_closure_module (SCM proc);
 
diff --git a/libguile/net_db.c b/libguile/net_db.c
index deb8d381d..4307091f7 100644
--- a/libguile/net_db.c
+++ b/libguile/net_db.c
@@ -1,19 +1,20 @@
 /* "net_db.c" network database support
- * Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2006 Free Software Foundation, Inc.
+ * Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2006, 2009 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -64,6 +65,12 @@
 extern int h_errno;
 #endif
 
+#if defined HAVE_HSTRERROR && !HAVE_DECL_HSTRERROR	\
+  && !defined __MINGW32__ && !defined __CYGWIN__
+/* Some OSes, such as Tru64 5.1b, lack a declaration for hstrerror(3).  */
+extern const char *hstrerror (int);
+#endif
+
 
 
 SCM_SYMBOL (scm_host_not_found_key, "host-not-found");
diff --git a/libguile/net_db.h b/libguile/net_db.h
index df1f03067..4b6327f27 100644
--- a/libguile/net_db.h
+++ b/libguile/net_db.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,2000,2001, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/null-threads.c b/libguile/null-threads.c
index 814017564..28eff2c61 100644
--- a/libguile/null-threads.c
+++ b/libguile/null-threads.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 2002, 2006, 2008 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 #ifdef HAVE_CONFIG_H
diff --git a/libguile/null-threads.h b/libguile/null-threads.h
index 5a61dbf50..ec83ab798 100644
--- a/libguile/null-threads.h
+++ b/libguile/null-threads.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 2005, 2006 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/numbers.c b/libguile/numbers.c
index 7006cccb6..20fda02da 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -1,22 +1,23 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
  *
  * Portions Copyright 1990, 1991, 1992, 1993 by AT&T Bell Laboratories
  * and Bellcore.  See scm_divide.
  *
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -45,8 +46,9 @@
 #endif
 
 #include <math.h>
-#include <ctype.h>
 #include <string.h>
+#include <unicase.h>
+#include <unictype.h>
 
 #if HAVE_COMPLEX_H
 #include <complex.h>
@@ -2436,7 +2438,7 @@ scm_i_print_fraction (SCM sexp, SCM port, scm_print_state *pstate SCM_UNUSED)
 {
   SCM str;
   str = scm_number_to_string (sexp, SCM_UNDEFINED);
-  scm_lfwrite (scm_i_string_chars (str), scm_i_string_length (str), port);
+  scm_lfwrite_str (str, port);
   scm_remember_upto_here_1 (str);
   return !0;
 }
@@ -2483,13 +2485,13 @@ enum t_exactness {NO_EXACTNESS, INEXACT, EXACT};
 /* R5RS, section 7.1.1, lexical structure of numbers: <uinteger R>. */
 
 /* In non ASCII-style encodings the following macro might not work. */
-#define XDIGIT2UINT(d)                                  \
-  (isdigit ((int) (unsigned char) d)                    \
-   ? (d) - '0'                                          \
-   : tolower ((int) (unsigned char) d) - 'a' + 10)
+#define XDIGIT2UINT(d)                                                  \
+  (uc_is_property_decimal_digit ((int) (unsigned char) d)               \
+   ? (d) - '0'                                                          \
+   : uc_tolower ((int) (unsigned char) d) - 'a' + 10)
 
 static SCM
-mem2uinteger (const char* mem, size_t len, unsigned int *p_idx,
+mem2uinteger (SCM mem, unsigned int *p_idx,
 	      unsigned int radix, enum t_exactness *p_exactness)
 {
   unsigned int idx = *p_idx;
@@ -2499,12 +2501,13 @@ mem2uinteger (const char* mem, size_t len, unsigned int *p_idx,
   unsigned int digit_value;
   SCM result;
   char c;
+  size_t len = scm_i_string_length (mem);
 
   if (idx == len)
     return SCM_BOOL_F;
 
-  c = mem[idx];
-  if (!isxdigit ((int) (unsigned char) c))
+  c = scm_i_string_ref (mem, idx);
+  if (!uc_is_property_ascii_hex_digit ((scm_t_uint32) c))
     return SCM_BOOL_F;
   digit_value = XDIGIT2UINT (c);
   if (digit_value >= radix)
@@ -2514,8 +2517,8 @@ mem2uinteger (const char* mem, size_t len, unsigned int *p_idx,
   result = SCM_I_MAKINUM (digit_value);
   while (idx != len)
     {
-      char c = mem[idx];
-      if (isxdigit ((int) (unsigned char) c))
+      scm_t_wchar c = scm_i_string_ref (mem, idx);
+      if (uc_is_property_ascii_hex_digit ((scm_t_uint32) c))
 	{
 	  if (hash_seen)
 	    break;
@@ -2568,20 +2571,20 @@ mem2uinteger (const char* mem, size_t len, unsigned int *p_idx,
  * has already been seen in the digits before the point.
  */
 
-/* In non ASCII-style encodings the following macro might not work. */
-#define DIGIT2UINT(d) ((d) - '0')
+#define DIGIT2UINT(d) (uc_numeric_value(d).numerator)
 
 static SCM
-mem2decimal_from_point (SCM result, const char* mem, size_t len, 
+mem2decimal_from_point (SCM result, SCM mem, 
 			unsigned int *p_idx, enum t_exactness *p_exactness)
 {
   unsigned int idx = *p_idx;
   enum t_exactness x = *p_exactness;
+  size_t len = scm_i_string_length (mem);
 
   if (idx == len)
     return result;
 
-  if (mem[idx] == '.')
+  if (scm_i_string_ref (mem, idx) == '.')
     {
       scm_t_bits shift = 1;
       scm_t_bits add = 0;
@@ -2591,8 +2594,8 @@ mem2decimal_from_point (SCM result, const char* mem, size_t len,
       idx++;
       while (idx != len)
 	{
-	  char c = mem[idx];
-	  if (isdigit ((int) (unsigned char) c))
+	  scm_t_wchar c = scm_i_string_ref (mem, idx);
+	  if (uc_is_property_decimal_digit ((scm_t_uint32) c))
 	    {
 	      if (x == INEXACT)
 		return SCM_BOOL_F;
@@ -2642,13 +2645,13 @@ mem2decimal_from_point (SCM result, const char* mem, size_t len,
     {
       int sign = 1;
       unsigned int start;
-      char c;
+      scm_t_wchar c;
       int exponent;
       SCM e;
 
       /* R5RS, section 7.1.1, lexical structure of numbers: <suffix> */
 
-      switch (mem[idx])
+      switch (scm_i_string_ref (mem, idx))
 	{
 	case 'd': case 'D':
 	case 'e': case 'E':
@@ -2656,32 +2659,41 @@ mem2decimal_from_point (SCM result, const char* mem, size_t len,
 	case 'l': case 'L':
 	case 's': case 'S':
 	  idx++;
+          if (idx == len)
+            return SCM_BOOL_F;
+
 	  start = idx;
-	  c = mem[idx];
+	  c = scm_i_string_ref (mem, idx);
 	  if (c == '-')
 	    {
 	      idx++;
+              if (idx == len)
+                return SCM_BOOL_F;
+
 	      sign = -1;
-	      c = mem[idx];
+	      c = scm_i_string_ref (mem, idx);
 	    }
 	  else if (c == '+')
 	    {
 	      idx++;
+              if (idx == len)
+                return SCM_BOOL_F;
+
 	      sign = 1;
-	      c = mem[idx];
+	      c = scm_i_string_ref (mem, idx);
 	    }
 	  else
 	    sign = 1;
 
-	  if (!isdigit ((int) (unsigned char) c))
+	  if (!uc_is_property_decimal_digit ((scm_t_uint32) c))
 	    return SCM_BOOL_F;
 
 	  idx++;
 	  exponent = DIGIT2UINT (c);
 	  while (idx != len)
 	    {
-	      char c = mem[idx];
-	      if (isdigit ((int) (unsigned char) c))
+	      scm_t_wchar c = scm_i_string_ref (mem, idx);
+	      if (uc_is_property_decimal_digit ((scm_t_uint32) c))
 		{
 		  idx++;
 		  if (exponent <= SCM_MAXEXP)
@@ -2694,7 +2706,7 @@ mem2decimal_from_point (SCM result, const char* mem, size_t len,
 	  if (exponent > SCM_MAXEXP)
 	    {
 	      size_t exp_len = idx - start;
-	      SCM exp_string = scm_from_locale_stringn (&mem[start], exp_len);
+	      SCM exp_string = scm_i_substring_copy (mem, start, start + exp_len);
 	      SCM exp_num = scm_string_to_number (exp_string, SCM_UNDEFINED);
 	      scm_out_of_range ("string->number", exp_num);
 	    }
@@ -2726,63 +2738,67 @@ mem2decimal_from_point (SCM result, const char* mem, size_t len,
 /* R5RS, section 7.1.1, lexical structure of numbers: <ureal R> */
 
 static SCM
-mem2ureal (const char* mem, size_t len, unsigned int *p_idx,
+mem2ureal (SCM mem, unsigned int *p_idx,
 	   unsigned int radix, enum t_exactness *p_exactness)
 {
   unsigned int idx = *p_idx;
   SCM result;
+  size_t len = scm_i_string_length (mem);
+
+  /* Start off believing that the number will be exact.  This changes
+     to INEXACT if we see a decimal point or a hash. */
+  enum t_exactness x = EXACT;
 
   if (idx == len)
     return SCM_BOOL_F;
 
-  if (idx+5 <= len && !strncmp (mem+idx, "inf.0", 5))
+  if (idx+5 <= len && !scm_i_string_strcmp (mem, idx, "inf.0"))
     {
       *p_idx = idx+5;
       return scm_inf ();
     }
 
-  if (idx+4 < len && !strncmp (mem+idx, "nan.", 4))
+  if (idx+4 < len && !scm_i_string_strcmp (mem, idx, "nan."))
     {
-      enum t_exactness x = EXACT;
-
       /* Cobble up the fractional part.  We might want to set the
 	 NaN's mantissa from it. */
       idx += 4;
-      mem2uinteger (mem, len, &idx, 10, &x);
+      mem2uinteger (mem, &idx, 10, &x);
       *p_idx = idx;
       return scm_nan ();
     }
 
-  if (mem[idx] == '.')
+  if (scm_i_string_ref (mem, idx) == '.')
     {
       if (radix != 10)
 	return SCM_BOOL_F;
       else if (idx + 1 == len)
 	return SCM_BOOL_F;
-      else if (!isdigit ((int) (unsigned char) mem[idx + 1]))
+      else if (!uc_is_property_decimal_digit ((scm_t_uint32) scm_i_string_ref (mem, idx+1)))
 	return SCM_BOOL_F;
       else
-	result = mem2decimal_from_point (SCM_I_MAKINUM (0), mem, len,
-					 p_idx, p_exactness);
+	result = mem2decimal_from_point (SCM_I_MAKINUM (0), mem,
+					 p_idx, &x);
     }
   else
     {
-      enum t_exactness x = EXACT;
       SCM uinteger;
 
-      uinteger = mem2uinteger (mem, len, &idx, radix, &x);
+      uinteger = mem2uinteger (mem, &idx, radix, &x);
       if (scm_is_false (uinteger))
 	return SCM_BOOL_F;
 
       if (idx == len)
 	result = uinteger;
-      else if (mem[idx] == '/')
+      else if (scm_i_string_ref (mem, idx) == '/')
 	{
 	  SCM divisor;
 
 	  idx++;
+          if (idx == len)
+            return SCM_BOOL_F;
 
-	  divisor = mem2uinteger (mem, len, &idx, radix, &x);
+	  divisor = mem2uinteger (mem, &idx, radix, &x);
 	  if (scm_is_false (divisor))
 	    return SCM_BOOL_F;
 
@@ -2791,7 +2807,7 @@ mem2ureal (const char* mem, size_t len, unsigned int *p_idx,
 	}
       else if (radix == 10)
 	{
-	  result = mem2decimal_from_point (uinteger, mem, len, &idx, &x);
+	  result = mem2decimal_from_point (uinteger, mem, &idx, &x);
 	  if (scm_is_false (result))
 	    return SCM_BOOL_F;
 	}
@@ -2799,10 +2815,16 @@ mem2ureal (const char* mem, size_t len, unsigned int *p_idx,
 	result = uinteger;
 
       *p_idx = idx;
-      if (x == INEXACT)
-	*p_exactness = x;
     }
 
+  /* Update *p_exactness if the number just read was inexact.  This is
+     important for complex numbers, so that a complex number is
+     treated as inexact overall if either its real or imaginary part
+     is inexact.
+  */
+  if (x == INEXACT)
+    *p_exactness = x;
+
   /* When returning an inexact zero, make sure it is represented as a
      floating point value so that we can change its sign. 
   */
@@ -2816,17 +2838,18 @@ mem2ureal (const char* mem, size_t len, unsigned int *p_idx,
 /* R5RS, section 7.1.1, lexical structure of numbers: <complex R> */
 
 static SCM
-mem2complex (const char* mem, size_t len, unsigned int idx,
+mem2complex (SCM mem, unsigned int idx,
 	     unsigned int radix, enum t_exactness *p_exactness)
 {
-  char c;
+  scm_t_wchar c;
   int sign = 0;
   SCM ureal;
+  size_t len = scm_i_string_length (mem);
 
   if (idx == len)
     return SCM_BOOL_F;
 
-  c = mem[idx];
+  c = scm_i_string_ref (mem, idx);
   if (c == '+')
     {
       idx++;
@@ -2841,7 +2864,7 @@ mem2complex (const char* mem, size_t len, unsigned int idx,
   if (idx == len)
     return SCM_BOOL_F;
 
-  ureal = mem2ureal (mem, len, &idx, radix, p_exactness);
+  ureal = mem2ureal (mem, &idx, radix, p_exactness);
   if (scm_is_false (ureal))
     {
       /* input must be either +i or -i */
@@ -2849,7 +2872,8 @@ mem2complex (const char* mem, size_t len, unsigned int idx,
       if (sign == 0)
 	return SCM_BOOL_F;
 
-      if (mem[idx] == 'i' || mem[idx] == 'I')
+      if (scm_i_string_ref (mem, idx) == 'i'
+	  || scm_i_string_ref (mem, idx) == 'I')
 	{
 	  idx++;
 	  if (idx != len)
@@ -2868,7 +2892,7 @@ mem2complex (const char* mem, size_t len, unsigned int idx,
       if (idx == len)
 	return ureal;
 
-      c = mem[idx];
+      c = scm_i_string_ref (mem, idx);
       switch (c)
 	{
 	case 'i': case 'I':
@@ -2893,21 +2917,25 @@ mem2complex (const char* mem, size_t len, unsigned int idx,
 	      SCM angle;
 	      SCM result;
 
-	      c = mem[idx];
+	      c = scm_i_string_ref (mem, idx);
 	      if (c == '+')
 		{
 		  idx++;
+                  if (idx == len)
+                    return SCM_BOOL_F;
 		  sign = 1;
 		}
 	      else if (c == '-')
 		{
 		  idx++;
+                  if (idx == len)
+                    return SCM_BOOL_F;
 		  sign = -1;
 		}
 	      else
 		sign = 1;
 
-	      angle = mem2ureal (mem, len, &idx, radix, p_exactness);
+	      angle = mem2ureal (mem, &idx, radix, p_exactness);
 	      if (scm_is_false (angle))
 		return SCM_BOOL_F;
 	      if (idx != len)
@@ -2929,7 +2957,7 @@ mem2complex (const char* mem, size_t len, unsigned int idx,
 	  else
 	    {
 	      int sign = (c == '+') ? 1 : -1;
-	      SCM imag = mem2ureal (mem, len, &idx, radix, p_exactness);
+	      SCM imag = mem2ureal (mem, &idx, radix, p_exactness);
 
 	      if (scm_is_false (imag))
 		imag = SCM_I_MAKINUM (sign);
@@ -2938,7 +2966,8 @@ mem2complex (const char* mem, size_t len, unsigned int idx,
 
 	      if (idx == len)
 		return SCM_BOOL_F;
-	      if (mem[idx] != 'i' && mem[idx] != 'I')
+	      if (scm_i_string_ref (mem, idx) != 'i'
+		  && scm_i_string_ref (mem, idx) != 'I')
 		return SCM_BOOL_F;
 
 	      idx++;
@@ -2959,19 +2988,19 @@ mem2complex (const char* mem, size_t len, unsigned int idx,
 enum t_radix {NO_RADIX=0, DUAL=2, OCT=8, DEC=10, HEX=16};
 
 SCM
-scm_c_locale_stringn_to_number (const char* mem, size_t len,
-				unsigned int default_radix)
+scm_i_string_to_number (SCM mem, unsigned int default_radix)
 {
   unsigned int idx = 0;
   unsigned int radix = NO_RADIX;
   enum t_exactness forced_x = NO_EXACTNESS;
   enum t_exactness implicit_x = EXACT;
   SCM result;
+  size_t len = scm_i_string_length (mem);
 
   /* R5RS, section 7.1.1, lexical structure of numbers: <prefix R> */
-  while (idx + 2 < len && mem[idx] == '#')
+  while (idx + 2 < len && scm_i_string_ref (mem, idx) == '#')
     {
-      switch (mem[idx + 1])
+      switch (scm_i_string_ref (mem, idx + 1))
 	{
 	case 'b': case 'B':
 	  if (radix != NO_RADIX)
@@ -3011,9 +3040,9 @@ scm_c_locale_stringn_to_number (const char* mem, size_t len,
 
   /* R5RS, section 7.1.1, lexical structure of numbers: <complex R> */
   if (radix == NO_RADIX)
-    result = mem2complex (mem, len, idx, default_radix, &implicit_x);
+    result = mem2complex (mem, idx, default_radix, &implicit_x);
   else
-    result = mem2complex (mem, len, idx, (unsigned int) radix, &implicit_x);
+    result = mem2complex (mem, idx, (unsigned int) radix, &implicit_x);
 
   if (scm_is_false (result))
     return SCM_BOOL_F;
@@ -3044,6 +3073,15 @@ scm_c_locale_stringn_to_number (const char* mem, size_t len,
     }
 }
 
+SCM
+scm_c_locale_stringn_to_number (const char* mem, size_t len,
+				unsigned int default_radix)
+{
+  SCM str = scm_from_locale_stringn (mem, len);
+
+  return scm_i_string_to_number (str, default_radix);
+}
+
 
 SCM_DEFINE (scm_string_to_number, "string->number", 1, 1, 0,
             (SCM string, SCM radix),
@@ -3066,9 +3104,7 @@ SCM_DEFINE (scm_string_to_number, "string->number", 1, 1, 0,
   else
     base = scm_to_unsigned_integer (radix, 2, INT_MAX);
 
-  answer = scm_c_locale_stringn_to_number (scm_i_string_chars (string),
-					   scm_i_string_length (string),
-					   base);
+  answer = scm_i_string_to_number (string, base);
   scm_remember_upto_here_1 (string);
   return answer;
 }
@@ -5353,7 +5389,12 @@ SCM
 scm_c_make_polar (double mag, double ang)
 {
   double s, c;
-#if HAVE_SINCOS
+
+  /* The sincos(3) function is undocumented an broken on Tru64.  Thus we only
+     use it on Glibc-based systems that have it (it's a GNU extension).  See
+     http://lists.gnu.org/archive/html/guile-user/2009-04/msg00033.html for
+     details.  */
+#if (defined HAVE_SINCOS) && (defined __GLIBC__) && (defined _GNU_SOURCE)
   sincos (ang, &s, &c);
 #else
   s = sin (ang);
@@ -5851,6 +5892,14 @@ scm_i_range_error (SCM bad_val, SCM min, SCM max)
 #define SCM_FROM_TYPE_PROTO(arg) scm_from_uint32 (arg)
 #include "libguile/conv-uinteger.i.c"
 
+#define TYPE                     scm_t_wchar
+#define TYPE_MIN                 (scm_t_int32)-1
+#define TYPE_MAX                 (scm_t_int32)0x10ffff
+#define SIZEOF_TYPE              4
+#define SCM_TO_TYPE_PROTO(arg)   scm_to_wchar (arg)
+#define SCM_FROM_TYPE_PROTO(arg) scm_from_wchar (arg)
+#include "libguile/conv-integer.i.c"
+
 #if SCM_HAVE_T_INT64
 
 #define TYPE                     scm_t_int64
diff --git a/libguile/numbers.h b/libguile/numbers.h
index e139dac7b..9597afb8d 100644
--- a/libguile/numbers.h
+++ b/libguile/numbers.h
@@ -3,21 +3,22 @@
 #ifndef SCM_NUMBERS_H
 #define SCM_NUMBERS_H
 
-/* Copyright (C) 1995,1996,1998,2000,2001,2002,2003,2004,2005, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,2000,2001,2002,2003,2004,2005, 2006, 2008, 2009 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -27,6 +28,11 @@
 #include "libguile/__scm.h"
 #include "libguile/print.h"
 
+#ifndef SCM_T_WCHAR_DEFINED
+typedef scm_t_int32 scm_t_wchar;
+#define SCM_T_WCHAR_DEFINED
+#endif /* SCM_T_WCHAR_DEFINED */
+
 #if SCM_HAVE_FLOATINGPOINT_H
 # include <floatingpoint.h>
 #endif
@@ -173,6 +179,7 @@ typedef struct scm_t_complex
   double imag;
 } scm_t_complex;
 
+
 
 
 SCM_API SCM scm_exact_p (SCM x);
@@ -209,6 +216,7 @@ SCM_API int scm_print_complex (SCM sexp, SCM port, scm_print_state *pstate);
 SCM_API int scm_bigprint (SCM exp, SCM port, scm_print_state *pstate);
 SCM_API SCM scm_c_locale_stringn_to_number (const char *mem, size_t len,
 					    unsigned int radix);
+SCM_INTERNAL SCM scm_i_string_to_number (SCM str, unsigned int radix);
 SCM_API SCM scm_string_to_number (SCM str, SCM radix);
 SCM_API SCM scm_bigequal (SCM x, SCM y);
 SCM_API SCM scm_real_equalp (SCM x, SCM y);
@@ -321,6 +329,9 @@ SCM_API SCM          scm_from_int32  (scm_t_int32 x);
 SCM_API scm_t_uint32 scm_to_uint32   (SCM x);
 SCM_API SCM          scm_from_uint32 (scm_t_uint32 x);
 
+SCM_API scm_t_wchar  scm_to_wchar    (SCM x);
+SCM_API SCM          scm_from_wchar  (scm_t_wchar x);
+
 #if SCM_HAVE_T_INT64
 
 SCM_API scm_t_int64  scm_to_int64    (SCM x);
diff --git a/libguile/objcodes.c b/libguile/objcodes.c
new file mode 100644
index 000000000..be3423271
--- /dev/null
+++ b/libguile/objcodes.c
@@ -0,0 +1,290 @@
+/* Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+ * 
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+#if HAVE_CONFIG_H
+#  include <config.h>
+#endif
+
+#include <string.h>
+#include <fcntl.h>
+#include <unistd.h>
+#include <sys/mman.h>
+#include <sys/stat.h>
+#include <sys/types.h>
+#include <assert.h>
+
+#include "_scm.h"
+#include "vm-bootstrap.h"
+#include "programs.h"
+#include "objcodes.h"
+
+/* SCM_OBJCODE_COOKIE is defined in _scm.h */
+/* The length of the header must be a multiple of 8 bytes.  */
+verify (((sizeof (SCM_OBJCODE_COOKIE) - 1) & 7) == 0);
+
+
+/*
+ * Objcode type
+ */
+
+scm_t_bits scm_tc16_objcode;
+
+static SCM
+make_objcode_by_mmap (int fd)
+#define FUNC_NAME "make_objcode_by_mmap"
+{
+  int ret;
+  char *addr;
+  struct stat st;
+  SCM sret = SCM_BOOL_F;
+  struct scm_objcode *data;
+
+  ret = fstat (fd, &st);
+  if (ret < 0)
+    SCM_SYSERROR;
+
+  if (st.st_size <= sizeof (struct scm_objcode) + strlen (SCM_OBJCODE_COOKIE))
+    scm_misc_error (FUNC_NAME, "object file too small (~a bytes)",
+		    scm_list_1 (SCM_I_MAKINUM (st.st_size)));
+
+  addr = mmap (0, st.st_size, PROT_READ, MAP_SHARED, fd, 0);
+  if (addr == MAP_FAILED)
+    {
+      (void) close (fd);
+      SCM_SYSERROR;
+    }
+
+  if (memcmp (addr, SCM_OBJCODE_COOKIE, strlen (SCM_OBJCODE_COOKIE)))
+    {
+      SCM args = scm_list_1 (scm_from_locale_stringn
+                             (addr, strlen (SCM_OBJCODE_COOKIE)));
+      (void) close (fd);
+      (void) munmap (addr, st.st_size);
+      scm_misc_error (FUNC_NAME, "bad header on object file: ~s", args);
+    }
+
+  data = (struct scm_objcode*)(addr + strlen (SCM_OBJCODE_COOKIE));
+
+  if (data->len + data->metalen != (st.st_size - sizeof (*data) - strlen (SCM_OBJCODE_COOKIE)))
+    {
+      (void) close (fd);
+      (void) munmap (addr, st.st_size);
+      scm_misc_error (FUNC_NAME, "bad length header (~a, ~a)",
+		      scm_list_2 (scm_from_size_t (st.st_size),
+				  scm_from_uint32 (sizeof (*data) + data->len
+						   + data->metalen)));
+    }
+
+  SCM_NEWSMOB3 (sret, scm_tc16_objcode, addr + strlen (SCM_OBJCODE_COOKIE),
+                SCM_PACK (SCM_BOOL_F), fd);
+  SCM_SET_SMOB_FLAGS (sret, SCM_F_OBJCODE_IS_MMAP);
+
+  /* FIXME: we leak ourselves and the file descriptor. but then again so does
+     dlopen(). */
+  return scm_permanent_object (sret);
+}
+#undef FUNC_NAME
+
+SCM
+scm_c_make_objcode_slice (SCM parent, const scm_t_uint8 *ptr)
+#define FUNC_NAME "make-objcode-slice"
+{
+  const struct scm_objcode *data, *parent_data;
+  SCM ret;
+
+  SCM_VALIDATE_OBJCODE (1, parent);
+  parent_data = SCM_OBJCODE_DATA (parent);
+  
+  if (ptr < parent_data->base
+      || ptr >= (parent_data->base + parent_data->len + parent_data->metalen
+                 - sizeof (struct scm_objcode)))
+    scm_misc_error (FUNC_NAME, "offset out of bounds (~a vs ~a + ~a + ~a)",
+		    scm_list_4 (scm_from_ulong ((unsigned long)ptr),
+				scm_from_ulong ((unsigned long)parent_data->base),
+				scm_from_uint32 (parent_data->len),
+				scm_from_uint32 (parent_data->metalen)));
+
+#ifdef __GNUC__ /* we need `__alignof__' */
+  /* Make sure bytecode for the objcode-meta is suitable aligned.  Failing to
+     do so leads to SIGBUS/SIGSEGV on some arches (e.g., SPARC).  */
+  assert ((((scm_t_bits) ptr) & (__alignof__ (struct scm_objcode) - 1UL)) == 0);
+#endif
+
+  data = (struct scm_objcode*)ptr;
+  if (data->base + data->len + data->metalen > parent_data->base + parent_data->len + parent_data->metalen)
+    abort ();
+
+  SCM_NEWSMOB2 (ret, scm_tc16_objcode, data, parent);
+  SCM_SET_SMOB_FLAGS (ret, SCM_F_OBJCODE_IS_SLICE);
+  return ret;
+}
+#undef FUNC_NAME
+
+
+/*
+ * Scheme interface
+ */
+
+SCM_DEFINE (scm_objcode_p, "objcode?", 1, 0, 0,
+	    (SCM obj),
+	    "")
+#define FUNC_NAME s_scm_objcode_p
+{
+  return SCM_BOOL (SCM_OBJCODE_P (obj));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_objcode_meta, "objcode-meta", 1, 0, 0,
+	    (SCM objcode),
+	    "")
+#define FUNC_NAME s_scm_objcode_meta
+{
+  SCM_VALIDATE_OBJCODE (1, objcode);
+
+  if (SCM_OBJCODE_META_LEN (objcode) == 0)
+    return SCM_BOOL_F;
+  else
+    return scm_c_make_objcode_slice (objcode, (SCM_OBJCODE_BASE (objcode)
+                                               + SCM_OBJCODE_LEN (objcode)));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytecode_to_objcode, "bytecode->objcode", 1, 0, 0,
+	    (SCM bytecode),
+	    "")
+#define FUNC_NAME s_scm_bytecode_to_objcode
+{
+  size_t size;
+  ssize_t increment;
+  scm_t_array_handle handle;
+  const scm_t_uint8 *c_bytecode;
+  struct scm_objcode *data;
+  SCM objcode;
+
+  if (scm_is_false (scm_u8vector_p (bytecode)))
+    scm_wrong_type_arg (FUNC_NAME, 1, bytecode);
+
+  c_bytecode = scm_u8vector_elements (bytecode, &handle, &size, &increment);
+  data = (struct scm_objcode*)c_bytecode;
+  SCM_NEWSMOB2 (objcode, scm_tc16_objcode, data, bytecode);
+  scm_array_handle_release (&handle);
+
+  SCM_ASSERT_RANGE (0, bytecode, size >= sizeof(struct scm_objcode));
+  if (data->len + data->metalen != (size - sizeof (*data)))
+    scm_misc_error (FUNC_NAME, "bad u8vector size (~a != ~a)",
+		    scm_list_2 (scm_from_size_t (size),
+				scm_from_uint32 (sizeof (*data) + data->len + data->metalen)));
+  assert (increment == 1);
+  SCM_SET_SMOB_FLAGS (objcode, SCM_F_OBJCODE_IS_U8VECTOR);
+  
+  /* foolishly, we assume that as long as bytecode is around, that c_bytecode
+     will be of the same length; perhaps a bad assumption? */
+
+  return objcode;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_load_objcode, "load-objcode", 1, 0, 0,
+	    (SCM file),
+	    "")
+#define FUNC_NAME s_scm_load_objcode
+{
+  int fd;
+  char *c_file;
+
+  SCM_VALIDATE_STRING (1, file);
+
+  c_file = scm_to_locale_string (file);
+  fd = open (c_file, O_RDONLY);
+  free (c_file);
+  if (fd < 0) SCM_SYSERROR;
+
+  return make_objcode_by_mmap (fd);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_objcode_to_bytecode, "objcode->bytecode", 1, 0, 0,
+	    (SCM objcode),
+	    "")
+#define FUNC_NAME s_scm_objcode_to_bytecode
+{
+  scm_t_uint8 *u8vector;
+  scm_t_uint32 len;
+
+  SCM_VALIDATE_OBJCODE (1, objcode);
+
+  len = sizeof(struct scm_objcode) + SCM_OBJCODE_TOTAL_LEN (objcode);
+
+  u8vector = scm_malloc (len);
+  memcpy (u8vector, SCM_OBJCODE_DATA (objcode), len);
+
+  return scm_take_u8vector (u8vector, len);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_write_objcode, "write-objcode", 2, 0, 0,
+	    (SCM objcode, SCM port),
+	    "")
+#define FUNC_NAME s_scm_write_objcode
+{
+  SCM_VALIDATE_OBJCODE (1, objcode);
+  SCM_VALIDATE_OUTPUT_PORT (2, port);
+  
+  scm_c_write (port, SCM_OBJCODE_COOKIE, strlen (SCM_OBJCODE_COOKIE));
+  scm_c_write (port, SCM_OBJCODE_DATA (objcode),
+               sizeof (struct scm_objcode) + SCM_OBJCODE_TOTAL_LEN (objcode));
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
+void
+scm_bootstrap_objcodes (void)
+{
+  scm_tc16_objcode = scm_make_smob_type ("objcode", 0);
+  scm_c_register_extension ("libguile", "scm_init_objcodes",
+                            (scm_t_extension_init_func)scm_init_objcodes, NULL);
+}
+
+/* Before, we used __BYTE_ORDER, but that is not defined on all
+   systems. So punt and use automake, PDP endianness be damned. */
+#ifdef WORDS_BIGENDIAN
+#define SCM_BYTE_ORDER 4321
+#else
+#define SCM_BYTE_ORDER 1234
+#endif
+
+void
+scm_init_objcodes (void)
+{
+  scm_bootstrap_vm ();
+
+#ifndef SCM_MAGIC_SNARFER
+#include "libguile/objcodes.x"
+#endif
+
+  scm_c_define ("word-size", scm_from_size_t (sizeof(SCM)));
+  scm_c_define ("byte-order", scm_from_uint16 (SCM_BYTE_ORDER));
+}
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/objcodes.h b/libguile/objcodes.h
new file mode 100644
index 000000000..2bb4e6040
--- /dev/null
+++ b/libguile/objcodes.h
@@ -0,0 +1,75 @@
+/* Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+#ifndef _SCM_OBJCODES_H_
+#define _SCM_OBJCODES_H_
+
+#include <libguile.h>
+
+/* objcode data should be directly mappable to this C structure. */
+struct scm_objcode {
+  scm_t_uint8 nargs;
+  scm_t_uint8 nrest;
+  scm_t_uint16 nlocs;
+  scm_t_uint32 len;             /* the maximum index of base[] */
+  scm_t_uint32 metalen;         /* well, i lie. this many bytes at the end of
+                                   base[] for metadata */
+  scm_t_uint32 unused;          /* pad so that `base' is 8-byte aligned */
+  scm_t_uint8 base[0];
+};
+
+#define SCM_F_OBJCODE_IS_MMAP     (1<<0)
+#define SCM_F_OBJCODE_IS_U8VECTOR (1<<1)
+#define SCM_F_OBJCODE_IS_SLICE    (1<<2)
+
+SCM_API scm_t_bits scm_tc16_objcode;
+
+#define SCM_OBJCODE_P(x)	(SCM_SMOB_PREDICATE (scm_tc16_objcode, x))
+#define SCM_OBJCODE_DATA(x)	((struct scm_objcode *) SCM_SMOB_DATA (x))
+#define SCM_VALIDATE_OBJCODE(p,x) SCM_MAKE_VALIDATE (p, x, OBJCODE_P)
+
+#define SCM_OBJCODE_LEN(x)	(SCM_OBJCODE_DATA (x)->len)
+#define SCM_OBJCODE_META_LEN(x)	(SCM_OBJCODE_DATA (x)->metalen)
+#define SCM_OBJCODE_TOTAL_LEN(x) (SCM_OBJCODE_LEN (x) + SCM_OBJCODE_META_LEN (x))
+#define SCM_OBJCODE_NARGS(x)	(SCM_OBJCODE_DATA (x)->nargs)
+#define SCM_OBJCODE_NREST(x)	(SCM_OBJCODE_DATA (x)->nrest)
+#define SCM_OBJCODE_NLOCS(x)	(SCM_OBJCODE_DATA (x)->nlocs)
+#define SCM_OBJCODE_BASE(x)	(SCM_OBJCODE_DATA (x)->base)
+
+#define SCM_OBJCODE_IS_MMAP(x)	(SCM_SMOB_FLAGS (x) & SCM_F_OBJCODE_IS_MMAP)
+#define SCM_OBJCODE_IS_U8VECTOR(x) (SCM_SMOB_FLAGS (x) & SCM_F_OBJCODE_IS_U8VECTOR)
+#define SCM_OBJCODE_IS_SLICE(x) (SCM_SMOB_FLAGS (x) & SCM_F_OBJCODE_IS_SLICE)
+
+SCM scm_c_make_objcode_slice (SCM parent, const scm_t_uint8 *ptr);
+SCM_API SCM scm_load_objcode (SCM file);
+SCM_API SCM scm_objcode_p (SCM obj);
+SCM_API SCM scm_objcode_meta (SCM objcode);
+SCM_API SCM scm_bytecode_to_objcode (SCM bytecode);
+SCM_API SCM scm_objcode_to_bytecode (SCM objcode);
+SCM_API SCM scm_write_objcode (SCM objcode, SCM port);
+
+SCM_INTERNAL void scm_bootstrap_objcodes (void);
+SCM_INTERNAL void scm_init_objcodes (void);
+
+#endif /* _SCM_OBJCODES_H_ */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/objects.c b/libguile/objects.c
index 0b2c3be74..f686c3a00 100644
--- a/libguile/objects.c
+++ b/libguile/objects.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1995,1996,1999,2000,2001, 2003, 2004, 2006, 2008 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -39,6 +40,8 @@
 #include "libguile/ports.h"
 #include "libguile/strings.h"
 #include "libguile/vectors.h"
+#include "libguile/programs.h"
+#include "libguile/vm.h"
 
 #include "libguile/validate.h"
 #include "libguile/objects.h"
@@ -138,8 +141,9 @@ scm_mcache_lookup_cmethod (SCM cache, SCM args)
 	    z = SCM_CDR (z);
 	  }
 	while (j-- && !scm_is_null (ls));
-      /* Fewer arguments than specifiers => CAR != ENV */
-      if (scm_is_null (SCM_CAR (z)) || scm_is_pair (SCM_CAR (z)))
+      /* Fewer arguments than specifiers => CAR != CLASS or `no-method' */
+      if (!scm_is_pair (z)
+          || (!SCM_CLASSP (SCM_CAR (z)) && !scm_is_symbol (SCM_CAR (z))))
 	return z;
     next_method:
       i = (i + 1) & mask;
@@ -161,10 +165,15 @@ SCM
 scm_apply_generic (SCM gf, SCM args)
 {
   SCM cmethod = scm_mcache_compute_cmethod (SCM_ENTITY_PROCEDURE (gf), args);
-  return scm_eval_body (SCM_CDR (SCM_CMETHOD_CODE (cmethod)),
-			SCM_EXTEND_ENV (SCM_CAR (SCM_CMETHOD_CODE (cmethod)),
-					args,
-					SCM_CMETHOD_ENV (cmethod)));
+  if (SCM_PROGRAM_P (cmethod))
+    return scm_vm_apply (scm_the_vm (), cmethod, args);
+  else if (scm_is_pair (cmethod))
+    return scm_eval_body (SCM_CDR (SCM_CMETHOD_CODE (cmethod)),
+                          SCM_EXTEND_ENV (SCM_CAR (SCM_CMETHOD_CODE (cmethod)),
+                                          args,
+                                          SCM_CMETHOD_ENV (cmethod)));
+  else
+    return scm_apply (cmethod, args, SCM_EOL);
 }
 
 SCM
diff --git a/libguile/objects.h b/libguile/objects.h
index 9b2a0ed5a..914a7ea74 100644
--- a/libguile/objects.h
+++ b/libguile/objects.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1996,1999,2000,2001, 2003, 2006, 2008, 2009 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/objprop.c b/libguile/objprop.c
index 8e9486f54..6dd1da631 100644
--- a/libguile/objprop.c
+++ b/libguile/objprop.c
@@ -1,18 +1,19 @@
 /*	Copyright (C) 1995,1996, 2000, 2001, 2003, 2006, 2008 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/objprop.h b/libguile/objprop.h
index 7e5365a74..f9a2e945d 100644
--- a/libguile/objprop.h
+++ b/libguile/objprop.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,2000,2001, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/options.c b/libguile/options.c
index cc3d452e6..ee7001a8c 100644
--- a/libguile/options.c
+++ b/libguile/options.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1995,1996,1998,2000,2001, 2006, 2008 Free Software Foundation
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/options.h b/libguile/options.h
index 4facdce01..8ea960b3c 100644
--- a/libguile/options.h
+++ b/libguile/options.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,2000,2001, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/pairs.c b/libguile/pairs.c
index cb2d64260..aaaeb110f 100644
--- a/libguile/pairs.c
+++ b/libguile/pairs.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1995,1996,2000,2001, 2004, 2005, 2006, 2008 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/pairs.h b/libguile/pairs.h
index 61af24efe..a6d44d289 100644
--- a/libguile/pairs.h
+++ b/libguile/pairs.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,2000,2001, 2004, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/ports.c b/libguile/ports.c
index 454b51085..e3d2b0da6 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -29,6 +30,9 @@
 #include <errno.h>
 #include <fcntl.h>  /* for chsize on mingw */
 #include <assert.h>
+#include <uniconv.h>
+#include <unistr.h>
+#include <striconveh.h>
 
 #include <assert.h>
 
@@ -52,6 +56,7 @@
 #include "libguile/vectors.h"
 #include "libguile/weaks.h"
 #include "libguile/fluids.h"
+#include "libguile/eq.h"
 
 #ifdef HAVE_STRING_H
 #include <string.h>
@@ -221,15 +226,14 @@ scm_set_port_close (scm_t_bits tc, int (*close) (SCM))
 }
 
 void
-scm_set_port_seek (scm_t_bits tc, off_t (*seek) (SCM port,
-					   off_t OFFSET,
-					   int WHENCE))
+scm_set_port_seek (scm_t_bits tc,
+		   scm_t_off (*seek) (SCM, scm_t_off, int))
 {
   scm_ptobs[SCM_TC2PTOBNUM (tc)].seek = seek;
 }
 
 void
-scm_set_port_truncate (scm_t_bits tc, void (*truncate) (SCM port, off_t length))
+scm_set_port_truncate (scm_t_bits tc, void (*truncate) (SCM, scm_t_off))
 {
   scm_ptobs[SCM_TC2PTOBNUM (tc)].truncate = truncate;
 }
@@ -358,10 +362,10 @@ SCM_DEFINE (scm_drain_input, "drain-input", 1, 0, 0,
 
 /* Standard ports --- current input, output, error, and more(!).  */
 
-static SCM cur_inport_fluid;
-static SCM cur_outport_fluid;
-static SCM cur_errport_fluid;
-static SCM cur_loadport_fluid;
+static SCM cur_inport_fluid = 0;
+static SCM cur_outport_fluid = 0;
+static SCM cur_errport_fluid = 0;
+static SCM cur_loadport_fluid = 0;
 
 SCM_DEFINE (scm_current_input_port, "current-input-port", 0, 0, 0,
 	    (),
@@ -370,7 +374,10 @@ SCM_DEFINE (scm_current_input_port, "current-input-port", 0, 0, 0,
 	    "returns the @dfn{standard input} in Unix and C terminology.")
 #define FUNC_NAME s_scm_current_input_port
 {
-  return scm_fluid_ref (cur_inport_fluid);
+  if (cur_inport_fluid)
+    return scm_fluid_ref (cur_inport_fluid);
+  else
+    return SCM_BOOL_F;
 }
 #undef FUNC_NAME
 
@@ -382,7 +389,10 @@ SCM_DEFINE (scm_current_output_port, "current-output-port", 0, 0, 0,
 	    "Unix and C terminology.")
 #define FUNC_NAME s_scm_current_output_port
 {
-  return scm_fluid_ref (cur_outport_fluid);
+  if (cur_outport_fluid)
+    return scm_fluid_ref (cur_outport_fluid);
+  else
+    return SCM_BOOL_F;
 }
 #undef FUNC_NAME
 
@@ -392,7 +402,10 @@ SCM_DEFINE (scm_current_error_port, "current-error-port", 0, 0, 0,
 	    "@dfn{standard error} in Unix and C terminology).")
 #define FUNC_NAME s_scm_current_error_port
 {
-  return scm_fluid_ref (cur_errport_fluid);
+  if (cur_errport_fluid)
+    return scm_fluid_ref (cur_errport_fluid);
+  else
+    return SCM_BOOL_F;
 }
 #undef FUNC_NAME
 
@@ -570,10 +583,18 @@ scm_new_port_table_entry (scm_t_bits tag)
   
   SCM z = scm_cons (SCM_EOL, SCM_EOL);
   scm_t_port *entry = (scm_t_port *) scm_gc_calloc (sizeof (scm_t_port), "port");
+  const char *enc;
 
   entry->file_name = SCM_BOOL_F;
   entry->rw_active = SCM_PORT_NEITHER;
   entry->port = z;
+  /* Initialize this port with the thread's current default
+     encoding.  */
+  if ((enc = scm_i_get_port_encoding (SCM_BOOL_F)) == NULL)
+    entry->encoding = NULL;
+  else
+    entry->encoding = strdup (enc);
+  entry->ilseq_handler = scm_i_get_conversion_strategy (SCM_BOOL_F);
 
   SCM_SET_CELL_TYPE (z, tag);
   SCM_SETPTAB_ENTRY (z, entry);
@@ -614,6 +635,11 @@ scm_i_remove_port (SCM port)
   scm_t_port *p = SCM_PTAB_ENTRY (port);
   if (p->putback_buf)
     scm_gc_free (p->putback_buf, p->putback_buf_size, "putback buffer");
+  if (p->encoding)
+    {
+      free (p->encoding);
+      p->encoding = NULL;
+    }
   scm_gc_free (p, sizeof (scm_t_port), "port");
 
   SCM_SETPTAB_ENTRY (port, 0);
@@ -697,21 +723,22 @@ SCM_DEFINE (scm_set_port_revealed_x, "set-port-revealed!", 2, 0, 0,
  */
 
 static long
-scm_i_mode_bits_n (const char *modes, size_t n)
+scm_i_mode_bits_n (SCM modes)
 {
   return (SCM_OPN
-	  | (memchr (modes, 'r', n) || memchr (modes, '+', n) ? SCM_RDNG : 0)
-	  | (   memchr (modes, 'w', n)
-	     || memchr (modes, 'a', n)
-	     || memchr (modes, '+', n) ? SCM_WRTNG : 0)
-	  | (memchr (modes, '0', n) ? SCM_BUF0 : 0)
-	  | (memchr (modes, 'l', n) ? SCM_BUFLINE : 0));
+	  | (scm_i_string_contains_char (modes, 'r') 
+	     || scm_i_string_contains_char (modes, '+') ? SCM_RDNG : 0)
+	  | (scm_i_string_contains_char (modes, 'w')
+	     || scm_i_string_contains_char (modes, 'a')
+	     || scm_i_string_contains_char (modes, '+') ? SCM_WRTNG : 0)
+	  | (scm_i_string_contains_char (modes, '0') ? SCM_BUF0 : 0)
+	  | (scm_i_string_contains_char (modes, 'l') ? SCM_BUFLINE : 0));
 }
 
 long
 scm_mode_bits (char *modes)
 {
-  return scm_i_mode_bits_n (modes, strlen (modes));
+  return scm_i_mode_bits (scm_from_locale_string (modes));
 }
 
 long
@@ -722,8 +749,7 @@ scm_i_mode_bits (SCM modes)
   if (!scm_is_string (modes))
     scm_wrong_type_arg_msg (NULL, 0, modes, "string");
 
-  bits = scm_i_mode_bits_n (scm_i_string_chars (modes),
-			    scm_i_string_length (modes));
+  bits = scm_i_mode_bits_n (modes);
   scm_remember_upto_here_1 (modes);
   return bits;
 }
@@ -994,7 +1020,7 @@ SCM_DEFINE (scm_read_char, "read-char", 0, 1, 0,
 	    "characters are available, the end-of-file object is returned.")
 #define FUNC_NAME s_scm_read_char
 {
-  int c;
+  scm_t_wchar c;
   if (SCM_UNBNDP (port))
     port = scm_current_input_port ();
   SCM_VALIDATE_OPINPORT (1, port);
@@ -1005,6 +1031,133 @@ SCM_DEFINE (scm_read_char, "read-char", 0, 1, 0,
 }
 #undef FUNC_NAME
 
+#define SCM_MBCHAR_BUF_SIZE (4)
+
+/* Get one codepoint from a file, using the port's encoding.  */
+scm_t_wchar
+scm_getc (SCM port)
+{
+  int c;
+  unsigned int bufcount = 0;
+  char buf[SCM_MBCHAR_BUF_SIZE];
+  scm_t_wchar codepoint = 0;
+  scm_t_uint32 *u32;
+  size_t u32len;
+  scm_t_port *pt = SCM_PTAB_ENTRY (port);
+
+  c = scm_get_byte_or_eof (port);
+  if (c == EOF)
+    return (scm_t_wchar) EOF;
+
+  buf[0] = c;
+  bufcount++;
+
+  if (pt->encoding == NULL)
+    { 
+      /* The encoding is Latin-1: bytes are characters.  */
+      codepoint = (unsigned char) buf[0];
+      goto success;
+    }
+
+  for (;;)
+    {
+      u32 = u32_conv_from_encoding (pt->encoding, 
+                                    (enum iconv_ilseq_handler) pt->ilseq_handler, 
+				    buf, bufcount, NULL, NULL, &u32len);
+      if (u32 == NULL || u32len == 0)
+	{
+	  if (errno == ENOMEM)
+	    scm_memory_error ("Input decoding");
+          
+	  /* Otherwise errno is EILSEQ or EINVAL, so perhaps more
+             bytes are needed.  Keep looping.  */
+	}
+      else 
+	{
+	  /* Complete codepoint found. */
+	  codepoint = u32[0];
+	  free (u32);
+	  goto success;
+	}
+
+      if (bufcount == SCM_MBCHAR_BUF_SIZE)
+	{
+	  /* We've read several bytes and didn't find a good
+	     codepoint.  Give up.  */
+	  goto failure;
+	}
+
+      c = scm_get_byte_or_eof (port);
+
+      if (c == EOF)
+	{
+	  /* EOF before a complete character was read.  Push it all
+	     back and return EOF. */
+	  while (bufcount > 0)
+	    {
+	      /* FIXME: this will probably cause errors in the port column. */
+	      scm_unget_byte (buf[bufcount-1], port);
+	      bufcount --;
+	    }
+          return EOF;
+	}
+      
+      if (c == '\n')
+	{
+          /* It is always invalid to have EOL in the middle of a
+             multibyte character.  */
+	  scm_unget_byte ('\n', port);
+	  goto failure;
+	}
+	
+      buf[bufcount++] = c;
+    }
+
+ success:
+  switch (codepoint)
+    {
+    case '\a':
+      break;
+    case '\b':
+      SCM_DECCOL (port);
+      break;
+    case '\n':
+      SCM_INCLINE (port);
+        break;
+    case '\r':
+      SCM_ZEROCOL (port);
+      break;
+    case '\t':
+      SCM_TABCOL (port);
+      break;
+    default:
+      SCM_INCCOL (port);
+      break;
+    }
+
+  return codepoint;
+
+ failure:
+  {
+    char *err_buf;
+    SCM err_str = scm_i_make_string (bufcount, &err_buf);
+    memcpy (err_buf, buf, bufcount);
+
+    if (errno == EILSEQ)
+      scm_misc_error (NULL, "input encoding error for ~s: ~s",
+		      scm_list_2 (scm_from_locale_string (scm_i_get_port_encoding (port)),
+				  err_str));
+    else
+      scm_misc_error (NULL, "input encoding error (invalid) for ~s: ~s\n", 
+		      scm_list_2 (scm_from_locale_string (scm_i_get_port_encoding (port)),
+				  err_str));
+  }
+
+  /* Never gets here.  */
+  return 0;
+}
+
+
 /* this should only be called when the read buffer is empty.  it
    tries to refill the read buffer.  it returns the first char from
    the port, which is either EOF or *(pt->read_pos).  */
@@ -1034,7 +1187,24 @@ scm_fill_input (SCM port)
  * This function differs from scm_c_write; it updates port line and
  * column. */
 
-void 
+static void
+update_port_lf (scm_t_wchar c, SCM port)
+{
+  if (c == '\a')
+    ;                           /* Do nothing. */
+  else if (c == '\b')
+    SCM_DECCOL (port);
+  else if (c == '\n')
+    SCM_INCLINE (port);
+  else if (c == '\r')
+    SCM_ZEROCOL (port);
+  else if (c == '\t')
+    SCM_TABCOL (port);
+  else
+    SCM_INCCOL (port);
+}
+
+void
 scm_lfwrite (const char *ptr, size_t size, SCM port)
 {
   scm_t_port *pt = SCM_PTAB_ENTRY (port);
@@ -1045,25 +1215,74 @@ scm_lfwrite (const char *ptr, size_t size, SCM port)
 
   ptob->write (port, ptr, size);
 
-  for (; size; ptr++, size--) {
-    if (*ptr == '\a') {
-    }
-    else if (*ptr == '\b') {
-      SCM_DECCOL(port);
-    }
-    else if (*ptr == '\n') {
-      SCM_INCLINE(port);
-    }
-    else if (*ptr == '\r') {
-      SCM_ZEROCOL(port);
-    }
-    else if (*ptr == '\t') {
-      SCM_TABCOL(port);
+  for (; size; ptr++, size--)
+    update_port_lf ((scm_t_wchar) (unsigned char) *ptr, port);
+
+  if (pt->rw_random)
+    pt->rw_active = SCM_PORT_WRITE;
+}
+
+/* Write a scheme string STR to PORT from START inclusive to END
+   exclusive.  */
+void
+scm_lfwrite_substr (SCM str, size_t start, size_t end, SCM port)
+{
+  size_t i, size = scm_i_string_length (str);
+  scm_t_port *pt = SCM_PTAB_ENTRY (port);
+  scm_t_ptob_descriptor *ptob = &scm_ptobs[SCM_PTOBNUM (port)];
+  scm_t_wchar p;
+  char *buf;
+  size_t len;
+
+  if (pt->rw_active == SCM_PORT_READ)
+    scm_end_input (port);
+
+  if (end == (size_t) (-1))
+    end = size;
+  size = end - start;
+
+  /* Note that making a substring will likely take the
+     stringbuf_write_mutex.  So, one shouldn't use scm_lfwrite_substr
+     if the stringbuf write mutex may still be held elsewhere.  */
+  buf = scm_to_stringn (scm_c_substring (str, start, end), &len,
+			pt->encoding, pt->ilseq_handler);
+  ptob->write (port, buf, len);
+  free (buf);
+
+  for (i = 0; i < size; i++)
+    {
+      p = scm_i_string_ref (str, i + start);
+      update_port_lf (p, port);
     }
-    else {
-      SCM_INCCOL(port);
+
+  if (pt->rw_random)
+    pt->rw_active = SCM_PORT_WRITE;
+}
+
+/* Write a scheme string STR to PORT.  */
+void
+scm_lfwrite_str (SCM str, SCM port)
+{
+  size_t i, size = scm_i_string_length (str);
+  scm_t_port *pt = SCM_PTAB_ENTRY (port);
+  scm_t_ptob_descriptor *ptob = &scm_ptobs[SCM_PTOBNUM (port)];
+  scm_t_wchar p;
+  char *buf;
+  size_t len;
+
+  if (pt->rw_active == SCM_PORT_READ)
+    scm_end_input (port);
+
+  buf = scm_to_stringn (str, &len,
+			pt->encoding, pt->ilseq_handler);
+  ptob->write (port, buf, len);
+  free (buf);
+
+  for (i = 0; i < size; i++)
+    {
+      p = scm_i_string_ref (str, i);
+      update_port_lf (p, port);
     }
-  }
 
   if (pt->rw_random)
     pt->rw_active = SCM_PORT_WRITE;
@@ -1257,8 +1476,8 @@ scm_end_input (SCM port)
 
 
 void 
-scm_ungetc (int c, SCM port)
-#define FUNC_NAME "scm_ungetc"
+scm_unget_byte (int c, SCM port)
+#define FUNC_NAME "scm_unget_byte"
 {
   scm_t_port *pt = SCM_PTAB_ENTRY (port);
 
@@ -1319,6 +1538,25 @@ scm_ungetc (int c, SCM port)
 
   if (pt->rw_random)
     pt->rw_active = SCM_PORT_READ;
+}
+#undef FUNC_NAME
+
+void 
+scm_ungetc (scm_t_wchar c, SCM port)
+#define FUNC_NAME "scm_ungetc"
+{
+  scm_t_port *pt = SCM_PTAB_ENTRY (port);
+  scm_t_wchar *wbuf;
+  SCM str = scm_i_make_wide_string (1, &wbuf);
+  char *buf;
+  size_t len;
+  int i;
+
+  wbuf[0] = c;
+  buf = scm_to_stringn (str, &len, pt->encoding, pt->ilseq_handler);
+    
+  for (i = len - 1; i >= 0; i--)
+    scm_unget_byte (buf[i], port);
 
   if (c == '\n')
     {
@@ -1365,7 +1603,7 @@ SCM_DEFINE (scm_peek_char, "peek-char", 0, 1, 0,
 	    "to @code{read-char} would have hung.")
 #define FUNC_NAME s_scm_peek_char
 {
-  int c, column;
+  scm_t_wchar c, column;
   if (SCM_UNBNDP (port))
     port = scm_current_input_port ();
   else
@@ -1411,13 +1649,17 @@ SCM_DEFINE (scm_unread_string, "unread-string", 2, 0, 0,
 	    "@var{port} is not supplied, the current-input-port is used.")
 #define FUNC_NAME s_scm_unread_string
 {
+  int n;
   SCM_VALIDATE_STRING (1, str);
   if (SCM_UNBNDP (port))
     port = scm_current_input_port ();
   else
     SCM_VALIDATE_OPINPORT (2, port);
 
-  scm_ungets (scm_i_string_chars (str), scm_i_string_length (str), port);
+  n = scm_i_string_length (str);
+
+  while (n--)
+    scm_ungetc (scm_i_string_ref (str, n), port);
   
   return str;
 }
@@ -1458,23 +1700,18 @@ SCM_DEFINE (scm_seek, "seek", 3, 0, 0,
   if (how != SEEK_SET && how != SEEK_CUR && how != SEEK_END)
     SCM_OUT_OF_RANGE (3, whence);
 
-  if (SCM_OPFPORTP (fd_port))
-    {
-      /* go direct to fport code to allow 64-bit offsets */
-      return scm_i_fport_seek (fd_port, offset, how);
-    }
-  else if (SCM_OPPORTP (fd_port))
+  if (SCM_OPPORTP (fd_port))
     {
       scm_t_ptob_descriptor *ptob = scm_ptobs + SCM_PTOBNUM (fd_port);
-      off_t off = scm_to_off_t (offset);
-      off_t rv;
+      off_t_or_off64_t off = scm_to_off_t_or_off64_t (offset);
+      off_t_or_off64_t rv;
 
       if (!ptob->seek)
 	SCM_MISC_ERROR ("port is not seekable", 
                         scm_cons (fd_port, SCM_EOL));
       else
 	rv = ptob->seek (fd_port, off, how);
-      return scm_from_off_t (rv);
+      return scm_from_off_t_or_off64_t (rv);
     }
   else /* file descriptor?.  */
     {
@@ -1556,14 +1793,9 @@ SCM_DEFINE (scm_truncate_file, "truncate-file", 1, 1, 0,
       SCM_SYSCALL (rv = ftruncate_or_ftruncate64 (scm_to_int (object),
                                                   c_length));
     }
-  else if (SCM_OPOUTFPORTP (object))
-    {
-      /* go direct to fport code to allow 64-bit offsets */
-      rv = scm_i_fport_truncate (object, length);
-    }
   else if (SCM_OPOUTPORTP (object))
     {
-      off_t c_length = scm_to_off_t (length);
+      off_t_or_off64_t c_length = scm_to_off_t_or_off64_t (length);
       scm_t_port *pt = SCM_PTAB_ENTRY (object);
       scm_t_ptob_descriptor *ptob = scm_ptobs + SCM_PTOBNUM (object);
       
@@ -1682,6 +1914,328 @@ SCM_DEFINE (scm_set_port_filename_x, "set-port-filename!", 2, 0, 0,
 }
 #undef FUNC_NAME
 
+/* The default port encoding for this locale. New ports will have this
+   encoding.  If it is a string, that is the encoding.  If it #f, it
+   is in the native (Latin-1) encoding.  */
+SCM_GLOBAL_VARIABLE (scm_port_encoding_var, "%port-encoding");
+static int scm_port_encoding_init = 0;
+
+/* Return a C string representation of the current encoding.  */
+const char *
+scm_i_get_port_encoding (SCM port)
+{
+  SCM encoding;
+  
+  if (scm_is_false (port))
+    {
+      if (!scm_port_encoding_init)
+	return NULL;
+      else if (!scm_is_fluid (SCM_VARIABLE_REF (scm_port_encoding_var)))
+	return NULL;
+      else
+	{
+	  encoding = scm_fluid_ref (SCM_VARIABLE_REF (scm_port_encoding_var));
+	  if (!scm_is_string (encoding))
+	    return NULL;
+	  else
+	    return scm_i_string_chars (encoding);
+	}
+    }
+  else
+    {
+      scm_t_port *pt;
+      pt = SCM_PTAB_ENTRY (port);
+      if (pt->encoding)
+	return pt->encoding;
+      else
+	return NULL;
+    }
+}
+
+/* Returns ENC is if is a recognized encoding.  If it isn't, it tries
+   to find an alias of ENC that is valid.  Otherwise, it returns
+   NULL.  */
+static const char *
+find_valid_encoding (const char *enc)
+{
+  int isvalid = 0;
+  const char str[] = " ";
+  scm_t_uint32 *u32;
+  size_t u32len;
+    
+  u32 = u32_conv_from_encoding (enc, iconveh_error, str, 1,
+                                NULL, NULL, &u32len);
+  isvalid = (u32 != NULL);
+  free (u32);
+    
+  if (isvalid)
+    return enc;
+
+  return NULL;
+}
+
+void
+scm_i_set_port_encoding_x (SCM port, const char *enc)
+{
+  const char *valid_enc;
+  scm_t_port *pt;
+
+  /* Null is shorthand for the native, Latin-1 encoding.  */
+  if (enc == NULL)
+    valid_enc = NULL;
+  else
+    {
+      valid_enc = find_valid_encoding (enc);
+      if (valid_enc == NULL)
+        {
+          SCM err;
+          err = scm_from_locale_string (enc);
+          scm_misc_error (NULL, "invalid or unknown character encoding ~s",
+                          scm_list_1 (err));
+        }
+    }
+
+  if (scm_is_false (port))
+    {
+      /* Set the default encoding for future ports.  */
+      if (!scm_port_encoding_init
+	  || !scm_is_fluid (SCM_VARIABLE_REF (scm_port_encoding_var)))
+	scm_misc_error (NULL, "tried to set port encoding fluid before it is initialized",
+                       SCM_EOL);
+
+      if (valid_enc == NULL 
+          || !strcmp (valid_enc, "ASCII")
+          || !strcmp (valid_enc, "ANSI_X3.4-1968")
+          || !strcmp (valid_enc, "ISO-8859-1"))
+        scm_fluid_set_x (SCM_VARIABLE_REF (scm_port_encoding_var), SCM_BOOL_F);
+      else
+        scm_fluid_set_x (SCM_VARIABLE_REF (scm_port_encoding_var), 
+                         scm_from_locale_string (valid_enc));
+    }
+  else
+    {
+      /* Set the character encoding for this port.  */
+      pt = SCM_PTAB_ENTRY (port);
+      if (pt->encoding)
+	free (pt->encoding);
+      if (valid_enc == NULL)
+        pt->encoding = NULL;
+      else
+        pt->encoding = strdup (valid_enc);
+    }
+}
+
+SCM_DEFINE (scm_port_encoding, "port-encoding", 1, 0, 0,
+	    (SCM port),
+	    "Returns, as a string, the character encoding that @var{port}\n"
+	    "uses to interpret its input and output.\n")
+#define FUNC_NAME s_scm_port_encoding
+{
+  scm_t_port *pt;
+  const char *enc;
+
+  SCM_VALIDATE_PORT (1, port);
+
+  pt = SCM_PTAB_ENTRY (port);
+  enc = scm_i_get_port_encoding (port);
+  if (enc)
+    return scm_from_locale_string (pt->encoding);
+  else
+    return scm_from_locale_string ("NONE");
+}
+#undef FUNC_NAME
+  
+SCM_DEFINE (scm_set_port_encoding_x, "set-port-encoding!", 2, 0, 0,
+	    (SCM port, SCM enc),
+	    "Sets the character encoding that will be used to interpret all\n"
+	    "port I/O.  New ports are created with the encoding\n"
+	    "appropriate for the current locale if @code{setlocale} has \n"
+	    "been called or ISO-8859-1 otherwise\n"
+	    "and this procedure can be used to modify that encoding.\n")
+
+#define FUNC_NAME s_scm_set_port_encoding_x
+{
+  char *enc_str;
+  const char *valid_enc_str;
+
+  SCM_VALIDATE_PORT (1, port);
+  SCM_VALIDATE_STRING (2, enc);
+
+  enc_str = scm_to_locale_string (enc);
+  valid_enc_str = find_valid_encoding (enc_str);
+  if (valid_enc_str == NULL)
+    {
+      free (enc_str);
+      scm_misc_error (FUNC_NAME, "invalid or unknown character encoding ~s",
+		      scm_list_1 (enc));
+    }
+  else
+    {
+      scm_i_set_port_encoding_x (port, valid_enc_str);
+      free (enc_str);
+    }
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
+/* This determines how conversions handle unconvertible characters.  */
+SCM_GLOBAL_VARIABLE (scm_conversion_strategy, "%port-conversion-strategy");
+static int scm_conversion_strategy_init = 0;
+
+scm_t_string_failed_conversion_handler
+scm_i_get_conversion_strategy (SCM port)
+{
+  SCM encoding;
+  
+  if (scm_is_false (port))
+    {
+      if (!scm_conversion_strategy_init
+	  || !scm_is_fluid (SCM_VARIABLE_REF (scm_conversion_strategy)))
+	return SCM_FAILED_CONVERSION_QUESTION_MARK;
+      else
+	{
+	  encoding = scm_fluid_ref (SCM_VARIABLE_REF (scm_conversion_strategy));
+	  if (scm_is_false (encoding))
+	    return SCM_FAILED_CONVERSION_QUESTION_MARK;
+	  else 
+	    return (scm_t_string_failed_conversion_handler) scm_to_int (encoding);
+	}
+    }
+  else
+    {
+      scm_t_port *pt;
+      pt = SCM_PTAB_ENTRY (port);
+	return pt->ilseq_handler;
+    }
+      
+}
+
+void
+scm_i_set_conversion_strategy_x (SCM port, 
+				 scm_t_string_failed_conversion_handler handler)
+{
+  SCM strategy;
+  scm_t_port *pt;
+  
+  strategy = scm_from_int ((int) handler);
+  
+  if (scm_is_false (port))
+    {
+      /* Set the default encoding for future ports.  */
+      if (!scm_conversion_strategy
+	  || !scm_is_fluid (SCM_VARIABLE_REF (scm_conversion_strategy)))
+	scm_misc_error (NULL, "tried to set conversion strategy fluid before it is initialized",
+                       SCM_EOL);
+      scm_fluid_set_x (SCM_VARIABLE_REF (scm_conversion_strategy), strategy);
+    }
+  else
+    {
+      /* Set the character encoding for this port.  */
+      pt = SCM_PTAB_ENTRY (port);
+      pt->ilseq_handler = handler;
+    }
+}
+
+SCM_DEFINE (scm_port_conversion_strategy, "port-conversion-strategy",
+	    1, 0, 0, (SCM port),
+	    "Returns the behavior of the port when handling a character that\n"
+	    "is not representable in the port's current encoding.\n"
+	    "It returns the symbol @code{error} if unrepresentable characters\n"
+	    "should cause exceptions, @code{substitute} if the port should\n"
+	    "try to replace unrepresentable characters with question marks or\n"
+	    "approximate characters, or @code{escape} if unrepresentable\n"
+	    "characters should be converted to string escapes.\n"
+	    "\n"
+	    "If @var{port} is @code{#f}, then the current default behavior\n"
+	    "will be returned.  New ports will have this default behavior\n"
+	    "when they are created.\n")
+#define FUNC_NAME s_scm_port_conversion_strategy
+{
+  scm_t_string_failed_conversion_handler h;
+
+  SCM_VALIDATE_OPPORT (1, port);
+
+  if (!scm_is_false (port))
+    {
+      SCM_VALIDATE_OPPORT (1, port);
+    }
+
+  h = scm_i_get_conversion_strategy (port);
+  if (h == SCM_FAILED_CONVERSION_ERROR)
+    return scm_from_locale_symbol ("error");
+  else if (h == SCM_FAILED_CONVERSION_QUESTION_MARK)
+    return scm_from_locale_symbol ("substitute");
+  else if (h == SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE)
+    return scm_from_locale_symbol ("escape");
+  else
+    abort ();
+
+  /* Never gets here. */
+  return SCM_UNDEFINED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_set_port_conversion_strategy_x, "set-port-conversion-strategy!",
+	    2, 0, 0, 
+	    (SCM port, SCM sym),
+	    "Sets the behavior of the interpreter when outputting a character\n"
+	    "that is not representable in the port's current encoding.\n"
+	    "@var{sym} can be either @code{'error}, @code{'substitute}, or\n"
+	    "@code{'escape}.  If it is @code{'error}, an error will be thrown\n"
+	    "when an unconvertible character is encountered.  If it is\n"
+	    "@code{'substitute}, then unconvertible characters will \n"
+	    "be replaced with approximate characters, or with question marks\n"
+	    "if no approximately correct character is available.\n"
+	    "If it is @code{'escape},\n"
+	    "it will appear as a hex escape when output.\n"
+	    "\n"
+	    "If @var{port} is an open port, the conversion error behavior\n"
+	    "is set for that port.  If it is @code{#f}, it is set as the\n"
+	    "default behavior for any future ports that get created in\n"
+	    "this thread.\n")
+#define FUNC_NAME s_scm_set_port_conversion_strategy_x
+{
+  SCM err;
+  SCM qm;
+  SCM esc;
+
+  if (!scm_is_false (port))
+    {
+      SCM_VALIDATE_OPPORT (1, port);
+    }
+
+  err = scm_from_locale_symbol ("error");
+  if (scm_is_true (scm_eqv_p (sym, err)))
+    {
+      scm_i_set_conversion_strategy_x (port, SCM_FAILED_CONVERSION_ERROR);
+      return SCM_UNSPECIFIED;
+    }
+
+  qm = scm_from_locale_symbol ("substitute");
+  if (scm_is_true (scm_eqv_p (sym, qm)))
+    {
+      scm_i_set_conversion_strategy_x (port, 
+                                       SCM_FAILED_CONVERSION_QUESTION_MARK);
+      return SCM_UNSPECIFIED;
+    }
+
+  esc = scm_from_locale_symbol ("escape");
+  if (scm_is_true (scm_eqv_p (sym, esc)))
+    {
+      scm_i_set_conversion_strategy_x (port,
+                                       SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE);
+      return SCM_UNSPECIFIED;
+    }
+
+  SCM_MISC_ERROR ("unknown conversion behavior ~s", scm_list_1 (sym));
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
+
 void
 scm_print_port_mode (SCM exp, SCM port)
 {
@@ -1792,8 +2346,17 @@ scm_init_ports ()
   cur_loadport_fluid = scm_permanent_object (scm_make_fluid ());
 
   scm_i_port_weak_hash = scm_permanent_object (scm_make_weak_key_hash_table (SCM_I_MAKINUM(31)));
-  
 #include "libguile/ports.x"
+
+  SCM_VARIABLE_SET (scm_port_encoding_var, scm_make_fluid ());
+  scm_fluid_set_x (SCM_VARIABLE_REF (scm_port_encoding_var), SCM_BOOL_F);
+  scm_port_encoding_init = 1;
+  
+  SCM_VARIABLE_SET (scm_conversion_strategy, scm_make_fluid ());
+  scm_fluid_set_x (SCM_VARIABLE_REF (scm_conversion_strategy), 
+		   scm_from_int ((int) SCM_FAILED_CONVERSION_QUESTION_MARK));
+  scm_conversion_strategy_init = 1;
+  
 }
 
 /*
diff --git a/libguile/ports.h b/libguile/ports.h
index 5e42a3468..0f46e7f51 100644
--- a/libguile/ports.h
+++ b/libguile/ports.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2008, 2009 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -27,9 +28,7 @@
 #include "libguile/print.h"
 #include "libguile/struct.h"
 #include "libguile/threads.h"
-
-/* Not sure if this is a good idea.  We need it for off_t.  */
-#include <sys/types.h>
+#include "libguile/strings.h"
 
 
 
@@ -57,6 +56,10 @@ typedef struct
   long line_number;		/* debugging support.  */
   int column_number;		/* debugging support.  */
 
+  /* Character encoding support  */
+  char *encoding;
+  scm_t_string_failed_conversion_handler ilseq_handler;
+
   /* port buffers.  the buffer(s) are set up for all ports.  
      in the case of string ports, the buffer is the string itself.
      in the case of unbuffered file ports, the buffer is a
@@ -69,7 +72,7 @@ typedef struct
   unsigned char *read_buf;	/* buffer start.  */
   const unsigned char *read_pos;/* the next unread char.  */
   unsigned char *read_end;      /* pointer to last buffered char + 1.  */
-  off_t read_buf_size;		/* size of the buffer.  */
+  scm_t_off read_buf_size;		/* size of the buffer.  */
 
   /* when chars are put back into the buffer, e.g., using peek-char or
      unread-string, the read-buffer pointers are switched to cbuf.
@@ -78,7 +81,7 @@ typedef struct
   unsigned char *saved_read_buf;
   const unsigned char *saved_read_pos;
   unsigned char *saved_read_end;
-  off_t saved_read_buf_size;
+  scm_t_off saved_read_buf_size;
 
   /* write requests are saved into this buffer at write_pos until it
      reaches write_buf + write_buf_size, then the ptob flush is
@@ -87,7 +90,7 @@ typedef struct
   unsigned char *write_buf;     /* buffer start.  */
   unsigned char *write_pos;     /* pointer to last buffered char + 1.  */
   unsigned char *write_end;     /* pointer to end of buffer + 1.  */
-  off_t write_buf_size;		/* size of the buffer.  */
+  scm_t_off write_buf_size;		/* size of the buffer.  */
 
   unsigned char shortbuf;       /* buffer for "unbuffered" streams.  */
 
@@ -156,11 +159,11 @@ SCM_INTERNAL SCM scm_i_port_weak_hash;
 #define SCM_REVEALED(x)           (SCM_PTAB_ENTRY(x)->revealed)
 #define SCM_SETREVEALED(x, s)      (SCM_PTAB_ENTRY(x)->revealed = (s))
 
-#define SCM_INCLINE(port)  	{SCM_LINUM (port) += 1; SCM_COL (port) = 0;}
-#define SCM_ZEROCOL(port)  	{SCM_COL (port) = 0;}
-#define SCM_INCCOL(port)  	{SCM_COL (port) += 1;}
-#define SCM_DECCOL(port)  	{if (SCM_COL (port) > 0) SCM_COL (port) -= 1;}
-#define SCM_TABCOL(port)  	{SCM_COL (port) += 8 - SCM_COL (port) % 8;}
+#define SCM_INCLINE(port)  	do {SCM_LINUM (port) += 1; SCM_COL (port) = 0;} while (0)
+#define SCM_ZEROCOL(port)  	do {SCM_COL (port) = 0;} while (0)
+#define SCM_INCCOL(port)  	do {SCM_COL (port) += 1;} while (0)
+#define SCM_DECCOL(port)  	do {if (SCM_COL (port) > 0) SCM_COL (port) -= 1;} while (0)
+#define SCM_TABCOL(port)  	do {SCM_COL (port) += 8 - SCM_COL (port) % 8;} while (0)
 
 /* Maximum number of port types.  */
 #define SCM_I_MAX_PORT_TYPE_COUNT  256
@@ -184,8 +187,8 @@ typedef struct scm_t_ptob_descriptor
   int (*fill_input) (SCM port);
   int (*input_waiting) (SCM port);
 
-  off_t (*seek) (SCM port, off_t OFFSET, int WHENCE);
-  void (*truncate) (SCM port, off_t length);
+  scm_t_off (*seek) (SCM port, scm_t_off OFFSET, int WHENCE);
+  void (*truncate) (SCM port, scm_t_off length);
 
 } scm_t_ptob_descriptor;
 
@@ -222,12 +225,12 @@ SCM_API void scm_set_port_end_input (scm_t_bits tc,
 				     void (*end_input) (SCM port,
 							int offset));
 SCM_API void scm_set_port_seek (scm_t_bits tc,
-				off_t (*seek) (SCM port,
-					       off_t OFFSET,
-					       int WHENCE));
+				scm_t_off (*seek) (SCM port,
+						   scm_t_off OFFSET,
+						   int WHENCE));
 SCM_API void scm_set_port_truncate (scm_t_bits tc,
 				    void (*truncate) (SCM port,
-						      off_t length));
+						      scm_t_off length));
 SCM_API void scm_set_port_input_waiting (scm_t_bits tc, int (*input_waiting) (SCM));
 SCM_API SCM scm_char_ready_p (SCM port);
 size_t scm_take_from_input_buffers (SCM port, char *dest, size_t read_len);
@@ -266,13 +269,18 @@ SCM_API SCM scm_eof_object_p (SCM x);
 SCM_API SCM scm_force_output (SCM port);
 SCM_API SCM scm_flush_all_ports (void);
 SCM_API SCM scm_read_char (SCM port);
+SCM_API scm_t_wchar scm_getc (SCM port);
 SCM_API size_t scm_c_read (SCM port, void *buffer, size_t size);
 SCM_API void scm_c_write (SCM port, const void *buffer, size_t size);
 SCM_API void scm_lfwrite (const char *ptr, size_t size, SCM port);
+SCM_INTERNAL void scm_lfwrite_str (SCM str, SCM port);
+SCM_INTERNAL void scm_lfwrite_substr (SCM str, size_t start, size_t end,
+				      SCM port);
 SCM_API void scm_flush (SCM port);
 SCM_API void scm_end_input (SCM port);
 SCM_API int scm_fill_input (SCM port);
-SCM_API void scm_ungetc (int c, SCM port);
+SCM_INTERNAL void scm_unget_byte (int c, SCM port); 
+SCM_API void scm_ungetc (scm_t_wchar c, SCM port);
 SCM_API void scm_ungets (const char *s, int n, SCM port);
 SCM_API SCM scm_peek_char (SCM port);
 SCM_API SCM scm_unread_char (SCM cobj, SCM port);
@@ -285,6 +293,15 @@ SCM_API SCM scm_port_column (SCM port);
 SCM_API SCM scm_set_port_column_x (SCM port, SCM line);
 SCM_API SCM scm_port_filename (SCM port);
 SCM_API SCM scm_set_port_filename_x (SCM port, SCM filename);
+SCM_INTERNAL const char *scm_i_get_port_encoding (SCM port);
+SCM_INTERNAL void scm_i_set_port_encoding_x (SCM port, const char *str);
+SCM_API SCM scm_port_encoding (SCM port);
+SCM_API SCM scm_set_port_encoding_x (SCM port, SCM encoding);
+SCM_INTERNAL scm_t_string_failed_conversion_handler scm_i_get_conversion_strategy (SCM port);
+SCM_INTERNAL void scm_i_set_conversion_strategy_x (SCM port, 
+						   scm_t_string_failed_conversion_handler h);
+SCM_API SCM scm_port_conversion_strategy (SCM port);
+SCM_API SCM scm_set_port_conversion_strategy_x (SCM port, SCM behavior);
 SCM_API int scm_port_print (SCM exp, SCM port, scm_print_state *);
 SCM_API void scm_print_port_mode (SCM exp, SCM port);
 SCM_API void scm_ports_prehistory (void);
@@ -292,7 +309,6 @@ SCM_API SCM scm_void_port (char * mode_str);
 SCM_API SCM scm_sys_make_void_port (SCM mode);
 SCM_INTERNAL void scm_init_ports (void);
 
-
 #if SCM_ENABLE_DEPRECATED==1
 SCM_API scm_t_port * scm_add_to_port_table (SCM port);
 #endif
diff --git a/libguile/posix.c b/libguile/posix.c
index b5082fa0a..75469531c 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -21,8 +22,10 @@
 #  include <config.h>
 #endif
 
+#include <stdlib.h>
 #include <stdio.h>
 #include <errno.h>
+#include <uniconv.h>
 
 #include "libguile/_scm.h"
 #include "libguile/dynwind.h"
@@ -33,6 +36,7 @@
 #include "libguile/srfi-13.h"
 #include "libguile/srfi-14.h"
 #include "libguile/vectors.h"
+#include "libguile/values.h"
 #include "libguile/lang.h"
 
 #include "libguile/validate.h"
@@ -99,8 +103,6 @@ extern char *ttyname();
 
 #include <signal.h>
 
-extern char ** environ;
-
 #ifdef HAVE_GRP_H
 #include <grp.h>
 #endif
@@ -136,13 +138,7 @@ extern char ** environ;
 #  include <sys/resource.h>
 #endif
 
-#if HAVE_SYS_FILE_H
-# include <sys/file.h>
-#endif
-
-#if HAVE_CRT_EXTERNS_H
-#include <crt_externs.h>  /* for Darwin _NSGetEnviron */
-#endif
+#include <sys/file.h>     /* from Gnulib */
 
 /* Some Unix systems don't define these.  CPP hair is dangerous, but
    this seems safe enough... */
@@ -196,13 +192,6 @@ int sethostname (char *name, size_t namelen);
 
 
 
-/* On Apple Darwin in a shared library there's no "environ" to access
-   directly, instead the address of that variable must be obtained with
-   _NSGetEnviron().  */
-#if HAVE__NSGETENVIRON && defined (PIC)
-#define environ (*_NSGetEnviron())
-#endif
-
 
 
 /* Two often used patterns
@@ -463,6 +452,179 @@ SCM_DEFINE (scm_setgrent, "setgr", 0, 1, 0,
 #endif /* HAVE_GETGRENT */
 
 
+#ifdef HAVE_GETRLIMIT
+#ifdef RLIMIT_AS
+SCM_SYMBOL (sym_as, "as");
+#endif
+#ifdef RLIMIT_CORE
+SCM_SYMBOL (sym_core, "core");
+#endif
+#ifdef RLIMIT_CPU
+SCM_SYMBOL (sym_cpu, "cpu");
+#endif
+#ifdef RLIMIT_DATA
+SCM_SYMBOL (sym_data, "data");
+#endif
+#ifdef RLIMIT_FSIZE
+SCM_SYMBOL (sym_fsize, "fsize");
+#endif
+#ifdef RLIMIT_MEMLOCK
+SCM_SYMBOL (sym_memlock, "memlock");
+#endif
+#ifdef RLIMIT_MSGQUEUE
+SCM_SYMBOL (sym_msgqueue, "msgqueue");
+#endif
+#ifdef RLIMIT_NICE
+SCM_SYMBOL (sym_nice, "nice");
+#endif
+#ifdef RLIMIT_NOFILE
+SCM_SYMBOL (sym_nofile, "nofile");
+#endif
+#ifdef RLIMIT_NPROC
+SCM_SYMBOL (sym_nproc, "nproc");
+#endif
+#ifdef RLIMIT_RSS
+SCM_SYMBOL (sym_rss, "rss");
+#endif
+#ifdef RLIMIT_RTPRIO
+SCM_SYMBOL (sym_rtprio, "rtprio");
+#endif
+#ifdef RLIMIT_RTPRIO
+SCM_SYMBOL (sym_rttime, "rttime");
+#endif
+#ifdef RLIMIT_SIGPENDING
+SCM_SYMBOL (sym_sigpending, "sigpending");
+#endif
+#ifdef RLIMIT_STACK
+SCM_SYMBOL (sym_stack, "stack");
+#endif
+
+static int
+scm_to_resource (SCM s, const char *func, int pos)
+{
+  if (scm_is_number (s))
+    return scm_to_int (s);
+  
+  SCM_ASSERT_TYPE (scm_is_symbol (s), s, pos, func, "symbol");
+
+#ifdef RLIMIT_AS
+  if (s == sym_as)
+    return RLIMIT_AS;
+#endif
+#ifdef RLIMIT_CORE
+  if (s == sym_core)
+    return RLIMIT_CORE;
+#endif
+#ifdef RLIMIT_CPU
+  if (s == sym_cpu)
+    return RLIMIT_CPU;
+#endif
+#ifdef RLIMIT_DATA
+  if (s == sym_data)
+    return RLIMIT_DATA;
+#endif
+#ifdef RLIMIT_FSIZE
+  if (s == sym_fsize)
+    return RLIMIT_FSIZE;
+#endif
+#ifdef RLIMIT_MEMLOCK
+  if (s == sym_memlock)
+    return RLIMIT_MEMLOCK;
+#endif
+#ifdef RLIMIT_MSGQUEUE
+  if (s == sym_msgqueue)
+    return RLIMIT_MSGQUEUE;
+#endif
+#ifdef RLIMIT_NICE
+  if (s == sym_nice)
+    return RLIMIT_NICE;
+#endif
+#ifdef RLIMIT_NOFILE
+  if (s == sym_nofile)
+    return RLIMIT_NOFILE;
+#endif
+#ifdef RLIMIT_NPROC
+  if (s == sym_nproc)
+    return RLIMIT_NPROC;
+#endif
+#ifdef RLIMIT_RSS
+  if (s == sym_rss)
+    return RLIMIT_RSS;
+#endif
+#ifdef RLIMIT_RTPRIO
+  if (s == sym_rtprio)
+    return RLIMIT_RTPRIO;
+#endif
+#ifdef RLIMIT_RTPRIO
+  if (s == sym_rttime)
+    return RLIMIT_RTPRIO;
+#endif
+#ifdef RLIMIT_SIGPENDING
+  if (s == sym_sigpending)
+    return RLIMIT_SIGPENDING;
+#endif
+#ifdef RLIMIT_STACK
+  if (s == sym_stack)
+    return RLIMIT_STACK;
+#endif
+
+  scm_misc_error (func, "invalid rlimit resource ~A", scm_list_1 (s));
+  return 0;
+}
+  
+SCM_DEFINE (scm_getrlimit, "getrlimit", 1, 0, 0,
+            (SCM resource),
+	    "Get a resource limit for this process. @var{resource} identifies the resource,\n"
+            "either as an integer or as a symbol. For example, @code{(getrlimit 'stack)}\n"
+            "gets the limits associated with @code{RLIMIT_STACK}.\n\n"
+	    "@code{getrlimit} returns two values, the soft and the hard limit. If no\n"
+            "limit is set for the resource in question, the returned limit will be @code{#f}.")
+#define FUNC_NAME s_scm_getrlimit
+{
+  int iresource;
+  struct rlimit lim = { 0, 0 };
+  
+  iresource = scm_to_resource (resource, FUNC_NAME, 1);
+  
+  if (getrlimit (iresource, &lim) != 0)
+    scm_syserror (FUNC_NAME);
+
+  return scm_values (scm_list_2 ((lim.rlim_cur == RLIM_INFINITY) ? SCM_BOOL_F
+                                 : scm_from_long (lim.rlim_cur),
+                                 (lim.rlim_max == RLIM_INFINITY) ? SCM_BOOL_F
+                                 : scm_from_long (lim.rlim_max)));
+}
+#undef FUNC_NAME
+
+
+#ifdef HAVE_SETRLIMIT
+SCM_DEFINE (scm_setrlimit, "setrlimit", 3, 0, 0,
+            (SCM resource, SCM soft, SCM hard),
+	    "Set a resource limit for this process. @var{resource} identifies the resource,\n"
+            "either as an integer or as a symbol. @var{soft} and @var{hard} should be integers,\n"
+            "or @code{#f} to indicate no limit (i.e., @code{RLIM_INFINITY}).\n\n"
+            "For example, @code{(setrlimit 'stack 150000 300000)} sets the @code{RLIMIT_STACK}\n"
+            "limit to 150 kilobytes, with a hard limit of 300 kB.")
+#define FUNC_NAME s_scm_setrlimit
+{
+  int iresource;
+  struct rlimit lim = { 0, 0 };
+  
+  iresource = scm_to_resource (resource, FUNC_NAME, 1);
+  
+  lim.rlim_cur = (soft == SCM_BOOL_F) ? RLIM_INFINITY : scm_to_long (soft);
+  lim.rlim_max = (hard == SCM_BOOL_F) ? RLIM_INFINITY : scm_to_long (hard);
+
+  if (setrlimit (iresource, &lim) != 0)
+    scm_syserror (FUNC_NAME);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+#endif /* HAVE_SETRLIMIT */
+#endif /* HAVE_GETRLIMIT */
+
+
 SCM_DEFINE (scm_kill, "kill", 2, 0, 0,
             (SCM pid, SCM sig),
 	    "Sends a signal to the specified process or group of processes.\n\n"
@@ -1311,98 +1473,13 @@ SCM_DEFINE (scm_putenv, "putenv", 1, 0, 0,
   int rv;
   char *c_str = scm_to_locale_string (str);
 
-  if (strchr (c_str, '=') == NULL)
-    {
-      /* We want no "=" in the argument to mean remove the variable from the
-	 environment, but not all putenv()s understand this, for example
-	 FreeBSD 4.8 doesn't.  Getting it happening everywhere is a bit
-	 painful.  What unsetenv() exists, we use that, of course.
-
-         Traditionally putenv("NAME") removes a variable, for example that's
-         what we have to do on Solaris 9 (it doesn't have an unsetenv).
-
-         But on DOS and on that DOS overlay manager thing called W-whatever,
-         putenv("NAME=") must be used (it too doesn't have an unsetenv).
-
-         Supposedly on AIX a putenv("NAME") could cause a segfault, but also
-         supposedly AIX 5.3 and up has unsetenv() available so should be ok
-         with the latter there.
-
-         For the moment we hard code the DOS putenv("NAME=") style under
-         __MINGW32__ and do the traditional everywhere else.  Such
-         system-name tests are bad, of course.  It'd be possible to use a
-         configure test when doing a a native build.  For example GNU R has
-         such a test (see R_PUTENV_AS_UNSETENV in
-         https://svn.r-project.org/R/trunk/m4/R.m4).  But when cross
-         compiling there'd want to be a guess, one probably based on the
-         system name (ie. mingw or not), thus landing back in basically the
-         present hard-coded situation.  Another possibility for a cross
-         build would be to try "NAME" then "NAME=" at runtime, if that's not
-         too much like overkill.  */
-
-#if HAVE_UNSETENV
-      /* when unsetenv() exists then we use it */
-      unsetenv (c_str);
-      free (c_str);
-#elif defined (__MINGW32__)
-      /* otherwise putenv("NAME=") on DOS */
-      int e;
-      size_t len = strlen (c_str);
-      char *ptr = scm_malloc (len + 2);
-      strcpy (ptr, c_str);
-      strcpy (ptr+len, "=");
-      rv = putenv (ptr);
-      e = errno; free (ptr); free (c_str); errno = e;
-      if (rv < 0)
-	SCM_SYSERROR;
-#else
-      /* otherwise traditional putenv("NAME") */
-      rv = putenv (c_str);
-      if (rv < 0)
-	SCM_SYSERROR;
-#endif
-    }
-  else
-    {
-#ifdef __MINGW32__
-      /* If str is "FOO=", ie. attempting to set an empty string, then
-         we need to see if it's been successful.  On MINGW, "FOO="
-         means remove FOO from the environment.  As a workaround, we
-         set "FOO= ", ie. a space, and then modify the string returned
-         by getenv.  It's not enough just to modify the string we set,
-         because MINGW putenv copies it.  */
-
-      {
-        size_t len = strlen (c_str);
-        if (c_str[len-1] == '=')
-          {
-            char *ptr = scm_malloc (len+2);
-            strcpy (ptr, c_str);
-            strcpy (ptr+len, " ");
-            rv = putenv (ptr);
-            if (rv < 0)
-              {
-                int eno = errno;
-                free (c_str);
-                errno = eno;
-                SCM_SYSERROR;
-              }
-            /* truncate to just the name */
-            c_str[len-1] = '\0';
-            ptr = getenv (c_str);
-            if (ptr)
-              ptr[0] = '\0';
-            return SCM_UNSPECIFIED;
-          }
-      }
-#endif /* __MINGW32__ */
+  /* Leave C_STR in the environment.  */
 
-      /* Leave c_str in the environment.  */
+  /* Gnulib's `putenv' module honors the semantics described above.  */
+  rv = putenv (c_str);
+  if (rv < 0)
+    SCM_SYSERROR;
 
-      rv = putenv (c_str);
-      if (rv < 0)
-	SCM_SYSERROR;
-    }
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
@@ -1425,12 +1502,17 @@ SCM_DEFINE (scm_setlocale, "setlocale", 1, 1, 0,
 	    "Otherwise the specified locale category is set to the string\n"
 	    "@var{locale} and the new value is returned as a\n"
 	    "system-dependent string.  If @var{locale} is an empty string,\n"
-	    "the locale will be set using environment variables.")
+	    "the locale will be set using environment variables.\n"
+	    "\n"
+	    "When the locale is changed, the character encoding of the new\n"
+	    "locale (UTF-8, ISO-8859-1, etc.) is used for the current\n"
+	    "input, output, and error ports\n")
 #define FUNC_NAME s_scm_setlocale
 {
   int c_category;
   char *clocale;
   char *rv;
+  const char *enc;
 
   scm_dynwind_begin (0);
 
@@ -1459,15 +1541,47 @@ SCM_DEFINE (scm_setlocale, "setlocale", 1, 1, 0,
       SCM_SYSERROR;
     }
 
-  /* Recompute the standard SRFI-14 character sets in a locale-dependent
-     (actually charset-dependent) way.  */
-  scm_srfi_14_compute_char_sets ();
+  enc = locale_charset ();
+  /* Set the default encoding for new ports.  */
+  scm_i_set_port_encoding_x (SCM_BOOL_F, enc);
+  /* Set the encoding for the stdio ports.  */
+  scm_i_set_port_encoding_x (scm_current_input_port (), enc);
+  scm_i_set_port_encoding_x (scm_current_output_port (), enc);
+  scm_i_set_port_encoding_x (scm_current_error_port (), enc);
 
   scm_dynwind_end ();
   return scm_from_locale_string (rv);
 }
 #undef FUNC_NAME
 #endif /* HAVE_SETLOCALE */
+SCM_DEFINE (scm_setbinary, "setbinary", 0, 0, 0,
+            (void),
+	    "Sets the encoding for the current input, output, and error\n"
+	    "ports to ISO-8859-1.  That character encoding allows\n"
+	    "ports to operate on binary data.\n"
+	    "\n"
+	    "It also sets the default encoding for newly created ports\n"
+	    "to ISO-8859-1.\n"
+            "\n"
+            "The previous default encoding for new ports is returned\n")
+#define FUNC_NAME s_scm_setbinary
+{
+  const char *enc = scm_i_get_port_encoding (SCM_BOOL_F);
+
+  /* Set the default encoding for new ports.  */
+  scm_i_set_port_encoding_x (SCM_BOOL_F, NULL);
+  /* Set the encoding for the stdio ports.  */
+  scm_i_set_port_encoding_x (scm_current_input_port (), NULL);
+  scm_i_set_port_encoding_x (scm_current_output_port (), NULL);
+  scm_i_set_port_encoding_x (scm_current_error_port (), NULL);
+
+  if (enc)
+    return scm_from_locale_string (enc);
+
+  return scm_from_locale_string ("ISO-8859-1");
+}
+#undef FUNC_NAME
+
 
 #ifdef HAVE_MKNOD
 SCM_DEFINE (scm_mknod, "mknod", 4, 0, 0,
@@ -1668,6 +1782,11 @@ SCM_DEFINE (scm_getlogin, "getlogin", 0, 0, 0,
 #endif /* HAVE_GETLOGIN */
 
 #if HAVE_CUSERID
+
+# if !HAVE_DECL_CUSERID
+extern char *cuserid (char *);
+# endif
+
 SCM_DEFINE (scm_cuserid, "cuserid", 0, 0, 0, 
             (void),
 	    "Return a string containing a user name associated with the\n"
@@ -1777,73 +1896,6 @@ SCM_DEFINE (scm_getpass, "getpass", 1, 0, 0,
 #undef FUNC_NAME
 #endif /* HAVE_GETPASS */
 
-/* Wrapper function for flock() support under M$-Windows. */
-#ifdef __MINGW32__
-# include <io.h>
-# include <sys/locking.h>
-# include <errno.h>
-# ifndef _LK_UNLCK
-   /* Current MinGW package fails to define this. *sigh* */
-#  define _LK_UNLCK 0
-# endif
-# define LOCK_EX 1
-# define LOCK_UN 2
-# define LOCK_SH 4
-# define LOCK_NB 8
-
-static int flock (int fd, int operation)
-{
-  long pos, len;
-  int ret, err;
-
-  /* Disable invalid arguments. */
-  if (((operation & (LOCK_EX | LOCK_SH)) == (LOCK_EX | LOCK_SH)) ||
-      ((operation & (LOCK_EX | LOCK_UN)) == (LOCK_EX | LOCK_UN)) ||
-      ((operation & (LOCK_SH | LOCK_UN)) == (LOCK_SH | LOCK_UN)))
-    {
-      errno = EINVAL;
-      return -1;
-    }
-
-  /* Determine mode of operation and discard unsupported ones. */
-  if (operation == (LOCK_NB | LOCK_EX))
-    operation = _LK_NBLCK;
-  else if (operation & LOCK_UN)
-    operation = _LK_UNLCK;
-  else if (operation == LOCK_EX)
-    operation = _LK_LOCK;
-  else
-    {
-      errno = EINVAL;
-      return -1;
-    }
-
-  /* Save current file pointer and seek to beginning. */
-  if ((pos = lseek (fd, 0, SEEK_CUR)) == -1 || (len = filelength (fd)) == -1)
-    return -1;
-  lseek (fd, 0L, SEEK_SET);
-
-  /* Deadlock if necessary. */
-  do
-    {
-      ret = _locking (fd, operation, len);
-    }
-  while (ret == -1 && errno == EDEADLOCK);
-
-  /* Produce meaningful error message. */
-  if (errno == EACCES && operation == _LK_NBLCK)
-    err = EDEADLOCK;
-  else
-    err = errno;
-
-  /* Return to saved file position pointer. */
-  lseek (fd, pos, SEEK_SET);
-  errno = err;
-  return ret;
-}
-#endif /* __MINGW32__ */
-
-#if HAVE_FLOCK || defined (__MINGW32__)
 SCM_DEFINE (scm_flock, "flock", 2, 0, 0, 
             (SCM file, SCM operation),
 	    "Apply or remove an advisory lock on an open file.\n"
@@ -1887,7 +1939,6 @@ SCM_DEFINE (scm_flock, "flock", 2, 0, 0,
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
-#endif /* HAVE_FLOCK */
 
 #if HAVE_SETHOSTNAME
 SCM_DEFINE (scm_sethostname, "sethostname", 1, 0, 0, 
diff --git a/libguile/posix.h b/libguile/posix.h
index 34e1fc77f..2d93300b8 100644
--- a/libguile/posix.h
+++ b/libguile/posix.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -41,6 +42,8 @@ SCM_API SCM scm_getpwuid (SCM user);
 SCM_API SCM scm_setpwent (SCM arg);
 SCM_API SCM scm_getgrgid (SCM name);
 SCM_API SCM scm_setgrent (SCM arg);
+SCM_API SCM scm_getrlimit (SCM resource);
+SCM_API SCM scm_setrlimit (SCM resource, SCM soft, SCM hard);
 SCM_API SCM scm_kill (SCM pid, SCM sig);
 SCM_API SCM scm_waitpid (SCM pid, SCM options);
 SCM_API SCM scm_status_exit_val (SCM status);
@@ -71,6 +74,7 @@ SCM_API SCM scm_access (SCM path, SCM how);
 SCM_API SCM scm_getpid (void);
 SCM_API SCM scm_putenv (SCM str);
 SCM_API SCM scm_setlocale (SCM category, SCM locale);
+SCM_API SCM scm_setbinary (void);
 SCM_API SCM scm_mknod (SCM path, SCM type, SCM perms, SCM dev);
 SCM_API SCM scm_nice (SCM incr);
 SCM_API SCM scm_sync (void);
diff --git a/libguile/print.c b/libguile/print.c
index 1852cf19a..3bb6cb167 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1995-1999,2000,2001, 2002, 2003, 2004, 2006, 2008, 2009 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -22,6 +23,8 @@
 #endif
 
 #include <errno.h>
+#include <uniconv.h>
+#include <unictype.h>
 
 #include "libguile/_scm.h"
 #include "libguile/chars.h"
@@ -32,7 +35,7 @@
 #include "libguile/procprop.h"
 #include "libguile/read.h"
 #include "libguile/weaks.h"
-#include "libguile/unif.h"
+#include "libguile/programs.h"
 #include "libguile/alist.h"
 #include "libguile/struct.h"
 #include "libguile/objects.h"
@@ -291,13 +294,12 @@ print_circref (SCM port, scm_print_state *pstate, SCM ref)
 /* Print the name of a symbol. */
 
 static int
-quote_keywordish_symbol (const char *str, size_t len)
+quote_keywordish_symbol (SCM symbol)
 {
   SCM option;
 
-  /* LEN is guaranteed to be > 0.
-   */
-  if (str[0] != ':' && str[len-1] != ':')
+  if (scm_i_symbol_ref (symbol, 0) != ':'
+      && scm_i_symbol_ref (symbol, scm_i_symbol_length (symbol) - 1) !=  ':')
     return 0;
 
   option = SCM_PRINT_KEYWORD_STYLE;
@@ -309,7 +311,7 @@ quote_keywordish_symbol (const char *str, size_t len)
 }
 
 void
-scm_print_symbol_name (const char *str, size_t len, SCM port)
+scm_i_print_symbol_name (SCM str, SCM port)
 {
   /* This points to the first character that has not yet been written to the
    * port. */
@@ -330,18 +332,20 @@ scm_print_symbol_name (const char *str, size_t len, SCM port)
    * simpler and faster. */
   int maybe_weird = 0;
   size_t mw_pos = 0;
+  size_t len = scm_i_symbol_length (str);
+  scm_t_wchar str0 = scm_i_symbol_ref (str, 0);
 
-  if (len == 0 || str[0] == '\'' || str[0] == '`' || str[0] == ','
-      || quote_keywordish_symbol (str, len)
-      || (str[0] == '.' && len == 1)
-      || scm_is_true (scm_c_locale_stringn_to_number (str, len, 10)))
+  if (len == 0 || str0 == '\'' || str0 == '`' || str0 == ','
+      || quote_keywordish_symbol (str) 
+      || (str0 == '.' && len == 1)
+      || scm_is_true (scm_i_string_to_number (scm_symbol_to_string (str), 10)))
     {
       scm_lfwrite ("#{", 2, port);
       weird = 1;
     }
 
   for (end = pos; end < len; ++end)
-    switch (str[end])
+    switch (scm_i_symbol_ref (str, end))
       {
 #ifdef BRACKETS_AS_PARENS
       case '[':
@@ -366,11 +370,11 @@ scm_print_symbol_name (const char *str, size_t len, SCM port)
 	    weird = 1;
 	  }
 	if (pos < end)
-	  scm_lfwrite (str + pos, end - pos, port);
+	  scm_lfwrite_substr (scm_symbol_to_string (str), pos, end, port);
 	{
 	  char buf[2];
 	  buf[0] = '\\';
-	  buf[1] = str[end];
+	  buf[1] = (char) (unsigned char) scm_i_symbol_ref (str, end);
 	  scm_lfwrite (buf, 2, port);
 	}
 	pos = end + 1;
@@ -388,11 +392,18 @@ scm_print_symbol_name (const char *str, size_t len, SCM port)
 	break;
       }
   if (pos < end)
-    scm_lfwrite (str + pos, end - pos, port);
+    scm_lfwrite_substr (scm_symbol_to_string (str), pos, end, port);
   if (weird)
     scm_lfwrite ("}#", 2, port);
 }
 
+void
+scm_print_symbol_name (const char *str, size_t len, SCM port)
+{
+  SCM symbol = scm_from_locale_symboln (str, len);
+  return scm_i_print_symbol_name (symbol, port);
+}
+
 /* Print generally.  Handles both write and display according to PSTATE.
  */
 SCM_GPROC(s_write, "write", 1, 1, 0, scm_write, g_write);
@@ -435,24 +446,66 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
     case scm_tc3_imm24:
       if (SCM_CHARP (exp))
 	{
-	  long i = SCM_CHAR (exp);
+	  scm_t_wchar i = SCM_CHAR (exp);
+          const char *name;
 
 	  if (SCM_WRITINGP (pstate))
 	    {
 	      scm_puts ("#\\", port);
-	      if ((i >= 0) && (i <= ' ') && scm_charnames[i])
-		scm_puts (scm_charnames[i], port);
-#ifndef EBCDIC
-	      else if (i == '\177')
-		scm_puts (scm_charnames[scm_n_charnames - 1], port);
-#endif
-	      else if (i < 0 || i > '\177')
-		scm_intprint (i, 8, port);
-	      else
-		scm_putc (i, port);
+	      name = scm_i_charname (exp);
+	      if (name != NULL)
+		scm_puts (name, port);
+	      else if (uc_is_general_category_withtable (i, UC_CATEGORY_MASK_L
+                                                         | UC_CATEGORY_MASK_M 
+                                                         | UC_CATEGORY_MASK_N 
+                                                         | UC_CATEGORY_MASK_P 
+                                                         | UC_CATEGORY_MASK_S))
+                /* Print the character if is graphic character.  */
+                {
+                  scm_t_wchar *wbuf;
+                  SCM wstr = scm_i_make_wide_string (1, &wbuf);
+                  char *buf;
+                  size_t len;
+                  const char *enc;
+
+                  enc = scm_i_get_port_encoding (port);
+                  wbuf[0] = i;
+                  if (enc == NULL)
+                    {
+                      if (i <= 0xFF)
+                        /* Character is graphic and Latin-1.  Print it  */
+                        scm_lfwrite_str (wstr, port);
+                      else
+                        /* Character is graphic but unrepresentable in
+                           this port's encoding.  */
+                        scm_intprint (i, 8, port);
+                    }
+                  else
+                    {
+                      buf = u32_conv_to_encoding (enc, 
+                                                  iconveh_error,
+                                                  (scm_t_uint32 *) wbuf, 
+                                                  1,
+                                                  NULL,
+                                                  NULL, &len);
+                      if (buf != NULL)
+                        {
+                          /* Character is graphic.  Print it.  */
+                          scm_lfwrite_str (wstr, port);
+                          free (buf);
+                        }
+                      else
+                        /* Character is graphic but unrepresentable in
+                           this port's encoding.  */
+                        scm_intprint (i, 8, port);
+                    }
+                }
+              else
+                /* Character is a non-graphical character.  */
+                scm_intprint (i, 8, port);
 	    }
 	  else
-	    scm_putc (i, port);
+	    scm_i_charprint (i, port);
 	}
       else if (SCM_IFLAGP (exp)
 	       && ((size_t) SCM_IFLAGNUM (exp) < (sizeof iflagnames / sizeof (char *))))
@@ -545,63 +598,128 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
             break;
           }
 	  break;
-	case scm_tc7_string:
-	  if (SCM_WRITINGP (pstate))
-	    {
-	      size_t i, j, len;
-	      const char *data;
-
-	      scm_putc ('"', port);
-	      len = scm_i_string_length (exp);
-	      data = scm_i_string_chars (exp);
-	      for (i = 0, j = 0; i < len; ++i)
-		{
-		  unsigned char ch = data[i];
-		  if ((ch < 32 && ch != '\n') || (127 <= ch && ch < 148))
-		    {
-		      static char const hex[]="0123456789abcdef";
-		      char buf[4];
-
-		      scm_lfwrite (data+j, i-j, port);
-		      buf[0] = '\\';
-		      buf[1] = 'x';
-		      buf[2] =  hex [ch / 16];
-		      buf[3] = hex [ch % 16];
-		      scm_lfwrite (buf, 4, port);
-		      data = scm_i_string_chars (exp);
-		      j = i+1;
-		    }
-		  else if (ch == '"' || ch == '\\')
-		    {
-		      scm_lfwrite (data+j, i-j, port);
-		      scm_putc ('\\', port);
-		      data = scm_i_string_chars (exp);
-		      j = i;
-		    }
-		}
-	      scm_lfwrite (data+j, i-j, port);
-	      scm_putc ('"', port);
-	      scm_remember_upto_here_1 (exp);
-	    }
-	  else
-	    scm_lfwrite (scm_i_string_chars (exp), scm_i_string_length (exp),
-			 port);
-	  scm_remember_upto_here_1 (exp);
-	  break;
+        case scm_tc7_string:
+          if (SCM_WRITINGP (pstate))
+            {
+              size_t i, j, len;
+              static char const hex[] = "0123456789abcdef";
+              char buf[8];
+
+
+              scm_putc ('"', port);
+              len = scm_i_string_length (exp);
+              for (i = 0; i < len; ++i)
+                {
+                  scm_t_wchar ch = scm_i_string_ref (exp, i);
+                  int printed = 0;
+
+                  if (ch == ' ' || ch == '\n')
+                    {
+                      scm_putc (ch, port);
+                      printed = 1;
+                    }
+                  else if (ch == '"' || ch == '\\')
+                    {
+                      scm_putc ('\\', port);
+                      scm_i_charprint (ch, port);
+                      printed = 1;
+                    }
+                  else
+                    if (uc_is_general_category_withtable
+                        (ch,
+                         UC_CATEGORY_MASK_L | UC_CATEGORY_MASK_M |
+                         UC_CATEGORY_MASK_N | UC_CATEGORY_MASK_P |
+                         UC_CATEGORY_MASK_S))
+                    {
+                      /* Print the character since it is a graphic
+                         character.  */
+                      scm_t_wchar *wbuf;
+                      SCM wstr = scm_i_make_wide_string (1, &wbuf);
+                      char *buf;
+                      size_t len;
+                      
+                      if (scm_i_get_port_encoding (port))
+                        {
+                          wstr = scm_i_make_wide_string (1, &wbuf);
+                          wbuf[0] = ch;
+                          buf = u32_conv_to_encoding (scm_i_get_port_encoding (port), 
+                                                      iconveh_error,
+                                                      (scm_t_uint32 *) wbuf, 
+                                                      1   ,
+                                                      NULL,
+                                                      NULL, &len);
+                          if (buf != NULL)
+                            {
+                              /* Character is graphic and representable in
+                                 this encoding.  Print it.  */
+                              scm_lfwrite_str (wstr, port);
+                              free (buf);
+                              printed = 1;
+                            }
+                        }
+                      else
+                        if (ch <= 0xFF)
+                          {
+                            scm_putc (ch, port);
+                            printed = 1;
+                          }
+                    }
+
+                  if (!printed)
+                    {
+                      /* Character is graphic but unrepresentable in
+                         this port's encoding or is not graphic.  */
+                      if (ch <= 0xFF)
+                        {
+                          buf[0] = '\\';
+                          buf[1] = 'x';
+                          buf[2] = hex[ch / 16];
+                          buf[3] = hex[ch % 16];
+                          scm_lfwrite (buf, 4, port);
+                        }
+                      else if (ch <= 0xFFFF)
+                        {
+                          buf[0] = '\\';
+                          buf[1] = 'u';
+                          buf[2] = hex[(ch & 0xF000) >> 12];
+                          buf[3] = hex[(ch & 0xF00) >> 8];
+                          buf[4] = hex[(ch & 0xF0) >> 4];
+                          buf[5] = hex[(ch & 0xF)];
+                          scm_lfwrite (buf, 6, port);
+                          j = i + 1;
+                        }
+                      else if (ch > 0xFFFF)
+                        {
+                          buf[0] = '\\';
+                          buf[1] = 'U';
+                          buf[2] = hex[(ch & 0xF00000) >> 20];
+                          buf[3] = hex[(ch & 0xF0000) >> 16];
+                          buf[4] = hex[(ch & 0xF000) >> 12];
+                          buf[5] = hex[(ch & 0xF00) >> 8];
+                          buf[6] = hex[(ch & 0xF0) >> 4];
+                          buf[7] = hex[(ch & 0xF)];
+                          scm_lfwrite (buf, 8, port);
+                          j = i + 1;
+                        }
+                    }
+                }
+              scm_putc ('"', port);
+              scm_remember_upto_here_1 (exp);
+            }
+          else
+            scm_lfwrite_str (exp, port);
+          scm_remember_upto_here_1 (exp);
+          break;
 	case scm_tc7_symbol:
 	  if (scm_i_symbol_is_interned (exp))
 	    {
-	      scm_print_symbol_name (scm_i_symbol_chars (exp),
-				     scm_i_symbol_length (exp),
-				     port);
+	      scm_i_print_symbol_name (exp, port);
 	      scm_remember_upto_here_1 (exp);
 	    }
 	  else
 	    {
 	      scm_puts ("#<uninterned-symbol ", port);
-	      scm_print_symbol_name (scm_i_symbol_chars (exp),
-				     scm_i_symbol_length (exp),
-				     port);
+	      scm_i_print_symbol_name (exp, port);
 	      scm_putc (' ', port);
 	      scm_uintprint (SCM_UNPACK (exp), 16, port);
 	      scm_putc ('>', port);
@@ -610,6 +728,9 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
 	case scm_tc7_variable:
 	  scm_i_variable_print (exp, port, pstate);
 	  break;
+	case scm_tc7_program:
+	  scm_i_program_print (exp, port, pstate);
+	  break;
 	case scm_tc7_wvect:
 	  ENTER_NESTED_DATA (pstate, exp, circref);
 	  if (SCM_IS_WHVEC (exp))
@@ -618,6 +739,9 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
 	    scm_puts ("#w(", port);
 	  goto common_vector_printer;
 
+	case scm_tc7_bytevector:
+	  scm_i_print_bytevector (exp, port, pstate);
+	  break;
 	case scm_tc7_vector:
 	  ENTER_NESTED_DATA (pstate, exp, circref);
 	  scm_puts ("#(", port);
@@ -664,14 +788,16 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
 	  EXIT_NESTED_DATA (pstate);
 	  break;
 	case scm_tcs_subrs:
-	  scm_puts (SCM_SUBR_GENERIC (exp)
-		    ? "#<primitive-generic "
-		    : "#<primitive-procedure ",
-		    port);
-	  scm_puts (scm_i_symbol_chars (SCM_SNAME (exp)), port);
-	  scm_putc ('>', port);
-	  break;
-
+	  {
+	    SCM name = scm_symbol_to_string (SCM_SUBR_NAME (exp));
+	    scm_puts (SCM_SUBR_GENERIC (exp)
+		      ? "#<primitive-generic "
+		      : "#<primitive-procedure ",
+		      port);
+	    scm_lfwrite_str (name, port);
+	    scm_putc ('>', port);
+	    break;
+	  }
 	case scm_tc7_pws:
 	  scm_puts ("#<procedure-with-setter", port);
 	  {
@@ -763,6 +889,17 @@ scm_prin1 (SCM exp, SCM port, int writingp)
     }
 }
 
+/* Print a character.
+ */
+void
+scm_i_charprint (scm_t_wchar ch, SCM port)
+{
+  scm_t_wchar *wbuf;
+  SCM wstr = scm_i_make_wide_string (1, &wbuf);
+
+  wbuf[0] = ch;
+  scm_lfwrite_str (wstr, port);
+}
 
 /* Print an integer.
  */
@@ -977,9 +1114,7 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1,
   SCM port, answer = SCM_UNSPECIFIED;
   int fReturnString = 0;
   int writingp;
-  const char *start;
-  const char *end;
-  const char *p;
+  size_t start, p, end;
 
   if (scm_is_eq (destination, SCM_BOOL_T))
     {
@@ -1002,15 +1137,16 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1,
   SCM_VALIDATE_STRING (2, message);
   SCM_VALIDATE_REST_ARGUMENT (args);
 
-  start = scm_i_string_chars (message);
-  end = start + scm_i_string_length (message);
+  p = 0;
+  start = 0;
+  end = scm_i_string_length (message);
   for (p = start; p != end; ++p)
-    if (*p == '~')
+    if (scm_i_string_ref (message, p) == '~')
       {
 	if (++p == end)
 	  break;
 
-	switch (*p) 
+	switch (scm_i_string_ref (message, p)) 
 	  {
 	  case 'A': case 'a':
 	    writingp = 0;
@@ -1019,33 +1155,33 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1,
 	    writingp = 1;
 	    break;
 	  case '~':
-	    scm_lfwrite (start, p - start, port);
+	    scm_lfwrite_substr (message, start, p, port);
 	    start = p + 1;
 	    continue;
 	  case '%':
-	    scm_lfwrite (start, p - start - 1, port);
+	    scm_lfwrite_substr (message, start, p - 1, port);
 	    scm_newline (port);
 	    start = p + 1;
 	    continue;
 	  default:
 	    SCM_MISC_ERROR ("FORMAT: Unsupported format option ~~~A - use (ice-9 format) instead",
-			    scm_list_1 (SCM_MAKE_CHAR (*p)));
+			    scm_list_1 (SCM_MAKE_CHAR (scm_i_string_ref (message, p))));
 	    
 	  }
 
 
 	if (!scm_is_pair (args))
 	  SCM_MISC_ERROR ("FORMAT: Missing argument for ~~~A",
-			  scm_list_1 (SCM_MAKE_CHAR (*p)));
+			  scm_list_1 (SCM_MAKE_CHAR (scm_i_string_ref (message, p))));
 			  		
-	scm_lfwrite (start, p - start - 1, port);
+	scm_lfwrite_substr (message, start, p - 1, port);
 	/* we pass destination here */
 	scm_prin1 (SCM_CAR (args), destination, writingp);
 	args = SCM_CDR (args);
 	start = p + 1;
       }
 
-  scm_lfwrite (start, p - start, port);
+  scm_lfwrite_substr (message, start, p, port);
   if (!scm_is_eq (args, SCM_EOL))
     SCM_MISC_ERROR ("FORMAT: ~A superfluous arguments",
 		    scm_list_1 (scm_length (args)));
diff --git a/libguile/print.h b/libguile/print.h
index 8974a7554..ae2aaef54 100644
--- a/libguile/print.h
+++ b/libguile/print.h
@@ -6,24 +6,26 @@
 /* Copyright (C) 1995,1996,1998,2000,2001, 2003, 2004, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
 
 #include "libguile/__scm.h"
 
+#include "libguile/chars.h" 
 #include "libguile/options.h"
 
 
@@ -76,10 +78,12 @@ SCM_API SCM scm_print_options (SCM setting);
 SCM_API SCM scm_make_print_state (void);
 SCM_API void scm_free_print_state (SCM print_state);
 SCM_INTERNAL SCM scm_i_port_with_print_state (SCM port, SCM print_state);
+SCM_INTERNAL void scm_i_charprint (scm_t_wchar c, SCM port);
 SCM_API void scm_intprint (scm_t_intmax n, int radix, SCM port);
 SCM_API void scm_uintprint (scm_t_uintmax n, int radix, SCM port);
 SCM_API void scm_ipruk (char *hdr, SCM ptr, SCM port);
 SCM_API void scm_iprlist (char *hdr, SCM exp, int tlr, SCM port, scm_print_state *pstate);
+SCM_INTERNAL void scm_i_print_symbol_name (SCM sym, SCM port);
 SCM_API void scm_print_symbol_name (const char *str, size_t len, SCM port);
 SCM_API void scm_prin1 (SCM exp, SCM port, int writingp);
 SCM_API void scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate);
diff --git a/libguile/private-gc.h b/libguile/private-gc.h
index b38addebd..42514c1e2 100644
--- a/libguile/private-gc.h
+++ b/libguile/private-gc.h
@@ -1,25 +1,26 @@
 /*
  * private-gc.h - private declarations for garbage collection.
  * 
- * Copyright (C) 2002, 03, 04, 05, 06, 07, 08 Free Software Foundation, Inc.
+ * Copyright (C) 2002, 03, 04, 05, 06, 07, 08, 09 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
-#ifndef PRIVATE_GC
-#define PRIVATE_GC
+#ifndef SCM_PRIVATE_GC
+#define SCM_PRIVATE_GC
 
 #include  "_scm.h"
 
@@ -31,54 +32,15 @@
  * 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_MIN_HEAP_SEG_SIZE is minimum size of heap to accept when more heap
- * is needed.
  */
 
 
-/*
- * Heap size 45000 and 40% min yield gives quick startup and no extra
- * heap allocation.  Having higher values on min yield may lead to
- * large heaps, especially if code behaviour is varying its
- * maximum consumption between different freelists.
- */
-
-/*
-  These values used to be global C variables. However, they're also
-  available through the environment, and having a double interface is
-  confusing. Now they're #defines --hwn.
- */
-
-#define SCM_DEFAULT_INIT_HEAP_SIZE_1  256*1024
-#define SCM_DEFAULT_MIN_YIELD_1 40
 #define SCM_DEFAULT_INIT_HEAP_SIZE_2 32*1024
 
-/*
-  How many cells to collect during one sweep call. This is the pool
-  size of each thread.
- */
-#define DEFAULT_SWEEP_AMOUNT 512
-
-/* The following value may seem large, but note that if we get to GC at
- * all, this means that we have a numerically intensive application
- */
-#define SCM_DEFAULT_MIN_YIELD_2 40
-
-#define SCM_DEFAULT_MAX_SEGMENT_SIZE  (20*1024*1024L)
-
-#define SCM_MIN_HEAP_SEG_SIZE (8 * SCM_GC_SIZEOF_CARD)
-#define SCM_HEAP_SEG_SIZE (16384L * sizeof (scm_t_cell))
-
 #define SCM_DOUBLECELL_ALIGNED_P(x)  (((2 * sizeof (scm_t_cell) - 1) & SCM_UNPACK (x)) == 0)
 
 
-#define SCM_GC_CARD_BVEC_SIZE_IN_LONGS \
-    ((SCM_GC_CARD_N_CELLS + SCM_C_BVEC_LONG_BITS - 1) / SCM_C_BVEC_LONG_BITS)
-#define SCM_GC_IN_CARD_HEADERP(x) \
-  (scm_t_cell *) (x) <  SCM_GC_CELL_CARD (x) + SCM_GC_CARD_N_HEADER_CELLS
-
-int scm_getenv_int (const char *var, int def);
+SCM_INTERNAL int scm_getenv_int (const char *var, int def);
 
 
 typedef enum { return_on_error, abort_on_error } policy_on_error;
@@ -99,29 +61,6 @@ typedef enum { return_on_error, abort_on_error } policy_on_error;
 */
 #define CELL_P(x)  ((SCM_UNPACK(x) & (sizeof(scm_t_cell)-1)) == scm_tc3_cons)
 
-/*
-  gc-mark
- */
-
-/* this can be used to ensure that set/clear gc marks only happen when
-   allowed. */
-int scm_i_marking;
-
-void scm_mark_all (void);
-
-extern long int scm_i_deprecated_memory_return;
-extern long int scm_i_find_heap_calls;
-
 SCM_INTERNAL char const *scm_i_tag_name (scm_t_bits tag); /* MOVEME */
 
-
-/*
-  global init funcs.
- */
-void scm_gc_init_malloc (void);
-void scm_gc_init_freelist (void);
-void scm_gc_init_segments (void);
-void scm_gc_init_mark (void);
-
-
 #endif
diff --git a/libguile/private-options.h b/libguile/private-options.h
index eeaf0c17b..ffb699bee 100644
--- a/libguile/private-options.h
+++ b/libguile/private-options.h
@@ -7,18 +7,19 @@
  * Copyright (C) 2007 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 #ifndef PRIVATE_OPTIONS
diff --git a/libguile/procprop.c b/libguile/procprop.c
index db16834c5..5054291b1 100644
--- a/libguile/procprop.c
+++ b/libguile/procprop.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1995,1996,1998,2000,2001,2003,2004, 2006, 2008, 2009 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -32,6 +33,7 @@
 #include "libguile/root.h"
 #include "libguile/vectors.h"
 #include "libguile/hashtab.h"
+#include "libguile/programs.h"
 
 #include "libguile/validate.h"
 #include "libguile/procprop.h"
@@ -71,6 +73,11 @@ scm_i_procedure_arity (SCM proc)
     case scm_tc7_lsubr:
       r = 1;
       break;
+    case scm_tc7_program:
+      a += SCM_PROGRAM_DATA (proc)->nargs;
+      r = SCM_PROGRAM_DATA (proc)->nrest;
+      a -= r;
+      break;
     case scm_tc7_lsubr_2:
       a += 2;
       r = 1;
diff --git a/libguile/procprop.h b/libguile/procprop.h
index bf27dba0a..04cd38442 100644
--- a/libguile/procprop.h
+++ b/libguile/procprop.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,1998,2000, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/procs.c b/libguile/procs.c
index 56bb0bb14..40d6231bb 100644
--- a/libguile/procs.c
+++ b/libguile/procs.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1995,1996,1997,1999,2000,2001, 2006, 2008, 2009 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -31,6 +32,9 @@
 
 #include "libguile/validate.h"
 #include "libguile/procs.h"
+#include "libguile/procprop.h"
+#include "libguile/objcodes.h"
+#include "libguile/programs.h"
 
 
 
@@ -42,15 +46,19 @@ SCM
 scm_c_make_subr (const char *name, long type, SCM (*fcn) ())
 {
   register SCM z;
+  SCM sname;
   SCM *meta_info;
 
   meta_info = scm_gc_malloc (2 * sizeof (*meta_info), "subr meta-info");
-  meta_info[0] = scm_from_locale_symbol (name);
+  sname = scm_from_locale_symbol (name);
+  meta_info[0] = sname;
   meta_info[1] = SCM_EOL;  /* properties */
 
   z = scm_double_cell ((scm_t_bits) type, (scm_t_bits) fcn,
 		       0 /* generic */, (scm_t_bits) meta_info);
 
+  scm_remember_upto_here_1 (sname);
+
   return z;
 }
 
@@ -58,7 +66,7 @@ SCM
 scm_c_define_subr (const char *name, long type, SCM (*fcn) ())
 {
   SCM subr = scm_c_make_subr (name, type, fcn);
-  scm_define (SCM_SNAME (subr), subr);
+  scm_define (SCM_SUBR_NAME (subr), subr);
   return subr;
 }
 
@@ -76,7 +84,7 @@ scm_c_define_subr_with_generic (const char *name,
 				long type, SCM (*fcn) (), SCM *gf)
 {
   SCM subr = scm_c_make_subr_with_generic (name, type, fcn, gf);
-  scm_define (SCM_SNAME (subr), subr);
+  scm_define (SCM_SUBR_NAME (subr), subr);
   return subr;
 }
 
@@ -95,6 +103,7 @@ SCM_DEFINE (scm_procedure_p, "procedure?", 1, 0, 0,
       case scm_tcs_closures:
       case scm_tcs_subrs:
       case scm_tc7_pws:
+      case scm_tc7_program:
 	return SCM_BOOL_T;
       case scm_tc7_smob:
 	return scm_from_bool (SCM_SMOB_DESCRIPTOR (obj).apply);
@@ -134,11 +143,17 @@ SCM_DEFINE (scm_thunk_p, "thunk?", 1, 0, 0,
 	  return SCM_BOOL_T;
 	case scm_tc7_gsubr:
 	  return scm_from_bool (SCM_GSUBR_REQ (SCM_GSUBR_TYPE (obj)) == 0);
+	case scm_tc7_program:
+	  return scm_from_bool (SCM_PROGRAM_DATA (obj)->nargs == 0
+                                || (SCM_PROGRAM_DATA (obj)->nargs == 1
+                                    && SCM_PROGRAM_DATA (obj)->nrest));
 	case scm_tc7_pws:
 	  obj = SCM_PROCEDURE (obj);
 	  goto again;
 	default:
-	  ;
+          if (SCM_PROGRAM_P (obj) && SCM_PROGRAM_DATA (obj)->nargs == 0)
+            return SCM_BOOL_T;
+          /* otherwise fall through */
 	}
     }
   return SCM_BOOL_F;
@@ -160,6 +175,8 @@ scm_subr_p (SCM obj)
   return 0;
 }
 
+SCM_SYMBOL (sym_documentation, "documentation");
+
 SCM_DEFINE (scm_procedure_documentation, "procedure-documentation", 1, 0, 0, 
            (SCM proc),
 	    "Return the documentation string associated with @code{proc}.  By\n"
@@ -171,6 +188,8 @@ SCM_DEFINE (scm_procedure_documentation, "procedure-documentation", 1, 0, 0,
   SCM code;
   SCM_ASSERT (scm_is_true (scm_procedure_p (proc)),
 	      proc, SCM_ARG1, FUNC_NAME);
+  if (SCM_PROGRAM_P (proc))
+    return scm_assq_ref (scm_program_properties (proc), sym_documentation);
   switch (SCM_TYP7 (proc))
     {
     case scm_tcs_closures:
@@ -208,11 +227,25 @@ SCM_DEFINE (scm_make_procedure_with_setter, "make-procedure-with-setter", 2, 0,
 	    "with the associated setter @var{setter}.")
 #define FUNC_NAME s_scm_make_procedure_with_setter
 {
+  SCM name, ret;
   SCM_VALIDATE_PROC (1, procedure);
   SCM_VALIDATE_PROC (2, setter);
-  return scm_double_cell (scm_tc7_pws,
-			  SCM_UNPACK (procedure),
-			  SCM_UNPACK (setter), 0);
+  ret = scm_double_cell (scm_tc7_pws,
+                         SCM_UNPACK (procedure),
+                         SCM_UNPACK (setter), 0);
+  /* don't use procedure_name, because don't care enough to do a reverse
+     lookup */
+  switch (SCM_TYP7 (procedure)) {
+  case scm_tcs_subrs:
+    name = SCM_SUBR_NAME (procedure);
+    break;
+  default:
+    name = scm_procedure_property (procedure, scm_sym_name);
+    break;
+  }
+  if (scm_is_true (name))
+    scm_set_procedure_property_x (ret, scm_sym_name, name);
+  return ret;
 }
 #undef FUNC_NAME
 
diff --git a/libguile/procs.h b/libguile/procs.h
index 18857c62e..7e445ad11 100644
--- a/libguile/procs.h
+++ b/libguile/procs.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,1998,1999,2000,2001, 2006, 2008, 2009 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -31,7 +32,7 @@
  */
 
 #define SCM_SUBR_META_INFO(x)  ((SCM *) SCM_CELL_WORD_3 (x))
-#define SCM_SNAME(x) (SCM_SUBR_META_INFO (x) [0])
+#define SCM_SUBR_NAME(x) (SCM_SUBR_META_INFO (x) [0])
 #define SCM_SUBRF(x) ((SCM (*)()) SCM_CELL_WORD_1 (x))
 #define SCM_DSUBRF(x) ((double (*)()) SCM_CELL_WORD_1 (x))
 #define SCM_SUBR_PROPS(x) (SCM_SUBR_META_INFO (x) [1])
diff --git a/libguile/programs.c b/libguile/programs.c
new file mode 100644
index 000000000..b2bf80674
--- /dev/null
+++ b/libguile/programs.c
@@ -0,0 +1,307 @@
+/* Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+ * 
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+#if HAVE_CONFIG_H
+#  include <config.h>
+#endif
+
+#include <string.h>
+#include "_scm.h"
+#include "vm-bootstrap.h"
+#include "instructions.h"
+#include "modules.h"
+#include "programs.h"
+#include "procprop.h" // scm_sym_name
+#include "srcprop.h" // scm_sym_filename
+#include "vm.h"
+
+
+static SCM write_program = SCM_BOOL_F;
+
+SCM_DEFINE (scm_make_program, "make-program", 1, 2, 0,
+	    (SCM objcode, SCM objtable, SCM free_variables),
+	    "")
+#define FUNC_NAME s_scm_make_program
+{
+  SCM_VALIDATE_OBJCODE (1, objcode);
+  if (SCM_UNLIKELY (SCM_UNBNDP (objtable)))
+    objtable = SCM_BOOL_F;
+  else if (scm_is_true (objtable))
+    SCM_VALIDATE_VECTOR (2, objtable);
+  if (SCM_UNLIKELY (SCM_UNBNDP (free_variables)))
+    free_variables = SCM_BOOL_F;
+  else if (free_variables != SCM_BOOL_F)
+    SCM_VALIDATE_VECTOR (3, free_variables);
+
+  return scm_double_cell (scm_tc7_program, (scm_t_bits)objcode,
+                          (scm_t_bits)objtable, (scm_t_bits)free_variables);
+}
+#undef FUNC_NAME
+
+void
+scm_i_program_print (SCM program, SCM port, scm_print_state *pstate)
+{
+  static int print_error = 0;
+
+  if (SCM_FALSEP (write_program) && scm_module_system_booted_p)
+    write_program = scm_module_local_variable
+      (scm_c_resolve_module ("system vm program"),
+       scm_from_locale_symbol ("write-program"));
+  
+  if (SCM_FALSEP (write_program) || print_error)
+    {
+      scm_puts ("#<program ", port);
+      scm_uintprint (SCM_CELL_WORD_1 (program), 16, port);
+      scm_putc ('>', port);
+    }
+  else
+    {
+      print_error = 1;
+      scm_call_2 (SCM_VARIABLE_REF (write_program), program, port);
+      print_error = 0;
+    }
+}
+
+
+/*
+ * Scheme interface
+ */
+
+SCM_DEFINE (scm_program_p, "program?", 1, 0, 0,
+	    (SCM obj),
+	    "")
+#define FUNC_NAME s_scm_program_p
+{
+  return SCM_BOOL (SCM_PROGRAM_P (obj));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_program_base, "program-base", 1, 0, 0,
+	    (SCM program),
+	    "")
+#define FUNC_NAME s_scm_program_base
+{
+  SCM_VALIDATE_PROGRAM (1, program);
+
+  return scm_from_ulong ((unsigned long) SCM_PROGRAM_DATA (program)->base);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_program_arity, "program-arity", 1, 0, 0,
+	    (SCM program),
+	    "")
+#define FUNC_NAME s_scm_program_arity
+{
+  struct scm_objcode *p;
+
+  SCM_VALIDATE_PROGRAM (1, program);
+
+  p = SCM_PROGRAM_DATA (program);
+  return scm_list_3 (SCM_I_MAKINUM (p->nargs),
+		     SCM_I_MAKINUM (p->nrest),
+		     SCM_I_MAKINUM (p->nlocs));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_program_objects, "program-objects", 1, 0, 0,
+	    (SCM program),
+	    "")
+#define FUNC_NAME s_scm_program_objects
+{
+  SCM_VALIDATE_PROGRAM (1, program);
+  return SCM_PROGRAM_OBJTABLE (program);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_program_module, "program-module", 1, 0, 0,
+	    (SCM program),
+	    "")
+#define FUNC_NAME s_scm_program_module
+{
+  SCM objs;
+  SCM_VALIDATE_PROGRAM (1, program);
+  objs = SCM_PROGRAM_OBJTABLE (program);
+  return scm_is_true (objs) ? scm_c_vector_ref (objs, 0) : SCM_BOOL_F;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_program_meta, "program-meta", 1, 0, 0,
+	    (SCM program),
+	    "")
+#define FUNC_NAME s_scm_program_meta
+{
+  SCM metaobj;
+  
+  SCM_VALIDATE_PROGRAM (1, program);
+
+  metaobj = scm_objcode_meta (SCM_PROGRAM_OBJCODE (program));
+  if (scm_is_true (metaobj))
+    return scm_make_program (metaobj, SCM_BOOL_F, SCM_BOOL_F);
+  else
+    return SCM_BOOL_F;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_program_bindings, "program-bindings", 1, 0, 0,
+	    (SCM program),
+	    "")
+#define FUNC_NAME s_scm_program_bindings
+{
+  SCM meta;
+  
+  SCM_VALIDATE_PROGRAM (1, program);
+
+  meta = scm_program_meta (program);
+  if (scm_is_false (meta))
+    return SCM_BOOL_F;
+  
+  return scm_car (scm_call_0 (meta));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_program_sources, "program-sources", 1, 0, 0,
+	    (SCM program),
+	    "")
+#define FUNC_NAME s_scm_program_sources
+{
+  SCM meta, sources, ret, filename;
+  
+  SCM_VALIDATE_PROGRAM (1, program);
+
+  meta = scm_program_meta (program);
+  if (scm_is_false (meta))
+    return SCM_EOL;
+  
+  filename = SCM_BOOL_F;
+  ret = SCM_EOL;
+  for (sources = scm_cadr (scm_call_0 (meta)); !scm_is_null (sources);
+       sources = scm_cdr (sources))
+    {
+      SCM x = scm_car (sources);
+      if (scm_is_pair (x))
+        {
+          if (scm_is_number (scm_car (x)))
+            {
+              SCM addr = scm_car (x);
+              ret = scm_acons (addr, scm_cons (filename, scm_cdr (x)),
+                               ret);
+            }
+          else if (scm_is_eq (scm_car (x), scm_sym_filename))
+            filename = scm_cdr (x);
+        }
+    }
+  return scm_reverse_x (ret, SCM_UNDEFINED);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_program_properties, "program-properties", 1, 0, 0,
+	    (SCM program),
+	    "")
+#define FUNC_NAME s_scm_program_properties
+{
+  SCM meta;
+  
+  SCM_VALIDATE_PROGRAM (1, program);
+
+  meta = scm_program_meta (program);
+  if (scm_is_false (meta))
+    return SCM_EOL;
+  
+  return scm_cddr (scm_call_0 (meta));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_program_name, "program-name", 1, 0, 0,
+	    (SCM program),
+	    "")
+#define FUNC_NAME s_scm_program_name
+{
+  SCM_VALIDATE_PROGRAM (1, program);
+  return scm_assq_ref (scm_program_properties (program), scm_sym_name);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_program_source, "program-source", 2, 0, 0,
+	    (SCM program, SCM ip),
+	    "")
+#define FUNC_NAME s_scm_program_source
+{
+  SCM_VALIDATE_PROGRAM (1, program);
+  return scm_c_program_source (program, scm_to_size_t (ip));
+}
+#undef FUNC_NAME
+    
+extern SCM
+scm_c_program_source (SCM program, size_t ip)
+{
+  SCM sources, source = SCM_BOOL_F;
+
+  for (sources = scm_program_sources (program);
+       !scm_is_null (sources)
+         && scm_to_size_t (scm_caar (sources)) <= ip;
+       sources = scm_cdr (sources))
+    source = scm_car (sources);
+  
+  return source; /* (addr . (filename . (line . column))) */
+}
+
+SCM_DEFINE (scm_program_free_variables, "program-free-variables", 1, 0, 0,
+	    (SCM program),
+	    "")
+#define FUNC_NAME s_scm_program_free_variables
+{
+  SCM_VALIDATE_PROGRAM (1, program);
+  return SCM_PROGRAM_FREE_VARIABLES (program);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_program_objcode, "program-objcode", 1, 0, 0,
+	    (SCM program),
+	    "Return a @var{program}'s object code.")
+#define FUNC_NAME s_scm_program_objcode
+{
+  SCM_VALIDATE_PROGRAM (1, program);
+
+  return SCM_PROGRAM_OBJCODE (program);
+}
+#undef FUNC_NAME
+
+
+
+void
+scm_bootstrap_programs (void)
+{
+  scm_c_register_extension ("libguile", "scm_init_programs",
+                            (scm_t_extension_init_func)scm_init_programs, NULL);
+}
+
+void
+scm_init_programs (void)
+{
+  scm_bootstrap_vm ();
+  
+#ifndef SCM_MAGIC_SNARFER
+#include "libguile/programs.x"
+#endif
+}
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/programs.h b/libguile/programs.h
new file mode 100644
index 000000000..d52631fbb
--- /dev/null
+++ b/libguile/programs.h
@@ -0,0 +1,68 @@
+/* Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+ * 
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+#ifndef _SCM_PROGRAMS_H_
+#define _SCM_PROGRAMS_H_
+
+#include <libguile.h>
+#include <libguile/objcodes.h>
+
+/*
+ * Programs
+ */
+
+#define SCM_F_PROGRAM_IS_BOOT (1<<16)
+
+#define SCM_PROGRAM_P(x)	(!SCM_IMP (x) && SCM_TYP7(x) == scm_tc7_program)
+#define SCM_PROGRAM_OBJCODE(x)	(SCM_CELL_OBJECT_1 (x))
+#define SCM_PROGRAM_OBJTABLE(x)	(SCM_CELL_OBJECT_2 (x))
+#define SCM_PROGRAM_FREE_VARIABLES(x) (SCM_CELL_OBJECT_3 (x))
+#define SCM_PROGRAM_DATA(x)	(SCM_OBJCODE_DATA (SCM_PROGRAM_OBJCODE (x)))
+#define SCM_VALIDATE_PROGRAM(p,x) SCM_MAKE_VALIDATE (p, x, PROGRAM_P)
+#define SCM_PROGRAM_IS_BOOT(x)	(SCM_CELL_WORD_0 (x) & SCM_F_PROGRAM_IS_BOOT)
+
+SCM_API SCM scm_make_program (SCM objcode, SCM objtable, SCM free_variables);
+
+SCM_API SCM scm_program_p (SCM obj);
+SCM_API SCM scm_program_base (SCM program);
+SCM_API SCM scm_program_arity (SCM program);
+SCM_API SCM scm_program_meta (SCM program);
+SCM_API SCM scm_program_bindings (SCM program);
+SCM_API SCM scm_program_sources (SCM program);
+SCM_API SCM scm_program_source (SCM program, SCM ip);
+SCM_API SCM scm_program_properties (SCM program);
+SCM_API SCM scm_program_name (SCM program);
+SCM_API SCM scm_program_objects (SCM program);
+SCM_API SCM scm_program_module (SCM program);
+SCM_API SCM scm_program_free_variables (SCM program);
+SCM_API SCM scm_program_objcode (SCM program);
+
+SCM_API SCM scm_c_program_source (SCM program, size_t ip);
+
+SCM_INTERNAL void scm_i_program_print (SCM program, SCM port,
+                                       scm_print_state *pstate);
+SCM_INTERNAL void scm_bootstrap_programs (void);
+SCM_INTERNAL void scm_init_programs (void);
+
+#endif /* _SCM_PROGRAMS_H_ */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/properties.c b/libguile/properties.c
index 321dc9ec4..60ff2ff65 100644
--- a/libguile/properties.c
+++ b/libguile/properties.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1995,1996,2000,2001, 2003, 2006, 2008 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/properties.h b/libguile/properties.h
index 54feb01d9..efeaf3a59 100644
--- a/libguile/properties.h
+++ b/libguile/properties.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,1998,2000, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/pthread-threads.h b/libguile/pthread-threads.h
index bd6d4854d..4f72a4293 100644
--- a/libguile/pthread-threads.h
+++ b/libguile/pthread-threads.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 2002, 2005, 2006 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/putenv.c b/libguile/putenv.c
index 0ff33592a..cdc05dd7e 100644
--- a/libguile/putenv.c
+++ b/libguile/putenv.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1991, 2000, 2001, 2004, 2005, 2006 Free Software Foundation, Inc.
 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c
new file mode 100644
index 000000000..6ad320af4
--- /dev/null
+++ b/libguile/r6rs-ports.c
@@ -0,0 +1,1076 @@
+/* Copyright (C) 2009 Free Software Foundation, Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#ifdef HAVE_UNISTD_H
+# include <unistd.h>
+#endif
+
+#include <string.h>
+#include <stdio.h>
+#include <assert.h>
+
+#include "libguile/_scm.h"
+#include "libguile/bytevectors.h"
+#include "libguile/chars.h"
+#include "libguile/eval.h"
+#include "libguile/r6rs-ports.h"
+#include "libguile/strings.h"
+#include "libguile/validate.h"
+#include "libguile/values.h"
+#include "libguile/vectors.h"
+
+
+
+/* Unimplemented features.  */
+
+
+/* Transoders are currently not implemented since Guile 1.8 is not
+   Unicode-capable.  Thus, most of the code here assumes the use of the
+   binary transcoder.  */
+static inline void
+transcoders_not_implemented (void)
+{
+  fprintf (stderr, "%s: warning: transcoders not implemented\n",
+	   PACKAGE_NAME);
+}
+
+
+/* End-of-file object.  */
+
+SCM_DEFINE (scm_eof_object, "eof-object", 0, 0, 0,
+	    (void),
+	    "Return the end-of-file object.")
+#define FUNC_NAME s_scm_eof_object
+{
+  return (SCM_EOF_VAL);
+}
+#undef FUNC_NAME
+
+
+/* Input ports.  */
+
+#ifndef MIN
+# define MIN(a,b) ((a) < (b) ? (a) : (b))
+#endif
+
+/* Bytevector input ports or "bip" for short.  */
+static scm_t_bits bytevector_input_port_type = 0;
+
+static inline SCM
+make_bip (SCM bv)
+{
+  SCM port;
+  char *c_bv;
+  unsigned c_len;
+  scm_t_port *c_port;
+  const unsigned long mode_bits = SCM_OPN | SCM_RDNG;
+
+  port = scm_new_port_table_entry (bytevector_input_port_type);
+
+  /* Prevent BV from being GC'd.  */
+  SCM_SETSTREAM (port, SCM_UNPACK (bv));
+
+  /* Have the port directly access the bytevector.  */
+  c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);
+  c_len = SCM_BYTEVECTOR_LENGTH (bv);
+
+  c_port = SCM_PTAB_ENTRY (port);
+  c_port->read_pos = c_port->read_buf = (unsigned char *) c_bv;
+  c_port->read_end = (unsigned char *) c_bv + c_len;
+  c_port->read_buf_size = c_len;
+
+  /* Mark PORT as open, readable and unbuffered (hmm, how elegant...).  */
+  SCM_SET_CELL_TYPE (port, bytevector_input_port_type | mode_bits);
+
+  return port;
+}
+
+static int
+bip_fill_input (SCM port)
+{
+  int result;
+  scm_t_port *c_port = SCM_PTAB_ENTRY (port);
+
+  if (c_port->read_pos >= c_port->read_end)
+    result = EOF;
+  else
+    result = (int) *c_port->read_pos;
+
+  return result;
+}
+
+static scm_t_off
+bip_seek (SCM port, scm_t_off offset, int whence)
+#define FUNC_NAME "bip_seek"
+{
+  scm_t_off c_result = 0;
+  scm_t_port *c_port = SCM_PTAB_ENTRY (port);
+
+  switch (whence)
+    {
+    case SEEK_CUR:
+      offset += c_port->read_pos - c_port->read_buf;
+      /* Fall through.  */
+
+    case SEEK_SET:
+      if (c_port->read_buf + offset < c_port->read_end)
+	{
+	  c_port->read_pos = c_port->read_buf + offset;
+	  c_result = offset;
+	}
+      else
+	scm_out_of_range (FUNC_NAME, scm_from_int (offset));
+      break;
+
+    case SEEK_END:
+      if (c_port->read_end - offset >= c_port->read_buf)
+	{
+	  c_port->read_pos = c_port->read_end - offset;
+	  c_result = c_port->read_pos - c_port->read_buf;
+	}
+      else
+	scm_out_of_range (FUNC_NAME, scm_from_int (offset));
+      break;
+
+    default:
+      scm_wrong_type_arg_msg (FUNC_NAME, 0, port,
+			      "invalid `seek' parameter");
+    }
+
+  return c_result;
+}
+#undef FUNC_NAME
+
+
+/* Instantiate the bytevector input port type.  */
+static inline void
+initialize_bytevector_input_ports (void)
+{
+  bytevector_input_port_type =
+    scm_make_port_type ("r6rs-bytevector-input-port", bip_fill_input,
+			NULL);
+
+  scm_set_port_seek (bytevector_input_port_type, bip_seek);
+}
+
+
+SCM_DEFINE (scm_open_bytevector_input_port,
+	    "open-bytevector-input-port", 1, 1, 0,
+	    (SCM bv, SCM transcoder),
+	    "Return an input port whose contents are drawn from "
+	    "bytevector @var{bv}.")
+#define FUNC_NAME s_scm_open_bytevector_input_port
+{
+  SCM_VALIDATE_BYTEVECTOR (1, bv);
+  if (!SCM_UNBNDP (transcoder) && !scm_is_false (transcoder))
+    transcoders_not_implemented ();
+
+  return (make_bip (bv));
+}
+#undef FUNC_NAME
+
+
+/* Custom binary ports.  The following routines are shared by input and
+   output custom binary ports.  */
+
+#define SCM_CBP_GET_POSITION_PROC(_port)			\
+  SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 1)
+#define SCM_CBP_SET_POSITION_PROC(_port)			\
+  SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 2)
+#define SCM_CBP_CLOSE_PROC(_port)				\
+  SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 3)
+
+static scm_t_off
+cbp_seek (SCM port, scm_t_off offset, int whence)
+#define FUNC_NAME "cbp_seek"
+{
+  SCM result;
+  scm_t_off c_result = 0;
+
+  switch (whence)
+    {
+    case SEEK_CUR:
+      {
+	SCM get_position_proc;
+
+	get_position_proc = SCM_CBP_GET_POSITION_PROC (port);
+	if (SCM_LIKELY (scm_is_true (get_position_proc)))
+	  result = scm_call_0 (get_position_proc);
+	else
+	  scm_wrong_type_arg_msg (FUNC_NAME, 0, port,
+				  "R6RS custom binary port does not "
+				  "support `port-position'");
+
+	offset += scm_to_int (result);
+	/* Fall through.  */
+      }
+
+    case SEEK_SET:
+      {
+	SCM set_position_proc;
+
+	set_position_proc = SCM_CBP_SET_POSITION_PROC (port);
+	if (SCM_LIKELY (scm_is_true (set_position_proc)))
+	  result = scm_call_1 (set_position_proc, scm_from_int (offset));
+	else
+	  scm_wrong_type_arg_msg (FUNC_NAME, 0, port,
+				  "R6RS custom binary port does not "
+				  "support `set-port-position!'");
+
+	/* Assuming setting the position succeeded.  */
+	c_result = offset;
+	break;
+      }
+
+    default:
+      /* `SEEK_END' cannot be supported.  */
+      scm_wrong_type_arg_msg (FUNC_NAME, 0, port,
+			      "R6RS custom binary ports do not "
+			      "support `SEEK_END'");
+    }
+
+  return c_result;
+}
+#undef FUNC_NAME
+
+static int
+cbp_close (SCM port)
+{
+  SCM close_proc;
+
+  close_proc = SCM_CBP_CLOSE_PROC (port);
+  if (scm_is_true (close_proc))
+    /* Invoke the `close' thunk.  */
+    scm_call_0 (close_proc);
+
+  return 1;
+}
+
+
+/* Custom binary input port ("cbip" for short).  */
+
+static scm_t_bits custom_binary_input_port_type = 0;
+
+/* Size of the buffer embedded in custom binary input ports.  */
+#define CBIP_BUFFER_SIZE  4096
+
+/* Return the bytevector associated with PORT.  */
+#define SCM_CBIP_BYTEVECTOR(_port)				\
+  SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 4)
+
+/* Return the various procedures of PORT.  */
+#define SCM_CBIP_READ_PROC(_port)				\
+  SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 0)
+
+
+static inline SCM
+make_cbip (SCM read_proc, SCM get_position_proc,
+	   SCM set_position_proc, SCM close_proc)
+{
+  SCM port, bv, method_vector;
+  char *c_bv;
+  unsigned c_len;
+  scm_t_port *c_port;
+  const unsigned long mode_bits = SCM_OPN | SCM_RDNG;
+
+  /* Use a bytevector as the underlying buffer.  */
+  c_len = CBIP_BUFFER_SIZE;
+  bv = scm_c_make_bytevector (c_len);
+  c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);
+
+  /* Store the various methods and bytevector in a vector.  */
+  method_vector = scm_c_make_vector (5, SCM_BOOL_F);
+  SCM_SIMPLE_VECTOR_SET (method_vector, 4, bv);
+  SCM_SIMPLE_VECTOR_SET (method_vector, 0, read_proc);
+  SCM_SIMPLE_VECTOR_SET (method_vector, 1, get_position_proc);
+  SCM_SIMPLE_VECTOR_SET (method_vector, 2, set_position_proc);
+  SCM_SIMPLE_VECTOR_SET (method_vector, 3, close_proc);
+
+  port = scm_new_port_table_entry (custom_binary_input_port_type);
+
+  /* Attach it the method vector.  */
+  SCM_SETSTREAM (port, SCM_UNPACK (method_vector));
+
+  /* Have the port directly access the buffer (bytevector).  */
+  c_port = SCM_PTAB_ENTRY (port);
+  c_port->read_pos = c_port->read_buf = (unsigned char *) c_bv;
+  c_port->read_end = (unsigned char *) c_bv;
+  c_port->read_buf_size = c_len;
+
+  /* Mark PORT as open, readable and unbuffered (hmm, how elegant...).  */
+  SCM_SET_CELL_TYPE (port, custom_binary_input_port_type | mode_bits);
+
+  return port;
+}
+
+static int
+cbip_fill_input (SCM port)
+#define FUNC_NAME "cbip_fill_input"
+{
+  int result;
+  scm_t_port *c_port = SCM_PTAB_ENTRY (port);
+
+ again:
+  if (c_port->read_pos >= c_port->read_end)
+    {
+      /* Invoke the user's `read!' procedure.  */
+      unsigned c_octets;
+      SCM bv, read_proc, octets;
+
+      /* Use the bytevector associated with PORT as the buffer passed to the
+	 `read!' procedure, thereby avoiding additional allocations.  */
+      bv = SCM_CBIP_BYTEVECTOR (port);
+      read_proc = SCM_CBIP_READ_PROC (port);
+
+      /* The assumption here is that C_PORT's internal buffer wasn't changed
+	 behind our back.  */
+      assert (c_port->read_buf ==
+	      (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv));
+      assert ((unsigned) c_port->read_buf_size
+	      == SCM_BYTEVECTOR_LENGTH (bv));
+
+      octets = scm_call_3 (read_proc, bv, SCM_INUM0,
+			   SCM_I_MAKINUM (CBIP_BUFFER_SIZE));
+      c_octets = scm_to_uint (octets);
+
+      c_port->read_pos = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
+      c_port->read_end = (unsigned char *) c_port->read_pos + c_octets;
+
+      if (c_octets > 0)
+	goto again;
+      else
+	result = EOF;
+    }
+  else
+    result = (int) *c_port->read_pos;
+
+  return result;
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_make_custom_binary_input_port,
+	    "make-custom-binary-input-port", 5, 0, 0,
+	    (SCM id, SCM read_proc, SCM get_position_proc,
+	     SCM set_position_proc, SCM close_proc),
+	    "Return a new custom binary input port whose input is drained "
+	    "by invoking @var{read_proc} and passing it a bytevector, an "
+	    "index where octets should be written, and an octet count.")
+#define FUNC_NAME s_scm_make_custom_binary_input_port
+{
+  SCM_VALIDATE_STRING (1, id);
+  SCM_VALIDATE_PROC (2, read_proc);
+
+  if (!scm_is_false (get_position_proc))
+    SCM_VALIDATE_PROC (3, get_position_proc);
+
+  if (!scm_is_false (set_position_proc))
+    SCM_VALIDATE_PROC (4, set_position_proc);
+
+  if (!scm_is_false (close_proc))
+    SCM_VALIDATE_PROC (5, close_proc);
+
+  return (make_cbip (read_proc, get_position_proc, set_position_proc,
+		     close_proc));
+}
+#undef FUNC_NAME
+
+
+/* Instantiate the custom binary input port type.  */
+static inline void
+initialize_custom_binary_input_ports (void)
+{
+  custom_binary_input_port_type =
+    scm_make_port_type ("r6rs-custom-binary-input-port",
+			cbip_fill_input, NULL);
+
+  scm_set_port_seek (custom_binary_input_port_type, cbp_seek);
+  scm_set_port_close (custom_binary_input_port_type, cbp_close);
+}
+
+
+
+/* Binary input.  */
+
+/* We currently don't support specific binary input ports.  */
+#define SCM_VALIDATE_BINARY_INPUT_PORT SCM_VALIDATE_OPINPORT
+
+SCM_DEFINE (scm_get_u8, "get-u8", 1, 0, 0,
+	    (SCM port),
+	    "Read an octet from @var{port}, a binary input port, "
+	    "blocking as necessary.")
+#define FUNC_NAME s_scm_get_u8
+{
+  SCM result;
+  int c_result;
+
+  SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
+
+  c_result = scm_getc (port);
+  if (c_result == EOF)
+    result = SCM_EOF_VAL;
+  else
+    result = SCM_I_MAKINUM ((unsigned char) c_result);
+
+  return result;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_lookahead_u8, "lookahead-u8", 1, 0, 0,
+	    (SCM port),
+	    "Like @code{get-u8} but does not update @var{port} to "
+	    "point past the octet.")
+#define FUNC_NAME s_scm_lookahead_u8
+{
+  SCM result;
+
+  SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
+
+  result = scm_peek_char (port);
+  if (SCM_CHARP (result))
+    result = SCM_I_MAKINUM ((signed char) SCM_CHAR (result));
+  else
+    result = SCM_EOF_VAL;
+
+  return result;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_get_bytevector_n, "get-bytevector-n", 2, 0, 0,
+	    (SCM port, SCM count),
+	    "Read @var{count} octets from @var{port}, blocking as "
+	    "necessary and return a bytevector containing the octets "
+	    "read.  If fewer bytes are available, a bytevector smaller "
+	    "than @var{count} is returned.")
+#define FUNC_NAME s_scm_get_bytevector_n
+{
+  SCM result;
+  char *c_bv;
+  unsigned c_count;
+  size_t c_read;
+
+  SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
+  c_count = scm_to_uint (count);
+
+  result = scm_c_make_bytevector (c_count);
+  c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (result);
+
+  if (SCM_LIKELY (c_count > 0))
+    /* XXX: `scm_c_read ()' does not update the port position.  */
+    c_read = scm_c_read (port, c_bv, c_count);
+  else
+    /* Don't invoke `scm_c_read ()' since it may block.  */
+    c_read = 0;
+
+  if ((c_read == 0) && (c_count > 0))
+    {
+      if (SCM_EOF_OBJECT_P (scm_peek_char (port)))
+	result = SCM_EOF_VAL;
+      else
+	result = scm_null_bytevector;
+    }
+  else
+    {
+      if (c_read < c_count)
+	result = scm_c_shrink_bytevector (result, c_read);
+    }
+
+  return result;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_get_bytevector_n_x, "get-bytevector-n!", 4, 0, 0,
+	    (SCM port, SCM bv, SCM start, SCM count),
+	    "Read @var{count} bytes from @var{port} and store them "
+	    "in @var{bv} starting at index @var{start}.  Return either "
+	    "the number of bytes actually read or the end-of-file "
+	    "object.")
+#define FUNC_NAME s_scm_get_bytevector_n_x
+{
+  SCM result;
+  char *c_bv;
+  unsigned c_start, c_count, c_len;
+  size_t c_read;
+
+  SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
+  SCM_VALIDATE_BYTEVECTOR (2, bv);
+  c_start = scm_to_uint (start);
+  c_count = scm_to_uint (count);
+
+  c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);
+  c_len = SCM_BYTEVECTOR_LENGTH (bv);
+
+  if (SCM_UNLIKELY (c_start + c_count > c_len))
+    scm_out_of_range (FUNC_NAME, count);
+
+  if (SCM_LIKELY (c_count > 0))
+    c_read = scm_c_read (port, c_bv + c_start, c_count);
+  else
+    /* Don't invoke `scm_c_read ()' since it may block.  */
+    c_read = 0;
+
+  if ((c_read == 0) && (c_count > 0))
+    {
+      if (SCM_EOF_OBJECT_P (scm_peek_char (port)))
+	result = SCM_EOF_VAL;
+      else
+	result = SCM_I_MAKINUM (0);
+    }
+  else
+    result = scm_from_size_t (c_read);
+
+  return result;
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_get_bytevector_some, "get-bytevector-some", 1, 0, 0,
+	    (SCM port),
+	    "Read from @var{port}, blocking as necessary, until data "
+	    "are available or and end-of-file is reached.  Return either "
+	    "a new bytevector containing the data read or the "
+	    "end-of-file object.")
+#define FUNC_NAME s_scm_get_bytevector_some
+{
+  /* Read at least one byte, unless the end-of-file is already reached, and
+     read while characters are available (buffered).  */
+
+  SCM result;
+  char *c_bv;
+  unsigned c_len;
+  size_t c_total;
+
+  SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
+
+  c_len = 4096;
+  c_bv = (char *) scm_gc_malloc_pointerless (c_len, SCM_GC_BYTEVECTOR);
+  c_total = 0;
+
+  do
+    {
+      int c_chr;
+
+      if (c_total + 1 > c_len)
+	{
+	  /* Grow the bytevector.  */
+	  c_bv = (char *) scm_gc_realloc (c_bv, c_len, c_len * 2,
+					  SCM_GC_BYTEVECTOR);
+	  c_len *= 2;
+	}
+
+      /* We can't use `scm_c_read ()' since it blocks.  */
+      c_chr = scm_getc (port);
+      if (c_chr != EOF)
+	{
+	  c_bv[c_total] = (char) c_chr;
+	  c_total++;
+	}
+    }
+  while ((scm_is_true (scm_char_ready_p (port)))
+	 && (!SCM_EOF_OBJECT_P (scm_peek_char (port))));
+
+  if (c_total == 0)
+    {
+      result = SCM_EOF_VAL;
+      scm_gc_free (c_bv, c_len, SCM_GC_BYTEVECTOR);
+    }
+  else
+    {
+      if (c_len > c_total)
+	{
+	  /* Shrink the bytevector.  */
+	  c_bv = (char *) scm_gc_realloc (c_bv, c_len, c_total,
+					  SCM_GC_BYTEVECTOR);
+	  c_len = (unsigned) c_total;
+	}
+
+      result = scm_c_take_bytevector ((signed char *) c_bv, c_len);
+    }
+
+  return result;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_get_bytevector_all, "get-bytevector-all", 1, 0, 0,
+	    (SCM port),
+	    "Read from @var{port}, blocking as necessary, until "
+	    "the end-of-file is reached.  Return either "
+	    "a new bytevector containing the data read or the "
+	    "end-of-file object (if no data were available).")
+#define FUNC_NAME s_scm_get_bytevector_all
+{
+  SCM result;
+  char *c_bv;
+  unsigned c_len, c_count;
+  size_t c_read, c_total;
+
+  SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
+
+  c_len = c_count = 4096;
+  c_bv = (char *) scm_gc_malloc_pointerless (c_len, SCM_GC_BYTEVECTOR);
+  c_total = c_read = 0;
+
+  do
+    {
+      if (c_total + c_read > c_len)
+	{
+	  /* Grow the bytevector.  */
+	  c_bv = (char *) scm_gc_realloc (c_bv, c_len, c_len * 2,
+					  SCM_GC_BYTEVECTOR);
+	  c_count = c_len;
+	  c_len *= 2;
+	}
+
+      /* `scm_c_read ()' blocks until C_COUNT bytes are available or EOF is
+	 reached.  */
+      c_read = scm_c_read (port, c_bv + c_total, c_count);
+      c_total += c_read, c_count -= c_read;
+    }
+  while (!SCM_EOF_OBJECT_P (scm_peek_char (port)));
+
+  if (c_total == 0)
+    {
+      result = SCM_EOF_VAL;
+      scm_gc_free (c_bv, c_len, SCM_GC_BYTEVECTOR);
+    }
+  else
+    {
+      if (c_len > c_total)
+	{
+	  /* Shrink the bytevector.  */
+	  c_bv = (char *) scm_gc_realloc (c_bv, c_len, c_total,
+					  SCM_GC_BYTEVECTOR);
+	  c_len = (unsigned) c_total;
+	}
+
+      result = scm_c_take_bytevector ((signed char *) c_bv, c_len);
+    }
+
+  return result;
+}
+#undef FUNC_NAME
+
+
+
+/* Binary output.  */
+
+/* We currently don't support specific binary input ports.  */
+#define SCM_VALIDATE_BINARY_OUTPUT_PORT SCM_VALIDATE_OPOUTPORT
+
+
+SCM_DEFINE (scm_put_u8, "put-u8", 2, 0, 0,
+	    (SCM port, SCM octet),
+	    "Write @var{octet} to binary port @var{port}.")
+#define FUNC_NAME s_scm_put_u8
+{
+  scm_t_uint8 c_octet;
+
+  SCM_VALIDATE_BINARY_OUTPUT_PORT (1, port);
+  c_octet = scm_to_uint8 (octet);
+
+  scm_putc ((char) c_octet, port);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_put_bytevector, "put-bytevector", 2, 2, 0,
+	    (SCM port, SCM bv, SCM start, SCM count),
+	    "Write the contents of @var{bv} to @var{port}, optionally "
+	    "starting at index @var{start} and limiting to @var{count} "
+	    "octets.")
+#define FUNC_NAME s_scm_put_bytevector
+{
+  char *c_bv;
+  unsigned c_start, c_count, c_len;
+
+  SCM_VALIDATE_BINARY_OUTPUT_PORT (1, port);
+  SCM_VALIDATE_BYTEVECTOR (2, bv);
+
+  c_len = SCM_BYTEVECTOR_LENGTH (bv);
+  c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);
+
+  if (start != SCM_UNDEFINED)
+    {
+      c_start = scm_to_uint (start);
+
+      if (count != SCM_UNDEFINED)
+	{
+	  c_count = scm_to_uint (count);
+	  if (SCM_UNLIKELY (c_start + c_count > c_len))
+	    scm_out_of_range (FUNC_NAME, count);
+	}
+      else
+	{
+	  if (SCM_UNLIKELY (c_start >= c_len))
+	    scm_out_of_range (FUNC_NAME, start);
+	  else
+	    c_count = c_len - c_start;
+	}
+    }
+  else
+    c_start = 0, c_count = c_len;
+
+  scm_c_write (port, c_bv + c_start, c_count);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
+
+/* Bytevector output port ("bop" for short).  */
+
+/* Implementation of "bops".
+
+   Each bop has an internal buffer, of type `scm_t_bop_buffer', attached to
+   it.  The procedure returned along with the output port is actually an
+   applicable SMOB.  The SMOB holds a reference to the port.  When applied,
+   the SMOB swallows the port's internal buffer, turning it into a
+   bytevector, and resets it.
+
+   XXX: Access to a bop's internal buffer is not thread-safe.  */
+
+static scm_t_bits bytevector_output_port_type = 0;
+
+SCM_SMOB (bytevector_output_port_procedure,
+	  "r6rs-bytevector-output-port-procedure",
+	  0);
+
+#define SCM_GC_BOP "r6rs-bytevector-output-port"
+#define SCM_BOP_BUFFER_INITIAL_SIZE 4096
+
+/* Representation of a bop's internal buffer.  */
+typedef struct
+{
+  size_t total_len;
+  size_t len;
+  size_t pos;
+  char  *buffer;
+} scm_t_bop_buffer;
+
+
+/* Accessing a bop's buffer.  */
+#define SCM_BOP_BUFFER(_port)		\
+  ((scm_t_bop_buffer *) SCM_STREAM (_port))
+#define SCM_SET_BOP_BUFFER(_port, _buf)		\
+  (SCM_SETSTREAM ((_port), (scm_t_bits) (_buf)))
+
+
+static inline void
+bop_buffer_init (scm_t_bop_buffer *buf)
+{
+  buf->total_len = buf->len = buf->pos = 0;
+  buf->buffer = NULL;
+}
+
+static inline void
+bop_buffer_grow (scm_t_bop_buffer *buf, size_t min_size)
+{
+  char *new_buf;
+  size_t new_size;
+
+  for (new_size = buf->total_len
+	 ? buf->total_len : SCM_BOP_BUFFER_INITIAL_SIZE;
+       new_size < min_size;
+       new_size *= 2);
+
+  if (buf->buffer)
+    new_buf = scm_gc_realloc ((void *) buf->buffer, buf->total_len,
+			      new_size, SCM_GC_BOP);
+  else
+    new_buf = scm_gc_malloc_pointerless (new_size, SCM_GC_BOP);
+
+  buf->buffer = new_buf;
+  buf->total_len = new_size;
+}
+
+static inline SCM
+make_bop (void)
+{
+  SCM port, bop_proc;
+  scm_t_port *c_port;
+  scm_t_bop_buffer *buf;
+  const unsigned long mode_bits = SCM_OPN | SCM_WRTNG;
+
+  port = scm_new_port_table_entry (bytevector_output_port_type);
+
+  buf = (scm_t_bop_buffer *) scm_gc_malloc (sizeof (* buf), SCM_GC_BOP);
+  bop_buffer_init (buf);
+
+  c_port = SCM_PTAB_ENTRY (port);
+  c_port->write_buf = c_port->write_pos = c_port->write_end = NULL;
+  c_port->write_buf_size = 0;
+
+  SCM_SET_BOP_BUFFER (port, buf);
+
+  /* Mark PORT as open and writable.  */
+  SCM_SET_CELL_TYPE (port, bytevector_output_port_type | mode_bits);
+
+  /* Make the bop procedure.  */
+  SCM_NEWSMOB (bop_proc, bytevector_output_port_procedure,
+	       SCM_PACK (port));
+
+  return (scm_values (scm_list_2 (port, bop_proc)));
+}
+
+/* Write SIZE octets from DATA to PORT.  */
+static void
+bop_write (SCM port, const void *data, size_t size)
+{
+  scm_t_bop_buffer *buf;
+
+  buf = SCM_BOP_BUFFER (port);
+
+  if (buf->pos + size > buf->total_len)
+    bop_buffer_grow (buf, buf->pos + size);
+
+  memcpy (buf->buffer + buf->pos, data, size);
+  buf->pos += size;
+  buf->len = (buf->len > buf->pos) ? buf->len : buf->pos;
+}
+
+static scm_t_off
+bop_seek (SCM port, scm_t_off offset, int whence)
+#define FUNC_NAME "bop_seek"
+{
+  scm_t_bop_buffer *buf;
+
+  buf = SCM_BOP_BUFFER (port);
+  switch (whence)
+    {
+    case SEEK_CUR:
+      offset += (scm_t_off) buf->pos;
+      /* Fall through.  */
+
+    case SEEK_SET:
+      if (offset < 0 || (unsigned) offset > buf->len)
+	scm_out_of_range (FUNC_NAME, scm_from_int (offset));
+      else
+	buf->pos = offset;
+      break;
+
+    case SEEK_END:
+      if (offset < 0 || (unsigned) offset >= buf->len)
+	scm_out_of_range (FUNC_NAME, scm_from_int (offset));
+      else
+	buf->pos = buf->len - (offset + 1);
+      break;
+
+    default:
+      scm_wrong_type_arg_msg (FUNC_NAME, 0, port,
+			      "invalid `seek' parameter");
+    }
+
+  return buf->pos;
+}
+#undef FUNC_NAME
+
+/* Fetch data from a bop.  */
+SCM_SMOB_APPLY (bytevector_output_port_procedure,
+		bop_proc_apply, 0, 0, 0, (SCM bop_proc))
+{
+  SCM port, bv;
+  scm_t_bop_buffer *buf, result_buf;
+
+  port = SCM_PACK (SCM_SMOB_DATA (bop_proc));
+  buf = SCM_BOP_BUFFER (port);
+
+  result_buf = *buf;
+  bop_buffer_init (buf);
+
+  if (result_buf.len == 0)
+    bv = scm_c_take_bytevector (NULL, 0);
+  else
+    {
+      if (result_buf.total_len > result_buf.len)
+	/* Shrink the buffer.  */
+	result_buf.buffer = scm_gc_realloc ((void *) result_buf.buffer,
+					    result_buf.total_len,
+					    result_buf.len,
+					    SCM_GC_BOP);
+
+      bv = scm_c_take_bytevector ((signed char *) result_buf.buffer,
+				       result_buf.len);
+    }
+
+  return bv;
+}
+
+SCM_DEFINE (scm_open_bytevector_output_port,
+	    "open-bytevector-output-port", 0, 1, 0,
+	    (SCM transcoder),
+	    "Return two values: an output port and a procedure.  The latter "
+	    "should be called with zero arguments to obtain a bytevector "
+	    "containing the data accumulated by the port.")
+#define FUNC_NAME s_scm_open_bytevector_output_port
+{
+  if (!SCM_UNBNDP (transcoder) && !scm_is_false (transcoder))
+    transcoders_not_implemented ();
+
+  return (make_bop ());
+}
+#undef FUNC_NAME
+
+static inline void
+initialize_bytevector_output_ports (void)
+{
+  bytevector_output_port_type =
+    scm_make_port_type ("r6rs-bytevector-output-port",
+			NULL, bop_write);
+
+  scm_set_port_seek (bytevector_output_port_type, bop_seek);
+}
+
+
+/* Custom binary output port ("cbop" for short).  */
+
+static scm_t_bits custom_binary_output_port_type;
+
+/* Return the various procedures of PORT.  */
+#define SCM_CBOP_WRITE_PROC(_port)				\
+  SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 0)
+
+
+static inline SCM
+make_cbop (SCM write_proc, SCM get_position_proc,
+	   SCM set_position_proc, SCM close_proc)
+{
+  SCM port, method_vector;
+  scm_t_port *c_port;
+  const unsigned long mode_bits = SCM_OPN | SCM_WRTNG;
+
+  /* Store the various methods and bytevector in a vector.  */
+  method_vector = scm_c_make_vector (4, SCM_BOOL_F);
+  SCM_SIMPLE_VECTOR_SET (method_vector, 0, write_proc);
+  SCM_SIMPLE_VECTOR_SET (method_vector, 1, get_position_proc);
+  SCM_SIMPLE_VECTOR_SET (method_vector, 2, set_position_proc);
+  SCM_SIMPLE_VECTOR_SET (method_vector, 3, close_proc);
+
+  port = scm_new_port_table_entry (custom_binary_output_port_type);
+
+  /* Attach it the method vector.  */
+  SCM_SETSTREAM (port, SCM_UNPACK (method_vector));
+
+  /* Have the port directly access the buffer (bytevector).  */
+  c_port = SCM_PTAB_ENTRY (port);
+  c_port->write_buf = c_port->write_pos = c_port->write_end = NULL;
+  c_port->write_buf_size = c_port->read_buf_size = 0;
+
+  /* Mark PORT as open, writable and unbuffered.  */
+  SCM_SET_CELL_TYPE (port, custom_binary_output_port_type | mode_bits);
+
+  return port;
+}
+
+/* Write SIZE octets from DATA to PORT.  */
+static void
+cbop_write (SCM port, const void *data, size_t size)
+#define FUNC_NAME "cbop_write"
+{
+  long int c_result;
+  size_t c_written;
+  SCM bv, write_proc, result;
+
+  /* XXX: Allocating a new bytevector at each `write' call is inefficient,
+     but necessary since (1) we don't control the lifetime of the buffer
+     pointed to by DATA, and (2) the `write!' procedure could capture the
+     bytevector it is passed.  */
+  bv = scm_c_make_bytevector (size);
+  memcpy (SCM_BYTEVECTOR_CONTENTS (bv), data, size);
+
+  write_proc = SCM_CBOP_WRITE_PROC (port);
+
+  /* Since the `write' procedure of Guile's ports has type `void', it must
+     try hard to write exactly SIZE bytes, regardless of how many bytes the
+     sink can handle.  */
+  for (c_written = 0;
+       c_written < size;
+       c_written += c_result)
+    {
+      result = scm_call_3 (write_proc, bv,
+			   scm_from_size_t (c_written),
+			   scm_from_size_t (size - c_written));
+
+      c_result = scm_to_long (result);
+      if (SCM_UNLIKELY (c_result < 0
+			|| (size_t) c_result > (size - c_written)))
+	scm_wrong_type_arg_msg (FUNC_NAME, 0, result,
+				"R6RS custom binary output port `write!' "
+				"returned a incorrect integer");
+    }
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_make_custom_binary_output_port,
+	    "make-custom-binary-output-port", 5, 0, 0,
+	    (SCM id, SCM write_proc, SCM get_position_proc,
+	     SCM set_position_proc, SCM close_proc),
+	    "Return a new custom binary output port whose output is drained "
+	    "by invoking @var{write_proc} and passing it a bytevector, an "
+	    "index where octets should be written, and an octet count.")
+#define FUNC_NAME s_scm_make_custom_binary_output_port
+{
+  SCM_VALIDATE_STRING (1, id);
+  SCM_VALIDATE_PROC (2, write_proc);
+
+  if (!scm_is_false (get_position_proc))
+    SCM_VALIDATE_PROC (3, get_position_proc);
+
+  if (!scm_is_false (set_position_proc))
+    SCM_VALIDATE_PROC (4, set_position_proc);
+
+  if (!scm_is_false (close_proc))
+    SCM_VALIDATE_PROC (5, close_proc);
+
+  return (make_cbop (write_proc, get_position_proc, set_position_proc,
+		     close_proc));
+}
+#undef FUNC_NAME
+
+
+/* Instantiate the custom binary output port type.  */
+static inline void
+initialize_custom_binary_output_ports (void)
+{
+  custom_binary_output_port_type =
+    scm_make_port_type ("r6rs-custom-binary-output-port",
+			NULL, cbop_write);
+
+  scm_set_port_seek (custom_binary_output_port_type, cbp_seek);
+  scm_set_port_close (custom_binary_output_port_type, cbp_close);
+}
+
+
+/* Initialization.  */
+
+void
+scm_init_r6rs_ports (void)
+{
+#include "libguile/r6rs-ports.x"
+
+  initialize_bytevector_input_ports ();
+  initialize_custom_binary_input_ports ();
+  initialize_bytevector_output_ports ();
+  initialize_custom_binary_output_ports ();
+}
diff --git a/libguile/r6rs-ports.h b/libguile/r6rs-ports.h
new file mode 100644
index 000000000..5e1707a88
--- /dev/null
+++ b/libguile/r6rs-ports.h
@@ -0,0 +1,44 @@
+#ifndef SCM_R6RS_PORTS_H
+#define SCM_R6RS_PORTS_H
+
+/* Copyright (C) 2009 Free Software Foundation, Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+
+
+#include "libguile/__scm.h"
+
+/* R6RS I/O Ports.  */
+
+SCM_API SCM scm_eof_object (void);
+SCM_API SCM scm_open_bytevector_input_port (SCM, SCM);
+SCM_API SCM scm_make_custom_binary_input_port (SCM, SCM, SCM, SCM, SCM);
+SCM_API SCM scm_get_u8 (SCM);
+SCM_API SCM scm_lookahead_u8 (SCM);
+SCM_API SCM scm_get_bytevector_n (SCM, SCM);
+SCM_API SCM scm_get_bytevector_n_x (SCM, SCM, SCM, SCM);
+SCM_API SCM scm_get_bytevector_some (SCM);
+SCM_API SCM scm_get_bytevector_all (SCM);
+SCM_API SCM scm_put_u8 (SCM, SCM);
+SCM_API SCM scm_put_bytevector (SCM, SCM, SCM, SCM);
+SCM_API SCM scm_open_bytevector_output_port (SCM);
+SCM_API SCM scm_make_custom_binary_output_port (SCM, SCM, SCM, SCM, SCM);
+
+SCM_API void scm_init_r6rs_ports (void);
+
+#endif /* SCM_R6RS_PORTS_H */
diff --git a/libguile/random.c b/libguile/random.c
index f5f706f85..281d43aa8 100644
--- a/libguile/random.c
+++ b/libguile/random.c
@@ -1,17 +1,18 @@
-/* Copyright (C) 1999,2000,2001, 2003, 2005, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1999,2000,2001, 2003, 2005, 2006, 2009 Free Software Foundation, Inc.
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -32,9 +33,10 @@
 #include "libguile/numbers.h"
 #include "libguile/feature.h"
 #include "libguile/strings.h"
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
 #include "libguile/srfi-4.h"
 #include "libguile/vectors.h"
+#include "libguile/generalized-vectors.h"
 
 #include "libguile/validate.h"
 #include "libguile/random.h"
diff --git a/libguile/random.h b/libguile/random.h
index ae44092ab..6cf404f8d 100644
--- a/libguile/random.h
+++ b/libguile/random.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1999,2000,2001, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/rdelim.c b/libguile/rdelim.c
index c9cc0164d..1f46e5bf0 100644
--- a/libguile/rdelim.c
+++ b/libguile/rdelim.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2006 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 #ifdef HAVE_CONFIG_H
@@ -58,12 +59,10 @@ SCM_DEFINE (scm_read_delimited_x, "%read-delimited!", 3, 3, 0,
   size_t j;
   size_t cstart;
   size_t cend;
-  int c;
-  const char *cdelims;
+  scm_t_wchar c;
   size_t num_delims;
 
   SCM_VALIDATE_STRING (1, delims);
-  cdelims = scm_i_string_chars (delims);
   num_delims = scm_i_string_length (delims);
 
   SCM_VALIDATE_STRING (2, str);
@@ -82,7 +81,7 @@ SCM_DEFINE (scm_read_delimited_x, "%read-delimited!", 3, 3, 0,
       c = scm_getc (port);
       for (k = 0; k < num_delims; k++)
 	{
-	  if (cdelims[k] == c)
+	  if (scm_i_string_ref (delims, k) == c)
 	    {
 	      if (scm_is_false (gobble))
 		scm_ungetc (c, port);
diff --git a/libguile/rdelim.h b/libguile/rdelim.h
index 17efb4fe5..2e401e4fe 100644
--- a/libguile/rdelim.h
+++ b/libguile/rdelim.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,1997,1998,2000,2001, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/read.c b/libguile/read.c
index 47b80041e..d91c868e1 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -1,19 +1,20 @@
-/* Copyright (C) 1995,1996,1997,1999,2000,2001,2003, 2004, 2006, 2007, 2008 Free Software
+/* Copyright (C) 1995,1996,1997,1999,2000,2001,2003, 2004, 2006, 2007, 2008, 2009 Free Software
  * Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -26,11 +27,15 @@
 #include <stdio.h>
 #include <ctype.h>
 #include <string.h>
+#include <unistd.h>
+#include <unicase.h>
 
 #include "libguile/_scm.h"
+#include "libguile/bytevectors.h"
 #include "libguile/chars.h"
 #include "libguile/eval.h"
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
+#include "libguile/bitvectors.h"
 #include "libguile/keywords.h"
 #include "libguile/alist.h"
 #include "libguile/srcprop.h"
@@ -175,52 +180,76 @@ static SCM *scm_read_hash_procedures;
   (((_chr) == 'e') || ((_chr) == 's') || ((_chr) == 'f')	\
    || ((_chr) == 'd') || ((_chr) == 'l'))
 
-/* An inlinable version of `scm_c_downcase ()'.  */
-#define CHAR_DOWNCASE(_chr)				\
-  (((_chr) <= UCHAR_MAX) ? tolower (_chr) : (_chr))
-
-
 /* Read an SCSH block comment.  */
 static inline SCM scm_read_scsh_block_comment (int chr, SCM port);
+static SCM scm_read_commented_expression (int chr, SCM port);
 
 /* Read from PORT until a delimiter (e.g., a whitespace) is read.  Return
    zero if the whole token fits in BUF, non-zero otherwise.  */
 static inline int
-read_token (SCM port, char *buf, size_t buf_size, size_t *read)
+read_token (SCM port, SCM buf, size_t *read)
 {
+  scm_t_wchar chr;
   *read = 0;
 
-  while (*read < buf_size)
+  buf = scm_i_string_start_writing (buf);
+  while (*read < scm_i_string_length (buf))
     {
-      int chr;
-
       chr = scm_getc (port);
-      chr = (SCM_CASE_INSENSITIVE_P ? CHAR_DOWNCASE (chr) : chr);
 
       if (chr == EOF)
-	return 0;
-      else if (CHAR_IS_DELIMITER (chr))
 	{
-	  scm_ungetc (chr, port);
+	  scm_i_string_stop_writing ();
 	  return 0;
 	}
-      else
+
+      chr = (SCM_CASE_INSENSITIVE_P ? uc_tolower (chr) : chr);
+
+      if (CHAR_IS_DELIMITER (chr))
 	{
-	  *buf = (char) chr;
-	  buf++, (*read)++;
+	  scm_i_string_stop_writing ();
+	  scm_ungetc (chr, port);
+	  return 0;
 	}
+
+      scm_i_string_set_x (buf, *read, chr);
+      (*read)++;
     }
+  scm_i_string_stop_writing ();
 
   return 1;
 }
 
+static SCM
+read_complete_token (SCM port, size_t *read)
+{
+  SCM buffer, str = SCM_EOL;
+  size_t len;
+  int overflow;
+
+  buffer = scm_i_make_string (READER_BUFFER_SIZE, NULL); 
+  overflow = read_token (port, buffer, read);
+  if (!overflow)
+    return scm_i_substring (buffer, 0, *read);
+
+  str = scm_string_copy (buffer);
+  do
+    {
+      overflow = read_token (port, buffer, &len);
+      str = scm_string_append (scm_list_2 (str, buffer));
+      *read += len;
+    }
+  while (overflow);
+
+  return scm_i_substring (str, 0, *read);
+}
 
 /* Skip whitespace from PORT and return the first non-whitespace character
    read.  Raise an error on end-of-file.  */
 static int
 flush_ws (SCM port, const char *eoferr)
 {
-  register int c;
+  register scm_t_wchar c;
   while (1)
     switch (c = scm_getc (port))
       {
@@ -257,6 +286,9 @@ flush_ws (SCM port, const char *eoferr)
 	  case '!':
 	    scm_read_scsh_block_comment (c, port);
 	    break;
+	  case ';':
+	    scm_read_commented_expression (c, port);
+	    break;
 	  default:
 	    scm_ungetc (c, port);
 	    return '#';
@@ -286,7 +318,7 @@ static SCM recsexpr (SCM obj, long line, int column, SCM filename);
 
 
 static SCM
-scm_read_sexp (int chr, SCM port)
+scm_read_sexp (scm_t_wchar chr, SCM port)
 #define FUNC_NAME "scm_i_lreadparen"
 {
   register int c;
@@ -381,207 +413,218 @@ scm_read_string (int chr, SCM port)
      object (the string returned).  */
 
   SCM str = SCM_BOOL_F;
-  char c_str[READER_STRING_BUFFER_SIZE];
   unsigned c_str_len = 0;
-  int c;
+  scm_t_wchar c;
 
+  str = scm_i_make_string (READER_STRING_BUFFER_SIZE, NULL);
   while ('"' != (c = scm_getc (port)))
     {
       if (c == EOF)
-	str_eof: scm_i_input_error (FUNC_NAME, port,
-				    "end of file in string constant",
-				    SCM_EOL);
-
-      if (c_str_len + 1 >= sizeof (c_str))
-	{
-	  /* Flush the C buffer onto a Scheme string.  */
-	  SCM addy;
-
-	  if (str == SCM_BOOL_F)
-	    str = scm_c_make_string (0, SCM_MAKE_CHAR ('X'));
+        {
+        str_eof:
+          scm_i_input_error (FUNC_NAME, port,
+                             "end of file in string constant", SCM_EOL);
+        }
 
-	  addy = scm_from_locale_stringn (c_str, c_str_len);
-	  str = scm_string_append_shared (scm_list_2 (str, addy));
+      if (c_str_len + 1 >= scm_i_string_length (str))
+        {
+          SCM addy = scm_i_make_string (READER_STRING_BUFFER_SIZE, NULL);
 
-	  c_str_len = 0;
-	}
+          str = scm_string_append (scm_list_2 (str, addy));
+        }
 
       if (c == '\\')
-	switch (c = scm_getc (port))
-	  {
-	  case EOF:
-	    goto str_eof;
-	  case '"':
-	  case '\\':
-	    break;
+        {
+          switch (c = scm_getc (port))
+            {
+            case EOF:
+              goto str_eof;
+            case '"':
+            case '\\':
+              break;
 #if SCM_ENABLE_ELISP
-	  case '(':
-	  case ')':
-	    if (SCM_ESCAPED_PARENS_P)
-	      break;
-	    goto bad_escaped;
+            case '(':
+            case ')':
+              if (SCM_ESCAPED_PARENS_P)
+                break;
+              goto bad_escaped;
 #endif
-	  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;
-	  case 'x':
-	    {
-	      int a, b;
-	      a = scm_getc (port);
-	      if (a == EOF) goto str_eof;
-	      b = scm_getc (port);
-	      if (b == EOF) goto str_eof;
-	      if      ('0' <= a && a <= '9') a -= '0';
-	      else if ('A' <= a && a <= 'F') a = a - 'A' + 10;
-	      else if ('a' <= a && a <= 'f') a = a - 'a' + 10;
-	      else goto bad_escaped;
-	      if      ('0' <= b && b <= '9') b -= '0';
-	      else if ('A' <= b && b <= 'F') b = b - 'A' + 10;
-	      else if ('a' <= b && b <= 'f') b = b - 'a' + 10;
-	      else goto bad_escaped;
-	      c = a * 16 + b;
-	      break;
-	    }
-	  default:
-	  bad_escaped:
-	    scm_i_input_error (FUNC_NAME, port,
-			       "illegal character in escape sequence: ~S",
-			       scm_list_1 (SCM_MAKE_CHAR (c)));
-	  }
-      c_str[c_str_len++] = c;
+            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;
+            case 'x':
+              {
+                scm_t_wchar a, b;
+                a = scm_getc (port);
+                if (a == EOF)
+                  goto str_eof;
+                b = scm_getc (port);
+                if (b == EOF)
+                  goto str_eof;
+                if ('0' <= a && a <= '9')
+                  a -= '0';
+                else if ('A' <= a && a <= 'F')
+                  a = a - 'A' + 10;
+                else if ('a' <= a && a <= 'f')
+                  a = a - 'a' + 10;
+                else
+                  {
+                    c = a;
+                    goto bad_escaped;
+                  }
+                if ('0' <= b && b <= '9')
+                  b -= '0';
+                else if ('A' <= b && b <= 'F')
+                  b = b - 'A' + 10;
+                else if ('a' <= b && b <= 'f')
+                  b = b - 'a' + 10;
+                else
+                  {
+                    c = b;
+                    goto bad_escaped;
+                  }
+                c = a * 16 + b;
+                break;
+              }
+            case 'u':
+              {
+                scm_t_wchar a;
+                int i;
+                c = 0;
+                for (i = 0; i < 4; i++)
+                  {
+                    a = scm_getc (port);
+                    if (a == EOF)
+                      goto str_eof;
+                    if ('0' <= a && a <= '9')
+                      a -= '0';
+                    else if ('A' <= a && a <= 'F')
+                      a = a - 'A' + 10;
+                    else if ('a' <= a && a <= 'f')
+                      a = a - 'a' + 10;
+                    else
+                      {
+                        c = a;
+                        goto bad_escaped;
+                      }
+                    c = c * 16 + a;
+                  }
+                break;
+              }
+            case 'U':
+              {
+                scm_t_wchar a;
+                int i;
+                c = 0;
+                for (i = 0; i < 6; i++)
+                  {
+                    a = scm_getc (port);
+                    if (a == EOF)
+                      goto str_eof;
+                    if ('0' <= a && a <= '9')
+                      a -= '0';
+                    else if ('A' <= a && a <= 'F')
+                      a = a - 'A' + 10;
+                    else if ('a' <= a && a <= 'f')
+                      a = a - 'a' + 10;
+                    else
+                      {
+                        c = a;
+                        goto bad_escaped;
+                      }
+                    c = c * 16 + a;
+                  }
+                break;
+              }
+            default:
+            bad_escaped:
+              scm_i_input_error (FUNC_NAME, port,
+                                 "illegal character in escape sequence: ~S",
+                                 scm_list_1 (SCM_MAKE_CHAR (c)));
+            }
+        }
+      str = scm_i_string_start_writing (str);
+      scm_i_string_set_x (str, c_str_len++, c);
+      scm_i_string_stop_writing ();
     }
 
   if (c_str_len > 0)
     {
-      SCM addy;
-
-      addy = scm_from_locale_stringn (c_str, c_str_len);
-      if (str == SCM_BOOL_F)
-	str = addy;
-      else
-	str = scm_string_append_shared (scm_list_2 (str, addy));
+      return scm_i_substring_copy (str, 0, c_str_len);
     }
-  else
-    str = (str == SCM_BOOL_F) ? scm_nullstr : str;
-
-  return str;
+  
+  return scm_nullstr;
 }
 #undef FUNC_NAME
 
 
 static SCM
-scm_read_number (int chr, SCM port)
+scm_read_number (scm_t_wchar chr, SCM port)
 {
-  SCM result, str = SCM_EOL;
-  char buffer[READER_BUFFER_SIZE];
+  SCM result;
+  SCM buffer;
   size_t read;
-  int overflow = 0;
 
   scm_ungetc (chr, port);
-  do
-    {
-      overflow = read_token (port, buffer, sizeof (buffer), &read);
-
-      if ((overflow) || (scm_is_pair (str)))
-	str = scm_cons (scm_from_locale_stringn (buffer, read), str);
-    }
-  while (overflow);
-
-  if (scm_is_pair (str))
-    {
-      /* The slow path.  */
-
-      str = scm_string_concatenate (scm_reverse_x (str, SCM_EOL));
-      result = scm_string_to_number (str, SCM_UNDEFINED);
-      if (!scm_is_true (result))
-	/* Return a symbol instead of a number.  */
-	result = scm_string_to_symbol (str);
-    }
-  else
-    {
-      result = scm_c_locale_stringn_to_number (buffer, read, 10);
-      if (!scm_is_true (result))
-	/* Return a symbol instead of a number.  */
-	result = scm_from_locale_symboln (buffer, read);
-    }
+  buffer = read_complete_token (port, &read);
+  result = scm_string_to_number (buffer, SCM_UNDEFINED);
+  if (!scm_is_true (result))
+    /* Return a symbol instead of a number.  */
+    result = scm_string_to_symbol (buffer);
 
   return result;
 }
 
 static SCM
-scm_read_mixed_case_symbol (int chr, SCM port)
+scm_read_mixed_case_symbol (scm_t_wchar chr, SCM port)
 {
-  SCM result, str = SCM_EOL;
-  int overflow = 0, ends_with_colon = 0;
-  char buffer[READER_BUFFER_SIZE];
+  SCM result;
+  int ends_with_colon = 0;
+  SCM buffer;
   size_t read = 0;
   int postfix = scm_is_eq (SCM_PACK (SCM_KEYWORD_STYLE), scm_keyword_postfix);
 
   scm_ungetc (chr, port);
-  do
-    {
-      overflow = read_token (port, buffer, sizeof (buffer), &read);
-
-      if (read > 0)
-	ends_with_colon = (buffer[read - 1] == ':');
-
-      if ((overflow) || (scm_is_pair (str)))
-	str = scm_cons (scm_from_locale_stringn (buffer, read), str);
-    }
-  while (overflow);
-
-  if (scm_is_pair (str))
-    {
-      str = scm_string_concatenate (scm_reverse_x (str, SCM_EOL));
-      result = scm_string_to_symbol (str);
+  buffer = read_complete_token (port, &read);
+  if (read > 0)
+    ends_with_colon = scm_i_string_ref (buffer, read - 1) == ':';
 
-      /* Per SRFI-88, `:' alone is an identifier, not a keyword.  */
-      if (postfix && ends_with_colon && (scm_c_string_length (result) > 1))
-	result = scm_symbol_to_keyword (result);
-    }
+  if (postfix && ends_with_colon && (read > 1))
+    result = scm_symbol_to_keyword (scm_string_to_symbol (scm_i_substring (buffer, 0, read - 1)));
   else
-    {
-      /* For symbols smaller than `sizeof (buffer)', we don't need to recur
-	 to Scheme strings.  Therefore, we only create one Scheme object (a
-	 symbol) per symbol read.  */
-      if (postfix && ends_with_colon && (read > 1))
-	result = scm_from_locale_keywordn (buffer, read - 1);
-      else
-	result = scm_from_locale_symboln (buffer, read);
-    }
+    result = scm_string_to_symbol (buffer);
 
   return result;
 }
 
 static SCM
-scm_read_number_and_radix (int chr, SCM port)
+scm_read_number_and_radix (scm_t_wchar chr, SCM port)
 #define FUNC_NAME "scm_lreadr"
 {
-  SCM result, str = SCM_EOL;
+  SCM result;
   size_t read;
-  char buffer[READER_BUFFER_SIZE];
+  SCM buffer = scm_i_make_string (READER_BUFFER_SIZE, NULL);
   unsigned int radix;
-  int overflow = 0;
 
   switch (chr)
     {
@@ -611,22 +654,8 @@ scm_read_number_and_radix (int chr, SCM port)
       radix = 10;
     }
 
-  do
-    {
-      overflow = read_token (port, buffer, sizeof (buffer), &read);
-
-      if ((overflow) || (scm_is_pair (str)))
-	str = scm_cons (scm_from_locale_stringn (buffer, read), str);
-    }
-  while (overflow);
-
-  if (scm_is_pair (str))
-    {
-      str = scm_string_concatenate (scm_reverse_x (str, SCM_EOL));
-      result = scm_string_to_number (str, scm_from_uint (radix));
-    }
-  else
-    result = scm_c_locale_stringn_to_number (buffer, read, radix);
+  buffer = read_complete_token (port, &read);
+  result = scm_string_to_number (buffer, scm_from_uint (radix));
 
   if (scm_is_true (result))
     return result;
@@ -656,7 +685,7 @@ scm_read_quote (int chr, SCM port)
 
     case ',':
       {
-	int c;
+	scm_t_wchar c;
 
 	c = scm_getc (port);
 	if ('@' == c)
@@ -691,12 +720,74 @@ scm_read_quote (int chr, SCM port)
   return p;
 }
 
+SCM_SYMBOL (sym_syntax, "syntax");
+SCM_SYMBOL (sym_quasisyntax, "quasisyntax");
+SCM_SYMBOL (sym_unsyntax, "unsyntax");
+SCM_SYMBOL (sym_unsyntax_splicing, "unsyntax-splicing");
+
+static SCM
+scm_read_syntax (int chr, SCM port)
+{
+  SCM p;
+  long line = SCM_LINUM (port);
+  int column = SCM_COL (port) - 1;
+
+  switch (chr)
+    {
+    case '`':
+      p = sym_quasisyntax;
+      break;
+
+    case '\'':
+      p = sym_syntax;
+      break;
+
+    case ',':
+      {
+	int c;
+
+	c = scm_getc (port);
+	if ('@' == c)
+	  p = sym_unsyntax_splicing;
+	else
+	  {
+	    scm_ungetc (c, port);
+	    p = sym_unsyntax;
+	  }
+	break;
+      }
+
+    default:
+      fprintf (stderr, "%s: unhandled syntax character (%i)\n",
+	       "scm_read_syntax", chr);
+      abort ();
+    }
+
+  p = scm_cons2 (p, scm_read_expression (port), SCM_EOL);
+  if (SCM_RECORD_POSITIONS_P)
+    scm_whash_insert (scm_source_whash, p,
+		      scm_make_srcprops (line, column,
+					 SCM_FILENAME (port),
+					 SCM_COPY_SOURCE_P
+					 ? (scm_cons2 (SCM_CAR (p),
+						       SCM_CAR (SCM_CDR (p)),
+						       SCM_EOL))
+					 : SCM_UNDEFINED,
+					 SCM_EOL));
+
+
+  return p;
+}
+
 static inline SCM
 scm_read_semicolon_comment (int chr, SCM port)
 {
   int c;
 
-  for (c = scm_getc (port);
+  /* We use the get_byte here because there is no need to get the
+     locale correct with comment input. This presumes that newline
+     always represents itself no matter what the encoding is.  */
+  for (c = scm_get_byte_or_eof (port);
        (c != EOF) && (c != '\n');
        c = scm_getc (port));
 
@@ -724,14 +815,18 @@ scm_read_boolean (int chr, SCM port)
 }
 
 static SCM
-scm_read_character (int chr, SCM port)
+scm_read_character (scm_t_wchar chr, SCM port)
 #define FUNC_NAME "scm_lreadr"
 {
-  unsigned c;
-  char charname[READER_CHAR_NAME_MAX_SIZE];
+  SCM charname = scm_i_make_string (READER_CHAR_NAME_MAX_SIZE, NULL);
   size_t charname_len;
+  scm_t_wchar cp;
+  int overflow;
 
-  if (read_token (port, charname, sizeof (charname), &charname_len))
+  overflow = read_token (port, charname, &charname_len);
+  charname = scm_c_substring (charname, 0, charname_len);
+
+  if (overflow)
     goto char_error;
 
   if (charname_len == 0)
@@ -746,29 +841,34 @@ scm_read_character (int chr, SCM port)
     }
 
   if (charname_len == 1)
-    return SCM_MAKE_CHAR (charname[0]);
+    return SCM_MAKE_CHAR (scm_i_string_ref (charname, 0));
 
-  if (*charname >= '0' && *charname < '8')
+  cp = scm_i_string_ref (charname, 0);
+  if (cp >= '0' && cp < '8')
     {
       /* Dirk:FIXME::  This type of character syntax is not R5RS
        * compliant.  Further, it should be verified that the constant
        * does only consist of octal digits.  Finally, it should be
        * checked whether the resulting fixnum is in the range of
        * characters.  */
-      SCM p = scm_c_locale_stringn_to_number (charname, charname_len, 8);
+      SCM p = scm_string_to_number (charname, scm_from_uint (8));
       if (SCM_I_INUMP (p))
 	return SCM_MAKE_CHAR (SCM_I_INUM (p));
     }
 
-  for (c = 0; c < scm_n_charnames; c++)
-    if (scm_charnames[c]
-	&& (!strncasecmp (scm_charnames[c], charname, charname_len)))
-      return SCM_MAKE_CHAR (scm_charnums[c]);
+  /* The names of characters should never have non-Latin1
+     characters.  */
+  if (scm_i_is_narrow_string (charname)
+      || scm_i_try_narrow_string (charname))
+    { SCM ch = scm_i_charname_to_char (scm_i_string_chars (charname),
+                                       charname_len);
+      if (scm_is_true (ch))
+        return ch;
+    }
 
  char_error:
   scm_i_input_error (FUNC_NAME, port, "unknown character name ~a",
-		     scm_list_1 (scm_from_locale_stringn (charname,
-							  charname_len)));
+		     scm_list_1 (charname));
 
   return SCM_UNSPECIFIED;
 }
@@ -810,7 +910,31 @@ scm_read_srfi4_vector (int chr, SCM port)
 }
 
 static SCM
-scm_read_guile_bit_vector (int chr, SCM port)
+scm_read_bytevector (scm_t_wchar chr, SCM port)
+{
+  chr = scm_getc (port);
+  if (chr != 'u')
+    goto syntax;
+
+  chr = scm_getc (port);
+  if (chr != '8')
+    goto syntax;
+
+  chr = scm_getc (port);
+  if (chr != '(')
+    goto syntax;
+
+  return scm_u8_list_to_bytevector (scm_read_sexp (chr, port));
+
+ syntax:
+  scm_i_input_error ("read_bytevector", port,
+		     "invalid bytevector prefix",
+		     SCM_MAKE_CHAR (chr));
+  return SCM_UNSPECIFIED;
+}
+
+static SCM
+scm_read_guile_bit_vector (scm_t_wchar chr, SCM port)
 {
   /* Read the `#*10101'-style read syntax for bit vectors in Guile.  This is
      terribly inefficient but who cares?  */
@@ -830,13 +954,17 @@ scm_read_guile_bit_vector (int chr, SCM port)
 }
 
 static inline SCM
-scm_read_scsh_block_comment (int chr, SCM port)
+scm_read_scsh_block_comment (scm_t_wchar chr, SCM port)
 {
   int bang_seen = 0;
 
+  /* We can use the get_byte here because there is no need to get the
+     locale correct when reading comments. This presumes that 
+     hash and exclamation points always represent themselves no
+     matter what the source encoding is.*/
   for (;;)
     {
-      int c = scm_getc (port);
+      int c = scm_get_byte_or_eof (port);
 
       if (c == EOF)
 	scm_i_input_error ("skip_block_comment", port,
@@ -854,19 +982,32 @@ scm_read_scsh_block_comment (int chr, SCM port)
 }
 
 static SCM
-scm_read_extended_symbol (int chr, SCM port)
+scm_read_commented_expression (scm_t_wchar chr, SCM port)
+{
+  scm_t_wchar c;
+  
+  c = flush_ws (port, (char *) NULL);
+  if (EOF == c)
+    scm_i_input_error ("read_commented_expression", port,
+                       "no expression after #; comment", SCM_EOL);
+  scm_ungetc (c, port);
+  scm_read_expression (port);
+  return SCM_UNSPECIFIED;
+}
+
+static SCM
+scm_read_extended_symbol (scm_t_wchar chr, SCM port)
 {
   /* Guile's extended symbol read syntax looks like this:
 
        #{This is all a symbol name}#
 
      So here, CHR is expected to be `{'.  */
-  SCM result;
   int saw_brace = 0, finished = 0;
   size_t len = 0;
-  char buf[1024];
+  SCM buf = scm_i_make_string (1024, NULL);
 
-  result = scm_c_make_string (0, SCM_MAKE_CHAR ('X'));
+  buf = scm_i_string_start_writing (buf);
 
   while ((chr = scm_getc (port)) != EOF)
     {
@@ -880,32 +1021,30 @@ scm_read_extended_symbol (int chr, SCM port)
 	  else
 	    {
 	      saw_brace = 0;
-	      buf[len++] = '}';
-	      buf[len++] = chr;
+	      scm_i_string_set_x (buf, len++, '}');
+	      scm_i_string_set_x (buf, len++, chr);
 	    }
 	}
       else if (chr == '}')
 	saw_brace = 1;
       else
-	buf[len++] = chr;
+	scm_i_string_set_x (buf, len++, chr);
 
-      if (len >= sizeof (buf) - 2)
+      if (len >= scm_i_string_length (buf) - 2)
 	{
-	  scm_string_append (scm_list_2 (result,
-					 scm_from_locale_stringn (buf, len)));
+	  scm_i_string_stop_writing ();
+	  SCM addy = scm_i_make_string (1024, NULL);
+	  buf = scm_string_append (scm_list_2 (buf, addy));
 	  len = 0;
+	  buf = scm_i_string_start_writing (buf);
 	}
 
       if (finished)
 	break;
     }
+  scm_i_string_stop_writing ();
 
-  if (len)
-    result = scm_string_append (scm_list_2
-				(result,
-				 scm_from_locale_stringn (buf, len)));
-
-  return (scm_string_to_symbol (result));
+  return (scm_string_to_symbol (scm_c_substring (buf, 0, len)));
 }
 
 
@@ -941,7 +1080,7 @@ scm_read_sharp_extension (int chr, SCM port)
 /* The reader for the sharp `#' character.  It basically dispatches reads
    among the above token readers.   */
 static SCM
-scm_read_sharp (int chr, SCM port)
+scm_read_sharp (scm_t_wchar chr, SCM port)
 #define FUNC_NAME "scm_lreadr"
 {
   SCM result;
@@ -963,6 +1102,8 @@ scm_read_sharp (int chr, SCM port)
     case 'f':
       /* This one may return either a boolean or an SRFI-4 vector.  */
       return (scm_read_srfi4_vector (chr, port));
+    case 'v':
+      return (scm_read_bytevector (chr, port));
     case '*':
       return (scm_read_guile_bit_vector (chr, port));
     case 't':
@@ -991,7 +1132,7 @@ scm_read_sharp (int chr, SCM port)
       {
 	/* When next char is '(', it really is an old-style
 	   uniform array. */
-	int next_c = scm_getc (port);
+	scm_t_wchar next_c = scm_getc (port);
 	if (next_c != EOF)
 	  scm_ungetc (next_c, port);
 	if (next_c == '(')
@@ -1014,6 +1155,12 @@ scm_read_sharp (int chr, SCM port)
       return (scm_read_extended_symbol (chr, port));
     case '!':
       return (scm_read_scsh_block_comment (chr, port));
+    case ';':
+      return (scm_read_commented_expression (chr, port));
+    case '`':
+    case '\'':
+    case ',':
+      return (scm_read_syntax (chr, port));
     default:
       result = scm_read_sharp_extension (chr, port);
       if (scm_is_eq (result, SCM_UNSPECIFIED))
@@ -1033,7 +1180,7 @@ scm_read_expression (SCM port)
 {
   while (1)
     {
-      register int chr;
+      register scm_t_wchar chr;
 
       chr = scm_getc (port);
 
@@ -1244,6 +1391,127 @@ scm_get_hash_procedure (int c)
     }
 }
 
+#define SCM_ENCODING_SEARCH_SIZE (500)
+
+/* Search the first few hundred characters of a file for
+   an emacs-like coding declaration.  */
+char *
+scm_scan_for_encoding (SCM port)
+{
+  char header[SCM_ENCODING_SEARCH_SIZE+1];
+  size_t bytes_read;
+  char *encoding = NULL;
+  int utf8_bom = 0;
+  char *pos;
+  int i;
+  int in_comment;
+
+  bytes_read = scm_c_read (port, header, SCM_ENCODING_SEARCH_SIZE);  
+  scm_seek (port, scm_from_int (0), scm_from_int (SEEK_SET));
+
+  if (bytes_read > 3 
+      && header[0] == '\xef' && header[1] == '\xbb' && header[2] == '\xbf')
+    utf8_bom = 1;
+
+  /* search past "coding[:=]" */
+  pos = header;
+  while (1)
+    {
+      if ((pos = strstr(pos, "coding")) == NULL)
+        return NULL;
+
+      pos += strlen("coding");
+      if (pos - header >= SCM_ENCODING_SEARCH_SIZE || 
+          (*pos == ':' || *pos == '='))
+        {
+          pos ++;
+          break;
+        }
+    }
+
+  /* skip spaces */
+  while (pos - header <= SCM_ENCODING_SEARCH_SIZE && 
+	 (*pos == ' ' || *pos == '\t'))
+    pos ++;
+
+  /* grab the next token */
+  i = 0;
+  while (pos + i - header <= SCM_ENCODING_SEARCH_SIZE 
+	 && (isalnum(pos[i]) || pos[i] == '_' || pos[i] == '-' || pos[i] == '.'))
+    i++;
+
+  if (i == 0)
+    return NULL;
+
+  encoding = scm_malloc (i+1);
+  memcpy (encoding, pos, i);
+  encoding[i] ='\0';
+  for (i = 0; i < strlen (encoding); i++)
+    encoding[i] = toupper ((int) encoding[i]);
+
+  /* push backwards to make sure we were in a comment */
+  in_comment = 0;
+  while (pos - i - header > 0)
+    {
+      if (*(pos - i) == '\n')
+	{
+	  /* This wasn't in a semicolon comment. Check for a
+	   hash-bang comment. */
+	  char *beg = strstr (header, "#!");
+	  char *end = strstr (header, "!#");
+	  if (beg < pos && pos < end)
+	    in_comment = 1;
+	  break;
+	}
+      if (*(pos - i) == ';')
+	{
+	  in_comment = 1;
+	  break;
+	}
+      i ++;
+    }
+  if (!in_comment)
+    {
+      /* This wasn't in a comment */
+      free (encoding);
+      return NULL;
+    }
+  if (utf8_bom && strcmp(encoding, "UTF-8"))
+    scm_misc_error (NULL, 
+		    "the port input declares the encoding ~s but is encoded as UTF-8",
+		    scm_list_1 (scm_from_locale_string (encoding)));
+      
+  return encoding;
+}
+
+SCM_DEFINE (scm_file_encoding, "file-encoding", 1, 0, 0,
+            (SCM port),
+            "Scans the port for an EMACS-like character coding declaration\n"
+            "near the top of the contents of a port with random-acessible contents.\n"
+            "The coding declaration is of the form\n"
+            "@code{coding: XXXXX} and must appear in a scheme comment.\n"
+            "\n"
+            "Returns a string containing the character encoding of the file\n"
+            "if a declaration was found, or @code{#f} otherwise.\n")
+#define FUNC_NAME s_scm_file_encoding
+{
+  char *enc;
+  SCM s_enc;
+  
+  enc = scm_scan_for_encoding (port);
+  if (enc == NULL)
+    return SCM_BOOL_F;
+  else
+    {
+      s_enc = scm_from_locale_string (enc);
+      free (enc);
+      return s_enc;
+    }
+  
+  return SCM_BOOL_F;
+}
+#undef FUNC_NAME
+
 void
 scm_init_read ()
 {
diff --git a/libguile/read.h b/libguile/read.h
index 4253622da..7bc4a0ba4 100644
--- a/libguile/read.h
+++ b/libguile/read.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,2000, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -55,6 +56,8 @@ SCM_API SCM scm_read_options (SCM setting);
 SCM_API SCM scm_read (SCM port);
 SCM_API size_t scm_read_token (int ic, SCM * tok_buf, SCM port, int weird);
 SCM_API SCM scm_read_hash_extend (SCM chr, SCM proc);
+SCM_INTERNAL char *scm_scan_for_encoding (SCM port);
+SCM_API SCM scm_file_encoding (SCM port);
 
 SCM_INTERNAL void scm_i_input_error (const char *func, SCM port,
 				     const char *message, SCM arg)
diff --git a/libguile/regex-posix.c b/libguile/regex-posix.c
index 187261421..6259f28ae 100644
--- a/libguile/regex-posix.c
+++ b/libguile/regex-posix.c
@@ -1,18 +1,19 @@
 /*	Copyright (C) 1997, 1998, 1999, 2000, 2001, 2004, 2006, 2007 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/regex-posix.h b/libguile/regex-posix.h
index 2863b0562..8060fe3b7 100644
--- a/libguile/regex-posix.h
+++ b/libguile/regex-posix.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1997,1998,2000,2001, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/root.c b/libguile/root.c
index 0d4ab29e5..83960b5d8 100644
--- a/libguile/root.c
+++ b/libguile/root.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1995,1996,1997,1998,1999,2000, 2001, 2002, 2006, 2008 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/root.h b/libguile/root.h
index a8116c879..676a7b44c 100644
--- a/libguile/root.h
+++ b/libguile/root.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1996,1998,2000,2001, 2002, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/rw.c b/libguile/rw.c
index 3e814740a..a9b4a329a 100644
--- a/libguile/rw.c
+++ b/libguile/rw.c
@@ -1,18 +1,19 @@
-/* 	Copyright (C) 2001, 2006 Free Software Foundation, Inc.
+/* 	Copyright (C) 2001, 2006, 2009 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -130,6 +131,7 @@ SCM_DEFINE (scm_read_string_x_partial, "read-string!/partial", 1, 3, 0,
 	 don't touch the file descriptor.  otherwise the
 	 "return immediately if something is available" rule may
 	 be violated.  */
+      str = scm_i_string_start_writing (str);
       dest = scm_i_string_writable_chars (str) + offset;
       chars_read = scm_take_from_input_buffers (port, dest, read_len);
       scm_i_string_stop_writing ();
@@ -139,6 +141,7 @@ SCM_DEFINE (scm_read_string_x_partial, "read-string!/partial", 1, 3, 0,
   if (chars_read == 0 && read_len > 0) /* don't confuse read_len == 0 with
 					  EOF.  */
     {
+      str = scm_i_string_start_writing (str);
       dest = scm_i_string_writable_chars (str) + offset;
       SCM_SYSCALL (chars_read = read (fdes, dest, read_len));
       scm_i_string_stop_writing ();
@@ -206,7 +209,7 @@ SCM_DEFINE (scm_write_string_partial, "write-string/partial", 1, 3, 0,
 #define FUNC_NAME s_scm_write_string_partial
 {
   const char *src;
-  long write_len;
+  scm_t_off write_len;
   int fdes;
 
   {
@@ -231,7 +234,7 @@ SCM_DEFINE (scm_write_string_partial, "write-string/partial", 1, 3, 0,
       SCM port = (SCM_UNBNDP (port_or_fdes)?
 		  scm_current_output_port () : port_or_fdes);
       scm_t_port *pt;
-      off_t space;
+      scm_t_off space;
 
       SCM_VALIDATE_OPFPORT (2, port);
       SCM_VALIDATE_OUTPUT_PORT (2, port);
diff --git a/libguile/rw.h b/libguile/rw.h
index b526051fc..d54f1b3ef 100644
--- a/libguile/rw.h
+++ b/libguile/rw.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 2001, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/scmconfig.h.top b/libguile/scmconfig.h.top
index dfc7ba99c..b84660b6c 100644
--- a/libguile/scmconfig.h.top
+++ b/libguile/scmconfig.h.top
@@ -1,16 +1,17 @@
 /* Copyright (C) 2003, 2006 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
diff --git a/libguile/scmsigs.c b/libguile/scmsigs.c
index eb7cec67b..d9b36c574 100644
--- a/libguile/scmsigs.c
+++ b/libguile/scmsigs.c
@@ -1,18 +1,19 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2004, 2006, 2007, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2004, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -147,32 +148,6 @@ take_signal (int signum)
 #endif
 }
 
-typedef struct {
-  ssize_t res;
-  int fd;
-  char *buf;
-  size_t n;
-} read_without_guile_data;
-
-static void *
-do_read_without_guile (void *raw_data)
-{
-  read_without_guile_data *data = (read_without_guile_data *)raw_data;
-  data->res = read (data->fd, data->buf, data->n);
-  return NULL;
-}
-
-static ssize_t
-read_without_guile (int fd, char *buf, size_t n)
-{
-  read_without_guile_data data;
-  data.fd = fd;
-  data.buf = buf;
-  data.n = n;
-  scm_without_guile (do_read_without_guile, &data);
-  return data.res;
-}
-
 static SCM
 signal_delivery_thread (void *data)
 {
@@ -186,7 +161,7 @@ signal_delivery_thread (void *data)
 
   while (1)
     {
-      n = read_without_guile (signal_pipe[0], &sigbyte, 1);
+      n = read (signal_pipe[0], &sigbyte, 1);
       sig = sigbyte;
       if (n == 1 && sig >= 0 && sig < NSIG)
 	{
@@ -305,10 +280,8 @@ SCM_DEFINE (scm_sigaction_for_thread, "sigaction", 1, 3, 0,
 	    "a scheme procedure has been specified, that procedure will run\n"
 	    "in the given @var{thread}.   When no thread has been given, the\n"
 	    "thread that made this call to @code{sigaction} is used.\n"
-	    "Flags can "
-	    "optionally be specified for the new handler (@code{SA_RESTART} will\n"
-	    "always be added if it's available and the system is using restartable\n"
-	    "system calls.)  The return value is a pair with information about the\n"
+	    "Flags can optionally be specified for the new handler.\n"
+	    "The return value is a pair with information about the\n"
 	    "old handler as described above.\n\n"
 	    "This interface does not provide access to the \"signal blocking\"\n"
 	    "facility.  Maybe this is not needed, since the thread support may\n"
@@ -332,14 +305,7 @@ SCM_DEFINE (scm_sigaction_for_thread, "sigaction", 1, 3, 0,
   csig = scm_to_signed_integer (signum, 0, NSIG-1);
 
 #if defined(HAVE_SIGACTION)
-#if defined(SA_RESTART) && defined(HAVE_RESTARTABLE_SYSCALLS)
-  /* don't allow SA_RESTART to be omitted if HAVE_RESTARTABLE_SYSCALLS
-     is defined, since libguile would be likely to produce spurious
-     EINTR errors.  */
-  action.sa_flags = SA_RESTART;
-#else
   action.sa_flags = 0;
-#endif
   if (!SCM_UNBNDP (flags))
     action.sa_flags |= scm_to_int (flags);
   sigemptyset (&action.sa_mask);
@@ -712,29 +678,6 @@ scm_init_scmsigs ()
 #else
       orig_handlers[i] = SIG_ERR;
 #endif
-
-#ifdef HAVE_RESTARTABLE_SYSCALLS
-      /* If HAVE_RESTARTABLE_SYSCALLS is defined, it's important that
-	 signals really are restartable.  don't rely on the same
-	 run-time that configure got: reset the default for every signal.
-      */
-#ifdef HAVE_SIGINTERRUPT
-      siginterrupt (i, 0);
-#elif defined(SA_RESTART)
-      {
-	struct sigaction action;
-
-	sigaction (i, NULL, &action);
-	if (!(action.sa_flags & SA_RESTART))
-	  {
-	    action.sa_flags |= SA_RESTART;
-	    sigaction (i, &action, NULL);
-	  }
-      }
-#endif
-      /* if neither siginterrupt nor SA_RESTART are available we may
-	 as well assume that signals are always restartable.  */
-#endif
     }
 
   scm_c_define ("NSIG", scm_from_long (NSIG));
diff --git a/libguile/scmsigs.h b/libguile/scmsigs.h
index bcbf825d4..fce372849 100644
--- a/libguile/scmsigs.h
+++ b/libguile/scmsigs.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,1997,1998,2000, 2002, 2006, 2007, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/script.c b/libguile/script.c
index 14691c738..8c4e8ef55 100644
--- a/libguile/script.c
+++ b/libguile/script.c
@@ -1,17 +1,18 @@
 /* Copyright (C) 1994, 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 /* "script.c" argv tricks for `#!' scripts.
@@ -29,6 +30,7 @@
 #include "libguile/eval.h"
 #include "libguile/feature.h"
 #include "libguile/load.h"
+#include "libguile/private-gc.h" /* scm_getenv_int */
 #include "libguile/read.h"
 #include "libguile/script.h"
 #include "libguile/strings.h"
@@ -376,6 +378,10 @@ scm_shell_usage (int fatal, char *message)
            "  --no-debug     start with normal evaluator\n"
            "                 Default is to enable debugging for interactive\n"
            "                 use, but not for `-s' and `-c'.\n"
+           "  --autocompile  compile source files automatically\n"
+           "  --no-autocompile  disable automatic source file compilation\n"
+           "                 Default is to enable autocompilation of source\n"
+           "                 files.\n"
 	   "  -q             inhibit loading of user init file\n"
            "  --emacs        enable Emacs protocol (experimental)\n"
 	   "  --use-srfi=LS  load SRFI modules for the SRFIs in LS,\n"
@@ -404,6 +410,7 @@ SCM_SYMBOL (sym_quit, "quit");
 SCM_SYMBOL (sym_use_srfis, "use-srfis");
 SCM_SYMBOL (sym_load_path, "%load-path");
 SCM_SYMBOL (sym_set_x, "set!");
+SCM_SYMBOL (sym_sys_load_should_autocompile, "%load-should-autocompile");
 SCM_SYMBOL (sym_cons, "cons");
 SCM_SYMBOL (sym_at, "@");
 SCM_SYMBOL (sym_atat, "@@");
@@ -448,6 +455,8 @@ scm_compile_shell_switches (int argc, char **argv)
   int use_emacs_interface = 0;
   int turn_on_debugging = 0;
   int dont_turn_on_debugging = 0;
+  int turn_on_autocompile = 0;
+  int dont_turn_on_autocompile = 0;
 
   int i;
   char *argv0 = guile;
@@ -584,6 +593,18 @@ scm_compile_shell_switches (int argc, char **argv)
 	  turn_on_debugging = 0;
 	}
 
+      else if (! strcmp (argv[i], "--autocompile"))
+	{
+	  turn_on_autocompile = 1;
+	  dont_turn_on_autocompile = 0;
+	}
+
+      else if (! strcmp (argv[i], "--no-autocompile"))
+	{
+	  dont_turn_on_autocompile = 1;
+	  turn_on_autocompile = 0;
+	}
+
       else if (! strcmp (argv[i], "--emacs")) /* use emacs protocol */ 
 	use_emacs_interface = 1;
 
@@ -701,6 +722,16 @@ scm_compile_shell_switches (int argc, char **argv)
       tail = scm_cons (scm_cons (sym_load_user_init, SCM_EOL), tail);
     }
 
+  /* If GUILE_AUTO_COMPILE is not set and no args are given, default to
+     autocompilation. */
+  if (turn_on_autocompile || (scm_getenv_int ("GUILE_AUTO_COMPILE", 1)
+                              && !dont_turn_on_autocompile))
+    {
+      tail = scm_cons (scm_list_3 (sym_set_x, sym_sys_load_should_autocompile,
+                                   SCM_BOOL_T),
+                       tail);
+    }
+
   /* If debugging was requested, or we are interactive and debugging
      was not explicitly turned off, turn on debugging. */
   if (turn_on_debugging || (interactive && !dont_turn_on_debugging))
diff --git a/libguile/script.h b/libguile/script.h
index 6c02f8d8d..7e3828aa3 100644
--- a/libguile/script.h
+++ b/libguile/script.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1997,1998,2000, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/simpos.c b/libguile/simpos.c
index e4c27b7e7..41af23378 100644
--- a/libguile/simpos.c
+++ b/libguile/simpos.c
@@ -2,18 +2,19 @@
  * Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/simpos.h b/libguile/simpos.h
index 6df8bb1d2..b391a28d8 100644
--- a/libguile/simpos.h
+++ b/libguile/simpos.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,1997,1998,2000, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/smob.c b/libguile/smob.c
index ad33933c3..86bb22f47 100644
--- a/libguile/smob.c
+++ b/libguile/smob.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2004, 2006, 2009 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -470,35 +471,13 @@ scm_make_smob (scm_t_bits tc)
   SCM_RETURN_NEWSMOB (tc, data);
 }
 
-
-/* {Initialization for the type of free cells}
- */
-
-static int
-free_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
-{
-  char buf[100];
-  sprintf (buf, "#<freed cell %p; GC missed a reference>",
-	   (void *) SCM_UNPACK (exp));
-  scm_puts (buf, port);
-  
-#if (SCM_DEBUG_CELL_ACCESSES == 1)
-  if (scm_debug_cell_accesses_p)
-    abort();
-#endif
-  
-
-  return 1;
-}
 
 
 /* Marking SMOBs using user-supplied mark procedures.  */
 
 
-/* The freelist and GC kind used for SMOB types that provide a custom mark
-   procedure.  */
-static void **smob_freelist = NULL;
-static int    smob_gc_kind = 0;
+/* The GC kind used for SMOB types that provide a custom mark procedure.  */
+static int smob_gc_kind;
 
 
 /* The generic SMOB mark procedure that gets called for SMOBs allocated with
@@ -633,10 +612,8 @@ void
 scm_smob_prehistory ()
 {
   long i;
-  scm_t_bits tc;
 
-  smob_freelist = GC_new_free_list ();
-  smob_gc_kind = GC_new_kind ((void **)smob_freelist,
+  smob_gc_kind = GC_new_kind (GC_new_free_list (),
 			      GC_MAKE_PROC (GC_new_proc (smob_mark), 0),
 			      0,
 			      /* Clear new objects.  As of version 7.1, libgc
@@ -659,10 +636,6 @@ scm_smob_prehistory ()
       scm_smobs[i].apply_3    = 0;
       scm_smobs[i].gsubr_type = 0;
     }
-
-  /* WARNING: This scm_make_smob_type call must be done first.  */
-  tc = scm_make_smob_type ("free", 0);
-  scm_set_smob_print (tc, free_print);
 }
 
 /*
diff --git a/libguile/smob.h b/libguile/smob.h
index 6f5033605..d435bacb8 100644
--- a/libguile/smob.h
+++ b/libguile/smob.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,1998,1999,2000,2001, 2004, 2006, 2009 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/snarf.h b/libguile/snarf.h
index c3113e1a7..9eaccf60c 100644
--- a/libguile/snarf.h
+++ b/libguile/snarf.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2009 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -345,19 +346,27 @@ SCM_SNARF_INIT(scm_set_smob_apply((tag), (c_name), (req), (opt), (rest));)
     };									\
   static SCM_UNUSED const SCM c_name = SCM_PACK (& c_name ## _raw_cell)
 
-#define SCM_IMMUTABLE_STRINGBUF(c_name, contents)			\
-  SCM_IMMUTABLE_DOUBLE_CELL (c_name,					\
-			     scm_tc7_stringbuf | SCM_I_STRINGBUF_F_SHARED, \
-			     (scm_t_bits) (contents),			\
-                             (scm_t_bits) sizeof (contents) - 1,	\
-			     (scm_t_bits) 0)
+#define SCM_IMMUTABLE_STRINGBUF(c_name, contents)	\
+  static SCM_UNUSED const				\
+  struct						\
+  {							\
+    scm_t_bits word_0;					\
+    scm_t_bits word_1;					\
+    const char buffer[sizeof (contents)];		\
+  }							\
+  c_name =						\
+    {							\
+      scm_tc7_stringbuf | SCM_I_STRINGBUF_F_SHARED,	\
+      sizeof (contents) - 1,				\
+      contents						\
+    }
 
 #define SCM_IMMUTABLE_STRING(c_name, contents)				\
   SCM_IMMUTABLE_STRINGBUF (scm_i_paste (c_name, _stringbuf), contents);	\
   SCM_IMMUTABLE_DOUBLE_CELL (c_name,					\
 			     scm_tc7_ro_string,				\
 			     (scm_t_bits) &scm_i_paste (c_name,		\
-							_stringbuf_raw_cell), \
+							_stringbuf),	\
 			     (scm_t_bits) 0,				\
 			     (scm_t_bits) sizeof (contents) - 1)
 
diff --git a/libguile/socket.c b/libguile/socket.c
index f34b6d49d..3a81ed9d0 100644
--- a/libguile/socket.c
+++ b/libguile/socket.c
@@ -1,18 +1,19 @@
-/* Copyright (C) 1996,1997,1998,2000,2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+/* Copyright (C) 1996,1997,1998,2000,2001, 2002, 2003, 2004, 2005, 2006, 2007, 2009 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -26,12 +27,13 @@
 #include <gmp.h>
 
 #include "libguile/_scm.h"
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
 #include "libguile/feature.h"
 #include "libguile/fports.h"
 #include "libguile/strings.h"
 #include "libguile/vectors.h"
 #include "libguile/dynwind.h"
+#include "libguile/srfi-13.h"
 
 #include "libguile/validate.h"
 #include "libguile/socket.h"
@@ -1413,6 +1415,8 @@ SCM_DEFINE (scm_recv, "recv!", 2, 1, 0,
 	    "protocols, if a packet larger than this limit is encountered\n"
 	    "then some data\n"
 	    "will be irrevocably lost.\n\n"
+	    "The data is assumed to be binary, and there is no decoding of\n"
+	    "of locale-encoded strings.\n\n"
 	    "The optional @var{flags} argument is a value or\n"
 	    "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
 	    "The value returned is the number of bytes read from the\n"
@@ -1427,6 +1431,7 @@ SCM_DEFINE (scm_recv, "recv!", 2, 1, 0,
   int flg;
   char *dest;
   size_t len;
+  SCM msg;
 
   SCM_VALIDATE_OPFPORT (1, sock);
   SCM_VALIDATE_STRING (2, buf);
@@ -1436,15 +1441,16 @@ SCM_DEFINE (scm_recv, "recv!", 2, 1, 0,
     flg = scm_to_int (flags);
   fd = SCM_FPORT_FDES (sock);
 
-  len =  scm_i_string_length (buf);
-  dest = scm_i_string_writable_chars (buf);
+  len = scm_i_string_length (buf);
+  msg = scm_i_make_string (len, &dest);
   SCM_SYSCALL (rv = recv (fd, dest, len, flg));
-  scm_i_string_stop_writing ();
+  scm_string_copy_x (buf, scm_from_int (0), 
+		     msg, scm_from_int (0), scm_from_size_t (len));
 
   if (rv == -1)
     SCM_SYSERROR;
 
-  scm_remember_upto_here_1 (buf);
+  scm_remember_upto_here_2 (buf, msg);
   return scm_from_int (rv);
 }
 #undef FUNC_NAME
@@ -1462,18 +1468,28 @@ SCM_DEFINE (scm_send, "send", 2, 1, 0,
 	    "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
 	    "Note that the data is written directly to the socket\n"
 	    "file descriptor:\n"
-	    "any unflushed buffered port data is ignored.")
+	    "any unflushed buffered port data is ignored.\n\n"
+	    "This operation is defined only for strings containing codepoints\n"
+	    "zero to 255.")
 #define FUNC_NAME s_scm_send
 {
   int rv;
   int fd;
   int flg;
-  const char *src;
+  char *src;
   size_t len;
 
   sock = SCM_COERCE_OUTPORT (sock);
   SCM_VALIDATE_OPFPORT (1, sock);
   SCM_VALIDATE_STRING (2, message);
+  
+  /* If the string is wide, see if it can be coerced into
+     a narrow string.  */
+  if (!scm_i_is_narrow_string (message)
+      || scm_i_try_narrow_string (message))
+    SCM_MISC_ERROR ("the message string is not 8-bit: ~s", 
+                        scm_list_1 (message));
+
   if (SCM_UNBNDP (flags))
     flg = 0;
   else
@@ -1481,6 +1497,7 @@ SCM_DEFINE (scm_send, "send", 2, 1, 0,
   fd = SCM_FPORT_FDES (sock);
 
   len = scm_i_string_length (message);
+  message = scm_i_string_start_writing (message);
   src = scm_i_string_writable_chars (message);
   SCM_SYSCALL (rv = send (fd, src, len, flg));
   scm_i_string_stop_writing ();
@@ -1549,6 +1566,7 @@ SCM_DEFINE (scm_recvfrom, "recvfrom!", 2, 3, 0,
 
   /* recvfrom will not necessarily return an address.  usually nothing
      is returned for stream sockets.  */
+  str = scm_i_string_start_writing (str);
   buf = scm_i_string_writable_chars (str);
   ((struct sockaddr *) &addr)->sa_family = AF_UNSPEC;
   SCM_SYSCALL (rv = recvfrom (fd, buf + offset,
@@ -1588,7 +1606,9 @@ SCM_DEFINE (scm_sendto, "sendto", 3, 1, 1,
 	    "set to be non-blocking.\n"
 	    "Note that the data is written directly to the socket\n"
 	    "file descriptor:\n"
-	    "any unflushed buffered port data is ignored.")
+	    "any unflushed buffered port data is ignored.\n"
+	    "This operation is defined only for strings containing codepoints\n"
+	    "zero to 255.")
 #define FUNC_NAME s_scm_sendto
 {
   int rv;
diff --git a/libguile/socket.h b/libguile/socket.h
index 133dbf7c6..fcddd780d 100644
--- a/libguile/socket.h
+++ b/libguile/socket.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,1997,2000,2001, 2004, 2005, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/sort.c b/libguile/sort.c
index 2a7317663..a9e4dda8c 100644
--- a/libguile/sort.c
+++ b/libguile/sort.c
@@ -1,17 +1,18 @@
-/* Copyright (C) 1999,2000,2001,2002, 2004, 2006, 2007, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1999,2000,2001,2002, 2004, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -38,8 +39,8 @@
 
 #include "libguile/_scm.h"
 #include "libguile/eval.h"
-#include "libguile/unif.h"
-#include "libguile/ramap.h"
+#include "libguile/arrays.h"
+#include "libguile/array-map.h"
 #include "libguile/feature.h"
 #include "libguile/vectors.h"
 #include "libguile/lang.h"
diff --git a/libguile/sort.h b/libguile/sort.h
index 51f292a5c..3ae86c2f3 100644
--- a/libguile/sort.h
+++ b/libguile/sort.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1999,2000, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/srcprop.c b/libguile/srcprop.c
index ee15f641d..77430bd82 100644
--- a/libguile/srcprop.c
+++ b/libguile/srcprop.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002, 2006, 2008 Free Software Foundation
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -68,7 +69,7 @@ SCM_GLOBAL_SYMBOL (scm_sym_breakpoint, "breakpoint");
  * car = tag
  * cbr = pos
  * ccr = copy
- * cdr = plist 
+ * cdr = alist
  */
 
 #define SRCPROPSP(p) (SCM_SMOB_PREDICATE (scm_tc16_srcprops, (p)))
@@ -77,7 +78,7 @@ SCM_GLOBAL_SYMBOL (scm_sym_breakpoint, "breakpoint");
 #define SRCPROPLINE(p) (SRCPROPPOS(p) >> 12)
 #define SRCPROPCOL(p) (SRCPROPPOS(p) & 0x0fffL)
 #define SRCPROPCOPY(p) (SCM_CELL_OBJECT(p,2))
-#define SRCPROPPLIST(p) (SCM_CELL_OBJECT_3(p))
+#define SRCPROPALIST(p) (SCM_CELL_OBJECT_3(p))
 #define SETSRCPROPBRK(p) \
  (SCM_SET_SMOB_FLAGS ((p), \
                       SCM_SMOB_FLAGS (p) | SCM_SOURCE_PROPERTY_FLAG_BREAK))
@@ -89,9 +90,11 @@ SCM_GLOBAL_SYMBOL (scm_sym_breakpoint, "breakpoint");
 #define SETSRCPROPLINE(p, l) SETSRCPROPPOS (p, l, SRCPROPCOL (p))
 #define SETSRCPROPCOL(p, c) SETSRCPROPPOS (p, SRCPROPLINE (p), c)
 #define SETSRCPROPCOPY(p, c) (SCM_SET_CELL_WORD(p, 2, c))
-#define SETSRCPROPPLIST(p, l) (SCM_SET_CELL_WORD(p, 3, l))
+#define SETSRCPROPALIST(p, l) (SCM_SET_CELL_WORD(p, 3, l))
 
 
+static SCM scm_srcprops_to_alist (SCM obj);
+
 
 scm_t_bits scm_tc16_srcprops;
 
@@ -101,7 +104,7 @@ srcprops_print (SCM obj, SCM port, scm_print_state *pstate)
   int writingp = SCM_WRITINGP (pstate);
   scm_puts ("#<srcprops ", port);
   SCM_SET_WRITINGP (pstate, 1);
-  scm_iprin1 (scm_srcprops_to_plist (obj), port, pstate);
+  scm_iprin1 (scm_srcprops_to_alist (obj), port, pstate);
   SCM_SET_WRITINGP (pstate, writingp);
   scm_putc ('>', port);
   return 1;
@@ -117,57 +120,57 @@ scm_c_source_property_breakpoint_p (SCM form)
 
 
 /*
- * We remember the last file name settings, so we can share that plist
+ * We remember the last file name settings, so we can share that alist
  * entry.  This works because scm_set_source_property_x does not use
- * assoc-set! for modifying the plist.
+ * assoc-set! for modifying the alist.
  *
  * This variable contains a protected cons, whose cdr is the cached
- * plist
+ * alist
  */
-static SCM scm_last_plist_filename;
+static SCM scm_last_alist_filename;
 
 SCM
-scm_make_srcprops (long line, int col, SCM filename, SCM copy, SCM plist)
+scm_make_srcprops (long line, int col, SCM filename, SCM copy, SCM alist)
 {
   if (!SCM_UNBNDP (filename))
     {
-      SCM old_plist = plist;
+      SCM old_alist = alist;
 
       /*
 	have to extract the acons, and operate on that, for
 	thread safety.
        */
-      SCM last_acons = SCM_CDR (scm_last_plist_filename);
-      if (old_plist == SCM_EOL
+      SCM last_acons = SCM_CDR (scm_last_alist_filename);
+      if (old_alist == SCM_EOL
 	  && SCM_CDAR (last_acons) == filename)
 	{
-	  plist = last_acons;
+	  alist = last_acons;
 	}
       else
 	{
-	  plist = scm_acons (scm_sym_filename, filename, plist);
-	  if (old_plist == SCM_EOL)
-	    SCM_SETCDR (scm_last_plist_filename, plist);
+	  alist = scm_acons (scm_sym_filename, filename, alist);
+	  if (old_alist == SCM_EOL)
+	    SCM_SETCDR (scm_last_alist_filename, alist);
 	}
     }
   
   SCM_RETURN_NEWSMOB3 (scm_tc16_srcprops,
 		       SRCPROPMAKPOS (line, col),
 		       copy,
-		       plist);
+		       alist);
 }
 
 
-SCM
-scm_srcprops_to_plist (SCM obj)
+static SCM
+scm_srcprops_to_alist (SCM obj)
 {
-  SCM plist = SRCPROPPLIST (obj);
+  SCM alist = SRCPROPALIST (obj);
   if (!SCM_UNBNDP (SRCPROPCOPY (obj)))
-    plist = scm_acons (scm_sym_copy, SRCPROPCOPY (obj), plist);
-  plist = scm_acons (scm_sym_column, scm_from_int (SRCPROPCOL (obj)), plist);
-  plist = scm_acons (scm_sym_line, scm_from_int (SRCPROPLINE (obj)), plist);
-  plist = scm_acons (scm_sym_breakpoint, scm_from_bool (SRCPROPBRK (obj)), plist);
-  return plist;
+    alist = scm_acons (scm_sym_copy, SRCPROPCOPY (obj), alist);
+  alist = scm_acons (scm_sym_column, scm_from_int (SRCPROPCOL (obj)), alist);
+  alist = scm_acons (scm_sym_line, scm_from_int (SRCPROPLINE (obj)), alist);
+  alist = scm_acons (scm_sym_breakpoint, scm_from_bool (SRCPROPBRK (obj)), alist);
+  return alist;
 }
 
 SCM_DEFINE (scm_source_properties, "source-properties", 1, 0, 0, 
@@ -183,7 +186,7 @@ SCM_DEFINE (scm_source_properties, "source-properties", 1, 0, 0,
     SCM_WRONG_TYPE_ARG (1, obj);
   p = scm_hashq_ref (scm_source_whash, obj, SCM_EOL);
   if (SRCPROPSP (p))
-    return scm_srcprops_to_plist (p);
+    return scm_srcprops_to_alist (p);
   else
     /* list from set-source-properties!, or SCM_EOL for not found */
     return p;
@@ -193,20 +196,83 @@ SCM_DEFINE (scm_source_properties, "source-properties", 1, 0, 0,
 /* Perhaps this procedure should look through an alist
    and try to make a srcprops-object...? */
 SCM_DEFINE (scm_set_source_properties_x, "set-source-properties!", 2, 0, 0,
-            (SCM obj, SCM plist),
-	    "Install the association list @var{plist} as the source property\n"
+            (SCM obj, SCM alist),
+	    "Install the association list @var{alist} as the source property\n"
 	    "list for @var{obj}.")
 #define FUNC_NAME s_scm_set_source_properties_x
 {
   SCM handle;
+  long line = 0, col = 0;
+  SCM fname = SCM_UNDEFINED, copy = SCM_UNDEFINED, breakpoint = SCM_BOOL_F;
+  SCM others = SCM_EOL;
+  SCM *others_cdrloc = &others;
+  int need_srcprops = 0;
+  SCM tail, key;
+
   SCM_VALIDATE_NIM (1, obj);
   if (SCM_MEMOIZEDP (obj))
     obj = SCM_MEMOIZED_EXP (obj);
   else if (!scm_is_pair (obj))
     SCM_WRONG_TYPE_ARG(1, obj);
-  handle = scm_hashq_create_handle_x (scm_source_whash, obj, plist);
 
-  return plist;
+  tail = alist;
+  while (!scm_is_null (tail))
+    {
+      key = SCM_CAAR (tail);
+      if (scm_is_eq (key, scm_sym_line))
+	{
+	  line = scm_to_long (SCM_CDAR (tail));
+	  need_srcprops = 1;
+	}
+      else if (scm_is_eq (key, scm_sym_column))
+	{
+	  col = scm_to_long (SCM_CDAR (tail));
+	  need_srcprops = 1;
+	}
+      else if (scm_is_eq (key, scm_sym_filename))
+	{
+	  fname = SCM_CDAR (tail);
+	  need_srcprops = 1;
+	}
+      else if (scm_is_eq (key, scm_sym_copy))
+	{
+	  copy = SCM_CDAR (tail);
+	  need_srcprops = 1;
+	}
+      else if (scm_is_eq (key, scm_sym_breakpoint))
+	{
+	  breakpoint = SCM_CDAR (tail);
+	  need_srcprops = 1;
+	}
+      else
+	{
+	  /* Do we allocate here, or clobber the caller's alist?
+
+	     Source properties aren't supposed to be used for anything
+	     except the special properties above, so the mainline case
+	     is that we never execute this else branch, and hence it
+	     doesn't matter much.
+
+	     We choose allocation here, as that seems safer.
+	  */
+	  *others_cdrloc = scm_cons (scm_cons (key, SCM_CDAR (tail)),
+				     SCM_EOL);
+	  others_cdrloc = SCM_CDRLOC (*others_cdrloc);
+	}
+      tail = SCM_CDR (tail);
+    }
+  if (need_srcprops)
+    {
+      alist = scm_make_srcprops (line, col, fname, copy, others);
+      if (scm_is_true (breakpoint))
+	SETSRCPROPBRK (alist);
+    }
+  else
+    alist = others;
+
+  handle = scm_hashq_create_handle_x (scm_source_whash, obj, alist);
+  SCM_SETCDR (handle, alist);
+  return alist;
 }
 #undef FUNC_NAME
 
@@ -224,15 +290,15 @@ SCM_DEFINE (scm_source_property, "source-property", 2, 0, 0,
     SCM_WRONG_TYPE_ARG (1, obj);
   p = scm_hashq_ref (scm_source_whash, obj, SCM_EOL);
   if (!SRCPROPSP (p))
-    goto plist;
+    goto alist;
   if      (scm_is_eq (scm_sym_breakpoint, key)) p = scm_from_bool (SRCPROPBRK (p));
   else if (scm_is_eq (scm_sym_line,       key)) p = scm_from_int (SRCPROPLINE (p));
   else if (scm_is_eq (scm_sym_column,     key)) p = scm_from_int (SRCPROPCOL (p));
   else if (scm_is_eq (scm_sym_copy,       key)) p = SRCPROPCOPY (p);
   else
     {
-      p = SRCPROPPLIST (p);
-    plist:
+      p = SRCPROPALIST (p);
+    alist:
       p = scm_assoc (key, p);
       return (SCM_NIMP (p) ? SCM_CDR (p) : SCM_BOOL_F);
     }
@@ -308,7 +374,7 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0,
   else
     {
       if (SRCPROPSP (p))
-	SETSRCPROPPLIST (p, scm_acons (key, datum, SRCPROPPLIST (p)));
+	SETSRCPROPALIST (p, scm_acons (key, datum, SRCPROPALIST (p)));
       else
 	SCM_WHASHSET (scm_source_whash, h, scm_acons (key, datum, p));
     }
@@ -326,7 +392,7 @@ scm_init_srcprop ()
   scm_source_whash = scm_make_weak_key_hash_table (scm_from_int (2047));
   scm_c_define ("source-whash", scm_source_whash);
 
-  scm_last_plist_filename
+  scm_last_alist_filename
     = scm_permanent_object (scm_cons (SCM_EOL,
 				      scm_acons (SCM_EOL, SCM_EOL, SCM_EOL)));
 
diff --git a/libguile/srcprop.h b/libguile/srcprop.h
index a467aa34e..89063bed4 100644
--- a/libguile/srcprop.h
+++ b/libguile/srcprop.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,2000,2001, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -63,13 +64,11 @@ SCM_API SCM scm_sym_breakpoint;
 
 
 SCM_API int scm_c_source_property_breakpoint_p (SCM form);
-SCM_API SCM scm_srcprops_to_plist (SCM obj);
 SCM_API SCM scm_make_srcprops (long line, int col, SCM fname, SCM copy, SCM plist);
 SCM_API SCM scm_source_property (SCM obj, SCM key);
 SCM_API SCM scm_set_source_property_x (SCM obj, SCM key, SCM datum);
 SCM_API SCM scm_source_properties (SCM obj);
 SCM_API SCM scm_set_source_properties_x (SCM obj, SCM props);
-SCM_API void scm_finish_srcprop (void);
 SCM_INTERNAL void scm_init_srcprop (void);
 
 #if SCM_ENABLE_DEPRECATED == 1
diff --git a/libguile/srfi-13.c b/libguile/srfi-13.c
index c8ca78027..4faa377d0 100644
--- a/libguile/srfi-13.c
+++ b/libguile/srfi-13.c
@@ -1,20 +1,21 @@
 /* srfi-13.c --- SRFI-13 procedures for Guile
  *
- * Copyright (C) 2001, 2004, 2005, 2006, 2008 Free Software Foundation, Inc.
+ * Copyright (C) 2001, 2004, 2005, 2006, 2008, 2009 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -23,41 +24,14 @@
 #endif
 
 #include <string.h>
-#include <ctype.h>
+#include <unicase.h>
+#include <unictype.h>
 
 #include "libguile.h"
 
 #include "libguile/srfi-13.h"
 #include "libguile/srfi-14.h"
 
-/* SCM_VALIDATE_SUBSTRING_SPEC_COPY is deprecated since it encourages
-   messing with the internal representation of strings.  We define our
-   own version since we use it so much and are messing with Guile
-   internals anyway.
-*/
-
-#define MY_VALIDATE_SUBSTRING_SPEC_COPY(pos_str, str, c_str,        \
-                                        pos_start, start, c_start,  \
-                                        pos_end, end, c_end)        \
-  do {                                                              \
-    SCM_VALIDATE_STRING (pos_str, str);                             \
-    c_str = scm_i_string_chars (str);                               \
-    scm_i_get_substring_spec (scm_i_string_length (str),            \
-			      start, &c_start, end, &c_end);        \
-  } while (0)
-
-/* Expecting "unsigned char *c_str" */
-#define MY_VALIDATE_SUBSTRING_SPEC_UCOPY(pos_str, str, c_str,           \
-                                         pos_start, start, c_start,     \
-                                         pos_end, end, c_end)           \
-  do {                                                                  \
-    const char *signed_c_str;                                           \
-    MY_VALIDATE_SUBSTRING_SPEC_COPY(pos_str, str, signed_c_str,         \
-                                    pos_start, start, c_start,          \
-                                    pos_end, end, c_end);               \
-    c_str = (unsigned char *) signed_c_str;                             \
-  } while (0)
-
 #define MY_VALIDATE_SUBSTRING_SPEC(pos_str, str,              \
                                    pos_start, start, c_start, \
                                    pos_end, end, c_end)       \
@@ -67,6 +41,18 @@
 			      start, &c_start, end, &c_end);  \
   } while (0)
 
+#define MY_SUBF_VALIDATE_SUBSTRING_SPEC(fname, pos_str, str,            \
+					pos_start, start, c_start,      \
+					pos_end, end, c_end)            \
+  do {                                                                  \
+    SCM_ASSERT_TYPE (scm_is_string (str), str, pos_str, fname, "string"); \
+    scm_i_get_substring_spec (scm_i_string_length (str),                \
+			      start, &c_start, end, &c_end);            \
+  } while (0)
+
+#define REF_IN_CHARSET(s, i, cs)					\
+  (scm_is_true (scm_char_set_contains_p ((cs), SCM_MAKE_CHAR (scm_i_string_ref (s, i)))))
+
 SCM_DEFINE (scm_string_null_p, "string-null?", 1, 0, 0,
            (SCM str),
 	    "Return @code{#t} if @var{str}'s length is zero, and\n"
@@ -110,25 +96,28 @@ SCM_DEFINE (scm_string_any, "string-any-c-code", 2, 2, 0,
 "@var{end}) then the return is @code{#f}.\n")
 #define FUNC_NAME s_scm_string_any
 {
-  const char *cstr;
   size_t cstart, cend;
   SCM res = SCM_BOOL_F;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s, cstr,
-				   3, start, cstart,
-				   4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s,
+			      3, start, cstart,
+			      4, end, cend);
 
   if (SCM_CHARP (char_pred))
     {
-      res = (memchr (cstr+cstart, (int) SCM_CHAR (char_pred),
-		     cend-cstart) == NULL
-	     ? SCM_BOOL_F : SCM_BOOL_T);
+      size_t i;
+      for (i = cstart; i < cend; i ++)
+	if (scm_i_string_ref (s, i) == SCM_CHAR (char_pred))
+	  {
+	    res = SCM_BOOL_T;
+	    break;
+	  }
     }
   else if (SCM_CHARSETP (char_pred))
     {
       size_t i;
       for (i = cstart; i < cend; i++)
-        if (SCM_CHARSET_GET (char_pred, cstr[i]))
+        if (REF_IN_CHARSET (s, i, char_pred))
 	  {
 	    res = SCM_BOOL_T;
 	    break;
@@ -141,10 +130,10 @@ SCM_DEFINE (scm_string_any, "string-any-c-code", 2, 2, 0,
 
       while (cstart < cend)
         {
-          res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cstart]));
+          res = pred_tramp (char_pred, 
+                            SCM_MAKE_CHAR (scm_i_string_ref (s, cstart)));
           if (scm_is_true (res))
             break;
-	  cstr = scm_i_string_chars (s);
           cstart++;
         }
     }
@@ -175,19 +164,17 @@ SCM_DEFINE (scm_string_every, "string-every-c-code", 2, 2, 0,
 "@var{end}) then the return is @code{#t}.\n")
 #define FUNC_NAME s_scm_string_every
 {
-  const char *cstr;
   size_t cstart, cend;
   SCM res = SCM_BOOL_T;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s, cstr,
-				   3, start, cstart,
-				   4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s,
+			      3, start, cstart,
+			      4, end, cend);
   if (SCM_CHARP (char_pred))
     {
-      char cchr = SCM_CHAR (char_pred);
       size_t i;
       for (i = cstart; i < cend; i++)
-        if (cstr[i] != cchr)
+        if (scm_i_string_ref (s, i) != SCM_CHAR (char_pred))
 	  {
 	    res = SCM_BOOL_F;
 	    break;
@@ -197,7 +184,7 @@ SCM_DEFINE (scm_string_every, "string-every-c-code", 2, 2, 0,
     {
       size_t i;
       for (i = cstart; i < cend; i++)
-        if (!SCM_CHARSET_GET (char_pred, cstr[i]))
+        if (!REF_IN_CHARSET (s, i, char_pred))
 	  {
 	    res = SCM_BOOL_F;
 	    break;
@@ -210,10 +197,10 @@ SCM_DEFINE (scm_string_every, "string-every-c-code", 2, 2, 0,
 
       while (cstart < cend)
         {
-          res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cstart]));
+          res = pred_tramp (char_pred, 
+                            SCM_MAKE_CHAR (scm_i_string_ref (s, cstart)));
           if (scm_is_false (res))
             break;
-          cstr = scm_i_string_chars (s);
           cstart++;
         }
     }
@@ -235,28 +222,49 @@ SCM_DEFINE (scm_string_tabulate, "string-tabulate", 2, 0, 0,
   size_t clen, i;
   SCM res;
   SCM ch;
-  char *p;
   scm_t_trampoline_1 proc_tramp;
 
   proc_tramp = scm_trampoline_1 (proc);
   SCM_ASSERT (proc_tramp, proc, SCM_ARG1, FUNC_NAME);
 
+  SCM_ASSERT_RANGE (2, len, scm_to_int (len) >= 0);
   clen = scm_to_size_t (len);
-  SCM_ASSERT_RANGE (2, len, clen >= 0);
 
-  res = scm_i_make_string (clen, &p);
-  i = 0;
-  while (i < clen)
-    {
-      /* The RES string remains untouched since nobody knows about it
-	 yet. No need to refetch P.
-      */
-      ch = proc_tramp (proc, scm_from_size_t (i));
-      if (!SCM_CHARP (ch))
-	SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (proc));
-      *p++ = SCM_CHAR (ch);
-      i++;
-    }
+  {
+    /* This function is more complicated than necessary for the sake
+       of speed.  */
+    scm_t_wchar *buf = scm_malloc (clen * sizeof (scm_t_wchar));
+    int wide = 0;
+    i = 0; 
+    while (i < clen)
+      {
+        ch = proc_tramp (proc, scm_from_size_t (i));
+        if (!SCM_CHARP (ch))
+          {
+            SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (proc));
+          }
+        if (SCM_CHAR (ch) > 255)
+          wide = 1;
+        buf[i] = SCM_CHAR (ch);
+        i++;
+      }
+    if (wide)
+      {
+        scm_t_wchar *wbuf = NULL;
+        res = scm_i_make_wide_string (clen, &wbuf);
+        memcpy (wbuf, buf, clen * sizeof (scm_t_wchar));
+        free (buf);
+      }
+    else
+      {
+        char *nbuf = NULL;
+        res = scm_i_make_string (clen, &nbuf);
+        for (i = 0; i < clen; i ++)
+          nbuf[i] = (unsigned char) buf[i];
+        free (buf);
+      }
+  }
+
   return res;
 }
 #undef FUNC_NAME
@@ -267,18 +275,34 @@ SCM_DEFINE (scm_substring_to_list, "string->list", 1, 2, 0,
 	    "Convert the string @var{str} into a list of characters.")
 #define FUNC_NAME s_scm_substring_to_list
 {
-  const char *cstr;
   size_t cstart, cend;
+  int narrow;
   SCM result = SCM_EOL;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, str, cstr,
-				   2, start, cstart,
-				   3, end, cend);
-  while (cstart < cend)
+  MY_VALIDATE_SUBSTRING_SPEC (1, str,
+			      2, start, cstart,
+			      3, end, cend);
+
+  /* This explicit narrow/wide logic (instead of just using
+     scm_i_string_ref) is for speed optimizaion.  */
+  narrow = scm_i_is_narrow_string (str);
+  if (narrow)
     {
-      cend--;
-      result = scm_cons (SCM_MAKE_CHAR (cstr[cend]), result);
-      cstr = scm_i_string_chars (str);
+      const char *buf = scm_i_string_chars (str);
+      while (cstart < cend)
+        {
+          cend--;
+          result = scm_cons (SCM_MAKE_CHAR (buf[cend]), result);
+        }
+    }
+  else
+    {
+      const scm_t_wchar *buf = scm_i_string_wide_chars (str);
+      while (cstart < cend)
+        {
+          cend--;
+          result = scm_cons (SCM_MAKE_CHAR (buf[cend]), result);
+        }
     }
   scm_remember_upto_here_1 (str);
   return result;
@@ -307,7 +331,7 @@ SCM_DEFINE (scm_reverse_list_to_string, "reverse-list->string", 1, 0, 0,
 #define FUNC_NAME s_scm_reverse_list_to_string
 {
   SCM result;
-  long i = scm_ilength (chrs);
+  long i = scm_ilength (chrs), j;
   char *data;
 
   if (i < 0)
@@ -315,18 +339,27 @@ SCM_DEFINE (scm_reverse_list_to_string, "reverse-list->string", 1, 0, 0,
   result = scm_i_make_string (i, &data);
 
   {
-    
-    data += i;
-    while (i > 0 && scm_is_pair (chrs))
+    SCM rest;
+    rest = chrs;
+    j = 0;
+    while (j < i && scm_is_pair (rest))
       {
-	SCM elt = SCM_CAR (chrs);
-
-	SCM_VALIDATE_CHAR (SCM_ARGn, elt);
-	data--;
-	*data = SCM_CHAR (elt);
-	chrs = SCM_CDR (chrs);
-	i--;
+        SCM elt = SCM_CAR (rest);
+        SCM_VALIDATE_CHAR (SCM_ARGn, elt);
+        j++;
+        rest = SCM_CDR (rest);
+      }
+    rest = chrs;
+    j = i;
+    result = scm_i_string_start_writing (result);
+    while (j > 0 && scm_is_pair (rest))
+      {
+        SCM elt = SCM_CAR (rest);
+        scm_i_string_set_x (result, j-1, SCM_CHAR (elt));
+        rest = SCM_CDR (rest);
+        j--;
       }
+    scm_i_string_stop_writing ();
   }
 
   return result;
@@ -339,18 +372,6 @@ SCM_SYMBOL (scm_sym_strict_infix, "strict-infix");
 SCM_SYMBOL (scm_sym_suffix, "suffix");
 SCM_SYMBOL (scm_sym_prefix, "prefix");
 
-static void
-append_string (char **sp, size_t *lp, SCM str)
-{
-  size_t len;
-  len = scm_c_string_length (str);
-  if (len > *lp)
-    len = *lp;
-  memcpy (*sp, scm_i_string_chars (str), len);
-  *lp -= len;
-  *sp += len;
-}
-
 SCM_DEFINE (scm_string_join, "string-join", 1, 2, 0,
             (SCM ls, SCM delimiter, SCM grammar),
 	    "Append the string in the string list @var{ls}, using the string\n"
@@ -381,8 +402,6 @@ SCM_DEFINE (scm_string_join, "string-join", 1, 2, 0,
   SCM result;
   int gram = GRAM_INFIX;
   size_t del_len = 0;
-  size_t len = 0;
-  char *p;
   long strings = scm_ilength (ls);
 
   /* Validate the string list.  */
@@ -396,7 +415,10 @@ SCM_DEFINE (scm_string_join, "string-join", 1, 2, 0,
       del_len = 1;
     }
   else
-    del_len = scm_c_string_length (delimiter);
+    {
+      SCM_VALIDATE_STRING (2, delimiter);
+      del_len = scm_i_string_length (delimiter);
+    }
 
   /* Validate the grammar symbol and remember the grammar.  */
   if (SCM_UNBNDP (grammar))
@@ -412,33 +434,12 @@ SCM_DEFINE (scm_string_join, "string-join", 1, 2, 0,
   else
     SCM_WRONG_TYPE_ARG (3, grammar);
 
-  /* Check grammar constraints and calculate the space required for
-     the delimiter(s).  */
-  switch (gram)
-    {
-    case GRAM_INFIX:
-      if (!scm_is_null (ls))
-	len = (strings > 0) ? ((strings - 1) * del_len) : 0;
-      break;
-    case GRAM_STRICT_INFIX:
-      if (strings == 0)
-	SCM_MISC_ERROR ("strict-infix grammar requires non-empty list",
-			SCM_EOL);
-      len = (strings - 1) * del_len;
-      break;
-    default:
-      len = strings * del_len;
-      break;
-    }
-
-  tmp = ls;
-  while (scm_is_pair (tmp))
-    {
-      len += scm_c_string_length (SCM_CAR (tmp));
-      tmp = SCM_CDR (tmp);
-    }
+  /* Check grammar constraints.  */
+  if (strings == 0 && gram == GRAM_STRICT_INFIX)
+    SCM_MISC_ERROR ("strict-infix grammar requires non-empty list",
+		    SCM_EOL);
 
-  result = scm_i_make_string (len, &p);
+  result = scm_i_make_string (0, NULL);
 
   tmp = ls;
   switch (gram)
@@ -447,18 +448,18 @@ SCM_DEFINE (scm_string_join, "string-join", 1, 2, 0,
     case GRAM_STRICT_INFIX:
       while (scm_is_pair (tmp))
 	{
-	  append_string (&p, &len, SCM_CAR (tmp));
+	  result = scm_string_append (scm_list_2 (result, SCM_CAR (tmp)));
 	  if (!scm_is_null (SCM_CDR (tmp)) && del_len > 0)
-	    append_string (&p, &len, delimiter);
+	    result = scm_string_append (scm_list_2 (result, delimiter));
 	  tmp = SCM_CDR (tmp);
 	}
       break;
     case GRAM_SUFFIX:
       while (scm_is_pair (tmp))
 	{
-	  append_string (&p, &len, SCM_CAR (tmp));
+	  result = scm_string_append (scm_list_2 (result, SCM_CAR (tmp)));
 	  if (del_len > 0)
-	    append_string (&p, &len, delimiter);
+	    result = scm_string_append (scm_list_2 (result, delimiter));
 	  tmp = SCM_CDR (tmp);
 	}
       break;
@@ -466,8 +467,8 @@ SCM_DEFINE (scm_string_join, "string-join", 1, 2, 0,
       while (scm_is_pair (tmp))
 	{
 	  if (del_len > 0)
-	    append_string (&p, &len, delimiter);
-	  append_string (&p, &len, SCM_CAR (tmp));
+	    result = scm_string_append (scm_list_2 (result, delimiter));
+	  result = scm_string_append (scm_list_2 (result, SCM_CAR (tmp)));
 	  tmp = SCM_CDR (tmp);
 	}
       break;
@@ -507,20 +508,22 @@ SCM_DEFINE (scm_srfi13_substring_copy, "string-copy", 1, 2, 0,
 	    "@var{str} which is copied.")
 #define FUNC_NAME s_scm_srfi13_substring_copy
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, str, cstr,
-				   2, start, cstart,
-				   3, end, cend);
-  return scm_c_substring_copy (str, cstart, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, str,
+			      2, start, cstart,
+			      3, end, cend);
+  return scm_i_substring_copy (str, cstart, cend);
 }
 #undef FUNC_NAME
 
 SCM 
 scm_string_copy (SCM str)
 {
-  return scm_c_substring (str, 0, scm_c_string_length (str));
+  if (!scm_is_string (str))
+    scm_wrong_type_arg ("scm_string_copy", 0, str);
+
+  return scm_i_substring (str, 0, scm_i_string_length (str));
 }
 
 SCM_DEFINE (scm_string_copy_x, "string-copy!", 3, 2, 0,
@@ -534,22 +537,24 @@ SCM_DEFINE (scm_string_copy_x, "string-copy!", 3, 2, 0,
 	    "string.")
 #define FUNC_NAME s_scm_string_copy_x
 {
-  const char *cstr;
-  char *ctarget;
-  size_t cstart, cend, ctstart, dummy, len;
+  size_t cstart, cend, ctstart, dummy, len, i;
   SCM sdummy = SCM_UNDEFINED;
 
   MY_VALIDATE_SUBSTRING_SPEC (1, target,
 			      2, tstart, ctstart,
 			      2, sdummy, dummy);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (3, s, cstr,
-				   4, start, cstart,
-				   5, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (3, s,
+			      4, start, cstart,
+			      5, end, cend);
   len = cend - cstart;
   SCM_ASSERT_RANGE (3, s, len <= scm_i_string_length (target) - ctstart);
 
-  ctarget = scm_i_string_writable_chars (target);
-  memmove (ctarget + ctstart, cstr + cstart, len);
+  target = scm_i_string_start_writing (target);
+  for (i = 0; i < cend - cstart; i++)
+    {
+      scm_i_string_set_x (target, ctstart + i, 
+                          scm_i_string_ref (s, cstart + i));
+    }
   scm_i_string_stop_writing ();
   scm_remember_upto_here_1 (target);
 
@@ -620,7 +625,6 @@ SCM_DEFINE (scm_string_pad, "string-pad", 2, 3, 0,
 	    "string is longer than @var{len}, it is truncated on the right.")
 #define FUNC_NAME s_scm_string_pad
 {
-  char cchr;
   size_t cstart, cend, clen;
 
   MY_VALIDATE_SUBSTRING_SPEC (1, s,
@@ -629,23 +633,19 @@ SCM_DEFINE (scm_string_pad, "string-pad", 2, 3, 0,
   clen = scm_to_size_t (len);
 
   if (SCM_UNBNDP (chr))
-    cchr = ' ';
+    chr = SCM_MAKE_CHAR (' ');
   else
     {
       SCM_VALIDATE_CHAR (3, chr);
-      cchr = SCM_CHAR (chr);
     }
   if (clen < (cend - cstart))
-    return scm_c_substring (s, cend - clen, cend);
+    return scm_i_substring (s, cend - clen, cend);
   else
     {
       SCM result;
-      char *dst;
-
-      result = scm_i_make_string (clen, &dst);
-      memset (dst, cchr, (clen - (cend - cstart)));
-      memmove (dst + clen - (cend - cstart),
-	       scm_i_string_chars (s) + cstart, cend - cstart);
+      result = (scm_string_append 
+		(scm_list_2 (scm_c_make_string (clen - (cend - cstart), chr),
+			     scm_i_substring (s, cstart, cend))));
       return result;
     }
 }
@@ -660,7 +660,6 @@ SCM_DEFINE (scm_string_pad_right, "string-pad-right", 2, 3, 0,
 	    "string is longer than @var{len}, it is truncated on the left.")
 #define FUNC_NAME s_scm_string_pad_right
 {
-  char cchr;
   size_t cstart, cend, clen;
 
   MY_VALIDATE_SUBSTRING_SPEC (1, s,
@@ -669,22 +668,21 @@ SCM_DEFINE (scm_string_pad_right, "string-pad-right", 2, 3, 0,
   clen = scm_to_size_t (len);
 
   if (SCM_UNBNDP (chr))
-    cchr = ' ';
+    chr = SCM_MAKE_CHAR (' ');
   else
     {
       SCM_VALIDATE_CHAR (3, chr);
-      cchr = SCM_CHAR (chr);
     }
   if (clen < (cend - cstart))
-    return scm_c_substring (s, cstart, cstart + clen);
+    return scm_i_substring (s, cstart, cstart + clen);
   else
     {
       SCM result;
-      char *dst;
 
-      result = scm_i_make_string (clen, &dst);
-      memset (dst + (cend - cstart), cchr, clen - (cend - cstart));
-      memmove (dst, scm_i_string_chars (s) + cstart, cend - cstart);
+      result = (scm_string_append 
+		(scm_list_2 (scm_i_substring (s, cstart, cend),
+			     scm_c_make_string (clen - (cend - cstart), chr))));
+
       return result;
     }
 }
@@ -713,27 +711,25 @@ SCM_DEFINE (scm_string_trim, "string-trim", 1, 3, 0,
 	    "trimmed.")
 #define FUNC_NAME s_scm_string_trim
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s, cstr,
-				   3, start, cstart,
-				   4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s,
+			      3, start, cstart,
+			      4, end, cend);
   if (SCM_UNBNDP (char_pred))
     {
       while (cstart < cend)
 	{
-	  if (!isspace((int) (unsigned char) cstr[cstart]))
+	  if (!uc_is_c_whitespace (scm_i_string_ref (s, cstart)))
 	    break;
 	  cstart++;
 	}
     }
   else if (SCM_CHARP (char_pred))
     {
-      char chr = SCM_CHAR (char_pred);
       while (cstart < cend)
 	{
-	  if (chr != cstr[cstart])
+	  if (scm_i_string_ref (s, cstart) != SCM_CHAR (char_pred))
 	    break;
 	  cstart++;
 	}
@@ -742,7 +738,7 @@ SCM_DEFINE (scm_string_trim, "string-trim", 1, 3, 0,
     {
       while (cstart < cend)
 	{
-	  if (!SCM_CHARSET_GET (char_pred, cstr[cstart]))
+	  if (!REF_IN_CHARSET (s, cstart, char_pred))
 	    break;
 	  cstart++;
 	}
@@ -756,21 +752,20 @@ SCM_DEFINE (scm_string_trim, "string-trim", 1, 3, 0,
 	{
 	  SCM res;
 
-	  res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cstart]));
+	  res = pred_tramp (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cstart)));
 	  if (scm_is_false (res))
 	    break;
-	  cstr = scm_i_string_chars (s);
 	  cstart++;
 	}
     }
-  return scm_c_substring (s, cstart, cend);
+  return scm_i_substring (s, cstart, cend);
 }
 #undef FUNC_NAME
 
 
 SCM_DEFINE (scm_string_trim_right, "string-trim-right", 1, 3, 0,
 	    (SCM s, SCM char_pred, SCM start, SCM end),
-	    "Trim @var{s} by skipping over all characters on the rightt\n"
+	    "Trim @var{s} by skipping over all characters on the right\n"
 	    "that satisfy the parameter @var{char_pred}:\n"
 	    "\n"
 	    "@itemize @bullet\n"
@@ -791,27 +786,25 @@ SCM_DEFINE (scm_string_trim_right, "string-trim-right", 1, 3, 0,
 	    "trimmed.")
 #define FUNC_NAME s_scm_string_trim_right
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s, cstr,
-				   3, start, cstart,
-				   4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s,
+			      3, start, cstart,
+			      4, end, cend);
   if (SCM_UNBNDP (char_pred))
     {
       while (cstart < cend)
 	{
-	  if (!isspace((int) (unsigned char) cstr[cend - 1]))
+	  if (!uc_is_c_whitespace (scm_i_string_ref (s, cend - 1)))
 	    break;
 	  cend--;
 	}
     }
   else if (SCM_CHARP (char_pred))
     {
-      char chr = SCM_CHAR (char_pred);
       while (cstart < cend)
 	{
-	  if (chr != cstr[cend - 1])
+	  if (scm_i_string_ref (s, cend - 1) != SCM_CHAR (char_pred))
 	    break;
 	  cend--;
 	}
@@ -820,7 +813,7 @@ SCM_DEFINE (scm_string_trim_right, "string-trim-right", 1, 3, 0,
     {
       while (cstart < cend)
 	{
-	  if (!SCM_CHARSET_GET (char_pred, cstr[cend - 1]))
+	  if (!REF_IN_CHARSET (s, cend-1, char_pred))
 	    break;
 	  cend--;
 	}
@@ -834,14 +827,13 @@ SCM_DEFINE (scm_string_trim_right, "string-trim-right", 1, 3, 0,
 	{
 	  SCM res;
 
-	  res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cend - 1]));
+	  res = pred_tramp (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cend - 1)));
 	  if (scm_is_false (res))
 	    break;
-	  cstr = scm_i_string_chars (s);
 	  cend--;
 	}
     }
-  return scm_c_substring (s, cstart, cend);
+  return scm_i_substring (s, cstart, cend);
 }
 #undef FUNC_NAME
 
@@ -869,39 +861,37 @@ SCM_DEFINE (scm_string_trim_both, "string-trim-both", 1, 3, 0,
 	    "trimmed.")
 #define FUNC_NAME s_scm_string_trim_both
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s, cstr,
-				   3, start, cstart,
-				   4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s,
+			      3, start, cstart,
+			      4, end, cend);
   if (SCM_UNBNDP (char_pred))
     {
       while (cstart < cend)
 	{
-	  if (!isspace((int) (unsigned char) cstr[cstart]))
+	  if (!uc_is_c_whitespace (scm_i_string_ref (s, cstart)))
 	    break;
 	  cstart++;
 	}
       while (cstart < cend)
 	{
-	  if (!isspace((int) (unsigned char) cstr[cend - 1]))
+	  if (!uc_is_c_whitespace (scm_i_string_ref (s, cend - 1)))
 	    break;
 	  cend--;
 	}
     }
   else if (SCM_CHARP (char_pred))
     {
-      char chr = SCM_CHAR (char_pred);
       while (cstart < cend)
 	{
-	  if (chr != cstr[cstart])
+	  if (scm_i_string_ref (s, cstart) != SCM_CHAR(char_pred))
 	    break;
 	  cstart++;
 	}
       while (cstart < cend)
 	{
-	  if (chr != cstr[cend - 1])
+	  if (scm_i_string_ref (s, cend - 1) != SCM_CHAR (char_pred))
 	    break;
 	  cend--;
 	}
@@ -910,13 +900,13 @@ SCM_DEFINE (scm_string_trim_both, "string-trim-both", 1, 3, 0,
     {
       while (cstart < cend)
 	{
-	  if (!SCM_CHARSET_GET (char_pred, cstr[cstart]))
+	  if (!REF_IN_CHARSET (s, cstart, char_pred))
 	    break;
 	  cstart++;
 	}
       while (cstart < cend)
 	{
-	  if (!SCM_CHARSET_GET (char_pred, cstr[cend - 1]))
+	  if (!REF_IN_CHARSET (s, cend-1, char_pred))
 	    break;
 	  cend--;
 	}
@@ -930,24 +920,22 @@ SCM_DEFINE (scm_string_trim_both, "string-trim-both", 1, 3, 0,
 	{
 	  SCM res;
 
-	  res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cstart]));
+	  res = pred_tramp (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cstart)));
 	  if (scm_is_false (res))
 	    break;
-	  cstr = scm_i_string_chars (s);
 	  cstart++;
 	}
       while (cstart < cend)
 	{
 	  SCM res;
 
-	  res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cend - 1]));
+	  res = pred_tramp (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cend - 1)));
 	  if (scm_is_false (res))
 	    break;
-	  cstr = scm_i_string_chars (s);
 	  cend--;
 	}
     }
-  return scm_c_substring (s, cstart, cend);
+  return scm_i_substring (s, cstart, cend);
 }
 #undef FUNC_NAME
 
@@ -958,9 +946,7 @@ SCM_DEFINE (scm_substring_fill_x, "string-fill!", 2, 2, 0,
 	    "returns an unspecified value.")
 #define FUNC_NAME s_scm_substring_fill_x
 {
-  char *cstr;
   size_t cstart, cend;
-  int c;
   size_t k;
 
   /* Older versions of Guile provided the function
@@ -982,13 +968,13 @@ SCM_DEFINE (scm_substring_fill_x, "string-fill!", 2, 2, 0,
   MY_VALIDATE_SUBSTRING_SPEC (1, str,
 			      3, start, cstart,
 			      4, end, cend);
-  SCM_VALIDATE_CHAR_COPY (2, chr, c);
+  SCM_VALIDATE_CHAR (2, chr);
+
 
-  cstr = scm_i_string_writable_chars (str);
+  str = scm_i_string_start_writing (str);
   for (k = cstart; k < cend; k++)
-    cstr[k] = c;
+    scm_i_string_set_x (str, k, SCM_CHAR (chr));
   scm_i_string_stop_writing ();
-  scm_remember_upto_here_1 (str);
 
   return SCM_UNSPECIFIED;
 }
@@ -1010,28 +996,29 @@ SCM_DEFINE (scm_string_compare, "string-compare", 5, 4, 0,
 	    "@var{i} is the first position that does not match.")
 #define FUNC_NAME s_scm_string_compare
 {
-  const unsigned char *cstr1, *cstr2;
   size_t cstart1, cend1, cstart2, cend2;
   SCM proc;
 
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (1, s1, cstr1,
-                                    6, start1, cstart1,
-                                    7, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (2, s2, cstr2,
-                                    8, start2, cstart2,
-                                    9, end2, cend2);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s1,
+			      6, start1, cstart1,
+			      7, end1, cend1);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s2,
+			      8, start2, cstart2,
+			      9, end2, cend2);
   SCM_VALIDATE_PROC (3, proc_lt);
   SCM_VALIDATE_PROC (4, proc_eq);
   SCM_VALIDATE_PROC (5, proc_gt);
 
   while (cstart1 < cend1 && cstart2 < cend2)
     {
-      if (cstr1[cstart1] < cstr2[cstart2])
+      if (scm_i_string_ref (s1, cstart1)
+	  < scm_i_string_ref (s2, cstart2))
 	{
 	  proc = proc_lt;
 	  goto ret;
 	}
-      else if (cstr1[cstart1] > cstr2[cstart2])
+      else if (scm_i_string_ref (s1, cstart1) 
+	       > scm_i_string_ref (s2, cstart2))
 	{
 	  proc = proc_gt;
 	  goto ret;
@@ -1060,33 +1047,33 @@ SCM_DEFINE (scm_string_compare_ci, "string-compare-ci", 5, 4, 0,
 	    "equal to, or greater than @var{s2}.  The mismatch index is the\n"
 	    "largest index @var{i} such that for every 0 <= @var{j} <\n"
 	    "@var{i}, @var{s1}[@var{j}] = @var{s2}[@var{j}] -- that is,\n"
-	    "@var{i} is the first position that does not match.  The\n"
-	    "character comparison is done case-insensitively.")
+	    "@var{i} is the first position where the lowercased letters \n"
+	    "do not match.\n")
 #define FUNC_NAME s_scm_string_compare_ci
 {
-  const unsigned char *cstr1, *cstr2;
   size_t cstart1, cend1, cstart2, cend2;
   SCM proc;
 
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (1, s1, cstr1,
-                                    6, start1, cstart1,
-                                    7, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (2, s2, cstr2,
-                                    8, start2, cstart2,
-                                    9, end2, cend2);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s1,
+			      6, start1, cstart1,
+			      7, end1, cend1);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s2,
+			      8, start2, cstart2,
+			      9, end2, cend2);
   SCM_VALIDATE_PROC (3, proc_lt);
   SCM_VALIDATE_PROC (4, proc_eq);
   SCM_VALIDATE_PROC (5, proc_gt);
 
   while (cstart1 < cend1 && cstart2 < cend2)
     {
-      if (scm_c_downcase (cstr1[cstart1]) < scm_c_downcase (cstr2[cstart2]))
+      if (uc_tolower (uc_toupper (scm_i_string_ref (s1, cstart1)))
+	  < uc_tolower (uc_toupper (scm_i_string_ref (s2, cstart2))))
 	{
 	  proc = proc_lt;
 	  goto ret;
 	}
-      else if (scm_c_downcase (cstr1[cstart1]) 
-	       > scm_c_downcase (cstr2[cstart2]))
+      else if (uc_tolower (uc_toupper (scm_i_string_ref (s1, cstart1)))
+	       > uc_tolower (uc_toupper (scm_i_string_ref (s2, cstart2))))
 	{
 	  proc = proc_gt;
 	  goto ret;
@@ -1108,42 +1095,83 @@ SCM_DEFINE (scm_string_compare_ci, "string-compare-ci", 5, 4, 0,
 }
 #undef FUNC_NAME
 
-
-SCM_DEFINE (scm_string_eq, "string=", 2, 4, 0,
-	    (SCM s1, SCM s2, SCM start1, SCM end1, SCM start2, SCM end2),
-	    "Return @code{#f} if @var{s1} and @var{s2} are not equal, a true\n"
-	    "value otherwise.")
-#define FUNC_NAME s_scm_string_eq
+/* This function compares two substrings, S1 from START1 to END1 and
+   S2 from START2 to END2, possibly case insensitively, and returns
+   one of the parameters LESSTHAN, GREATERTHAN, LONGER, SHORTER, or
+   EQUAL depending if S1 is less than S2, greater than S2, longer,
+   shorter, or equal. */
+static SCM
+compare_strings (const char *fname, int case_insensitive,
+		 SCM s1, SCM s2, SCM start1, SCM end1, SCM start2, SCM end2,
+		 SCM lessthan, SCM greaterthan, SCM longer, SCM shorter, SCM equal)
 {
-  const char *cstr1, *cstr2;
   size_t cstart1, cend1, cstart2, cend2;
+  SCM ret;
+  scm_t_wchar a, b;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cstr1,
+  MY_SUBF_VALIDATE_SUBSTRING_SPEC (fname, 1, s1,
 				   3, start1, cstart1,
 				   4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
+  MY_SUBF_VALIDATE_SUBSTRING_SPEC (fname, 2, s2,
 				   5, start2, cstart2,
 				   6, end2, cend2);
 
-  if ((cend1 - cstart1) != (cend2 - cstart2))
-    goto false;
-
-  while (cstart1 < cend1)
+  while (cstart1 < cend1 && cstart2 < cend2)
     {
-      if (cstr1[cstart1] < cstr2[cstart2])
-	goto false;
-      else if (cstr1[cstart1] > cstr2[cstart2])
-	goto false;
+      if (case_insensitive)
+	{
+	  a = uc_tolower (uc_toupper (scm_i_string_ref (s1, cstart1)));
+	  b = uc_tolower (uc_toupper (scm_i_string_ref (s2, cstart2)));
+	}
+      else
+	{
+	  a = scm_i_string_ref (s1, cstart1);
+	  b = scm_i_string_ref (s2, cstart2);
+	}
+      if (a < b)
+	{
+	  ret = lessthan;
+	  goto done;
+	}
+      else if (a > b)
+	{
+	  ret = greaterthan;
+	  goto done;
+	}
       cstart1++;
       cstart2++;
     }
-  
-  scm_remember_upto_here_2 (s1, s2);
-  return scm_from_size_t (cstart1);
+  if (cstart1 < cend1)
+    {
+      ret = longer;
+      goto done;
+    }
+  else if (cstart2 < cend2)
+    {
+      ret = shorter;
+      goto done;
+    }
+  else
+    {
+      ret = equal;
+      goto done;
+    }
 
- false:
+ done:
   scm_remember_upto_here_2 (s1, s2);
-  return SCM_BOOL_F;
+  return ret;
+}
+
+
+SCM_DEFINE (scm_string_eq, "string=", 2, 4, 0,
+	    (SCM s1, SCM s2, SCM start1, SCM end1, SCM start2, SCM end2),
+	    "Return @code{#f} if @var{s1} and @var{s2} are not equal, a true\n"
+	    "value otherwise.")
+#define FUNC_NAME s_scm_string_eq
+{
+  return compare_strings (FUNC_NAME, 0, 
+			  s1, s2, start1, end1, start2, end2,
+			  SCM_BOOL_F, SCM_BOOL_F, SCM_BOOL_F, SCM_BOOL_F, SCM_BOOL_T);
 }
 #undef FUNC_NAME
 
@@ -1154,39 +1182,9 @@ SCM_DEFINE (scm_string_neq, "string<>", 2, 4, 0,
 	    "value otherwise.")
 #define FUNC_NAME s_scm_string_neq
 {
-  const char *cstr1, *cstr2;
-  size_t cstart1, cend1, cstart2, cend2;
-
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cstr1,
-				   3, start1, cstart1,
-				   4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
-				   5, start2, cstart2,
-				   6, end2, cend2);
-
-  while (cstart1 < cend1 && cstart2 < cend2)
-    {
-      if (cstr1[cstart1] < cstr2[cstart2])
-	goto true;
-      else if (cstr1[cstart1] > cstr2[cstart2])
-	goto true;
-      cstart1++;
-      cstart2++;
-    }
-  if (cstart1 < cend1)
-    goto true;
-  else if (cstart2 < cend2)
-    goto true;
-  else
-    goto false;
-
- true:
-  scm_remember_upto_here_2 (s1, s2);
-  return scm_from_size_t (cstart1);
-
- false:
-  scm_remember_upto_here_2 (s1, s2);
-  return SCM_BOOL_F;
+  return compare_strings (FUNC_NAME, 0,
+			  s1, s2, start1, end1, start2, end2,
+			  SCM_BOOL_T, SCM_BOOL_T, SCM_BOOL_T, SCM_BOOL_T, SCM_BOOL_F);
 }
 #undef FUNC_NAME
 
@@ -1197,39 +1195,9 @@ SCM_DEFINE (scm_string_lt, "string<", 2, 4, 0,
 	    "true value otherwise.")
 #define FUNC_NAME s_scm_string_lt
 {
-  const unsigned char *cstr1, *cstr2;
-  size_t cstart1, cend1, cstart2, cend2;
-
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (1, s1, cstr1,
-                                    3, start1, cstart1,
-                                    4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (2, s2, cstr2,
-                                    5, start2, cstart2,
-                                    6, end2, cend2);
-
-  while (cstart1 < cend1 && cstart2 < cend2)
-    {
-      if (cstr1[cstart1] < cstr2[cstart2])
-	goto true;
-      else if (cstr1[cstart1] > cstr2[cstart2])
-	goto false;
-      cstart1++;
-      cstart2++;
-    }
-  if (cstart1 < cend1)
-    goto false;
-  else if (cstart2 < cend2)
-    goto true;
-  else
-    goto false;
-
- true:
-  scm_remember_upto_here_2 (s1, s2);
-  return scm_from_size_t (cstart1);
-
- false:
-  scm_remember_upto_here_2 (s1, s2);
-  return SCM_BOOL_F;
+  return compare_strings (FUNC_NAME, 0,
+			  s1, s2, start1, end1, start2, end2,
+			  SCM_BOOL_T, SCM_BOOL_F, SCM_BOOL_T, SCM_BOOL_F, SCM_BOOL_F);
 }
 #undef FUNC_NAME
 
@@ -1240,39 +1208,9 @@ SCM_DEFINE (scm_string_gt, "string>", 2, 4, 0,
 	    "true value otherwise.")
 #define FUNC_NAME s_scm_string_gt
 {
-  const unsigned char *cstr1, *cstr2;
-  size_t cstart1, cend1, cstart2, cend2;
-
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (1, s1, cstr1,
-                                    3, start1, cstart1,
-                                    4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (2, s2, cstr2,
-                                    5, start2, cstart2,
-                                    6, end2, cend2);
-
-  while (cstart1 < cend1 && cstart2 < cend2)
-    {
-      if (cstr1[cstart1] < cstr2[cstart2])
-	goto false;
-      else if (cstr1[cstart1] > cstr2[cstart2])
-	goto true;
-      cstart1++;
-      cstart2++;
-    }
-  if (cstart1 < cend1)
-    goto true;
-  else if (cstart2 < cend2)
-    goto false;
-  else
-    goto false;
-
- true:
-  scm_remember_upto_here_2 (s1, s2);
-  return scm_from_size_t (cstart1);
-
- false:
-  scm_remember_upto_here_2 (s1, s2);
-  return SCM_BOOL_F;
+  return compare_strings (FUNC_NAME, 0,
+			  s1, s2, start1, end1, start2, end2,
+			  SCM_BOOL_F, SCM_BOOL_T, SCM_BOOL_F, SCM_BOOL_T, SCM_BOOL_F);
 }
 #undef FUNC_NAME
 
@@ -1283,39 +1221,9 @@ SCM_DEFINE (scm_string_le, "string<=", 2, 4, 0,
 	    "value otherwise.")
 #define FUNC_NAME s_scm_string_le
 {
-  const unsigned char *cstr1, *cstr2;
-  size_t cstart1, cend1, cstart2, cend2;
-
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (1, s1, cstr1,
-                                    3, start1, cstart1,
-                                    4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (2, s2, cstr2,
-                                    5, start2, cstart2,
-                                    6, end2, cend2);
-
-  while (cstart1 < cend1 && cstart2 < cend2)
-    {
-      if (cstr1[cstart1] < cstr2[cstart2])
-	goto true;
-      else if (cstr1[cstart1] > cstr2[cstart2])
-	goto false;
-      cstart1++;
-      cstart2++;
-    }
-  if (cstart1 < cend1)
-    goto false;
-  else if (cstart2 < cend2)
-    goto true;
-  else
-    goto true;
-
- true:
-  scm_remember_upto_here_2 (s1, s2);
-  return scm_from_size_t (cstart1);
-
- false:
-  scm_remember_upto_here_2 (s1, s2);
-  return SCM_BOOL_F;
+  return compare_strings (FUNC_NAME, 0,
+			  s1, s2, start1, end1, start2, end2,
+			  SCM_BOOL_T, SCM_BOOL_F, SCM_BOOL_T, SCM_BOOL_F, SCM_BOOL_T);
 }
 #undef FUNC_NAME
 
@@ -1326,39 +1234,9 @@ SCM_DEFINE (scm_string_ge, "string>=", 2, 4, 0,
 	    "otherwise.")
 #define FUNC_NAME s_scm_string_ge
 {
-  const unsigned char *cstr1, *cstr2;
-  size_t cstart1, cend1, cstart2, cend2;
-
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (1, s1, cstr1,
-                                    3, start1, cstart1,
-                                    4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (2, s2, cstr2,
-                                    5, start2, cstart2,
-                                    6, end2, cend2);
-
-  while (cstart1 < cend1 && cstart2 < cend2)
-    {
-      if (cstr1[cstart1] < cstr2[cstart2])
-	goto false;
-      else if (cstr1[cstart1] > cstr2[cstart2])
-	goto true;
-      cstart1++;
-      cstart2++;
-    }
-  if (cstart1 < cend1)
-    goto true;
-  else if (cstart2 < cend2)
-    goto false;
-  else
-    goto true;
-
- true:
-  scm_remember_upto_here_2 (s1, s2);
-  return scm_from_size_t (cstart1);
-
- false:
-  scm_remember_upto_here_2 (s1, s2);
-  return SCM_BOOL_F;
+  return compare_strings (FUNC_NAME, 0,
+			  s1, s2, start1, end1, start2, end2,
+			  SCM_BOOL_F, SCM_BOOL_T, SCM_BOOL_F, SCM_BOOL_T, SCM_BOOL_T);
 }
 #undef FUNC_NAME
 
@@ -1370,39 +1248,9 @@ SCM_DEFINE (scm_string_ci_eq, "string-ci=", 2, 4, 0,
 	    "case-insensitively.")
 #define FUNC_NAME s_scm_string_ci_eq
 {
-  const char *cstr1, *cstr2;
-  size_t cstart1, cend1, cstart2, cend2;
-
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cstr1,
-				   3, start1, cstart1,
-				   4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
-				   5, start2, cstart2,
-				   6, end2, cend2);
-
-  while (cstart1 < cend1 && cstart2 < cend2)
-    {
-      if (scm_c_downcase (cstr1[cstart1]) < scm_c_downcase (cstr2[cstart2]))
-	goto false;
-      else if (scm_c_downcase (cstr1[cstart1]) > scm_c_downcase (cstr2[cstart2]))
-	goto false;
-      cstart1++;
-      cstart2++;
-    }
-  if (cstart1 < cend1)
-    goto false;
-  else if (cstart2 < cend2)
-    goto false;
-  else
-    goto true;
-
- true:
-  scm_remember_upto_here_2 (s1, s2);
-  return scm_from_size_t (cstart1);
-
- false:
-  scm_remember_upto_here_2 (s1, s2);
-  return SCM_BOOL_F;
+  return compare_strings (FUNC_NAME, 1,
+			  s1, s2, start1, end1, start2, end2,
+			  SCM_BOOL_F, SCM_BOOL_F, SCM_BOOL_F, SCM_BOOL_F, SCM_BOOL_T);
 }
 #undef FUNC_NAME
 
@@ -1414,39 +1262,9 @@ SCM_DEFINE (scm_string_ci_neq, "string-ci<>", 2, 4, 0,
 	    "case-insensitively.")
 #define FUNC_NAME s_scm_string_ci_neq
 {
-  const char *cstr1, *cstr2;
-  size_t cstart1, cend1, cstart2, cend2;
-
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cstr1,
-				   3, start1, cstart1,
-				   4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
-				   5, start2, cstart2,
-				   6, end2, cend2);
-
-  while (cstart1 < cend1 && cstart2 < cend2)
-    {
-      if (scm_c_downcase (cstr1[cstart1]) < scm_c_downcase (cstr2[cstart2]))
-	goto true;
-      else if (scm_c_downcase (cstr1[cstart1]) > scm_c_downcase (cstr2[cstart2]))
-	goto true;
-      cstart1++;
-      cstart2++;
-    }
-  if (cstart1 < cend1)
-    goto true;
-  else if (cstart2 < cend2)
-    goto true;
-  else
-    goto false;
-
- true:
-  scm_remember_upto_here_2 (s1, s2);
-  return scm_from_size_t (cstart1);
-
- false:
-  scm_remember_upto_here_2 (s1, s2);
-  return SCM_BOOL_F;
+  return compare_strings (FUNC_NAME, 1,
+			  s1, s2, start1, end1, start2, end2,
+			  SCM_BOOL_T, SCM_BOOL_T, SCM_BOOL_T, SCM_BOOL_T, SCM_BOOL_F);
 }
 #undef FUNC_NAME
 
@@ -1458,39 +1276,9 @@ SCM_DEFINE (scm_string_ci_lt, "string-ci<", 2, 4, 0,
 	    "case-insensitively.")
 #define FUNC_NAME s_scm_string_ci_lt
 {
-  const unsigned char *cstr1, *cstr2;
-  size_t cstart1, cend1, cstart2, cend2;
-
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (1, s1, cstr1,
-                                    3, start1, cstart1,
-                                    4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (2, s2, cstr2,
-                                    5, start2, cstart2,
-                                    6, end2, cend2);
-
-  while (cstart1 < cend1 && cstart2 < cend2)
-    {
-      if (scm_c_downcase (cstr1[cstart1]) < scm_c_downcase (cstr2[cstart2]))
-	goto true;
-      else if (scm_c_downcase (cstr1[cstart1]) > scm_c_downcase (cstr2[cstart2]))
-	goto false;
-      cstart1++;
-      cstart2++;
-    }
-  if (cstart1 < cend1)
-    goto false;
-  else if (cstart2 < cend2)
-    goto true;
-  else
-    goto false;
-
- true:
-  scm_remember_upto_here_2 (s1, s2);
-  return scm_from_size_t (cstart1);
-
- false:
-  scm_remember_upto_here_2 (s1, s2);
-  return SCM_BOOL_F;
+  return compare_strings (FUNC_NAME, 1,
+			  s1, s2, start1, end1, start2, end2,
+			  SCM_BOOL_T, SCM_BOOL_F, SCM_BOOL_T, SCM_BOOL_F, SCM_BOOL_F);
 }
 #undef FUNC_NAME
 
@@ -1502,39 +1290,9 @@ SCM_DEFINE (scm_string_ci_gt, "string-ci>", 2, 4, 0,
 	    "case-insensitively.")
 #define FUNC_NAME s_scm_string_ci_gt
 {
-  const unsigned char *cstr1, *cstr2;
-  size_t cstart1, cend1, cstart2, cend2;
-
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (1, s1, cstr1,
-                                    3, start1, cstart1,
-                                    4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (2, s2, cstr2,
-                                    5, start2, cstart2,
-                                    6, end2, cend2);
-
-  while (cstart1 < cend1 && cstart2 < cend2)
-    {
-      if (scm_c_downcase (cstr1[cstart1]) < scm_c_downcase (cstr2[cstart2]))
-	goto false;
-      else if (scm_c_downcase (cstr1[cstart1]) > scm_c_downcase (cstr2[cstart2]))
-	goto true;
-      cstart1++;
-      cstart2++;
-    }
-  if (cstart1 < cend1)
-    goto true;
-  else if (cstart2 < cend2)
-    goto false;
-  else
-    goto false;
-
- true:
-  scm_remember_upto_here_2 (s1, s2);
-  return scm_from_size_t (cstart1);
-
- false:
-  scm_remember_upto_here_2 (s1, s2);
-  return SCM_BOOL_F;
+  return compare_strings (FUNC_NAME, 1,
+			  s1, s2, start1, end1, start2, end2,
+			  SCM_BOOL_F, SCM_BOOL_T, SCM_BOOL_F, SCM_BOOL_T, SCM_BOOL_F);
 }
 #undef FUNC_NAME
 
@@ -1546,39 +1304,9 @@ SCM_DEFINE (scm_string_ci_le, "string-ci<=", 2, 4, 0,
 	    "case-insensitively.")
 #define FUNC_NAME s_scm_string_ci_le
 {
-  const unsigned char *cstr1, *cstr2;
-  size_t cstart1, cend1, cstart2, cend2;
-
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (1, s1, cstr1,
-                                    3, start1, cstart1,
-                                    4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (2, s2, cstr2,
-                                    5, start2, cstart2,
-                                    6, end2, cend2);
-
-  while (cstart1 < cend1 && cstart2 < cend2)
-    {
-      if (scm_c_downcase (cstr1[cstart1]) < scm_c_downcase (cstr2[cstart2]))
-	goto true;
-      else if (scm_c_downcase (cstr1[cstart1]) > scm_c_downcase (cstr2[cstart2]))
-	goto false;
-      cstart1++;
-      cstart2++;
-    }
-  if (cstart1 < cend1)
-    goto false;
-  else if (cstart2 < cend2)
-    goto true;
-  else
-    goto true;
-
- true:
-  scm_remember_upto_here_2 (s1, s2);
-  return scm_from_size_t (cstart1);
-
- false:
-  scm_remember_upto_here_2 (s1, s2);
-  return SCM_BOOL_F;
+  return compare_strings (FUNC_NAME, 1,
+			  s1, s2, start1, end1, start2, end2,
+			  SCM_BOOL_T, SCM_BOOL_F, SCM_BOOL_T, SCM_BOOL_F, SCM_BOOL_T);
 }
 #undef FUNC_NAME
 
@@ -1590,39 +1318,9 @@ SCM_DEFINE (scm_string_ci_ge, "string-ci>=", 2, 4, 0,
 	    "case-insensitively.")
 #define FUNC_NAME s_scm_string_ci_ge
 {
-  const unsigned char *cstr1, *cstr2;
-  size_t cstart1, cend1, cstart2, cend2;
-
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (1, s1, cstr1,
-                                    3, start1, cstart1,
-                                    4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (2, s2, cstr2,
-                                    5, start2, cstart2,
-                                    6, end2, cend2);
-
-  while (cstart1 < cend1 && cstart2 < cend2)
-    {
-      if (scm_c_downcase (cstr1[cstart1]) < scm_c_downcase (cstr2[cstart2]))
-	goto false;
-      else if (scm_c_downcase (cstr1[cstart1]) > scm_c_downcase (cstr2[cstart2]))
-	goto true;
-      cstart1++;
-      cstart2++;
-    }
-  if (cstart1 < cend1)
-    goto true;
-  else if (cstart2 < cend2)
-    goto false;
-  else
-    goto true;
-
- true:
-  scm_remember_upto_here_2 (s1, s2);
-  return scm_from_size_t (cstart1);
-
- false:
-  scm_remember_upto_here_2 (s1, s2);
-  return SCM_BOOL_F;
+  return compare_strings (FUNC_NAME, 1,
+			  s1, s2, start1, end1, start2, end2,
+			  SCM_BOOL_F, SCM_BOOL_T, SCM_BOOL_F, SCM_BOOL_T, SCM_BOOL_T);
 }
 #undef FUNC_NAME
 
@@ -1664,19 +1362,20 @@ SCM_DEFINE (scm_string_prefix_length, "string-prefix-length", 2, 4, 0,
 	    "strings.")
 #define FUNC_NAME s_scm_string_prefix_length
 {
-  const char *cstr1, *cstr2;
   size_t cstart1, cend1, cstart2, cend2;
   size_t len = 0;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cstr1,
-				   3, start1, cstart1,
-				   4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
-				   5, start2, cstart2,
-				   6, end2, cend2);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s1,
+			      3, start1, cstart1,
+			      4, end1, cend1);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s2,
+			      5, start2, cstart2,
+			      6, end2, cend2);
+  
   while (cstart1 < cend1 && cstart2 < cend2)
     {
-      if (cstr1[cstart1] != cstr2[cstart2])
+      if (scm_i_string_ref (s1, cstart1)
+          != scm_i_string_ref (s2, cstart2))
 	goto ret;
       len++;
       cstart1++;
@@ -1696,19 +1395,19 @@ SCM_DEFINE (scm_string_prefix_length_ci, "string-prefix-length-ci", 2, 4, 0,
 	    "strings, ignoring character case.")
 #define FUNC_NAME s_scm_string_prefix_length_ci
 {
-  const char *cstr1, *cstr2;
   size_t cstart1, cend1, cstart2, cend2;
   size_t len = 0;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cstr1,
-				   3, start1, cstart1,
-				   4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
-				   5, start2, cstart2,
-				   6, end2, cend2);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s1,
+			      3, start1, cstart1,
+			      4, end1, cend1);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s2,
+			      5, start2, cstart2,
+			      6, end2, cend2);
   while (cstart1 < cend1 && cstart2 < cend2)
     {
-      if (scm_c_downcase (cstr1[cstart1]) != scm_c_downcase (cstr2[cstart2]))
+      if (uc_tolower (uc_toupper (scm_i_string_ref (s1, cstart1)))
+	  != uc_tolower (uc_toupper (scm_i_string_ref (s2, cstart2))))
 	goto ret;
       len++;
       cstart1++;
@@ -1728,21 +1427,21 @@ SCM_DEFINE (scm_string_suffix_length, "string-suffix-length", 2, 4, 0,
 	    "strings.")
 #define FUNC_NAME s_scm_string_suffix_length
 {
-  const char *cstr1, *cstr2;
   size_t cstart1, cend1, cstart2, cend2;
   size_t len = 0;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cstr1,
-				   3, start1, cstart1,
-				   4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
-				   5, start2, cstart2,
-				   6, end2, cend2);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s1,
+			      3, start1, cstart1,
+			      4, end1, cend1);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s2,
+			      5, start2, cstart2,
+			      6, end2, cend2);
   while (cstart1 < cend1 && cstart2 < cend2)
     {
       cend1--;
       cend2--;
-      if (cstr1[cend1] != cstr2[cend2])
+      if (scm_i_string_ref (s1, cend1) 
+	  != scm_i_string_ref (s2, cend2))
 	goto ret;
       len++;
     }
@@ -1760,21 +1459,21 @@ SCM_DEFINE (scm_string_suffix_length_ci, "string-suffix-length-ci", 2, 4, 0,
 	    "strings, ignoring character case.")
 #define FUNC_NAME s_scm_string_suffix_length_ci
 {
-  const char *cstr1, *cstr2;
   size_t cstart1, cend1, cstart2, cend2;
   size_t len = 0;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cstr1,
-				   3, start1, cstart1,
-				   4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
-				   5, start2, cstart2,
-				   6, end2, cend2);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s1,
+			      3, start1, cstart1,
+			      4, end1, cend1);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s2,
+			      5, start2, cstart2,
+			      6, end2, cend2);
   while (cstart1 < cend1 && cstart2 < cend2)
     {
       cend1--;
       cend2--;
-      if (scm_c_downcase (cstr1[cend1]) != scm_c_downcase (cstr2[cend2]))
+      if (uc_tolower (uc_toupper (scm_i_string_ref (s1, cend1)))
+	  != uc_tolower (uc_toupper (scm_i_string_ref (s2, cend2))))
 	goto ret;
       len++;
     }
@@ -1791,20 +1490,20 @@ SCM_DEFINE (scm_string_prefix_p, "string-prefix?", 2, 4, 0,
 	    "Is @var{s1} a prefix of @var{s2}?")
 #define FUNC_NAME s_scm_string_prefix_p
 {
-  const char *cstr1, *cstr2;
   size_t cstart1, cend1, cstart2, cend2;
   size_t len = 0, len1;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cstr1,
-				   3, start1, cstart1,
-				   4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
-				   5, start2, cstart2,
-				   6, end2, cend2);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s1,
+			      3, start1, cstart1,
+			      4, end1, cend1);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s2,
+			      5, start2, cstart2,
+			      6, end2, cend2);
   len1 = cend1 - cstart1;
   while (cstart1 < cend1 && cstart2 < cend2)
     {
-      if (cstr1[cstart1] != cstr2[cstart2])
+      if (scm_i_string_ref (s1, cstart1)
+          != scm_i_string_ref (s2, cstart2))
 	goto ret;
       len++;
       cstart1++;
@@ -1823,20 +1522,21 @@ SCM_DEFINE (scm_string_prefix_ci_p, "string-prefix-ci?", 2, 4, 0,
 	    "Is @var{s1} a prefix of @var{s2}, ignoring character case?")
 #define FUNC_NAME s_scm_string_prefix_ci_p
 {
-  const char *cstr1, *cstr2;
   size_t cstart1, cend1, cstart2, cend2;
   size_t len = 0, len1;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cstr1,
-				   3, start1, cstart1,
-				   4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
-				   5, start2, cstart2,
-				   6, end2, cend2);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s1,
+			      3, start1, cstart1,
+			      4, end1, cend1);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s2,
+			      5, start2, cstart2,
+			      6, end2, cend2);
   len1 = cend1 - cstart1;
   while (cstart1 < cend1 && cstart2 < cend2)
     {
-      if (scm_c_downcase (cstr1[cstart1]) != scm_c_downcase (cstr2[cstart2]))
+      scm_t_wchar a = uc_tolower (uc_toupper (scm_i_string_ref (s1, cstart1)));
+      scm_t_wchar b = uc_tolower (uc_toupper (scm_i_string_ref (s2, cstart2)));
+      if (a != b)
 	goto ret;
       len++;
       cstart1++;
@@ -1855,22 +1555,22 @@ SCM_DEFINE (scm_string_suffix_p, "string-suffix?", 2, 4, 0,
 	    "Is @var{s1} a suffix of @var{s2}?")
 #define FUNC_NAME s_scm_string_suffix_p
 {
-  const char *cstr1, *cstr2;
   size_t cstart1, cend1, cstart2, cend2;
   size_t len = 0, len1;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cstr1,
-				   3, start1, cstart1,
-				   4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
-				   5, start2, cstart2,
-				   6, end2, cend2);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s1,
+			      3, start1, cstart1,
+			      4, end1, cend1);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s2,
+			      5, start2, cstart2,
+			      6, end2, cend2);
   len1 = cend1 - cstart1;
   while (cstart1 < cend1 && cstart2 < cend2)
     {
       cend1--;
       cend2--;
-      if (cstr1[cend1] != cstr2[cend2])
+      if (scm_i_string_ref (s1, cend1) 
+	  != scm_i_string_ref (s2, cend2))
 	goto ret;
       len++;
     }
@@ -1887,22 +1587,22 @@ SCM_DEFINE (scm_string_suffix_ci_p, "string-suffix-ci?", 2, 4, 0,
 	    "Is @var{s1} a suffix of @var{s2}, ignoring character case?")
 #define FUNC_NAME s_scm_string_suffix_ci_p
 {
-  const char *cstr1, *cstr2;
   size_t cstart1, cend1, cstart2, cend2;
   size_t len = 0, len1;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cstr1,
-				   3, start1, cstart1,
-				   4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
-				   5, start2, cstart2,
-				   6, end2, cend2);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s1,
+			      3, start1, cstart1,
+			      4, end1, cend1);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s2,
+			      5, start2, cstart2,
+			      6, end2, cend2);
   len1 = cend1 - cstart1;
   while (cstart1 < cend1 && cstart2 < cend2)
     {
       cend1--;
       cend2--;
-      if (scm_c_downcase (cstr1[cend1]) != scm_c_downcase (cstr2[cend2]))
+      if (uc_tolower (uc_toupper (scm_i_string_ref (s1, cend1)))
+	  != uc_tolower (uc_toupper (scm_i_string_ref (s2, cend2))))
 	goto ret;
       len++;
     }
@@ -1931,18 +1631,16 @@ SCM_DEFINE (scm_string_index, "string-index", 2, 2, 0,
 	    "@end itemize")
 #define FUNC_NAME s_scm_string_index
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s, cstr,
-				   3, start, cstart,
-				   4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s,
+			      3, start, cstart,
+			      4, end, cend);
   if (SCM_CHARP (char_pred))
     {
-      char cchr = SCM_CHAR (char_pred);
       while (cstart < cend)
 	{
-	  if (cchr == cstr[cstart])
+	  if (scm_i_string_ref (s, cstart) == SCM_CHAR (char_pred))
 	    goto found;
 	  cstart++;
 	}
@@ -1951,7 +1649,7 @@ SCM_DEFINE (scm_string_index, "string-index", 2, 2, 0,
     {
       while (cstart < cend)
 	{
-	  if (SCM_CHARSET_GET (char_pred, cstr[cstart]))
+	  if (REF_IN_CHARSET (s, cstart, char_pred))
 	    goto found;
 	  cstart++;
 	}
@@ -1964,10 +1662,9 @@ SCM_DEFINE (scm_string_index, "string-index", 2, 2, 0,
       while (cstart < cend)
 	{
 	  SCM res;
-	  res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cstart]));
+	  res = pred_tramp (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cstart)));
 	  if (scm_is_true (res))
 	    goto found;
-	  cstr = scm_i_string_chars (s);
 	  cstart++;
 	}
     }
@@ -1998,19 +1695,17 @@ SCM_DEFINE (scm_string_index_right, "string-index-right", 2, 2, 0,
 	    "@end itemize")
 #define FUNC_NAME s_scm_string_index_right
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s, cstr,
-				   3, start, cstart,
-				   4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s,
+			      3, start, cstart,
+			      4, end, cend);
   if (SCM_CHARP (char_pred))
     {
-      char cchr = SCM_CHAR (char_pred);
       while (cstart < cend)
 	{
 	  cend--;
-	  if (cchr == cstr[cend])
+	  if (scm_i_string_ref (s, cend) == SCM_CHAR (char_pred))
 	    goto found;
 	}
     }
@@ -2019,7 +1714,7 @@ SCM_DEFINE (scm_string_index_right, "string-index-right", 2, 2, 0,
       while (cstart < cend)
 	{
 	  cend--;
-	  if (SCM_CHARSET_GET (char_pred, cstr[cend]))
+	  if (REF_IN_CHARSET (s, cend, char_pred))
 	    goto found;
 	}
     }
@@ -2032,10 +1727,9 @@ SCM_DEFINE (scm_string_index_right, "string-index-right", 2, 2, 0,
 	{
 	  SCM res;
 	  cend--;
-	  res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cend]));
+	  res = pred_tramp (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cend)));
 	  if (scm_is_true (res))
 	    goto found;
-	  cstr = scm_i_string_chars (s);
 	}
     }
 
@@ -2087,18 +1781,16 @@ SCM_DEFINE (scm_string_skip, "string-skip", 2, 2, 0,
 	    "@end itemize")
 #define FUNC_NAME s_scm_string_skip
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s, cstr,
-				   3, start, cstart,
-				   4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s,
+			      3, start, cstart,
+			      4, end, cend);
   if (SCM_CHARP (char_pred))
     {
-      char cchr = SCM_CHAR (char_pred);
       while (cstart < cend)
 	{
-	  if (cchr != cstr[cstart])
+	  if (scm_i_string_ref (s, cstart) !=  SCM_CHAR (char_pred))
 	    goto found;
 	  cstart++;
 	}
@@ -2107,7 +1799,7 @@ SCM_DEFINE (scm_string_skip, "string-skip", 2, 2, 0,
     {
       while (cstart < cend)
 	{
-	  if (!SCM_CHARSET_GET (char_pred, cstr[cstart]))
+	  if (!REF_IN_CHARSET (s, cstart, char_pred))
 	    goto found;
 	  cstart++;
 	}
@@ -2120,10 +1812,9 @@ SCM_DEFINE (scm_string_skip, "string-skip", 2, 2, 0,
       while (cstart < cend)
 	{
 	  SCM res;
-	  res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cstart]));
+	  res = pred_tramp (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cstart)));
 	  if (scm_is_false (res))
 	    goto found;
-	  cstr = scm_i_string_chars (s);
 	  cstart++;
 	}
     }
@@ -2156,19 +1847,17 @@ SCM_DEFINE (scm_string_skip_right, "string-skip-right", 2, 2, 0,
 	    "@end itemize")
 #define FUNC_NAME s_scm_string_skip_right
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s, cstr,
-				   3, start, cstart,
-				   4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s,
+			      3, start, cstart,
+			      4, end, cend);
   if (SCM_CHARP (char_pred))
     {
-      char cchr = SCM_CHAR (char_pred);
       while (cstart < cend)
 	{
 	  cend--;
-	  if (cchr != cstr[cend])
+	  if (scm_i_string_ref (s, cend) != SCM_CHAR (char_pred))
 	    goto found;
 	}
     }
@@ -2177,7 +1866,7 @@ SCM_DEFINE (scm_string_skip_right, "string-skip-right", 2, 2, 0,
       while (cstart < cend)
 	{
 	  cend--;
-	  if (!SCM_CHARSET_GET (char_pred, cstr[cend]))
+	  if (!REF_IN_CHARSET (s, cend, char_pred))
 	    goto found;
 	}
     }
@@ -2190,10 +1879,9 @@ SCM_DEFINE (scm_string_skip_right, "string-skip-right", 2, 2, 0,
 	{
 	  SCM res;
 	  cend--;
-	  res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cend]));
+	  res = pred_tramp (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cend)));
 	  if (scm_is_false (res))
 	    goto found;
-	  cstr = scm_i_string_chars (s);
 	}
     }
 
@@ -2225,19 +1913,17 @@ SCM_DEFINE (scm_string_count, "string-count", 2, 2, 0,
 	    "@end itemize")
 #define FUNC_NAME s_scm_string_count
 {
-  const char *cstr;
   size_t cstart, cend;
   size_t count = 0;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s, cstr,
-				   3, start, cstart,
-				   4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s,
+			      3, start, cstart,
+			      4, end, cend);
   if (SCM_CHARP (char_pred))
     {
-      char cchr = SCM_CHAR (char_pred);
       while (cstart < cend)
 	{
-	  if (cchr == cstr[cstart])
+	  if (scm_i_string_ref (s, cstart) == SCM_CHAR(char_pred))
 	    count++;
 	  cstart++;
 	}
@@ -2246,7 +1932,7 @@ SCM_DEFINE (scm_string_count, "string-count", 2, 2, 0,
     {
       while (cstart < cend)
 	{
-	  if (SCM_CHARSET_GET (char_pred, cstr[cstart]))
+	  if (REF_IN_CHARSET (s, cstart, char_pred))
 	    count++;
 	  cstart++;
 	}
@@ -2259,10 +1945,9 @@ SCM_DEFINE (scm_string_count, "string-count", 2, 2, 0,
       while (cstart < cend)
 	{
 	  SCM res;
-	  res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cstart]));
+	  res = pred_tramp (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cstart)));
 	  if (scm_is_true (res))
 	    count++;
-	  cstr = scm_i_string_chars (s);
 	  cstart++;
 	}
     }
@@ -2284,23 +1969,25 @@ SCM_DEFINE (scm_string_contains, "string-contains", 2, 4, 0,
 	    "indicated substrings.")
 #define FUNC_NAME s_scm_string_contains
 {
-  const char *cs1, * cs2;
   size_t cstart1, cend1, cstart2, cend2;
   size_t len2, i, j;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cs1,
-				   3, start1, cstart1,
-				   4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cs2,
-				   5, start2, cstart2,
-				   6, end2, cend2);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s1,
+			      3, start1, cstart1,
+			      4, end1, cend1);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s2,
+			      5, start2, cstart2,
+			      6, end2, cend2);
   len2 = cend2 - cstart2;
   if (cend1 - cstart1 >= len2)
     while (cstart1 <= cend1 - len2)
       {
 	i = cstart1;
 	j = cstart2;
-	while (i < cend1 && j < cend2 && cs1[i] == cs2[j])
+	while (i < cend1 
+	       && j < cend2 
+	       && (scm_i_string_ref (s1, i)
+		   == scm_i_string_ref (s2, j)))
 	  {
 	    i++;
 	    j++;
@@ -2331,24 +2018,25 @@ SCM_DEFINE (scm_string_contains_ci, "string-contains-ci", 2, 4, 0,
 	    "case-insensitively.")
 #define FUNC_NAME s_scm_string_contains_ci
 {
-  const char *cs1, * cs2;
   size_t cstart1, cend1, cstart2, cend2;
   size_t len2, i, j;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cs1,
-				   3, start1, cstart1,
-				   4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cs2,
-				   5, start2, cstart2,
-				   6, end2, cend2);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s1,
+			      3, start1, cstart1,
+			      4, end1, cend1);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s2,
+			      5, start2, cstart2,
+			      6, end2, cend2);
   len2 = cend2 - cstart2;
   if (cend1 - cstart1 >= len2)
     while (cstart1 <= cend1 - len2)
       {
 	i = cstart1;
 	j = cstart2;
-	while (i < cend1 && j < cend2 &&
-	       scm_c_downcase (cs1[i]) == scm_c_downcase (cs2[j]))
+	while (i < cend1 
+	       && j < cend2 
+	       && (uc_tolower (uc_toupper (scm_i_string_ref (s1, i)))
+		   == uc_tolower (uc_toupper (scm_i_string_ref (s2, j)))))
 	  {
 	    i++;
 	    j++;
@@ -2367,17 +2055,15 @@ SCM_DEFINE (scm_string_contains_ci, "string-contains-ci", 2, 4, 0,
 #undef FUNC_NAME
 
 
-/* Helper function for the string uppercase conversion functions.
- * No argument checking is performed.  */
+/* Helper function for the string uppercase conversion functions. */
 static SCM
 string_upcase_x (SCM v, size_t start, size_t end)
 {
   size_t k;
-  char *dst;
 
-  dst = scm_i_string_writable_chars (v);
+  v = scm_i_string_start_writing (v);
   for (k = start; k < end; ++k)
-    dst[k] = scm_c_upcase (dst[k]);
+    scm_i_string_set_x (v, k, uc_toupper (scm_i_string_ref (v, k)));
   scm_i_string_stop_writing ();
   scm_remember_upto_here_1 (v);
 
@@ -2396,12 +2082,11 @@ SCM_DEFINE (scm_substring_upcase_x, "string-upcase!", 1, 2, 0,
 	    "@end lisp")
 #define FUNC_NAME s_scm_substring_upcase_x
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, str, cstr,
-				   2, start, cstart,
-				   3, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, str,
+			      2, start, cstart,
+			      3, end, cend);
   return string_upcase_x (str, cstart, cend);
 }
 #undef FUNC_NAME
@@ -2417,12 +2102,11 @@ SCM_DEFINE (scm_substring_upcase, "string-upcase", 1, 2, 0,
 	    "Upcase every character in @code{str}.")
 #define FUNC_NAME s_scm_substring_upcase
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, str, cstr,
-				   2, start, cstart,
-				   3, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, str,
+			      2, start, cstart,
+			      3, end, cend);
   return string_upcase_x (scm_string_copy (str), cstart, cend);
 }
 #undef FUNC_NAME
@@ -2439,11 +2123,10 @@ static SCM
 string_downcase_x (SCM v, size_t start, size_t end)
 {
   size_t k;
-  char *dst;
 
-  dst = scm_i_string_writable_chars (v);
+  v = scm_i_string_start_writing (v);
   for (k = start; k < end; ++k)
-    dst[k] = scm_c_downcase (dst[k]);
+    scm_i_string_set_x (v, k, uc_tolower (scm_i_string_ref (v, k)));
   scm_i_string_stop_writing ();
   scm_remember_upto_here_1 (v);
 
@@ -2464,12 +2147,11 @@ SCM_DEFINE (scm_substring_downcase_x, "string-downcase!", 1, 2, 0,
 	    "@end lisp")
 #define FUNC_NAME s_scm_substring_downcase_x
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, str, cstr,
-				   2, start, cstart,
-				   3, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, str,
+			      2, start, cstart,
+			      3, end, cend);
   return string_downcase_x (str, cstart, cend);
 }
 #undef FUNC_NAME
@@ -2485,12 +2167,11 @@ SCM_DEFINE (scm_substring_downcase, "string-downcase", 1, 2, 0,
 	    "Downcase every character in @var{str}.")
 #define FUNC_NAME s_scm_substring_downcase
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, str, cstr,
-				   2, start, cstart,
-				   3, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, str,
+			      2, start, cstart,
+			      3, end, cend);
   return string_downcase_x (scm_string_copy (str), cstart, cend);
 }
 #undef FUNC_NAME
@@ -2506,23 +2187,24 @@ scm_string_downcase (SCM str)
 static SCM
 string_titlecase_x (SCM str, size_t start, size_t end)
 {
-  unsigned char *sz;
+  SCM ch;
   size_t i;
   int in_word = 0;
 
-  sz = (unsigned char *) scm_i_string_writable_chars (str);
+  str = scm_i_string_start_writing (str);
   for(i = start; i < end;  i++)
     {
-      if (scm_is_true (scm_char_alphabetic_p (SCM_MAKE_CHAR (sz[i]))))
+      ch = SCM_MAKE_CHAR (scm_i_string_ref (str, i));
+      if (scm_is_true (scm_char_alphabetic_p (ch)))
 	{
 	  if (!in_word)
 	    {
-	      sz[i] = scm_c_upcase(sz[i]);
+	      scm_i_string_set_x (str, i, uc_toupper (SCM_CHAR (ch)));
 	      in_word = 1;
 	    }
 	  else
 	    {
-	      sz[i] = scm_c_downcase(sz[i]);
+	      scm_i_string_set_x (str, i, uc_tolower (SCM_CHAR (ch)));
 	    }
 	}
       else
@@ -2541,12 +2223,11 @@ SCM_DEFINE (scm_string_titlecase_x, "string-titlecase!", 1, 2, 0,
 	    "@var{str}.")
 #define FUNC_NAME s_scm_string_titlecase_x
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, str, cstr,
-				   2, start, cstart,
-				   3, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, str,
+			      2, start, cstart,
+			      3, end, cend);
   return string_titlecase_x (str, cstart, cend);
 }
 #undef FUNC_NAME
@@ -2557,12 +2238,11 @@ SCM_DEFINE (scm_string_titlecase, "string-titlecase", 1, 2, 0,
 	    "Titlecase every first character in a word in @var{str}.")
 #define FUNC_NAME s_scm_string_titlecase
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, str, cstr,
-				   2, start, cstart,
-				   3, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, str,
+			      2, start, cstart,
+			      3, end, cend);
   return string_titlecase_x (scm_string_copy (str), cstart, cend);
 }
 #undef FUNC_NAME
@@ -2599,22 +2279,24 @@ SCM_DEFINE (scm_string_capitalize, "string-capitalize", 1, 0, 0,
 /* Reverse the portion of @var{str} between str[cstart] (including)
    and str[cend] excluding.  */
 static void
-string_reverse_x (char * str, size_t cstart, size_t cend)
+string_reverse_x (SCM str, size_t cstart, size_t cend)
 {
-  char tmp;
+  SCM tmp;
 
+  str = scm_i_string_start_writing (str);
   if (cend > 0)
     {
       cend--;
       while (cstart < cend)
 	{
-	  tmp = str[cstart];
-	  str[cstart] = str[cend];
-	  str[cend] = tmp;
+	  tmp = SCM_MAKE_CHAR (scm_i_string_ref (str, cstart));
+	  scm_i_string_set_x (str, cstart, scm_i_string_ref (str, cend));
+	  scm_i_string_set_x (str, cend, SCM_CHAR (tmp));
 	  cstart++;
 	  cend--;
 	}
     }
+  scm_i_string_stop_writing ();
 }
 
 
@@ -2625,18 +2307,14 @@ SCM_DEFINE (scm_string_reverse, "string-reverse", 1, 2, 0,
 	    "operate on.")
 #define FUNC_NAME s_scm_string_reverse
 {
-  const char *cstr;
-  char *ctarget;
   size_t cstart, cend;
   SCM result;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, str, cstr,
-				   2, start, cstart,
-				   3, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, str,
+			      2, start, cstart,
+			      3, end, cend);
   result = scm_string_copy (str);
-  ctarget = scm_i_string_writable_chars (result);
-  string_reverse_x (ctarget, cstart, cend);
-  scm_i_string_stop_writing ();
+  string_reverse_x (result, cstart, cend);
   scm_remember_upto_here_1 (str);
   return result;
 }
@@ -2650,16 +2328,13 @@ SCM_DEFINE (scm_string_reverse_x, "string-reverse!", 1, 2, 0,
 	    "operate on.  The return value is unspecified.")
 #define FUNC_NAME s_scm_string_reverse_x
 {
-  char *cstr;
   size_t cstart, cend;
 
   MY_VALIDATE_SUBSTRING_SPEC (1, str,
 			      2, start, cstart,
 			      3, end, cend);
 
-  cstr = scm_i_string_writable_chars (str);
-  string_reverse_x (cstr, cstart, cend);
-  scm_i_string_stop_writing ();
+  string_reverse_x (str, cstart, cend);
   scm_remember_upto_here_1 (str);
   return SCM_UNSPECIFIED;
 }
@@ -2685,7 +2360,9 @@ SCM_DEFINE (scm_string_append_shared, "string-append/shared", 0, 0, 1,
   for (l = rest; scm_is_pair (l); l = SCM_CDR (l))
     {
       s = SCM_CAR (l);
-      if (scm_c_string_length (s) != 0)
+      if (!scm_is_string (s))
+	scm_wrong_type_arg (FUNC_NAME, 0, s);
+      if (scm_i_string_length (s) != 0)
         {
           if (seen_nonempty)
             /* two or more non-empty strings, need full concat */
@@ -2772,7 +2449,7 @@ SCM_DEFINE (scm_string_map, "string-map", 2, 2, 0,
 	    "string elements is not specified.")
 #define FUNC_NAME s_scm_string_map
 {
-  char *p;
+  size_t p;
   size_t cstart, cend;
   SCM result;
   scm_t_trampoline_1 proc_tramp = scm_trampoline_1 (proc);
@@ -2781,15 +2458,20 @@ SCM_DEFINE (scm_string_map, "string-map", 2, 2, 0,
   MY_VALIDATE_SUBSTRING_SPEC (2, s,
 			      3, start, cstart,
 			      4, end, cend);
-  result = scm_i_make_string (cend - cstart, &p);
+  result = scm_i_make_string (cend - cstart, NULL);
+  p = 0;
   while (cstart < cend)
     {
       SCM ch = proc_tramp (proc, scm_c_string_ref (s, cstart));
       if (!SCM_CHARP (ch))
 	SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (proc));
       cstart++;
-      *p++ = SCM_CHAR (ch);
+      result = scm_i_string_start_writing (result);
+      scm_i_string_set_x (result, p, SCM_CHAR (ch));
+      scm_i_string_stop_writing ();
+      p++;
     }
+  
   return result;
 }
 #undef FUNC_NAME
@@ -2815,7 +2497,9 @@ SCM_DEFINE (scm_string_map_x, "string-map!", 2, 2, 0,
       SCM ch = proc_tramp (proc, scm_c_string_ref (s, cstart));
       if (!SCM_CHARP (ch))
 	SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (proc));
-      scm_c_string_set_x (s, cstart, ch);
+      s = scm_i_string_start_writing (s);
+      scm_i_string_set_x (s, cstart, SCM_CHAR (ch));
+      scm_i_string_stop_writing ();
       cstart++;
     }
   return SCM_UNSPECIFIED;
@@ -2831,20 +2515,17 @@ SCM_DEFINE (scm_string_fold, "string-fold", 3, 2, 0,
 	    "result of @var{kons}' application.")
 #define FUNC_NAME s_scm_string_fold
 {
-  const char *cstr;
   size_t cstart, cend;
   SCM result;
 
   SCM_VALIDATE_PROC (1, kons);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (3, s, cstr,
-				   4, start, cstart,
-				   5, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (3, s,
+			      4, start, cstart,
+			      5, end, cend);
   result = knil;
   while (cstart < cend)
     {
-      unsigned int c = (unsigned char) cstr[cstart];
-      result = scm_call_2 (kons, SCM_MAKE_CHAR (c), result);
-      cstr = scm_i_string_chars (s);
+      result = scm_call_2 (kons, SCM_MAKE_CHAR (scm_i_string_ref (s, cstart)), result);
       cstart++;
     }
 
@@ -2862,20 +2543,17 @@ SCM_DEFINE (scm_string_fold_right, "string-fold-right", 3, 2, 0,
 	    "result of @var{kons}' application.")
 #define FUNC_NAME s_scm_string_fold_right
 {
-  const char *cstr;
   size_t cstart, cend;
   SCM result;
 
   SCM_VALIDATE_PROC (1, kons);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (3, s, cstr,
-				   4, start, cstart,
-				   5, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (3, s,
+			      4, start, cstart,
+			      5, end, cend);
   result = knil;
   while (cstart < cend)
     {
-      unsigned int c  = (unsigned char) cstr[cend - 1];
-      result = scm_call_2 (kons, SCM_MAKE_CHAR (c), result);
-      cstr = scm_i_string_chars (s);
+      result = scm_call_2 (kons, SCM_MAKE_CHAR (scm_i_string_ref (s, cend-1)), result);
       cend--;
     }
 
@@ -2926,12 +2604,15 @@ SCM_DEFINE (scm_string_unfold, "string-unfold", 4, 2, 0,
   while (scm_is_false (res))
     {
       SCM str;
-      char *ptr;
+      size_t i = 0;
       SCM ch = scm_call_1 (f, seed);
       if (!SCM_CHARP (ch))
 	SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (f));
-      str = scm_i_make_string (1, &ptr);
-      *ptr = SCM_CHAR (ch);
+      str = scm_i_make_string (1, NULL);
+      str = scm_i_string_start_writing (str);
+      scm_i_string_set_x (str, i, SCM_CHAR (ch));
+      scm_i_string_stop_writing ();
+      i++;
 
       ans = scm_string_append (scm_list_2 (ans, str));
       seed = scm_call_1 (g, seed);
@@ -2989,12 +2670,15 @@ SCM_DEFINE (scm_string_unfold_right, "string-unfold-right", 4, 2, 0,
   while (scm_is_false (res))
     {
       SCM str;
-      char *ptr;
+      size_t i = 0;
       SCM ch = scm_call_1 (f, seed);
       if (!SCM_CHARP (ch))
 	SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (f));
-      str = scm_i_make_string (1, &ptr);
-      *ptr = SCM_CHAR (ch);
+      str = scm_i_make_string (1, NULL);
+      str = scm_i_string_start_writing (str);
+      scm_i_string_set_x (str, i, SCM_CHAR (ch));
+      scm_i_string_stop_writing ();
+      i++;
 
       ans = scm_string_append (scm_list_2 (str, ans));
       seed = scm_call_1 (g, seed);
@@ -3017,19 +2701,16 @@ SCM_DEFINE (scm_string_for_each, "string-for-each", 2, 2, 0,
 	    "return value is not specified.")
 #define FUNC_NAME s_scm_string_for_each
 {
-  const char *cstr;
   size_t cstart, cend;
   scm_t_trampoline_1 proc_tramp = scm_trampoline_1 (proc);
 
   SCM_ASSERT (proc_tramp, proc, SCM_ARG1, FUNC_NAME);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s, cstr,
-				   3, start, cstart,
-				   4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s,
+			      3, start, cstart,
+			      4, end, cend);
   while (cstart < cend)
     {
-      unsigned int c = (unsigned char) cstr[cstart];
-      proc_tramp (proc, SCM_MAKE_CHAR (c));
-      cstr = scm_i_string_chars (s);
+      proc_tramp (proc, SCM_MAKE_CHAR (scm_i_string_ref (s, cstart)));
       cstart++;
     }
 
@@ -3091,8 +2772,7 @@ SCM_DEFINE (scm_xsubstring, "xsubstring", 2, 3, 0,
 	    "defaults to @var{from} + (@var{end} - @var{start}).")
 #define FUNC_NAME s_scm_xsubstring
 {
-  const char *cs;
-  char *p;
+  size_t p;
   size_t cstart, cend;
   int cfrom, cto;
   SCM result;
@@ -3109,19 +2789,22 @@ SCM_DEFINE (scm_xsubstring, "xsubstring", 2, 3, 0,
   if (cstart == cend && cfrom != cto)
     SCM_MISC_ERROR ("start and end indices must not be equal", SCM_EOL);
 
-  result = scm_i_make_string (cto - cfrom, &p);
+  result = scm_i_make_string (cto - cfrom, NULL);
+  result = scm_i_string_start_writing (result);
 
-  cs = scm_i_string_chars (s);
+  p = 0;
   while (cfrom < cto)
     {
       size_t t = ((cfrom < 0) ? -cfrom : cfrom) % (cend - cstart);
       if (cfrom < 0)
-	*p = cs[(cend - cstart) - t];
+	scm_i_string_set_x (result, p, 
+                            scm_i_string_ref (s, (cend - cstart) - t));
       else
-	*p = cs[t];
+	scm_i_string_set_x (result, p, scm_i_string_ref (s, t));
       cfrom++;
       p++;
     }
+  scm_i_string_stop_writing ();
 
   scm_remember_upto_here_1 (s);
   return result;
@@ -3138,8 +2821,7 @@ SCM_DEFINE (scm_string_xcopy_x, "string-xcopy!", 4, 3, 0,
 	    "cannot copy a string on top of itself.")
 #define FUNC_NAME s_scm_string_xcopy_x
 {
-  char *p;
-  const char *cs;
+  size_t p;
   size_t ctstart, cstart, cend;
   int csfrom, csto;
   SCM dummy = SCM_UNDEFINED;
@@ -3161,15 +2843,15 @@ SCM_DEFINE (scm_string_xcopy_x, "string-xcopy!", 4, 3, 0,
   SCM_ASSERT_RANGE (1, tstart,
 		    ctstart + (csto - csfrom) <= scm_i_string_length (target));
 
-  p = scm_i_string_writable_chars (target) + ctstart;
-  cs = scm_i_string_chars (s);
+  p = 0;
+  target = scm_i_string_start_writing (target);
   while (csfrom < csto)
     {
       size_t t = ((csfrom < 0) ? -csfrom : csfrom) % (cend - cstart);
       if (csfrom < 0)
-	*p = cs[(cend - cstart) - t];
+	scm_i_string_set_x (target, p + cstart, scm_i_string_ref (s, (cend - cstart) - t));
       else
-	*p = cs[t];
+	scm_i_string_set_x (target, p + cstart, scm_i_string_ref (s, t));
       csfrom++;
       p++;
     }
@@ -3188,8 +2870,6 @@ SCM_DEFINE (scm_string_replace, "string-replace", 2, 4, 0,
 	    "@var{start2} @dots{} @var{end2} from @var{s2}.")
 #define FUNC_NAME s_scm_string_replace
 {
-  const char *cstr1, *cstr2;
-  char *p;
   size_t cstart1, cend1, cstart2, cend2;
   SCM result;
 
@@ -3199,16 +2879,10 @@ SCM_DEFINE (scm_string_replace, "string-replace", 2, 4, 0,
   MY_VALIDATE_SUBSTRING_SPEC (2, s2,
 			      5, start2, cstart2,
 			      6, end2, cend2);
-  result = scm_i_make_string (cstart1 + (cend2 - cstart2) +
-			      scm_i_string_length (s1) - cend1, &p);
-  cstr1 = scm_i_string_chars (s1);
-  cstr2 = scm_i_string_chars (s2);
-  memmove (p, cstr1, cstart1 * sizeof (char));
-  memmove (p + cstart1, cstr2 + cstart2, (cend2 - cstart2) * sizeof (char));
-  memmove (p + cstart1 + (cend2 - cstart2),
-	   cstr1 + cend1,
-	   (scm_i_string_length (s1) - cend1) * sizeof (char));
-  scm_remember_upto_here_2 (s1, s2);
+  return (scm_string_append 
+	  (scm_list_3 (scm_i_substring (s1, 0, cstart1),
+		       scm_i_substring (s2, cstart2, cend2),
+		       scm_i_substring (s1, cend1, scm_i_string_length (s1)))));
   return result;
 }
 #undef FUNC_NAME
@@ -3225,13 +2899,12 @@ SCM_DEFINE (scm_string_tokenize, "string-tokenize", 1, 3, 0,
 	    "of @var{s}.")
 #define FUNC_NAME s_scm_string_tokenize
 {
-  const char *cstr;
   size_t cstart, cend;
   SCM result = SCM_EOL;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s, cstr,
-				   3, start, cstart,
-				   4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s,
+			      3, start, cstart,
+			      4, end, cend);
 
   if (SCM_UNBNDP (token_set))
     token_set = scm_char_set_graphic;
@@ -3244,7 +2917,7 @@ SCM_DEFINE (scm_string_tokenize, "string-tokenize", 1, 3, 0,
 	{
 	  while (cstart < cend)
 	    {
-	      if (SCM_CHARSET_GET (token_set, cstr[cend - 1]))
+	      if (REF_IN_CHARSET (s, cend-1, token_set))
 		break;
 	      cend--;
 	    }
@@ -3253,12 +2926,11 @@ SCM_DEFINE (scm_string_tokenize, "string-tokenize", 1, 3, 0,
 	  idx = cend;
 	  while (cstart < cend)
 	    {
-	      if (!SCM_CHARSET_GET (token_set, cstr[cend - 1]))
+	      if (!REF_IN_CHARSET (s, cend-1, token_set))
 		break;
 	      cend--;
 	    }
-	  result = scm_cons (scm_c_substring (s, cend, idx), result);
-	  cstr = scm_i_string_chars (s);
+	  result = scm_cons (scm_i_substring (s, cend, idx), result);
 	}
     }
   else
@@ -3292,27 +2964,45 @@ SCM_DEFINE (scm_string_split, "string-split", 2, 0, 0,
 #define FUNC_NAME s_scm_string_split
 {
   long idx, last_idx;
-  const char * p;
-  char ch;
+  int narrow;
   SCM res = SCM_EOL;
 
   SCM_VALIDATE_STRING (1, str);
   SCM_VALIDATE_CHAR (2, chr);
-
+  
+  /* This is explicit wide/narrow logic (instead of using
+     scm_i_string_ref) is a speed optimization.  */
   idx = scm_i_string_length (str);
-  p = scm_i_string_chars (str);
-  ch = SCM_CHAR (chr);
-  while (idx >= 0)
-    {
-      last_idx = idx;
-      while (idx > 0 && p[idx - 1] != ch)
-	idx--;
-      if (idx >= 0)
-	{
-	  res = scm_cons (scm_c_substring (str, idx, last_idx), res);
-	  p = scm_i_string_chars (str);
-	  idx--;
-	}
+  narrow = scm_i_is_narrow_string (str);
+  if (narrow)
+    {
+      const char *buf = scm_i_string_chars (str);
+      while (idx >= 0)
+        {
+          last_idx = idx;
+          while (idx > 0 && buf[idx-1] != (char) SCM_CHAR(chr))
+            idx--;
+          if (idx >= 0)
+            {
+              res = scm_cons (scm_i_substring (str, idx, last_idx), res);
+              idx--;
+            }
+        }
+    }
+  else
+    {
+      const scm_t_wchar *buf = scm_i_string_wide_chars (str);
+      while (idx >= 0)
+        {
+          last_idx = idx;
+          while (idx > 0 && buf[idx-1] != SCM_CHAR(chr))
+            idx--;
+          if (idx >= 0)
+            {
+              res = scm_cons (scm_i_substring (str, idx, last_idx), res);
+              idx--;
+            }
+        }
     }
   scm_remember_upto_here_1 (str);
   return res;
@@ -3331,14 +3021,13 @@ SCM_DEFINE (scm_string_filter, "string-filter", 2, 2, 0,
 	    "membership.")
 #define FUNC_NAME s_scm_string_filter
 {
-  const char *cstr;
   size_t cstart, cend;
   SCM result;
   size_t idx;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s, cstr,
-				   3, start, cstart,
-				   4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s,
+			      3, start, cstart,
+			      4, end, cend);
 
   /* The explicit loops below stripping leading and trailing non-matches
      mean we can return a substring if those are the only deletions, making
@@ -3347,22 +3036,19 @@ SCM_DEFINE (scm_string_filter, "string-filter", 2, 2, 0,
   if (SCM_CHARP (char_pred))
     {
       size_t count;
-      char chr;
-
-      chr = SCM_CHAR (char_pred);
 
       /* strip leading non-matches by incrementing cstart */
-      while (cstart < cend && cstr[cstart] != chr)
+      while (cstart < cend && scm_i_string_ref (s, cstart) != SCM_CHAR (char_pred))
         cstart++;
 
       /* strip trailing non-matches by decrementing cend */
-      while (cend > cstart && cstr[cend-1] != chr)
+      while (cend > cstart && scm_i_string_ref (s, cend-1) != SCM_CHAR (char_pred))
         cend--;
 
       /* count chars to keep */
       count = 0;
       for (idx = cstart; idx < cend; idx++)
-        if (cstr[idx] == chr)
+        if (scm_i_string_ref (s, idx) == SCM_CHAR (char_pred))
           count++;
 
       if (count == cend - cstart)
@@ -3380,17 +3066,17 @@ SCM_DEFINE (scm_string_filter, "string-filter", 2, 2, 0,
       size_t count;
 
       /* strip leading non-matches by incrementing cstart */
-      while (cstart < cend && ! SCM_CHARSET_GET (char_pred, cstr[cstart]))
+      while (cstart < cend && ! REF_IN_CHARSET (s, cstart, char_pred))
         cstart++;
 
       /* strip trailing non-matches by decrementing cend */
-      while (cend > cstart && ! SCM_CHARSET_GET (char_pred, cstr[cend-1]))
+      while (cend > cstart && ! REF_IN_CHARSET (s, cend-1, char_pred))
         cend--;
 
       /* count chars to be kept */
       count = 0;
       for (idx = cstart; idx < cend; idx++)
-        if (SCM_CHARSET_GET (char_pred, cstr[idx]))
+        if (REF_IN_CHARSET (s, idx, char_pred))
           count++;
 
       /* if whole of start to end kept then return substring */
@@ -3398,21 +3084,23 @@ SCM_DEFINE (scm_string_filter, "string-filter", 2, 2, 0,
         goto result_substring;
       else
         {
-          char *dst;
-          result = scm_i_make_string (count, &dst);
-          cstr = scm_i_string_chars (s);
+          size_t dst = 0;
+          result = scm_i_make_string (count, NULL);
+	  result = scm_i_string_start_writing (result);
 
           /* decrement "count" in this loop as well as using idx, so that if
              another thread is simultaneously changing "s" there's no chance
              it'll make us copy more than count characters */
           for (idx = cstart; idx < cend && count != 0; idx++)
             {
-              if (SCM_CHARSET_GET (char_pred, cstr[idx]))
+              if (REF_IN_CHARSET (s, idx, char_pred))
                 {
-                  *dst++ = cstr[idx];
+		  scm_i_string_set_x (result, dst, scm_i_string_ref (s, idx));
+		  dst ++;
                   count--;
                 }
             }
+	  scm_i_string_stop_writing ();
         }
     }
   else
@@ -3425,11 +3113,10 @@ SCM_DEFINE (scm_string_filter, "string-filter", 2, 2, 0,
       while (idx < cend)
 	{
 	  SCM res, ch;
-	  ch = SCM_MAKE_CHAR (cstr[idx]);
+	  ch = SCM_MAKE_CHAR (scm_i_string_ref (s, idx));
 	  res = pred_tramp (char_pred, ch);
 	  if (scm_is_true (res))
 	    ls = scm_cons (ch, ls);
-	  cstr = scm_i_string_chars (s);
 	  idx++;
 	}
       result = scm_reverse_list_to_string (ls);
@@ -3451,14 +3138,13 @@ SCM_DEFINE (scm_string_delete, "string-delete", 2, 2, 0,
 	    "membership.")
 #define FUNC_NAME s_scm_string_delete
 {
-  const char *cstr;
   size_t cstart, cend;
   SCM result;
   size_t idx;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s, cstr,
-				   3, start, cstart,
-				   4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s,
+			      3, start, cstart,
+			      4, end, cend);
 
   /* The explicit loops below stripping leading and trailing matches mean we
      can return a substring if those are the only deletions, making
@@ -3467,22 +3153,19 @@ SCM_DEFINE (scm_string_delete, "string-delete", 2, 2, 0,
   if (SCM_CHARP (char_pred))
     {
       size_t count;
-      char chr;
-
-      chr = SCM_CHAR (char_pred);
 
       /* strip leading matches by incrementing cstart */
-      while (cstart < cend && cstr[cstart] == chr)
+      while (cstart < cend && scm_i_string_ref (s, cstart) == SCM_CHAR(char_pred))
         cstart++;
 
       /* strip trailing matches by decrementing cend */
-      while (cend > cstart && cstr[cend-1] == chr)
+      while (cend > cstart && scm_i_string_ref (s, cend-1) == SCM_CHAR (char_pred))
         cend--;
 
       /* count chars to be kept */
       count = 0;
       for (idx = cstart; idx < cend; idx++)
-        if (cstr[idx] != chr)
+        if (scm_i_string_ref (s, idx) != SCM_CHAR (char_pred))
           count++;
 
       if (count == cend - cstart)
@@ -3494,22 +3177,24 @@ SCM_DEFINE (scm_string_delete, "string-delete", 2, 2, 0,
         }
       else
         {
+	  int i = 0;
           /* new string for retained portion */
-          char *dst;
-          result = scm_i_make_string (count, &dst);
-          cstr = scm_i_string_chars (s);
-
+          result = scm_i_make_string (count, NULL); 
+          result = scm_i_string_start_writing (result);
           /* decrement "count" in this loop as well as using idx, so that if
              another thread is simultaneously changing "s" there's no chance
              it'll make us copy more than count characters */
           for (idx = cstart; idx < cend && count != 0; idx++)
             {
-              if (cstr[idx] != chr)
+	      scm_t_wchar c = scm_i_string_ref (s, idx);
+              if (c != SCM_CHAR (char_pred))
                 {
-                  *dst++ = cstr[idx];
+                  scm_i_string_set_x (result, i, c);
+		  i++;
                   count--;
                 }
             }
+	  scm_i_string_stop_writing ();
         }
     }
   else if (SCM_CHARSETP (char_pred))
@@ -3517,39 +3202,41 @@ SCM_DEFINE (scm_string_delete, "string-delete", 2, 2, 0,
       size_t count;
 
       /* strip leading matches by incrementing cstart */
-      while (cstart < cend && SCM_CHARSET_GET (char_pred, cstr[cstart]))
+      while (cstart < cend && REF_IN_CHARSET (s, cstart, char_pred))
         cstart++;
 
       /* strip trailing matches by decrementing cend */
-      while (cend > cstart && SCM_CHARSET_GET (char_pred, cstr[cend-1]))
+      while (cend > cstart && REF_IN_CHARSET (s, cend-1, char_pred))
         cend--;
 
       /* count chars to be kept */
       count = 0;
       for (idx = cstart; idx < cend; idx++)
-        if (! SCM_CHARSET_GET (char_pred, cstr[idx]))
+        if (!REF_IN_CHARSET (s, idx, char_pred))
           count++;
 
       if (count == cend - cstart)
         goto result_substring;
       else
         {
+	  size_t i = 0;
           /* new string for retained portion */
-          char *dst;
-          result = scm_i_make_string (count, &dst);
-          cstr = scm_i_string_chars (s);
+          result = scm_i_make_string (count, NULL);
+	  result = scm_i_string_start_writing (result);
 
           /* decrement "count" in this loop as well as using idx, so that if
              another thread is simultaneously changing "s" there's no chance
              it'll make us copy more than count characters */
           for (idx = cstart; idx < cend && count != 0; idx++)
             {
-              if (! SCM_CHARSET_GET (char_pred, cstr[idx]))
+              if (!REF_IN_CHARSET (s, idx, char_pred))
                 {
-                  *dst++ = cstr[idx];
+		  scm_i_string_set_x (result, i, scm_i_string_ref (s, idx));
+		  i++;
                   count--;
                 }
             }
+	  scm_i_string_stop_writing ();
         }
     }
   else
@@ -3561,11 +3248,10 @@ SCM_DEFINE (scm_string_delete, "string-delete", 2, 2, 0,
       idx = cstart;
       while (idx < cend)
 	{
-	  SCM res, ch = SCM_MAKE_CHAR (cstr[idx]);
+	  SCM res, ch = SCM_MAKE_CHAR (scm_i_string_ref (s, idx));
 	  res = pred_tramp (char_pred, ch);
 	  if (scm_is_false (res))
 	    ls = scm_cons (ch, ls);
-	  cstr = scm_i_string_chars (s);
 	  idx++;
 	}
       result = scm_reverse_list_to_string (ls);
diff --git a/libguile/srfi-13.h b/libguile/srfi-13.h
index f8221ddc6..478a55d64 100644
--- a/libguile/srfi-13.h
+++ b/libguile/srfi-13.h
@@ -6,18 +6,19 @@
  * 	Copyright (C) 2001, 2004, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/srfi-14.c b/libguile/srfi-14.c
index fc047c028..7c0013193 100644
--- a/libguile/srfi-14.c
+++ b/libguile/srfi-14.c
@@ -3,18 +3,19 @@
  * Copyright (C) 2001, 2004, 2006, 2007 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 #ifdef HAVE_CONFIG_H
@@ -23,59 +24,511 @@
 
 
 #include <string.h>
-#include <ctype.h>
+#include <unictype.h>
 
 #include "libguile.h"
 #include "libguile/srfi-14.h"
+#include "libguile/strings.h"
 
+/* Include the pre-computed standard charset data.  */
+#include "libguile/srfi-14.i.c"
 
-#define SCM_CHARSET_SET(cs, idx)				\
-  (((long *) SCM_SMOB_DATA (cs))[(idx) / SCM_BITS_PER_LONG] |=	\
-    (1L << ((idx) % SCM_BITS_PER_LONG)))
+#define SCM_CHARSET_DATA(charset) ((scm_t_char_set *) SCM_SMOB_DATA (charset))
 
-#define SCM_CHARSET_UNSET(cs, idx)				\
-  (((long *) SCM_SMOB_DATA (cs))[(idx) / SCM_BITS_PER_LONG] &=	\
-    (~(1L << ((idx) % SCM_BITS_PER_LONG))))
-
-#define BYTES_PER_CHARSET (SCM_CHARSET_SIZE / 8)
-#define LONGS_PER_CHARSET (SCM_CHARSET_SIZE / SCM_BITS_PER_LONG)
+#define SCM_CHARSET_SET(cs, idx)                        \
+  scm_i_charset_set (SCM_CHARSET_DATA (cs), idx)
 
+#define SCM_CHARSET_UNSET(cs, idx)                      \
+  scm_i_charset_unset (SCM_CHARSET_DATA (cs), idx)
 
 /* Smob type code for character sets.  */
 int scm_tc16_charset = 0;
+int scm_tc16_charset_cursor = 0;
+
+/* True if N exists in charset CS.  */
+int
+scm_i_charset_get (scm_t_char_set *cs, scm_t_wchar n)
+{
+  size_t i;
+
+  i = 0;
+  while (i < cs->len)
+    {
+      if (cs->ranges[i].lo <= n && n <= cs->ranges[i].hi)
+        return 1;
+      i++;
+    }
+
+  return 0;
+}
+
+/* Put N into charset CS.  */
+void
+scm_i_charset_set (scm_t_char_set *cs, scm_t_wchar n)
+{
+  size_t i;
+  size_t len;
+
+  len = cs->len;
+
+  i = 0;
+  while (i < len)
+    {
+      /* Already in this range  */
+      if (cs->ranges[i].lo <= n && n <= cs->ranges[i].hi)
+        {
+          return;
+        }
+
+      if (n == cs->ranges[i].lo - 1)
+        {
+          /* This char is one below the current range. */
+          if (i > 0 && cs->ranges[i - 1].hi + 1 == n)
+            {
+              /* It is also one above the previous range, so combine them.  */
+              cs->ranges[i - 1].hi = cs->ranges[i].hi;
+              if (i < len - 1)
+                memmove (cs->ranges + i, cs->ranges + (i + 1),
+                         sizeof (scm_t_char_range) * (len - i - 1));
+              cs->ranges = scm_gc_realloc (cs->ranges,
+                                           sizeof (scm_t_char_range) * len,
+                                           sizeof (scm_t_char_range) * (len -
+                                                                        1),
+                                           "character-set");
+              cs->len = len - 1;
+              return;
+            }
+          else
+            {
+              /* Expand the range down by one.  */
+              cs->ranges[i].lo = n;
+              return;
+            }
+        }
+      else if (n == cs->ranges[i].hi + 1)
+        {
+          /* This char is one above the current range.  */
+          if (i < len - 1 && cs->ranges[i + 1].lo - 1 == n)
+            {
+              /* It is also one below the next range, so combine them.  */
+              cs->ranges[i].hi = cs->ranges[i + 1].hi;
+              if (i < len - 2)
+                memmove (cs->ranges + (i + 1), cs->ranges + (i + 2),
+                         sizeof (scm_t_char_range) * (len - i - 2));
+              cs->ranges = scm_gc_realloc (cs->ranges,
+                                           sizeof (scm_t_char_range) * len,
+                                           sizeof (scm_t_char_range) * (len -
+                                                                        1),
+                                           "character-set");
+              cs->len = len - 1;
+              return;
+            }
+          else
+            {
+              /* Expand the range up by one.  */
+              cs->ranges[i].hi = n;
+              return;
+            }
+        }
+      else if (n < cs->ranges[i].lo - 1)
+        {
+          /* This is a new range below the current one.  */
+          cs->ranges = scm_gc_realloc (cs->ranges,
+                                       sizeof (scm_t_char_range) * len,
+                                       sizeof (scm_t_char_range) * (len + 1),
+                                       "character-set");
+          memmove (cs->ranges + (i + 1), cs->ranges + i,
+                   sizeof (scm_t_char_range) * (len - i));
+          cs->ranges[i].lo = n;
+          cs->ranges[i].hi = n;
+          cs->len = len + 1;
+          return;
+        }
+
+      i++;
+    }
+
+  /* This is a new range above all previous ranges.  */
+  if (len == 0)
+    {
+      cs->ranges = scm_gc_malloc (sizeof (scm_t_char_range), "character-set");
+    }
+  else
+    {
+      cs->ranges = scm_gc_realloc (cs->ranges,
+                                   sizeof (scm_t_char_range) * len,
+                                   sizeof (scm_t_char_range) * (len + 1),
+                                   "character-set");
+    }
+  cs->ranges[len].lo = n;
+  cs->ranges[len].hi = n;
+  cs->len = len + 1;
+
+  return;
+}
+
+/* If N is in charset CS, remove it.  */
+void
+scm_i_charset_unset (scm_t_char_set *cs, scm_t_wchar n)
+{
+  size_t i;
+  size_t len;
+
+  len = cs->len;
+
+  i = 0;
+  while (i < len)
+    {
+      if (n < cs->ranges[i].lo)
+        /* Not in this set.  */
+        return;
+
+      if (n == cs->ranges[i].lo && n == cs->ranges[i].hi)
+        {
+          /* Remove this one-character range.  */
+          if (len == 1)
+            {
+              scm_gc_free (cs->ranges,
+                           sizeof (scm_t_char_range) * cs->len,
+                           "character-set");
+              cs->ranges = NULL;
+              cs->len = 0;
+              return;
+            }
+          else if (i < len - 1)
+            {
+              memmove (cs->ranges + i, cs->ranges + (i + 1),
+                       sizeof (scm_t_char_range) * (len - i - 1));
+              cs->ranges = scm_gc_realloc (cs->ranges,
+                                           sizeof (scm_t_char_range) * len,
+                                           sizeof (scm_t_char_range) * (len -
+                                                                        1),
+                                           "character-set");
+              cs->len = len - 1;
+              return;
+            }
+          else if (i == len - 1)
+            {
+              cs->ranges = scm_gc_realloc (cs->ranges,
+                                           sizeof (scm_t_char_range) * len,
+                                           sizeof (scm_t_char_range) * (len -
+                                                                        1),
+                                           "character-set");
+              cs->len = len - 1;
+              return;
+            }
+        }
+      else if (n == cs->ranges[i].lo)
+        {
+          /* Shrink this range from the left.  */
+          cs->ranges[i].lo = n + 1;
+          return;
+        }
+      else if (n == cs->ranges[i].hi)
+        {
+          /* Shrink this range from the right.  */
+          cs->ranges[i].hi = n - 1;
+          return;
+        }
+      else if (n > cs->ranges[i].lo && n < cs->ranges[i].hi)
+        {
+          /* Split this range into two pieces.  */
+          cs->ranges = scm_gc_realloc (cs->ranges,
+                                       sizeof (scm_t_char_range) * len,
+                                       sizeof (scm_t_char_range) * (len + 1),
+                                       "character-set");
+          if (i < len - 1)
+            memmove (cs->ranges + (i + 2), cs->ranges + (i + 1),
+                     sizeof (scm_t_char_range) * (len - i - 1));
+          cs->ranges[i + 1].hi = cs->ranges[i].hi;
+          cs->ranges[i + 1].lo = n + 1;
+          cs->ranges[i].hi = n - 1;
+          cs->len = len + 1;
+          return;
+        }
+
+      i++;
+    }
+
+  /* This value is above all ranges, so do nothing here.  */
+  return;
+}
+
+static int
+charsets_equal (scm_t_char_set *a, scm_t_char_set *b)
+{
+  if (a->len != b->len)
+    return 0;
+
+  if (memcmp (a->ranges, b->ranges, sizeof (scm_t_char_range) * a->len) != 0)
+    return 0;
+
+  return 1;
+}
+
+/* Return true if every character in A is also in B.  */
+static int
+charsets_leq (scm_t_char_set *a, scm_t_char_set *b)
+{
+  size_t i = 0, j = 0;
+  scm_t_wchar alo, ahi;
+
+  if (a->len == 0)
+    return 1;
+  if (b->len == 0)
+    return 0;
+  while (i < a->len)
+    {
+      alo = a->ranges[i].lo;
+      ahi = a->ranges[i].hi;
+      while (b->ranges[j].hi < alo)
+        {
+          if (j < b->len - 1)
+            j++;
+          else
+            return 0;
+        }
+      if (alo < b->ranges[j].lo || ahi > b->ranges[j].hi)
+        return 0;
+      i++;
+    }
+
+  return 1;
+}
+
+/* Merge B into A. */
+static void
+charsets_union (scm_t_char_set *a, scm_t_char_set *b)
+{
+  size_t i = 0;
+  scm_t_wchar blo, bhi, n;
+
+  if (b->len == 0)
+    return;
+
+  if (a->len == 0)
+    {
+      a->len = b->len;
+      a->ranges = scm_gc_malloc (sizeof (scm_t_char_range) * b->len,
+                                 "character-set");
+      memcpy (a->ranges, b->ranges, sizeof (scm_t_char_range) * b->len);
+      return;
+    }
+
+  /* This needs optimization.  */
+  while (i < b->len)
+    {
+      blo = b->ranges[i].lo;
+      bhi = b->ranges[i].hi;
+      for (n = blo; n <= bhi; n++)
+        scm_i_charset_set (a, n);
+
+      i++;
+    }
+
+  return;
+}
+
+/* Remove elements not both in A and B from A. */
+static void
+charsets_intersection (scm_t_char_set *a, scm_t_char_set *b)
+{
+  size_t i = 0;
+  scm_t_wchar blo, bhi, n;
+  scm_t_char_set *c;
+
+  if (a->len == 0)
+    return;
+
+  if (b->len == 0)
+    {
+      scm_gc_free (a->ranges, sizeof (scm_t_char_range) * a->len,
+                   "character-set");
+      a->len = 0;
+      return;
+    }
+
+  c = (scm_t_char_set *) scm_malloc (sizeof (scm_t_char_set));
+  c->len = 0;
+  c->ranges = NULL;
+
+  while (i < b->len)
+    {
+      blo = b->ranges[i].lo;
+      bhi = b->ranges[i].hi;
+      for (n = blo; n <= bhi; n++)
+        if (scm_i_charset_get (a, n))
+          scm_i_charset_set (c, n);
+      i++;
+    }
+  scm_gc_free (a->ranges, sizeof (scm_t_char_range) * a->len,
+               "character-set");
+
+  a->len = c->len;
+  if (c->len != 0)
+    a->ranges = c->ranges;
+  else
+    a->ranges = NULL;
+  free (c);
+  return;
+}
+
+/* Make P the compelement of Q.  */
+static void
+charsets_complement (scm_t_char_set *p, scm_t_char_set *q)
+{
+  int k, idx;
+
+  if (q->len == 0)
+    {
+      /* Fill with all valid codepoints.  */
+      p->len = 2;
+      p->ranges = scm_gc_malloc (sizeof (scm_t_char_range) * 2,
+                                 "character-set");
+      p->ranges[0].lo = 0;
+      p->ranges[0].hi = 0xd7ff;
+      p->ranges[1].lo = 0xe000;
+      p->ranges[1].hi = SCM_CODEPOINT_MAX;
+      return;
+    }
+
+  if (p->len > 0)
+    scm_gc_free (p->ranges, sizeof (scm_t_char_set) * p->len,
+                 "character-set");
+
+  p->len = 0;
+  if (q->ranges[0].lo > 0)
+    p->len++;
+  if (q->ranges[q->len - 1].hi < SCM_CODEPOINT_MAX)
+    p->len++;
+  p->len += q->len - 1;
+  p->ranges =
+    (scm_t_char_range *) scm_gc_malloc (sizeof (scm_t_char_range) * p->len,
+                                        "character-set");
+  idx = 0;
+  if (q->ranges[0].lo > 0)
+    {
+      p->ranges[idx].lo = 0;
+      p->ranges[idx++].hi = q->ranges[0].lo - 1;
+    }
+  for (k = 1; k < q->len; k++)
+    {
+      p->ranges[idx].lo = q->ranges[k - 1].hi + 1;
+      p->ranges[idx++].hi = q->ranges[k].lo - 1;
+    }
+  if (q->ranges[q->len - 1].hi < SCM_CODEPOINT_MAX)
+    {
+      p->ranges[idx].lo = q->ranges[q->len - 1].hi + 1;
+      p->ranges[idx].hi = SCM_CODEPOINT_MAX;
+    }
+  return;
+}
+
+/* Replace A with elements only found in one of A or B.  */
+static void
+charsets_xor (scm_t_char_set *a, scm_t_char_set *b)
+{
+  size_t i = 0;
+  scm_t_wchar blo, bhi, n;
+
+  if (b->len == 0)
+    {
+      return;
+    }
 
+  if (a->len == 0)
+    {
+      a->ranges =
+        (scm_t_char_range *) scm_gc_malloc (sizeof (scm_t_char_range) *
+                                            b->len, "character-set");
+      a->len = b->len;
+      memcpy (a->ranges, b->ranges, sizeof (scm_t_char_range) * a->len);
+      return;
+    }
+
+  while (i < b->len)
+    {
+      blo = b->ranges[i].lo;
+      bhi = b->ranges[i].hi;
+      for (n = blo; n <= bhi; n++)
+        {
+          if (scm_i_charset_get (a, n))
+            scm_i_charset_unset (a, n);
+          else
+            scm_i_charset_set (a, n);
+        }
+
+      i++;
+    }
+  return;
+}
 
 /* Smob print hook for character sets.  */
 static int
 charset_print (SCM charset, SCM port, scm_print_state *pstate SCM_UNUSED)
 {
-  int i;
+  size_t i;
   int first = 1;
+  scm_t_char_set *p;
+  const size_t max_ranges_to_print = 50;
+
+  p = SCM_CHARSET_DATA (charset);
 
   scm_puts ("#<charset {", port);
-  for (i = 0; i < SCM_CHARSET_SIZE; i++)
-    if (SCM_CHARSET_GET (charset, i))
-      {
-	if (first)
-	  first = 0;
-	else
-	  scm_puts (" ", port);
-	scm_write (SCM_MAKE_CHAR (i), port);
-      }
+  for (i = 0; i < p->len; i++)
+    {
+      if (first)
+        first = 0;
+      else
+        scm_puts (" ", port);
+      scm_write (SCM_MAKE_CHAR (p->ranges[i].lo), port);
+      if (p->ranges[i].lo != p->ranges[i].hi)
+        {
+          scm_puts ("..", port);
+          scm_write (SCM_MAKE_CHAR (p->ranges[i].hi), port);
+        }
+      if (i >= max_ranges_to_print)
+        {
+          /* Too many to print here.  Quit early.  */
+          scm_puts (" ...", port);
+          break;
+        }
+    }
   scm_puts ("}>", port);
   return 1;
 }
 
+/* Smob print hook for character sets cursors.  */
+static int
+charset_cursor_print (SCM cursor, SCM port,
+                      scm_print_state *pstate SCM_UNUSED)
+{
+  scm_t_char_set_cursor *cur;
+
+  cur = (scm_t_char_set_cursor *) SCM_SMOB_DATA (cursor);
+
+  scm_puts ("#<charset-cursor ", port);
+  if (cur->range == (size_t) (-1))
+    scm_puts ("(empty)", port);
+  else
+    {
+      scm_write (scm_from_size_t (cur->range), port);
+      scm_puts (":", port);
+      scm_write (scm_from_int32 (cur->n), port);
+    }
+  scm_puts (">", port);
+  return 1;
+}
 
 
 /* Create a new, empty character set.  */
 static SCM
-make_char_set (const char * func_name)
+make_char_set (const char *func_name)
 {
-  long * p;
+  scm_t_char_set *p;
 
-  p = scm_gc_malloc (BYTES_PER_CHARSET, "character-set");
-  memset (p, 0, BYTES_PER_CHARSET);
+  p = scm_gc_malloc (sizeof (scm_t_char_set), "character-set");
+  memset (p, 0, sizeof (scm_t_char_set));
   SCM_RETURN_NEWSMOB (scm_tc16_charset, p);
 }
 
@@ -97,22 +550,22 @@ SCM_DEFINE (scm_char_set_eq, "char-set=", 0, 0, 1,
 #define FUNC_NAME s_scm_char_set_eq
 {
   int argnum = 1;
-  long *cs1_data = NULL;
+  scm_t_char_set *cs1_data = NULL;
 
   SCM_VALIDATE_REST_ARGUMENT (char_sets);
 
   while (!scm_is_null (char_sets))
     {
       SCM csi = SCM_CAR (char_sets);
-      long *csi_data;
+      scm_t_char_set *csi_data;
 
       SCM_VALIDATE_SMOB (argnum, csi, charset);
       argnum++;
-      csi_data = (long *) SCM_SMOB_DATA (csi);
+      csi_data = SCM_CHARSET_DATA (csi);
       if (cs1_data == NULL)
-	cs1_data = csi_data;
-      else if (memcmp (cs1_data, csi_data, BYTES_PER_CHARSET) != 0)
-	return SCM_BOOL_F;
+        cs1_data = csi_data;
+      else if (!charsets_equal (cs1_data, csi_data))
+        return SCM_BOOL_F;
       char_sets = SCM_CDR (char_sets);
     }
   return SCM_BOOL_T;
@@ -127,28 +580,23 @@ SCM_DEFINE (scm_char_set_leq, "char-set<=", 0, 0, 1,
 #define FUNC_NAME s_scm_char_set_leq
 {
   int argnum = 1;
-  long *prev_data = NULL;
+  scm_t_char_set *prev_data = NULL;
 
   SCM_VALIDATE_REST_ARGUMENT (char_sets);
 
   while (!scm_is_null (char_sets))
     {
       SCM csi = SCM_CAR (char_sets);
-      long *csi_data;
+      scm_t_char_set *csi_data;
 
       SCM_VALIDATE_SMOB (argnum, csi, charset);
       argnum++;
-      csi_data = (long *) SCM_SMOB_DATA (csi);
+      csi_data = SCM_CHARSET_DATA (csi);
       if (prev_data)
-	{
-	  int k;
-
-	  for (k = 0; k < LONGS_PER_CHARSET; k++)
-	    {
-	      if ((prev_data[k] & csi_data[k]) != prev_data[k])
-		return SCM_BOOL_F;
-	    }
-	}
+        {
+          if (!charsets_leq (prev_data, csi_data))
+            return SCM_BOOL_F;
+        }
       prev_data = csi_data;
       char_sets = SCM_CDR (char_sets);
     }
@@ -166,9 +614,10 @@ SCM_DEFINE (scm_char_set_hash, "char-set-hash", 1, 1, 0,
 {
   const unsigned long default_bnd = 871;
   unsigned long bnd;
-  long * p;
+  scm_t_char_set *p;
   unsigned long val = 0;
   int k;
+  scm_t_wchar c;
 
   SCM_VALIDATE_SMOB (1, cs, charset);
 
@@ -178,14 +627,14 @@ SCM_DEFINE (scm_char_set_hash, "char-set-hash", 1, 1, 0,
     {
       bnd = scm_to_ulong (bound);
       if (bnd == 0)
-	bnd = default_bnd;
+        bnd = default_bnd;
     }
 
-  p = (long *) SCM_SMOB_DATA (cs);
-  for (k = 0; k < LONGS_PER_CHARSET; k++)
+  p = SCM_CHARSET_DATA (cs);
+  for (k = 0; k < p->len; k++)
     {
-      if (p[k] != 0)
-        val = p[k] + (val << 1);
+      for (c = p->ranges[k].lo; c <= p->ranges[k].hi; c++)
+        val = c + (val << 1);
     }
   return scm_from_ulong (val % bnd);
 }
@@ -193,89 +642,150 @@ SCM_DEFINE (scm_char_set_hash, "char-set-hash", 1, 1, 0,
 
 
 SCM_DEFINE (scm_char_set_cursor, "char-set-cursor", 1, 0, 0,
-	    (SCM cs),
-	    "Return a cursor into the character set @var{cs}.")
+            (SCM cs), "Return a cursor into the character set @var{cs}.")
 #define FUNC_NAME s_scm_char_set_cursor
 {
-  int idx;
+  scm_t_char_set *cs_data;
+  scm_t_char_set_cursor *cur_data;
 
   SCM_VALIDATE_SMOB (1, cs, charset);
-  for (idx = 0; idx < SCM_CHARSET_SIZE; idx++)
+  cs_data = SCM_CHARSET_DATA (cs);
+  cur_data =
+    (scm_t_char_set_cursor *) scm_gc_malloc (sizeof (scm_t_char_set_cursor),
+                                             "charset-cursor");
+  if (cs_data->len == 0)
     {
-      if (SCM_CHARSET_GET (cs, idx))
-	break;
+      cur_data->range = (size_t) (-1);
+      cur_data->n = 0;
     }
-  return SCM_I_MAKINUM (idx);
+  else
+    {
+      cur_data->range = 0;
+      cur_data->n = cs_data->ranges[0].lo;
+    }
+  SCM_RETURN_NEWSMOB (scm_tc16_charset_cursor, cur_data);
 }
 #undef FUNC_NAME
 
 
 SCM_DEFINE (scm_char_set_ref, "char-set-ref", 2, 0, 0,
-	    (SCM cs, SCM cursor),
-	    "Return the character at the current cursor position\n"
-	    "@var{cursor} in the character set @var{cs}.  It is an error to\n"
-	    "pass a cursor for which @code{end-of-char-set?} returns true.")
+            (SCM cs, SCM cursor),
+            "Return the character at the current cursor position\n"
+            "@var{cursor} in the character set @var{cs}.  It is an error to\n"
+            "pass a cursor for which @code{end-of-char-set?} returns true.")
 #define FUNC_NAME s_scm_char_set_ref
 {
-  size_t ccursor = scm_to_size_t (cursor);
+  scm_t_char_set *cs_data;
+  scm_t_char_set_cursor *cur_data;
+  size_t i;
+
   SCM_VALIDATE_SMOB (1, cs, charset);
+  SCM_VALIDATE_SMOB (2, cursor, charset_cursor);
 
-  if (ccursor >= SCM_CHARSET_SIZE || !SCM_CHARSET_GET (cs, ccursor))
+  cs_data = SCM_CHARSET_DATA (cs);
+  cur_data = (scm_t_char_set_cursor *) SCM_SMOB_DATA (cursor);
+
+  /* Validate that this cursor is still true.  */
+  i = cur_data->range;
+  if (i == (size_t) (-1)
+      || i >= cs_data->len
+      || cur_data->n < cs_data->ranges[i].lo
+      || cur_data->n > cs_data->ranges[i].hi)
     SCM_MISC_ERROR ("invalid character set cursor: ~A", scm_list_1 (cursor));
-  return SCM_MAKE_CHAR (ccursor);
+  return SCM_MAKE_CHAR (cur_data->n);
 }
 #undef FUNC_NAME
 
 
 SCM_DEFINE (scm_char_set_cursor_next, "char-set-cursor-next", 2, 0, 0,
-	    (SCM cs, SCM cursor),
-	    "Advance the character set cursor @var{cursor} to the next\n"
-	    "character in the character set @var{cs}.  It is an error if the\n"
-	    "cursor given satisfies @code{end-of-char-set?}.")
+            (SCM cs, SCM cursor),
+            "Advance the character set cursor @var{cursor} to the next\n"
+            "character in the character set @var{cs}.  It is an error if the\n"
+            "cursor given satisfies @code{end-of-char-set?}.")
 #define FUNC_NAME s_scm_char_set_cursor_next
 {
-  size_t ccursor = scm_to_size_t (cursor);
+  scm_t_char_set *cs_data;
+  scm_t_char_set_cursor *cur_data;
+  size_t i;
+
   SCM_VALIDATE_SMOB (1, cs, charset);
+  SCM_VALIDATE_SMOB (2, cursor, charset_cursor);
+
+  cs_data = SCM_CHARSET_DATA (cs);
+  cur_data = (scm_t_char_set_cursor *) SCM_SMOB_DATA (cursor);
 
-  if (ccursor >= SCM_CHARSET_SIZE || !SCM_CHARSET_GET (cs, ccursor))
+  /* Validate that this cursor is still true.  */
+  i = cur_data->range;
+  if (i == (size_t) (-1)
+      || i >= cs_data->len
+      || cur_data->n < cs_data->ranges[i].lo
+      || cur_data->n > cs_data->ranges[i].hi)
     SCM_MISC_ERROR ("invalid character set cursor: ~A", scm_list_1 (cursor));
-  for (ccursor++; ccursor < SCM_CHARSET_SIZE; ccursor++)
+  /* Increment the cursor.  */
+  if (cur_data->n == cs_data->ranges[i].hi)
     {
-      if (SCM_CHARSET_GET (cs, ccursor))
-	break;
+      if (i + 1 < cs_data->len)
+        {
+          cur_data->range = i + 1;
+          cur_data->n = cs_data->ranges[i + 1].lo;
+        }
+      else
+        {
+          /* This is the end of the road.  */
+          cur_data->range = (size_t) (-1);
+          cur_data->n = 0;
+        }
     }
-  return SCM_I_MAKINUM (ccursor);
+  else
+    {
+      cur_data->n = cur_data->n + 1;
+    }
+
+  return cursor;
 }
 #undef FUNC_NAME
 
 
 SCM_DEFINE (scm_end_of_char_set_p, "end-of-char-set?", 1, 0, 0,
-	    (SCM cursor),
-	    "Return @code{#t} if @var{cursor} has reached the end of a\n"
-	    "character set, @code{#f} otherwise.")
+            (SCM cursor),
+            "Return @code{#t} if @var{cursor} has reached the end of a\n"
+            "character set, @code{#f} otherwise.")
 #define FUNC_NAME s_scm_end_of_char_set_p
 {
-  size_t ccursor = scm_to_size_t (cursor);
-  return scm_from_bool (ccursor >= SCM_CHARSET_SIZE);
+  scm_t_char_set_cursor *cur_data;
+  SCM_VALIDATE_SMOB (1, cursor, charset_cursor);
+
+  cur_data = (scm_t_char_set_cursor *) SCM_SMOB_DATA (cursor);
+  if (cur_data->range == (size_t) (-1))
+    return SCM_BOOL_T;
+
+  return SCM_BOOL_F;
 }
 #undef FUNC_NAME
 
 
 SCM_DEFINE (scm_char_set_fold, "char-set-fold", 3, 0, 0,
-	    (SCM kons, SCM knil, SCM cs),
-	    "Fold the procedure @var{kons} over the character set @var{cs},\n"
-	    "initializing it with @var{knil}.")
+            (SCM kons, SCM knil, SCM cs),
+            "Fold the procedure @var{kons} over the character set @var{cs},\n"
+            "initializing it with @var{knil}.")
 #define FUNC_NAME s_scm_char_set_fold
 {
+  scm_t_char_set *cs_data;
   int k;
+  scm_t_wchar n;
 
   SCM_VALIDATE_PROC (1, kons);
   SCM_VALIDATE_SMOB (3, cs, charset);
 
-  for (k = 0; k < SCM_CHARSET_SIZE; k++)
-    if (SCM_CHARSET_GET (cs, k))
+  cs_data = SCM_CHARSET_DATA (cs);
+
+  if (cs_data->len == 0)
+    return knil;
+
+  for (k = 0; k < cs_data->len; k++)
+    for (n = cs_data->ranges[k].lo; n <= cs_data->ranges[k].hi; n++)
       {
-	knil = scm_call_2 (kons, SCM_MAKE_CHAR (k), knil);
+        knil = scm_call_2 (kons, SCM_MAKE_CHAR (n), knil);
       }
   return knil;
 }
@@ -365,19 +875,29 @@ SCM_DEFINE (scm_char_set_unfold_x, "char-set-unfold!", 5, 0, 0,
 
 
 SCM_DEFINE (scm_char_set_for_each, "char-set-for-each", 2, 0, 0,
-	    (SCM proc, SCM cs),
-	    "Apply @var{proc} to every character in the character set\n"
-	    "@var{cs}.  The return value is not specified.")
+            (SCM proc, SCM cs),
+            "Apply @var{proc} to every character in the character set\n"
+            "@var{cs}.  The return value is not specified.")
 #define FUNC_NAME s_scm_char_set_for_each
 {
+  scm_t_char_set *cs_data;
   int k;
+  scm_t_wchar n;
 
   SCM_VALIDATE_PROC (1, proc);
   SCM_VALIDATE_SMOB (2, cs, charset);
 
-  for (k = 0; k < SCM_CHARSET_SIZE; k++)
-    if (SCM_CHARSET_GET (cs, k))
-      scm_call_1 (proc, SCM_MAKE_CHAR (k));
+  cs_data = SCM_CHARSET_DATA (cs);
+
+  if (cs_data->len == 0)
+    return SCM_UNSPECIFIED;
+
+  for (k = 0; k < cs_data->len; k++)
+    for (n = cs_data->ranges[k].lo; n <= cs_data->ranges[k].hi; n++)
+      {
+        scm_call_1 (proc, SCM_MAKE_CHAR (n));
+      }
+
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
@@ -391,18 +911,26 @@ SCM_DEFINE (scm_char_set_map, "char-set-map", 2, 0, 0,
 {
   SCM result;
   int k;
+  scm_t_char_set *cs_data;
+  scm_t_wchar n;
 
   SCM_VALIDATE_PROC (1, proc);
   SCM_VALIDATE_SMOB (2, cs, charset);
 
   result = make_char_set (FUNC_NAME);
-  for (k = 0; k < SCM_CHARSET_SIZE; k++)
-    if (SCM_CHARSET_GET (cs, k))
+  cs_data = SCM_CHARSET_DATA (cs);
+
+  if (cs_data->len == 0)
+    return result;
+
+  for (k = 0; k < cs_data->len; k++)
+    for (n = cs_data->ranges[k].lo; n <= cs_data->ranges[k].hi; n++)
       {
-	SCM ch = scm_call_1 (proc, SCM_MAKE_CHAR (k));
-	if (!SCM_CHARP (ch))
-	  SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (proc));
-	SCM_CHARSET_SET (result, SCM_CHAR (ch));
+        SCM ch = scm_call_1 (proc, SCM_MAKE_CHAR (n));
+        if (!SCM_CHARP (ch))
+          SCM_MISC_ERROR ("procedure ~S returned non-char",
+                          scm_list_1 (proc));
+        SCM_CHARSET_SET (result, SCM_CHAR (ch));
       }
   return result;
 }
@@ -416,15 +944,23 @@ SCM_DEFINE (scm_char_set_copy, "char-set-copy", 1, 0, 0,
 #define FUNC_NAME s_scm_char_set_copy
 {
   SCM ret;
-  long * p1, * p2;
-  int k;
+  scm_t_char_set *p1, *p2;
 
   SCM_VALIDATE_SMOB (1, cs, charset);
   ret = make_char_set (FUNC_NAME);
-  p1 = (long *) SCM_SMOB_DATA (cs);
-  p2 = (long *) SCM_SMOB_DATA (ret);
-  for (k = 0; k < LONGS_PER_CHARSET; k++)
-    p2[k] = p1[k];
+  p1 = SCM_CHARSET_DATA (cs);
+  p2 = SCM_CHARSET_DATA (ret);
+  p2->len = p1->len;
+
+  if (p1->len == 0)
+    p2->ranges = NULL;
+  else
+    {
+      p2->ranges = scm_gc_malloc (sizeof (scm_t_char_range) * p1->len,
+                                  "character-set");
+      memcpy (p2->ranges, p1->ranges, sizeof (scm_t_char_range) * p1->len);
+    }
+
   return ret;
 }
 #undef FUNC_NAME
@@ -436,20 +972,18 @@ SCM_DEFINE (scm_char_set, "char-set", 0, 0, 1,
 #define FUNC_NAME s_scm_char_set
 {
   SCM cs;
-  long * p;
   int argnum = 1;
 
   SCM_VALIDATE_REST_ARGUMENT (rest);
   cs = make_char_set (FUNC_NAME);
-  p = (long *) SCM_SMOB_DATA (cs);
   while (!scm_is_null (rest))
     {
-      int c;
+      scm_t_wchar c;
 
       SCM_VALIDATE_CHAR_COPY (argnum, SCM_CAR (rest), c);
       argnum++;
       rest = SCM_CDR (rest);
-      p[c / SCM_BITS_PER_LONG] |= 1L << (c % SCM_BITS_PER_LONG);
+      SCM_CHARSET_SET (cs, c);
     }
   return cs;
 }
@@ -464,7 +998,6 @@ SCM_DEFINE (scm_list_to_char_set, "list->char-set", 1, 1, 0,
 #define FUNC_NAME s_scm_list_to_char_set
 {
   SCM cs;
-  long * p;
 
   SCM_VALIDATE_LIST (1, list);
   if (SCM_UNBNDP (base_cs))
@@ -474,16 +1007,16 @@ SCM_DEFINE (scm_list_to_char_set, "list->char-set", 1, 1, 0,
       SCM_VALIDATE_SMOB (2, base_cs, charset);
       cs = scm_char_set_copy (base_cs);
     }
-  p = (long *) SCM_SMOB_DATA (cs);
   while (!scm_is_null (list))
     {
       SCM chr = SCM_CAR (list);
-      int c;
+      scm_t_wchar c;
 
       SCM_VALIDATE_CHAR_COPY (0, chr, c);
       list = SCM_CDR (list);
 
-      p[c / SCM_BITS_PER_LONG] |= 1L << (c % SCM_BITS_PER_LONG);
+
+      SCM_CHARSET_SET (cs, c);
     }
   return cs;
 }
@@ -491,26 +1024,23 @@ SCM_DEFINE (scm_list_to_char_set, "list->char-set", 1, 1, 0,
 
 
 SCM_DEFINE (scm_list_to_char_set_x, "list->char-set!", 2, 0, 0,
-	    (SCM list, SCM base_cs),
-	    "Convert the character list @var{list} to a character set.  The\n"
-	    "characters are added to @var{base_cs} and @var{base_cs} is\n"
-	    "returned.")
+            (SCM list, SCM base_cs),
+            "Convert the character list @var{list} to a character set.  The\n"
+            "characters are added to @var{base_cs} and @var{base_cs} is\n"
+            "returned.")
 #define FUNC_NAME s_scm_list_to_char_set_x
 {
-  long * p;
-
   SCM_VALIDATE_LIST (1, list);
   SCM_VALIDATE_SMOB (2, base_cs, charset);
-  p = (long *) SCM_SMOB_DATA (base_cs);
   while (!scm_is_null (list))
     {
       SCM chr = SCM_CAR (list);
-      int c;
+      scm_t_wchar c;
 
       SCM_VALIDATE_CHAR_COPY (0, chr, c);
       list = SCM_CDR (list);
 
-      p[c / SCM_BITS_PER_LONG] |= 1L << (c % SCM_BITS_PER_LONG);
+      SCM_CHARSET_SET (base_cs, c);
     }
   return base_cs;
 }
@@ -525,8 +1055,6 @@ SCM_DEFINE (scm_string_to_char_set, "string->char-set", 1, 1, 0,
 #define FUNC_NAME s_scm_string_to_char_set
 {
   SCM cs;
-  long * p;
-  const char * s;
   size_t k = 0, len;
 
   SCM_VALIDATE_STRING (1, str);
@@ -537,13 +1065,11 @@ SCM_DEFINE (scm_string_to_char_set, "string->char-set", 1, 1, 0,
       SCM_VALIDATE_SMOB (2, base_cs, charset);
       cs = scm_char_set_copy (base_cs);
     }
-  p = (long *) SCM_SMOB_DATA (cs);
-  s = scm_i_string_chars (str);
   len = scm_i_string_length (str);
   while (k < len)
     {
-      int c = s[k++];
-      p[c / SCM_BITS_PER_LONG] |= 1L << (c % SCM_BITS_PER_LONG);
+      scm_t_wchar c = scm_i_string_ref (str, k++);
+      SCM_CHARSET_SET (cs, c);
     }
   scm_remember_upto_here_1 (str);
   return cs;
@@ -552,25 +1078,21 @@ SCM_DEFINE (scm_string_to_char_set, "string->char-set", 1, 1, 0,
 
 
 SCM_DEFINE (scm_string_to_char_set_x, "string->char-set!", 2, 0, 0,
-	    (SCM str, SCM base_cs),
-	    "Convert the string @var{str} to a character set.  The\n"
-	    "characters from the string are added to @var{base_cs}, and\n"
-	    "@var{base_cs} is returned.")
+            (SCM str, SCM base_cs),
+            "Convert the string @var{str} to a character set.  The\n"
+            "characters from the string are added to @var{base_cs}, and\n"
+            "@var{base_cs} is returned.")
 #define FUNC_NAME s_scm_string_to_char_set_x
 {
-  long * p;
-  const char * s;
   size_t k = 0, len;
 
   SCM_VALIDATE_STRING (1, str);
   SCM_VALIDATE_SMOB (2, base_cs, charset);
-  p = (long *) SCM_SMOB_DATA (base_cs);
-  s = scm_i_string_chars (str);
   len = scm_i_string_length (str);
   while (k < len)
     {
-      int c = s[k++];
-      p[c / SCM_BITS_PER_LONG] |= 1L << (c % SCM_BITS_PER_LONG);
+      scm_t_wchar c = scm_i_string_ref (str, k++);
+      SCM_CHARSET_SET (base_cs, c);
     }
   scm_remember_upto_here_1 (str);
   return base_cs;
@@ -587,7 +1109,8 @@ SCM_DEFINE (scm_char_set_filter, "char-set-filter", 2, 1, 0,
 {
   SCM ret;
   int k;
-  long * p;
+  scm_t_wchar n;
+  scm_t_char_set *p;
 
   SCM_VALIDATE_PROC (1, pred);
   SCM_VALIDATE_SMOB (2, cs, charset);
@@ -598,17 +1121,20 @@ SCM_DEFINE (scm_char_set_filter, "char-set-filter", 2, 1, 0,
     }
   else
     ret = make_char_set (FUNC_NAME);
-  p = (long *) SCM_SMOB_DATA (ret);
-  for (k = 0; k < SCM_CHARSET_SIZE; k++)
-    {
-      if (SCM_CHARSET_GET (cs, k))
-	{
-	  SCM res = scm_call_1 (pred, SCM_MAKE_CHAR (k));
 
-	  if (scm_is_true (res))
-	    p[k / SCM_BITS_PER_LONG] |= 1L << (k % SCM_BITS_PER_LONG);
-	}
-    }
+  p = SCM_CHARSET_DATA (cs);
+
+  if (p->len == 0)
+    return ret;
+
+  for (k = 0; k < p->len; k++)
+    for (n = p->ranges[k].lo; n <= p->ranges[k].hi; n++)
+      {
+        SCM res = scm_call_1 (pred, SCM_MAKE_CHAR (n));
+
+        if (scm_is_true (res))
+          SCM_CHARSET_SET (ret, n);
+      }
   return ret;
 }
 #undef FUNC_NAME
@@ -622,22 +1148,24 @@ SCM_DEFINE (scm_char_set_filter_x, "char-set-filter!", 3, 0, 0,
 #define FUNC_NAME s_scm_char_set_filter_x
 {
   int k;
-  long * p;
+  scm_t_wchar n;
+  scm_t_char_set *p;
 
   SCM_VALIDATE_PROC (1, pred);
   SCM_VALIDATE_SMOB (2, cs, charset);
   SCM_VALIDATE_SMOB (3, base_cs, charset);
-  p = (long *) SCM_SMOB_DATA (base_cs);
-  for (k = 0; k < SCM_CHARSET_SIZE; k++)
-    {
-      if (SCM_CHARSET_GET (cs, k))
-	{
-	  SCM res = scm_call_1 (pred, SCM_MAKE_CHAR (k));
+  p = SCM_CHARSET_DATA (cs);
+  if (p->len == 0)
+    return base_cs;
 
-	  if (scm_is_true (res))
-	    p[k / SCM_BITS_PER_LONG] |= 1L << (k % SCM_BITS_PER_LONG);
-	}
-    }
+  for (k = 0; k < p->len; k++)
+    for (n = p->ranges[k].lo; n <= p->ranges[k].hi; n++)
+      {
+        SCM res = scm_call_1 (pred, SCM_MAKE_CHAR (k));
+
+        if (scm_is_true (res))
+          SCM_CHARSET_SET (base_cs, n);
+      }
   return base_cs;
 }
 #undef FUNC_NAME
@@ -661,7 +1189,6 @@ SCM_DEFINE (scm_ucs_range_to_char_set, "ucs-range->char-set", 2, 2, 0,
 {
   SCM cs;
   size_t clower, cupper;
-  long * p;
 
   clower = scm_to_size_t (lower);
   cupper = scm_to_size_t (upper);
@@ -669,15 +1196,15 @@ SCM_DEFINE (scm_ucs_range_to_char_set, "ucs-range->char-set", 2, 2, 0,
   if (!SCM_UNBNDP (error))
     {
       if (scm_is_true (error))
-	{
-	  SCM_ASSERT_RANGE (1, lower, clower <= SCM_CHARSET_SIZE);
-	  SCM_ASSERT_RANGE (2, upper, cupper <= SCM_CHARSET_SIZE);
-	}
+        {
+          SCM_ASSERT_RANGE (1, lower, SCM_IS_UNICODE_CHAR (clower));
+          SCM_ASSERT_RANGE (2, upper, SCM_IS_UNICODE_CHAR (cupper));
+        }
     }
-  if (clower > SCM_CHARSET_SIZE)
-    clower = SCM_CHARSET_SIZE;
-  if (cupper > SCM_CHARSET_SIZE)
-    cupper = SCM_CHARSET_SIZE;
+  if (clower > 0x10FFFF)
+    clower = 0x10FFFF;
+  if (cupper > 0x10FFFF)
+    cupper = 0x10FFFF;
   if (SCM_UNBNDP (base_cs))
     cs = make_char_set (FUNC_NAME);
   else
@@ -685,10 +1212,11 @@ SCM_DEFINE (scm_ucs_range_to_char_set, "ucs-range->char-set", 2, 2, 0,
       SCM_VALIDATE_SMOB (4, base_cs, charset);
       cs = scm_char_set_copy (base_cs);
     }
-  p = (long *) SCM_SMOB_DATA (cs);
+  /* It not be difficult to write a more optimized version of the
+     following.  */
   while (clower < cupper)
     {
-      p[clower / SCM_BITS_PER_LONG] |= 1L << (clower % SCM_BITS_PER_LONG);
+      SCM_CHARSET_SET (cs, clower);
       clower++;
     }
   return cs;
@@ -713,24 +1241,24 @@ SCM_DEFINE (scm_ucs_range_to_char_set_x, "ucs-range->char-set!", 4, 0, 0,
 #define FUNC_NAME s_scm_ucs_range_to_char_set_x
 {
   size_t clower, cupper;
-  long * p;
 
   clower = scm_to_size_t (lower);
   cupper = scm_to_size_t (upper);
   SCM_ASSERT_RANGE (2, upper, cupper >= clower);
   if (scm_is_true (error))
     {
-      SCM_ASSERT_RANGE (1, lower, clower <= SCM_CHARSET_SIZE);
-      SCM_ASSERT_RANGE (2, upper, cupper <= SCM_CHARSET_SIZE);
+      SCM_ASSERT_RANGE (1, lower, SCM_IS_UNICODE_CHAR (clower));
+      SCM_ASSERT_RANGE (2, upper, SCM_IS_UNICODE_CHAR (cupper));
     }
-  if (clower > SCM_CHARSET_SIZE)
-    clower = SCM_CHARSET_SIZE;
-  if (cupper > SCM_CHARSET_SIZE)
-    cupper = SCM_CHARSET_SIZE;
-  p = (long *) SCM_SMOB_DATA (base_cs);
+  if (clower > SCM_CODEPOINT_MAX)
+    clower = SCM_CODEPOINT_MAX;
+  if (cupper > SCM_CODEPOINT_MAX)
+    cupper = SCM_CODEPOINT_MAX;
+
   while (clower < cupper)
     {
-      p[clower / SCM_BITS_PER_LONG] |= 1L << (clower % SCM_BITS_PER_LONG);
+      if (SCM_IS_UNICODE_CHAR (clower))
+        SCM_CHARSET_SET (base_cs, clower);
       clower++;
     }
   return base_cs;
@@ -759,12 +1287,18 @@ SCM_DEFINE (scm_char_set_size, "char-set-size", 1, 0, 0,
 #define FUNC_NAME s_scm_char_set_size
 {
   int k, count = 0;
+  scm_t_char_set *cs_data;
 
   SCM_VALIDATE_SMOB (1, cs, charset);
-  for (k = 0; k < SCM_CHARSET_SIZE; k++)
-    if (SCM_CHARSET_GET (cs, k))
-      count++;
-  return SCM_I_MAKINUM (count);
+  cs_data = SCM_CHARSET_DATA (cs);
+
+  if (cs_data->len == 0)
+    return scm_from_int (0);
+
+  for (k = 0; k < cs_data->len; k++)
+    count += cs_data->ranges[k].hi - cs_data->ranges[k].lo + 1;
+
+  return scm_from_int (count);
 }
 #undef FUNC_NAME
 
@@ -776,16 +1310,21 @@ SCM_DEFINE (scm_char_set_count, "char-set-count", 2, 0, 0,
 #define FUNC_NAME s_scm_char_set_count
 {
   int k, count = 0;
+  scm_t_wchar n;
+  scm_t_char_set *cs_data;
 
   SCM_VALIDATE_PROC (1, pred);
   SCM_VALIDATE_SMOB (2, cs, charset);
+  cs_data = SCM_CHARSET_DATA (cs);
+  if (cs_data->len == 0)
+    return scm_from_int (0);
 
-  for (k = 0; k < SCM_CHARSET_SIZE; k++)
-    if (SCM_CHARSET_GET (cs, k))
+  for (k = 0; k < cs_data->len; k++)
+    for (n = cs_data->ranges[k].lo; n <= cs_data->ranges[k].hi; n++)
       {
-	SCM res = scm_call_1 (pred, SCM_MAKE_CHAR (k));
-	if (scm_is_true (res))
-	  count++;
+        SCM res = scm_call_1 (pred, SCM_MAKE_CHAR (n));
+        if (scm_is_true (res))
+          count++;
       }
   return SCM_I_MAKINUM (count);
 }
@@ -799,12 +1338,18 @@ SCM_DEFINE (scm_char_set_to_list, "char-set->list", 1, 0, 0,
 #define FUNC_NAME s_scm_char_set_to_list
 {
   int k;
+  scm_t_wchar n;
   SCM result = SCM_EOL;
+  scm_t_char_set *p;
 
   SCM_VALIDATE_SMOB (1, cs, charset);
-  for (k = SCM_CHARSET_SIZE; k > 0; k--)
-    if (SCM_CHARSET_GET (cs, k - 1))
-      result = scm_cons (SCM_MAKE_CHAR (k - 1), result);
+  p = SCM_CHARSET_DATA (cs);
+  if (p->len == 0)
+    return SCM_EOL;
+
+  for (k = p->len - 1; k >= 0; k--)
+    for (n = p->ranges[k].hi; n >= p->ranges[k].lo; n--)
+      result = scm_cons (SCM_MAKE_CHAR (n), result);
   return result;
 }
 #undef FUNC_NAME
@@ -820,17 +1365,35 @@ SCM_DEFINE (scm_char_set_to_string, "char-set->string", 1, 0, 0,
   int k;
   int count = 0;
   int idx = 0;
+  int wide = 0;
   SCM result;
-  char * p;
+  scm_t_wchar n;
+  scm_t_char_set *cs_data;
+  char *buf;
+  scm_t_wchar *wbuf;
 
   SCM_VALIDATE_SMOB (1, cs, charset);
-  for (k = 0; k < SCM_CHARSET_SIZE; k++)
-    if (SCM_CHARSET_GET (cs, k))
-      count++;
-  result = scm_i_make_string (count, &p);
-  for (k = 0; k < SCM_CHARSET_SIZE; k++)
-    if (SCM_CHARSET_GET (cs, k))
-      p[idx++] = k;
+  cs_data = SCM_CHARSET_DATA (cs);
+  if (cs_data->len == 0)
+    return scm_nullstr;
+
+  if (cs_data->ranges[cs_data->len - 1].hi > 255)
+    wide = 1;
+
+  count = scm_to_int (scm_char_set_size (cs));
+  if (wide)
+    result = scm_i_make_wide_string (count, &wbuf);
+  else
+    result = scm_i_make_string (count, &buf);
+
+  for (k = 0; k < cs_data->len; k++)
+    for (n = cs_data->ranges[k].lo; n <= cs_data->ranges[k].hi; n++)
+      {
+        if (wide)
+          wbuf[idx++] = n;
+        else
+          buf[idx++] = n;
+      }
   return result;
 }
 #undef FUNC_NAME
@@ -856,19 +1419,25 @@ SCM_DEFINE (scm_char_set_every, "char-set-every", 2, 0, 0,
 #define FUNC_NAME s_scm_char_set_every
 {
   int k;
+  scm_t_wchar n;
   SCM res = SCM_BOOL_T;
+  scm_t_char_set *cs_data;
 
   SCM_VALIDATE_PROC (1, pred);
   SCM_VALIDATE_SMOB (2, cs, charset);
 
-  for (k = 0; k < SCM_CHARSET_SIZE; k++)
-    if (SCM_CHARSET_GET (cs, k))
+  cs_data = SCM_CHARSET_DATA (cs);
+  if (cs_data->len == 0)
+    return SCM_BOOL_T;
+
+  for (k = 0; k < cs_data->len; k++)
+    for (n = cs_data->ranges[k].lo; n <= cs_data->ranges[k].hi; n++)
       {
-	res = scm_call_1 (pred, SCM_MAKE_CHAR (k));
-	if (scm_is_false (res))
-	  return res;
+        res = scm_call_1 (pred, SCM_MAKE_CHAR (n));
+        if (scm_is_false (res))
+          return res;
       }
-  return res;
+  return SCM_BOOL_T;
 }
 #undef FUNC_NAME
 
@@ -880,16 +1449,20 @@ SCM_DEFINE (scm_char_set_any, "char-set-any", 2, 0, 0,
 #define FUNC_NAME s_scm_char_set_any
 {
   int k;
+  scm_t_wchar n;
+  scm_t_char_set *cs_data;
 
   SCM_VALIDATE_PROC (1, pred);
   SCM_VALIDATE_SMOB (2, cs, charset);
 
-  for (k = 0; k < SCM_CHARSET_SIZE; k++)
-    if (SCM_CHARSET_GET (cs, k))
+  cs_data = (scm_t_char_set *) cs;
+
+  for (k = 0; k < cs_data->len; k++)
+    for (n = cs_data->ranges[k].lo; n <= cs_data->ranges[k].hi; n++)
       {
-	SCM res = scm_call_1 (pred, SCM_MAKE_CHAR (k));
-	if (scm_is_true (res))
-	  return res;
+        SCM res = scm_call_1 (pred, SCM_MAKE_CHAR (n));
+        if (scm_is_true (res))
+          return res;
       }
   return SCM_BOOL_F;
 }
@@ -897,27 +1470,24 @@ SCM_DEFINE (scm_char_set_any, "char-set-any", 2, 0, 0,
 
 
 SCM_DEFINE (scm_char_set_adjoin, "char-set-adjoin", 1, 0, 1,
-	    (SCM cs, SCM rest),
-	    "Add all character arguments to the first argument, which must\n"
-	    "be a character set.")
+            (SCM cs, SCM rest),
+            "Add all character arguments to the first argument, which must\n"
+            "be a character set.")
 #define FUNC_NAME s_scm_char_set_adjoin
 {
-  long * p;
-
   SCM_VALIDATE_SMOB (1, cs, charset);
   SCM_VALIDATE_REST_ARGUMENT (rest);
   cs = scm_char_set_copy (cs);
 
-  p = (long *) SCM_SMOB_DATA (cs);
   while (!scm_is_null (rest))
     {
       SCM chr = SCM_CAR (rest);
-      int c;
+      scm_t_wchar c;
 
       SCM_VALIDATE_CHAR_COPY (1, chr, c);
       rest = SCM_CDR (rest);
 
-      p[c / SCM_BITS_PER_LONG] |= 1L << (c % SCM_BITS_PER_LONG);
+      SCM_CHARSET_SET (cs, c);
     }
   return cs;
 }
@@ -925,27 +1495,24 @@ SCM_DEFINE (scm_char_set_adjoin, "char-set-adjoin", 1, 0, 1,
 
 
 SCM_DEFINE (scm_char_set_delete, "char-set-delete", 1, 0, 1,
-	    (SCM cs, SCM rest),
-	    "Delete all character arguments from the first argument, which\n"
-	    "must be a character set.")
+            (SCM cs, SCM rest),
+            "Delete all character arguments from the first argument, which\n"
+            "must be a character set.")
 #define FUNC_NAME s_scm_char_set_delete
 {
-  long * p;
-
   SCM_VALIDATE_SMOB (1, cs, charset);
   SCM_VALIDATE_REST_ARGUMENT (rest);
   cs = scm_char_set_copy (cs);
 
-  p = (long *) SCM_SMOB_DATA (cs);
   while (!scm_is_null (rest))
     {
       SCM chr = SCM_CAR (rest);
-      int c;
+      scm_t_wchar c;
 
       SCM_VALIDATE_CHAR_COPY (1, chr, c);
       rest = SCM_CDR (rest);
 
-      p[c / SCM_BITS_PER_LONG] &= ~(1L << (c % SCM_BITS_PER_LONG));
+      SCM_CHARSET_UNSET (cs, c);
     }
   return cs;
 }
@@ -953,26 +1520,23 @@ SCM_DEFINE (scm_char_set_delete, "char-set-delete", 1, 0, 1,
 
 
 SCM_DEFINE (scm_char_set_adjoin_x, "char-set-adjoin!", 1, 0, 1,
-	    (SCM cs, SCM rest),
-	    "Add all character arguments to the first argument, which must\n"
-	    "be a character set.")
+            (SCM cs, SCM rest),
+            "Add all character arguments to the first argument, which must\n"
+            "be a character set.")
 #define FUNC_NAME s_scm_char_set_adjoin_x
 {
-  long * p;
-
   SCM_VALIDATE_SMOB (1, cs, charset);
   SCM_VALIDATE_REST_ARGUMENT (rest);
 
-  p = (long *) SCM_SMOB_DATA (cs);
   while (!scm_is_null (rest))
     {
       SCM chr = SCM_CAR (rest);
-      int c;
+      scm_t_wchar c;
 
       SCM_VALIDATE_CHAR_COPY (1, chr, c);
       rest = SCM_CDR (rest);
 
-      p[c / SCM_BITS_PER_LONG] |= 1L << (c % SCM_BITS_PER_LONG);
+      SCM_CHARSET_SET (cs, c);
     }
   return cs;
 }
@@ -980,26 +1544,23 @@ SCM_DEFINE (scm_char_set_adjoin_x, "char-set-adjoin!", 1, 0, 1,
 
 
 SCM_DEFINE (scm_char_set_delete_x, "char-set-delete!", 1, 0, 1,
-	    (SCM cs, SCM rest),
-	    "Delete all character arguments from the first argument, which\n"
-	    "must be a character set.")
+            (SCM cs, SCM rest),
+            "Delete all character arguments from the first argument, which\n"
+            "must be a character set.")
 #define FUNC_NAME s_scm_char_set_delete_x
 {
-  long * p;
-
   SCM_VALIDATE_SMOB (1, cs, charset);
   SCM_VALIDATE_REST_ARGUMENT (rest);
 
-  p = (long *) SCM_SMOB_DATA (cs);
   while (!scm_is_null (rest))
     {
       SCM chr = SCM_CAR (rest);
-      int c;
+      scm_t_wchar c;
 
       SCM_VALIDATE_CHAR_COPY (1, chr, c);
       rest = SCM_CDR (rest);
 
-      p[c / SCM_BITS_PER_LONG] &= ~(1L << (c % SCM_BITS_PER_LONG));
+      SCM_CHARSET_UNSET (cs, c);
     }
   return cs;
 }
@@ -1007,21 +1568,19 @@ SCM_DEFINE (scm_char_set_delete_x, "char-set-delete!", 1, 0, 1,
 
 
 SCM_DEFINE (scm_char_set_complement, "char-set-complement", 1, 0, 0,
-	    (SCM cs),
-	    "Return the complement of the character set @var{cs}.")
+            (SCM cs), "Return the complement of the character set @var{cs}.")
 #define FUNC_NAME s_scm_char_set_complement
 {
-  int k;
   SCM res;
-  long * p, * q;
+  scm_t_char_set *p, *q;
 
   SCM_VALIDATE_SMOB (1, cs, charset);
 
   res = make_char_set (FUNC_NAME);
-  p = (long *) SCM_SMOB_DATA (res);
-  q = (long *) SCM_SMOB_DATA (cs);
-  for (k = 0; k < LONGS_PER_CHARSET; k++)
-    p[k] = ~q[k];
+  p = SCM_CHARSET_DATA (res);
+  q = SCM_CHARSET_DATA (cs);
+
+  charsets_complement (p, q);
   return res;
 }
 #undef FUNC_NAME
@@ -1034,22 +1593,21 @@ SCM_DEFINE (scm_char_set_union, "char-set-union", 0, 0, 1,
 {
   int c = 1;
   SCM res;
-  long * p;
+  scm_t_char_set *p;
 
   SCM_VALIDATE_REST_ARGUMENT (rest);
 
   res = make_char_set (FUNC_NAME);
-  p = (long *) SCM_SMOB_DATA (res);
+  p = SCM_CHARSET_DATA (res);
   while (!scm_is_null (rest))
     {
-      int k;
       SCM cs = SCM_CAR (rest);
       SCM_VALIDATE_SMOB (c, cs, charset);
       c++;
       rest = SCM_CDR (rest);
 
-      for (k = 0; k < LONGS_PER_CHARSET; k++)
-	p[k] |= ((long *) SCM_SMOB_DATA (cs))[k];
+
+      charsets_union (p, (scm_t_char_set *) SCM_SMOB_DATA (cs));
     }
   return res;
 }
@@ -1069,26 +1627,24 @@ SCM_DEFINE (scm_char_set_intersection, "char-set-intersection", 0, 0, 1,
     res = make_char_set (FUNC_NAME);
   else
     {
-      long *p;
+      scm_t_char_set *p;
       int argnum = 2;
 
       res = scm_char_set_copy (SCM_CAR (rest));
-      p = (long *) SCM_SMOB_DATA (res);
+      p = SCM_CHARSET_DATA (res);
       rest = SCM_CDR (rest);
 
       while (scm_is_pair (rest))
-	{
-	  int k;
-	  SCM cs = SCM_CAR (rest);
-	  long *cs_data;
-
-	  SCM_VALIDATE_SMOB (argnum, cs, charset);
-	  argnum++;
-	  cs_data = (long *) SCM_SMOB_DATA (cs);
-	  rest = SCM_CDR (rest);
-	  for (k = 0; k < LONGS_PER_CHARSET; k++)
-	    p[k] &= cs_data[k];
-	}
+        {
+          SCM cs = SCM_CAR (rest);
+          scm_t_char_set *cs_data;
+
+          SCM_VALIDATE_SMOB (argnum, cs, charset);
+          argnum++;
+          cs_data = SCM_CHARSET_DATA (cs);
+          rest = SCM_CDR (rest);
+          charsets_intersection (p, cs_data);
+        }
     }
 
   return res;
@@ -1102,24 +1658,25 @@ SCM_DEFINE (scm_char_set_difference, "char-set-difference", 1, 0, 1,
 #define FUNC_NAME s_scm_char_set_difference
 {
   int c = 2;
-  SCM res;
-  long * p;
+  SCM res, compl;
+  scm_t_char_set *p, *q;
 
   SCM_VALIDATE_SMOB (1, cs1, charset);
   SCM_VALIDATE_REST_ARGUMENT (rest);
 
   res = scm_char_set_copy (cs1);
-  p = (long *) SCM_SMOB_DATA (res);
+  p = SCM_CHARSET_DATA (res);
+  compl = make_char_set (FUNC_NAME);
+  q = SCM_CHARSET_DATA (compl);
   while (!scm_is_null (rest))
     {
-      int k;
       SCM cs = SCM_CAR (rest);
       SCM_VALIDATE_SMOB (c, cs, charset);
       c++;
       rest = SCM_CDR (rest);
 
-      for (k = 0; k < LONGS_PER_CHARSET; k++)
-	p[k] &= ~((long *) SCM_SMOB_DATA (cs))[k];
+      charsets_complement (q, SCM_CHARSET_DATA (cs));
+      charsets_intersection (p, q);
     }
   return res;
 }
@@ -1140,26 +1697,24 @@ SCM_DEFINE (scm_char_set_xor, "char-set-xor", 0, 0, 1,
   else
     {
       int argnum = 2;
-      long * p;
+      scm_t_char_set *p;
 
       res = scm_char_set_copy (SCM_CAR (rest));
-      p = (long *) SCM_SMOB_DATA (res);
+      p = SCM_CHARSET_DATA (res);
       rest = SCM_CDR (rest);
 
       while (scm_is_pair (rest))
-	{
-	  SCM cs = SCM_CAR (rest);
-	  long *cs_data;
-	  int k;
-
-	  SCM_VALIDATE_SMOB (argnum, cs, charset);
-	  argnum++;
-	  cs_data = (long *) SCM_SMOB_DATA (cs);
-	  rest = SCM_CDR (rest);
-
-	  for (k = 0; k < LONGS_PER_CHARSET; k++)
-	    p[k] ^= cs_data[k];
-	}
+        {
+          SCM cs = SCM_CAR (rest);
+          scm_t_char_set *cs_data;
+
+          SCM_VALIDATE_SMOB (argnum, cs, charset);
+          argnum++;
+          cs_data = SCM_CHARSET_DATA (cs);
+          rest = SCM_CDR (rest);
+
+          charsets_xor (p, cs_data);
+        }
     }
   return res;
 }
@@ -1174,30 +1729,26 @@ SCM_DEFINE (scm_char_set_diff_plus_intersection, "char-set-diff+intersection", 1
 {
   int c = 2;
   SCM res1, res2;
-  long * p, * q;
+  scm_t_char_set *p, *q;
 
   SCM_VALIDATE_SMOB (1, cs1, charset);
   SCM_VALIDATE_REST_ARGUMENT (rest);
 
   res1 = scm_char_set_copy (cs1);
   res2 = make_char_set (FUNC_NAME);
-  p = (long *) SCM_SMOB_DATA (res1);
-  q = (long *) SCM_SMOB_DATA (res2);
+  p = SCM_CHARSET_DATA (res1);
+  q = SCM_CHARSET_DATA (res2);
   while (!scm_is_null (rest))
     {
-      int k;
       SCM cs = SCM_CAR (rest);
-      long *r;
+      scm_t_char_set *r;
 
       SCM_VALIDATE_SMOB (c, cs, charset);
       c++;
-      r = (long *) SCM_SMOB_DATA (cs);
+      r = SCM_CHARSET_DATA (cs);
 
-      for (k = 0; k < LONGS_PER_CHARSET; k++)
-	{
-	  q[k] |= p[k] & r[k];
-	  p[k] &= ~r[k];
-	}
+      charsets_union (q, r);
+      charsets_intersection (p, r);
       rest = SCM_CDR (rest);
     }
   return scm_values (scm_list_2 (res1, res2));
@@ -1206,101 +1757,53 @@ SCM_DEFINE (scm_char_set_diff_plus_intersection, "char-set-diff+intersection", 1
 
 
 SCM_DEFINE (scm_char_set_complement_x, "char-set-complement!", 1, 0, 0,
-	    (SCM cs),
-	    "Return the complement of the character set @var{cs}.")
+            (SCM cs), "Return the complement of the character set @var{cs}.")
 #define FUNC_NAME s_scm_char_set_complement_x
 {
-  int k;
-  long * p;
-
   SCM_VALIDATE_SMOB (1, cs, charset);
-  p = (long *) SCM_SMOB_DATA (cs);
-  for (k = 0; k < LONGS_PER_CHARSET; k++)
-    p[k] = ~p[k];
+  cs = scm_char_set_complement (cs);
   return cs;
 }
 #undef FUNC_NAME
 
 
 SCM_DEFINE (scm_char_set_union_x, "char-set-union!", 1, 0, 1,
-	    (SCM cs1, SCM rest),
-	    "Return the union of all argument character sets.")
+            (SCM cs1, SCM rest),
+            "Return the union of all argument character sets.")
 #define FUNC_NAME s_scm_char_set_union_x
 {
-  int c = 2;
-  long * p;
-
   SCM_VALIDATE_SMOB (1, cs1, charset);
   SCM_VALIDATE_REST_ARGUMENT (rest);
 
-  p = (long *) SCM_SMOB_DATA (cs1);
-  while (!scm_is_null (rest))
-    {
-      int k;
-      SCM cs = SCM_CAR (rest);
-      SCM_VALIDATE_SMOB (c, cs, charset);
-      c++;
-      rest = SCM_CDR (rest);
-
-      for (k = 0; k < LONGS_PER_CHARSET; k++)
-	p[k] |= ((long *) SCM_SMOB_DATA (cs))[k];
-    }
+  cs1 = scm_char_set_union (scm_cons (cs1, rest));
   return cs1;
 }
 #undef FUNC_NAME
 
 
 SCM_DEFINE (scm_char_set_intersection_x, "char-set-intersection!", 1, 0, 1,
-	    (SCM cs1, SCM rest),
-	    "Return the intersection of all argument character sets.")
+            (SCM cs1, SCM rest),
+            "Return the intersection of all argument character sets.")
 #define FUNC_NAME s_scm_char_set_intersection_x
 {
-  int c = 2;
-  long * p;
-
   SCM_VALIDATE_SMOB (1, cs1, charset);
   SCM_VALIDATE_REST_ARGUMENT (rest);
 
-  p = (long *) SCM_SMOB_DATA (cs1);
-  while (!scm_is_null (rest))
-    {
-      int k;
-      SCM cs = SCM_CAR (rest);
-      SCM_VALIDATE_SMOB (c, cs, charset);
-      c++;
-      rest = SCM_CDR (rest);
-
-      for (k = 0; k < LONGS_PER_CHARSET; k++)
-	p[k] &= ((long *) SCM_SMOB_DATA (cs))[k];
-    }
+  cs1 = scm_char_set_intersection (scm_cons (cs1, rest));
   return cs1;
 }
 #undef FUNC_NAME
 
 
 SCM_DEFINE (scm_char_set_difference_x, "char-set-difference!", 1, 0, 1,
-	    (SCM cs1, SCM rest),
-	    "Return the difference of all argument character sets.")
+            (SCM cs1, SCM rest),
+            "Return the difference of all argument character sets.")
 #define FUNC_NAME s_scm_char_set_difference_x
 {
-  int c = 2;
-  long * p;
-
   SCM_VALIDATE_SMOB (1, cs1, charset);
   SCM_VALIDATE_REST_ARGUMENT (rest);
 
-  p = (long *) SCM_SMOB_DATA (cs1);
-  while (!scm_is_null (rest))
-    {
-      int k;
-      SCM cs = SCM_CAR (rest);
-      SCM_VALIDATE_SMOB (c, cs, charset);
-      c++;
-      rest = SCM_CDR (rest);
-
-      for (k = 0; k < LONGS_PER_CHARSET; k++)
-	p[k] &= ~((long *) SCM_SMOB_DATA (cs))[k];
-    }
+  cs1 = scm_char_set_difference (cs1, rest);
   return cs1;
 }
 #undef FUNC_NAME
@@ -1315,86 +1818,32 @@ SCM_DEFINE (scm_char_set_xor_x, "char-set-xor!", 1, 0, 1,
      (define a (char-set #\a))
      (char-set-xor a a a) -> char set #\a
      (char-set-xor! a a a) -> char set #\a
-  */
+   */
   return scm_char_set_xor (scm_cons (cs1, rest));
-
-#if 0
-  /* this would give (char-set-xor! a a a) -> empty char set.  */
-  int c = 2;
-  long * p;
-
-  SCM_VALIDATE_SMOB (1, cs1, charset);
-  SCM_VALIDATE_REST_ARGUMENT (rest);
-
-  p = (long *) SCM_SMOB_DATA (cs1);
-  while (!scm_is_null (rest))
-    {
-      int k;
-      SCM cs = SCM_CAR (rest);
-      SCM_VALIDATE_SMOB (c, cs, charset);
-      c++;
-      rest = SCM_CDR (rest);
-
-      for (k = 0; k < LONGS_PER_CHARSET; k++)
-	p[k] ^= ((long *) SCM_SMOB_DATA (cs))[k];
-    }
-  return cs1;
-#endif
 }
 #undef FUNC_NAME
 
 
-SCM_DEFINE (scm_char_set_diff_plus_intersection_x, "char-set-diff+intersection!", 2, 0, 1,
-	    (SCM cs1, SCM cs2, SCM rest),
-	    "Return the difference and the intersection of all argument\n"
-	    "character sets.")
+SCM_DEFINE (scm_char_set_diff_plus_intersection_x,
+            "char-set-diff+intersection!", 2, 0, 1, (SCM cs1, SCM cs2,
+                                                     SCM rest),
+            "Return the difference and the intersection of all argument\n"
+            "character sets.")
 #define FUNC_NAME s_scm_char_set_diff_plus_intersection_x
 {
-  int c = 3;
-  long * p, * q;
-  int k;
+  SCM diff, intersect;
 
-  SCM_VALIDATE_SMOB (1, cs1, charset);
-  SCM_VALIDATE_SMOB (2, cs2, charset);
-  SCM_VALIDATE_REST_ARGUMENT (rest);
-
-  p = (long *) SCM_SMOB_DATA (cs1);
-  q = (long *) SCM_SMOB_DATA (cs2);
-  if (p == q)
-    {
-      /* (char-set-diff+intersection! a a ...): can't share storage,
-	 but we know the answer without checking for further
-	 arguments.  */
-      return scm_values (scm_list_2 (make_char_set (FUNC_NAME), cs1));
-    }
-  for (k = 0; k < LONGS_PER_CHARSET; k++)
-    {
-      long t = p[k];
-
-      p[k] &= ~q[k];
-      q[k] = t & q[k];
-    }
-  while (!scm_is_null (rest))
-    {
-      SCM cs = SCM_CAR (rest);
-      long *r;
-
-      SCM_VALIDATE_SMOB (c, cs, charset);
-      c++;
-      r = (long *) SCM_SMOB_DATA (cs);
-
-      for (k = 0; k < LONGS_PER_CHARSET; k++)
-	{
-	  q[k] |= p[k] & r[k];
-	  p[k] &= ~r[k];
-	}
-      rest = SCM_CDR (rest);
-    }
+  diff = scm_char_set_difference (cs1, scm_cons (cs2, rest));
+  intersect =
+    scm_char_set_intersection (scm_cons (cs1, scm_cons (cs2, rest)));
+  cs1 = diff;
+  cs2 = intersect;
   return scm_values (scm_list_2 (cs1, cs2));
 }
 #undef FUNC_NAME
 
 
+
 /* Standard character sets.  */
 
 SCM scm_char_set_lower_case;
@@ -1418,146 +1867,77 @@ SCM scm_char_set_full;
 
 /* Create an empty character set and return it after binding it to NAME.  */
 static inline SCM
-define_charset (const char *name)
+define_charset (const char *name, const scm_t_char_set *p)
 {
-  SCM cs = make_char_set (NULL);
+  SCM cs;
+
+  SCM_NEWSMOB (cs, scm_tc16_charset, p);
   scm_c_define (name, cs);
   return scm_permanent_object (cs);
 }
 
-/* Membership predicates for the various char sets.
-
-   XXX: The `punctuation' and `symbol' char sets have no direct equivalent in
-   <ctype.h>.  Thus, the predicates below yield correct results for ASCII,
-   but they do not provide the result described by the SRFI for Latin-1.  The
-   correct Latin-1 result could only be obtained by hard-coding the
-   characters listed by the SRFI, but the problem would remain for other
-   8-bit charsets.
-
-   Similarly, character 0xA0 in Latin-1 (unbreakable space, `#\0240') should
-   be part of `char-set:blank'.  However, glibc's current (2006/09) Latin-1
-   locales (which use the ISO 14652 "i18n" FDCC-set) do not consider it
-   `blank' so it ends up in `char-set:punctuation'.  */
-#ifdef HAVE_ISBLANK
-# define CSET_BLANK_PRED(c)  (isblank (c))
-#else
-# define CSET_BLANK_PRED(c)			\
-   (((c) == ' ') || ((c) == '\t'))
-#endif
-
-#define CSET_SYMBOL_PRED(c)					\
-  (((c) != '\0') && (strchr ("$+<=>^`|~", (c)) != NULL))
-#define CSET_PUNCT_PRED(c)					\
-  ((ispunct (c)) && (!CSET_SYMBOL_PRED (c)))
-
-#define CSET_LOWER_PRED(c)       (islower (c))
-#define CSET_UPPER_PRED(c)       (isupper (c))
-#define CSET_LETTER_PRED(c)      (isalpha (c))
-#define CSET_DIGIT_PRED(c)       (isdigit (c))
-#define CSET_WHITESPACE_PRED(c)  (isspace (c))
-#define CSET_CONTROL_PRED(c)     (iscntrl (c))
-#define CSET_HEX_DIGIT_PRED(c)   (isxdigit (c))
-#define CSET_ASCII_PRED(c)       (isascii (c))
-
-/* Some char sets are explicitly defined by the SRFI as a union of other char
-   sets so we try to follow this closely.  */
-
-#define CSET_LETTER_AND_DIGIT_PRED(c)		\
-  (CSET_LETTER_PRED (c) || CSET_DIGIT_PRED (c))
-
-#define CSET_GRAPHIC_PRED(c)				\
-  (CSET_LETTER_PRED (c) || CSET_DIGIT_PRED (c)		\
-   || CSET_PUNCT_PRED (c) || CSET_SYMBOL_PRED (c))
-
-#define CSET_PRINTING_PRED(c)				\
-  (CSET_GRAPHIC_PRED (c) || CSET_WHITESPACE_PRED (c))
-
-/* False and true predicates.  */
-#define CSET_TRUE_PRED(c)    (1)
-#define CSET_FALSE_PRED(c)   (0)
-
-
-/* Compute the contents of all the standard character sets.  Computation may
-   need to be re-done at `setlocale'-time because some char sets (e.g.,
-   `char-set:letter') need to reflect the character set supported by Guile.
-
-   For instance, at startup time, the "C" locale is used, thus Guile supports
-   only ASCII; therefore, `char-set:letter' only contains English letters.
-   The user can change this by invoking `setlocale' and specifying a locale
-   with an 8-bit charset, thereby augmenting some of the SRFI-14 standard
-   character sets.
-
-   This works because some of the predicates used below to construct
-   character sets (e.g., `isalpha(3)') are locale-dependent (so
-   charset-dependent, though generally not language-dependent).  For details,
-   please see the `guile-devel' mailing list archive of September 2006.  */
-void
-scm_srfi_14_compute_char_sets (void)
+#ifdef SCM_CHARSET_DEBUG
+SCM_DEFINE (scm_debug_char_set, "debug-char-set", 1, 0, 0,
+            (SCM charset),
+            "Print out the internal C structure of @var{charset}.\n")
+#define FUNC_NAME s_scm_debug_char_set
 {
-#define UPDATE_CSET(c, cset, pred)		\
-  do						\
-    {						\
-      if (pred (c))				\
-	SCM_CHARSET_SET ((cset), (c));		\
-      else					\
-	SCM_CHARSET_UNSET ((cset), (c));	\
-    }						\
-  while (0)
-
-  register int ch;
-
-  for (ch = 0; ch < 256; ch++)
+  int i;
+  scm_t_char_set *cs = SCM_CHARSET_DATA (charset);
+  fprintf (stderr, "cs %p\n", cs);
+  fprintf (stderr, "len %d\n", cs->len);
+  fprintf (stderr, "arr %p\n", cs->ranges);
+  for (i = 0; i < cs->len; i++)
     {
-      UPDATE_CSET (ch, scm_char_set_upper_case, CSET_UPPER_PRED);
-      UPDATE_CSET (ch, scm_char_set_lower_case, CSET_LOWER_PRED);
-      UPDATE_CSET (ch, scm_char_set_title_case, CSET_FALSE_PRED);
-      UPDATE_CSET (ch, scm_char_set_letter, CSET_LETTER_PRED);
-      UPDATE_CSET (ch, scm_char_set_digit, CSET_DIGIT_PRED);
-      UPDATE_CSET (ch, scm_char_set_letter_and_digit,
-		   CSET_LETTER_AND_DIGIT_PRED);
-      UPDATE_CSET (ch, scm_char_set_graphic, CSET_GRAPHIC_PRED);
-      UPDATE_CSET (ch, scm_char_set_printing, CSET_PRINTING_PRED);
-      UPDATE_CSET (ch, scm_char_set_whitespace, CSET_WHITESPACE_PRED);
-      UPDATE_CSET (ch, scm_char_set_iso_control, CSET_CONTROL_PRED);
-      UPDATE_CSET (ch, scm_char_set_punctuation, CSET_PUNCT_PRED);
-      UPDATE_CSET (ch, scm_char_set_symbol, CSET_SYMBOL_PRED);
-      UPDATE_CSET (ch, scm_char_set_hex_digit, CSET_HEX_DIGIT_PRED);
-      UPDATE_CSET (ch, scm_char_set_blank, CSET_BLANK_PRED);
-      UPDATE_CSET (ch, scm_char_set_ascii, CSET_ASCII_PRED);
-      UPDATE_CSET (ch, scm_char_set_empty, CSET_FALSE_PRED);
-      UPDATE_CSET (ch, scm_char_set_full, CSET_TRUE_PRED);
+      if (cs->ranges[i].lo == cs->ranges[i].hi)
+        fprintf (stderr, "%04x\n", cs->ranges[i].lo);
+      else
+        fprintf (stderr, "%04x..%04x\t[%d]\n",
+                 cs->ranges[i].lo,
+                 cs->ranges[i].hi, cs->ranges[i].hi - cs->ranges[i].lo + 1);
     }
-
-#undef UPDATE_CSET
+  printf ("\n");
+  return SCM_UNSPECIFIED;
 }
-
+#undef FUNC_NAME
+#endif /* SCM_CHARSET_DEBUG */
 
+
+
 void
 scm_init_srfi_14 (void)
 {
-  scm_tc16_charset = scm_make_smob_type ("character-set",
-					 BYTES_PER_CHARSET);
+  scm_tc16_charset = scm_make_smob_type ("character-set", 0);
   scm_set_smob_print (scm_tc16_charset, charset_print);
 
-  scm_char_set_upper_case = define_charset ("char-set:upper-case");
-  scm_char_set_lower_case = define_charset ("char-set:lower-case");
-  scm_char_set_title_case = define_charset ("char-set:title-case");
-  scm_char_set_letter = define_charset ("char-set:letter");
-  scm_char_set_digit = define_charset ("char-set:digit");
-  scm_char_set_letter_and_digit = define_charset ("char-set:letter+digit");
-  scm_char_set_graphic = define_charset ("char-set:graphic");
-  scm_char_set_printing = define_charset ("char-set:printing");
-  scm_char_set_whitespace = define_charset ("char-set:whitespace");
-  scm_char_set_iso_control = define_charset ("char-set:iso-control");
-  scm_char_set_punctuation = define_charset ("char-set:punctuation");
-  scm_char_set_symbol = define_charset ("char-set:symbol");
-  scm_char_set_hex_digit = define_charset ("char-set:hex-digit");
-  scm_char_set_blank = define_charset ("char-set:blank");
-  scm_char_set_ascii = define_charset ("char-set:ascii");
-  scm_char_set_empty = define_charset ("char-set:empty");
-  scm_char_set_full = define_charset ("char-set:full");
-
-  scm_srfi_14_compute_char_sets ();
+  scm_tc16_charset_cursor = scm_make_smob_type ("char-set-cursor", 0);
+  scm_set_smob_print (scm_tc16_charset_cursor, charset_cursor_print);
+
+  scm_char_set_upper_case =
+    define_charset ("char-set:upper-case", &cs_upper_case);
+  scm_char_set_lower_case =
+    define_charset ("char-set:lower-case", &cs_lower_case);
+  scm_char_set_title_case =
+    define_charset ("char-set:title-case", &cs_title_case);
+  scm_char_set_letter = define_charset ("char-set:letter", &cs_letter);
+  scm_char_set_digit = define_charset ("char-set:digit", &cs_digit);
+  scm_char_set_letter_and_digit =
+    define_charset ("char-set:letter+digit", &cs_letter_plus_digit);
+  scm_char_set_graphic = define_charset ("char-set:graphic", &cs_graphic);
+  scm_char_set_printing = define_charset ("char-set:printing", &cs_printing);
+  scm_char_set_whitespace =
+    define_charset ("char-set:whitespace", &cs_whitespace);
+  scm_char_set_iso_control =
+    define_charset ("char-set:iso-control", &cs_iso_control);
+  scm_char_set_punctuation =
+    define_charset ("char-set:punctuation", &cs_punctuation);
+  scm_char_set_symbol = define_charset ("char-set:symbol", &cs_symbol);
+  scm_char_set_hex_digit =
+    define_charset ("char-set:hex-digit", &cs_hex_digit);
+  scm_char_set_blank = define_charset ("char-set:blank", &cs_blank);
+  scm_char_set_ascii = define_charset ("char-set:ascii", &cs_ascii);
+  scm_char_set_empty = define_charset ("char-set:empty", &cs_empty);
+  scm_char_set_full = define_charset ("char-set:full", &cs_full);
 
 #include "libguile/srfi-14.x"
 }
diff --git a/libguile/srfi-14.h b/libguile/srfi-14.h
index ea8027aac..1b9c29518 100644
--- a/libguile/srfi-14.h
+++ b/libguile/srfi-14.h
@@ -6,39 +6,52 @@
  * 	Copyright (C) 2001, 2004, 2006, 2008 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
 #include "libguile/__scm.h"
 
-#define SCM_CHARSET_SIZE 256
+typedef struct
+{
+  scm_t_wchar lo;
+  scm_t_wchar hi;
+} scm_t_char_range;
 
-/* We expect 8-bit bytes here.  Should be no problem in the year
-   2001.  */
-#ifndef SCM_BITS_PER_LONG
-# define SCM_BITS_PER_LONG (sizeof (long) * 8)
-#endif
+typedef struct 
+{
+  size_t len;
+  scm_t_char_range *ranges;
+} scm_t_char_set;
 
-#define SCM_CHARSET_GET(cs, idx) (((long *) SCM_SMOB_DATA (cs))\
-			           [((unsigned char) (idx)) / SCM_BITS_PER_LONG] &\
-			 	   (1L << (((unsigned char) (idx)) % SCM_BITS_PER_LONG)))
+typedef struct
+{
+  size_t range;
+  scm_t_wchar n;
+} scm_t_char_set_cursor;
+
+#define SCM_CHARSET_GET(cs,idx)                                 \
+  scm_i_charset_get((scm_t_char_set *)SCM_SMOB_DATA(cs),idx)
 
 #define SCM_CHARSETP(x) (!SCM_IMP (x) && (SCM_TYP16 (x) == scm_tc16_charset))
 
 /* Smob type code for character sets.  */
 SCM_API int scm_tc16_charset;
+SCM_INTERNAL int scm_i_charset_get (scm_t_char_set *cs, scm_t_wchar n);
+SCM_INTERNAL void scm_i_charset_set (scm_t_char_set *cs, scm_t_wchar n);
+SCM_INTERNAL void scm_i_charset_unset (scm_t_char_set *cs, scm_t_wchar n);
 
 SCM_API SCM scm_char_set_p (SCM obj);
 SCM_API SCM scm_char_set_eq (SCM char_sets);
@@ -87,6 +100,9 @@ SCM_API SCM scm_char_set_intersection_x (SCM cs1, SCM rest);
 SCM_API SCM scm_char_set_difference_x (SCM cs1, SCM rest);
 SCM_API SCM scm_char_set_xor_x (SCM cs1, SCM rest);
 SCM_API SCM scm_char_set_diff_plus_intersection_x (SCM cs1, SCM cs2, SCM rest);
+#if SCM_CHARSET_DEBUG
+SCM_API SCM scm_debug_char_set (SCM cs);
+#endif /* SCM_CHARSET_DEBUG */
 
 SCM_API SCM scm_char_set_lower_case;
 SCM_API SCM scm_char_set_upper_case;
@@ -106,7 +122,6 @@ SCM_API SCM scm_char_set_ascii;
 SCM_API SCM scm_char_set_empty;
 SCM_API SCM scm_char_set_full;
 
-SCM_INTERNAL void scm_srfi_14_compute_char_sets (void);
 SCM_INTERNAL void scm_init_srfi_14 (void);
 
 #endif /* SCM_SRFI_14_H */
diff --git a/libguile/srfi-14.i.c b/libguile/srfi-14.i.c
new file mode 100644
index 000000000..5ef21f333
--- /dev/null
+++ b/libguile/srfi-14.i.c
@@ -0,0 +1,7150 @@
+/* srfi-14.i.c -- standard SRFI-14 character set data */
+
+/* This file is #include'd by srfi-14.c.  */
+
+/* This file was generated from http://unicode.org/Public/UNIDATA/UnicodeData.txt
+   with the unidata_to_charset.pl script.  */
+
+scm_t_char_range cs_lower_case_ranges[] = {
+  {0x0061, 0x007a}
+  ,
+  {0x00b5, 0x00b5}
+  ,
+  {0x00df, 0x00f6}
+  ,
+  {0x00f8, 0x00ff}
+  ,
+  {0x0101, 0x0101}
+  ,
+  {0x0103, 0x0103}
+  ,
+  {0x0105, 0x0105}
+  ,
+  {0x0107, 0x0107}
+  ,
+  {0x0109, 0x0109}
+  ,
+  {0x010b, 0x010b}
+  ,
+  {0x010d, 0x010d}
+  ,
+  {0x010f, 0x010f}
+  ,
+  {0x0111, 0x0111}
+  ,
+  {0x0113, 0x0113}
+  ,
+  {0x0115, 0x0115}
+  ,
+  {0x0117, 0x0117}
+  ,
+  {0x0119, 0x0119}
+  ,
+  {0x011b, 0x011b}
+  ,
+  {0x011d, 0x011d}
+  ,
+  {0x011f, 0x011f}
+  ,
+  {0x0121, 0x0121}
+  ,
+  {0x0123, 0x0123}
+  ,
+  {0x0125, 0x0125}
+  ,
+  {0x0127, 0x0127}
+  ,
+  {0x0129, 0x0129}
+  ,
+  {0x012b, 0x012b}
+  ,
+  {0x012d, 0x012d}
+  ,
+  {0x012f, 0x012f}
+  ,
+  {0x0131, 0x0131}
+  ,
+  {0x0133, 0x0133}
+  ,
+  {0x0135, 0x0135}
+  ,
+  {0x0137, 0x0138}
+  ,
+  {0x013a, 0x013a}
+  ,
+  {0x013c, 0x013c}
+  ,
+  {0x013e, 0x013e}
+  ,
+  {0x0140, 0x0140}
+  ,
+  {0x0142, 0x0142}
+  ,
+  {0x0144, 0x0144}
+  ,
+  {0x0146, 0x0146}
+  ,
+  {0x0148, 0x0149}
+  ,
+  {0x014b, 0x014b}
+  ,
+  {0x014d, 0x014d}
+  ,
+  {0x014f, 0x014f}
+  ,
+  {0x0151, 0x0151}
+  ,
+  {0x0153, 0x0153}
+  ,
+  {0x0155, 0x0155}
+  ,
+  {0x0157, 0x0157}
+  ,
+  {0x0159, 0x0159}
+  ,
+  {0x015b, 0x015b}
+  ,
+  {0x015d, 0x015d}
+  ,
+  {0x015f, 0x015f}
+  ,
+  {0x0161, 0x0161}
+  ,
+  {0x0163, 0x0163}
+  ,
+  {0x0165, 0x0165}
+  ,
+  {0x0167, 0x0167}
+  ,
+  {0x0169, 0x0169}
+  ,
+  {0x016b, 0x016b}
+  ,
+  {0x016d, 0x016d}
+  ,
+  {0x016f, 0x016f}
+  ,
+  {0x0171, 0x0171}
+  ,
+  {0x0173, 0x0173}
+  ,
+  {0x0175, 0x0175}
+  ,
+  {0x0177, 0x0177}
+  ,
+  {0x017a, 0x017a}
+  ,
+  {0x017c, 0x017c}
+  ,
+  {0x017e, 0x0180}
+  ,
+  {0x0183, 0x0183}
+  ,
+  {0x0185, 0x0185}
+  ,
+  {0x0188, 0x0188}
+  ,
+  {0x018c, 0x018d}
+  ,
+  {0x0192, 0x0192}
+  ,
+  {0x0195, 0x0195}
+  ,
+  {0x0199, 0x019b}
+  ,
+  {0x019e, 0x019e}
+  ,
+  {0x01a1, 0x01a1}
+  ,
+  {0x01a3, 0x01a3}
+  ,
+  {0x01a5, 0x01a5}
+  ,
+  {0x01a8, 0x01a8}
+  ,
+  {0x01ab, 0x01ab}
+  ,
+  {0x01ad, 0x01ad}
+  ,
+  {0x01b0, 0x01b0}
+  ,
+  {0x01b4, 0x01b4}
+  ,
+  {0x01b6, 0x01b6}
+  ,
+  {0x01b9, 0x01ba}
+  ,
+  {0x01bd, 0x01bd}
+  ,
+  {0x01bf, 0x01bf}
+  ,
+  {0x01c6, 0x01c6}
+  ,
+  {0x01c9, 0x01c9}
+  ,
+  {0x01cc, 0x01cc}
+  ,
+  {0x01ce, 0x01ce}
+  ,
+  {0x01d0, 0x01d0}
+  ,
+  {0x01d2, 0x01d2}
+  ,
+  {0x01d4, 0x01d4}
+  ,
+  {0x01d6, 0x01d6}
+  ,
+  {0x01d8, 0x01d8}
+  ,
+  {0x01da, 0x01da}
+  ,
+  {0x01dc, 0x01dd}
+  ,
+  {0x01df, 0x01df}
+  ,
+  {0x01e1, 0x01e1}
+  ,
+  {0x01e3, 0x01e3}
+  ,
+  {0x01e5, 0x01e5}
+  ,
+  {0x01e7, 0x01e7}
+  ,
+  {0x01e9, 0x01e9}
+  ,
+  {0x01eb, 0x01eb}
+  ,
+  {0x01ed, 0x01ed}
+  ,
+  {0x01ef, 0x01f0}
+  ,
+  {0x01f3, 0x01f3}
+  ,
+  {0x01f5, 0x01f5}
+  ,
+  {0x01f9, 0x01f9}
+  ,
+  {0x01fb, 0x01fb}
+  ,
+  {0x01fd, 0x01fd}
+  ,
+  {0x01ff, 0x01ff}
+  ,
+  {0x0201, 0x0201}
+  ,
+  {0x0203, 0x0203}
+  ,
+  {0x0205, 0x0205}
+  ,
+  {0x0207, 0x0207}
+  ,
+  {0x0209, 0x0209}
+  ,
+  {0x020b, 0x020b}
+  ,
+  {0x020d, 0x020d}
+  ,
+  {0x020f, 0x020f}
+  ,
+  {0x0211, 0x0211}
+  ,
+  {0x0213, 0x0213}
+  ,
+  {0x0215, 0x0215}
+  ,
+  {0x0217, 0x0217}
+  ,
+  {0x0219, 0x0219}
+  ,
+  {0x021b, 0x021b}
+  ,
+  {0x021d, 0x021d}
+  ,
+  {0x021f, 0x021f}
+  ,
+  {0x0221, 0x0221}
+  ,
+  {0x0223, 0x0223}
+  ,
+  {0x0225, 0x0225}
+  ,
+  {0x0227, 0x0227}
+  ,
+  {0x0229, 0x0229}
+  ,
+  {0x022b, 0x022b}
+  ,
+  {0x022d, 0x022d}
+  ,
+  {0x022f, 0x022f}
+  ,
+  {0x0231, 0x0231}
+  ,
+  {0x0233, 0x0239}
+  ,
+  {0x023c, 0x023c}
+  ,
+  {0x023f, 0x0240}
+  ,
+  {0x0242, 0x0242}
+  ,
+  {0x0247, 0x0247}
+  ,
+  {0x0249, 0x0249}
+  ,
+  {0x024b, 0x024b}
+  ,
+  {0x024d, 0x024d}
+  ,
+  {0x024f, 0x0261}
+  ,
+  {0x0263, 0x0269}
+  ,
+  {0x026b, 0x0273}
+  ,
+  {0x0275, 0x0275}
+  ,
+  {0x0277, 0x0280}
+  ,
+  {0x0282, 0x028e}
+  ,
+  {0x0290, 0x0293}
+  ,
+  {0x029a, 0x029a}
+  ,
+  {0x029d, 0x029e}
+  ,
+  {0x02a0, 0x02a0}
+  ,
+  {0x02a3, 0x02ab}
+  ,
+  {0x02ae, 0x02af}
+  ,
+  {0x0345, 0x0345}
+  ,
+  {0x0363, 0x036f}
+  ,
+  {0x0371, 0x0371}
+  ,
+  {0x0373, 0x0373}
+  ,
+  {0x0377, 0x0377}
+  ,
+  {0x037b, 0x037d}
+  ,
+  {0x0390, 0x0390}
+  ,
+  {0x03ac, 0x03ce}
+  ,
+  {0x03d0, 0x03d1}
+  ,
+  {0x03d5, 0x03d7}
+  ,
+  {0x03d9, 0x03d9}
+  ,
+  {0x03db, 0x03db}
+  ,
+  {0x03dd, 0x03dd}
+  ,
+  {0x03df, 0x03df}
+  ,
+  {0x03e1, 0x03e1}
+  ,
+  {0x03e3, 0x03e3}
+  ,
+  {0x03e5, 0x03e5}
+  ,
+  {0x03e7, 0x03e7}
+  ,
+  {0x03e9, 0x03e9}
+  ,
+  {0x03eb, 0x03eb}
+  ,
+  {0x03ed, 0x03ed}
+  ,
+  {0x03ef, 0x03f2}
+  ,
+  {0x03f5, 0x03f5}
+  ,
+  {0x03f8, 0x03f8}
+  ,
+  {0x03fb, 0x03fb}
+  ,
+  {0x0430, 0x045f}
+  ,
+  {0x0461, 0x0461}
+  ,
+  {0x0463, 0x0463}
+  ,
+  {0x0465, 0x0465}
+  ,
+  {0x0467, 0x0467}
+  ,
+  {0x0469, 0x0469}
+  ,
+  {0x046b, 0x046b}
+  ,
+  {0x046d, 0x046d}
+  ,
+  {0x046f, 0x046f}
+  ,
+  {0x0471, 0x0471}
+  ,
+  {0x0473, 0x0473}
+  ,
+  {0x0475, 0x0475}
+  ,
+  {0x0477, 0x0477}
+  ,
+  {0x0479, 0x0479}
+  ,
+  {0x047b, 0x047b}
+  ,
+  {0x047d, 0x047d}
+  ,
+  {0x047f, 0x047f}
+  ,
+  {0x0481, 0x0481}
+  ,
+  {0x048b, 0x048b}
+  ,
+  {0x048d, 0x048d}
+  ,
+  {0x048f, 0x048f}
+  ,
+  {0x0491, 0x0491}
+  ,
+  {0x0493, 0x0493}
+  ,
+  {0x0495, 0x0495}
+  ,
+  {0x0497, 0x0497}
+  ,
+  {0x0499, 0x0499}
+  ,
+  {0x049b, 0x049b}
+  ,
+  {0x049d, 0x049d}
+  ,
+  {0x049f, 0x049f}
+  ,
+  {0x04a1, 0x04a1}
+  ,
+  {0x04a3, 0x04a3}
+  ,
+  {0x04a5, 0x04a5}
+  ,
+  {0x04a7, 0x04a7}
+  ,
+  {0x04a9, 0x04a9}
+  ,
+  {0x04ab, 0x04ab}
+  ,
+  {0x04ad, 0x04ad}
+  ,
+  {0x04af, 0x04af}
+  ,
+  {0x04b1, 0x04b1}
+  ,
+  {0x04b3, 0x04b3}
+  ,
+  {0x04b5, 0x04b5}
+  ,
+  {0x04b7, 0x04b7}
+  ,
+  {0x04b9, 0x04b9}
+  ,
+  {0x04bb, 0x04bb}
+  ,
+  {0x04bd, 0x04bd}
+  ,
+  {0x04bf, 0x04bf}
+  ,
+  {0x04c2, 0x04c2}
+  ,
+  {0x04c4, 0x04c4}
+  ,
+  {0x04c6, 0x04c6}
+  ,
+  {0x04c8, 0x04c8}
+  ,
+  {0x04ca, 0x04ca}
+  ,
+  {0x04cc, 0x04cc}
+  ,
+  {0x04ce, 0x04cf}
+  ,
+  {0x04d1, 0x04d1}
+  ,
+  {0x04d3, 0x04d3}
+  ,
+  {0x04d5, 0x04d5}
+  ,
+  {0x04d7, 0x04d7}
+  ,
+  {0x04d9, 0x04d9}
+  ,
+  {0x04db, 0x04db}
+  ,
+  {0x04dd, 0x04dd}
+  ,
+  {0x04df, 0x04df}
+  ,
+  {0x04e1, 0x04e1}
+  ,
+  {0x04e3, 0x04e3}
+  ,
+  {0x04e5, 0x04e5}
+  ,
+  {0x04e7, 0x04e7}
+  ,
+  {0x04e9, 0x04e9}
+  ,
+  {0x04eb, 0x04eb}
+  ,
+  {0x04ed, 0x04ed}
+  ,
+  {0x04ef, 0x04ef}
+  ,
+  {0x04f1, 0x04f1}
+  ,
+  {0x04f3, 0x04f3}
+  ,
+  {0x04f5, 0x04f5}
+  ,
+  {0x04f7, 0x04f7}
+  ,
+  {0x04f9, 0x04f9}
+  ,
+  {0x04fb, 0x04fb}
+  ,
+  {0x04fd, 0x04fd}
+  ,
+  {0x04ff, 0x04ff}
+  ,
+  {0x0501, 0x0501}
+  ,
+  {0x0503, 0x0503}
+  ,
+  {0x0505, 0x0505}
+  ,
+  {0x0507, 0x0507}
+  ,
+  {0x0509, 0x0509}
+  ,
+  {0x050b, 0x050b}
+  ,
+  {0x050d, 0x050d}
+  ,
+  {0x050f, 0x050f}
+  ,
+  {0x0511, 0x0511}
+  ,
+  {0x0513, 0x0513}
+  ,
+  {0x0515, 0x0515}
+  ,
+  {0x0517, 0x0517}
+  ,
+  {0x0519, 0x0519}
+  ,
+  {0x051b, 0x051b}
+  ,
+  {0x051d, 0x051d}
+  ,
+  {0x051f, 0x051f}
+  ,
+  {0x0521, 0x0521}
+  ,
+  {0x0523, 0x0523}
+  ,
+  {0x0561, 0x0587}
+  ,
+  {0x1930, 0x1938}
+  ,
+  {0x1d02, 0x1d02}
+  ,
+  {0x1d08, 0x1d09}
+  ,
+  {0x1d11, 0x1d14}
+  ,
+  {0x1d16, 0x1d17}
+  ,
+  {0x1d1d, 0x1d1f}
+  ,
+  {0x1d62, 0x1d77}
+  ,
+  {0x1d79, 0x1d7a}
+  ,
+  {0x1d7c, 0x1d7d}
+  ,
+  {0x1d7f, 0x1d9a}
+  ,
+  {0x1dca, 0x1dca}
+  ,
+  {0x1dd3, 0x1dda}
+  ,
+  {0x1ddc, 0x1ddd}
+  ,
+  {0x1de0, 0x1de0}
+  ,
+  {0x1de3, 0x1de6}
+  ,
+  {0x1e01, 0x1e01}
+  ,
+  {0x1e03, 0x1e03}
+  ,
+  {0x1e05, 0x1e05}
+  ,
+  {0x1e07, 0x1e07}
+  ,
+  {0x1e09, 0x1e09}
+  ,
+  {0x1e0b, 0x1e0b}
+  ,
+  {0x1e0d, 0x1e0d}
+  ,
+  {0x1e0f, 0x1e0f}
+  ,
+  {0x1e11, 0x1e11}
+  ,
+  {0x1e13, 0x1e13}
+  ,
+  {0x1e15, 0x1e15}
+  ,
+  {0x1e17, 0x1e17}
+  ,
+  {0x1e19, 0x1e19}
+  ,
+  {0x1e1b, 0x1e1b}
+  ,
+  {0x1e1d, 0x1e1d}
+  ,
+  {0x1e1f, 0x1e1f}
+  ,
+  {0x1e21, 0x1e21}
+  ,
+  {0x1e23, 0x1e23}
+  ,
+  {0x1e25, 0x1e25}
+  ,
+  {0x1e27, 0x1e27}
+  ,
+  {0x1e29, 0x1e29}
+  ,
+  {0x1e2b, 0x1e2b}
+  ,
+  {0x1e2d, 0x1e2d}
+  ,
+  {0x1e2f, 0x1e2f}
+  ,
+  {0x1e31, 0x1e31}
+  ,
+  {0x1e33, 0x1e33}
+  ,
+  {0x1e35, 0x1e35}
+  ,
+  {0x1e37, 0x1e37}
+  ,
+  {0x1e39, 0x1e39}
+  ,
+  {0x1e3b, 0x1e3b}
+  ,
+  {0x1e3d, 0x1e3d}
+  ,
+  {0x1e3f, 0x1e3f}
+  ,
+  {0x1e41, 0x1e41}
+  ,
+  {0x1e43, 0x1e43}
+  ,
+  {0x1e45, 0x1e45}
+  ,
+  {0x1e47, 0x1e47}
+  ,
+  {0x1e49, 0x1e49}
+  ,
+  {0x1e4b, 0x1e4b}
+  ,
+  {0x1e4d, 0x1e4d}
+  ,
+  {0x1e4f, 0x1e4f}
+  ,
+  {0x1e51, 0x1e51}
+  ,
+  {0x1e53, 0x1e53}
+  ,
+  {0x1e55, 0x1e55}
+  ,
+  {0x1e57, 0x1e57}
+  ,
+  {0x1e59, 0x1e59}
+  ,
+  {0x1e5b, 0x1e5b}
+  ,
+  {0x1e5d, 0x1e5d}
+  ,
+  {0x1e5f, 0x1e5f}
+  ,
+  {0x1e61, 0x1e61}
+  ,
+  {0x1e63, 0x1e63}
+  ,
+  {0x1e65, 0x1e65}
+  ,
+  {0x1e67, 0x1e67}
+  ,
+  {0x1e69, 0x1e69}
+  ,
+  {0x1e6b, 0x1e6b}
+  ,
+  {0x1e6d, 0x1e6d}
+  ,
+  {0x1e6f, 0x1e6f}
+  ,
+  {0x1e71, 0x1e71}
+  ,
+  {0x1e73, 0x1e73}
+  ,
+  {0x1e75, 0x1e75}
+  ,
+  {0x1e77, 0x1e77}
+  ,
+  {0x1e79, 0x1e79}
+  ,
+  {0x1e7b, 0x1e7b}
+  ,
+  {0x1e7d, 0x1e7d}
+  ,
+  {0x1e7f, 0x1e7f}
+  ,
+  {0x1e81, 0x1e81}
+  ,
+  {0x1e83, 0x1e83}
+  ,
+  {0x1e85, 0x1e85}
+  ,
+  {0x1e87, 0x1e87}
+  ,
+  {0x1e89, 0x1e89}
+  ,
+  {0x1e8b, 0x1e8b}
+  ,
+  {0x1e8d, 0x1e8d}
+  ,
+  {0x1e8f, 0x1e8f}
+  ,
+  {0x1e91, 0x1e91}
+  ,
+  {0x1e93, 0x1e93}
+  ,
+  {0x1e95, 0x1e9d}
+  ,
+  {0x1e9f, 0x1e9f}
+  ,
+  {0x1ea1, 0x1ea1}
+  ,
+  {0x1ea3, 0x1ea3}
+  ,
+  {0x1ea5, 0x1ea5}
+  ,
+  {0x1ea7, 0x1ea7}
+  ,
+  {0x1ea9, 0x1ea9}
+  ,
+  {0x1eab, 0x1eab}
+  ,
+  {0x1ead, 0x1ead}
+  ,
+  {0x1eaf, 0x1eaf}
+  ,
+  {0x1eb1, 0x1eb1}
+  ,
+  {0x1eb3, 0x1eb3}
+  ,
+  {0x1eb5, 0x1eb5}
+  ,
+  {0x1eb7, 0x1eb7}
+  ,
+  {0x1eb9, 0x1eb9}
+  ,
+  {0x1ebb, 0x1ebb}
+  ,
+  {0x1ebd, 0x1ebd}
+  ,
+  {0x1ebf, 0x1ebf}
+  ,
+  {0x1ec1, 0x1ec1}
+  ,
+  {0x1ec3, 0x1ec3}
+  ,
+  {0x1ec5, 0x1ec5}
+  ,
+  {0x1ec7, 0x1ec7}
+  ,
+  {0x1ec9, 0x1ec9}
+  ,
+  {0x1ecb, 0x1ecb}
+  ,
+  {0x1ecd, 0x1ecd}
+  ,
+  {0x1ecf, 0x1ecf}
+  ,
+  {0x1ed1, 0x1ed1}
+  ,
+  {0x1ed3, 0x1ed3}
+  ,
+  {0x1ed5, 0x1ed5}
+  ,
+  {0x1ed7, 0x1ed7}
+  ,
+  {0x1ed9, 0x1ed9}
+  ,
+  {0x1edb, 0x1edb}
+  ,
+  {0x1edd, 0x1edd}
+  ,
+  {0x1edf, 0x1edf}
+  ,
+  {0x1ee1, 0x1ee1}
+  ,
+  {0x1ee3, 0x1ee3}
+  ,
+  {0x1ee5, 0x1ee5}
+  ,
+  {0x1ee7, 0x1ee7}
+  ,
+  {0x1ee9, 0x1ee9}
+  ,
+  {0x1eeb, 0x1eeb}
+  ,
+  {0x1eed, 0x1eed}
+  ,
+  {0x1eef, 0x1eef}
+  ,
+  {0x1ef1, 0x1ef1}
+  ,
+  {0x1ef3, 0x1ef3}
+  ,
+  {0x1ef5, 0x1ef5}
+  ,
+  {0x1ef7, 0x1ef7}
+  ,
+  {0x1ef9, 0x1ef9}
+  ,
+  {0x1efb, 0x1efb}
+  ,
+  {0x1efd, 0x1efd}
+  ,
+  {0x1eff, 0x1f07}
+  ,
+  {0x1f10, 0x1f15}
+  ,
+  {0x1f20, 0x1f27}
+  ,
+  {0x1f30, 0x1f37}
+  ,
+  {0x1f40, 0x1f45}
+  ,
+  {0x1f50, 0x1f57}
+  ,
+  {0x1f60, 0x1f67}
+  ,
+  {0x1f70, 0x1f7d}
+  ,
+  {0x1f80, 0x1f87}
+  ,
+  {0x1f90, 0x1f97}
+  ,
+  {0x1fa0, 0x1fa7}
+  ,
+  {0x1fb0, 0x1fb4}
+  ,
+  {0x1fb6, 0x1fb7}
+  ,
+  {0x1fbe, 0x1fbe}
+  ,
+  {0x1fc2, 0x1fc4}
+  ,
+  {0x1fc6, 0x1fc7}
+  ,
+  {0x1fd0, 0x1fd3}
+  ,
+  {0x1fd6, 0x1fd7}
+  ,
+  {0x1fe0, 0x1fe7}
+  ,
+  {0x1ff2, 0x1ff4}
+  ,
+  {0x1ff6, 0x1ff7}
+  ,
+  {0xa641, 0xa641}
+  ,
+  {0xa643, 0xa643}
+  ,
+  {0xa645, 0xa645}
+  ,
+  {0xa647, 0xa647}
+  ,
+  {0xa649, 0xa649}
+  ,
+  {0xa64b, 0xa64b}
+  ,
+  {0xa64d, 0xa64d}
+  ,
+  {0xa64f, 0xa64f}
+  ,
+  {0xa651, 0xa651}
+  ,
+  {0xa653, 0xa653}
+  ,
+  {0xa655, 0xa655}
+  ,
+  {0xa657, 0xa657}
+  ,
+  {0xa659, 0xa659}
+  ,
+  {0xa65b, 0xa65b}
+  ,
+  {0xa65d, 0xa65d}
+  ,
+  {0xa65f, 0xa65f}
+  ,
+  {0xa663, 0xa663}
+  ,
+  {0xa665, 0xa665}
+  ,
+  {0xa667, 0xa667}
+  ,
+  {0xa669, 0xa669}
+  ,
+  {0xa66b, 0xa66b}
+  ,
+  {0xa66d, 0xa66d}
+  ,
+  {0xa681, 0xa681}
+  ,
+  {0xa683, 0xa683}
+  ,
+  {0xa685, 0xa685}
+  ,
+  {0xa687, 0xa687}
+  ,
+  {0xa689, 0xa689}
+  ,
+  {0xa68b, 0xa68b}
+  ,
+  {0xa68d, 0xa68d}
+  ,
+  {0xa68f, 0xa68f}
+  ,
+  {0xa691, 0xa691}
+  ,
+  {0xa693, 0xa693}
+  ,
+  {0xa695, 0xa695}
+  ,
+  {0xa697, 0xa697}
+  ,
+  {0xa723, 0xa723}
+  ,
+  {0xa725, 0xa725}
+  ,
+  {0xa727, 0xa727}
+  ,
+  {0xa729, 0xa729}
+  ,
+  {0xa72b, 0xa72b}
+  ,
+  {0xa72d, 0xa72d}
+  ,
+  {0xa72f, 0xa72f}
+  ,
+  {0xa733, 0xa733}
+  ,
+  {0xa735, 0xa735}
+  ,
+  {0xa737, 0xa737}
+  ,
+  {0xa739, 0xa739}
+  ,
+  {0xa73b, 0xa73b}
+  ,
+  {0xa73d, 0xa73d}
+  ,
+  {0xa73f, 0xa73f}
+  ,
+  {0xa741, 0xa741}
+  ,
+  {0xa743, 0xa743}
+  ,
+  {0xa745, 0xa745}
+  ,
+  {0xa747, 0xa747}
+  ,
+  {0xa749, 0xa749}
+  ,
+  {0xa74b, 0xa74b}
+  ,
+  {0xa74d, 0xa74d}
+  ,
+  {0xa74f, 0xa74f}
+  ,
+  {0xa751, 0xa751}
+  ,
+  {0xa753, 0xa753}
+  ,
+  {0xa755, 0xa755}
+  ,
+  {0xa757, 0xa757}
+  ,
+  {0xa759, 0xa759}
+  ,
+  {0xa75b, 0xa75b}
+  ,
+  {0xa75d, 0xa75d}
+  ,
+  {0xa75f, 0xa75f}
+  ,
+  {0xa761, 0xa761}
+  ,
+  {0xa763, 0xa763}
+  ,
+  {0xa765, 0xa765}
+  ,
+  {0xa767, 0xa767}
+  ,
+  {0xa769, 0xa769}
+  ,
+  {0xa76b, 0xa76b}
+  ,
+  {0xa76d, 0xa76d}
+  ,
+  {0xa76f, 0xa76f}
+  ,
+  {0xa771, 0xa775}
+  ,
+  {0xa777, 0xa778}
+  ,
+  {0xa77a, 0xa77a}
+  ,
+  {0xa77c, 0xa77c}
+  ,
+  {0xa77f, 0xa77f}
+  ,
+  {0xa781, 0xa781}
+  ,
+  {0xa783, 0xa783}
+  ,
+  {0xa785, 0xa785}
+  ,
+  {0xa787, 0xa787}
+  ,
+  {0xa78c, 0xa78c}
+  ,
+  {0xfb00, 0xfb06}
+  ,
+  {0xfb13, 0xfb17}
+  ,
+  {0xff41, 0xff5a}
+  ,
+  {0x10428, 0x1044f}
+  ,
+  {0xe0061, 0xe007a}
+};
+
+scm_t_char_set cs_lower_case = {
+  523,
+  cs_lower_case_ranges
+};
+
+scm_t_char_range cs_upper_case_ranges[] = {
+  {0x0041, 0x005a}
+  ,
+  {0x00c0, 0x00d6}
+  ,
+  {0x00d8, 0x00de}
+  ,
+  {0x0100, 0x0100}
+  ,
+  {0x0102, 0x0102}
+  ,
+  {0x0104, 0x0104}
+  ,
+  {0x0106, 0x0106}
+  ,
+  {0x0108, 0x0108}
+  ,
+  {0x010a, 0x010a}
+  ,
+  {0x010c, 0x010c}
+  ,
+  {0x010e, 0x010e}
+  ,
+  {0x0110, 0x0110}
+  ,
+  {0x0112, 0x0112}
+  ,
+  {0x0114, 0x0114}
+  ,
+  {0x0116, 0x0116}
+  ,
+  {0x0118, 0x0118}
+  ,
+  {0x011a, 0x011a}
+  ,
+  {0x011c, 0x011c}
+  ,
+  {0x011e, 0x011e}
+  ,
+  {0x0120, 0x0120}
+  ,
+  {0x0122, 0x0122}
+  ,
+  {0x0124, 0x0124}
+  ,
+  {0x0126, 0x0126}
+  ,
+  {0x0128, 0x0128}
+  ,
+  {0x012a, 0x012a}
+  ,
+  {0x012c, 0x012c}
+  ,
+  {0x012e, 0x012e}
+  ,
+  {0x0130, 0x0130}
+  ,
+  {0x0132, 0x0132}
+  ,
+  {0x0134, 0x0134}
+  ,
+  {0x0136, 0x0136}
+  ,
+  {0x0139, 0x0139}
+  ,
+  {0x013b, 0x013b}
+  ,
+  {0x013d, 0x013d}
+  ,
+  {0x013f, 0x013f}
+  ,
+  {0x0141, 0x0141}
+  ,
+  {0x0143, 0x0143}
+  ,
+  {0x0145, 0x0145}
+  ,
+  {0x0147, 0x0147}
+  ,
+  {0x014a, 0x014a}
+  ,
+  {0x014c, 0x014c}
+  ,
+  {0x014e, 0x014e}
+  ,
+  {0x0150, 0x0150}
+  ,
+  {0x0152, 0x0152}
+  ,
+  {0x0154, 0x0154}
+  ,
+  {0x0156, 0x0156}
+  ,
+  {0x0158, 0x0158}
+  ,
+  {0x015a, 0x015a}
+  ,
+  {0x015c, 0x015c}
+  ,
+  {0x015e, 0x015e}
+  ,
+  {0x0160, 0x0160}
+  ,
+  {0x0162, 0x0162}
+  ,
+  {0x0164, 0x0164}
+  ,
+  {0x0166, 0x0166}
+  ,
+  {0x0168, 0x0168}
+  ,
+  {0x016a, 0x016a}
+  ,
+  {0x016c, 0x016c}
+  ,
+  {0x016e, 0x016e}
+  ,
+  {0x0170, 0x0170}
+  ,
+  {0x0172, 0x0172}
+  ,
+  {0x0174, 0x0174}
+  ,
+  {0x0176, 0x0176}
+  ,
+  {0x0178, 0x0179}
+  ,
+  {0x017b, 0x017b}
+  ,
+  {0x017d, 0x017d}
+  ,
+  {0x0181, 0x0182}
+  ,
+  {0x0184, 0x0184}
+  ,
+  {0x0186, 0x0187}
+  ,
+  {0x0189, 0x018b}
+  ,
+  {0x018e, 0x0191}
+  ,
+  {0x0193, 0x0194}
+  ,
+  {0x0196, 0x0198}
+  ,
+  {0x019c, 0x019d}
+  ,
+  {0x019f, 0x01a0}
+  ,
+  {0x01a2, 0x01a2}
+  ,
+  {0x01a4, 0x01a4}
+  ,
+  {0x01a6, 0x01a7}
+  ,
+  {0x01a9, 0x01a9}
+  ,
+  {0x01ac, 0x01ac}
+  ,
+  {0x01ae, 0x01af}
+  ,
+  {0x01b1, 0x01b3}
+  ,
+  {0x01b5, 0x01b5}
+  ,
+  {0x01b7, 0x01b8}
+  ,
+  {0x01bc, 0x01bc}
+  ,
+  {0x01c4, 0x01c4}
+  ,
+  {0x01c7, 0x01c7}
+  ,
+  {0x01ca, 0x01ca}
+  ,
+  {0x01cd, 0x01cd}
+  ,
+  {0x01cf, 0x01cf}
+  ,
+  {0x01d1, 0x01d1}
+  ,
+  {0x01d3, 0x01d3}
+  ,
+  {0x01d5, 0x01d5}
+  ,
+  {0x01d7, 0x01d7}
+  ,
+  {0x01d9, 0x01d9}
+  ,
+  {0x01db, 0x01db}
+  ,
+  {0x01de, 0x01de}
+  ,
+  {0x01e0, 0x01e0}
+  ,
+  {0x01e2, 0x01e2}
+  ,
+  {0x01e4, 0x01e4}
+  ,
+  {0x01e6, 0x01e6}
+  ,
+  {0x01e8, 0x01e8}
+  ,
+  {0x01ea, 0x01ea}
+  ,
+  {0x01ec, 0x01ec}
+  ,
+  {0x01ee, 0x01ee}
+  ,
+  {0x01f1, 0x01f1}
+  ,
+  {0x01f4, 0x01f4}
+  ,
+  {0x01f6, 0x01f8}
+  ,
+  {0x01fa, 0x01fa}
+  ,
+  {0x01fc, 0x01fc}
+  ,
+  {0x01fe, 0x01fe}
+  ,
+  {0x0200, 0x0200}
+  ,
+  {0x0202, 0x0202}
+  ,
+  {0x0204, 0x0204}
+  ,
+  {0x0206, 0x0206}
+  ,
+  {0x0208, 0x0208}
+  ,
+  {0x020a, 0x020a}
+  ,
+  {0x020c, 0x020c}
+  ,
+  {0x020e, 0x020e}
+  ,
+  {0x0210, 0x0210}
+  ,
+  {0x0212, 0x0212}
+  ,
+  {0x0214, 0x0214}
+  ,
+  {0x0216, 0x0216}
+  ,
+  {0x0218, 0x0218}
+  ,
+  {0x021a, 0x021a}
+  ,
+  {0x021c, 0x021c}
+  ,
+  {0x021e, 0x021e}
+  ,
+  {0x0220, 0x0220}
+  ,
+  {0x0222, 0x0222}
+  ,
+  {0x0224, 0x0224}
+  ,
+  {0x0226, 0x0226}
+  ,
+  {0x0228, 0x0228}
+  ,
+  {0x022a, 0x022a}
+  ,
+  {0x022c, 0x022c}
+  ,
+  {0x022e, 0x022e}
+  ,
+  {0x0230, 0x0230}
+  ,
+  {0x0232, 0x0232}
+  ,
+  {0x023a, 0x023b}
+  ,
+  {0x023d, 0x023e}
+  ,
+  {0x0241, 0x0241}
+  ,
+  {0x0243, 0x0246}
+  ,
+  {0x0248, 0x0248}
+  ,
+  {0x024a, 0x024a}
+  ,
+  {0x024c, 0x024c}
+  ,
+  {0x024e, 0x024e}
+  ,
+  {0x0370, 0x0370}
+  ,
+  {0x0372, 0x0372}
+  ,
+  {0x0376, 0x0376}
+  ,
+  {0x0386, 0x0386}
+  ,
+  {0x0388, 0x038a}
+  ,
+  {0x038c, 0x038c}
+  ,
+  {0x038e, 0x038f}
+  ,
+  {0x0391, 0x03a1}
+  ,
+  {0x03a3, 0x03ab}
+  ,
+  {0x03cf, 0x03cf}
+  ,
+  {0x03d8, 0x03d8}
+  ,
+  {0x03da, 0x03da}
+  ,
+  {0x03dc, 0x03dc}
+  ,
+  {0x03de, 0x03de}
+  ,
+  {0x03e0, 0x03e0}
+  ,
+  {0x03e2, 0x03e2}
+  ,
+  {0x03e4, 0x03e4}
+  ,
+  {0x03e6, 0x03e6}
+  ,
+  {0x03e8, 0x03e8}
+  ,
+  {0x03ea, 0x03ea}
+  ,
+  {0x03ec, 0x03ec}
+  ,
+  {0x03ee, 0x03ee}
+  ,
+  {0x03f4, 0x03f4}
+  ,
+  {0x03f7, 0x03f7}
+  ,
+  {0x03f9, 0x03fa}
+  ,
+  {0x03fd, 0x042f}
+  ,
+  {0x0460, 0x0460}
+  ,
+  {0x0462, 0x0462}
+  ,
+  {0x0464, 0x0464}
+  ,
+  {0x0466, 0x0466}
+  ,
+  {0x0468, 0x0468}
+  ,
+  {0x046a, 0x046a}
+  ,
+  {0x046c, 0x046c}
+  ,
+  {0x046e, 0x046e}
+  ,
+  {0x0470, 0x0470}
+  ,
+  {0x0472, 0x0472}
+  ,
+  {0x0474, 0x0474}
+  ,
+  {0x0476, 0x0476}
+  ,
+  {0x0478, 0x0478}
+  ,
+  {0x047a, 0x047a}
+  ,
+  {0x047c, 0x047c}
+  ,
+  {0x047e, 0x047e}
+  ,
+  {0x0480, 0x0480}
+  ,
+  {0x048a, 0x048a}
+  ,
+  {0x048c, 0x048c}
+  ,
+  {0x048e, 0x048e}
+  ,
+  {0x0490, 0x0490}
+  ,
+  {0x0492, 0x0492}
+  ,
+  {0x0494, 0x0494}
+  ,
+  {0x0496, 0x0496}
+  ,
+  {0x0498, 0x0498}
+  ,
+  {0x049a, 0x049a}
+  ,
+  {0x049c, 0x049c}
+  ,
+  {0x049e, 0x049e}
+  ,
+  {0x04a0, 0x04a0}
+  ,
+  {0x04a2, 0x04a2}
+  ,
+  {0x04a4, 0x04a4}
+  ,
+  {0x04a6, 0x04a6}
+  ,
+  {0x04a8, 0x04a8}
+  ,
+  {0x04aa, 0x04aa}
+  ,
+  {0x04ac, 0x04ac}
+  ,
+  {0x04ae, 0x04ae}
+  ,
+  {0x04b0, 0x04b0}
+  ,
+  {0x04b2, 0x04b2}
+  ,
+  {0x04b4, 0x04b4}
+  ,
+  {0x04b6, 0x04b6}
+  ,
+  {0x04b8, 0x04b8}
+  ,
+  {0x04ba, 0x04ba}
+  ,
+  {0x04bc, 0x04bc}
+  ,
+  {0x04be, 0x04be}
+  ,
+  {0x04c0, 0x04c1}
+  ,
+  {0x04c3, 0x04c3}
+  ,
+  {0x04c5, 0x04c5}
+  ,
+  {0x04c7, 0x04c7}
+  ,
+  {0x04c9, 0x04c9}
+  ,
+  {0x04cb, 0x04cb}
+  ,
+  {0x04cd, 0x04cd}
+  ,
+  {0x04d0, 0x04d0}
+  ,
+  {0x04d2, 0x04d2}
+  ,
+  {0x04d4, 0x04d4}
+  ,
+  {0x04d6, 0x04d6}
+  ,
+  {0x04d8, 0x04d8}
+  ,
+  {0x04da, 0x04da}
+  ,
+  {0x04dc, 0x04dc}
+  ,
+  {0x04de, 0x04de}
+  ,
+  {0x04e0, 0x04e0}
+  ,
+  {0x04e2, 0x04e2}
+  ,
+  {0x04e4, 0x04e4}
+  ,
+  {0x04e6, 0x04e6}
+  ,
+  {0x04e8, 0x04e8}
+  ,
+  {0x04ea, 0x04ea}
+  ,
+  {0x04ec, 0x04ec}
+  ,
+  {0x04ee, 0x04ee}
+  ,
+  {0x04f0, 0x04f0}
+  ,
+  {0x04f2, 0x04f2}
+  ,
+  {0x04f4, 0x04f4}
+  ,
+  {0x04f6, 0x04f6}
+  ,
+  {0x04f8, 0x04f8}
+  ,
+  {0x04fa, 0x04fa}
+  ,
+  {0x04fc, 0x04fc}
+  ,
+  {0x04fe, 0x04fe}
+  ,
+  {0x0500, 0x0500}
+  ,
+  {0x0502, 0x0502}
+  ,
+  {0x0504, 0x0504}
+  ,
+  {0x0506, 0x0506}
+  ,
+  {0x0508, 0x0508}
+  ,
+  {0x050a, 0x050a}
+  ,
+  {0x050c, 0x050c}
+  ,
+  {0x050e, 0x050e}
+  ,
+  {0x0510, 0x0510}
+  ,
+  {0x0512, 0x0512}
+  ,
+  {0x0514, 0x0514}
+  ,
+  {0x0516, 0x0516}
+  ,
+  {0x0518, 0x0518}
+  ,
+  {0x051a, 0x051a}
+  ,
+  {0x051c, 0x051c}
+  ,
+  {0x051e, 0x051e}
+  ,
+  {0x0520, 0x0520}
+  ,
+  {0x0522, 0x0522}
+  ,
+  {0x0531, 0x0556}
+  ,
+  {0x10a0, 0x10c5}
+  ,
+  {0x1d7b, 0x1d7b}
+  ,
+  {0x1d7e, 0x1d7e}
+  ,
+  {0x1e00, 0x1e00}
+  ,
+  {0x1e02, 0x1e02}
+  ,
+  {0x1e04, 0x1e04}
+  ,
+  {0x1e06, 0x1e06}
+  ,
+  {0x1e08, 0x1e08}
+  ,
+  {0x1e0a, 0x1e0a}
+  ,
+  {0x1e0c, 0x1e0c}
+  ,
+  {0x1e0e, 0x1e0e}
+  ,
+  {0x1e10, 0x1e10}
+  ,
+  {0x1e12, 0x1e12}
+  ,
+  {0x1e14, 0x1e14}
+  ,
+  {0x1e16, 0x1e16}
+  ,
+  {0x1e18, 0x1e18}
+  ,
+  {0x1e1a, 0x1e1a}
+  ,
+  {0x1e1c, 0x1e1c}
+  ,
+  {0x1e1e, 0x1e1e}
+  ,
+  {0x1e20, 0x1e20}
+  ,
+  {0x1e22, 0x1e22}
+  ,
+  {0x1e24, 0x1e24}
+  ,
+  {0x1e26, 0x1e26}
+  ,
+  {0x1e28, 0x1e28}
+  ,
+  {0x1e2a, 0x1e2a}
+  ,
+  {0x1e2c, 0x1e2c}
+  ,
+  {0x1e2e, 0x1e2e}
+  ,
+  {0x1e30, 0x1e30}
+  ,
+  {0x1e32, 0x1e32}
+  ,
+  {0x1e34, 0x1e34}
+  ,
+  {0x1e36, 0x1e36}
+  ,
+  {0x1e38, 0x1e38}
+  ,
+  {0x1e3a, 0x1e3a}
+  ,
+  {0x1e3c, 0x1e3c}
+  ,
+  {0x1e3e, 0x1e3e}
+  ,
+  {0x1e40, 0x1e40}
+  ,
+  {0x1e42, 0x1e42}
+  ,
+  {0x1e44, 0x1e44}
+  ,
+  {0x1e46, 0x1e46}
+  ,
+  {0x1e48, 0x1e48}
+  ,
+  {0x1e4a, 0x1e4a}
+  ,
+  {0x1e4c, 0x1e4c}
+  ,
+  {0x1e4e, 0x1e4e}
+  ,
+  {0x1e50, 0x1e50}
+  ,
+  {0x1e52, 0x1e52}
+  ,
+  {0x1e54, 0x1e54}
+  ,
+  {0x1e56, 0x1e56}
+  ,
+  {0x1e58, 0x1e58}
+  ,
+  {0x1e5a, 0x1e5a}
+  ,
+  {0x1e5c, 0x1e5c}
+  ,
+  {0x1e5e, 0x1e5e}
+  ,
+  {0x1e60, 0x1e60}
+  ,
+  {0x1e62, 0x1e62}
+  ,
+  {0x1e64, 0x1e64}
+  ,
+  {0x1e66, 0x1e66}
+  ,
+  {0x1e68, 0x1e68}
+  ,
+  {0x1e6a, 0x1e6a}
+  ,
+  {0x1e6c, 0x1e6c}
+  ,
+  {0x1e6e, 0x1e6e}
+  ,
+  {0x1e70, 0x1e70}
+  ,
+  {0x1e72, 0x1e72}
+  ,
+  {0x1e74, 0x1e74}
+  ,
+  {0x1e76, 0x1e76}
+  ,
+  {0x1e78, 0x1e78}
+  ,
+  {0x1e7a, 0x1e7a}
+  ,
+  {0x1e7c, 0x1e7c}
+  ,
+  {0x1e7e, 0x1e7e}
+  ,
+  {0x1e80, 0x1e80}
+  ,
+  {0x1e82, 0x1e82}
+  ,
+  {0x1e84, 0x1e84}
+  ,
+  {0x1e86, 0x1e86}
+  ,
+  {0x1e88, 0x1e88}
+  ,
+  {0x1e8a, 0x1e8a}
+  ,
+  {0x1e8c, 0x1e8c}
+  ,
+  {0x1e8e, 0x1e8e}
+  ,
+  {0x1e90, 0x1e90}
+  ,
+  {0x1e92, 0x1e92}
+  ,
+  {0x1e94, 0x1e94}
+  ,
+  {0x1e9e, 0x1e9e}
+  ,
+  {0x1ea0, 0x1ea0}
+  ,
+  {0x1ea2, 0x1ea2}
+  ,
+  {0x1ea4, 0x1ea4}
+  ,
+  {0x1ea6, 0x1ea6}
+  ,
+  {0x1ea8, 0x1ea8}
+  ,
+  {0x1eaa, 0x1eaa}
+  ,
+  {0x1eac, 0x1eac}
+  ,
+  {0x1eae, 0x1eae}
+  ,
+  {0x1eb0, 0x1eb0}
+  ,
+  {0x1eb2, 0x1eb2}
+  ,
+  {0x1eb4, 0x1eb4}
+  ,
+  {0x1eb6, 0x1eb6}
+  ,
+  {0x1eb8, 0x1eb8}
+  ,
+  {0x1eba, 0x1eba}
+  ,
+  {0x1ebc, 0x1ebc}
+  ,
+  {0x1ebe, 0x1ebe}
+  ,
+  {0x1ec0, 0x1ec0}
+  ,
+  {0x1ec2, 0x1ec2}
+  ,
+  {0x1ec4, 0x1ec4}
+  ,
+  {0x1ec6, 0x1ec6}
+  ,
+  {0x1ec8, 0x1ec8}
+  ,
+  {0x1eca, 0x1eca}
+  ,
+  {0x1ecc, 0x1ecc}
+  ,
+  {0x1ece, 0x1ece}
+  ,
+  {0x1ed0, 0x1ed0}
+  ,
+  {0x1ed2, 0x1ed2}
+  ,
+  {0x1ed4, 0x1ed4}
+  ,
+  {0x1ed6, 0x1ed6}
+  ,
+  {0x1ed8, 0x1ed8}
+  ,
+  {0x1eda, 0x1eda}
+  ,
+  {0x1edc, 0x1edc}
+  ,
+  {0x1ede, 0x1ede}
+  ,
+  {0x1ee0, 0x1ee0}
+  ,
+  {0x1ee2, 0x1ee2}
+  ,
+  {0x1ee4, 0x1ee4}
+  ,
+  {0x1ee6, 0x1ee6}
+  ,
+  {0x1ee8, 0x1ee8}
+  ,
+  {0x1eea, 0x1eea}
+  ,
+  {0x1eec, 0x1eec}
+  ,
+  {0x1eee, 0x1eee}
+  ,
+  {0x1ef0, 0x1ef0}
+  ,
+  {0x1ef2, 0x1ef2}
+  ,
+  {0x1ef4, 0x1ef4}
+  ,
+  {0x1ef6, 0x1ef6}
+  ,
+  {0x1ef8, 0x1ef8}
+  ,
+  {0x1efa, 0x1efa}
+  ,
+  {0x1efc, 0x1efc}
+  ,
+  {0x1efe, 0x1efe}
+  ,
+  {0x1f08, 0x1f0f}
+  ,
+  {0x1f18, 0x1f1d}
+  ,
+  {0x1f28, 0x1f2f}
+  ,
+  {0x1f38, 0x1f3f}
+  ,
+  {0x1f48, 0x1f4d}
+  ,
+  {0x1f59, 0x1f59}
+  ,
+  {0x1f5b, 0x1f5b}
+  ,
+  {0x1f5d, 0x1f5d}
+  ,
+  {0x1f5f, 0x1f5f}
+  ,
+  {0x1f68, 0x1f6f}
+  ,
+  {0x1f88, 0x1f8f}
+  ,
+  {0x1f98, 0x1f9f}
+  ,
+  {0x1fa8, 0x1faf}
+  ,
+  {0x1fb8, 0x1fbc}
+  ,
+  {0x1fc8, 0x1fcc}
+  ,
+  {0x1fd8, 0x1fdb}
+  ,
+  {0x1fe8, 0x1fec}
+  ,
+  {0x1ff8, 0x1ffc}
+  ,
+  {0xa640, 0xa640}
+  ,
+  {0xa642, 0xa642}
+  ,
+  {0xa644, 0xa644}
+  ,
+  {0xa646, 0xa646}
+  ,
+  {0xa648, 0xa648}
+  ,
+  {0xa64a, 0xa64a}
+  ,
+  {0xa64c, 0xa64c}
+  ,
+  {0xa64e, 0xa64e}
+  ,
+  {0xa650, 0xa650}
+  ,
+  {0xa652, 0xa652}
+  ,
+  {0xa654, 0xa654}
+  ,
+  {0xa656, 0xa656}
+  ,
+  {0xa658, 0xa658}
+  ,
+  {0xa65a, 0xa65a}
+  ,
+  {0xa65c, 0xa65c}
+  ,
+  {0xa65e, 0xa65e}
+  ,
+  {0xa662, 0xa662}
+  ,
+  {0xa664, 0xa664}
+  ,
+  {0xa666, 0xa666}
+  ,
+  {0xa668, 0xa668}
+  ,
+  {0xa66a, 0xa66a}
+  ,
+  {0xa66c, 0xa66c}
+  ,
+  {0xa680, 0xa680}
+  ,
+  {0xa682, 0xa682}
+  ,
+  {0xa684, 0xa684}
+  ,
+  {0xa686, 0xa686}
+  ,
+  {0xa688, 0xa688}
+  ,
+  {0xa68a, 0xa68a}
+  ,
+  {0xa68c, 0xa68c}
+  ,
+  {0xa68e, 0xa68e}
+  ,
+  {0xa690, 0xa690}
+  ,
+  {0xa692, 0xa692}
+  ,
+  {0xa694, 0xa694}
+  ,
+  {0xa696, 0xa696}
+  ,
+  {0xa722, 0xa722}
+  ,
+  {0xa724, 0xa724}
+  ,
+  {0xa726, 0xa726}
+  ,
+  {0xa728, 0xa728}
+  ,
+  {0xa72a, 0xa72a}
+  ,
+  {0xa72c, 0xa72c}
+  ,
+  {0xa72e, 0xa72e}
+  ,
+  {0xa732, 0xa732}
+  ,
+  {0xa734, 0xa734}
+  ,
+  {0xa736, 0xa736}
+  ,
+  {0xa738, 0xa738}
+  ,
+  {0xa73a, 0xa73a}
+  ,
+  {0xa73c, 0xa73c}
+  ,
+  {0xa73e, 0xa73e}
+  ,
+  {0xa740, 0xa740}
+  ,
+  {0xa742, 0xa742}
+  ,
+  {0xa744, 0xa744}
+  ,
+  {0xa746, 0xa746}
+  ,
+  {0xa748, 0xa748}
+  ,
+  {0xa74a, 0xa74a}
+  ,
+  {0xa74c, 0xa74c}
+  ,
+  {0xa74e, 0xa74e}
+  ,
+  {0xa750, 0xa750}
+  ,
+  {0xa752, 0xa752}
+  ,
+  {0xa754, 0xa754}
+  ,
+  {0xa756, 0xa756}
+  ,
+  {0xa758, 0xa758}
+  ,
+  {0xa75a, 0xa75a}
+  ,
+  {0xa75c, 0xa75c}
+  ,
+  {0xa75e, 0xa75e}
+  ,
+  {0xa760, 0xa760}
+  ,
+  {0xa762, 0xa762}
+  ,
+  {0xa764, 0xa764}
+  ,
+  {0xa766, 0xa766}
+  ,
+  {0xa768, 0xa768}
+  ,
+  {0xa76a, 0xa76a}
+  ,
+  {0xa76c, 0xa76c}
+  ,
+  {0xa76e, 0xa76e}
+  ,
+  {0xa779, 0xa779}
+  ,
+  {0xa77b, 0xa77b}
+  ,
+  {0xa77d, 0xa77e}
+  ,
+  {0xa780, 0xa780}
+  ,
+  {0xa782, 0xa782}
+  ,
+  {0xa784, 0xa784}
+  ,
+  {0xa786, 0xa786}
+  ,
+  {0xa78b, 0xa78b}
+  ,
+  {0xff21, 0xff3a}
+  ,
+  {0x10400, 0x10427}
+  ,
+  {0xe0041, 0xe005a}
+};
+
+scm_t_char_set cs_upper_case = {
+  492,
+  cs_upper_case_ranges
+};
+
+scm_t_char_range cs_title_case_ranges[] = {
+  {0x01c5, 0x01c5}
+  ,
+  {0x01c8, 0x01c8}
+  ,
+  {0x01cb, 0x01cb}
+  ,
+  {0x01f2, 0x01f2}
+  ,
+  {0x1f88, 0x1f8f}
+  ,
+  {0x1f98, 0x1f9f}
+  ,
+  {0x1fa8, 0x1faf}
+  ,
+  {0x1fbc, 0x1fbc}
+  ,
+  {0x1fcc, 0x1fcc}
+  ,
+  {0x1ffc, 0x1ffc}
+};
+
+scm_t_char_set cs_title_case = {
+  10,
+  cs_title_case_ranges
+};
+
+scm_t_char_range cs_letter_ranges[] = {
+  {0x0041, 0x005a}
+  ,
+  {0x0061, 0x007a}
+  ,
+  {0x00aa, 0x00aa}
+  ,
+  {0x00b5, 0x00b5}
+  ,
+  {0x00ba, 0x00ba}
+  ,
+  {0x00c0, 0x00d6}
+  ,
+  {0x00d8, 0x00f6}
+  ,
+  {0x00f8, 0x02c1}
+  ,
+  {0x02c6, 0x02d1}
+  ,
+  {0x02e0, 0x02e4}
+  ,
+  {0x02ec, 0x02ec}
+  ,
+  {0x02ee, 0x02ee}
+  ,
+  {0x0370, 0x0374}
+  ,
+  {0x0376, 0x0377}
+  ,
+  {0x037a, 0x037d}
+  ,
+  {0x0386, 0x0386}
+  ,
+  {0x0388, 0x038a}
+  ,
+  {0x038c, 0x038c}
+  ,
+  {0x038e, 0x03a1}
+  ,
+  {0x03a3, 0x03f5}
+  ,
+  {0x03f7, 0x0481}
+  ,
+  {0x048a, 0x0523}
+  ,
+  {0x0531, 0x0556}
+  ,
+  {0x0559, 0x0559}
+  ,
+  {0x0561, 0x0587}
+  ,
+  {0x05d0, 0x05ea}
+  ,
+  {0x05f0, 0x05f2}
+  ,
+  {0x0621, 0x064a}
+  ,
+  {0x066e, 0x066f}
+  ,
+  {0x0671, 0x06d3}
+  ,
+  {0x06d5, 0x06d5}
+  ,
+  {0x06e5, 0x06e6}
+  ,
+  {0x06ee, 0x06ef}
+  ,
+  {0x06fa, 0x06fc}
+  ,
+  {0x06ff, 0x06ff}
+  ,
+  {0x0710, 0x0710}
+  ,
+  {0x0712, 0x072f}
+  ,
+  {0x074d, 0x07a5}
+  ,
+  {0x07b1, 0x07b1}
+  ,
+  {0x07ca, 0x07ea}
+  ,
+  {0x07f4, 0x07f5}
+  ,
+  {0x07fa, 0x07fa}
+  ,
+  {0x0904, 0x0939}
+  ,
+  {0x093d, 0x093d}
+  ,
+  {0x0950, 0x0950}
+  ,
+  {0x0958, 0x0961}
+  ,
+  {0x0971, 0x0972}
+  ,
+  {0x097b, 0x097f}
+  ,
+  {0x0985, 0x098c}
+  ,
+  {0x098f, 0x0990}
+  ,
+  {0x0993, 0x09a8}
+  ,
+  {0x09aa, 0x09b0}
+  ,
+  {0x09b2, 0x09b2}
+  ,
+  {0x09b6, 0x09b9}
+  ,
+  {0x09bd, 0x09bd}
+  ,
+  {0x09ce, 0x09ce}
+  ,
+  {0x09dc, 0x09dd}
+  ,
+  {0x09df, 0x09e1}
+  ,
+  {0x09f0, 0x09f1}
+  ,
+  {0x0a05, 0x0a0a}
+  ,
+  {0x0a0f, 0x0a10}
+  ,
+  {0x0a13, 0x0a28}
+  ,
+  {0x0a2a, 0x0a30}
+  ,
+  {0x0a32, 0x0a33}
+  ,
+  {0x0a35, 0x0a36}
+  ,
+  {0x0a38, 0x0a39}
+  ,
+  {0x0a59, 0x0a5c}
+  ,
+  {0x0a5e, 0x0a5e}
+  ,
+  {0x0a72, 0x0a74}
+  ,
+  {0x0a85, 0x0a8d}
+  ,
+  {0x0a8f, 0x0a91}
+  ,
+  {0x0a93, 0x0aa8}
+  ,
+  {0x0aaa, 0x0ab0}
+  ,
+  {0x0ab2, 0x0ab3}
+  ,
+  {0x0ab5, 0x0ab9}
+  ,
+  {0x0abd, 0x0abd}
+  ,
+  {0x0ad0, 0x0ad0}
+  ,
+  {0x0ae0, 0x0ae1}
+  ,
+  {0x0b05, 0x0b0c}
+  ,
+  {0x0b0f, 0x0b10}
+  ,
+  {0x0b13, 0x0b28}
+  ,
+  {0x0b2a, 0x0b30}
+  ,
+  {0x0b32, 0x0b33}
+  ,
+  {0x0b35, 0x0b39}
+  ,
+  {0x0b3d, 0x0b3d}
+  ,
+  {0x0b5c, 0x0b5d}
+  ,
+  {0x0b5f, 0x0b61}
+  ,
+  {0x0b71, 0x0b71}
+  ,
+  {0x0b83, 0x0b83}
+  ,
+  {0x0b85, 0x0b8a}
+  ,
+  {0x0b8e, 0x0b90}
+  ,
+  {0x0b92, 0x0b95}
+  ,
+  {0x0b99, 0x0b9a}
+  ,
+  {0x0b9c, 0x0b9c}
+  ,
+  {0x0b9e, 0x0b9f}
+  ,
+  {0x0ba3, 0x0ba4}
+  ,
+  {0x0ba8, 0x0baa}
+  ,
+  {0x0bae, 0x0bb9}
+  ,
+  {0x0bd0, 0x0bd0}
+  ,
+  {0x0c05, 0x0c0c}
+  ,
+  {0x0c0e, 0x0c10}
+  ,
+  {0x0c12, 0x0c28}
+  ,
+  {0x0c2a, 0x0c33}
+  ,
+  {0x0c35, 0x0c39}
+  ,
+  {0x0c3d, 0x0c3d}
+  ,
+  {0x0c58, 0x0c59}
+  ,
+  {0x0c60, 0x0c61}
+  ,
+  {0x0c85, 0x0c8c}
+  ,
+  {0x0c8e, 0x0c90}
+  ,
+  {0x0c92, 0x0ca8}
+  ,
+  {0x0caa, 0x0cb3}
+  ,
+  {0x0cb5, 0x0cb9}
+  ,
+  {0x0cbd, 0x0cbd}
+  ,
+  {0x0cde, 0x0cde}
+  ,
+  {0x0ce0, 0x0ce1}
+  ,
+  {0x0d05, 0x0d0c}
+  ,
+  {0x0d0e, 0x0d10}
+  ,
+  {0x0d12, 0x0d28}
+  ,
+  {0x0d2a, 0x0d39}
+  ,
+  {0x0d3d, 0x0d3d}
+  ,
+  {0x0d60, 0x0d61}
+  ,
+  {0x0d7a, 0x0d7f}
+  ,
+  {0x0d85, 0x0d96}
+  ,
+  {0x0d9a, 0x0db1}
+  ,
+  {0x0db3, 0x0dbb}
+  ,
+  {0x0dbd, 0x0dbd}
+  ,
+  {0x0dc0, 0x0dc6}
+  ,
+  {0x0e01, 0x0e30}
+  ,
+  {0x0e32, 0x0e33}
+  ,
+  {0x0e40, 0x0e46}
+  ,
+  {0x0e81, 0x0e82}
+  ,
+  {0x0e84, 0x0e84}
+  ,
+  {0x0e87, 0x0e88}
+  ,
+  {0x0e8a, 0x0e8a}
+  ,
+  {0x0e8d, 0x0e8d}
+  ,
+  {0x0e94, 0x0e97}
+  ,
+  {0x0e99, 0x0e9f}
+  ,
+  {0x0ea1, 0x0ea3}
+  ,
+  {0x0ea5, 0x0ea5}
+  ,
+  {0x0ea7, 0x0ea7}
+  ,
+  {0x0eaa, 0x0eab}
+  ,
+  {0x0ead, 0x0eb0}
+  ,
+  {0x0eb2, 0x0eb3}
+  ,
+  {0x0ebd, 0x0ebd}
+  ,
+  {0x0ec0, 0x0ec4}
+  ,
+  {0x0ec6, 0x0ec6}
+  ,
+  {0x0edc, 0x0edd}
+  ,
+  {0x0f00, 0x0f00}
+  ,
+  {0x0f40, 0x0f47}
+  ,
+  {0x0f49, 0x0f6c}
+  ,
+  {0x0f88, 0x0f8b}
+  ,
+  {0x1000, 0x102a}
+  ,
+  {0x103f, 0x103f}
+  ,
+  {0x1050, 0x1055}
+  ,
+  {0x105a, 0x105d}
+  ,
+  {0x1061, 0x1061}
+  ,
+  {0x1065, 0x1066}
+  ,
+  {0x106e, 0x1070}
+  ,
+  {0x1075, 0x1081}
+  ,
+  {0x108e, 0x108e}
+  ,
+  {0x10a0, 0x10c5}
+  ,
+  {0x10d0, 0x10fa}
+  ,
+  {0x10fc, 0x10fc}
+  ,
+  {0x1100, 0x1159}
+  ,
+  {0x115f, 0x11a2}
+  ,
+  {0x11a8, 0x11f9}
+  ,
+  {0x1200, 0x1248}
+  ,
+  {0x124a, 0x124d}
+  ,
+  {0x1250, 0x1256}
+  ,
+  {0x1258, 0x1258}
+  ,
+  {0x125a, 0x125d}
+  ,
+  {0x1260, 0x1288}
+  ,
+  {0x128a, 0x128d}
+  ,
+  {0x1290, 0x12b0}
+  ,
+  {0x12b2, 0x12b5}
+  ,
+  {0x12b8, 0x12be}
+  ,
+  {0x12c0, 0x12c0}
+  ,
+  {0x12c2, 0x12c5}
+  ,
+  {0x12c8, 0x12d6}
+  ,
+  {0x12d8, 0x1310}
+  ,
+  {0x1312, 0x1315}
+  ,
+  {0x1318, 0x135a}
+  ,
+  {0x1380, 0x138f}
+  ,
+  {0x13a0, 0x13f4}
+  ,
+  {0x1401, 0x166c}
+  ,
+  {0x166f, 0x1676}
+  ,
+  {0x1681, 0x169a}
+  ,
+  {0x16a0, 0x16ea}
+  ,
+  {0x1700, 0x170c}
+  ,
+  {0x170e, 0x1711}
+  ,
+  {0x1720, 0x1731}
+  ,
+  {0x1740, 0x1751}
+  ,
+  {0x1760, 0x176c}
+  ,
+  {0x176e, 0x1770}
+  ,
+  {0x1780, 0x17b3}
+  ,
+  {0x17d7, 0x17d7}
+  ,
+  {0x17dc, 0x17dc}
+  ,
+  {0x1820, 0x1877}
+  ,
+  {0x1880, 0x18a8}
+  ,
+  {0x18aa, 0x18aa}
+  ,
+  {0x1900, 0x191c}
+  ,
+  {0x1950, 0x196d}
+  ,
+  {0x1970, 0x1974}
+  ,
+  {0x1980, 0x19a9}
+  ,
+  {0x19c1, 0x19c7}
+  ,
+  {0x1a00, 0x1a16}
+  ,
+  {0x1b05, 0x1b33}
+  ,
+  {0x1b45, 0x1b4b}
+  ,
+  {0x1b83, 0x1ba0}
+  ,
+  {0x1bae, 0x1baf}
+  ,
+  {0x1c00, 0x1c23}
+  ,
+  {0x1c4d, 0x1c4f}
+  ,
+  {0x1c5a, 0x1c7d}
+  ,
+  {0x1d00, 0x1dbf}
+  ,
+  {0x1e00, 0x1f15}
+  ,
+  {0x1f18, 0x1f1d}
+  ,
+  {0x1f20, 0x1f45}
+  ,
+  {0x1f48, 0x1f4d}
+  ,
+  {0x1f50, 0x1f57}
+  ,
+  {0x1f59, 0x1f59}
+  ,
+  {0x1f5b, 0x1f5b}
+  ,
+  {0x1f5d, 0x1f5d}
+  ,
+  {0x1f5f, 0x1f7d}
+  ,
+  {0x1f80, 0x1fb4}
+  ,
+  {0x1fb6, 0x1fbc}
+  ,
+  {0x1fbe, 0x1fbe}
+  ,
+  {0x1fc2, 0x1fc4}
+  ,
+  {0x1fc6, 0x1fcc}
+  ,
+  {0x1fd0, 0x1fd3}
+  ,
+  {0x1fd6, 0x1fdb}
+  ,
+  {0x1fe0, 0x1fec}
+  ,
+  {0x1ff2, 0x1ff4}
+  ,
+  {0x1ff6, 0x1ffc}
+  ,
+  {0x2071, 0x2071}
+  ,
+  {0x207f, 0x207f}
+  ,
+  {0x2090, 0x2094}
+  ,
+  {0x2102, 0x2102}
+  ,
+  {0x2107, 0x2107}
+  ,
+  {0x210a, 0x2113}
+  ,
+  {0x2115, 0x2115}
+  ,
+  {0x2119, 0x211d}
+  ,
+  {0x2124, 0x2124}
+  ,
+  {0x2126, 0x2126}
+  ,
+  {0x2128, 0x2128}
+  ,
+  {0x212a, 0x212d}
+  ,
+  {0x212f, 0x2139}
+  ,
+  {0x213c, 0x213f}
+  ,
+  {0x2145, 0x2149}
+  ,
+  {0x214e, 0x214e}
+  ,
+  {0x2183, 0x2184}
+  ,
+  {0x2c00, 0x2c2e}
+  ,
+  {0x2c30, 0x2c5e}
+  ,
+  {0x2c60, 0x2c6f}
+  ,
+  {0x2c71, 0x2c7d}
+  ,
+  {0x2c80, 0x2ce4}
+  ,
+  {0x2d00, 0x2d25}
+  ,
+  {0x2d30, 0x2d65}
+  ,
+  {0x2d6f, 0x2d6f}
+  ,
+  {0x2d80, 0x2d96}
+  ,
+  {0x2da0, 0x2da6}
+  ,
+  {0x2da8, 0x2dae}
+  ,
+  {0x2db0, 0x2db6}
+  ,
+  {0x2db8, 0x2dbe}
+  ,
+  {0x2dc0, 0x2dc6}
+  ,
+  {0x2dc8, 0x2dce}
+  ,
+  {0x2dd0, 0x2dd6}
+  ,
+  {0x2dd8, 0x2dde}
+  ,
+  {0x2e2f, 0x2e2f}
+  ,
+  {0x3005, 0x3006}
+  ,
+  {0x3031, 0x3035}
+  ,
+  {0x303b, 0x303c}
+  ,
+  {0x3041, 0x3096}
+  ,
+  {0x309d, 0x309f}
+  ,
+  {0x30a1, 0x30fa}
+  ,
+  {0x30fc, 0x30ff}
+  ,
+  {0x3105, 0x312d}
+  ,
+  {0x3131, 0x318e}
+  ,
+  {0x31a0, 0x31b7}
+  ,
+  {0x31f0, 0x31ff}
+  ,
+  {0x3400, 0x4db5}
+  ,
+  {0x4e00, 0x9fc3}
+  ,
+  {0xa000, 0xa48c}
+  ,
+  {0xa500, 0xa60c}
+  ,
+  {0xa610, 0xa61f}
+  ,
+  {0xa62a, 0xa62b}
+  ,
+  {0xa640, 0xa65f}
+  ,
+  {0xa662, 0xa66e}
+  ,
+  {0xa67f, 0xa697}
+  ,
+  {0xa717, 0xa71f}
+  ,
+  {0xa722, 0xa788}
+  ,
+  {0xa78b, 0xa78c}
+  ,
+  {0xa7fb, 0xa801}
+  ,
+  {0xa803, 0xa805}
+  ,
+  {0xa807, 0xa80a}
+  ,
+  {0xa80c, 0xa822}
+  ,
+  {0xa840, 0xa873}
+  ,
+  {0xa882, 0xa8b3}
+  ,
+  {0xa90a, 0xa925}
+  ,
+  {0xa930, 0xa946}
+  ,
+  {0xaa00, 0xaa28}
+  ,
+  {0xaa40, 0xaa42}
+  ,
+  {0xaa44, 0xaa4b}
+  ,
+  {0xac00, 0xd7a3}
+  ,
+  {0xf900, 0xfa2d}
+  ,
+  {0xfa30, 0xfa6a}
+  ,
+  {0xfa70, 0xfad9}
+  ,
+  {0xfb00, 0xfb06}
+  ,
+  {0xfb13, 0xfb17}
+  ,
+  {0xfb1d, 0xfb1d}
+  ,
+  {0xfb1f, 0xfb28}
+  ,
+  {0xfb2a, 0xfb36}
+  ,
+  {0xfb38, 0xfb3c}
+  ,
+  {0xfb3e, 0xfb3e}
+  ,
+  {0xfb40, 0xfb41}
+  ,
+  {0xfb43, 0xfb44}
+  ,
+  {0xfb46, 0xfbb1}
+  ,
+  {0xfbd3, 0xfd3d}
+  ,
+  {0xfd50, 0xfd8f}
+  ,
+  {0xfd92, 0xfdc7}
+  ,
+  {0xfdf0, 0xfdfb}
+  ,
+  {0xfe70, 0xfe74}
+  ,
+  {0xfe76, 0xfefc}
+  ,
+  {0xff21, 0xff3a}
+  ,
+  {0xff41, 0xff5a}
+  ,
+  {0xff66, 0xffbe}
+  ,
+  {0xffc2, 0xffc7}
+  ,
+  {0xffca, 0xffcf}
+  ,
+  {0xffd2, 0xffd7}
+  ,
+  {0xffda, 0xffdc}
+  ,
+  {0x10000, 0x1000b}
+  ,
+  {0x1000d, 0x10026}
+  ,
+  {0x10028, 0x1003a}
+  ,
+  {0x1003c, 0x1003d}
+  ,
+  {0x1003f, 0x1004d}
+  ,
+  {0x10050, 0x1005d}
+  ,
+  {0x10080, 0x100fa}
+  ,
+  {0x10280, 0x1029c}
+  ,
+  {0x102a0, 0x102d0}
+  ,
+  {0x10300, 0x1031e}
+  ,
+  {0x10330, 0x10340}
+  ,
+  {0x10342, 0x10349}
+  ,
+  {0x10380, 0x1039d}
+  ,
+  {0x103a0, 0x103c3}
+  ,
+  {0x103c8, 0x103cf}
+  ,
+  {0x10400, 0x1049d}
+  ,
+  {0x10800, 0x10805}
+  ,
+  {0x10808, 0x10808}
+  ,
+  {0x1080a, 0x10835}
+  ,
+  {0x10837, 0x10838}
+  ,
+  {0x1083c, 0x1083c}
+  ,
+  {0x1083f, 0x1083f}
+  ,
+  {0x10900, 0x10915}
+  ,
+  {0x10920, 0x10939}
+  ,
+  {0x10a00, 0x10a00}
+  ,
+  {0x10a10, 0x10a13}
+  ,
+  {0x10a15, 0x10a17}
+  ,
+  {0x10a19, 0x10a33}
+  ,
+  {0x12000, 0x1236e}
+  ,
+  {0x1d400, 0x1d454}
+  ,
+  {0x1d456, 0x1d49c}
+  ,
+  {0x1d49e, 0x1d49f}
+  ,
+  {0x1d4a2, 0x1d4a2}
+  ,
+  {0x1d4a5, 0x1d4a6}
+  ,
+  {0x1d4a9, 0x1d4ac}
+  ,
+  {0x1d4ae, 0x1d4b9}
+  ,
+  {0x1d4bb, 0x1d4bb}
+  ,
+  {0x1d4bd, 0x1d4c3}
+  ,
+  {0x1d4c5, 0x1d505}
+  ,
+  {0x1d507, 0x1d50a}
+  ,
+  {0x1d50d, 0x1d514}
+  ,
+  {0x1d516, 0x1d51c}
+  ,
+  {0x1d51e, 0x1d539}
+  ,
+  {0x1d53b, 0x1d53e}
+  ,
+  {0x1d540, 0x1d544}
+  ,
+  {0x1d546, 0x1d546}
+  ,
+  {0x1d54a, 0x1d550}
+  ,
+  {0x1d552, 0x1d6a5}
+  ,
+  {0x1d6a8, 0x1d6c0}
+  ,
+  {0x1d6c2, 0x1d6da}
+  ,
+  {0x1d6dc, 0x1d6fa}
+  ,
+  {0x1d6fc, 0x1d714}
+  ,
+  {0x1d716, 0x1d734}
+  ,
+  {0x1d736, 0x1d74e}
+  ,
+  {0x1d750, 0x1d76e}
+  ,
+  {0x1d770, 0x1d788}
+  ,
+  {0x1d78a, 0x1d7a8}
+  ,
+  {0x1d7aa, 0x1d7c2}
+  ,
+  {0x1d7c4, 0x1d7cb}
+  ,
+  {0x20000, 0x2a6d6}
+  ,
+  {0x2f800, 0x2fa1d}
+};
+
+scm_t_char_set cs_letter = {
+  390,
+  cs_letter_ranges
+};
+
+scm_t_char_range cs_digit_ranges[] = {
+  {0x0030, 0x0039}
+  ,
+  {0x0660, 0x0669}
+  ,
+  {0x06f0, 0x06f9}
+  ,
+  {0x07c0, 0x07c9}
+  ,
+  {0x0966, 0x096f}
+  ,
+  {0x09e6, 0x09ef}
+  ,
+  {0x0a66, 0x0a6f}
+  ,
+  {0x0ae6, 0x0aef}
+  ,
+  {0x0b66, 0x0b6f}
+  ,
+  {0x0be6, 0x0bef}
+  ,
+  {0x0c66, 0x0c6f}
+  ,
+  {0x0ce6, 0x0cef}
+  ,
+  {0x0d66, 0x0d6f}
+  ,
+  {0x0e50, 0x0e59}
+  ,
+  {0x0ed0, 0x0ed9}
+  ,
+  {0x0f20, 0x0f29}
+  ,
+  {0x1040, 0x1049}
+  ,
+  {0x1090, 0x1099}
+  ,
+  {0x17e0, 0x17e9}
+  ,
+  {0x1810, 0x1819}
+  ,
+  {0x1946, 0x194f}
+  ,
+  {0x19d0, 0x19d9}
+  ,
+  {0x1b50, 0x1b59}
+  ,
+  {0x1bb0, 0x1bb9}
+  ,
+  {0x1c40, 0x1c49}
+  ,
+  {0x1c50, 0x1c59}
+  ,
+  {0xa620, 0xa629}
+  ,
+  {0xa8d0, 0xa8d9}
+  ,
+  {0xa900, 0xa909}
+  ,
+  {0xaa50, 0xaa59}
+  ,
+  {0xff10, 0xff19}
+  ,
+  {0x104a0, 0x104a9}
+  ,
+  {0x1d7ce, 0x1d7ff}
+};
+
+scm_t_char_set cs_digit = {
+  33,
+  cs_digit_ranges
+};
+
+scm_t_char_range cs_hex_digit_ranges[] = {
+  {0x0030, 0x0039}
+  ,
+  {0x0041, 0x0046}
+  ,
+  {0x0061, 0x0066}
+};
+
+scm_t_char_set cs_hex_digit = {
+  3,
+  cs_hex_digit_ranges
+};
+
+scm_t_char_range cs_letter_plus_digit_ranges[] = {
+  {0x0030, 0x0039}
+  ,
+  {0x0041, 0x005a}
+  ,
+  {0x0061, 0x007a}
+  ,
+  {0x00aa, 0x00aa}
+  ,
+  {0x00b5, 0x00b5}
+  ,
+  {0x00ba, 0x00ba}
+  ,
+  {0x00c0, 0x00d6}
+  ,
+  {0x00d8, 0x00f6}
+  ,
+  {0x00f8, 0x02c1}
+  ,
+  {0x02c6, 0x02d1}
+  ,
+  {0x02e0, 0x02e4}
+  ,
+  {0x02ec, 0x02ec}
+  ,
+  {0x02ee, 0x02ee}
+  ,
+  {0x0370, 0x0374}
+  ,
+  {0x0376, 0x0377}
+  ,
+  {0x037a, 0x037d}
+  ,
+  {0x0386, 0x0386}
+  ,
+  {0x0388, 0x038a}
+  ,
+  {0x038c, 0x038c}
+  ,
+  {0x038e, 0x03a1}
+  ,
+  {0x03a3, 0x03f5}
+  ,
+  {0x03f7, 0x0481}
+  ,
+  {0x048a, 0x0523}
+  ,
+  {0x0531, 0x0556}
+  ,
+  {0x0559, 0x0559}
+  ,
+  {0x0561, 0x0587}
+  ,
+  {0x05d0, 0x05ea}
+  ,
+  {0x05f0, 0x05f2}
+  ,
+  {0x0621, 0x064a}
+  ,
+  {0x0660, 0x0669}
+  ,
+  {0x066e, 0x066f}
+  ,
+  {0x0671, 0x06d3}
+  ,
+  {0x06d5, 0x06d5}
+  ,
+  {0x06e5, 0x06e6}
+  ,
+  {0x06ee, 0x06fc}
+  ,
+  {0x06ff, 0x06ff}
+  ,
+  {0x0710, 0x0710}
+  ,
+  {0x0712, 0x072f}
+  ,
+  {0x074d, 0x07a5}
+  ,
+  {0x07b1, 0x07b1}
+  ,
+  {0x07c0, 0x07ea}
+  ,
+  {0x07f4, 0x07f5}
+  ,
+  {0x07fa, 0x07fa}
+  ,
+  {0x0904, 0x0939}
+  ,
+  {0x093d, 0x093d}
+  ,
+  {0x0950, 0x0950}
+  ,
+  {0x0958, 0x0961}
+  ,
+  {0x0966, 0x096f}
+  ,
+  {0x0971, 0x0972}
+  ,
+  {0x097b, 0x097f}
+  ,
+  {0x0985, 0x098c}
+  ,
+  {0x098f, 0x0990}
+  ,
+  {0x0993, 0x09a8}
+  ,
+  {0x09aa, 0x09b0}
+  ,
+  {0x09b2, 0x09b2}
+  ,
+  {0x09b6, 0x09b9}
+  ,
+  {0x09bd, 0x09bd}
+  ,
+  {0x09ce, 0x09ce}
+  ,
+  {0x09dc, 0x09dd}
+  ,
+  {0x09df, 0x09e1}
+  ,
+  {0x09e6, 0x09f1}
+  ,
+  {0x0a05, 0x0a0a}
+  ,
+  {0x0a0f, 0x0a10}
+  ,
+  {0x0a13, 0x0a28}
+  ,
+  {0x0a2a, 0x0a30}
+  ,
+  {0x0a32, 0x0a33}
+  ,
+  {0x0a35, 0x0a36}
+  ,
+  {0x0a38, 0x0a39}
+  ,
+  {0x0a59, 0x0a5c}
+  ,
+  {0x0a5e, 0x0a5e}
+  ,
+  {0x0a66, 0x0a6f}
+  ,
+  {0x0a72, 0x0a74}
+  ,
+  {0x0a85, 0x0a8d}
+  ,
+  {0x0a8f, 0x0a91}
+  ,
+  {0x0a93, 0x0aa8}
+  ,
+  {0x0aaa, 0x0ab0}
+  ,
+  {0x0ab2, 0x0ab3}
+  ,
+  {0x0ab5, 0x0ab9}
+  ,
+  {0x0abd, 0x0abd}
+  ,
+  {0x0ad0, 0x0ad0}
+  ,
+  {0x0ae0, 0x0ae1}
+  ,
+  {0x0ae6, 0x0aef}
+  ,
+  {0x0b05, 0x0b0c}
+  ,
+  {0x0b0f, 0x0b10}
+  ,
+  {0x0b13, 0x0b28}
+  ,
+  {0x0b2a, 0x0b30}
+  ,
+  {0x0b32, 0x0b33}
+  ,
+  {0x0b35, 0x0b39}
+  ,
+  {0x0b3d, 0x0b3d}
+  ,
+  {0x0b5c, 0x0b5d}
+  ,
+  {0x0b5f, 0x0b61}
+  ,
+  {0x0b66, 0x0b6f}
+  ,
+  {0x0b71, 0x0b71}
+  ,
+  {0x0b83, 0x0b83}
+  ,
+  {0x0b85, 0x0b8a}
+  ,
+  {0x0b8e, 0x0b90}
+  ,
+  {0x0b92, 0x0b95}
+  ,
+  {0x0b99, 0x0b9a}
+  ,
+  {0x0b9c, 0x0b9c}
+  ,
+  {0x0b9e, 0x0b9f}
+  ,
+  {0x0ba3, 0x0ba4}
+  ,
+  {0x0ba8, 0x0baa}
+  ,
+  {0x0bae, 0x0bb9}
+  ,
+  {0x0bd0, 0x0bd0}
+  ,
+  {0x0be6, 0x0bef}
+  ,
+  {0x0c05, 0x0c0c}
+  ,
+  {0x0c0e, 0x0c10}
+  ,
+  {0x0c12, 0x0c28}
+  ,
+  {0x0c2a, 0x0c33}
+  ,
+  {0x0c35, 0x0c39}
+  ,
+  {0x0c3d, 0x0c3d}
+  ,
+  {0x0c58, 0x0c59}
+  ,
+  {0x0c60, 0x0c61}
+  ,
+  {0x0c66, 0x0c6f}
+  ,
+  {0x0c85, 0x0c8c}
+  ,
+  {0x0c8e, 0x0c90}
+  ,
+  {0x0c92, 0x0ca8}
+  ,
+  {0x0caa, 0x0cb3}
+  ,
+  {0x0cb5, 0x0cb9}
+  ,
+  {0x0cbd, 0x0cbd}
+  ,
+  {0x0cde, 0x0cde}
+  ,
+  {0x0ce0, 0x0ce1}
+  ,
+  {0x0ce6, 0x0cef}
+  ,
+  {0x0d05, 0x0d0c}
+  ,
+  {0x0d0e, 0x0d10}
+  ,
+  {0x0d12, 0x0d28}
+  ,
+  {0x0d2a, 0x0d39}
+  ,
+  {0x0d3d, 0x0d3d}
+  ,
+  {0x0d60, 0x0d61}
+  ,
+  {0x0d66, 0x0d6f}
+  ,
+  {0x0d7a, 0x0d7f}
+  ,
+  {0x0d85, 0x0d96}
+  ,
+  {0x0d9a, 0x0db1}
+  ,
+  {0x0db3, 0x0dbb}
+  ,
+  {0x0dbd, 0x0dbd}
+  ,
+  {0x0dc0, 0x0dc6}
+  ,
+  {0x0e01, 0x0e30}
+  ,
+  {0x0e32, 0x0e33}
+  ,
+  {0x0e40, 0x0e46}
+  ,
+  {0x0e50, 0x0e59}
+  ,
+  {0x0e81, 0x0e82}
+  ,
+  {0x0e84, 0x0e84}
+  ,
+  {0x0e87, 0x0e88}
+  ,
+  {0x0e8a, 0x0e8a}
+  ,
+  {0x0e8d, 0x0e8d}
+  ,
+  {0x0e94, 0x0e97}
+  ,
+  {0x0e99, 0x0e9f}
+  ,
+  {0x0ea1, 0x0ea3}
+  ,
+  {0x0ea5, 0x0ea5}
+  ,
+  {0x0ea7, 0x0ea7}
+  ,
+  {0x0eaa, 0x0eab}
+  ,
+  {0x0ead, 0x0eb0}
+  ,
+  {0x0eb2, 0x0eb3}
+  ,
+  {0x0ebd, 0x0ebd}
+  ,
+  {0x0ec0, 0x0ec4}
+  ,
+  {0x0ec6, 0x0ec6}
+  ,
+  {0x0ed0, 0x0ed9}
+  ,
+  {0x0edc, 0x0edd}
+  ,
+  {0x0f00, 0x0f00}
+  ,
+  {0x0f20, 0x0f29}
+  ,
+  {0x0f40, 0x0f47}
+  ,
+  {0x0f49, 0x0f6c}
+  ,
+  {0x0f88, 0x0f8b}
+  ,
+  {0x1000, 0x102a}
+  ,
+  {0x103f, 0x1049}
+  ,
+  {0x1050, 0x1055}
+  ,
+  {0x105a, 0x105d}
+  ,
+  {0x1061, 0x1061}
+  ,
+  {0x1065, 0x1066}
+  ,
+  {0x106e, 0x1070}
+  ,
+  {0x1075, 0x1081}
+  ,
+  {0x108e, 0x108e}
+  ,
+  {0x1090, 0x1099}
+  ,
+  {0x10a0, 0x10c5}
+  ,
+  {0x10d0, 0x10fa}
+  ,
+  {0x10fc, 0x10fc}
+  ,
+  {0x1100, 0x1159}
+  ,
+  {0x115f, 0x11a2}
+  ,
+  {0x11a8, 0x11f9}
+  ,
+  {0x1200, 0x1248}
+  ,
+  {0x124a, 0x124d}
+  ,
+  {0x1250, 0x1256}
+  ,
+  {0x1258, 0x1258}
+  ,
+  {0x125a, 0x125d}
+  ,
+  {0x1260, 0x1288}
+  ,
+  {0x128a, 0x128d}
+  ,
+  {0x1290, 0x12b0}
+  ,
+  {0x12b2, 0x12b5}
+  ,
+  {0x12b8, 0x12be}
+  ,
+  {0x12c0, 0x12c0}
+  ,
+  {0x12c2, 0x12c5}
+  ,
+  {0x12c8, 0x12d6}
+  ,
+  {0x12d8, 0x1310}
+  ,
+  {0x1312, 0x1315}
+  ,
+  {0x1318, 0x135a}
+  ,
+  {0x1380, 0x138f}
+  ,
+  {0x13a0, 0x13f4}
+  ,
+  {0x1401, 0x166c}
+  ,
+  {0x166f, 0x1676}
+  ,
+  {0x1681, 0x169a}
+  ,
+  {0x16a0, 0x16ea}
+  ,
+  {0x1700, 0x170c}
+  ,
+  {0x170e, 0x1711}
+  ,
+  {0x1720, 0x1731}
+  ,
+  {0x1740, 0x1751}
+  ,
+  {0x1760, 0x176c}
+  ,
+  {0x176e, 0x1770}
+  ,
+  {0x1780, 0x17b3}
+  ,
+  {0x17d7, 0x17d7}
+  ,
+  {0x17dc, 0x17dc}
+  ,
+  {0x17e0, 0x17e9}
+  ,
+  {0x1810, 0x1819}
+  ,
+  {0x1820, 0x1877}
+  ,
+  {0x1880, 0x18a8}
+  ,
+  {0x18aa, 0x18aa}
+  ,
+  {0x1900, 0x191c}
+  ,
+  {0x1946, 0x196d}
+  ,
+  {0x1970, 0x1974}
+  ,
+  {0x1980, 0x19a9}
+  ,
+  {0x19c1, 0x19c7}
+  ,
+  {0x19d0, 0x19d9}
+  ,
+  {0x1a00, 0x1a16}
+  ,
+  {0x1b05, 0x1b33}
+  ,
+  {0x1b45, 0x1b4b}
+  ,
+  {0x1b50, 0x1b59}
+  ,
+  {0x1b83, 0x1ba0}
+  ,
+  {0x1bae, 0x1bb9}
+  ,
+  {0x1c00, 0x1c23}
+  ,
+  {0x1c40, 0x1c49}
+  ,
+  {0x1c4d, 0x1c7d}
+  ,
+  {0x1d00, 0x1dbf}
+  ,
+  {0x1e00, 0x1f15}
+  ,
+  {0x1f18, 0x1f1d}
+  ,
+  {0x1f20, 0x1f45}
+  ,
+  {0x1f48, 0x1f4d}
+  ,
+  {0x1f50, 0x1f57}
+  ,
+  {0x1f59, 0x1f59}
+  ,
+  {0x1f5b, 0x1f5b}
+  ,
+  {0x1f5d, 0x1f5d}
+  ,
+  {0x1f5f, 0x1f7d}
+  ,
+  {0x1f80, 0x1fb4}
+  ,
+  {0x1fb6, 0x1fbc}
+  ,
+  {0x1fbe, 0x1fbe}
+  ,
+  {0x1fc2, 0x1fc4}
+  ,
+  {0x1fc6, 0x1fcc}
+  ,
+  {0x1fd0, 0x1fd3}
+  ,
+  {0x1fd6, 0x1fdb}
+  ,
+  {0x1fe0, 0x1fec}
+  ,
+  {0x1ff2, 0x1ff4}
+  ,
+  {0x1ff6, 0x1ffc}
+  ,
+  {0x2071, 0x2071}
+  ,
+  {0x207f, 0x207f}
+  ,
+  {0x2090, 0x2094}
+  ,
+  {0x2102, 0x2102}
+  ,
+  {0x2107, 0x2107}
+  ,
+  {0x210a, 0x2113}
+  ,
+  {0x2115, 0x2115}
+  ,
+  {0x2119, 0x211d}
+  ,
+  {0x2124, 0x2124}
+  ,
+  {0x2126, 0x2126}
+  ,
+  {0x2128, 0x2128}
+  ,
+  {0x212a, 0x212d}
+  ,
+  {0x212f, 0x2139}
+  ,
+  {0x213c, 0x213f}
+  ,
+  {0x2145, 0x2149}
+  ,
+  {0x214e, 0x214e}
+  ,
+  {0x2183, 0x2184}
+  ,
+  {0x2c00, 0x2c2e}
+  ,
+  {0x2c30, 0x2c5e}
+  ,
+  {0x2c60, 0x2c6f}
+  ,
+  {0x2c71, 0x2c7d}
+  ,
+  {0x2c80, 0x2ce4}
+  ,
+  {0x2d00, 0x2d25}
+  ,
+  {0x2d30, 0x2d65}
+  ,
+  {0x2d6f, 0x2d6f}
+  ,
+  {0x2d80, 0x2d96}
+  ,
+  {0x2da0, 0x2da6}
+  ,
+  {0x2da8, 0x2dae}
+  ,
+  {0x2db0, 0x2db6}
+  ,
+  {0x2db8, 0x2dbe}
+  ,
+  {0x2dc0, 0x2dc6}
+  ,
+  {0x2dc8, 0x2dce}
+  ,
+  {0x2dd0, 0x2dd6}
+  ,
+  {0x2dd8, 0x2dde}
+  ,
+  {0x2e2f, 0x2e2f}
+  ,
+  {0x3005, 0x3006}
+  ,
+  {0x3031, 0x3035}
+  ,
+  {0x303b, 0x303c}
+  ,
+  {0x3041, 0x3096}
+  ,
+  {0x309d, 0x309f}
+  ,
+  {0x30a1, 0x30fa}
+  ,
+  {0x30fc, 0x30ff}
+  ,
+  {0x3105, 0x312d}
+  ,
+  {0x3131, 0x318e}
+  ,
+  {0x31a0, 0x31b7}
+  ,
+  {0x31f0, 0x31ff}
+  ,
+  {0x3400, 0x4db5}
+  ,
+  {0x4e00, 0x9fc3}
+  ,
+  {0xa000, 0xa48c}
+  ,
+  {0xa500, 0xa60c}
+  ,
+  {0xa610, 0xa62b}
+  ,
+  {0xa640, 0xa65f}
+  ,
+  {0xa662, 0xa66e}
+  ,
+  {0xa67f, 0xa697}
+  ,
+  {0xa717, 0xa71f}
+  ,
+  {0xa722, 0xa788}
+  ,
+  {0xa78b, 0xa78c}
+  ,
+  {0xa7fb, 0xa801}
+  ,
+  {0xa803, 0xa805}
+  ,
+  {0xa807, 0xa80a}
+  ,
+  {0xa80c, 0xa822}
+  ,
+  {0xa840, 0xa873}
+  ,
+  {0xa882, 0xa8b3}
+  ,
+  {0xa8d0, 0xa8d9}
+  ,
+  {0xa900, 0xa925}
+  ,
+  {0xa930, 0xa946}
+  ,
+  {0xaa00, 0xaa28}
+  ,
+  {0xaa40, 0xaa42}
+  ,
+  {0xaa44, 0xaa4b}
+  ,
+  {0xaa50, 0xaa59}
+  ,
+  {0xac00, 0xd7a3}
+  ,
+  {0xf900, 0xfa2d}
+  ,
+  {0xfa30, 0xfa6a}
+  ,
+  {0xfa70, 0xfad9}
+  ,
+  {0xfb00, 0xfb06}
+  ,
+  {0xfb13, 0xfb17}
+  ,
+  {0xfb1d, 0xfb1d}
+  ,
+  {0xfb1f, 0xfb28}
+  ,
+  {0xfb2a, 0xfb36}
+  ,
+  {0xfb38, 0xfb3c}
+  ,
+  {0xfb3e, 0xfb3e}
+  ,
+  {0xfb40, 0xfb41}
+  ,
+  {0xfb43, 0xfb44}
+  ,
+  {0xfb46, 0xfbb1}
+  ,
+  {0xfbd3, 0xfd3d}
+  ,
+  {0xfd50, 0xfd8f}
+  ,
+  {0xfd92, 0xfdc7}
+  ,
+  {0xfdf0, 0xfdfb}
+  ,
+  {0xfe70, 0xfe74}
+  ,
+  {0xfe76, 0xfefc}
+  ,
+  {0xff10, 0xff19}
+  ,
+  {0xff21, 0xff3a}
+  ,
+  {0xff41, 0xff5a}
+  ,
+  {0xff66, 0xffbe}
+  ,
+  {0xffc2, 0xffc7}
+  ,
+  {0xffca, 0xffcf}
+  ,
+  {0xffd2, 0xffd7}
+  ,
+  {0xffda, 0xffdc}
+  ,
+  {0x10000, 0x1000b}
+  ,
+  {0x1000d, 0x10026}
+  ,
+  {0x10028, 0x1003a}
+  ,
+  {0x1003c, 0x1003d}
+  ,
+  {0x1003f, 0x1004d}
+  ,
+  {0x10050, 0x1005d}
+  ,
+  {0x10080, 0x100fa}
+  ,
+  {0x10280, 0x1029c}
+  ,
+  {0x102a0, 0x102d0}
+  ,
+  {0x10300, 0x1031e}
+  ,
+  {0x10330, 0x10340}
+  ,
+  {0x10342, 0x10349}
+  ,
+  {0x10380, 0x1039d}
+  ,
+  {0x103a0, 0x103c3}
+  ,
+  {0x103c8, 0x103cf}
+  ,
+  {0x10400, 0x1049d}
+  ,
+  {0x104a0, 0x104a9}
+  ,
+  {0x10800, 0x10805}
+  ,
+  {0x10808, 0x10808}
+  ,
+  {0x1080a, 0x10835}
+  ,
+  {0x10837, 0x10838}
+  ,
+  {0x1083c, 0x1083c}
+  ,
+  {0x1083f, 0x1083f}
+  ,
+  {0x10900, 0x10915}
+  ,
+  {0x10920, 0x10939}
+  ,
+  {0x10a00, 0x10a00}
+  ,
+  {0x10a10, 0x10a13}
+  ,
+  {0x10a15, 0x10a17}
+  ,
+  {0x10a19, 0x10a33}
+  ,
+  {0x12000, 0x1236e}
+  ,
+  {0x1d400, 0x1d454}
+  ,
+  {0x1d456, 0x1d49c}
+  ,
+  {0x1d49e, 0x1d49f}
+  ,
+  {0x1d4a2, 0x1d4a2}
+  ,
+  {0x1d4a5, 0x1d4a6}
+  ,
+  {0x1d4a9, 0x1d4ac}
+  ,
+  {0x1d4ae, 0x1d4b9}
+  ,
+  {0x1d4bb, 0x1d4bb}
+  ,
+  {0x1d4bd, 0x1d4c3}
+  ,
+  {0x1d4c5, 0x1d505}
+  ,
+  {0x1d507, 0x1d50a}
+  ,
+  {0x1d50d, 0x1d514}
+  ,
+  {0x1d516, 0x1d51c}
+  ,
+  {0x1d51e, 0x1d539}
+  ,
+  {0x1d53b, 0x1d53e}
+  ,
+  {0x1d540, 0x1d544}
+  ,
+  {0x1d546, 0x1d546}
+  ,
+  {0x1d54a, 0x1d550}
+  ,
+  {0x1d552, 0x1d6a5}
+  ,
+  {0x1d6a8, 0x1d6c0}
+  ,
+  {0x1d6c2, 0x1d6da}
+  ,
+  {0x1d6dc, 0x1d6fa}
+  ,
+  {0x1d6fc, 0x1d714}
+  ,
+  {0x1d716, 0x1d734}
+  ,
+  {0x1d736, 0x1d74e}
+  ,
+  {0x1d750, 0x1d76e}
+  ,
+  {0x1d770, 0x1d788}
+  ,
+  {0x1d78a, 0x1d7a8}
+  ,
+  {0x1d7aa, 0x1d7c2}
+  ,
+  {0x1d7c4, 0x1d7cb}
+  ,
+  {0x1d7ce, 0x1d7ff}
+  ,
+  {0x20000, 0x2a6d6}
+  ,
+  {0x2f800, 0x2fa1d}
+};
+
+scm_t_char_set cs_letter_plus_digit = {
+  411,
+  cs_letter_plus_digit_ranges
+};
+
+scm_t_char_range cs_graphic_ranges[] = {
+  {0x0021, 0x007e}
+  ,
+  {0x00a1, 0x00ac}
+  ,
+  {0x00ae, 0x0377}
+  ,
+  {0x037a, 0x037e}
+  ,
+  {0x0384, 0x038a}
+  ,
+  {0x038c, 0x038c}
+  ,
+  {0x038e, 0x03a1}
+  ,
+  {0x03a3, 0x0523}
+  ,
+  {0x0531, 0x0556}
+  ,
+  {0x0559, 0x055f}
+  ,
+  {0x0561, 0x0587}
+  ,
+  {0x0589, 0x058a}
+  ,
+  {0x0591, 0x05c7}
+  ,
+  {0x05d0, 0x05ea}
+  ,
+  {0x05f0, 0x05f4}
+  ,
+  {0x0606, 0x061b}
+  ,
+  {0x061e, 0x061f}
+  ,
+  {0x0621, 0x065e}
+  ,
+  {0x0660, 0x06dc}
+  ,
+  {0x06de, 0x070d}
+  ,
+  {0x0710, 0x074a}
+  ,
+  {0x074d, 0x07b1}
+  ,
+  {0x07c0, 0x07fa}
+  ,
+  {0x0901, 0x0939}
+  ,
+  {0x093c, 0x094d}
+  ,
+  {0x0950, 0x0954}
+  ,
+  {0x0958, 0x0972}
+  ,
+  {0x097b, 0x097f}
+  ,
+  {0x0981, 0x0983}
+  ,
+  {0x0985, 0x098c}
+  ,
+  {0x098f, 0x0990}
+  ,
+  {0x0993, 0x09a8}
+  ,
+  {0x09aa, 0x09b0}
+  ,
+  {0x09b2, 0x09b2}
+  ,
+  {0x09b6, 0x09b9}
+  ,
+  {0x09bc, 0x09c4}
+  ,
+  {0x09c7, 0x09c8}
+  ,
+  {0x09cb, 0x09ce}
+  ,
+  {0x09d7, 0x09d7}
+  ,
+  {0x09dc, 0x09dd}
+  ,
+  {0x09df, 0x09e3}
+  ,
+  {0x09e6, 0x09fa}
+  ,
+  {0x0a01, 0x0a03}
+  ,
+  {0x0a05, 0x0a0a}
+  ,
+  {0x0a0f, 0x0a10}
+  ,
+  {0x0a13, 0x0a28}
+  ,
+  {0x0a2a, 0x0a30}
+  ,
+  {0x0a32, 0x0a33}
+  ,
+  {0x0a35, 0x0a36}
+  ,
+  {0x0a38, 0x0a39}
+  ,
+  {0x0a3c, 0x0a3c}
+  ,
+  {0x0a3e, 0x0a42}
+  ,
+  {0x0a47, 0x0a48}
+  ,
+  {0x0a4b, 0x0a4d}
+  ,
+  {0x0a51, 0x0a51}
+  ,
+  {0x0a59, 0x0a5c}
+  ,
+  {0x0a5e, 0x0a5e}
+  ,
+  {0x0a66, 0x0a75}
+  ,
+  {0x0a81, 0x0a83}
+  ,
+  {0x0a85, 0x0a8d}
+  ,
+  {0x0a8f, 0x0a91}
+  ,
+  {0x0a93, 0x0aa8}
+  ,
+  {0x0aaa, 0x0ab0}
+  ,
+  {0x0ab2, 0x0ab3}
+  ,
+  {0x0ab5, 0x0ab9}
+  ,
+  {0x0abc, 0x0ac5}
+  ,
+  {0x0ac7, 0x0ac9}
+  ,
+  {0x0acb, 0x0acd}
+  ,
+  {0x0ad0, 0x0ad0}
+  ,
+  {0x0ae0, 0x0ae3}
+  ,
+  {0x0ae6, 0x0aef}
+  ,
+  {0x0af1, 0x0af1}
+  ,
+  {0x0b01, 0x0b03}
+  ,
+  {0x0b05, 0x0b0c}
+  ,
+  {0x0b0f, 0x0b10}
+  ,
+  {0x0b13, 0x0b28}
+  ,
+  {0x0b2a, 0x0b30}
+  ,
+  {0x0b32, 0x0b33}
+  ,
+  {0x0b35, 0x0b39}
+  ,
+  {0x0b3c, 0x0b44}
+  ,
+  {0x0b47, 0x0b48}
+  ,
+  {0x0b4b, 0x0b4d}
+  ,
+  {0x0b56, 0x0b57}
+  ,
+  {0x0b5c, 0x0b5d}
+  ,
+  {0x0b5f, 0x0b63}
+  ,
+  {0x0b66, 0x0b71}
+  ,
+  {0x0b82, 0x0b83}
+  ,
+  {0x0b85, 0x0b8a}
+  ,
+  {0x0b8e, 0x0b90}
+  ,
+  {0x0b92, 0x0b95}
+  ,
+  {0x0b99, 0x0b9a}
+  ,
+  {0x0b9c, 0x0b9c}
+  ,
+  {0x0b9e, 0x0b9f}
+  ,
+  {0x0ba3, 0x0ba4}
+  ,
+  {0x0ba8, 0x0baa}
+  ,
+  {0x0bae, 0x0bb9}
+  ,
+  {0x0bbe, 0x0bc2}
+  ,
+  {0x0bc6, 0x0bc8}
+  ,
+  {0x0bca, 0x0bcd}
+  ,
+  {0x0bd0, 0x0bd0}
+  ,
+  {0x0bd7, 0x0bd7}
+  ,
+  {0x0be6, 0x0bfa}
+  ,
+  {0x0c01, 0x0c03}
+  ,
+  {0x0c05, 0x0c0c}
+  ,
+  {0x0c0e, 0x0c10}
+  ,
+  {0x0c12, 0x0c28}
+  ,
+  {0x0c2a, 0x0c33}
+  ,
+  {0x0c35, 0x0c39}
+  ,
+  {0x0c3d, 0x0c44}
+  ,
+  {0x0c46, 0x0c48}
+  ,
+  {0x0c4a, 0x0c4d}
+  ,
+  {0x0c55, 0x0c56}
+  ,
+  {0x0c58, 0x0c59}
+  ,
+  {0x0c60, 0x0c63}
+  ,
+  {0x0c66, 0x0c6f}
+  ,
+  {0x0c78, 0x0c7f}
+  ,
+  {0x0c82, 0x0c83}
+  ,
+  {0x0c85, 0x0c8c}
+  ,
+  {0x0c8e, 0x0c90}
+  ,
+  {0x0c92, 0x0ca8}
+  ,
+  {0x0caa, 0x0cb3}
+  ,
+  {0x0cb5, 0x0cb9}
+  ,
+  {0x0cbc, 0x0cc4}
+  ,
+  {0x0cc6, 0x0cc8}
+  ,
+  {0x0cca, 0x0ccd}
+  ,
+  {0x0cd5, 0x0cd6}
+  ,
+  {0x0cde, 0x0cde}
+  ,
+  {0x0ce0, 0x0ce3}
+  ,
+  {0x0ce6, 0x0cef}
+  ,
+  {0x0cf1, 0x0cf2}
+  ,
+  {0x0d02, 0x0d03}
+  ,
+  {0x0d05, 0x0d0c}
+  ,
+  {0x0d0e, 0x0d10}
+  ,
+  {0x0d12, 0x0d28}
+  ,
+  {0x0d2a, 0x0d39}
+  ,
+  {0x0d3d, 0x0d44}
+  ,
+  {0x0d46, 0x0d48}
+  ,
+  {0x0d4a, 0x0d4d}
+  ,
+  {0x0d57, 0x0d57}
+  ,
+  {0x0d60, 0x0d63}
+  ,
+  {0x0d66, 0x0d75}
+  ,
+  {0x0d79, 0x0d7f}
+  ,
+  {0x0d82, 0x0d83}
+  ,
+  {0x0d85, 0x0d96}
+  ,
+  {0x0d9a, 0x0db1}
+  ,
+  {0x0db3, 0x0dbb}
+  ,
+  {0x0dbd, 0x0dbd}
+  ,
+  {0x0dc0, 0x0dc6}
+  ,
+  {0x0dca, 0x0dca}
+  ,
+  {0x0dcf, 0x0dd4}
+  ,
+  {0x0dd6, 0x0dd6}
+  ,
+  {0x0dd8, 0x0ddf}
+  ,
+  {0x0df2, 0x0df4}
+  ,
+  {0x0e01, 0x0e3a}
+  ,
+  {0x0e3f, 0x0e5b}
+  ,
+  {0x0e81, 0x0e82}
+  ,
+  {0x0e84, 0x0e84}
+  ,
+  {0x0e87, 0x0e88}
+  ,
+  {0x0e8a, 0x0e8a}
+  ,
+  {0x0e8d, 0x0e8d}
+  ,
+  {0x0e94, 0x0e97}
+  ,
+  {0x0e99, 0x0e9f}
+  ,
+  {0x0ea1, 0x0ea3}
+  ,
+  {0x0ea5, 0x0ea5}
+  ,
+  {0x0ea7, 0x0ea7}
+  ,
+  {0x0eaa, 0x0eab}
+  ,
+  {0x0ead, 0x0eb9}
+  ,
+  {0x0ebb, 0x0ebd}
+  ,
+  {0x0ec0, 0x0ec4}
+  ,
+  {0x0ec6, 0x0ec6}
+  ,
+  {0x0ec8, 0x0ecd}
+  ,
+  {0x0ed0, 0x0ed9}
+  ,
+  {0x0edc, 0x0edd}
+  ,
+  {0x0f00, 0x0f47}
+  ,
+  {0x0f49, 0x0f6c}
+  ,
+  {0x0f71, 0x0f8b}
+  ,
+  {0x0f90, 0x0f97}
+  ,
+  {0x0f99, 0x0fbc}
+  ,
+  {0x0fbe, 0x0fcc}
+  ,
+  {0x0fce, 0x0fd4}
+  ,
+  {0x1000, 0x1099}
+  ,
+  {0x109e, 0x10c5}
+  ,
+  {0x10d0, 0x10fc}
+  ,
+  {0x1100, 0x1159}
+  ,
+  {0x115f, 0x11a2}
+  ,
+  {0x11a8, 0x11f9}
+  ,
+  {0x1200, 0x1248}
+  ,
+  {0x124a, 0x124d}
+  ,
+  {0x1250, 0x1256}
+  ,
+  {0x1258, 0x1258}
+  ,
+  {0x125a, 0x125d}
+  ,
+  {0x1260, 0x1288}
+  ,
+  {0x128a, 0x128d}
+  ,
+  {0x1290, 0x12b0}
+  ,
+  {0x12b2, 0x12b5}
+  ,
+  {0x12b8, 0x12be}
+  ,
+  {0x12c0, 0x12c0}
+  ,
+  {0x12c2, 0x12c5}
+  ,
+  {0x12c8, 0x12d6}
+  ,
+  {0x12d8, 0x1310}
+  ,
+  {0x1312, 0x1315}
+  ,
+  {0x1318, 0x135a}
+  ,
+  {0x135f, 0x137c}
+  ,
+  {0x1380, 0x1399}
+  ,
+  {0x13a0, 0x13f4}
+  ,
+  {0x1401, 0x1676}
+  ,
+  {0x1681, 0x169c}
+  ,
+  {0x16a0, 0x16f0}
+  ,
+  {0x1700, 0x170c}
+  ,
+  {0x170e, 0x1714}
+  ,
+  {0x1720, 0x1736}
+  ,
+  {0x1740, 0x1753}
+  ,
+  {0x1760, 0x176c}
+  ,
+  {0x176e, 0x1770}
+  ,
+  {0x1772, 0x1773}
+  ,
+  {0x1780, 0x17b3}
+  ,
+  {0x17b6, 0x17dd}
+  ,
+  {0x17e0, 0x17e9}
+  ,
+  {0x17f0, 0x17f9}
+  ,
+  {0x1800, 0x180d}
+  ,
+  {0x1810, 0x1819}
+  ,
+  {0x1820, 0x1877}
+  ,
+  {0x1880, 0x18aa}
+  ,
+  {0x1900, 0x191c}
+  ,
+  {0x1920, 0x192b}
+  ,
+  {0x1930, 0x193b}
+  ,
+  {0x1940, 0x1940}
+  ,
+  {0x1944, 0x196d}
+  ,
+  {0x1970, 0x1974}
+  ,
+  {0x1980, 0x19a9}
+  ,
+  {0x19b0, 0x19c9}
+  ,
+  {0x19d0, 0x19d9}
+  ,
+  {0x19de, 0x1a1b}
+  ,
+  {0x1a1e, 0x1a1f}
+  ,
+  {0x1b00, 0x1b4b}
+  ,
+  {0x1b50, 0x1b7c}
+  ,
+  {0x1b80, 0x1baa}
+  ,
+  {0x1bae, 0x1bb9}
+  ,
+  {0x1c00, 0x1c37}
+  ,
+  {0x1c3b, 0x1c49}
+  ,
+  {0x1c4d, 0x1c7f}
+  ,
+  {0x1d00, 0x1de6}
+  ,
+  {0x1dfe, 0x1f15}
+  ,
+  {0x1f18, 0x1f1d}
+  ,
+  {0x1f20, 0x1f45}
+  ,
+  {0x1f48, 0x1f4d}
+  ,
+  {0x1f50, 0x1f57}
+  ,
+  {0x1f59, 0x1f59}
+  ,
+  {0x1f5b, 0x1f5b}
+  ,
+  {0x1f5d, 0x1f5d}
+  ,
+  {0x1f5f, 0x1f7d}
+  ,
+  {0x1f80, 0x1fb4}
+  ,
+  {0x1fb6, 0x1fc4}
+  ,
+  {0x1fc6, 0x1fd3}
+  ,
+  {0x1fd6, 0x1fdb}
+  ,
+  {0x1fdd, 0x1fef}
+  ,
+  {0x1ff2, 0x1ff4}
+  ,
+  {0x1ff6, 0x1ffe}
+  ,
+  {0x2010, 0x2027}
+  ,
+  {0x2030, 0x205e}
+  ,
+  {0x2070, 0x2071}
+  ,
+  {0x2074, 0x208e}
+  ,
+  {0x2090, 0x2094}
+  ,
+  {0x20a0, 0x20b5}
+  ,
+  {0x20d0, 0x20f0}
+  ,
+  {0x2100, 0x214f}
+  ,
+  {0x2153, 0x2188}
+  ,
+  {0x2190, 0x23e7}
+  ,
+  {0x2400, 0x2426}
+  ,
+  {0x2440, 0x244a}
+  ,
+  {0x2460, 0x269d}
+  ,
+  {0x26a0, 0x26bc}
+  ,
+  {0x26c0, 0x26c3}
+  ,
+  {0x2701, 0x2704}
+  ,
+  {0x2706, 0x2709}
+  ,
+  {0x270c, 0x2727}
+  ,
+  {0x2729, 0x274b}
+  ,
+  {0x274d, 0x274d}
+  ,
+  {0x274f, 0x2752}
+  ,
+  {0x2756, 0x2756}
+  ,
+  {0x2758, 0x275e}
+  ,
+  {0x2761, 0x2794}
+  ,
+  {0x2798, 0x27af}
+  ,
+  {0x27b1, 0x27be}
+  ,
+  {0x27c0, 0x27ca}
+  ,
+  {0x27cc, 0x27cc}
+  ,
+  {0x27d0, 0x2b4c}
+  ,
+  {0x2b50, 0x2b54}
+  ,
+  {0x2c00, 0x2c2e}
+  ,
+  {0x2c30, 0x2c5e}
+  ,
+  {0x2c60, 0x2c6f}
+  ,
+  {0x2c71, 0x2c7d}
+  ,
+  {0x2c80, 0x2cea}
+  ,
+  {0x2cf9, 0x2d25}
+  ,
+  {0x2d30, 0x2d65}
+  ,
+  {0x2d6f, 0x2d6f}
+  ,
+  {0x2d80, 0x2d96}
+  ,
+  {0x2da0, 0x2da6}
+  ,
+  {0x2da8, 0x2dae}
+  ,
+  {0x2db0, 0x2db6}
+  ,
+  {0x2db8, 0x2dbe}
+  ,
+  {0x2dc0, 0x2dc6}
+  ,
+  {0x2dc8, 0x2dce}
+  ,
+  {0x2dd0, 0x2dd6}
+  ,
+  {0x2dd8, 0x2dde}
+  ,
+  {0x2de0, 0x2e30}
+  ,
+  {0x2e80, 0x2e99}
+  ,
+  {0x2e9b, 0x2ef3}
+  ,
+  {0x2f00, 0x2fd5}
+  ,
+  {0x2ff0, 0x2ffb}
+  ,
+  {0x3001, 0x303f}
+  ,
+  {0x3041, 0x3096}
+  ,
+  {0x3099, 0x30ff}
+  ,
+  {0x3105, 0x312d}
+  ,
+  {0x3131, 0x318e}
+  ,
+  {0x3190, 0x31b7}
+  ,
+  {0x31c0, 0x31e3}
+  ,
+  {0x31f0, 0x321e}
+  ,
+  {0x3220, 0x3243}
+  ,
+  {0x3250, 0x32fe}
+  ,
+  {0x3300, 0x4db5}
+  ,
+  {0x4dc0, 0x9fc3}
+  ,
+  {0xa000, 0xa48c}
+  ,
+  {0xa490, 0xa4c6}
+  ,
+  {0xa500, 0xa62b}
+  ,
+  {0xa640, 0xa65f}
+  ,
+  {0xa662, 0xa673}
+  ,
+  {0xa67c, 0xa697}
+  ,
+  {0xa700, 0xa78c}
+  ,
+  {0xa7fb, 0xa82b}
+  ,
+  {0xa840, 0xa877}
+  ,
+  {0xa880, 0xa8c4}
+  ,
+  {0xa8ce, 0xa8d9}
+  ,
+  {0xa900, 0xa953}
+  ,
+  {0xa95f, 0xa95f}
+  ,
+  {0xaa00, 0xaa36}
+  ,
+  {0xaa40, 0xaa4d}
+  ,
+  {0xaa50, 0xaa59}
+  ,
+  {0xaa5c, 0xaa5f}
+  ,
+  {0xac00, 0xd7a3}
+  ,
+  {0xf900, 0xfa2d}
+  ,
+  {0xfa30, 0xfa6a}
+  ,
+  {0xfa70, 0xfad9}
+  ,
+  {0xfb00, 0xfb06}
+  ,
+  {0xfb13, 0xfb17}
+  ,
+  {0xfb1d, 0xfb36}
+  ,
+  {0xfb38, 0xfb3c}
+  ,
+  {0xfb3e, 0xfb3e}
+  ,
+  {0xfb40, 0xfb41}
+  ,
+  {0xfb43, 0xfb44}
+  ,
+  {0xfb46, 0xfbb1}
+  ,
+  {0xfbd3, 0xfd3f}
+  ,
+  {0xfd50, 0xfd8f}
+  ,
+  {0xfd92, 0xfdc7}
+  ,
+  {0xfdf0, 0xfdfd}
+  ,
+  {0xfe00, 0xfe19}
+  ,
+  {0xfe20, 0xfe26}
+  ,
+  {0xfe30, 0xfe52}
+  ,
+  {0xfe54, 0xfe66}
+  ,
+  {0xfe68, 0xfe6b}
+  ,
+  {0xfe70, 0xfe74}
+  ,
+  {0xfe76, 0xfefc}
+  ,
+  {0xff01, 0xffbe}
+  ,
+  {0xffc2, 0xffc7}
+  ,
+  {0xffca, 0xffcf}
+  ,
+  {0xffd2, 0xffd7}
+  ,
+  {0xffda, 0xffdc}
+  ,
+  {0xffe0, 0xffe6}
+  ,
+  {0xffe8, 0xffee}
+  ,
+  {0xfffc, 0xfffd}
+  ,
+  {0x10000, 0x1000b}
+  ,
+  {0x1000d, 0x10026}
+  ,
+  {0x10028, 0x1003a}
+  ,
+  {0x1003c, 0x1003d}
+  ,
+  {0x1003f, 0x1004d}
+  ,
+  {0x10050, 0x1005d}
+  ,
+  {0x10080, 0x100fa}
+  ,
+  {0x10100, 0x10102}
+  ,
+  {0x10107, 0x10133}
+  ,
+  {0x10137, 0x1018a}
+  ,
+  {0x10190, 0x1019b}
+  ,
+  {0x101d0, 0x101fd}
+  ,
+  {0x10280, 0x1029c}
+  ,
+  {0x102a0, 0x102d0}
+  ,
+  {0x10300, 0x1031e}
+  ,
+  {0x10320, 0x10323}
+  ,
+  {0x10330, 0x1034a}
+  ,
+  {0x10380, 0x1039d}
+  ,
+  {0x1039f, 0x103c3}
+  ,
+  {0x103c8, 0x103d5}
+  ,
+  {0x10400, 0x1049d}
+  ,
+  {0x104a0, 0x104a9}
+  ,
+  {0x10800, 0x10805}
+  ,
+  {0x10808, 0x10808}
+  ,
+  {0x1080a, 0x10835}
+  ,
+  {0x10837, 0x10838}
+  ,
+  {0x1083c, 0x1083c}
+  ,
+  {0x1083f, 0x1083f}
+  ,
+  {0x10900, 0x10919}
+  ,
+  {0x1091f, 0x10939}
+  ,
+  {0x1093f, 0x1093f}
+  ,
+  {0x10a00, 0x10a03}
+  ,
+  {0x10a05, 0x10a06}
+  ,
+  {0x10a0c, 0x10a13}
+  ,
+  {0x10a15, 0x10a17}
+  ,
+  {0x10a19, 0x10a33}
+  ,
+  {0x10a38, 0x10a3a}
+  ,
+  {0x10a3f, 0x10a47}
+  ,
+  {0x10a50, 0x10a58}
+  ,
+  {0x12000, 0x1236e}
+  ,
+  {0x12400, 0x12462}
+  ,
+  {0x12470, 0x12473}
+  ,
+  {0x1d000, 0x1d0f5}
+  ,
+  {0x1d100, 0x1d126}
+  ,
+  {0x1d129, 0x1d172}
+  ,
+  {0x1d17b, 0x1d1dd}
+  ,
+  {0x1d200, 0x1d245}
+  ,
+  {0x1d300, 0x1d356}
+  ,
+  {0x1d360, 0x1d371}
+  ,
+  {0x1d400, 0x1d454}
+  ,
+  {0x1d456, 0x1d49c}
+  ,
+  {0x1d49e, 0x1d49f}
+  ,
+  {0x1d4a2, 0x1d4a2}
+  ,
+  {0x1d4a5, 0x1d4a6}
+  ,
+  {0x1d4a9, 0x1d4ac}
+  ,
+  {0x1d4ae, 0x1d4b9}
+  ,
+  {0x1d4bb, 0x1d4bb}
+  ,
+  {0x1d4bd, 0x1d4c3}
+  ,
+  {0x1d4c5, 0x1d505}
+  ,
+  {0x1d507, 0x1d50a}
+  ,
+  {0x1d50d, 0x1d514}
+  ,
+  {0x1d516, 0x1d51c}
+  ,
+  {0x1d51e, 0x1d539}
+  ,
+  {0x1d53b, 0x1d53e}
+  ,
+  {0x1d540, 0x1d544}
+  ,
+  {0x1d546, 0x1d546}
+  ,
+  {0x1d54a, 0x1d550}
+  ,
+  {0x1d552, 0x1d6a5}
+  ,
+  {0x1d6a8, 0x1d7cb}
+  ,
+  {0x1d7ce, 0x1d7ff}
+  ,
+  {0x1f000, 0x1f02b}
+  ,
+  {0x1f030, 0x1f093}
+  ,
+  {0x20000, 0x2a6d6}
+  ,
+  {0x2f800, 0x2fa1d}
+  ,
+  {0xe0100, 0xe01ef}
+};
+
+scm_t_char_set cs_graphic = {
+  445,
+  cs_graphic_ranges
+};
+
+scm_t_char_range cs_whitespace_ranges[] = {
+  {0x0009, 0x000d}
+  ,
+  {0x0020, 0x0020}
+  ,
+  {0x00a0, 0x00a0}
+  ,
+  {0x1680, 0x1680}
+  ,
+  {0x180e, 0x180e}
+  ,
+  {0x2000, 0x200a}
+  ,
+  {0x2028, 0x2029}
+  ,
+  {0x202f, 0x202f}
+  ,
+  {0x205f, 0x205f}
+  ,
+  {0x3000, 0x3000}
+};
+
+scm_t_char_set cs_whitespace = {
+  10,
+  cs_whitespace_ranges
+};
+
+scm_t_char_range cs_printing_ranges[] = {
+  {0x0009, 0x000d}
+  ,
+  {0x0020, 0x007e}
+  ,
+  {0x00a0, 0x00ac}
+  ,
+  {0x00ae, 0x0377}
+  ,
+  {0x037a, 0x037e}
+  ,
+  {0x0384, 0x038a}
+  ,
+  {0x038c, 0x038c}
+  ,
+  {0x038e, 0x03a1}
+  ,
+  {0x03a3, 0x0523}
+  ,
+  {0x0531, 0x0556}
+  ,
+  {0x0559, 0x055f}
+  ,
+  {0x0561, 0x0587}
+  ,
+  {0x0589, 0x058a}
+  ,
+  {0x0591, 0x05c7}
+  ,
+  {0x05d0, 0x05ea}
+  ,
+  {0x05f0, 0x05f4}
+  ,
+  {0x0606, 0x061b}
+  ,
+  {0x061e, 0x061f}
+  ,
+  {0x0621, 0x065e}
+  ,
+  {0x0660, 0x06dc}
+  ,
+  {0x06de, 0x070d}
+  ,
+  {0x0710, 0x074a}
+  ,
+  {0x074d, 0x07b1}
+  ,
+  {0x07c0, 0x07fa}
+  ,
+  {0x0901, 0x0939}
+  ,
+  {0x093c, 0x094d}
+  ,
+  {0x0950, 0x0954}
+  ,
+  {0x0958, 0x0972}
+  ,
+  {0x097b, 0x097f}
+  ,
+  {0x0981, 0x0983}
+  ,
+  {0x0985, 0x098c}
+  ,
+  {0x098f, 0x0990}
+  ,
+  {0x0993, 0x09a8}
+  ,
+  {0x09aa, 0x09b0}
+  ,
+  {0x09b2, 0x09b2}
+  ,
+  {0x09b6, 0x09b9}
+  ,
+  {0x09bc, 0x09c4}
+  ,
+  {0x09c7, 0x09c8}
+  ,
+  {0x09cb, 0x09ce}
+  ,
+  {0x09d7, 0x09d7}
+  ,
+  {0x09dc, 0x09dd}
+  ,
+  {0x09df, 0x09e3}
+  ,
+  {0x09e6, 0x09fa}
+  ,
+  {0x0a01, 0x0a03}
+  ,
+  {0x0a05, 0x0a0a}
+  ,
+  {0x0a0f, 0x0a10}
+  ,
+  {0x0a13, 0x0a28}
+  ,
+  {0x0a2a, 0x0a30}
+  ,
+  {0x0a32, 0x0a33}
+  ,
+  {0x0a35, 0x0a36}
+  ,
+  {0x0a38, 0x0a39}
+  ,
+  {0x0a3c, 0x0a3c}
+  ,
+  {0x0a3e, 0x0a42}
+  ,
+  {0x0a47, 0x0a48}
+  ,
+  {0x0a4b, 0x0a4d}
+  ,
+  {0x0a51, 0x0a51}
+  ,
+  {0x0a59, 0x0a5c}
+  ,
+  {0x0a5e, 0x0a5e}
+  ,
+  {0x0a66, 0x0a75}
+  ,
+  {0x0a81, 0x0a83}
+  ,
+  {0x0a85, 0x0a8d}
+  ,
+  {0x0a8f, 0x0a91}
+  ,
+  {0x0a93, 0x0aa8}
+  ,
+  {0x0aaa, 0x0ab0}
+  ,
+  {0x0ab2, 0x0ab3}
+  ,
+  {0x0ab5, 0x0ab9}
+  ,
+  {0x0abc, 0x0ac5}
+  ,
+  {0x0ac7, 0x0ac9}
+  ,
+  {0x0acb, 0x0acd}
+  ,
+  {0x0ad0, 0x0ad0}
+  ,
+  {0x0ae0, 0x0ae3}
+  ,
+  {0x0ae6, 0x0aef}
+  ,
+  {0x0af1, 0x0af1}
+  ,
+  {0x0b01, 0x0b03}
+  ,
+  {0x0b05, 0x0b0c}
+  ,
+  {0x0b0f, 0x0b10}
+  ,
+  {0x0b13, 0x0b28}
+  ,
+  {0x0b2a, 0x0b30}
+  ,
+  {0x0b32, 0x0b33}
+  ,
+  {0x0b35, 0x0b39}
+  ,
+  {0x0b3c, 0x0b44}
+  ,
+  {0x0b47, 0x0b48}
+  ,
+  {0x0b4b, 0x0b4d}
+  ,
+  {0x0b56, 0x0b57}
+  ,
+  {0x0b5c, 0x0b5d}
+  ,
+  {0x0b5f, 0x0b63}
+  ,
+  {0x0b66, 0x0b71}
+  ,
+  {0x0b82, 0x0b83}
+  ,
+  {0x0b85, 0x0b8a}
+  ,
+  {0x0b8e, 0x0b90}
+  ,
+  {0x0b92, 0x0b95}
+  ,
+  {0x0b99, 0x0b9a}
+  ,
+  {0x0b9c, 0x0b9c}
+  ,
+  {0x0b9e, 0x0b9f}
+  ,
+  {0x0ba3, 0x0ba4}
+  ,
+  {0x0ba8, 0x0baa}
+  ,
+  {0x0bae, 0x0bb9}
+  ,
+  {0x0bbe, 0x0bc2}
+  ,
+  {0x0bc6, 0x0bc8}
+  ,
+  {0x0bca, 0x0bcd}
+  ,
+  {0x0bd0, 0x0bd0}
+  ,
+  {0x0bd7, 0x0bd7}
+  ,
+  {0x0be6, 0x0bfa}
+  ,
+  {0x0c01, 0x0c03}
+  ,
+  {0x0c05, 0x0c0c}
+  ,
+  {0x0c0e, 0x0c10}
+  ,
+  {0x0c12, 0x0c28}
+  ,
+  {0x0c2a, 0x0c33}
+  ,
+  {0x0c35, 0x0c39}
+  ,
+  {0x0c3d, 0x0c44}
+  ,
+  {0x0c46, 0x0c48}
+  ,
+  {0x0c4a, 0x0c4d}
+  ,
+  {0x0c55, 0x0c56}
+  ,
+  {0x0c58, 0x0c59}
+  ,
+  {0x0c60, 0x0c63}
+  ,
+  {0x0c66, 0x0c6f}
+  ,
+  {0x0c78, 0x0c7f}
+  ,
+  {0x0c82, 0x0c83}
+  ,
+  {0x0c85, 0x0c8c}
+  ,
+  {0x0c8e, 0x0c90}
+  ,
+  {0x0c92, 0x0ca8}
+  ,
+  {0x0caa, 0x0cb3}
+  ,
+  {0x0cb5, 0x0cb9}
+  ,
+  {0x0cbc, 0x0cc4}
+  ,
+  {0x0cc6, 0x0cc8}
+  ,
+  {0x0cca, 0x0ccd}
+  ,
+  {0x0cd5, 0x0cd6}
+  ,
+  {0x0cde, 0x0cde}
+  ,
+  {0x0ce0, 0x0ce3}
+  ,
+  {0x0ce6, 0x0cef}
+  ,
+  {0x0cf1, 0x0cf2}
+  ,
+  {0x0d02, 0x0d03}
+  ,
+  {0x0d05, 0x0d0c}
+  ,
+  {0x0d0e, 0x0d10}
+  ,
+  {0x0d12, 0x0d28}
+  ,
+  {0x0d2a, 0x0d39}
+  ,
+  {0x0d3d, 0x0d44}
+  ,
+  {0x0d46, 0x0d48}
+  ,
+  {0x0d4a, 0x0d4d}
+  ,
+  {0x0d57, 0x0d57}
+  ,
+  {0x0d60, 0x0d63}
+  ,
+  {0x0d66, 0x0d75}
+  ,
+  {0x0d79, 0x0d7f}
+  ,
+  {0x0d82, 0x0d83}
+  ,
+  {0x0d85, 0x0d96}
+  ,
+  {0x0d9a, 0x0db1}
+  ,
+  {0x0db3, 0x0dbb}
+  ,
+  {0x0dbd, 0x0dbd}
+  ,
+  {0x0dc0, 0x0dc6}
+  ,
+  {0x0dca, 0x0dca}
+  ,
+  {0x0dcf, 0x0dd4}
+  ,
+  {0x0dd6, 0x0dd6}
+  ,
+  {0x0dd8, 0x0ddf}
+  ,
+  {0x0df2, 0x0df4}
+  ,
+  {0x0e01, 0x0e3a}
+  ,
+  {0x0e3f, 0x0e5b}
+  ,
+  {0x0e81, 0x0e82}
+  ,
+  {0x0e84, 0x0e84}
+  ,
+  {0x0e87, 0x0e88}
+  ,
+  {0x0e8a, 0x0e8a}
+  ,
+  {0x0e8d, 0x0e8d}
+  ,
+  {0x0e94, 0x0e97}
+  ,
+  {0x0e99, 0x0e9f}
+  ,
+  {0x0ea1, 0x0ea3}
+  ,
+  {0x0ea5, 0x0ea5}
+  ,
+  {0x0ea7, 0x0ea7}
+  ,
+  {0x0eaa, 0x0eab}
+  ,
+  {0x0ead, 0x0eb9}
+  ,
+  {0x0ebb, 0x0ebd}
+  ,
+  {0x0ec0, 0x0ec4}
+  ,
+  {0x0ec6, 0x0ec6}
+  ,
+  {0x0ec8, 0x0ecd}
+  ,
+  {0x0ed0, 0x0ed9}
+  ,
+  {0x0edc, 0x0edd}
+  ,
+  {0x0f00, 0x0f47}
+  ,
+  {0x0f49, 0x0f6c}
+  ,
+  {0x0f71, 0x0f8b}
+  ,
+  {0x0f90, 0x0f97}
+  ,
+  {0x0f99, 0x0fbc}
+  ,
+  {0x0fbe, 0x0fcc}
+  ,
+  {0x0fce, 0x0fd4}
+  ,
+  {0x1000, 0x1099}
+  ,
+  {0x109e, 0x10c5}
+  ,
+  {0x10d0, 0x10fc}
+  ,
+  {0x1100, 0x1159}
+  ,
+  {0x115f, 0x11a2}
+  ,
+  {0x11a8, 0x11f9}
+  ,
+  {0x1200, 0x1248}
+  ,
+  {0x124a, 0x124d}
+  ,
+  {0x1250, 0x1256}
+  ,
+  {0x1258, 0x1258}
+  ,
+  {0x125a, 0x125d}
+  ,
+  {0x1260, 0x1288}
+  ,
+  {0x128a, 0x128d}
+  ,
+  {0x1290, 0x12b0}
+  ,
+  {0x12b2, 0x12b5}
+  ,
+  {0x12b8, 0x12be}
+  ,
+  {0x12c0, 0x12c0}
+  ,
+  {0x12c2, 0x12c5}
+  ,
+  {0x12c8, 0x12d6}
+  ,
+  {0x12d8, 0x1310}
+  ,
+  {0x1312, 0x1315}
+  ,
+  {0x1318, 0x135a}
+  ,
+  {0x135f, 0x137c}
+  ,
+  {0x1380, 0x1399}
+  ,
+  {0x13a0, 0x13f4}
+  ,
+  {0x1401, 0x1676}
+  ,
+  {0x1680, 0x169c}
+  ,
+  {0x16a0, 0x16f0}
+  ,
+  {0x1700, 0x170c}
+  ,
+  {0x170e, 0x1714}
+  ,
+  {0x1720, 0x1736}
+  ,
+  {0x1740, 0x1753}
+  ,
+  {0x1760, 0x176c}
+  ,
+  {0x176e, 0x1770}
+  ,
+  {0x1772, 0x1773}
+  ,
+  {0x1780, 0x17b3}
+  ,
+  {0x17b6, 0x17dd}
+  ,
+  {0x17e0, 0x17e9}
+  ,
+  {0x17f0, 0x17f9}
+  ,
+  {0x1800, 0x180e}
+  ,
+  {0x1810, 0x1819}
+  ,
+  {0x1820, 0x1877}
+  ,
+  {0x1880, 0x18aa}
+  ,
+  {0x1900, 0x191c}
+  ,
+  {0x1920, 0x192b}
+  ,
+  {0x1930, 0x193b}
+  ,
+  {0x1940, 0x1940}
+  ,
+  {0x1944, 0x196d}
+  ,
+  {0x1970, 0x1974}
+  ,
+  {0x1980, 0x19a9}
+  ,
+  {0x19b0, 0x19c9}
+  ,
+  {0x19d0, 0x19d9}
+  ,
+  {0x19de, 0x1a1b}
+  ,
+  {0x1a1e, 0x1a1f}
+  ,
+  {0x1b00, 0x1b4b}
+  ,
+  {0x1b50, 0x1b7c}
+  ,
+  {0x1b80, 0x1baa}
+  ,
+  {0x1bae, 0x1bb9}
+  ,
+  {0x1c00, 0x1c37}
+  ,
+  {0x1c3b, 0x1c49}
+  ,
+  {0x1c4d, 0x1c7f}
+  ,
+  {0x1d00, 0x1de6}
+  ,
+  {0x1dfe, 0x1f15}
+  ,
+  {0x1f18, 0x1f1d}
+  ,
+  {0x1f20, 0x1f45}
+  ,
+  {0x1f48, 0x1f4d}
+  ,
+  {0x1f50, 0x1f57}
+  ,
+  {0x1f59, 0x1f59}
+  ,
+  {0x1f5b, 0x1f5b}
+  ,
+  {0x1f5d, 0x1f5d}
+  ,
+  {0x1f5f, 0x1f7d}
+  ,
+  {0x1f80, 0x1fb4}
+  ,
+  {0x1fb6, 0x1fc4}
+  ,
+  {0x1fc6, 0x1fd3}
+  ,
+  {0x1fd6, 0x1fdb}
+  ,
+  {0x1fdd, 0x1fef}
+  ,
+  {0x1ff2, 0x1ff4}
+  ,
+  {0x1ff6, 0x1ffe}
+  ,
+  {0x2000, 0x200a}
+  ,
+  {0x2010, 0x2029}
+  ,
+  {0x202f, 0x205f}
+  ,
+  {0x2070, 0x2071}
+  ,
+  {0x2074, 0x208e}
+  ,
+  {0x2090, 0x2094}
+  ,
+  {0x20a0, 0x20b5}
+  ,
+  {0x20d0, 0x20f0}
+  ,
+  {0x2100, 0x214f}
+  ,
+  {0x2153, 0x2188}
+  ,
+  {0x2190, 0x23e7}
+  ,
+  {0x2400, 0x2426}
+  ,
+  {0x2440, 0x244a}
+  ,
+  {0x2460, 0x269d}
+  ,
+  {0x26a0, 0x26bc}
+  ,
+  {0x26c0, 0x26c3}
+  ,
+  {0x2701, 0x2704}
+  ,
+  {0x2706, 0x2709}
+  ,
+  {0x270c, 0x2727}
+  ,
+  {0x2729, 0x274b}
+  ,
+  {0x274d, 0x274d}
+  ,
+  {0x274f, 0x2752}
+  ,
+  {0x2756, 0x2756}
+  ,
+  {0x2758, 0x275e}
+  ,
+  {0x2761, 0x2794}
+  ,
+  {0x2798, 0x27af}
+  ,
+  {0x27b1, 0x27be}
+  ,
+  {0x27c0, 0x27ca}
+  ,
+  {0x27cc, 0x27cc}
+  ,
+  {0x27d0, 0x2b4c}
+  ,
+  {0x2b50, 0x2b54}
+  ,
+  {0x2c00, 0x2c2e}
+  ,
+  {0x2c30, 0x2c5e}
+  ,
+  {0x2c60, 0x2c6f}
+  ,
+  {0x2c71, 0x2c7d}
+  ,
+  {0x2c80, 0x2cea}
+  ,
+  {0x2cf9, 0x2d25}
+  ,
+  {0x2d30, 0x2d65}
+  ,
+  {0x2d6f, 0x2d6f}
+  ,
+  {0x2d80, 0x2d96}
+  ,
+  {0x2da0, 0x2da6}
+  ,
+  {0x2da8, 0x2dae}
+  ,
+  {0x2db0, 0x2db6}
+  ,
+  {0x2db8, 0x2dbe}
+  ,
+  {0x2dc0, 0x2dc6}
+  ,
+  {0x2dc8, 0x2dce}
+  ,
+  {0x2dd0, 0x2dd6}
+  ,
+  {0x2dd8, 0x2dde}
+  ,
+  {0x2de0, 0x2e30}
+  ,
+  {0x2e80, 0x2e99}
+  ,
+  {0x2e9b, 0x2ef3}
+  ,
+  {0x2f00, 0x2fd5}
+  ,
+  {0x2ff0, 0x2ffb}
+  ,
+  {0x3000, 0x303f}
+  ,
+  {0x3041, 0x3096}
+  ,
+  {0x3099, 0x30ff}
+  ,
+  {0x3105, 0x312d}
+  ,
+  {0x3131, 0x318e}
+  ,
+  {0x3190, 0x31b7}
+  ,
+  {0x31c0, 0x31e3}
+  ,
+  {0x31f0, 0x321e}
+  ,
+  {0x3220, 0x3243}
+  ,
+  {0x3250, 0x32fe}
+  ,
+  {0x3300, 0x4db5}
+  ,
+  {0x4dc0, 0x9fc3}
+  ,
+  {0xa000, 0xa48c}
+  ,
+  {0xa490, 0xa4c6}
+  ,
+  {0xa500, 0xa62b}
+  ,
+  {0xa640, 0xa65f}
+  ,
+  {0xa662, 0xa673}
+  ,
+  {0xa67c, 0xa697}
+  ,
+  {0xa700, 0xa78c}
+  ,
+  {0xa7fb, 0xa82b}
+  ,
+  {0xa840, 0xa877}
+  ,
+  {0xa880, 0xa8c4}
+  ,
+  {0xa8ce, 0xa8d9}
+  ,
+  {0xa900, 0xa953}
+  ,
+  {0xa95f, 0xa95f}
+  ,
+  {0xaa00, 0xaa36}
+  ,
+  {0xaa40, 0xaa4d}
+  ,
+  {0xaa50, 0xaa59}
+  ,
+  {0xaa5c, 0xaa5f}
+  ,
+  {0xac00, 0xd7a3}
+  ,
+  {0xf900, 0xfa2d}
+  ,
+  {0xfa30, 0xfa6a}
+  ,
+  {0xfa70, 0xfad9}
+  ,
+  {0xfb00, 0xfb06}
+  ,
+  {0xfb13, 0xfb17}
+  ,
+  {0xfb1d, 0xfb36}
+  ,
+  {0xfb38, 0xfb3c}
+  ,
+  {0xfb3e, 0xfb3e}
+  ,
+  {0xfb40, 0xfb41}
+  ,
+  {0xfb43, 0xfb44}
+  ,
+  {0xfb46, 0xfbb1}
+  ,
+  {0xfbd3, 0xfd3f}
+  ,
+  {0xfd50, 0xfd8f}
+  ,
+  {0xfd92, 0xfdc7}
+  ,
+  {0xfdf0, 0xfdfd}
+  ,
+  {0xfe00, 0xfe19}
+  ,
+  {0xfe20, 0xfe26}
+  ,
+  {0xfe30, 0xfe52}
+  ,
+  {0xfe54, 0xfe66}
+  ,
+  {0xfe68, 0xfe6b}
+  ,
+  {0xfe70, 0xfe74}
+  ,
+  {0xfe76, 0xfefc}
+  ,
+  {0xff01, 0xffbe}
+  ,
+  {0xffc2, 0xffc7}
+  ,
+  {0xffca, 0xffcf}
+  ,
+  {0xffd2, 0xffd7}
+  ,
+  {0xffda, 0xffdc}
+  ,
+  {0xffe0, 0xffe6}
+  ,
+  {0xffe8, 0xffee}
+  ,
+  {0xfffc, 0xfffd}
+  ,
+  {0x10000, 0x1000b}
+  ,
+  {0x1000d, 0x10026}
+  ,
+  {0x10028, 0x1003a}
+  ,
+  {0x1003c, 0x1003d}
+  ,
+  {0x1003f, 0x1004d}
+  ,
+  {0x10050, 0x1005d}
+  ,
+  {0x10080, 0x100fa}
+  ,
+  {0x10100, 0x10102}
+  ,
+  {0x10107, 0x10133}
+  ,
+  {0x10137, 0x1018a}
+  ,
+  {0x10190, 0x1019b}
+  ,
+  {0x101d0, 0x101fd}
+  ,
+  {0x10280, 0x1029c}
+  ,
+  {0x102a0, 0x102d0}
+  ,
+  {0x10300, 0x1031e}
+  ,
+  {0x10320, 0x10323}
+  ,
+  {0x10330, 0x1034a}
+  ,
+  {0x10380, 0x1039d}
+  ,
+  {0x1039f, 0x103c3}
+  ,
+  {0x103c8, 0x103d5}
+  ,
+  {0x10400, 0x1049d}
+  ,
+  {0x104a0, 0x104a9}
+  ,
+  {0x10800, 0x10805}
+  ,
+  {0x10808, 0x10808}
+  ,
+  {0x1080a, 0x10835}
+  ,
+  {0x10837, 0x10838}
+  ,
+  {0x1083c, 0x1083c}
+  ,
+  {0x1083f, 0x1083f}
+  ,
+  {0x10900, 0x10919}
+  ,
+  {0x1091f, 0x10939}
+  ,
+  {0x1093f, 0x1093f}
+  ,
+  {0x10a00, 0x10a03}
+  ,
+  {0x10a05, 0x10a06}
+  ,
+  {0x10a0c, 0x10a13}
+  ,
+  {0x10a15, 0x10a17}
+  ,
+  {0x10a19, 0x10a33}
+  ,
+  {0x10a38, 0x10a3a}
+  ,
+  {0x10a3f, 0x10a47}
+  ,
+  {0x10a50, 0x10a58}
+  ,
+  {0x12000, 0x1236e}
+  ,
+  {0x12400, 0x12462}
+  ,
+  {0x12470, 0x12473}
+  ,
+  {0x1d000, 0x1d0f5}
+  ,
+  {0x1d100, 0x1d126}
+  ,
+  {0x1d129, 0x1d172}
+  ,
+  {0x1d17b, 0x1d1dd}
+  ,
+  {0x1d200, 0x1d245}
+  ,
+  {0x1d300, 0x1d356}
+  ,
+  {0x1d360, 0x1d371}
+  ,
+  {0x1d400, 0x1d454}
+  ,
+  {0x1d456, 0x1d49c}
+  ,
+  {0x1d49e, 0x1d49f}
+  ,
+  {0x1d4a2, 0x1d4a2}
+  ,
+  {0x1d4a5, 0x1d4a6}
+  ,
+  {0x1d4a9, 0x1d4ac}
+  ,
+  {0x1d4ae, 0x1d4b9}
+  ,
+  {0x1d4bb, 0x1d4bb}
+  ,
+  {0x1d4bd, 0x1d4c3}
+  ,
+  {0x1d4c5, 0x1d505}
+  ,
+  {0x1d507, 0x1d50a}
+  ,
+  {0x1d50d, 0x1d514}
+  ,
+  {0x1d516, 0x1d51c}
+  ,
+  {0x1d51e, 0x1d539}
+  ,
+  {0x1d53b, 0x1d53e}
+  ,
+  {0x1d540, 0x1d544}
+  ,
+  {0x1d546, 0x1d546}
+  ,
+  {0x1d54a, 0x1d550}
+  ,
+  {0x1d552, 0x1d6a5}
+  ,
+  {0x1d6a8, 0x1d7cb}
+  ,
+  {0x1d7ce, 0x1d7ff}
+  ,
+  {0x1f000, 0x1f02b}
+  ,
+  {0x1f030, 0x1f093}
+  ,
+  {0x20000, 0x2a6d6}
+  ,
+  {0x2f800, 0x2fa1d}
+  ,
+  {0xe0100, 0xe01ef}
+};
+
+scm_t_char_set cs_printing = {
+  447,
+  cs_printing_ranges
+};
+
+scm_t_char_range cs_iso_control_ranges[] = {
+  {0x0000, 0x001f}
+  ,
+  {0x007f, 0x009f}
+};
+
+scm_t_char_set cs_iso_control = {
+  2,
+  cs_iso_control_ranges
+};
+
+scm_t_char_range cs_punctuation_ranges[] = {
+  {0x0021, 0x0023}
+  ,
+  {0x0025, 0x002a}
+  ,
+  {0x002c, 0x002f}
+  ,
+  {0x003a, 0x003b}
+  ,
+  {0x003f, 0x0040}
+  ,
+  {0x005b, 0x005d}
+  ,
+  {0x005f, 0x005f}
+  ,
+  {0x007b, 0x007b}
+  ,
+  {0x007d, 0x007d}
+  ,
+  {0x00a1, 0x00a1}
+  ,
+  {0x00ab, 0x00ab}
+  ,
+  {0x00b7, 0x00b7}
+  ,
+  {0x00bb, 0x00bb}
+  ,
+  {0x00bf, 0x00bf}
+  ,
+  {0x037e, 0x037e}
+  ,
+  {0x0387, 0x0387}
+  ,
+  {0x055a, 0x055f}
+  ,
+  {0x0589, 0x058a}
+  ,
+  {0x05be, 0x05be}
+  ,
+  {0x05c0, 0x05c0}
+  ,
+  {0x05c3, 0x05c3}
+  ,
+  {0x05c6, 0x05c6}
+  ,
+  {0x05f3, 0x05f4}
+  ,
+  {0x0609, 0x060a}
+  ,
+  {0x060c, 0x060d}
+  ,
+  {0x061b, 0x061b}
+  ,
+  {0x061e, 0x061f}
+  ,
+  {0x066a, 0x066d}
+  ,
+  {0x06d4, 0x06d4}
+  ,
+  {0x0700, 0x070d}
+  ,
+  {0x07f7, 0x07f9}
+  ,
+  {0x0964, 0x0965}
+  ,
+  {0x0970, 0x0970}
+  ,
+  {0x0df4, 0x0df4}
+  ,
+  {0x0e4f, 0x0e4f}
+  ,
+  {0x0e5a, 0x0e5b}
+  ,
+  {0x0f04, 0x0f12}
+  ,
+  {0x0f3a, 0x0f3d}
+  ,
+  {0x0f85, 0x0f85}
+  ,
+  {0x0fd0, 0x0fd4}
+  ,
+  {0x104a, 0x104f}
+  ,
+  {0x10fb, 0x10fb}
+  ,
+  {0x1361, 0x1368}
+  ,
+  {0x166d, 0x166e}
+  ,
+  {0x169b, 0x169c}
+  ,
+  {0x16eb, 0x16ed}
+  ,
+  {0x1735, 0x1736}
+  ,
+  {0x17d4, 0x17d6}
+  ,
+  {0x17d8, 0x17da}
+  ,
+  {0x1800, 0x180a}
+  ,
+  {0x1944, 0x1945}
+  ,
+  {0x19de, 0x19df}
+  ,
+  {0x1a1e, 0x1a1f}
+  ,
+  {0x1b5a, 0x1b60}
+  ,
+  {0x1c3b, 0x1c3f}
+  ,
+  {0x1c7e, 0x1c7f}
+  ,
+  {0x2010, 0x2027}
+  ,
+  {0x2030, 0x2043}
+  ,
+  {0x2045, 0x2051}
+  ,
+  {0x2053, 0x205e}
+  ,
+  {0x207d, 0x207e}
+  ,
+  {0x208d, 0x208e}
+  ,
+  {0x2329, 0x232a}
+  ,
+  {0x2768, 0x2775}
+  ,
+  {0x27c5, 0x27c6}
+  ,
+  {0x27e6, 0x27ef}
+  ,
+  {0x2983, 0x2998}
+  ,
+  {0x29d8, 0x29db}
+  ,
+  {0x29fc, 0x29fd}
+  ,
+  {0x2cf9, 0x2cfc}
+  ,
+  {0x2cfe, 0x2cff}
+  ,
+  {0x2e00, 0x2e2e}
+  ,
+  {0x2e30, 0x2e30}
+  ,
+  {0x3001, 0x3003}
+  ,
+  {0x3008, 0x3011}
+  ,
+  {0x3014, 0x301f}
+  ,
+  {0x3030, 0x3030}
+  ,
+  {0x303d, 0x303d}
+  ,
+  {0x30a0, 0x30a0}
+  ,
+  {0x30fb, 0x30fb}
+  ,
+  {0xa60d, 0xa60f}
+  ,
+  {0xa673, 0xa673}
+  ,
+  {0xa67e, 0xa67e}
+  ,
+  {0xa874, 0xa877}
+  ,
+  {0xa8ce, 0xa8cf}
+  ,
+  {0xa92e, 0xa92f}
+  ,
+  {0xa95f, 0xa95f}
+  ,
+  {0xaa5c, 0xaa5f}
+  ,
+  {0xfd3e, 0xfd3f}
+  ,
+  {0xfe10, 0xfe19}
+  ,
+  {0xfe30, 0xfe52}
+  ,
+  {0xfe54, 0xfe61}
+  ,
+  {0xfe63, 0xfe63}
+  ,
+  {0xfe68, 0xfe68}
+  ,
+  {0xfe6a, 0xfe6b}
+  ,
+  {0xff01, 0xff03}
+  ,
+  {0xff05, 0xff0a}
+  ,
+  {0xff0c, 0xff0f}
+  ,
+  {0xff1a, 0xff1b}
+  ,
+  {0xff1f, 0xff20}
+  ,
+  {0xff3b, 0xff3d}
+  ,
+  {0xff3f, 0xff3f}
+  ,
+  {0xff5b, 0xff5b}
+  ,
+  {0xff5d, 0xff5d}
+  ,
+  {0xff5f, 0xff65}
+  ,
+  {0x10100, 0x10101}
+  ,
+  {0x1039f, 0x1039f}
+  ,
+  {0x103d0, 0x103d0}
+  ,
+  {0x1091f, 0x1091f}
+  ,
+  {0x1093f, 0x1093f}
+  ,
+  {0x10a50, 0x10a58}
+  ,
+  {0x12470, 0x12473}
+};
+
+scm_t_char_set cs_punctuation = {
+  112,
+  cs_punctuation_ranges
+};
+
+scm_t_char_range cs_symbol_ranges[] = {
+  {0x0024, 0x0024}
+  ,
+  {0x002b, 0x002b}
+  ,
+  {0x003c, 0x003e}
+  ,
+  {0x005e, 0x005e}
+  ,
+  {0x0060, 0x0060}
+  ,
+  {0x007c, 0x007c}
+  ,
+  {0x007e, 0x007e}
+  ,
+  {0x00a2, 0x00a9}
+  ,
+  {0x00ac, 0x00ac}
+  ,
+  {0x00ae, 0x00b1}
+  ,
+  {0x00b4, 0x00b4}
+  ,
+  {0x00b6, 0x00b6}
+  ,
+  {0x00b8, 0x00b8}
+  ,
+  {0x00d7, 0x00d7}
+  ,
+  {0x00f7, 0x00f7}
+  ,
+  {0x02c2, 0x02c5}
+  ,
+  {0x02d2, 0x02df}
+  ,
+  {0x02e5, 0x02eb}
+  ,
+  {0x02ed, 0x02ed}
+  ,
+  {0x02ef, 0x02ff}
+  ,
+  {0x0375, 0x0375}
+  ,
+  {0x0384, 0x0385}
+  ,
+  {0x03f6, 0x03f6}
+  ,
+  {0x0482, 0x0482}
+  ,
+  {0x0606, 0x0608}
+  ,
+  {0x060b, 0x060b}
+  ,
+  {0x060e, 0x060f}
+  ,
+  {0x06e9, 0x06e9}
+  ,
+  {0x06fd, 0x06fe}
+  ,
+  {0x07f6, 0x07f6}
+  ,
+  {0x09f2, 0x09f3}
+  ,
+  {0x09fa, 0x09fa}
+  ,
+  {0x0af1, 0x0af1}
+  ,
+  {0x0b70, 0x0b70}
+  ,
+  {0x0bf3, 0x0bfa}
+  ,
+  {0x0c7f, 0x0c7f}
+  ,
+  {0x0cf1, 0x0cf2}
+  ,
+  {0x0d79, 0x0d79}
+  ,
+  {0x0e3f, 0x0e3f}
+  ,
+  {0x0f01, 0x0f03}
+  ,
+  {0x0f13, 0x0f17}
+  ,
+  {0x0f1a, 0x0f1f}
+  ,
+  {0x0f34, 0x0f34}
+  ,
+  {0x0f36, 0x0f36}
+  ,
+  {0x0f38, 0x0f38}
+  ,
+  {0x0fbe, 0x0fc5}
+  ,
+  {0x0fc7, 0x0fcc}
+  ,
+  {0x0fce, 0x0fcf}
+  ,
+  {0x109e, 0x109f}
+  ,
+  {0x1360, 0x1360}
+  ,
+  {0x1390, 0x1399}
+  ,
+  {0x17db, 0x17db}
+  ,
+  {0x1940, 0x1940}
+  ,
+  {0x19e0, 0x19ff}
+  ,
+  {0x1b61, 0x1b6a}
+  ,
+  {0x1b74, 0x1b7c}
+  ,
+  {0x1fbd, 0x1fbd}
+  ,
+  {0x1fbf, 0x1fc1}
+  ,
+  {0x1fcd, 0x1fcf}
+  ,
+  {0x1fdd, 0x1fdf}
+  ,
+  {0x1fed, 0x1fef}
+  ,
+  {0x1ffd, 0x1ffe}
+  ,
+  {0x2044, 0x2044}
+  ,
+  {0x2052, 0x2052}
+  ,
+  {0x207a, 0x207c}
+  ,
+  {0x208a, 0x208c}
+  ,
+  {0x20a0, 0x20b5}
+  ,
+  {0x2100, 0x2101}
+  ,
+  {0x2103, 0x2106}
+  ,
+  {0x2108, 0x2109}
+  ,
+  {0x2114, 0x2114}
+  ,
+  {0x2116, 0x2118}
+  ,
+  {0x211e, 0x2123}
+  ,
+  {0x2125, 0x2125}
+  ,
+  {0x2127, 0x2127}
+  ,
+  {0x2129, 0x2129}
+  ,
+  {0x212e, 0x212e}
+  ,
+  {0x213a, 0x213b}
+  ,
+  {0x2140, 0x2144}
+  ,
+  {0x214a, 0x214d}
+  ,
+  {0x214f, 0x214f}
+  ,
+  {0x2190, 0x2328}
+  ,
+  {0x232b, 0x23e7}
+  ,
+  {0x2400, 0x2426}
+  ,
+  {0x2440, 0x244a}
+  ,
+  {0x249c, 0x24e9}
+  ,
+  {0x2500, 0x269d}
+  ,
+  {0x26a0, 0x26bc}
+  ,
+  {0x26c0, 0x26c3}
+  ,
+  {0x2701, 0x2704}
+  ,
+  {0x2706, 0x2709}
+  ,
+  {0x270c, 0x2727}
+  ,
+  {0x2729, 0x274b}
+  ,
+  {0x274d, 0x274d}
+  ,
+  {0x274f, 0x2752}
+  ,
+  {0x2756, 0x2756}
+  ,
+  {0x2758, 0x275e}
+  ,
+  {0x2761, 0x2767}
+  ,
+  {0x2794, 0x2794}
+  ,
+  {0x2798, 0x27af}
+  ,
+  {0x27b1, 0x27be}
+  ,
+  {0x27c0, 0x27c4}
+  ,
+  {0x27c7, 0x27ca}
+  ,
+  {0x27cc, 0x27cc}
+  ,
+  {0x27d0, 0x27e5}
+  ,
+  {0x27f0, 0x2982}
+  ,
+  {0x2999, 0x29d7}
+  ,
+  {0x29dc, 0x29fb}
+  ,
+  {0x29fe, 0x2b4c}
+  ,
+  {0x2b50, 0x2b54}
+  ,
+  {0x2ce5, 0x2cea}
+  ,
+  {0x2e80, 0x2e99}
+  ,
+  {0x2e9b, 0x2ef3}
+  ,
+  {0x2f00, 0x2fd5}
+  ,
+  {0x2ff0, 0x2ffb}
+  ,
+  {0x3004, 0x3004}
+  ,
+  {0x3012, 0x3013}
+  ,
+  {0x3020, 0x3020}
+  ,
+  {0x3036, 0x3037}
+  ,
+  {0x303e, 0x303f}
+  ,
+  {0x309b, 0x309c}
+  ,
+  {0x3190, 0x3191}
+  ,
+  {0x3196, 0x319f}
+  ,
+  {0x31c0, 0x31e3}
+  ,
+  {0x3200, 0x321e}
+  ,
+  {0x322a, 0x3243}
+  ,
+  {0x3250, 0x3250}
+  ,
+  {0x3260, 0x327f}
+  ,
+  {0x328a, 0x32b0}
+  ,
+  {0x32c0, 0x32fe}
+  ,
+  {0x3300, 0x33ff}
+  ,
+  {0x4dc0, 0x4dff}
+  ,
+  {0xa490, 0xa4c6}
+  ,
+  {0xa700, 0xa716}
+  ,
+  {0xa720, 0xa721}
+  ,
+  {0xa789, 0xa78a}
+  ,
+  {0xa828, 0xa82b}
+  ,
+  {0xfb29, 0xfb29}
+  ,
+  {0xfdfc, 0xfdfd}
+  ,
+  {0xfe62, 0xfe62}
+  ,
+  {0xfe64, 0xfe66}
+  ,
+  {0xfe69, 0xfe69}
+  ,
+  {0xff04, 0xff04}
+  ,
+  {0xff0b, 0xff0b}
+  ,
+  {0xff1c, 0xff1e}
+  ,
+  {0xff3e, 0xff3e}
+  ,
+  {0xff40, 0xff40}
+  ,
+  {0xff5c, 0xff5c}
+  ,
+  {0xff5e, 0xff5e}
+  ,
+  {0xffe0, 0xffe6}
+  ,
+  {0xffe8, 0xffee}
+  ,
+  {0xfffc, 0xfffd}
+  ,
+  {0x10102, 0x10102}
+  ,
+  {0x10137, 0x1013f}
+  ,
+  {0x10179, 0x10189}
+  ,
+  {0x10190, 0x1019b}
+  ,
+  {0x101d0, 0x101fc}
+  ,
+  {0x1d000, 0x1d0f5}
+  ,
+  {0x1d100, 0x1d126}
+  ,
+  {0x1d129, 0x1d164}
+  ,
+  {0x1d16a, 0x1d16c}
+  ,
+  {0x1d183, 0x1d184}
+  ,
+  {0x1d18c, 0x1d1a9}
+  ,
+  {0x1d1ae, 0x1d1dd}
+  ,
+  {0x1d200, 0x1d241}
+  ,
+  {0x1d245, 0x1d245}
+  ,
+  {0x1d300, 0x1d356}
+  ,
+  {0x1d6c1, 0x1d6c1}
+  ,
+  {0x1d6db, 0x1d6db}
+  ,
+  {0x1d6fb, 0x1d6fb}
+  ,
+  {0x1d715, 0x1d715}
+  ,
+  {0x1d735, 0x1d735}
+  ,
+  {0x1d74f, 0x1d74f}
+  ,
+  {0x1d76f, 0x1d76f}
+  ,
+  {0x1d789, 0x1d789}
+  ,
+  {0x1d7a9, 0x1d7a9}
+  ,
+  {0x1d7c3, 0x1d7c3}
+  ,
+  {0x1f000, 0x1f02b}
+  ,
+  {0x1f030, 0x1f093}
+};
+
+scm_t_char_set cs_symbol = {
+  179,
+  cs_symbol_ranges
+};
+
+scm_t_char_range cs_blank_ranges[] = {
+  {0x0009, 0x0009}
+  ,
+  {0x0020, 0x0020}
+  ,
+  {0x00a0, 0x00a0}
+  ,
+  {0x1680, 0x1680}
+  ,
+  {0x180e, 0x180e}
+  ,
+  {0x2000, 0x200a}
+  ,
+  {0x202f, 0x202f}
+  ,
+  {0x205f, 0x205f}
+  ,
+  {0x3000, 0x3000}
+};
+
+scm_t_char_set cs_blank = {
+  9,
+  cs_blank_ranges
+};
+
+scm_t_char_range cs_ascii_ranges[] = {
+  {0x0000, 0x007f}
+};
+
+scm_t_char_set cs_ascii = {
+  0,
+  cs_ascii_ranges
+};
+
+scm_t_char_range cs_empty_ranges[] = {
+};
+
+scm_t_char_set cs_empty = {
+  0,
+  cs_empty_ranges
+};
+
+scm_t_char_range cs_full_ranges[] = {
+  {0x0000, 0x0377}
+  ,
+  {0x037a, 0x037e}
+  ,
+  {0x0384, 0x038a}
+  ,
+  {0x038c, 0x038c}
+  ,
+  {0x038e, 0x03a1}
+  ,
+  {0x03a3, 0x0523}
+  ,
+  {0x0531, 0x0556}
+  ,
+  {0x0559, 0x055f}
+  ,
+  {0x0561, 0x0587}
+  ,
+  {0x0589, 0x058a}
+  ,
+  {0x0591, 0x05c7}
+  ,
+  {0x05d0, 0x05ea}
+  ,
+  {0x05f0, 0x05f4}
+  ,
+  {0x0600, 0x0603}
+  ,
+  {0x0606, 0x061b}
+  ,
+  {0x061e, 0x061f}
+  ,
+  {0x0621, 0x065e}
+  ,
+  {0x0660, 0x070d}
+  ,
+  {0x070f, 0x074a}
+  ,
+  {0x074d, 0x07b1}
+  ,
+  {0x07c0, 0x07fa}
+  ,
+  {0x0901, 0x0939}
+  ,
+  {0x093c, 0x094d}
+  ,
+  {0x0950, 0x0954}
+  ,
+  {0x0958, 0x0972}
+  ,
+  {0x097b, 0x097f}
+  ,
+  {0x0981, 0x0983}
+  ,
+  {0x0985, 0x098c}
+  ,
+  {0x098f, 0x0990}
+  ,
+  {0x0993, 0x09a8}
+  ,
+  {0x09aa, 0x09b0}
+  ,
+  {0x09b2, 0x09b2}
+  ,
+  {0x09b6, 0x09b9}
+  ,
+  {0x09bc, 0x09c4}
+  ,
+  {0x09c7, 0x09c8}
+  ,
+  {0x09cb, 0x09ce}
+  ,
+  {0x09d7, 0x09d7}
+  ,
+  {0x09dc, 0x09dd}
+  ,
+  {0x09df, 0x09e3}
+  ,
+  {0x09e6, 0x09fa}
+  ,
+  {0x0a01, 0x0a03}
+  ,
+  {0x0a05, 0x0a0a}
+  ,
+  {0x0a0f, 0x0a10}
+  ,
+  {0x0a13, 0x0a28}
+  ,
+  {0x0a2a, 0x0a30}
+  ,
+  {0x0a32, 0x0a33}
+  ,
+  {0x0a35, 0x0a36}
+  ,
+  {0x0a38, 0x0a39}
+  ,
+  {0x0a3c, 0x0a3c}
+  ,
+  {0x0a3e, 0x0a42}
+  ,
+  {0x0a47, 0x0a48}
+  ,
+  {0x0a4b, 0x0a4d}
+  ,
+  {0x0a51, 0x0a51}
+  ,
+  {0x0a59, 0x0a5c}
+  ,
+  {0x0a5e, 0x0a5e}
+  ,
+  {0x0a66, 0x0a75}
+  ,
+  {0x0a81, 0x0a83}
+  ,
+  {0x0a85, 0x0a8d}
+  ,
+  {0x0a8f, 0x0a91}
+  ,
+  {0x0a93, 0x0aa8}
+  ,
+  {0x0aaa, 0x0ab0}
+  ,
+  {0x0ab2, 0x0ab3}
+  ,
+  {0x0ab5, 0x0ab9}
+  ,
+  {0x0abc, 0x0ac5}
+  ,
+  {0x0ac7, 0x0ac9}
+  ,
+  {0x0acb, 0x0acd}
+  ,
+  {0x0ad0, 0x0ad0}
+  ,
+  {0x0ae0, 0x0ae3}
+  ,
+  {0x0ae6, 0x0aef}
+  ,
+  {0x0af1, 0x0af1}
+  ,
+  {0x0b01, 0x0b03}
+  ,
+  {0x0b05, 0x0b0c}
+  ,
+  {0x0b0f, 0x0b10}
+  ,
+  {0x0b13, 0x0b28}
+  ,
+  {0x0b2a, 0x0b30}
+  ,
+  {0x0b32, 0x0b33}
+  ,
+  {0x0b35, 0x0b39}
+  ,
+  {0x0b3c, 0x0b44}
+  ,
+  {0x0b47, 0x0b48}
+  ,
+  {0x0b4b, 0x0b4d}
+  ,
+  {0x0b56, 0x0b57}
+  ,
+  {0x0b5c, 0x0b5d}
+  ,
+  {0x0b5f, 0x0b63}
+  ,
+  {0x0b66, 0x0b71}
+  ,
+  {0x0b82, 0x0b83}
+  ,
+  {0x0b85, 0x0b8a}
+  ,
+  {0x0b8e, 0x0b90}
+  ,
+  {0x0b92, 0x0b95}
+  ,
+  {0x0b99, 0x0b9a}
+  ,
+  {0x0b9c, 0x0b9c}
+  ,
+  {0x0b9e, 0x0b9f}
+  ,
+  {0x0ba3, 0x0ba4}
+  ,
+  {0x0ba8, 0x0baa}
+  ,
+  {0x0bae, 0x0bb9}
+  ,
+  {0x0bbe, 0x0bc2}
+  ,
+  {0x0bc6, 0x0bc8}
+  ,
+  {0x0bca, 0x0bcd}
+  ,
+  {0x0bd0, 0x0bd0}
+  ,
+  {0x0bd7, 0x0bd7}
+  ,
+  {0x0be6, 0x0bfa}
+  ,
+  {0x0c01, 0x0c03}
+  ,
+  {0x0c05, 0x0c0c}
+  ,
+  {0x0c0e, 0x0c10}
+  ,
+  {0x0c12, 0x0c28}
+  ,
+  {0x0c2a, 0x0c33}
+  ,
+  {0x0c35, 0x0c39}
+  ,
+  {0x0c3d, 0x0c44}
+  ,
+  {0x0c46, 0x0c48}
+  ,
+  {0x0c4a, 0x0c4d}
+  ,
+  {0x0c55, 0x0c56}
+  ,
+  {0x0c58, 0x0c59}
+  ,
+  {0x0c60, 0x0c63}
+  ,
+  {0x0c66, 0x0c6f}
+  ,
+  {0x0c78, 0x0c7f}
+  ,
+  {0x0c82, 0x0c83}
+  ,
+  {0x0c85, 0x0c8c}
+  ,
+  {0x0c8e, 0x0c90}
+  ,
+  {0x0c92, 0x0ca8}
+  ,
+  {0x0caa, 0x0cb3}
+  ,
+  {0x0cb5, 0x0cb9}
+  ,
+  {0x0cbc, 0x0cc4}
+  ,
+  {0x0cc6, 0x0cc8}
+  ,
+  {0x0cca, 0x0ccd}
+  ,
+  {0x0cd5, 0x0cd6}
+  ,
+  {0x0cde, 0x0cde}
+  ,
+  {0x0ce0, 0x0ce3}
+  ,
+  {0x0ce6, 0x0cef}
+  ,
+  {0x0cf1, 0x0cf2}
+  ,
+  {0x0d02, 0x0d03}
+  ,
+  {0x0d05, 0x0d0c}
+  ,
+  {0x0d0e, 0x0d10}
+  ,
+  {0x0d12, 0x0d28}
+  ,
+  {0x0d2a, 0x0d39}
+  ,
+  {0x0d3d, 0x0d44}
+  ,
+  {0x0d46, 0x0d48}
+  ,
+  {0x0d4a, 0x0d4d}
+  ,
+  {0x0d57, 0x0d57}
+  ,
+  {0x0d60, 0x0d63}
+  ,
+  {0x0d66, 0x0d75}
+  ,
+  {0x0d79, 0x0d7f}
+  ,
+  {0x0d82, 0x0d83}
+  ,
+  {0x0d85, 0x0d96}
+  ,
+  {0x0d9a, 0x0db1}
+  ,
+  {0x0db3, 0x0dbb}
+  ,
+  {0x0dbd, 0x0dbd}
+  ,
+  {0x0dc0, 0x0dc6}
+  ,
+  {0x0dca, 0x0dca}
+  ,
+  {0x0dcf, 0x0dd4}
+  ,
+  {0x0dd6, 0x0dd6}
+  ,
+  {0x0dd8, 0x0ddf}
+  ,
+  {0x0df2, 0x0df4}
+  ,
+  {0x0e01, 0x0e3a}
+  ,
+  {0x0e3f, 0x0e5b}
+  ,
+  {0x0e81, 0x0e82}
+  ,
+  {0x0e84, 0x0e84}
+  ,
+  {0x0e87, 0x0e88}
+  ,
+  {0x0e8a, 0x0e8a}
+  ,
+  {0x0e8d, 0x0e8d}
+  ,
+  {0x0e94, 0x0e97}
+  ,
+  {0x0e99, 0x0e9f}
+  ,
+  {0x0ea1, 0x0ea3}
+  ,
+  {0x0ea5, 0x0ea5}
+  ,
+  {0x0ea7, 0x0ea7}
+  ,
+  {0x0eaa, 0x0eab}
+  ,
+  {0x0ead, 0x0eb9}
+  ,
+  {0x0ebb, 0x0ebd}
+  ,
+  {0x0ec0, 0x0ec4}
+  ,
+  {0x0ec6, 0x0ec6}
+  ,
+  {0x0ec8, 0x0ecd}
+  ,
+  {0x0ed0, 0x0ed9}
+  ,
+  {0x0edc, 0x0edd}
+  ,
+  {0x0f00, 0x0f47}
+  ,
+  {0x0f49, 0x0f6c}
+  ,
+  {0x0f71, 0x0f8b}
+  ,
+  {0x0f90, 0x0f97}
+  ,
+  {0x0f99, 0x0fbc}
+  ,
+  {0x0fbe, 0x0fcc}
+  ,
+  {0x0fce, 0x0fd4}
+  ,
+  {0x1000, 0x1099}
+  ,
+  {0x109e, 0x10c5}
+  ,
+  {0x10d0, 0x10fc}
+  ,
+  {0x1100, 0x1159}
+  ,
+  {0x115f, 0x11a2}
+  ,
+  {0x11a8, 0x11f9}
+  ,
+  {0x1200, 0x1248}
+  ,
+  {0x124a, 0x124d}
+  ,
+  {0x1250, 0x1256}
+  ,
+  {0x1258, 0x1258}
+  ,
+  {0x125a, 0x125d}
+  ,
+  {0x1260, 0x1288}
+  ,
+  {0x128a, 0x128d}
+  ,
+  {0x1290, 0x12b0}
+  ,
+  {0x12b2, 0x12b5}
+  ,
+  {0x12b8, 0x12be}
+  ,
+  {0x12c0, 0x12c0}
+  ,
+  {0x12c2, 0x12c5}
+  ,
+  {0x12c8, 0x12d6}
+  ,
+  {0x12d8, 0x1310}
+  ,
+  {0x1312, 0x1315}
+  ,
+  {0x1318, 0x135a}
+  ,
+  {0x135f, 0x137c}
+  ,
+  {0x1380, 0x1399}
+  ,
+  {0x13a0, 0x13f4}
+  ,
+  {0x1401, 0x1676}
+  ,
+  {0x1680, 0x169c}
+  ,
+  {0x16a0, 0x16f0}
+  ,
+  {0x1700, 0x170c}
+  ,
+  {0x170e, 0x1714}
+  ,
+  {0x1720, 0x1736}
+  ,
+  {0x1740, 0x1753}
+  ,
+  {0x1760, 0x176c}
+  ,
+  {0x176e, 0x1770}
+  ,
+  {0x1772, 0x1773}
+  ,
+  {0x1780, 0x17dd}
+  ,
+  {0x17e0, 0x17e9}
+  ,
+  {0x17f0, 0x17f9}
+  ,
+  {0x1800, 0x180e}
+  ,
+  {0x1810, 0x1819}
+  ,
+  {0x1820, 0x1877}
+  ,
+  {0x1880, 0x18aa}
+  ,
+  {0x1900, 0x191c}
+  ,
+  {0x1920, 0x192b}
+  ,
+  {0x1930, 0x193b}
+  ,
+  {0x1940, 0x1940}
+  ,
+  {0x1944, 0x196d}
+  ,
+  {0x1970, 0x1974}
+  ,
+  {0x1980, 0x19a9}
+  ,
+  {0x19b0, 0x19c9}
+  ,
+  {0x19d0, 0x19d9}
+  ,
+  {0x19de, 0x1a1b}
+  ,
+  {0x1a1e, 0x1a1f}
+  ,
+  {0x1b00, 0x1b4b}
+  ,
+  {0x1b50, 0x1b7c}
+  ,
+  {0x1b80, 0x1baa}
+  ,
+  {0x1bae, 0x1bb9}
+  ,
+  {0x1c00, 0x1c37}
+  ,
+  {0x1c3b, 0x1c49}
+  ,
+  {0x1c4d, 0x1c7f}
+  ,
+  {0x1d00, 0x1de6}
+  ,
+  {0x1dfe, 0x1f15}
+  ,
+  {0x1f18, 0x1f1d}
+  ,
+  {0x1f20, 0x1f45}
+  ,
+  {0x1f48, 0x1f4d}
+  ,
+  {0x1f50, 0x1f57}
+  ,
+  {0x1f59, 0x1f59}
+  ,
+  {0x1f5b, 0x1f5b}
+  ,
+  {0x1f5d, 0x1f5d}
+  ,
+  {0x1f5f, 0x1f7d}
+  ,
+  {0x1f80, 0x1fb4}
+  ,
+  {0x1fb6, 0x1fc4}
+  ,
+  {0x1fc6, 0x1fd3}
+  ,
+  {0x1fd6, 0x1fdb}
+  ,
+  {0x1fdd, 0x1fef}
+  ,
+  {0x1ff2, 0x1ff4}
+  ,
+  {0x1ff6, 0x1ffe}
+  ,
+  {0x2000, 0x2064}
+  ,
+  {0x206a, 0x2071}
+  ,
+  {0x2074, 0x208e}
+  ,
+  {0x2090, 0x2094}
+  ,
+  {0x20a0, 0x20b5}
+  ,
+  {0x20d0, 0x20f0}
+  ,
+  {0x2100, 0x214f}
+  ,
+  {0x2153, 0x2188}
+  ,
+  {0x2190, 0x23e7}
+  ,
+  {0x2400, 0x2426}
+  ,
+  {0x2440, 0x244a}
+  ,
+  {0x2460, 0x269d}
+  ,
+  {0x26a0, 0x26bc}
+  ,
+  {0x26c0, 0x26c3}
+  ,
+  {0x2701, 0x2704}
+  ,
+  {0x2706, 0x2709}
+  ,
+  {0x270c, 0x2727}
+  ,
+  {0x2729, 0x274b}
+  ,
+  {0x274d, 0x274d}
+  ,
+  {0x274f, 0x2752}
+  ,
+  {0x2756, 0x2756}
+  ,
+  {0x2758, 0x275e}
+  ,
+  {0x2761, 0x2794}
+  ,
+  {0x2798, 0x27af}
+  ,
+  {0x27b1, 0x27be}
+  ,
+  {0x27c0, 0x27ca}
+  ,
+  {0x27cc, 0x27cc}
+  ,
+  {0x27d0, 0x2b4c}
+  ,
+  {0x2b50, 0x2b54}
+  ,
+  {0x2c00, 0x2c2e}
+  ,
+  {0x2c30, 0x2c5e}
+  ,
+  {0x2c60, 0x2c6f}
+  ,
+  {0x2c71, 0x2c7d}
+  ,
+  {0x2c80, 0x2cea}
+  ,
+  {0x2cf9, 0x2d25}
+  ,
+  {0x2d30, 0x2d65}
+  ,
+  {0x2d6f, 0x2d6f}
+  ,
+  {0x2d80, 0x2d96}
+  ,
+  {0x2da0, 0x2da6}
+  ,
+  {0x2da8, 0x2dae}
+  ,
+  {0x2db0, 0x2db6}
+  ,
+  {0x2db8, 0x2dbe}
+  ,
+  {0x2dc0, 0x2dc6}
+  ,
+  {0x2dc8, 0x2dce}
+  ,
+  {0x2dd0, 0x2dd6}
+  ,
+  {0x2dd8, 0x2dde}
+  ,
+  {0x2de0, 0x2e30}
+  ,
+  {0x2e80, 0x2e99}
+  ,
+  {0x2e9b, 0x2ef3}
+  ,
+  {0x2f00, 0x2fd5}
+  ,
+  {0x2ff0, 0x2ffb}
+  ,
+  {0x3000, 0x303f}
+  ,
+  {0x3041, 0x3096}
+  ,
+  {0x3099, 0x30ff}
+  ,
+  {0x3105, 0x312d}
+  ,
+  {0x3131, 0x318e}
+  ,
+  {0x3190, 0x31b7}
+  ,
+  {0x31c0, 0x31e3}
+  ,
+  {0x31f0, 0x321e}
+  ,
+  {0x3220, 0x3243}
+  ,
+  {0x3250, 0x32fe}
+  ,
+  {0x3300, 0x4db5}
+  ,
+  {0x4dc0, 0x9fc3}
+  ,
+  {0xa000, 0xa48c}
+  ,
+  {0xa490, 0xa4c6}
+  ,
+  {0xa500, 0xa62b}
+  ,
+  {0xa640, 0xa65f}
+  ,
+  {0xa662, 0xa673}
+  ,
+  {0xa67c, 0xa697}
+  ,
+  {0xa700, 0xa78c}
+  ,
+  {0xa7fb, 0xa82b}
+  ,
+  {0xa840, 0xa877}
+  ,
+  {0xa880, 0xa8c4}
+  ,
+  {0xa8ce, 0xa8d9}
+  ,
+  {0xa900, 0xa953}
+  ,
+  {0xa95f, 0xa95f}
+  ,
+  {0xaa00, 0xaa36}
+  ,
+  {0xaa40, 0xaa4d}
+  ,
+  {0xaa50, 0xaa59}
+  ,
+  {0xaa5c, 0xaa5f}
+  ,
+  {0xac00, 0xd7a3}
+  ,
+  {0xd800, 0xfa2d}
+  ,
+  {0xfa30, 0xfa6a}
+  ,
+  {0xfa70, 0xfad9}
+  ,
+  {0xfb00, 0xfb06}
+  ,
+  {0xfb13, 0xfb17}
+  ,
+  {0xfb1d, 0xfb36}
+  ,
+  {0xfb38, 0xfb3c}
+  ,
+  {0xfb3e, 0xfb3e}
+  ,
+  {0xfb40, 0xfb41}
+  ,
+  {0xfb43, 0xfb44}
+  ,
+  {0xfb46, 0xfbb1}
+  ,
+  {0xfbd3, 0xfd3f}
+  ,
+  {0xfd50, 0xfd8f}
+  ,
+  {0xfd92, 0xfdc7}
+  ,
+  {0xfdf0, 0xfdfd}
+  ,
+  {0xfe00, 0xfe19}
+  ,
+  {0xfe20, 0xfe26}
+  ,
+  {0xfe30, 0xfe52}
+  ,
+  {0xfe54, 0xfe66}
+  ,
+  {0xfe68, 0xfe6b}
+  ,
+  {0xfe70, 0xfe74}
+  ,
+  {0xfe76, 0xfefc}
+  ,
+  {0xfeff, 0xfeff}
+  ,
+  {0xff01, 0xffbe}
+  ,
+  {0xffc2, 0xffc7}
+  ,
+  {0xffca, 0xffcf}
+  ,
+  {0xffd2, 0xffd7}
+  ,
+  {0xffda, 0xffdc}
+  ,
+  {0xffe0, 0xffe6}
+  ,
+  {0xffe8, 0xffee}
+  ,
+  {0xfff9, 0xfffd}
+  ,
+  {0x10000, 0x1000b}
+  ,
+  {0x1000d, 0x10026}
+  ,
+  {0x10028, 0x1003a}
+  ,
+  {0x1003c, 0x1003d}
+  ,
+  {0x1003f, 0x1004d}
+  ,
+  {0x10050, 0x1005d}
+  ,
+  {0x10080, 0x100fa}
+  ,
+  {0x10100, 0x10102}
+  ,
+  {0x10107, 0x10133}
+  ,
+  {0x10137, 0x1018a}
+  ,
+  {0x10190, 0x1019b}
+  ,
+  {0x101d0, 0x101fd}
+  ,
+  {0x10280, 0x1029c}
+  ,
+  {0x102a0, 0x102d0}
+  ,
+  {0x10300, 0x1031e}
+  ,
+  {0x10320, 0x10323}
+  ,
+  {0x10330, 0x1034a}
+  ,
+  {0x10380, 0x1039d}
+  ,
+  {0x1039f, 0x103c3}
+  ,
+  {0x103c8, 0x103d5}
+  ,
+  {0x10400, 0x1049d}
+  ,
+  {0x104a0, 0x104a9}
+  ,
+  {0x10800, 0x10805}
+  ,
+  {0x10808, 0x10808}
+  ,
+  {0x1080a, 0x10835}
+  ,
+  {0x10837, 0x10838}
+  ,
+  {0x1083c, 0x1083c}
+  ,
+  {0x1083f, 0x1083f}
+  ,
+  {0x10900, 0x10919}
+  ,
+  {0x1091f, 0x10939}
+  ,
+  {0x1093f, 0x1093f}
+  ,
+  {0x10a00, 0x10a03}
+  ,
+  {0x10a05, 0x10a06}
+  ,
+  {0x10a0c, 0x10a13}
+  ,
+  {0x10a15, 0x10a17}
+  ,
+  {0x10a19, 0x10a33}
+  ,
+  {0x10a38, 0x10a3a}
+  ,
+  {0x10a3f, 0x10a47}
+  ,
+  {0x10a50, 0x10a58}
+  ,
+  {0x12000, 0x1236e}
+  ,
+  {0x12400, 0x12462}
+  ,
+  {0x12470, 0x12473}
+  ,
+  {0x1d000, 0x1d0f5}
+  ,
+  {0x1d100, 0x1d126}
+  ,
+  {0x1d129, 0x1d1dd}
+  ,
+  {0x1d200, 0x1d245}
+  ,
+  {0x1d300, 0x1d356}
+  ,
+  {0x1d360, 0x1d371}
+  ,
+  {0x1d400, 0x1d454}
+  ,
+  {0x1d456, 0x1d49c}
+  ,
+  {0x1d49e, 0x1d49f}
+  ,
+  {0x1d4a2, 0x1d4a2}
+  ,
+  {0x1d4a5, 0x1d4a6}
+  ,
+  {0x1d4a9, 0x1d4ac}
+  ,
+  {0x1d4ae, 0x1d4b9}
+  ,
+  {0x1d4bb, 0x1d4bb}
+  ,
+  {0x1d4bd, 0x1d4c3}
+  ,
+  {0x1d4c5, 0x1d505}
+  ,
+  {0x1d507, 0x1d50a}
+  ,
+  {0x1d50d, 0x1d514}
+  ,
+  {0x1d516, 0x1d51c}
+  ,
+  {0x1d51e, 0x1d539}
+  ,
+  {0x1d53b, 0x1d53e}
+  ,
+  {0x1d540, 0x1d544}
+  ,
+  {0x1d546, 0x1d546}
+  ,
+  {0x1d54a, 0x1d550}
+  ,
+  {0x1d552, 0x1d6a5}
+  ,
+  {0x1d6a8, 0x1d7cb}
+  ,
+  {0x1d7ce, 0x1d7ff}
+  ,
+  {0x1f000, 0x1f02b}
+  ,
+  {0x1f030, 0x1f093}
+  ,
+  {0x20000, 0x2a6d6}
+  ,
+  {0x2f800, 0x2fa1d}
+  ,
+  {0xe0001, 0xe0001}
+  ,
+  {0xe0020, 0xe007f}
+  ,
+  {0xe0100, 0xe01ef}
+  ,
+  {0xf0000, 0xffffd}
+  ,
+  {0x100000, 0x10fffd}
+};
+
+scm_t_char_set cs_full = {
+  445,
+  cs_full_ranges
+};
diff --git a/libguile/srfi-4.c b/libguile/srfi-4.c
index 3e43a4985..302414364 100644
--- a/libguile/srfi-4.c
+++ b/libguile/srfi-4.c
@@ -1,20 +1,21 @@
 /* srfi-4.c --- Uniform numeric vector datatypes.
  *
- * 	Copyright (C) 2001, 2004, 2006 Free Software Foundation, Inc.
+ * 	Copyright (C) 2001, 2004, 2006, 2009 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 #ifdef HAVE_CONFIG_H
@@ -27,13 +28,19 @@
 
 #include "libguile/_scm.h"
 #include "libguile/__scm.h"
+#include "libguile/boehm-gc.h"
 #include "libguile/srfi-4.h"
+#include "libguile/bitvectors.h"
+#include "libguile/bytevectors.h"
+#include "libguile/generalized-vectors.h"
+#include "libguile/uniform.h"
 #include "libguile/error.h"
+#include "libguile/eval.h"
 #include "libguile/read.h"
 #include "libguile/ports.h"
 #include "libguile/chars.h"
 #include "libguile/vectors.h"
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
 #include "libguile/strings.h"
 #include "libguile/strports.h"
 #include "libguile/dynwind.h"
@@ -275,6 +282,14 @@ uvec_assert (int type, SCM obj)
     scm_wrong_type_arg_msg (NULL, 0, obj, uvec_names[type]);
 }
 
+/* Invoke free(3) on DATA, a user-provided buffer passed to one of the
+   `scm_take_' functions.  */
+static void
+free_user_data (GC_PTR data, GC_PTR unused)
+{
+  free (data);
+}
+
 static SCM
 take_uvec (int type, void *base, size_t len)
 {
@@ -466,11 +481,8 @@ uvec_to_list (int type, SCM uvec)
   SCM res = SCM_EOL;
 
   elts = uvec_elements (type, uvec, &handle, &len, &inc);
-  for (i = len*inc; i > 0;)
-    {
-      i -= inc;
-      res = scm_cons (scm_array_handle_ref (&handle, i), res);
-    }
+  for (i = len - 1; i >= 0; i--)
+    res = scm_cons (scm_array_handle_ref (&handle, i*inc), res);
   scm_array_handle_release (&handle);
   return res;
 }
@@ -543,29 +555,6 @@ list_to_uvec (int type, SCM list)
   return uvec;
 }
 
-static SCM
-coerce_to_uvec (int type, SCM obj)
-{
-  if (is_uvec (type, obj))
-    return obj;
-  else if (scm_is_pair (obj))
-    return list_to_uvec (type, obj);
-  else if (scm_is_generalized_vector (obj))
-    {
-      scm_t_array_handle handle;
-      size_t len = scm_c_generalized_vector_length (obj), i;
-      SCM uvec = alloc_uvec (type, len);
-      scm_array_get_handle (uvec, &handle);
-      for (i = 0; i < len; i++)
-	scm_array_handle_set (&handle, i,
-			      scm_c_generalized_vector_ref (obj, i));
-      scm_array_handle_release (&handle);
-      return uvec;
-    }
-  else
-    scm_wrong_type_arg_msg (NULL, 0, obj, "list or generalized vector");
-}
-
 SCM_SYMBOL (scm_sym_a, "a");
 SCM_SYMBOL (scm_sym_b, "b");
 
@@ -580,222 +569,12 @@ scm_i_generalized_vector_type (SCM v)
     return scm_sym_b;
   else if (scm_is_uniform_vector (v))
     return scm_from_locale_symbol (uvec_tags[SCM_UVEC_TYPE(v)]);
+  else if (scm_is_bytevector (v))
+    return scm_from_locale_symbol ("vu8");
   else
     return SCM_BOOL_F;
 }
 
-int
-scm_is_uniform_vector (SCM obj)
-{
-  if (SCM_IS_UVEC (obj))
-    return 1;
-  if (SCM_I_ARRAYP (obj) && SCM_I_ARRAY_NDIM (obj) == 1)
-    {
-      SCM v = SCM_I_ARRAY_V (obj);
-      return SCM_IS_UVEC (v);
-    }
-  return 0;
-}
-
-size_t
-scm_c_uniform_vector_length (SCM uvec)
-{
-  /* scm_generalized_vector_get_handle will ultimately call us to get
-     the length of uniform vectors, so we can't use uvec_elements for
-     naked vectors.
-  */
-
-  if (SCM_IS_UVEC (uvec))
-    return SCM_UVEC_LENGTH (uvec);
-  else
-    {
-      scm_t_array_handle handle;
-      size_t len;
-      ssize_t inc;
-      uvec_elements (-1, uvec, &handle, &len, &inc);
-      scm_array_handle_release (&handle);
-      return len;
-    }
-}
-
-SCM_DEFINE (scm_uniform_vector_p, "uniform-vector?", 1, 0, 0,
-	    (SCM obj),
-	    "Return @code{#t} if @var{obj} is a uniform vector.")
-#define FUNC_NAME s_scm_uniform_vector_p
-{
-  return scm_from_bool (scm_is_uniform_vector (obj));
-}
-#undef FUNC_NAME
-
-SCM
-scm_c_uniform_vector_ref (SCM v, size_t idx)
-{
-  scm_t_array_handle handle;
-  size_t len;
-  ssize_t inc;
-  SCM res;
-
-  uvec_elements (-1, v, &handle, &len, &inc);
-  if (idx >= len)
-    scm_out_of_range (NULL, scm_from_size_t (idx));
-  res = scm_array_handle_ref (&handle, idx*inc);
-  scm_array_handle_release (&handle);
-  return res;
-}
-
-SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0,
-	    (SCM v, SCM idx),
-	    "Return the element at index @var{idx} of the\n"
-	    "homogenous numeric vector @var{v}.")
-#define FUNC_NAME s_scm_uniform_vector_ref
-{
-#if SCM_ENABLE_DEPRECATED
-  /* Support old argument convention.
-   */
-  if (scm_is_pair (idx))
-    {
-      scm_c_issue_deprecation_warning
-	("Using a list as the index to uniform-vector-ref is deprecated.");
-      if (!scm_is_null (SCM_CDR (idx)))
-	scm_wrong_num_args (NULL);
-      idx = SCM_CAR (idx);
-    }
-#endif
-
-  return scm_c_uniform_vector_ref (v, scm_to_size_t (idx));
-}
-#undef FUNC_NAME
-
-void
-scm_c_uniform_vector_set_x (SCM v, size_t idx, SCM val)
-{
-  scm_t_array_handle handle;
-  size_t len;
-  ssize_t inc;
-
-  uvec_writable_elements (-1, v, &handle, &len, &inc);
-  if (idx >= len)
-    scm_out_of_range (NULL, scm_from_size_t (idx));
-  scm_array_handle_set (&handle, idx*inc, val);
-  scm_array_handle_release (&handle);
-}
-
-SCM_DEFINE (scm_uniform_vector_set_x, "uniform-vector-set!", 3, 0, 0,
-	    (SCM v, SCM idx, SCM val),
-	    "Set the element at index @var{idx} of the\n"
-	    "homogenous numeric vector @var{v} to @var{val}.")
-#define FUNC_NAME s_scm_uniform_vector_set_x
-{
-#if SCM_ENABLE_DEPRECATED
-  /* Support old argument convention.
-   */
-  if (scm_is_pair (idx))
-    {
-      scm_c_issue_deprecation_warning
-	("Using a list as the index to uniform-vector-set! is deprecated.");
-      if (!scm_is_null (SCM_CDR (idx)))
-	scm_wrong_num_args (NULL);
-      idx = SCM_CAR (idx);
-    }
-#endif
-
-  scm_c_uniform_vector_set_x (v, scm_to_size_t (idx), val);
-  return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_uniform_vector_to_list, "uniform-vector->list", 1, 0, 0,
-            (SCM uvec),
-	    "Convert the uniform numeric vector @var{uvec} to a list.")
-#define FUNC_NAME s_scm_uniform_vector_to_list
-{
-  return uvec_to_list (-1, uvec);
-}
-#undef FUNC_NAME
-
-size_t
-scm_array_handle_uniform_element_size (scm_t_array_handle *h)
-{
-  SCM vec = h->array;
-  if (SCM_I_ARRAYP (vec))
-    vec = SCM_I_ARRAY_V (vec);
-  if (scm_is_uniform_vector (vec))
-    return uvec_sizes[SCM_UVEC_TYPE(vec)];
-  scm_wrong_type_arg_msg (NULL, 0, h->array, "uniform array");
-}
-
-#if SCM_ENABLE_DEPRECATED
- 
-/* return the size of an element in a uniform array or 0 if type not
-   found.  */
-size_t
-scm_uniform_element_size (SCM obj)
-{
-  scm_c_issue_deprecation_warning 
-    ("scm_uniform_element_size is deprecated.  "
-     "Use scm_array_handle_uniform_element_size instead.");
-
-  if (SCM_IS_UVEC (obj))
-    return uvec_sizes[SCM_UVEC_TYPE(obj)];
-  else
-    return 0;
-}
-
-#endif
-
-const void *
-scm_array_handle_uniform_elements (scm_t_array_handle *h)
-{
-  return scm_array_handle_uniform_writable_elements (h);
-}
-
-void *
-scm_array_handle_uniform_writable_elements (scm_t_array_handle *h)
-{
-  SCM vec = h->array;
-  if (SCM_I_ARRAYP (vec))
-    vec = SCM_I_ARRAY_V (vec);
-  if (SCM_IS_UVEC (vec))
-    {
-      size_t size = uvec_sizes[SCM_UVEC_TYPE(vec)];
-      char *elts = SCM_UVEC_BASE (vec);
-      return (void *) (elts + size*h->base);
-    }
-  scm_wrong_type_arg_msg (NULL, 0, h->array, "uniform array");
-}
-
-const void *
-scm_uniform_vector_elements (SCM uvec, 
-			     scm_t_array_handle *h,
-			     size_t *lenp, ssize_t *incp)
-{
-  return scm_uniform_vector_writable_elements (uvec, h, lenp, incp);
-}
-
-void *
-scm_uniform_vector_writable_elements (SCM uvec, 
-				      scm_t_array_handle *h,
-				      size_t *lenp, ssize_t *incp)
-{
-  scm_generalized_vector_get_handle (uvec, h);
-  if (lenp)
-    {
-      scm_t_array_dim *dim = scm_array_handle_dims (h);
-      *lenp = dim->ubnd - dim->lbnd + 1;
-      *incp = dim->inc;
-    }
-  return scm_array_handle_uniform_writable_elements (h);
-}
-
-SCM_DEFINE (scm_uniform_vector_length, "uniform-vector-length", 1, 0, 0, 
-	    (SCM v),
-	    "Return the number of elements in the uniform vector @var{v}.")
-#define FUNC_NAME s_scm_uniform_vector_length
-{
-  return uvec_length (-1, v);
-}
-#undef FUNC_NAME
-
 SCM_DEFINE (scm_uniform_vector_read_x, "uniform-vector-read!", 1, 3, 0,
            (SCM uvec, SCM port_or_fd, SCM start, SCM end),
 	    "Fill the elements of @var{uvec} by reading\n"
@@ -1031,6 +810,36 @@ SCM_DEFINE (scm_uniform_vector_write, "uniform-vector-write", 1, 3, 0,
 #define CTYPE double
 #include "libguile/srfi-4.i.c"
 
+#define DEFINE_SCHEME_PROXY100(cname, modname, scmname)                 \
+  SCM cname (SCM arg1)                                                  \
+  {                                                                     \
+    static SCM var = SCM_BOOL_F;                                        \
+    if (scm_is_false (var))                                             \
+      var = scm_c_module_lookup (scm_c_resolve_module (modname), scmname); \
+    return scm_call_1 (SCM_VARIABLE_REF (var), arg1);                   \
+  }
+
+#define DEFPROXY100(cname, scmname)               \
+  DEFINE_SCHEME_PROXY100 (cname, MOD, scmname)
+
+#define DEFINE_SRFI_4_GNU_PROXIES(tag)                              \
+  DEFPROXY100 (scm_any_to_##tag##vector, "any->" #tag "vector")
+
+#define MOD "srfi srfi-4 gnu"
+DEFINE_SRFI_4_GNU_PROXIES (u8);
+DEFINE_SRFI_4_GNU_PROXIES (s8);
+DEFINE_SRFI_4_GNU_PROXIES (u16);
+DEFINE_SRFI_4_GNU_PROXIES (s16);
+DEFINE_SRFI_4_GNU_PROXIES (u32);
+DEFINE_SRFI_4_GNU_PROXIES (s32);
+DEFINE_SRFI_4_GNU_PROXIES (u64);
+DEFINE_SRFI_4_GNU_PROXIES (s64);
+DEFINE_SRFI_4_GNU_PROXIES (f32);
+DEFINE_SRFI_4_GNU_PROXIES (f64);
+DEFINE_SRFI_4_GNU_PROXIES (c32);
+DEFINE_SRFI_4_GNU_PROXIES (c64);
+
+
 static scm_i_t_array_ref uvec_reffers[12] = {
   u8ref, s8ref,
   u16ref, s16ref,
@@ -1049,18 +858,35 @@ static scm_i_t_array_set uvec_setters[12] = {
   c32set, c64set
 };
 
-scm_i_t_array_ref
-scm_i_uniform_vector_ref_proc (SCM uvec)
+static SCM
+uvec_handle_ref (scm_t_array_handle *h, size_t index)
 {
-  return uvec_reffers[SCM_UVEC_TYPE(uvec)];
+  return uvec_reffers [SCM_UVEC_TYPE(h->array)] (h, index);
 }
 
-scm_i_t_array_set
-scm_i_uniform_vector_set_proc (SCM uvec)
+static void
+uvec_handle_set (scm_t_array_handle *h, size_t index, SCM val)
 {
-  return uvec_setters[SCM_UVEC_TYPE(uvec)];
+  uvec_setters [SCM_UVEC_TYPE(h->array)] (h, index, val);
 }
 
+static void
+uvec_get_handle (SCM v, scm_t_array_handle *h)
+{
+  h->array = v;
+  h->ndims = 1;
+  h->dims = &h->dim0;
+  h->dim0.lbnd = 0;
+  h->dim0.ubnd = SCM_UVEC_LENGTH (v) - 1;
+  h->dim0.inc = 1;
+  h->element_type = SCM_UVEC_TYPE (v) + SCM_ARRAY_ELEMENT_TYPE_U8;
+  h->elements = h->writable_elements = SCM_UVEC_BASE (v);
+}
+
+SCM_ARRAY_IMPLEMENTATION (scm_tc16_uvec, 0xffff,
+                          uvec_handle_ref, uvec_handle_set,
+                          uvec_get_handle);
+
 void
 scm_init_srfi_4 (void)
 {
@@ -1079,6 +905,24 @@ scm_init_srfi_4 (void)
     scm_permanent_object (scm_c_read_string ("9223372036854775807"));
 #endif
 
+#define REGISTER(tag, TAG)                                       \
+  scm_i_register_vector_constructor                              \
+    (scm_i_array_element_types[SCM_ARRAY_ELEMENT_TYPE_##TAG],    \
+     scm_make_##tag##vector)
+
+  REGISTER (u8, U8); 
+  REGISTER (s8, S8); 
+  REGISTER (u16, U16);
+  REGISTER (s16, S16);
+  REGISTER (u32, U32);
+  REGISTER (s32, S32);
+  REGISTER (u64, U64);
+  REGISTER (s64, S64);
+  REGISTER (f32, F32);
+  REGISTER (f64, F64);
+  REGISTER (c32, C32);
+  REGISTER (c64, C64);
+
 #include "libguile/srfi-4.x"
 
 }
diff --git a/libguile/srfi-4.h b/libguile/srfi-4.h
index 3c340d91e..3a45fd9e0 100644
--- a/libguile/srfi-4.h
+++ b/libguile/srfi-4.h
@@ -2,54 +2,26 @@
 #define SCM_SRFI_4_H
 /* srfi-4.c --- Homogeneous numeric vector datatypes.
  *
- * 	Copyright (C) 2001, 2004, 2006, 2008 Free Software Foundation, Inc.
+ * 	Copyright (C) 2001, 2004, 2006, 2008, 2009 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
 #include "libguile/__scm.h"
-#include "libguile/unif.h"
-
-/* Generic procedures.
- */
-
-SCM_API SCM scm_uniform_vector_p (SCM v);
-SCM_API SCM scm_uniform_vector_length (SCM v);
-SCM_API SCM scm_uniform_vector_ref (SCM v, SCM idx);
-SCM_API SCM scm_uniform_vector_set_x (SCM v, SCM idx, SCM val);
-SCM_API SCM scm_uniform_vector_to_list (SCM v);
-SCM_API SCM scm_uniform_vector_read_x (SCM v, SCM port_or_fd,
-				       SCM start, SCM end);
-SCM_API SCM scm_uniform_vector_write (SCM v, SCM port_or_fd,
-				      SCM start, SCM end);
-
-SCM_API int scm_is_uniform_vector (SCM obj);
-SCM_API size_t scm_c_uniform_vector_length (SCM v);
-SCM_API SCM scm_c_uniform_vector_ref (SCM v, size_t idx);
-SCM_API void scm_c_uniform_vector_set_x (SCM v, size_t idx, SCM val);
-SCM_API size_t scm_array_handle_uniform_element_size (scm_t_array_handle *h);
-SCM_API const void *scm_array_handle_uniform_elements (scm_t_array_handle *h);
-SCM_API void *scm_array_handle_uniform_writable_elements (scm_t_array_handle *h);
-SCM_API const void *scm_uniform_vector_elements (SCM uvec, 
-						 scm_t_array_handle *h,
-						 size_t *lenp, ssize_t *incp);
-SCM_API void *scm_uniform_vector_writable_elements (SCM uvec, 
-						    scm_t_array_handle *h,
-						    size_t *lenp,
-						    ssize_t *incp);
 
 /* Specific procedures.
  */
diff --git a/libguile/srfi-4.i.c b/libguile/srfi-4.i.c
index 58a52c1d8..098752ef2 100644
--- a/libguile/srfi-4.i.c
+++ b/libguile/srfi-4.i.c
@@ -121,24 +121,21 @@ SCM_DEFINE (F(scm_list_to_,TAG,vector), "list->"S(TAG)"vector", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (F(scm_any_to_,TAG,vector), "any->"S(TAG)"vector", 1, 0, 0,
-	    (SCM obj),
-	    "Convert @var{obj}, which can be a list, vector, or\n"
-	    "uniform vector, to a numeric uniform vector of\n"
-	    "type " S(TAG)".")
-#define FUNC_NAME s_F(scm_any_to_,TAG,vector)
-{
-  return coerce_to_uvec (TYPE, obj);
-}
-#undef FUNC_NAME
-
 #ifdef CTYPE
 
 SCM
 F(scm_take_,TAG,vector) (CTYPE *data, size_t n)
 {
-  scm_gc_register_collectable_memory ((void *)data, n*uvec_sizes[TYPE],
-				      uvec_names[TYPE]);
+  /* The manual says "Return a new uniform numeric vector [...] that uses the
+     memory pointed to by DATA".  We *have* to use DATA as the underlying
+     storage; thus we must register a finalizer to eventually free(3) it.  */
+  GC_finalization_proc prev_finalizer;
+  GC_PTR prev_finalization_data;
+
+  GC_REGISTER_FINALIZER_NO_ORDER (data, free_user_data, 0,
+				  &prev_finalizer,
+				  &prev_finalization_data);
+
   return take_uvec (TYPE, data, n);
 }
 
@@ -187,13 +184,13 @@ F(scm_,TAG,vector_writable_elements) (SCM uvec,
 #endif
 
 static SCM
-F(,TAG,ref) (scm_t_array_handle *handle, ssize_t pos)
+F(,TAG,ref) (scm_t_array_handle *handle, size_t pos)
 {
   return uvec_fast_ref (TYPE, handle->elements, pos);
 }
 
 static void
-F(,TAG,set) (scm_t_array_handle *handle, ssize_t pos, SCM val)
+F(,TAG,set) (scm_t_array_handle *handle, size_t pos, SCM val)
 {
   uvec_fast_set_x (TYPE, handle->writable_elements, pos, val);
 }
diff --git a/libguile/stackchk.c b/libguile/stackchk.c
index a53e67629..b14a71259 100644
--- a/libguile/stackchk.c
+++ b/libguile/stackchk.c
@@ -1,18 +1,19 @@
 /*	Copyright (C) 1995,1996,1997, 2000, 2001, 2006, 2008 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/stackchk.h b/libguile/stackchk.h
index 8681f5d46..6aa0fec18 100644
--- a/libguile/stackchk.h
+++ b/libguile/stackchk.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,1998,2000, 2003, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/stacks.c b/libguile/stacks.c
index 86597fa0b..45566cafa 100644
--- a/libguile/stacks.c
+++ b/libguile/stacks.c
@@ -2,18 +2,19 @@
  * Copyright (C) 1996,1997,2000,2001, 2006, 2007, 2008, 2009 Free Software Foundation
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -32,6 +33,8 @@
 #include "libguile/modules.h"
 #include "libguile/root.h"
 #include "libguile/strings.h"
+#include "libguile/vm.h" /* to capture vm stacks */
+#include "libguile/frames.h" /* vm frames */
 
 #include "libguile/validate.h"
 #include "libguile/stacks.h"
@@ -123,19 +126,17 @@
 #define RELOC_FRAME(ptr, offset) \
   ((scm_t_debug_frame *) ((SCM_STACKITEM *) (ptr) + (offset)))
 
-
 /* Count number of debug info frames on a stack, beginning with
  * DFRAME.  OFFSET is used for relocation of pointers when the stack
  * is read from a continuation.
  */
-static scm_t_bits
-stack_depth (scm_t_debug_frame *dframe, scm_t_ptrdiff offset,
-	     SCM *id, int *maxp)
+static long
+stack_depth (scm_t_debug_frame *dframe, scm_t_ptrdiff offset, SCM vmframe,
+	     SCM *id)
 {
   long n;
-  long max_depth = SCM_BACKTRACE_MAXDEPTH;
   for (n = 0;
-       dframe && !SCM_VOIDFRAMEP (*dframe) && n < max_depth;
+       dframe && !SCM_VOIDFRAMEP (*dframe);
        dframe = RELOC_FRAME (dframe->prev, offset))
     {
       if (SCM_EVALFRAMEP (*dframe))
@@ -148,15 +149,39 @@ stack_depth (scm_t_debug_frame *dframe, scm_t_ptrdiff offset,
 	  if ((((info - vect) & 1) == 0)
 	      && SCM_OVERFLOWP (*dframe)
 	      && !SCM_UNBNDP (info[1].a.proc))
-	    ++n;
+            ++n;
 	}
+      else if (SCM_APPLYFRAMEP (*dframe))
+        {
+          scm_t_debug_info *vect = RELOC_INFO (dframe->vect, offset);
+          if (SCM_PROGRAM_P (vect[0].a.proc))
+            {
+              if (!SCM_PROGRAM_IS_BOOT (vect[0].a.proc))
+                /* Programs can end up in the debug stack via deval; but we just
+                   ignore those, because we know that the debugging VM engine
+                   pushes one dframe per invocation, with the boot program as
+                   the proc, so we only count those. */
+                continue;
+              /* count vmframe back to previous boot frame */
+              for (; scm_is_true (vmframe); vmframe = scm_c_vm_frame_prev (vmframe))
+                {
+                  if (!SCM_PROGRAM_IS_BOOT (scm_vm_frame_program (vmframe)))
+                    ++n;
+                  else
+                    { /* skip boot frame, cut out of the vm backtrace */
+                      vmframe = scm_c_vm_frame_prev (vmframe);
+                      break;
+                    }
+                }
+            }
+          else
+            ++n; /* increment for non-program apply frame */
+        }
       else
 	++n;
     }
   if (dframe && SCM_VOIDFRAMEP (*dframe))
     *id = RELOC_INFO(dframe->vect, offset)[0].id;
-  else if (dframe)
-    *maxp = 1;
   return n;
 }
 
@@ -234,7 +259,7 @@ do { \
 
 static scm_t_bits
 read_frames (scm_t_debug_frame *dframe, scm_t_ptrdiff offset,
-	     long n, scm_t_info_frame *iframes)
+	     SCM vmframe, long n, scm_t_info_frame *iframes)
 {
   scm_t_info_frame *iframe = iframes;
   scm_t_debug_info *info, *vect;
@@ -293,10 +318,39 @@ read_frames (scm_t_debug_frame *dframe, scm_t_ptrdiff offset,
 	      NEXT_FRAME (iframe, n, quit);
 	    }
 	}
+      else if (SCM_PROGRAM_P (iframe->proc))
+        {
+          if (!SCM_PROGRAM_IS_BOOT (iframe->proc))
+            /* Programs can end up in the debug stack via deval; but we just
+               ignore those, because we know that the debugging VM engine
+               pushes one dframe per invocation, with the boot program as
+               the proc, so we only count those. */
+            continue;
+          for (; scm_is_true (vmframe);
+               vmframe = scm_c_vm_frame_prev (vmframe))
+            {
+              if (SCM_PROGRAM_IS_BOOT (scm_vm_frame_program (vmframe)))
+                { /* skip boot frame, back to interpreted frames */
+                  vmframe = scm_c_vm_frame_prev (vmframe);
+                  break;
+                }
+              else 
+                {
+                  /* Oh dear, oh dear, oh dear. */
+                  iframe->flags = SCM_UNPACK (SCM_INUM0) | SCM_FRAMEF_PROC;
+                  iframe->source = scm_vm_frame_source (vmframe);
+                  iframe->proc = scm_vm_frame_program (vmframe);
+                  iframe->args = scm_vm_frame_arguments (vmframe);
+                  ++iframe;
+                  if (--n == 0)
+                    goto quit;
+                }
+            }
+        }
       else
-	{
-	  NEXT_FRAME (iframe, n, quit);
-	}
+        {
+          NEXT_FRAME (iframe, n, quit);
+        }
     quit:
       if (iframe > iframes)
 	(iframe - 1) -> flags |= SCM_FRAMEF_REAL;
@@ -428,6 +482,7 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
   int maxp;
   scm_t_debug_frame *dframe;
   scm_t_info_frame *iframe;
+  SCM vmframe;
   long offset = 0;
   SCM stack, id;
   SCM inner_cut, outer_cut;
@@ -436,17 +491,37 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
      scm_make_stack was given.  */
   if (scm_is_eq (obj, SCM_BOOL_T))
     {
+      struct scm_vm *vp = SCM_VM_DATA (scm_the_vm ());
       dframe = scm_i_last_debug_frame ();
+      vmframe = scm_c_make_vm_frame (scm_the_vm (), vp->fp, vp->sp, vp->ip, 0);
     }
   else if (SCM_DEBUGOBJP (obj))
     {
       dframe = SCM_DEBUGOBJ_FRAME (obj);
+      vmframe = SCM_BOOL_F;
+    }
+  else if (SCM_VM_FRAME_P (obj))
+    {
+      dframe = NULL;
+      vmframe = obj;
     }
   else if (SCM_CONTINUATIONP (obj))
     {
       scm_t_contregs *cont = SCM_CONTREGS (obj);
       offset = cont->offset;
       dframe = RELOC_FRAME (cont->dframe, offset);
+      if (!scm_is_null (cont->vm_conts))
+        { SCM vm_cont;
+          struct scm_vm_cont *data;
+          vm_cont = scm_cdr (scm_car (cont->vm_conts));
+          data = SCM_VM_CONT_DATA (vm_cont);
+          vmframe = scm_c_make_vm_frame (vm_cont,
+                                         data->fp + data->reloc,
+                                         data->sp + data->reloc,
+                                         data->ip,
+                                         data->reloc);
+        } else 
+          vmframe = SCM_BOOL_F;
     }
   else
     {
@@ -459,7 +534,8 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
      (SCM_BACKTRACE_MAXDEPTH). */
   id = SCM_BOOL_F;
   maxp = 0;
-  n = stack_depth (dframe, offset, &id, &maxp);
+  n = stack_depth (dframe, offset, vmframe, &id);
+  /* FIXME: redo maxp? */
   size = n * SCM_FRAME_N_SLOTS;
 
   /* Make the stack object. */
@@ -467,10 +543,15 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
   SCM_STACK (stack) -> id = id;
   iframe = &SCM_STACK (stack) -> tail[0];
   SCM_STACK (stack) -> frames = iframe;
+  SCM_STACK (stack) -> length = n;
 
   /* Translate the current chain of stack frames into debugging information. */
-  n = read_frames (dframe, offset, n, iframe);
-  SCM_STACK (stack) -> length = n;
+  n = read_frames (dframe, offset, vmframe, n, iframe);
+  if (n != SCM_STACK (stack)->length)
+    {
+      scm_puts ("warning: stack count incorrect!\n", scm_current_error_port ());
+      SCM_STACK (stack)->length = n;
+    }
 
   /* Narrow the stack according to the arguments given to scm_make_stack. */
   SCM_VALIDATE_REST_ARGUMENT (args);
@@ -497,12 +578,11 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
       n = SCM_STACK (stack) -> length;
     }
   
+  if (n > 0 && maxp)
+    iframe[n - 1].flags |= SCM_FRAMEF_OVERFLOW;
+
   if (n > 0)
-    {
-      if (maxp)
-	iframe[n - 1].flags |= SCM_FRAMEF_OVERFLOW;
-      return stack;
-    }
+    return stack;
   else
     return SCM_BOOL_F;
 }
diff --git a/libguile/stacks.h b/libguile/stacks.h
index 53633bc14..20735eff5 100644
--- a/libguile/stacks.h
+++ b/libguile/stacks.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,2000,2001, 2004, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/stime.c b/libguile/stime.c
index 34c8a98fa..54022c296 100644
--- a/libguile/stime.c
+++ b/libguile/stime.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -45,6 +46,7 @@
 #include <stdio.h>
 #include <errno.h>
 #include <strftime.h>
+#include <unistr.h>
 
 #include "libguile/_scm.h"
 #include "libguile/async.h"
@@ -52,6 +54,7 @@
 #include "libguile/strings.h"
 #include "libguile/vectors.h"
 #include "libguile/dynwind.h"
+#include "libguile/strings.h"
 
 #include "libguile/validate.h"
 #include "libguile/stime.h"
@@ -77,10 +80,6 @@
 # include <sys/timeb.h>
 #endif
 
-#if HAVE_CRT_EXTERNS_H
-#include <crt_externs.h>  /* for Darwin _NSGetEnviron */
-#endif
-
 #ifndef tzname /* For SGI.  */
 extern char *tzname[]; /* RS6000 and others reject char **tzname.  */
 #endif
@@ -98,15 +97,6 @@ extern char *strptime ();
 # define timet long
 #endif
 
-extern char ** environ;
-
-/* On Apple Darwin in a shared library there's no "environ" to access
-   directly, instead the address of that variable must be obtained with
-   _NSGetEnviron().  */
-#if HAVE__NSGETENVIRON && defined (PIC)
-#define environ (*_NSGetEnviron())
-#endif
-
 
 #ifdef HAVE_TIMES
 static
@@ -636,18 +626,20 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0,
 {
   struct tm t;
 
-  char *tbuf;
+  scm_t_uint8 *tbuf;
   int size = 50;
-  const char *fmt;
-  char *myfmt;
+  scm_t_uint8 *fmt;
+  scm_t_uint8 *myfmt;
   int len;
   SCM result;
 
   SCM_VALIDATE_STRING (1, format);
   bdtime2c (stime, &t, SCM_ARG2, FUNC_NAME);
 
-  fmt = scm_i_string_chars (format);
-  len = scm_i_string_length (format);
+  /* Convert string to UTF-8 so that non-ASCII characters in the
+     format are passed through unchanged.  */
+  fmt = scm_i_to_utf8_string (format);
+  len = strlen ((const char *) fmt);
 
   /* Ugly hack: strftime can return 0 if its buffer is too small,
      but some valid time strings (e.g. "%p") can sometimes produce
@@ -655,9 +647,11 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0,
      character to the format string, so that valid returns are always
      nonzero. */
   myfmt = scm_malloc (len+2);
-  *myfmt = 'x';
-  strncpy(myfmt+1, fmt, len);
-  myfmt[len+1] = 0;
+  *myfmt = (scm_t_uint8) 'x';
+  strncpy ((char *) myfmt + 1, (const char *) fmt, len);
+  myfmt[len + 1] = 0;
+  scm_remember_upto_here_1 (format);
+  free (fmt);
 
   tbuf = scm_malloc (size);
   {
@@ -692,7 +686,8 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0,
 
     /* Use `nstrftime ()' from Gnulib, which supports all GNU extensions
        supported by glibc.  */
-    while ((len = nstrftime (tbuf, size, myfmt, &t, 0, 0)) == 0)
+    while ((len = nstrftime ((char *) tbuf, size, 
+			     (const char *) myfmt, &t, 0, 0)) == 0)
       {
 	free (tbuf);
 	size *= 2;
@@ -708,7 +703,7 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0,
 #endif
     }
 
-  result = scm_from_locale_stringn (tbuf + 1, len - 1);
+  result = scm_i_from_utf8_string ((const scm_t_uint8 *) tbuf + 1);
   free (tbuf);
   free (myfmt);
 #if HAVE_STRUCT_TM_TM_ZONE
@@ -734,14 +729,17 @@ SCM_DEFINE (scm_strptime, "strptime", 2, 0, 0,
 #define FUNC_NAME s_scm_strptime
 {
   struct tm t;
-  const char *fmt, *str, *rest;
+  scm_t_uint8 *fmt, *str, *rest;
+  size_t used_len;
   long zoff;
 
   SCM_VALIDATE_STRING (1, format);
   SCM_VALIDATE_STRING (2, string);
 
-  fmt = scm_i_string_chars (format);
-  str = scm_i_string_chars (string);
+  /* Convert strings to UTF-8 so that non-ASCII characters are passed
+     through unchanged.  */
+  fmt = scm_i_to_utf8_string (format);
+  str = scm_i_to_utf8_string (string);
 
   /* initialize the struct tm */
 #define tm_init(field) t.field = 0
@@ -763,7 +761,8 @@ SCM_DEFINE (scm_strptime, "strptime", 2, 0, 0,
      fields, hence the use of SCM_CRITICAL_SECTION_START.  */
   t.tm_isdst = -1;
   SCM_CRITICAL_SECTION_START;
-  rest = strptime (str, fmt, &t);
+  rest = (scm_t_uint8 *) strptime ((const char *) str, 
+                                   (const char *) fmt, &t);
   SCM_CRITICAL_SECTION_END;
   if (rest == NULL)
     {
@@ -771,6 +770,9 @@ SCM_DEFINE (scm_strptime, "strptime", 2, 0, 0,
          instance it doesn't.  Force a sensible value for our error
          message.  */
       errno = EINVAL;
+      scm_remember_upto_here_2 (format, string);
+      free (str);
+      free (fmt);
       SCM_SYSERROR;
     }
 
@@ -782,8 +784,14 @@ SCM_DEFINE (scm_strptime, "strptime", 2, 0, 0,
   zoff = 0;
 #endif
 
+  /* Compute the number of UTF-8 characters.  */
+  used_len = u8_strnlen (str, rest-str);
+  scm_remember_upto_here_2 (format, string);
+  free (str);
+  free (fmt);
+
   return scm_cons (filltime (&t, zoff, NULL),
-		   scm_from_signed_integer (rest - str));
+		   scm_from_signed_integer (used_len));
 }
 #undef FUNC_NAME
 #endif /* HAVE_STRPTIME */
diff --git a/libguile/stime.h b/libguile/stime.h
index c64c60ea9..8b70cee62 100644
--- a/libguile/stime.h
+++ b/libguile/stime.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,1997,1998,2000, 2003, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/strerror.c b/libguile/strerror.c
index c2f20f0c2..0e0e94ee8 100644
--- a/libguile/strerror.c
+++ b/libguile/strerror.c
@@ -1,19 +1,20 @@
 /* Turning errno values into English error messages.
    Copyright (C) 1985, 86, 87, 88, 93, 94, 95, 2000, 2001, 2006 Free Software Foundation, Inc.
 
-  This library is free software; you can redistribute it and/or
-  modify it under the terms of the GNU Lesser General Public
-  License as published by the Free Software Foundation; either
-  version 2.1 of the License, or (at your option) any later version.
- 
-  This library is distributed in the hope that it will be useful,
-  but WITHOUT ANY WARRANTY; without even the implied warranty of
-  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-  Lesser General Public License for more details.
- 
-  You should have received a copy of the GNU Lesser General Public
-  License along with this library; if not, write to the Free Software
-  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+   This library is free software; you can redistribute it and/or
+   modify it under the terms of the GNU Lesser General Public License
+   as published by the Free Software Foundation; either version 3 of
+   the License, or (at your option) any later version.
+  
+   This library is distributed in the hope that it will be useful, but
+   WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   Lesser General Public License for more details.
+  
+   You should have received a copy of the GNU Lesser General Public
+   License along with this library; if not, write to the Free Software
+   Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+   02110-1301 USA
 */
 
 char *
diff --git a/libguile/strings.c b/libguile/strings.c
index 1839c6ac0..03ead8138 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1995,1996,1998,2000,2001, 2004, 2006, 2008, 2009 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -23,11 +24,17 @@
 
 #include <string.h>
 #include <stdio.h>
+#include <ctype.h>
+#include <unistr.h>
+#include <uniconv.h>
+
+#include "striconveh.h"
 
 #include "libguile/_scm.h"
 #include "libguile/chars.h"
 #include "libguile/root.h"
 #include "libguile/strings.h"
+#include "libguile/generalized-vectors.h"
 #include "libguile/deprecation.h"
 #include "libguile/validate.h"
 
@@ -41,7 +48,7 @@
  *
  * XXX - keeping an accurate refcount during GC seems to be quite
  * tricky, so we just keep score of whether a stringbuf might be
- * shared, not wether it definitely is.  
+ * shared, not whether it definitely is.  
  *
  * The scheme I (mvo) tried to keep an accurate reference count would
  * recount all strings that point to a stringbuf during the mark-phase
@@ -54,37 +61,30 @@
  * cow-strings, but it failed randomly with more than 10 threads, say.
  * I couldn't figure out what went wrong, so I used the conservative
  * approach implemented below.
- * 
- * A stringbuf needs to know its length, but only so that it can be
- * reported when the stringbuf is freed.
  *
- * Stringbufs (and strings) are not stored very compactly: a stringbuf
- * has room for about 2*sizeof(scm_t_bits)-1 bytes additional
- * information.  As a compensation, the code below is made more
- * complicated by storing small strings inline in the double cell of a
- * stringbuf.  So we have fixstrings and bigstrings...
+ * There are 2 storage strategies for stringbufs: 8-bit and wide.  8-bit
+ * strings are ISO-8859-1-encoded strings; wide strings are 32-bit (UCS-4)
+ * strings.
  */
 
+/* The size in words of the stringbuf header (type tag + size).  */
+#define STRINGBUF_HEADER_SIZE   2U
+
+#define STRINGBUF_HEADER_BYTES  (STRINGBUF_HEADER_SIZE * sizeof (SCM))
+
 #define STRINGBUF_F_SHARED      SCM_I_STRINGBUF_F_SHARED
-#define STRINGBUF_F_INLINE      SCM_I_STRINGBUF_F_INLINE
+#define STRINGBUF_F_WIDE        SCM_I_STRINGBUF_F_WIDE
 
 #define STRINGBUF_TAG           scm_tc7_stringbuf
 #define STRINGBUF_SHARED(buf)   (SCM_CELL_WORD_0(buf) & STRINGBUF_F_SHARED)
-#define STRINGBUF_INLINE(buf)   (SCM_CELL_WORD_0(buf) & STRINGBUF_F_INLINE)
-
-#define STRINGBUF_OUTLINE_CHARS(buf)   ((char *)SCM_CELL_WORD_1(buf))
-#define STRINGBUF_OUTLINE_LENGTH(buf)  (SCM_CELL_WORD_2(buf))
-#define STRINGBUF_INLINE_CHARS(buf)    ((char *)SCM_CELL_OBJECT_LOC(buf,1))
-#define STRINGBUF_INLINE_LENGTH(buf)   (((size_t)SCM_CELL_WORD_0(buf))>>16)
+#define STRINGBUF_WIDE(buf)     (SCM_CELL_WORD_0(buf) & STRINGBUF_F_WIDE)
 
-#define STRINGBUF_CHARS(buf)  (STRINGBUF_INLINE (buf) \
-                               ? STRINGBUF_INLINE_CHARS (buf) \
-                               : STRINGBUF_OUTLINE_CHARS (buf))
-#define STRINGBUF_LENGTH(buf) (STRINGBUF_INLINE (buf) \
-                               ? STRINGBUF_INLINE_LENGTH (buf) \
-                               : STRINGBUF_OUTLINE_LENGTH (buf))
+#define STRINGBUF_CHARS(buf)    ((unsigned char *)			\
+                                 SCM_CELL_OBJECT_LOC (buf,		\
+						      STRINGBUF_HEADER_SIZE))
+#define STRINGBUF_LENGTH(buf)   (SCM_CELL_WORD_1 (buf))
 
-#define STRINGBUF_MAX_INLINE_LEN (3*sizeof(scm_t_bits))
+#define STRINGBUF_WIDE_CHARS(buf) ((scm_t_wchar *) STRINGBUF_CHARS (buf))
 
 #define SET_STRINGBUF_SHARED(buf)					\
   do									\
@@ -96,10 +96,12 @@
     }									\
   while (0)
 
-#if SCM_DEBUG
+#if SCM_STRING_LENGTH_HISTOGRAM
 static size_t lenhist[1001];
 #endif
 
+/* Make a stringbuf with space for LEN 8-bit Latin-1-encoded
+   characters. */
 static SCM
 make_stringbuf (size_t len)
 {
@@ -110,41 +112,117 @@ make_stringbuf (size_t len)
      can be dropped.
   */
 
-#if SCM_DEBUG
+  SCM buf;
+
+#if SCM_STRING_LENGTH_HISTOGRAM
   if (len < 1000)
     lenhist[len]++;
   else
     lenhist[1000]++;
 #endif
 
-  if (len <= STRINGBUF_MAX_INLINE_LEN-1)
-    {
-      return scm_double_cell (STRINGBUF_TAG | STRINGBUF_F_INLINE | (len << 16),
-			      0, 0, 0);
-    }
+  buf = PTR2SCM (scm_gc_malloc_pointerless (STRINGBUF_HEADER_BYTES + len + 1,
+					    "string"));
+
+  SCM_SET_CELL_TYPE (buf, STRINGBUF_TAG);
+  SCM_SET_CELL_WORD_1 (buf, (scm_t_bits) len);
+
+  STRINGBUF_CHARS (buf)[len] = 0;
+
+  return buf;
+}
+
+/* Make a stringbuf with space for LEN 32-bit UCS-4-encoded
+   characters.  */
+static SCM
+make_wide_stringbuf (size_t len)
+{
+  SCM buf;
+  size_t raw_len;
+
+#if SCM_STRING_LENGTH_HISTOGRAM
+  if (len < 1000)
+    lenhist[len]++;
+  else
+    lenhist[1000]++;
+#endif
+
+  raw_len = (len + 1) * sizeof (scm_t_wchar);
+  buf = PTR2SCM (scm_gc_malloc_pointerless (STRINGBUF_HEADER_BYTES + raw_len,
+					    "string"));
+
+  SCM_SET_CELL_TYPE (buf, STRINGBUF_TAG | STRINGBUF_F_WIDE);
+  SCM_SET_CELL_WORD_1 (buf, (scm_t_bits) len);
+
+  STRINGBUF_WIDE_CHARS (buf)[len] = 0;
+
+  return buf;
+}
+
+/* Return a UCS-4-encoded stringbuf containing the (possibly Latin-1-encoded)
+   characters from BUF.  */
+static SCM
+wide_stringbuf (SCM buf)
+{
+  SCM new_buf;
+
+  if (STRINGBUF_WIDE (buf))
+    new_buf = buf;
   else
     {
-      char *mem = scm_gc_malloc_pointerless (len + 1, "string");
-      mem[len] = '\0';
-      return scm_double_cell (STRINGBUF_TAG, (scm_t_bits) mem,
-			      (scm_t_bits) len, (scm_t_bits) 0);
+      size_t i, len;
+      scm_t_wchar *mem;
+
+      len = STRINGBUF_LENGTH (buf);
+
+      new_buf = make_wide_stringbuf (len);
+
+      mem = STRINGBUF_WIDE_CHARS (new_buf);
+      for (i = 0; i < len; i++)
+	mem[i] = (scm_t_wchar) STRINGBUF_CHARS (buf)[i];
+      mem[len] = 0;
     }
+
+  return new_buf;
 }
 
-/* Return a new stringbuf whose underlying storage consists of the LEN+1
-   octets pointed to by STR (the last octet is zero).  */
-SCM
-scm_i_take_stringbufn (char *str, size_t len)
+/* Return a Latin-1-encoded stringbuf containing the (possibly UCS-4-encoded)
+   characters from BUF, if possible.  */
+static SCM
+narrow_stringbuf (SCM buf)
 {
-  scm_gc_register_collectable_memory (str, len + 1, "stringbuf");
+  SCM new_buf;
 
-  return scm_double_cell (STRINGBUF_TAG, (scm_t_bits) str,
-			  (scm_t_bits) len, (scm_t_bits) 0);
-}
+  if (!STRINGBUF_WIDE (buf))
+    new_buf = buf;
+  else
+    {
+      size_t i, len;
+      scm_t_wchar *wmem;
+      unsigned char *mem;
+
+      len = STRINGBUF_LENGTH (buf);
+      wmem = STRINGBUF_WIDE_CHARS (buf);
+
+      for (i = 0; i < len; i++)
+	if (wmem[i] > 0xFF)
+	  /* BUF cannot be narrowed.  */
+	  return buf;
+
+      new_buf = make_stringbuf (len);
 
+      mem = STRINGBUF_CHARS (new_buf);
+      for (i = 0; i < len; i++)
+	mem[i] = (unsigned char) wmem[i];
+      mem[len] = 0;
+    }
+
+  return new_buf;
+}
 
 scm_i_pthread_mutex_t stringbuf_write_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
 
+
 /* Copy-on-write strings.
  */
 
@@ -175,18 +253,36 @@ scm_i_pthread_mutex_t stringbuf_write_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
 
 #define IS_SH_STRING(str)   (SCM_CELL_TYPE(str)==SH_STRING_TAG)
 
+/* Create a scheme string with space for LEN 8-bit Latin-1-encoded
+   characters.  CHARSP, if not NULL, will be set to location of the
+   char array.  */
 SCM
 scm_i_make_string (size_t len, char **charsp)
 {
   SCM buf = make_stringbuf (len);
   SCM res;
   if (charsp)
-    *charsp = STRINGBUF_CHARS (buf);
+    *charsp = (char *) STRINGBUF_CHARS (buf);
   res = scm_double_cell (STRING_TAG, SCM_UNPACK(buf),
 			 (scm_t_bits)0, (scm_t_bits) len);
   return res;
 }
 
+/* Create a scheme string with space for LEN 32-bit UCS-4-encoded
+   characters.  CHARSP, if not NULL, will be set to location of the
+   character array.  */
+SCM
+scm_i_make_wide_string (size_t len, scm_t_wchar **charsp)
+{
+  SCM buf = make_wide_stringbuf (len);
+  SCM res;
+  if (charsp)
+    *charsp = STRINGBUF_WIDE_CHARS (buf);
+  res = scm_double_cell (STRING_TAG, SCM_UNPACK (buf),
+                         (scm_t_bits) 0, (scm_t_bits) len);
+  return res;
+}
+
 static void
 validate_substring_args (SCM str, size_t start, size_t end)
 {
@@ -245,12 +341,24 @@ scm_i_substring_copy (SCM str, size_t start, size_t end)
   SCM buf, my_buf;
   size_t str_start;
   get_str_buf_start (&str, &buf, &str_start);
-  my_buf = make_stringbuf (len);
-  memcpy (STRINGBUF_CHARS (my_buf),
-	  STRINGBUF_CHARS (buf) + str_start + start, len);
+  if (scm_i_is_narrow_string (str))
+    {
+      my_buf = make_stringbuf (len);
+      memcpy (STRINGBUF_CHARS (my_buf),
+              STRINGBUF_CHARS (buf) + str_start + start, len);
+    }
+  else
+    {
+      my_buf = make_wide_stringbuf (len);
+      u32_cpy ((scm_t_uint32 *) STRINGBUF_WIDE_CHARS (my_buf),
+               (scm_t_uint32 *) (STRINGBUF_WIDE_CHARS (buf) + str_start 
+                                 + start), len);
+      /* Even though this string is wide, the substring may be narrow.
+         Consider adding code to narrow the string.  */
+    }
   scm_remember_upto_here_1 (buf);
-  return scm_double_cell (STRING_TAG, SCM_UNPACK(my_buf),
-			  (scm_t_bits)0, (scm_t_bits) len);
+  return scm_double_cell (STRING_TAG, SCM_UNPACK (my_buf),
+                          (scm_t_bits) 0, (scm_t_bits) len);
 }
 
 SCM
@@ -303,23 +411,73 @@ scm_c_substring_shared (SCM str, size_t start, size_t end)
 /* Internal accessors
  */
 
+/* Returns the number of characters in STR.  This may be different
+   than the memory size of the string storage.  */
 size_t
 scm_i_string_length (SCM str)
 {
   return STRING_LENGTH (str);
 }
 
+/* True if the string is 'narrow', meaning it has a 8-bit Latin-1
+   encoding.  False if it is 'wide', having a 32-bit UCS-4
+   encoding.  */
+int
+scm_i_is_narrow_string (SCM str)
+{
+  return !STRINGBUF_WIDE (STRING_STRINGBUF (str));
+}
+
+/* Try to coerce a string to be narrow.  It if is narrow already, do
+   nothing.  If it is wide, shrink it to narrow if none of its
+   characters are above 0xFF.  Return true if the string is narrow or
+   was made to be narrow.  */
+int
+scm_i_try_narrow_string (SCM str)
+{
+  SET_STRING_STRINGBUF (str, narrow_stringbuf (STRING_STRINGBUF (str)));
+
+  return scm_i_is_narrow_string (str);
+}
+
+/* Returns a pointer to the 8-bit Latin-1 encoded character array of
+   STR.  */
 const char *
 scm_i_string_chars (SCM str)
 {
   SCM buf;
   size_t start;
   get_str_buf_start (&str, &buf, &start);
-  return STRINGBUF_CHARS (buf) + start;
+  if (scm_i_is_narrow_string (str))
+    return (const char *) STRINGBUF_CHARS (buf) + start;
+  else
+    scm_misc_error (NULL, "Invalid read access of chars of wide string: ~s",
+                    scm_list_1 (str));
+  return NULL;
 }
 
-char *
-scm_i_string_writable_chars (SCM orig_str)
+/* Returns a pointer to the 32-bit UCS-4 encoded character array of
+   STR.  */
+const scm_t_wchar *
+scm_i_string_wide_chars (SCM str)
+{
+  SCM buf;
+  size_t start;
+
+  get_str_buf_start (&str, &buf, &start);
+  if (!scm_i_is_narrow_string (str))
+    return (const scm_t_wchar *) STRINGBUF_WIDE_CHARS (buf) + start;
+  else
+    scm_misc_error (NULL, "Invalid read access of chars of narrow string: ~s",
+                    scm_list_1 (str));
+}
+
+/* If the buffer in ORIG_STR is shared, copy ORIG_STR's characters to
+   a new string buffer, so that it can be modified without modifying
+   other strings.  Also, lock the string mutex.  Later, one must call
+   scm_i_string_stop_writing to unlock the mutex.  */
+SCM
+scm_i_string_start_writing (SCM orig_str)
 {
   SCM buf, str = orig_str;
   size_t start;
@@ -331,17 +489,28 @@ scm_i_string_writable_chars (SCM orig_str)
   scm_i_pthread_mutex_lock (&stringbuf_write_mutex);
   if (STRINGBUF_SHARED (buf))
     {
-      /* Clone stringbuf.  */
-
+      /* Clone the stringbuf.  */
       size_t len = STRING_LENGTH (str);
       SCM new_buf;
 
       scm_i_pthread_mutex_unlock (&stringbuf_write_mutex);
 
-      new_buf = make_stringbuf (len);
-      memcpy (STRINGBUF_CHARS (new_buf),
-	      STRINGBUF_CHARS (buf) + STRING_START (str), len);
+      if (scm_i_is_narrow_string (str))
+        {
+          new_buf = make_stringbuf (len);
+          memcpy (STRINGBUF_CHARS (new_buf),
+                  STRINGBUF_CHARS (buf) + STRING_START (str), len);
+
+        }
+      else
+        {
+          new_buf = make_wide_stringbuf (len);
+          u32_cpy ((scm_t_uint32 *) STRINGBUF_WIDE_CHARS (new_buf),
+                   (scm_t_uint32 *) (STRINGBUF_WIDE_CHARS (buf) 
+                                     + STRING_START (str)), len);
+        }
 
+      SET_STRING_STRINGBUF (str, new_buf);
       start -= STRING_START (str);
 
       /* FIXME: The following operations are not atomic, so other threads
@@ -357,18 +526,134 @@ scm_i_string_writable_chars (SCM orig_str)
 
       scm_i_pthread_mutex_lock (&stringbuf_write_mutex);
     }
+  return orig_str;
+}
+
+/* Return a pointer to the 8-bit Latin-1 chars of a string.  */
+char *
+scm_i_string_writable_chars (SCM str)
+{
+  SCM buf;
+  size_t start;
+
+  get_str_buf_start (&str, &buf, &start);
+  if (scm_i_is_narrow_string (str))
+    return (char *) STRINGBUF_CHARS (buf) + start;
+  else
+    scm_misc_error (NULL, "Invalid write access of chars of wide string: ~s",
+                    scm_list_1 (str));
+  return NULL;
+}
 
-  return STRINGBUF_CHARS (buf) + start;
+/* Return a pointer to the UCS-4 codepoints of a string.  */
+static scm_t_wchar *
+scm_i_string_writable_wide_chars (SCM str)
+{
+  SCM buf;
+  size_t start;
+
+  get_str_buf_start (&str, &buf, &start);
+  if (!scm_i_is_narrow_string (str))
+    return STRINGBUF_WIDE_CHARS (buf) + start;
+  else
+    scm_misc_error (NULL, "Invalid write access of chars of narrow string: ~s",
+                    scm_list_1 (str));
 }
 
+/* Unlock the string mutex that was locked when
+   scm_i_string_start_writing was called.  */
 void
 scm_i_string_stop_writing (void)
 {
   scm_i_pthread_mutex_unlock (&stringbuf_write_mutex);
 }
 
+/* Return the Xth character of STR as a UCS-4 codepoint.  */
+scm_t_wchar
+scm_i_string_ref (SCM str, size_t x)
+{
+  if (scm_i_is_narrow_string (str))
+    return (scm_t_wchar) (unsigned char) (scm_i_string_chars (str)[x]);
+  else
+    return scm_i_string_wide_chars (str)[x];
+}
+
+/* Returns index+1 of the first char in STR that matches C, or
+   0 if the char is not found.  */
+int
+scm_i_string_contains_char (SCM str, char ch)
+{
+  size_t i;
+  size_t len = scm_i_string_length (str);
+
+  i = 0;
+  if (scm_i_is_narrow_string (str))
+    {
+      while (i < len)
+        {
+          if (scm_i_string_chars (str)[i] == ch)
+            return i+1;
+          i++;
+        }
+    }
+  else
+    {
+      while (i < len)
+        {
+          if (scm_i_string_wide_chars (str)[i] 
+              == (unsigned char) ch)
+            return i+1;
+          i++;
+        }
+    }
+  return 0;
+}
+
+int 
+scm_i_string_strcmp (SCM sstr, size_t start_x, const char *cstr)
+{
+  if (scm_i_is_narrow_string (sstr))
+    {
+      const char *a = scm_i_string_chars (sstr) + start_x;
+      const char *b = cstr;
+      return strncmp (a, b, strlen(b));
+    }
+  else
+    {
+      size_t i;
+      const scm_t_wchar *a = scm_i_string_wide_chars (sstr) + start_x;
+      const char *b = cstr;
+      for (i = 0; i < strlen (b); i++)
+        {
+          if (a[i] != (unsigned char) b[i])
+            return 1;
+        }
+    }
+  return 0;
+}
+
+/* Set the Pth character of STR to UCS-4 codepoint CHR. */
+void
+scm_i_string_set_x (SCM str, size_t p, scm_t_wchar chr)
+{
+  if (chr > 0xFF && scm_i_is_narrow_string (str))
+    SET_STRING_STRINGBUF (str, wide_stringbuf (STRING_STRINGBUF (str)));
+
+  if (scm_i_is_narrow_string (str))
+    {
+      char *dst = scm_i_string_writable_chars (str);
+      dst[p] = chr;
+    }
+  else
+    {
+      scm_t_wchar *dst = scm_i_string_writable_wide_chars (str);
+      dst[p] = chr;
+    }
+}
+
+
 /* Symbols.
- 
+
    Basic symbol creation and accessing is done here, the rest is in
    symbols.[hc].  This has been done to keep stringbufs and the
    internals of strings and string-like objects confined to this file.
@@ -401,10 +686,21 @@ scm_i_make_symbol (SCM name, scm_t_bits flags,
   else
     {
       /* make new buf. */
-      SCM new_buf = make_stringbuf (length);
-      memcpy (STRINGBUF_CHARS (new_buf),
-	      STRINGBUF_CHARS (buf) + start, length);
-      buf = new_buf;
+      if (scm_i_is_narrow_string (name))
+        {
+          SCM new_buf = make_stringbuf (length);
+          memcpy (STRINGBUF_CHARS (new_buf),
+                  STRINGBUF_CHARS (buf) + start, length);
+          buf = new_buf;
+        }
+      else
+        {
+          SCM new_buf = make_wide_stringbuf (length);
+          u32_cpy ((scm_t_uint32 *) STRINGBUF_WIDE_CHARS (new_buf),
+                   (scm_t_uint32 *) STRINGBUF_WIDE_CHARS (buf) + start,
+                   length);
+          buf = new_buf;
+        }
     }
   return scm_double_cell (scm_tc7_symbol | flags, SCM_UNPACK (buf),
 			  (scm_t_bits) hash, SCM_UNPACK (props));
@@ -421,18 +717,8 @@ scm_i_c_make_symbol (const char *name, size_t len,
 				    (scm_t_bits) hash, SCM_UNPACK (props));
 }
 
-/* Return a new symbol that uses the LEN bytes pointed to by NAME as its
-   underlying storage.  */
-SCM
-scm_i_c_take_symbol (char *name, size_t len,
-		     scm_t_bits flags, unsigned long hash, SCM props)
-{
-  SCM buf = scm_i_take_stringbufn (name, len);
-
-  return scm_double_cell (scm_tc7_symbol | flags, SCM_UNPACK (buf),
-			  (scm_t_bits) hash, SCM_UNPACK (props));
-}
-
+/* Returns the number of characters in SYM.  This may be different
+   from the memory size of SYM.  */
 size_t
 scm_i_symbol_length (SCM sym)
 {
@@ -449,11 +735,45 @@ scm_c_symbol_length (SCM sym)
 }
 #undef FUNC_NAME
 
+/* True if the name of SYM is stored as a Latin-1 encoded string.
+   False if it is stored as a 32-bit UCS-4-encoded string.  */
+int
+scm_i_is_narrow_symbol (SCM sym)
+{
+  SCM buf;
+
+  buf = SYMBOL_STRINGBUF (sym);
+  return !STRINGBUF_WIDE (buf);
+}
+
+/* Returns a pointer to the 8-bit Latin-1 encoded character array that
+   contains the name of SYM.  */
 const char *
 scm_i_symbol_chars (SCM sym)
 {
-  SCM buf = SYMBOL_STRINGBUF (sym);
-  return STRINGBUF_CHARS (buf);
+  SCM buf;
+
+  buf = SYMBOL_STRINGBUF (sym);
+  if (!STRINGBUF_WIDE (buf))
+    return (const char *) STRINGBUF_CHARS (buf);
+  else
+    scm_misc_error (NULL, "Invalid access of chars of a wide symbol ~S",
+                    scm_list_1 (sym));
+}
+
+/* Return a pointer to the 32-bit UCS-4-encoded character array of a
+   symbol's name.  */
+const scm_t_wchar *
+scm_i_symbol_wide_chars (SCM sym)
+{
+  SCM buf;
+
+  buf = SYMBOL_STRINGBUF (sym);
+  if (STRINGBUF_WIDE (buf))
+    return (const scm_t_wchar *) STRINGBUF_WIDE_CHARS (buf);
+  else
+    scm_misc_error (NULL, "Invalid access of chars of a narrow symbol ~S",
+                    scm_list_1 (sym));
 }
 
 SCM
@@ -467,64 +787,194 @@ scm_i_symbol_substring (SCM sym, size_t start, size_t end)
 			  (scm_t_bits)start, (scm_t_bits) end - start);
 }
 
+/* Returns the Xth character of symbol SYM as a UCS-4 codepoint.  */
+scm_t_wchar
+scm_i_symbol_ref (SCM sym, size_t x)
+{
+  if (scm_i_is_narrow_symbol (sym))
+    return (scm_t_wchar) (unsigned char) (scm_i_symbol_chars (sym)[x]);
+  else
+    return scm_i_symbol_wide_chars (sym)[x];
+}
+
 /* Debugging
  */
 
-#if SCM_DEBUG
-
-SCM scm_sys_string_dump (SCM);
-SCM scm_sys_symbol_dump (SCM);
-SCM scm_sys_stringbuf_hist (void);
-
-SCM_DEFINE (scm_sys_string_dump, "%string-dump", 1, 0, 0,
-	    (SCM str),
-	    "")
+SCM_DEFINE (scm_sys_string_dump, "%string-dump", 1, 0, 0, (SCM str), 
+            "Returns an association list containing debugging information\n"
+            "for @var{str}. The association list has the following entries."
+            "@table @code\n"
+            "@item string\n"
+            "The string itself.\n"
+            "@item start\n"
+            "The start index of the string into its stringbuf\n"
+            "@item length\n"
+            "The length of the string\n"
+            "@item shared\n"
+            "If this string is a substring, it returns its parent string.\n"
+            "Otherwise, it returns @code{#f}\n"
+            "@item read-only\n"
+            "@code{#t} if the string is read-only\n"
+            "@item stringbuf-chars\n"
+            "A new string containing this string's stringbuf's characters\n"
+            "@item stringbuf-length\n"
+            "The number of characters in this stringbuf\n"
+            "@item stringbuf-shared\n"
+            "@code{#t} if this stringbuf is shared\n"
+            "@item stringbuf-wide\n"
+            "@code{#t} if this stringbuf's characters are stored in a\n"
+            "32-bit buffer, or @code{#f} if they are stored in an 8-bit\n"
+            "buffer\n"
+            "@end table")
 #define FUNC_NAME s_scm_sys_string_dump
 {
+  SCM e1, e2, e3, e4, e5, e6, e7, e8, e9;
+  SCM buf;
   SCM_VALIDATE_STRING (1, str);
-  fprintf (stderr, "%p:\n", str);
-  fprintf (stderr, " start: %u\n", STRING_START (str));
-  fprintf (stderr, " len:   %u\n", STRING_LENGTH (str));
+
+  /* String info */
+  e1 = scm_cons (scm_from_locale_symbol ("string"),
+                 str);
+  e2 = scm_cons (scm_from_locale_symbol ("start"),
+                 scm_from_size_t (STRING_START (str)));
+  e3 = scm_cons (scm_from_locale_symbol ("length"),
+                 scm_from_size_t (STRING_LENGTH (str)));
+
   if (IS_SH_STRING (str))
     {
-      fprintf (stderr, " string: %p\n", SH_STRING_STRING (str));
-      fprintf (stderr, "\n");
-      scm_sys_string_dump (SH_STRING_STRING (str));
+      e4 = scm_cons (scm_from_locale_symbol ("shared"),
+                     SH_STRING_STRING (str));
+      buf = STRING_STRINGBUF (SH_STRING_STRING (str));
     }
   else
     {
-      SCM buf = STRING_STRINGBUF (str);
-      fprintf (stderr, " buf:   %p\n", buf);
-      fprintf (stderr, "  chars:  %p\n", STRINGBUF_CHARS (buf));
-      fprintf (stderr, "  length: %u\n", STRINGBUF_LENGTH (buf));
-      fprintf (stderr, "  flags: %x\n", (SCM_CELL_WORD_0 (buf) & 0x300));
+      e4 = scm_cons (scm_from_locale_symbol ("shared"),
+                     SCM_BOOL_F);
+      buf = STRING_STRINGBUF (str);
     }
-  return SCM_UNSPECIFIED;
+
+  if (IS_RO_STRING (str))
+    e5 = scm_cons (scm_from_locale_symbol ("read-only"),
+                   SCM_BOOL_T);
+  else
+    e5 = scm_cons (scm_from_locale_symbol ("read-only"),
+                   SCM_BOOL_F);
+
+  /* Stringbuf info */
+  if (!STRINGBUF_WIDE (buf))
+    {
+      size_t len = STRINGBUF_LENGTH (buf);
+      char *cbuf;
+      SCM sbc = scm_i_make_string (len, &cbuf);
+      memcpy (cbuf, STRINGBUF_CHARS (buf), len);
+      e6 = scm_cons (scm_from_locale_symbol ("stringbuf-chars"),
+                     sbc);
+    }
+  else
+    {
+      size_t len = STRINGBUF_LENGTH (buf);
+      scm_t_wchar *cbuf;
+      SCM sbc = scm_i_make_wide_string (len, &cbuf);
+      u32_cpy ((scm_t_uint32 *) cbuf, 
+               (scm_t_uint32 *) STRINGBUF_WIDE_CHARS (buf), len);
+      e6 = scm_cons (scm_from_locale_symbol ("stringbuf-chars"),
+                     sbc);
+    }
+  e7 = scm_cons (scm_from_locale_symbol ("stringbuf-length"), 
+                 scm_from_size_t (STRINGBUF_LENGTH (buf)));
+  if (STRINGBUF_SHARED (buf))
+    e8 = scm_cons (scm_from_locale_symbol ("stringbuf-shared"), 
+                   SCM_BOOL_T);
+  else
+    e8 = scm_cons (scm_from_locale_symbol ("stringbuf-shared"), 
+                   SCM_BOOL_F);
+  if (STRINGBUF_WIDE (buf))
+    e9 = scm_cons (scm_from_locale_symbol ("stringbuf-wide"),
+		   SCM_BOOL_T);
+  else
+    e9 = scm_cons (scm_from_locale_symbol ("stringbuf-wide"),
+		   SCM_BOOL_F);
+
+  return scm_list_n (e1, e2, e3, e4, e5, e6, e7, e8, e9, SCM_UNDEFINED);
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_sys_symbol_dump, "%symbol-dump", 1, 0, 0,
-	    (SCM sym),
-	    "")
+SCM_DEFINE (scm_sys_symbol_dump, "%symbol-dump", 1, 0, 0, (SCM sym),
+            "Returns an association list containing debugging information\n"
+            "for @var{sym}. The association list has the following entries."
+            "@table @code\n"
+            "@item symbol\n"
+            "The symbol itself\n"
+            "@item hash\n"
+            "Its hash value\n"
+            "@item interned\n"
+            "@code{#t} if it is an interned symbol\n"
+            "@item stringbuf-chars\n"
+            "A new string containing this symbols's stringbuf's characters\n"
+            "@item stringbuf-length\n"
+            "The number of characters in this stringbuf\n"
+            "@item stringbuf-shared\n"
+            "@code{#t} if this stringbuf is shared\n"
+            "@item stringbuf-wide\n"
+            "@code{#t} if this stringbuf's characters are stored in a\n"
+            "32-bit buffer, or @code{#f} if they are stored in an 8-bit\n"
+            "buffer\n"
+            "@end table")
 #define FUNC_NAME s_scm_sys_symbol_dump
 {
+  SCM e1, e2, e3, e4, e5, e6, e7;
+  SCM buf;
   SCM_VALIDATE_SYMBOL (1, sym);
-  fprintf (stderr, "%p:\n", sym);
-  fprintf (stderr, " hash: %lu\n", scm_i_symbol_hash (sym));
-  {
-    SCM buf = SYMBOL_STRINGBUF (sym);
-    fprintf (stderr, " buf: %p\n", buf);
-    fprintf (stderr, "  chars:  %p\n", STRINGBUF_CHARS (buf));
-    fprintf (stderr, "  length: %u\n", STRINGBUF_LENGTH (buf));
-    fprintf (stderr, "  shared: %u\n", STRINGBUF_SHARED (buf));
-  }
-  return SCM_UNSPECIFIED;
+  e1 = scm_cons (scm_from_locale_symbol ("symbol"),
+                 sym);
+  e2 = scm_cons (scm_from_locale_symbol ("hash"),
+                 scm_from_ulong (scm_i_symbol_hash (sym)));
+  e3 = scm_cons (scm_from_locale_symbol ("interned"),
+                 scm_symbol_interned_p (sym));
+  buf = SYMBOL_STRINGBUF (sym);
+
+  /* Stringbuf info */
+  if (!STRINGBUF_WIDE (buf))
+    {
+      size_t len = STRINGBUF_LENGTH (buf);
+      char *cbuf;
+      SCM sbc = scm_i_make_string (len, &cbuf);
+      memcpy (cbuf, STRINGBUF_CHARS (buf), len);
+      e4 = scm_cons (scm_from_locale_symbol ("stringbuf-chars"),
+                     sbc);
+    }
+  else
+    {
+      size_t len = STRINGBUF_LENGTH (buf);
+      scm_t_wchar *cbuf;
+      SCM sbc = scm_i_make_wide_string (len, &cbuf);
+      u32_cpy ((scm_t_uint32 *) cbuf, 
+               (scm_t_uint32 *) STRINGBUF_WIDE_CHARS (buf), len);
+      e4 = scm_cons (scm_from_locale_symbol ("stringbuf-chars"),
+                     sbc);
+    }
+  e5 = scm_cons (scm_from_locale_symbol ("stringbuf-length"), 
+                 scm_from_size_t (STRINGBUF_LENGTH (buf)));
+  if (STRINGBUF_SHARED (buf))
+    e6 = scm_cons (scm_from_locale_symbol ("stringbuf-shared"), 
+                   SCM_BOOL_T);
+  else
+    e6 = scm_cons (scm_from_locale_symbol ("stringbuf-shared"), 
+                   SCM_BOOL_F);
+  if (STRINGBUF_WIDE (buf))
+    e7 = scm_cons (scm_from_locale_symbol ("stringbuf-wide"),
+                    SCM_BOOL_T);
+  else
+    e7 = scm_cons (scm_from_locale_symbol ("stringbuf-wide"),
+                    SCM_BOOL_F);
+  return scm_list_n (e1, e2, e3, e4, e5, e6, e7, SCM_UNDEFINED);
+
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_sys_stringbuf_hist, "%stringbuf-hist", 0, 0, 0,
-	    (void),
-	    "")
+#if SCM_STRING_LENGTH_HISTOGRAM
+
+SCM_DEFINE (scm_sys_stringbuf_hist, "%stringbuf-hist", 0, 0, 0, (void), "")
 #define FUNC_NAME s_scm_sys_stringbuf_hist
 {
   int i;
@@ -559,30 +1009,70 @@ SCM_DEFINE (scm_string, "string", 0, 0, 1,
 	    "@var{chrs}.")
 #define FUNC_NAME s_scm_string
 {
-  SCM result;
+  SCM result = SCM_BOOL_F;
+  SCM rest;
   size_t len;
-  char *data;
+  size_t p = 0;
+  long i;
+  int wide = 0;
 
-  {
-    long i = scm_ilength (chrs);
+  /* Verify that this is a list of chars.  */
+  i = scm_ilength (chrs);
+  SCM_ASSERT (i >= 0, chrs, SCM_ARG1, FUNC_NAME);
 
-    SCM_ASSERT (i >= 0, chrs, SCM_ARG1, FUNC_NAME);
-    len = i;
-  }
+  len = (size_t) i;
+  rest = chrs;
 
-  result = scm_i_make_string (len, &data);
-  while (len > 0 && scm_is_pair (chrs))
+  while (len > 0 && scm_is_pair (rest))
     {
-      SCM elt = SCM_CAR (chrs);
-
+      SCM elt = SCM_CAR (rest);
       SCM_VALIDATE_CHAR (SCM_ARGn, elt);
-      *data++ = SCM_CHAR (elt);
-      chrs = SCM_CDR (chrs);
+      if (SCM_CHAR (elt) > 0xFF)
+        wide = 1;
+      rest = SCM_CDR (rest);
       len--;
+      scm_remember_upto_here_1 (elt);
+    }
+
+  /* Construct a string containing this list of chars.  */
+  len = (size_t) i;
+  rest = chrs;
+
+  if (wide == 0)
+    {
+      result = scm_i_make_string (len, NULL);
+      result = scm_i_string_start_writing (result);
+      char *buf = scm_i_string_writable_chars (result);
+      while (len > 0 && scm_is_pair (rest))
+        {
+          SCM elt = SCM_CAR (rest);
+          buf[p] = (unsigned char) SCM_CHAR (elt);
+          p++;
+          rest = SCM_CDR (rest);
+          len--;
+          scm_remember_upto_here_1 (elt);
+        }
+    }
+  else
+    {
+      result = scm_i_make_wide_string (len, NULL);
+      result = scm_i_string_start_writing (result);
+      scm_t_wchar *buf = scm_i_string_writable_wide_chars (result);
+      while (len > 0 && scm_is_pair (rest))
+        {
+          SCM elt = SCM_CAR (rest);
+          buf[p] = SCM_CHAR (elt);
+          p++;
+          rest = SCM_CDR (rest);
+          len--;
+          scm_remember_upto_here_1 (elt);
+        }
     }
+  scm_i_string_stop_writing ();
+
   if (len > 0)
     scm_misc_error (NULL, "list changed while constructing string", SCM_EOL);
-  if (!scm_is_null (chrs))
+  if (!scm_is_null (rest))
     scm_wrong_type_arg_msg (NULL, 0, chrs, "proper list");
 
   return result;
@@ -605,13 +1095,16 @@ SCM
 scm_c_make_string (size_t len, SCM chr)
 #define FUNC_NAME NULL
 {
-  char *dst;
-  SCM res = scm_i_make_string (len, &dst);
+  size_t p;
+  SCM res = scm_i_make_string (len, NULL);
 
   if (!SCM_UNBNDP (chr))
     {
       SCM_VALIDATE_CHAR (0, chr);
-      memset (dst, SCM_CHAR (chr), len);
+      res = scm_i_string_start_writing (res);
+      for (p = 0; p < len; p++)
+        scm_i_string_set_x (res, p, SCM_CHAR (chr));
+      scm_i_string_stop_writing ();
     }
 
   return res;
@@ -628,6 +1121,20 @@ SCM_DEFINE (scm_string_length, "string-length", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (scm_string_bytes_per_char, "string-bytes-per-char", 1, 0, 0,
+            (SCM string),
+            "Return the bytes used to represent a character in @var{string}."
+            "This will return 1 or 4.")
+#define FUNC_NAME s_scm_string_bytes_per_char
+{
+  SCM_VALIDATE_STRING (1, string);
+  if (!scm_i_is_narrow_string (string))
+    return scm_from_int (4);
+
+  return scm_from_int (1);
+}
+#undef FUNC_NAME
+
 size_t
 scm_c_string_length (SCM string)
 {
@@ -638,8 +1145,8 @@ scm_c_string_length (SCM string)
 
 SCM_DEFINE (scm_string_ref, "string-ref", 2, 0, 0,
             (SCM str, SCM k),
-	    "Return character @var{k} of @var{str} using zero-origin\n"
-	    "indexing. @var{k} must be a valid index of @var{str}.")
+            "Return character @var{k} of @var{str} using zero-origin\n"
+            "indexing. @var{k} must be a valid index of @var{str}.")
 #define FUNC_NAME s_scm_string_ref
 {
   size_t len;
@@ -653,7 +1160,10 @@ SCM_DEFINE (scm_string_ref, "string-ref", 2, 0, 0,
   else
     scm_out_of_range (NULL, k);
 
-  return SCM_MAKE_CHAR (scm_i_string_chars (str)[idx]);
+  if (scm_i_is_narrow_string (str))
+    return SCM_MAKE_CHAR (scm_i_string_chars (str)[idx]);
+  else
+    return SCM_MAKE_CHAR (scm_i_string_wide_chars (str)[idx]);
 }
 #undef FUNC_NAME
 
@@ -662,14 +1172,18 @@ scm_c_string_ref (SCM str, size_t p)
 {
   if (p >= scm_i_string_length (str))
     scm_out_of_range (NULL, scm_from_size_t (p));
-  return SCM_MAKE_CHAR (scm_i_string_chars (str)[p]);
+  if (scm_i_is_narrow_string (str))
+    return SCM_MAKE_CHAR (scm_i_string_chars (str)[p]);
+  else
+    return SCM_MAKE_CHAR (scm_i_string_wide_chars (str)[p]);
+
 }
 
 SCM_DEFINE (scm_string_set_x, "string-set!", 3, 0, 0,
             (SCM str, SCM k, SCM chr),
-	    "Store @var{chr} in element @var{k} of @var{str} and return\n"
-	    "an unspecified value. @var{k} must be a valid index of\n"
-	    "@var{str}.")
+            "Store @var{chr} in element @var{k} of @var{str} and return\n"
+            "an unspecified value. @var{k} must be a valid index of\n"
+            "@var{str}.")
 #define FUNC_NAME s_scm_string_set_x
 {
   size_t len;
@@ -684,11 +1198,10 @@ SCM_DEFINE (scm_string_set_x, "string-set!", 3, 0, 0,
     scm_out_of_range (NULL, k);
 
   SCM_VALIDATE_CHAR (3, chr);
-  {
-    char *dst = scm_i_string_writable_chars (str);
-    dst[idx] = SCM_CHAR (chr);
-    scm_i_string_stop_writing ();
-  }
+  str = scm_i_string_start_writing (str);
+  scm_i_string_set_x (str, idx, SCM_CHAR (chr));
+  scm_i_string_stop_writing ();
+
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
@@ -698,11 +1211,9 @@ scm_c_string_set_x (SCM str, size_t p, SCM chr)
 {
   if (p >= scm_i_string_length (str))
     scm_out_of_range (NULL, scm_from_size_t (p));
-  {
-    char *dst = scm_i_string_writable_chars (str);
-    dst[p] = SCM_CHAR (chr);
-    scm_i_string_stop_writing ();
-  }
+  str = scm_i_string_start_writing (str);
+  scm_i_string_set_x (str, p, SCM_CHAR (chr));
+  scm_i_string_stop_writing ();
 }
 
 SCM_DEFINE (scm_substring, "substring", 2, 1, 0,
@@ -803,31 +1314,59 @@ SCM_DEFINE (scm_substring_shared, "substring/shared", 2, 1, 0,
 
 SCM_DEFINE (scm_string_append, "string-append", 0, 0, 1, 
             (SCM args),
-	    "Return a newly allocated string whose characters form the\n"
+            "Return a newly allocated string whose characters form the\n"
             "concatenation of the given strings, @var{args}.")
 #define FUNC_NAME s_scm_string_append
 {
   SCM res;
-  size_t i = 0;
+  size_t len = 0;
+  int wide = 0;
   SCM l, s;
-  char *data;
+  size_t i;
+  union
+  {
+    char *narrow;
+    scm_t_wchar *wide;
+  } data;
 
   SCM_VALIDATE_REST_ARGUMENT (args);
-  for (l = args; !scm_is_null (l); l = SCM_CDR (l)) 
+  for (l = args; !scm_is_null (l); l = SCM_CDR (l))
     {
       s = SCM_CAR (l);
       SCM_VALIDATE_STRING (SCM_ARGn, s);
-      i += scm_i_string_length (s);
+      len += scm_i_string_length (s);
+      if (!scm_i_is_narrow_string (s))
+        wide = 1;
     }
-  res = scm_i_make_string (i, &data);
-  for (l = args; !scm_is_null (l); l = SCM_CDR (l)) 
+  data.narrow = NULL;
+  if (!wide)
+    res = scm_i_make_string (len, &data.narrow);
+  else
+    res = scm_i_make_wide_string (len, &data.wide);
+
+  for (l = args; !scm_is_null (l); l = SCM_CDR (l))
     {
       size_t len;
       s = SCM_CAR (l);
       SCM_VALIDATE_STRING (SCM_ARGn, s);
       len = scm_i_string_length (s);
-      memcpy (data, scm_i_string_chars (s), len);
-      data += len;
+      if (!wide)
+        {
+          memcpy (data.narrow, scm_i_string_chars (s), len);
+          data.narrow += len;
+        }
+      else
+        {
+          if (scm_i_is_narrow_string (s))
+            {
+              for (i = 0; i < scm_i_string_length (s); i++)
+                data.wide[i] = (unsigned char) scm_i_string_chars (s)[i];
+            }
+          else
+            u32_cpy ((scm_t_uint32 *) data.wide,
+                     (scm_t_uint32 *) scm_i_string_wide_chars (s), len);
+          data.wide += len;
+        }
       scm_remember_upto_here_1 (s);
     }
   return res;
@@ -840,45 +1379,137 @@ scm_is_string (SCM obj)
   return IS_STRING (obj);
 }
 
+static SCM
+scm_from_stringn (const char *str, size_t len, const char *encoding,
+                  scm_t_string_failed_conversion_handler handler)
+{
+  size_t u32len, i;
+  scm_t_wchar *u32;
+  int wide = 0;
+  SCM res;
+
+  if (encoding == NULL)
+    {
+      /* If encoding is null, use Latin-1.  */
+      char *buf;
+      res = scm_i_make_string (len, &buf);
+      memcpy (buf, str, len);
+      return res;
+    }
+
+  u32len = 0;
+  u32 = (scm_t_wchar *) u32_conv_from_encoding (encoding,
+                                                (enum iconv_ilseq_handler)
+                                                handler,
+                                                str, len,
+                                                NULL,
+                                                NULL, &u32len);
+
+  if (u32 == NULL)
+    {
+      if (errno == ENOMEM)
+        scm_memory_error ("locale string conversion");
+      else
+        {
+          /* There are invalid sequences in the input string.  */
+          SCM errstr;
+          char *dst;
+          errstr = scm_i_make_string (len, &dst);
+          memcpy (dst, str, len);
+          scm_misc_error (NULL, "input locale conversion error from ~s: ~s",
+                          scm_list_2 (scm_from_locale_string (encoding),
+                                      errstr));
+          scm_remember_upto_here_1 (errstr);
+        }
+    }
+
+  i = 0;
+  while (i < u32len)
+    if (u32[i++] > 0xFF)
+      {
+        wide = 1;
+        break;
+      }
+
+  if (!wide)
+    {
+      char *dst;
+      res = scm_i_make_string (u32len, &dst);
+      for (i = 0; i < u32len; i ++)
+        dst[i] = (unsigned char) u32[i];
+      dst[u32len] = '\0';
+    }
+  else
+    {
+      scm_t_wchar *wdst;
+      res = scm_i_make_wide_string (u32len, &wdst);
+      u32_cpy ((scm_t_uint32 *) wdst, (scm_t_uint32 *) u32, u32len);
+      wdst[u32len] = 0;
+    }
+
+  free (u32);
+  return res;
+}
+
 SCM
 scm_from_locale_stringn (const char *str, size_t len)
 {
-  SCM res;
-  char *dst;
+  const char *enc;
+  scm_t_string_failed_conversion_handler hndl;
+  SCM inport;
+  scm_t_port *pt;
 
-  if (len == (size_t)-1)
+  if (len == (size_t) -1)
     len = strlen (str);
-  res = scm_i_make_string (len, &dst);
-  memcpy (dst, str, len);
-  return res;
+  if (len == 0)
+    return scm_nullstr;
+
+  inport = scm_current_input_port ();
+  if (!SCM_UNBNDP (inport) && SCM_OPINPORTP (inport))
+    {
+      pt = SCM_PTAB_ENTRY (inport);
+      enc = pt->encoding;
+      hndl = pt->ilseq_handler;
+    }
+  else
+    {
+      enc = NULL;
+      hndl = SCM_FAILED_CONVERSION_ERROR;
+    }
+
+  return scm_from_stringn (str, len, enc, hndl);
 }
 
 SCM
 scm_from_locale_string (const char *str)
 {
+  if (str == NULL)
+    return scm_nullstr;
+
   return scm_from_locale_stringn (str, -1);
 }
 
 SCM
+scm_i_from_utf8_string (const scm_t_uint8 *str)
+{
+  return scm_from_stringn ((const char *) str,
+                           strlen ((char *) str), "UTF-8",
+                           SCM_FAILED_CONVERSION_ERROR);
+}
+
+/* Create a new scheme string from the C string STR.  The memory of
+   STR may be used directly as storage for the new string.  */
+/* FIXME: GC-wise, the only way to use the memory area pointed to by STR
+   would be to register a finalizer to eventually free(3) STR, which isn't
+   worth it.  Should we just deprecate the `scm_take_' functions?  */
+SCM
 scm_take_locale_stringn (char *str, size_t len)
 {
-  SCM buf, res;
+  SCM res;
 
-  if (len == (size_t)-1)
-    len = strlen (str);
-  else
-    {
-      /* Ensure STR is null terminated.  A realloc for 1 extra byte should
-         often be satisfied from the alignment padding after the block, with
-         no actual data movement.  */
-      str = scm_realloc (str, len+1);
-      str[len] = '\0';
-    }
+  res = scm_from_locale_stringn (str, len);
+  free (str);
 
-  buf = scm_i_take_stringbufn (str, len);
-  res = scm_double_cell (STRING_TAG,
-                         SCM_UNPACK (buf),
-                         (scm_t_bits) 0, (scm_t_bits) len);
   return res;
 }
 
@@ -888,33 +1519,180 @@ scm_take_locale_string (char *str)
   return scm_take_locale_stringn (str, -1);
 }
 
+/* Change libunistring escapes (\uXXXX and \UXXXXXXXX) to \xXX \uXXXX
+   and \UXXXXXX.  */
+static void
+unistring_escapes_to_guile_escapes (char **bufp, size_t *lenp)
+{
+  char *before, *after;
+  size_t i, j;
+
+  before = *bufp;
+  after = *bufp;
+  i = 0;
+  j = 0;
+  while (i < *lenp)
+    {
+      if ((i <= *lenp - 6)
+          && before[i] == '\\'
+          && before[i + 1] == 'u'
+          && before[i + 2] == '0' && before[i + 3] == '0')
+        {
+          /* Convert \u00NN to \xNN */
+          after[j] = '\\';
+          after[j + 1] = 'x';
+          after[j + 2] = tolower ((int) before[i + 4]);
+          after[j + 3] = tolower ((int) before[i + 5]);
+          i += 6;
+          j += 4;
+        }
+      else if ((i <= *lenp - 10)
+               && before[i] == '\\'
+               && before[i + 1] == 'U'
+               && before[i + 2] == '0' && before[i + 3] == '0')
+        {
+          /* Convert \U00NNNNNN to \UNNNNNN */
+          after[j] = '\\';
+          after[j + 1] = 'U';
+          after[j + 2] = tolower ((int) before[i + 4]);
+          after[j + 3] = tolower ((int) before[i + 5]);
+          after[j + 4] = tolower ((int) before[i + 6]);
+          after[j + 5] = tolower ((int) before[i + 7]);
+          after[j + 6] = tolower ((int) before[i + 8]);
+          after[j + 7] = tolower ((int) before[i + 9]);
+          i += 10;
+          j += 8;
+        }
+      else
+        {
+          after[j] = before[i];
+          i++;
+          j++;
+        }
+    }
+  *lenp = j;
+  after = scm_realloc (after, j);
+}
+
 char *
-scm_to_locale_stringn (SCM str, size_t *lenp)
+scm_to_locale_stringn (SCM str, size_t * lenp)
 {
-  char *res;
-  size_t len;
+  SCM outport;
+  scm_t_port *pt;
+  const char *enc;
+
+  outport = scm_current_output_port ();
+  if (!SCM_UNBNDP (outport) && SCM_OPOUTPORTP (outport))
+    {
+      pt = SCM_PTAB_ENTRY (outport);
+      enc = pt->encoding;
+    }
+  else
+    enc = NULL;
+
+  return scm_to_stringn (str, lenp, 
+                         enc,
+                         scm_i_get_conversion_strategy (SCM_BOOL_F));
+}
+
+/* Low-level scheme to C string conversion function.  */
+char *
+scm_to_stringn (SCM str, size_t *lenp, const char *encoding,
+                scm_t_string_failed_conversion_handler handler)
+{
+  char *buf;
+  size_t ilen, len, i;
+  int ret;
+  const char *enc;
 
   if (!scm_is_string (str))
     scm_wrong_type_arg_msg (NULL, 0, str, "string");
-  len = scm_i_string_length (str);
-  res = scm_malloc (len + ((lenp==NULL)? 1 : 0));
-  memcpy (res, scm_i_string_chars (str), len);
+  ilen = scm_i_string_length (str);
+
+  if (ilen == 0)
+    {
+      buf = scm_malloc (1);
+      buf[0] = '\0';
+      if (lenp)
+        *lenp = 0;
+      return buf;
+    }
+
   if (lenp == NULL)
+    for (i = 0; i < ilen; i++)
+      if (scm_i_string_ref (str, i) == '\0')
+        scm_misc_error (NULL,
+                        "string contains #\\nul character: ~S",
+                        scm_list_1 (str));
+
+  if (scm_i_is_narrow_string (str) && (encoding == NULL))
     {
-      res[len] = '\0';
-      if (strlen (res) != len)
-	{
-	  free (res);
-	  scm_misc_error (NULL,
-			  "string contains #\\nul character: ~S",
-			  scm_list_1 (str));
-	}
+      /* If using native Latin-1 encoding, just copy the string
+         contents.  */
+      if (lenp)
+        {
+          buf = scm_malloc (ilen);
+          memcpy (buf, scm_i_string_chars (str), ilen);
+          *lenp = ilen;
+          return buf;
+        }
+      else
+        {
+          buf = scm_malloc (ilen + 1);
+          memcpy (buf, scm_i_string_chars (str), ilen);
+          buf[ilen] = '\0';
+          return buf;
+        }
+    }
+
+
+  buf = NULL;
+  len = 0;
+  enc = encoding;
+  if (enc == NULL)
+    enc = "ISO-8859-1";
+  if (scm_i_is_narrow_string (str))
+    {
+      ret = mem_iconveh (scm_i_string_chars (str), ilen,
+                         "ISO-8859-1", enc,
+                         (enum iconv_ilseq_handler) handler, NULL,
+                         &buf, &len);
+
+      if (ret == 0 && handler == SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE)
+        unistring_escapes_to_guile_escapes (&buf, &len);
+
+      if (ret != 0)
+        {
+          scm_misc_error (NULL, "cannot convert to output locale ~s: \"~s\"", 
+                          scm_list_2 (scm_from_locale_string (enc),
+                                      str));
+        }
     }
   else
+    {
+      buf = u32_conv_to_encoding (enc, 
+                                  (enum iconv_ilseq_handler) handler,
+                                  (scm_t_uint32 *) scm_i_string_wide_chars (str), 
+                                  ilen,
+                                  NULL,
+                                  NULL, &len);
+      if (buf == NULL)
+        {
+          scm_misc_error (NULL, "cannot convert to output locale ~s: \"~s\"", 
+                          scm_list_2 (scm_from_locale_string (enc),
+                                      str));
+        }
+    }
+  if (lenp)
     *lenp = len;
+  else
+    {
+      buf = scm_realloc (buf, len + 1);
+      buf[len] = '\0';
+    }
 
   scm_remember_upto_here_1 (str);
-  return res;
+  return buf;
 }
 
 char *
@@ -923,22 +1701,33 @@ scm_to_locale_string (SCM str)
   return scm_to_locale_stringn (str, NULL);
 }
 
+scm_t_uint8 *
+scm_i_to_utf8_string (SCM str)
+{
+  char *u8str;
+  u8str = scm_to_stringn (str, NULL, "UTF-8", SCM_FAILED_CONVERSION_ERROR);
+  return (scm_t_uint8 *) u8str;
+}
+
 size_t
 scm_to_locale_stringbuf (SCM str, char *buf, size_t max_len)
 {
   size_t len;
-  
+  char *result = NULL;
   if (!scm_is_string (str))
     scm_wrong_type_arg_msg (NULL, 0, str, "string");
-  len = scm_i_string_length (str);
-  memcpy (buf, scm_i_string_chars (str), (len > max_len)? max_len : len);
+  result = scm_to_locale_stringn (str, &len);
+
+  memcpy (buf, result, (len > max_len) ? max_len : len);
+  free (result);
+
   scm_remember_upto_here_1 (str);
   return len;
 }
 
 /* converts C scm_array of strings to SCM scm_list of strings. */
 /* If argc < 0, a null terminated scm_array is assumed. */
-SCM 
+SCM
 scm_makfromstrs (int argc, char **argv)
 {
   int i = argc;
@@ -1039,7 +1828,7 @@ scm_i_deprecated_string_chars (SCM str)
 		    "SCM_STRING_CHARS does not work with shared substrings.",
 		    SCM_EOL);
 
-  /* We explicitely test for read-only strings to produce a better
+  /* We explicitly test for read-only strings to produce a better
      error message.
   */
 
@@ -1050,6 +1839,7 @@ scm_i_deprecated_string_chars (SCM str)
     
   /* The following is still wrong, of course...
    */
+  str = scm_i_string_start_writing (str);
   chars = scm_i_string_writable_chars (str);
   scm_i_string_stop_writing ();
   return chars;
@@ -1065,6 +1855,36 @@ scm_i_deprecated_string_length (SCM str)
 
 #endif
 
+static SCM
+string_handle_ref (scm_t_array_handle *h, size_t index)
+{
+  return scm_c_string_ref (h->array, index);
+}
+
+static void
+string_handle_set (scm_t_array_handle *h, size_t index, SCM val)
+{
+  scm_c_string_set_x (h->array, index, val);
+}
+
+static void
+string_get_handle (SCM v, scm_t_array_handle *h)
+{
+  h->array = v;
+  h->ndims = 1;
+  h->dims = &h->dim0;
+  h->dim0.lbnd = 0;
+  h->dim0.ubnd = scm_c_string_length (v) - 1;
+  h->dim0.inc = 1;
+  h->element_type = SCM_ARRAY_ELEMENT_TYPE_CHAR;
+  h->elements = h->writable_elements = NULL;
+}
+
+SCM_ARRAY_IMPLEMENTATION (scm_tc7_string, 0x7f & ~2,
+                          string_handle_ref, string_handle_set,
+                          string_get_handle);
+SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_CHAR, scm_make_string);
+
 void
 scm_init_strings ()
 {
diff --git a/libguile/strings.h b/libguile/strings.h
index 2dabde1d6..910d51ee6 100644
--- a/libguile/strings.h
+++ b/libguile/strings.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,1997,1998,2000,2001, 2004, 2005, 2006, 2008, 2009 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -45,26 +46,37 @@
 
    Internal, low level interface to the character arrays
 
-   - Use scm_i_string_chars to get a pointer to the byte array of a
-     string for reading.  Use scm_i_string_length to get the number of
-     bytes in that array.  The array is not null-terminated.
+   - Use scm_is_narrow_string to determine is the string is narrow or
+     wide.
+
+   - Use scm_i_string_chars or scm_i_string_wide_chars to get a
+     pointer to the byte or scm_t_wchar array of a string for reading.
+     Use scm_i_string_length to get the number of characters in that
+     array.  The array is not null-terminated.
 
    - The array is valid as long as the corresponding SCM object is
      protected but only until the next SCM_TICK.  During such a 'safe
      point', strings might change their representation.
 
-   - Use scm_i_string_writable_chars to get the same pointer as with
-     scm_i_string_chars, but for reading and writing.  This is a
-     potentially costly operation since it implements the
-     copy-on-write behavior.  When done with the writing, call
-     scm_i_string_stop_writing.  You must do this before the next
-     SCM_TICK.  (This means, before calling almost any other scm_
-     function and you can't allow throws, of course.)
-
-   - New strings can be created with scm_i_make_string.  This gives
-     access to a writable pointer that remains valid as long as nobody
-     else makes a copy-on-write substring of the string.  Do not call
-     scm_i_string_stop_writing for this pointer.
+   - Use scm_i_string_start_writing to get a version of the string
+     ready for reading and writing.  This is a potentially costly
+     operation since it implements the copy-on-write behavior.  When
+     done with the writing, call scm_i_string_stop_writing.  You must
+     do this before the next SCM_TICK.  (This means, before calling
+     almost any other scm_ function and you can't allow throws, of
+     course.)
+
+   - New strings can be created with scm_i_make_string or
+     scm_i_make_wide_string.  This gives access to a writable pointer
+     that remains valid as long as nobody else makes a copy-on-write
+     substring of the string.  Do not call scm_i_string_stop_writing
+     for this pointer.
+
+   - Alternately, scm_i_string_ref and scm_i_string_set_x can be used
+     to read and write strings without worrying about whether the
+     string is narrow or wide.  scm_i_string_set_x still needs to be
+     bracketed by scm_i_string_start_writing and
+     scm_i_string_stop_writing.
 
    Legacy interface
 
@@ -73,13 +85,24 @@
    - SCM_STRING_CHARS uses scm_i_string_writable_chars and immediately
      calls scm_i_stop_writing, hoping for the best.  SCM_STRING_LENGTH
      is the same as scm_i_string_length.  SCM_STRING_CHARS will throw
-     an error for for strings that are not null-terminated.
+     an error for for strings that are not null-terminated.  There is
+     no wide version of this interface.
 */
 
+/* A type indicating what strategy to take when string locale
+   conversion is unsuccessful.  */
+typedef enum
+{
+  SCM_FAILED_CONVERSION_ERROR = SCM_ICONVEH_ERROR,
+  SCM_FAILED_CONVERSION_QUESTION_MARK = SCM_ICONVEH_QUESTION_MARK,
+  SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE = SCM_ICONVEH_ESCAPE_SEQUENCE
+} scm_t_string_failed_conversion_handler;
+
 SCM_API SCM scm_string_p (SCM x);
 SCM_API SCM scm_string (SCM chrs);
 SCM_API SCM scm_make_string (SCM k, SCM chr);
 SCM_API SCM scm_string_length (SCM str);
+SCM_API SCM scm_string_bytes_per_char (SCM str);
 SCM_API SCM scm_string_ref (SCM str, SCM k);
 SCM_API SCM scm_string_set_x (SCM str, SCM k, SCM chr);
 SCM_API SCM scm_substring (SCM str, SCM start, SCM end);
@@ -101,10 +124,16 @@ SCM_API SCM scm_c_substring_copy (SCM str, size_t start, size_t end);
 SCM_API int scm_is_string (SCM x);
 SCM_API SCM scm_from_locale_string (const char *str);
 SCM_API SCM scm_from_locale_stringn (const char *str, size_t len);
+SCM_INTERNAL SCM scm_i_from_utf8_string (const scm_t_uint8 *str);
 SCM_API SCM scm_take_locale_string (char *str);
 SCM_API SCM scm_take_locale_stringn (char *str, size_t len);
 SCM_API char *scm_to_locale_string (SCM str);
 SCM_API char *scm_to_locale_stringn (SCM str, size_t *lenp);
+SCM_INTERNAL char *scm_to_stringn (SCM str, size_t *lenp, 
+                                   const char *encoding,
+                                   scm_t_string_failed_conversion_handler
+                                   handler);
+SCM_INTERNAL scm_t_uint8 *scm_i_to_utf8_string (SCM str);
 SCM_API size_t scm_to_locale_stringbuf (SCM str, char *buf, size_t max_len);
 
 SCM_API SCM scm_makfromstrs (int argc, char **argv);
@@ -115,14 +144,15 @@ SCM_API SCM scm_makfromstrs (int argc, char **argv);
 /* Type tag for read-only strings.  */
 #define scm_tc7_ro_string             (scm_tc7_string + 0x200)
 
-/* Flags for shared and inline strings.  */
+/* Flags for shared and wide strings.  */
 #define SCM_I_STRINGBUF_F_SHARED      0x100
-#define SCM_I_STRINGBUF_F_INLINE      0x200
+#define SCM_I_STRINGBUF_F_WIDE        0x400
 
 
 /* internal accessor functions.  Arguments must be valid. */
 
 SCM_INTERNAL SCM scm_i_make_string (size_t len, char **datap);
+SCM_INTERNAL SCM scm_i_make_wide_string (size_t len, scm_t_wchar **datap);
 SCM_INTERNAL SCM scm_i_substring (SCM str, size_t start, size_t end);
 SCM_INTERNAL SCM scm_i_substring_read_only (SCM str, size_t start, size_t end);
 SCM_INTERNAL SCM scm_i_substring_shared (SCM str, size_t start, size_t end);
@@ -130,8 +160,14 @@ SCM_INTERNAL SCM scm_i_substring_copy (SCM str, size_t start, size_t end);
 SCM_INTERNAL size_t scm_i_string_length (SCM str);
 SCM_API /* FIXME: not internal */ const char *scm_i_string_chars (SCM str);
 SCM_API /* FIXME: not internal */ char *scm_i_string_writable_chars (SCM str);
+SCM_INTERNAL const scm_t_wchar *scm_i_string_wide_chars (SCM str);
+SCM_INTERNAL SCM scm_i_string_start_writing (SCM str);
 SCM_INTERNAL void scm_i_string_stop_writing (void);
-
+SCM_INTERNAL int scm_i_is_narrow_string (SCM str);
+SCM_INTERNAL scm_t_wchar scm_i_string_ref (SCM str, size_t x);
+SCM_INTERNAL int scm_i_string_contains_char (SCM str, char c);
+SCM_INTERNAL int scm_i_string_strcmp (SCM sstr, size_t start_x, const char *cstr);
+SCM_INTERNAL void scm_i_string_set_x (SCM str, size_t p, scm_t_wchar chr);
 /* internal functions related to symbols. */
 
 SCM_INTERNAL SCM scm_i_make_symbol (SCM name, scm_t_bits flags,
@@ -139,12 +175,13 @@ SCM_INTERNAL SCM scm_i_make_symbol (SCM name, scm_t_bits flags,
 SCM_INTERNAL SCM
 scm_i_c_make_symbol (const char *name, size_t len,
 		     scm_t_bits flags, unsigned long hash, SCM props);
-SCM_INTERNAL SCM
-scm_i_c_take_symbol (char *name, size_t len,
-		     scm_t_bits flags, unsigned long hash, SCM props);
 SCM_INTERNAL const char *scm_i_symbol_chars (SCM sym);
+SCM_INTERNAL const scm_t_wchar *scm_i_symbol_wide_chars (SCM sym);
 SCM_INTERNAL size_t scm_i_symbol_length (SCM sym);
+SCM_INTERNAL int scm_i_is_narrow_symbol (SCM str);
+SCM_INTERNAL int scm_i_try_narrow_string (SCM str);
 SCM_INTERNAL SCM scm_i_symbol_substring (SCM sym, size_t start, size_t end);
+SCM_INTERNAL scm_t_wchar scm_i_symbol_ref (SCM sym, size_t x);
 
 /* internal utility functions. */
 
@@ -152,7 +189,14 @@ SCM_INTERNAL char **scm_i_allocate_string_pointers (SCM list);
 SCM_INTERNAL void scm_i_get_substring_spec (size_t len,
 					    SCM start, size_t *cstart,
 					    SCM end, size_t *cend);
-SCM_INTERNAL SCM scm_i_take_stringbufn (char *str, size_t len);
+
+/* Debugging functions */
+
+SCM_API SCM scm_sys_string_dump (SCM);
+SCM_API SCM scm_sys_symbol_dump (SCM);
+#if SCM_STRING_LENGTH_HISTOGRAM
+SCM_API SCM scm_sys_stringbuf_hist (void);
+#endif
 
 /* deprecated stuff */
 
diff --git a/libguile/strorder.c b/libguile/strorder.c
index d3ccfcb06..e0a218389 100644
--- a/libguile/strorder.c
+++ b/libguile/strorder.c
@@ -1,18 +1,19 @@
 /*	Copyright (C) 1995, 1996, 1999, 2000, 2004, 2006, 2008 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/strorder.h b/libguile/strorder.h
index 17118634e..2c004e48a 100644
--- a/libguile/strorder.h
+++ b/libguile/strorder.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,2000, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/strports.c b/libguile/strports.c
index bc3fd7014..490a15f8b 100644
--- a/libguile/strports.c
+++ b/libguile/strports.c
@@ -1,18 +1,19 @@
-/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002, 2003, 2005, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002, 2003, 2005, 2006, 2009 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -29,7 +30,7 @@
 #include <unistd.h>
 #endif
 
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
 #include "libguile/eval.h"
 #include "libguile/ports.h"
 #include "libguile/read.h"
@@ -38,6 +39,7 @@
 #include "libguile/modules.h"
 #include "libguile/validate.h"
 #include "libguile/deprecation.h"
+#include "libguile/srfi-4.h"
 
 #include "libguile/strports.h"
 
@@ -107,7 +109,7 @@ stfill_buffer (SCM port)
 /* change the size of a port's string to new_size.  this doesn't
    change read_buf_size.  */
 static void 
-st_resize_port (scm_t_port *pt, off_t new_size)
+st_resize_port (scm_t_port *pt, scm_t_off new_size)
 {
   SCM old_stream = SCM_PACK (pt->stream);
   const char *src = scm_i_string_chars (old_stream);
@@ -117,7 +119,7 @@ st_resize_port (scm_t_port *pt, off_t new_size)
   unsigned long int min_size = min (old_size, new_size);
   unsigned long int i;
 
-  off_t index = pt->write_pos - pt->write_buf;
+  scm_t_off index = pt->write_pos - pt->write_buf;
 
   pt->write_buf_size = new_size;
 
@@ -198,11 +200,11 @@ st_end_input (SCM port, int offset)
   pt->rw_active = SCM_PORT_NEITHER;
 }
 
-static off_t
-st_seek (SCM port, off_t offset, int whence)
+static scm_t_off
+st_seek (SCM port, scm_t_off offset, int whence)
 {
   scm_t_port *pt = SCM_PTAB_ENTRY (port);
-  off_t target;
+  scm_t_off target;
 
   if (pt->rw_active == SCM_PORT_READ && offset == 0 && whence == SEEK_CUR)
     /* special case to avoid disturbing the unread-char buffer.  */
@@ -271,7 +273,7 @@ st_seek (SCM port, off_t offset, int whence)
 }
 
 static void
-st_truncate (SCM port, off_t length)
+st_truncate (SCM port, scm_t_off length)
 {
   scm_t_port *pt = SCM_PTAB_ENTRY (port);
 
@@ -288,42 +290,33 @@ st_truncate (SCM port, off_t length)
 }
 
 SCM 
-scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
+scm_i_mkstrport (SCM pos, const char *locale_str, size_t str_len, long modes, const char *caller)
 {
-  SCM z;
+  SCM z, str;
   scm_t_port *pt;
-  size_t str_len, c_pos;
-
-  SCM_ASSERT (scm_is_string (str), str, SCM_ARG1, caller);
+  size_t c_pos;
+  char *buf;
+
+  /* Because ports are inherently 8-bit, strings need to be converted
+     to a locale representation for storage.  But, since string ports
+     rely on string functionality for their memory management, we need
+     to create a new string that has the 8-bit locale representation
+     of the underlying string.  This violates the guideline that the
+     internal encoding of characters in strings is in unicode
+     codepoints. */
+  str = scm_i_make_string (str_len, &buf);
+  memcpy (buf, locale_str, str_len);
 
-  str_len = scm_i_string_length (str);
   c_pos = scm_to_unsigned_integer (pos, 0, str_len);
 
   if (!((modes & SCM_WRTNG) || (modes & SCM_RDNG)))
     scm_misc_error ("scm_mkstrport", "port must read or write", SCM_EOL);
 
-  /* XXX
- 
-     Make a new string to isolate us from changes to the original.
-     This is done so that we can rely on scm_i_string_chars to stay in
-     place even across SCM_TICKs.
-
-     Additionally, when we are going to write to the string, we make a
-     copy so that we can write to it without having to use
-     scm_i_string_writable_chars.
-  */
-
-  if (modes & SCM_WRTNG)
-    str = scm_c_substring_copy (str, 0, str_len);
-  else
-    str = scm_c_substring (str, 0, str_len);
-
   scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
   z = scm_new_port_table_entry (scm_tc16_strport);
   pt = SCM_PTAB_ENTRY(z);
   SCM_SETSTREAM (z, SCM_UNPACK (str));
   SCM_SET_CELL_TYPE(z, scm_tc16_strport|modes);
-  /* see above why we can use scm_i_string_chars here. */
   pt->write_buf = pt->read_buf = (unsigned char *) scm_i_string_chars (str);
   pt->read_pos = pt->write_pos = pt->read_buf + c_pos;
   pt->write_buf_size = pt->read_buf_size = str_len;
@@ -339,22 +332,60 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
   return z;
 }
 
+SCM 
+scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
+{
+  SCM z;
+  size_t str_len;
+  char *buf;
+
+  SCM_ASSERT (scm_is_string (str), str, SCM_ARG1, caller);
+
+  /* Because ports are inherently 8-bit, strings need to be converted
+     to a locale representation for storage.  But, since string ports
+     rely on string functionality for their memory management, we need
+     to create a new string that has the 8-bit locale representation
+     of the underlying string.  This violates the guideline that the
+     internal encoding of characters in strings is in unicode
+     codepoints. */
+  buf = scm_to_locale_stringn (str, &str_len);
+  z = scm_i_mkstrport (pos, buf, str_len, modes, caller);
+  free (buf);
+  return z;
+}
+
 /* create a new string from a string port's buffer.  */
 SCM scm_strport_to_string (SCM port)
 {
   scm_t_port *pt = SCM_PTAB_ENTRY (port);
   SCM str;
-  char *dst;
   
   if (pt->rw_active == SCM_PORT_WRITE)
     st_flush (port);
 
-  str = scm_i_make_string (pt->read_buf_size, &dst);
-  memcpy (dst, (char *) pt->read_buf, pt->read_buf_size);
+  str = scm_from_locale_stringn ((char *)pt->read_buf, pt->read_buf_size);
   scm_remember_upto_here_1 (port);
   return str;
 }
 
+/* Create a vector containing the locale representation of the string in the
+   port's buffer.  */
+SCM scm_strport_to_locale_u8vector (SCM port)
+{
+  scm_t_port *pt = SCM_PTAB_ENTRY (port);
+  SCM vec;
+  char *buf;
+  
+  if (pt->rw_active == SCM_PORT_WRITE)
+    st_flush (port);
+
+  buf = scm_malloc (pt->read_buf_size);
+  memcpy (buf, pt->read_buf, pt->read_buf_size);
+  vec = scm_take_u8vector ((unsigned char *) buf, pt->read_buf_size);
+  scm_remember_upto_here_1 (port);
+  return vec;
+}
+
 SCM_DEFINE (scm_object_to_string, "object->string", 1, 1, 0,
 	    (SCM obj, SCM printer),
 	    "Return a Scheme string obtained by printing @var{obj}.\n"
@@ -379,6 +410,25 @@ SCM_DEFINE (scm_object_to_string, "object->string", 1, 1, 0,
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (scm_call_with_output_locale_u8vector, "call-with-output-locale-u8vector", 1, 0, 0, 
+           (SCM proc),
+	    "Calls the one-argument procedure @var{proc} with a newly created output\n"
+	    "port.  When the function returns, a vector containing the bytes of a\n"
+	    "locale representation of the characters written into the port is returned\n")
+#define FUNC_NAME s_scm_call_with_output_locale_u8vector
+{
+  SCM p;
+
+  p = scm_mkstrport (SCM_INUM0, 
+		     scm_make_string (SCM_INUM0, SCM_UNDEFINED),
+		     SCM_OPN | SCM_WRTNG,
+                     FUNC_NAME);
+  scm_call_1 (proc, p);
+
+  return scm_get_output_locale_u8vector (p);
+}
+#undef FUNC_NAME
+
 SCM_DEFINE (scm_call_with_output_string, "call-with-output-string", 1, 0, 0, 
            (SCM proc),
 	    "Calls the one-argument procedure @var{proc} with a newly created output\n"
@@ -423,6 +473,27 @@ SCM_DEFINE (scm_open_input_string, "open-input-string", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (scm_open_input_locale_u8vector, "open-input-locale-u8vector", 1, 0, 0,
+	    (SCM vec),
+	    "Take a u8vector containing the bytes of a string encoded in the\n"
+	    "current locale and return an input port that delivers characters\n"
+	    "from the string. The port can be closed by\n"
+	    "@code{close-input-port}, though its storage will be reclaimed\n"
+	    "by the garbage collector if it becomes inaccessible.")
+#define FUNC_NAME s_scm_open_input_locale_u8vector
+{
+  scm_t_array_handle hnd;
+  ssize_t inc;
+  size_t len;
+  const scm_t_uint8 *buf;
+
+  buf = scm_u8vector_elements (vec, &hnd, &len, &inc);
+  SCM p = scm_i_mkstrport(SCM_INUM0, (const char *) buf, len, SCM_OPN | SCM_RDNG, FUNC_NAME);
+  scm_array_handle_release (&hnd);
+  return p;
+}
+#undef FUNC_NAME
+
 SCM_DEFINE (scm_open_output_string, "open-output-string", 0, 0, 0, 
 	    (void),
 	    "Return an output port that will accumulate characters for\n"
@@ -455,11 +526,26 @@ SCM_DEFINE (scm_get_output_string, "get-output-string", 1, 0, 0,
 #undef FUNC_NAME
 
 
+SCM_DEFINE (scm_get_output_locale_u8vector, "get-output-locale-u8vector", 1, 0, 0, 
+	    (SCM port),
+	    "Given an output port created by @code{open-output-string},\n"
+	    "return a u8 vector containing the characters of the string\n"
+	    "encoded in the current locale.")
+#define FUNC_NAME s_scm_get_output_locale_u8vector
+{
+  SCM_VALIDATE_OPOUTSTRPORT (1, port);
+  return scm_strport_to_locale_u8vector (port);
+}
+#undef FUNC_NAME
+
+
 /* Given a null-terminated string EXPR containing a Scheme expression
    read it, and return it as an SCM value. */
 SCM
 scm_c_read_string (const char *expr)
 {
+  /* FIXME: the c string gets packed into a string, only to get
+     immediately unpacked in scm_mkstrport.  */
   SCM port = scm_mkstrport (SCM_INUM0,
 			    scm_from_locale_string (expr),
 			    SCM_OPN | SCM_RDNG,
diff --git a/libguile/strports.h b/libguile/strports.h
index 58ca71f57..b2ded01f1 100644
--- a/libguile/strports.h
+++ b/libguile/strports.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,2000,2001,2002, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -43,13 +44,19 @@ SCM_API scm_t_bits scm_tc16_strport;
 
 
 SCM_API SCM scm_mkstrport (SCM pos, SCM str, long modes, const char * caller);
+SCM_INTERNAL SCM scm_i_mkstrport (SCM pos, const char *locale_str, size_t str_len, 
+				  long modes, const char *caller);
 SCM_API SCM scm_strport_to_string (SCM port);
+SCM_API SCM scm_strport_to_locale_u8vector (SCM port);
 SCM_API SCM scm_object_to_string (SCM obj, SCM printer);
 SCM_API SCM scm_call_with_output_string (SCM proc);
+SCM_API SCM scm_call_with_output_locale_u8vector (SCM proc);
 SCM_API SCM scm_call_with_input_string (SCM str, SCM proc);
 SCM_API SCM scm_open_input_string (SCM str);
+SCM_API SCM scm_open_input_locale_u8vector (SCM str);
 SCM_API SCM scm_open_output_string (void);
 SCM_API SCM scm_get_output_string (SCM port);
+SCM_API SCM scm_get_output_locale_u8vector (SCM port);
 SCM_API SCM scm_c_read_string (const char *expr);
 SCM_API SCM scm_c_eval_string (const char *expr);
 SCM_API SCM scm_c_eval_string_in_module (const char *expr, SCM module);
diff --git a/libguile/struct.c b/libguile/struct.c
index b536bea3b..b7e72a719 100644
--- a/libguile/struct.c
+++ b/libguile/struct.c
@@ -1,18 +1,19 @@
-/* Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2007, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -29,6 +30,7 @@
 #include "libguile/hashtab.h"
 #include "libguile/ports.h"
 #include "libguile/strings.h"
+#include "libguile/srfi-13.h"
 
 #include "libguile/validate.h"
 #include "libguile/struct.h"
@@ -62,9 +64,9 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
 {
   SCM new_sym;
   SCM_VALIDATE_STRING (1, fields);
+  scm_t_wchar c;
 
   { /* scope */
-    const char * field_desc;
     size_t len;
     int x;
 
@@ -73,11 +75,9 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
       SCM_MISC_ERROR ("odd length field specification: ~S", 
 		      scm_list_1 (fields));
 
-    field_desc = scm_i_string_chars (fields);
-
     for (x = 0; x < len; x += 2)
       {
-	switch (field_desc[x])
+	switch (c = scm_i_string_ref (fields, x))
 	  {
 	  case 'u':
 	  case 'p':
@@ -89,13 +89,13 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
 	    break;
 	  default:
 	    SCM_MISC_ERROR ("unrecognized field type: ~S", 
-			    scm_list_1 (SCM_MAKE_CHAR (field_desc[x])));
+			    scm_list_1 (SCM_MAKE_CHAR (c)));
 	  }
 
-	switch (field_desc[x + 1])
+	switch (c = scm_i_string_ref (fields, x + 1))
 	  {
 	  case 'w':
-	    if (field_desc[x] == 's')
+	    if (scm_i_string_ref (fields, x) == 's')
 	      SCM_MISC_ERROR ("self fields not writable", SCM_EOL);
 	  case 'r':
 	  case 'o':
@@ -103,7 +103,7 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
 	  case 'R':
 	  case 'W':
 	  case 'O':
-	    if (field_desc[x] == 's')
+	    if (scm_i_string_ref (fields, x) == 's')
 	      SCM_MISC_ERROR ("self fields not allowed in tail array", 
 			      SCM_EOL);
 	    if (x != len - 2)
@@ -112,12 +112,12 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
 	    break;
 	  default:
 	    SCM_MISC_ERROR ("unrecognized ref specification: ~S",
-			    scm_list_1 (SCM_MAKE_CHAR (field_desc[x + 1])));
+			    scm_list_1 (SCM_MAKE_CHAR (c)));
 	  }
 #if 0
-	if (field_desc[x] == 'd')
+	if (scm_i_string_ref (fields, x, 'd'))
 	  {
-	    if (field_desc[x + 2] != '-')
+	    if (!scm_i_string_ref (fields, x+2, '-'))
 	      SCM_MISC_ERROR ("missing dash field at position ~A",
 			      scm_list_1 (scm_from_int (x / 2)));
 	    x += 2;
@@ -139,18 +139,18 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
 static void
 scm_struct_init (SCM handle, SCM layout, scm_t_bits * mem, int tail_elts, SCM inits)
 {
-  unsigned const char *fields_desc =
-    (unsigned const char *) scm_i_symbol_chars (layout) - 2;
-  unsigned char prot = 0;
+  scm_t_wchar prot = 0;
   int n_fields = scm_i_symbol_length (layout) / 2;
   int tailp = 0;
+  int i;
 
+  i = -2;
   while (n_fields)
     {
       if (!tailp)
 	{
-	  fields_desc += 2;
-	  prot = fields_desc[1];
+	  i += 2;
+	  prot = scm_i_symbol_ref (layout, i+1);
 	  if (SCM_LAYOUT_TAILP (prot))
 	    {
 	      tailp = 1;
@@ -161,8 +161,7 @@ scm_struct_init (SCM handle, SCM layout, scm_t_bits * mem, int tail_elts, SCM in
 		break;
 	    }
 	}
-      
-      switch (*fields_desc)
+      switch (scm_i_symbol_ref (layout, i))
 	{
 #if 0
 	case 'i':
@@ -238,7 +237,8 @@ SCM_DEFINE (scm_struct_vtable_p, "struct-vtable?", 1, 0, 0,
 {
   SCM layout;
   scm_t_bits * mem;
-  int tmp;
+  SCM tmp;
+  size_t len;
 
   if (!SCM_STRUCTP (x))
     return SCM_BOOL_F;
@@ -249,11 +249,14 @@ SCM_DEFINE (scm_struct_vtable_p, "struct-vtable?", 1, 0, 0,
       < scm_i_string_length (required_vtable_fields))
     return SCM_BOOL_F;
 
-  tmp = strncmp (scm_i_symbol_chars (layout),
-		 scm_i_string_chars (required_vtable_fields),
-		 scm_i_string_length (required_vtable_fields));
-  scm_remember_upto_here_1 (required_vtable_fields);
-  if (tmp)
+  len = scm_i_string_length (required_vtable_fields);
+  tmp = scm_string_eq (scm_symbol_to_string (layout), 
+		       required_vtable_fields, 
+		       scm_from_size_t (0), 
+		       scm_from_size_t (len), 
+		       scm_from_size_t (0),
+		       scm_from_size_t (len));
+  if (scm_is_false (tmp))
     return SCM_BOOL_F;
 
   mem = SCM_STRUCT_DATA (x);
@@ -337,7 +340,7 @@ struct_finalizer_trampoline (GC_PTR ptr, GC_PTR unused_data)
   scm_t_struct_free free_struct_data
     = ((scm_t_struct_free) vtable_data[scm_struct_i_free]);
 
-  SCM_SET_CELL_TYPE (obj, scm_tc_free_cell);
+  SCM_SET_CELL_TYPE (obj, scm_tc3_struct);
 
 #if 0
   /* A sanity check.  However, this check can fail if the free function
@@ -620,8 +623,7 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
   size_t layout_len;
   size_t p;
   scm_t_bits n_fields;
-  const char *fields_desc;
-  char field_type = 0;
+  scm_t_wchar field_type = 0;
   
 
   SCM_VALIDATE_STRUCT (1, handle);
@@ -630,7 +632,6 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
   data = SCM_STRUCT_DATA (handle);
   p = scm_to_size_t (pos);
 
-  fields_desc = scm_i_symbol_chars (layout);
   layout_len = scm_i_symbol_length (layout);
   if (SCM_STRUCT_VTABLE_FLAGS (handle) & SCM_STRUCTF_LIGHT)
     /* no extra words */
@@ -642,9 +643,9 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
 
   if (p * 2 < layout_len)
     {
-      char ref;
-      field_type = fields_desc[p * 2];
-      ref = fields_desc[p * 2 + 1];
+      scm_t_wchar ref;
+      field_type = scm_i_symbol_ref (layout, p * 2);
+      ref = scm_i_symbol_ref (layout, p * 2 + 1);
       if ((ref != 'r') && (ref != 'w'))
 	{
 	  if ((ref == 'R') || (ref == 'W'))
@@ -653,8 +654,8 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
 	    SCM_MISC_ERROR ("ref denied for field ~A", scm_list_1 (pos));
 	}
     }
-  else if (fields_desc[layout_len - 1] != 'O')    
-    field_type = fields_desc[layout_len - 2];
+  else if (scm_i_symbol_ref (layout, layout_len - 1) != 'O')
+    field_type = scm_i_symbol_ref(layout, layout_len - 2);
   else
     SCM_MISC_ERROR ("ref denied for field ~A", scm_list_1 (pos));
   
@@ -702,8 +703,7 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
   size_t layout_len;
   size_t p;
   int n_fields;
-  const char *fields_desc;
-  char field_type = 0;
+  scm_t_wchar field_type = 0;
 
   SCM_VALIDATE_STRUCT (1, handle);
 
@@ -711,7 +711,6 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
   data = SCM_STRUCT_DATA (handle);
   p = scm_to_size_t (pos);
 
-  fields_desc = scm_i_symbol_chars (layout);
   layout_len = scm_i_symbol_length (layout);
   if (SCM_STRUCT_VTABLE_FLAGS (handle) & SCM_STRUCTF_LIGHT)
     /* no extra words */
@@ -724,13 +723,13 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
   if (p * 2 < layout_len)
     {
       char set_x;
-      field_type = fields_desc[p * 2];
-      set_x = fields_desc [p * 2 + 1];
+      field_type = scm_i_symbol_ref (layout, p * 2);
+      set_x = scm_i_symbol_ref (layout, p * 2 + 1);
       if (set_x != 'w')
 	SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos));
     }
-  else if (fields_desc[layout_len - 1] == 'W')    
-    field_type = fields_desc[layout_len - 2];
+  else if (scm_i_symbol_ref (layout, layout_len - 1) == 'W')    
+    field_type = scm_i_symbol_ref (layout, layout_len - 2);
   else
     SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos));
   
diff --git a/libguile/struct.h b/libguile/struct.h
index cccf429ec..12069b487 100644
--- a/libguile/struct.h
+++ b/libguile/struct.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1997,1999,2000,2001, 2006, 2007, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/symbols.c b/libguile/symbols.c
index 0814942d4..c77749f11 100644
--- a/libguile/symbols.c
+++ b/libguile/symbols.c
@@ -1,18 +1,19 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004, 2006, 2009 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -88,15 +89,17 @@ scm_i_hash_symbol (SCM obj, unsigned long n, void *closure)
 }
 
 static SCM
-lookup_interned_symbol (const char *name, size_t len,
-			unsigned long raw_hash)
+lookup_interned_symbol (SCM name, unsigned long raw_hash)
 {
   /* Try to find the symbol in the symbols table */
   SCM result = SCM_BOOL_F;
   SCM bucket, elt, previous_elt;
+  size_t len;
   unsigned long hash = raw_hash % SCM_HASHTABLE_N_BUCKETS (symbols);
 
+  len = scm_i_string_length (name);
   bucket = SCM_HASHTABLE_BUCKET (symbols, hash);
+
   for (elt = bucket, previous_elt = SCM_BOOL_F;
        !scm_is_null (elt);
        previous_elt = elt, elt = SCM_CDR (elt))
@@ -129,15 +132,32 @@ lookup_interned_symbol (const char *name, size_t len,
       if (scm_i_symbol_hash (sym) == raw_hash
 	  && scm_i_symbol_length (sym) == len)
 	{
-	  const char *chrs = scm_i_symbol_chars (sym);
-	  size_t i = len;
-
-	  while (i != 0)
-	    {
-	      --i;
-	      if (name[i] != chrs[i])
-		goto next_symbol;
-	    }
+          size_t i = len;
+
+          /* Slightly faster path for comparing narrow to narrow.  */
+          if (scm_i_is_narrow_string (name) && scm_i_is_narrow_symbol (sym))
+            {
+              const char *chrs = scm_i_symbol_chars (sym);
+              const char *str = scm_i_string_chars (name);
+
+              while (i != 0)
+                {
+                  --i;
+                  if (str[i] != chrs[i])
+                    goto next_symbol;
+                }
+            }
+          else
+            {
+              /* Somewhat slower path for comparing narrow to wide or
+                 wide to wide.  */
+              while (i != 0)
+                {
+                  --i;
+                  if (scm_i_string_ref (name, i) != scm_i_symbol_ref (sym, i))
+                    goto next_symbol;
+                }
+            }
 
 	  /* We found it.  */
 	  result = sym;
@@ -154,69 +174,47 @@ lookup_interned_symbol (const char *name, size_t len,
   return result;
 }
 
-static SCM
-scm_i_c_mem2symbol (const char *name, size_t len)
+/* Intern SYMBOL, an uninterned symbol.  */
+static void
+intern_symbol (SCM symbol)
 {
-  SCM symbol;
-  size_t raw_hash = scm_string_hash ((const unsigned char *) name, len);
-  size_t hash = raw_hash % SCM_HASHTABLE_N_BUCKETS (symbols);
-
-  symbol = lookup_interned_symbol (name, len, raw_hash);
-  if (symbol != SCM_BOOL_F)
-    return symbol;
-
-  {
-    /* The symbol was not found - create it. */
-    SCM symbol = scm_i_c_make_symbol (name, len, 0, raw_hash,
-				      scm_cons (SCM_BOOL_F, SCM_EOL));
-
-    SCM slot = SCM_HASHTABLE_BUCKET (symbols, hash);
-    SCM cell = scm_weak_car_pair (symbol, SCM_UNDEFINED);
-    SCM_SET_HASHTABLE_BUCKET (symbols, hash, scm_cons (cell, slot));
-    SCM_HASHTABLE_INCREMENT (symbols);
-    if (SCM_HASHTABLE_N_ITEMS (symbols) > SCM_HASHTABLE_UPPER (symbols))
-      scm_i_rehash (symbols, scm_i_hash_symbol, 0, "scm_mem2symbol");
-
-    return symbol;
-  }
+  SCM slot, cell;
+  unsigned long hash;
+
+  hash = scm_i_symbol_hash (symbol) % SCM_HASHTABLE_N_BUCKETS (symbols);
+  slot = SCM_HASHTABLE_BUCKET (symbols, hash);
+  cell = scm_cons (symbol, SCM_UNDEFINED);
+
+  SCM_SET_HASHTABLE_BUCKET (symbols, hash, scm_cons (cell, slot));
+  SCM_HASHTABLE_INCREMENT (symbols);
+
+  if (SCM_HASHTABLE_N_ITEMS (symbols) > SCM_HASHTABLE_UPPER (symbols))
+    scm_i_rehash (symbols, scm_i_hash_symbol, 0, "intern_symbol");
 }
 
 static SCM
-scm_i_mem2symbol (SCM str)
+scm_i_str2symbol (SCM str)
 {
   SCM symbol;
-  const char *name = scm_i_string_chars (str);
-  size_t len = scm_i_string_length (str);
-  size_t raw_hash = scm_string_hash ((const unsigned char *) name, len);
-  size_t hash = raw_hash % SCM_HASHTABLE_N_BUCKETS (symbols);
-
-  symbol = lookup_interned_symbol (name, len, raw_hash);
-  if (symbol != SCM_BOOL_F)
-    return symbol;
-
-  {
-    /* The symbol was not found - create it. */
-    SCM symbol = scm_i_make_symbol (str, 0, raw_hash,
-				    scm_cons (SCM_BOOL_F, SCM_EOL));
-
-    SCM slot = SCM_HASHTABLE_BUCKET (symbols, hash);
-    SCM cell = scm_weak_car_pair (symbol, SCM_UNDEFINED);
-    SCM_SET_HASHTABLE_BUCKET (symbols, hash, scm_cons (cell, slot));
-    SCM_HASHTABLE_INCREMENT (symbols);
-    if (SCM_HASHTABLE_N_ITEMS (symbols) > SCM_HASHTABLE_UPPER (symbols))
-      scm_i_rehash (symbols, scm_i_hash_symbol, 0, "scm_mem2symbol");
-
-    return symbol;
-  }
+  size_t raw_hash = scm_i_string_hash (str);
+
+  symbol = lookup_interned_symbol (str, raw_hash);
+  if (scm_is_false (symbol))
+    {
+      /* The symbol was not found, create it.  */
+      symbol = scm_i_make_symbol (str, 0, raw_hash,
+				  scm_cons (SCM_BOOL_F, SCM_EOL));
+      intern_symbol (symbol);
+    }
+
+  return symbol;
 }
 
 
 static SCM
-scm_i_mem2uninterned_symbol (SCM str)
+scm_i_str2uninterned_symbol (SCM str)
 {
-  const char *name = scm_i_string_chars (str);
-  size_t len = scm_i_string_length (str);
-  size_t raw_hash = scm_string_hash ((const unsigned char *) name, len);
+  size_t raw_hash = scm_i_string_hash (str);
 
   return scm_i_make_symbol (str, SCM_I_F_SYMBOL_UNINTERNED, 
 			    raw_hash, scm_cons (SCM_BOOL_F, SCM_EOL));
@@ -251,7 +249,7 @@ SCM_DEFINE (scm_make_symbol, "make-symbol", 1, 0, 0,
 #define FUNC_NAME s_scm_make_symbol
 {
   SCM_VALIDATE_STRING (1, name);
-  return scm_i_mem2uninterned_symbol (name);
+  return scm_i_str2uninterned_symbol (name);
 }
 #undef FUNC_NAME
 
@@ -313,7 +311,7 @@ SCM_DEFINE (scm_string_to_symbol, "string->symbol", 1, 0, 0,
 #define FUNC_NAME s_scm_string_to_symbol
 {
   SCM_VALIDATE_STRING (1, string);
-  return scm_i_mem2symbol (string);
+  return scm_i_str2symbol (string);
 }
 #undef FUNC_NAME
 
@@ -420,44 +418,23 @@ SCM_DEFINE (scm_symbol_pset_x, "symbol-pset!", 2, 0, 0,
 SCM
 scm_from_locale_symbol (const char *sym)
 {
-  return scm_i_c_mem2symbol (sym, strlen (sym));
+  return scm_from_locale_symboln (sym, -1);
 }
 
 SCM
 scm_from_locale_symboln (const char *sym, size_t len)
 {
-  return scm_i_c_mem2symbol (sym, len);
+  SCM str = scm_from_locale_stringn (sym, len);
+  return scm_i_str2symbol (str);
 }
 
 SCM
 scm_take_locale_symboln (char *sym, size_t len)
 {
-  SCM res;
-  unsigned long raw_hash;
-
-  if (len == (size_t)-1)
-    len = strlen (sym);
-  else
-    {
-      /* Ensure STR is null terminated.  A realloc for 1 extra byte should
-         often be satisfied from the alignment padding after the block, with
-         no actual data movement.  */
-      sym = scm_realloc (sym, len+1);
-      sym[len] = '\0';
-    }
-
-  raw_hash = scm_string_hash ((unsigned char *)sym, len);
-  res = lookup_interned_symbol (sym, len, raw_hash);
-  if (res != SCM_BOOL_F)
-    {
-      free (sym);
-      return res;
-    }
-
-  res = scm_i_c_take_symbol (sym, len, 0, raw_hash,
-			     scm_cons (SCM_BOOL_F, SCM_EOL));
+  SCM str;
 
-  return res;
+  str = scm_take_locale_stringn (sym, len);
+  return scm_i_str2symbol (str);
 }
 
 SCM
diff --git a/libguile/symbols.h b/libguile/symbols.h
index c2dc18363..e4bc33391 100644
--- a/libguile/symbols.h
+++ b/libguile/symbols.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/tags.h b/libguile/tags.h
index 666d5c8dc..146f2a59c 100644
--- a/libguile/tags.h
+++ b/libguile/tags.h
@@ -7,18 +7,19 @@
  * Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -373,10 +374,6 @@ typedef unsigned long scm_t_bits;
  * tc16 (for tc7==scm_tc7_smob):
  *   The largest part of the space of smob types is not subdivided in a
  *   predefined way, since smobs can be added arbitrarily by user C code.
- *   However, while Guile also defines a number of smob types throughout,
- *   there is one smob type, namely scm_tc_free_cell, for which Guile assumes
- *   that it is declared first and thus gets a known-in-advance tc16-code.
- *   The reason of requiring a fixed tc16-code for this type is performance.
  */
 
 
@@ -437,6 +434,7 @@ typedef unsigned long scm_t_bits;
 #define scm_tc7_string		21
 #define scm_tc7_number		23
 #define scm_tc7_stringbuf       39
+#define scm_tc7_bytevector	77
 
 /* Many of the following should be turned
  * into structs or smobs.  We need back some
@@ -451,12 +449,11 @@ typedef unsigned long scm_t_bits;
 #define scm_tc7_unused_5	53
 #define scm_tc7_unused_6	55
 #define scm_tc7_unused_7	71
-#define scm_tc7_unused_8	77
-#define scm_tc7_unused_9	79
 
 #define scm_tc7_dsubr		61
 #define scm_tc7_gsubr		63
 #define scm_tc7_rpsubr		69
+#define scm_tc7_program		79
 #define scm_tc7_subr_0		85
 #define scm_tc7_subr_1		87
 #define scm_tc7_cxr		93
@@ -483,12 +480,6 @@ typedef unsigned long scm_t_bits;
 #define SCM_TYP16_PREDICATE(tag, x) (!SCM_IMP (x) && SCM_TYP16 (x) == (tag))
 
 
-/* Here is the first smob subtype.  */
-
-/* scm_tc_free_cell is the 0th smob type.  We place this in free cells to tell
- * the conservative marker not to trace it.  */
-#define scm_tc_free_cell	(scm_tc7_smob + 0 * 256L)
-
 
 
 /* {Immediate Values}
diff --git a/libguile/threads.c b/libguile/threads.c
index 8ba25f7dc..f440bf59d 100644
--- a/libguile/threads.c
+++ b/libguile/threads.c
@@ -1,18 +1,19 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -298,7 +299,7 @@ unblock_from_queue (SCM queue)
       var 't'
       // save registers.
       SCM_FLUSH_REGISTER_WINDOWS;      // sparc only
-      setjmp (t->regs);                // here's most of the magic
+      SCM_I_SETJMP (t->regs);          // here's most of the magic
 
    ... and returns.
 
@@ -352,7 +353,7 @@ unblock_from_queue (SCM queue)
       t->top = SCM_STACK_PTR (&t);
       // save registers.
       SCM_FLUSH_REGISTER_WINDOWS;
-      setjmp (t->regs);
+      SCM_I_SETJMP (t->regs);
       res = func(data);
       scm_enter_guile (t);
 
@@ -403,7 +404,7 @@ suspend (void)
   t->top = SCM_STACK_PTR (&t);
   /* save registers. */
   SCM_FLUSH_REGISTER_WINDOWS;
-  setjmp (t->regs);
+  SCM_I_SETJMP (t->regs);
   return t;
 }
 
@@ -499,6 +500,7 @@ guilify_self_2 (SCM parent)
 
   t->continuation_root = scm_cons (t->handle, SCM_EOL);
   t->continuation_base = t->base;
+  t->vm = SCM_BOOL_F;
 
   if (scm_is_true (parent))
     t->dynamic_state = scm_make_dynamic_state (parent);
@@ -1179,6 +1181,16 @@ SCM_DEFINE (scm_join_thread_timed, "join-thread", 1, 2, 0,
 	  scm_i_pthread_mutex_unlock (&t->admin_mutex);
 	  SCM_TICK;
 	  scm_i_scm_pthread_mutex_lock (&t->admin_mutex);
+
+	  /* Check for exit again, since we just released and
+	     reacquired the admin mutex, before the next block_self
+	     call (which would block forever if t has already
+	     exited). */
+	  if (t->exited)
+	    {
+	      res = t->result;
+	      break;
+	    }
 	}
     }
 
@@ -1502,6 +1514,7 @@ fat_mutex_unlock (SCM mutex, SCM cond,
 	    {
 	      if (relock)
 		scm_lock_mutex_timed (mutex, SCM_UNDEFINED, owner);
+	      t->block_asyncs--;
 	      break;
 	    }
 
@@ -2055,6 +2068,49 @@ scm_init_thread_procs ()
 #include "libguile/threads.x"
 }
 
+
+/* IA64-specific things.  */
+
+#ifdef __ia64__
+# ifdef __hpux
+#  include <sys/param.h>
+#  include <sys/pstat.h>
+void *
+scm_ia64_register_backing_store_base (void)
+{
+  struct pst_vm_status vm_status;
+  int i = 0;
+  while (pstat_getprocvm (&vm_status, sizeof (vm_status), 0, i++) == 1)
+    if (vm_status.pst_type == PS_RSESTACK)
+      return (void *) vm_status.pst_vaddr;
+  abort ();
+}
+void *
+scm_ia64_ar_bsp (const void *ctx)
+{
+  uint64_t bsp;
+  __uc_get_ar_bsp (ctx, &bsp);
+  return (void *) bsp;
+}
+# endif /* hpux */
+# ifdef linux
+#  include <ucontext.h>
+void *
+scm_ia64_register_backing_store_base (void)
+{
+  extern void *__libc_ia64_register_backing_store_base;
+  return __libc_ia64_register_backing_store_base;
+}
+void *
+scm_ia64_ar_bsp (const void *opaque)
+{
+  const ucontext_t *ctx = opaque;
+  return (void *) ctx->uc_mcontext.sc_ar_bsp;
+}
+# endif /* linux */
+#endif /* __ia64__ */
+
+
 /*
   Local Variables:
   c-file-style: "gnu"
diff --git a/libguile/threads.h b/libguile/threads.h
index 59c7c2c60..55102df17 100644
--- a/libguile/threads.h
+++ b/libguile/threads.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1996,1997,1998,2000,2001, 2002, 2003, 2004, 2006, 2007, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -107,9 +108,10 @@ typedef struct scm_i_thread {
   SCM_STACKITEM *continuation_base;
 
   /* For keeping track of the stack and registers. */
+  SCM vm;
   SCM_STACKITEM *base;
   SCM_STACKITEM *top;
-  jmp_buf regs;
+  scm_i_jmp_buf regs;
 #ifdef __ia64__
   void *register_backing_store_base;
   scm_t_contregs *pending_rbs_continuation;
diff --git a/libguile/throw.c b/libguile/throw.c
index ae538e25e..cf6ea4a49 100644
--- a/libguile/throw.c
+++ b/libguile/throw.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004, 2006, 2008 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -22,6 +23,7 @@
 #endif
 
 #include <stdio.h>
+#include <unistdio.h>
 #include "libguile/_scm.h"
 #include "libguile/async.h"
 #include "libguile/smob.h"
@@ -41,6 +43,7 @@
 #include "libguile/throw.h"
 #include "libguile/init.h"
 #include "libguile/strings.h"
+#include "libguile/vm.h"
 
 #include "libguile/private-options.h"
 
@@ -57,7 +60,7 @@ static scm_t_bits tc16_jmpbuffer;
 #define DEACTIVATEJB(x) \
   (SCM_SET_CELL_WORD_0 ((x), (SCM_CELL_WORD_0 (x) & ~(1L << 16L))))
 
-#define JBJMPBUF(OBJ)           ((jmp_buf *) SCM_CELL_WORD_1 (OBJ))
+#define JBJMPBUF(OBJ)           ((scm_i_jmp_buf *) SCM_CELL_WORD_1 (OBJ))
 #define SETJBJMPBUF(x, v)        (SCM_SET_CELL_WORD_1 ((x), (scm_t_bits) (v)))
 #define SCM_JBDFRAME(x)         ((scm_t_debug_frame *) SCM_CELL_WORD_2 (x))
 #define SCM_SETJBDFRAME(x, v)    (SCM_SET_CELL_WORD_2 ((x), (scm_t_bits) (v)))
@@ -79,7 +82,7 @@ make_jmpbuf (void)
 {
   SCM answer;
   SCM_NEWSMOB2 (answer, tc16_jmpbuffer, 0, 0);
-  SETJBJMPBUF(answer, (jmp_buf *)0);
+  SETJBJMPBUF(answer, (scm_i_jmp_buf *)0);
   DEACTIVATEJB(answer);
   return answer;
 }
@@ -89,7 +92,7 @@ make_jmpbuf (void)
 
 struct jmp_buf_and_retval	/* use only on the stack, in scm_catch */
 {
-  jmp_buf buf;			/* must be first */
+  scm_i_jmp_buf buf;		/* must be first */
   SCM throw_tag;
   SCM retval;
 };
@@ -169,8 +172,17 @@ scm_c_catch (SCM tag,
   struct jmp_buf_and_retval jbr;
   SCM jmpbuf;
   SCM answer;
+  SCM vm;
+  SCM *sp = NULL, *fp = NULL; /* to reset the vm */
   struct pre_unwind_data pre_unwind;
 
+  vm = scm_the_vm ();
+  if (SCM_NFALSEP (vm))
+    {
+      sp = SCM_VM_DATA (vm)->sp;
+      fp = SCM_VM_DATA (vm)->fp;
+    }
+
   jmpbuf = make_jmpbuf ();
   answer = SCM_EOL;
   scm_i_set_dynwinds (scm_acons (tag, jmpbuf, scm_i_dynwinds ()));
@@ -183,7 +195,7 @@ scm_c_catch (SCM tag,
   pre_unwind.lazy_catch_p = 0;
   SCM_SETJBPREUNWIND(jmpbuf, &pre_unwind);
 
-  if (setjmp (jbr.buf))
+  if (SCM_I_SETJMP (jbr.buf))
     {
       SCM throw_tag;
       SCM throw_args;
@@ -199,6 +211,30 @@ scm_c_catch (SCM tag,
       throw_tag = jbr.throw_tag;
       jbr.throw_tag = SCM_EOL;
       jbr.retval = SCM_EOL;
+      if (SCM_NFALSEP (vm))
+        {
+          SCM_VM_DATA (vm)->sp = sp;
+          SCM_VM_DATA (vm)->fp = fp;
+#ifdef VM_ENABLE_STACK_NULLING
+          /* see vm.c -- you'll have to enable this manually */
+          memset (sp + 1, 0,
+                  (SCM_VM_DATA (vm)->stack_size
+                   - (sp + 1 - SCM_VM_DATA (vm)->stack_base)) * sizeof(SCM));
+#endif
+        }
+      else if (SCM_NFALSEP ((vm = scm_the_vm ())))
+        {
+          /* oof, it's possible this catch was called before the vm was
+             booted... yick. anyway, try to reset the vm stack. */
+          SCM_VM_DATA (vm)->sp = SCM_VM_DATA (vm)->stack_base - 1;
+          SCM_VM_DATA (vm)->fp = NULL;
+#ifdef VM_ENABLE_STACK_NULLING
+          /* see vm.c -- you'll have to enable this manually */
+          memset (SCM_VM_DATA (vm)->stack_base, 0,
+                  SCM_VM_DATA (vm)->stack_size * sizeof(SCM));
+#endif
+        }
+          
       answer = handler (handler_data, throw_tag, throw_args);
     }
   else
@@ -709,8 +745,12 @@ scm_ithrow (SCM key, SCM args, int noreturn SCM_UNUSED)
        */
       fprintf (stderr, "throw from within critical section.\n");
       if (scm_is_symbol (key))
-	fprintf (stderr, "error key: %s\n", scm_i_symbol_chars (key));
-
+	{
+	  if (scm_i_is_narrow_symbol (key))
+	    fprintf (stderr, "error key: %s\n", scm_i_symbol_chars (key));
+	  else
+	    ulc_fprintf (stderr, "error key: %llU\n", scm_i_symbol_wide_chars (key));
+	}
       
       for (; scm_is_pair (s); s = scm_cdr (s), i++)
 	{
@@ -849,7 +889,7 @@ scm_ithrow (SCM key, SCM args, int noreturn SCM_UNUSED)
       jbr->throw_tag = key;
       jbr->retval = args;
       scm_i_set_last_debug_frame (SCM_JBDFRAME (jmpbuf));
-      longjmp (*JBJMPBUF (jmpbuf), 1);
+      SCM_I_LONGJMP (*JBJMPBUF (jmpbuf), 1);
     }
 
   /* Otherwise, it's some random piece of junk.  */
diff --git a/libguile/throw.h b/libguile/throw.h
index 3cd557285..1ed6ba6b1 100644
--- a/libguile/throw.h
+++ b/libguile/throw.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,1998,2000, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/unidata_to_charset.pl b/libguile/unidata_to_charset.pl
new file mode 100755
index 000000000..6871e67ee
--- /dev/null
+++ b/libguile/unidata_to_charset.pl
@@ -0,0 +1,399 @@
+#!/usr/bin/perl
+# unidata_to_charset.pl --- Compute SRFI-14 charsets from UnicodeData.txt
+#
+# Copyright (C) 2009 Free Software Foundation, Inc.
+# 
+# This library is free software; you can redistribute it and/or
+# modify it under the terms of the GNU Lesser General Public
+# License as published by the Free Software Foundation; either
+# version 3 of the License, or (at your option) any later version.
+# 
+# This library is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# Lesser General Public License for more details.
+# 
+# You should have received a copy of the GNU Lesser General Public
+# License along with this library; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+open(my $in,  "<",  "UnicodeData.txt")  or die "Can't open UnicodeData.txt: $!";           
+open(my $out, ">",  "srfi-14.i.c") or die "Can't open srfi-14.i.c: $!";
+
+# For Unicode, we follow Java's specification: a character is
+# lowercase if
+#    * it is not in the range [U+2000,U+2FFF], and
+#    * the Unicode attribute table does not give a lowercase mapping
+#      for it, and
+#    * at least one of the following is true:
+#          o the Unicode attribute table gives a mapping to uppercase
+#            for the character, or
+#          o the name for the character in the Unicode attribute table
+#            contains the words "SMALL LETTER" or "SMALL LIGATURE".
+
+sub lower_case {
+    my($codepoint, $name, $category, $uppercase, $lowercase)= @_;
+    if (($codepoint < 0x2000 || $codepoint > 0x2FFF)
+        && (!defined($lowercase) || $lowercase eq "")
+        && ((defined($uppercase) && $uppercase ne "")
+            || ($name =~ /(SMALL LETTER|SMALL LIGATURE)/))) {
+        return 1;
+    } else {
+        return 0;
+    }
+}
+
+# For Unicode, we follow Java's specification: a character is
+# uppercase if
+#    * it is not in the range [U+2000,U+2FFF], and
+#    * the Unicode attribute table does not give an uppercase mapping
+#      for it (this excludes titlecase characters), and
+#    * at least one of the following is true:
+#          o the Unicode attribute table gives a mapping to lowercase
+#            for the character, or
+#          o the name for the character in the Unicode attribute table
+#            contains the words "CAPITAL LETTER" or "CAPITAL LIGATURE".
+
+sub upper_case {
+    my($codepoint, $name, $category, $uppercase, $lowercase)= @_;
+    if (($codepoint < 0x2000 || $codepoint > 0x2FFF)
+        && (!defined($uppercase) || $uppercase eq "")
+        && ((defined($lowercase) && $lowercase ne "")
+            || ($name =~ /(CAPITAL LETTER|CAPITAL LIGATURE)/))) {
+        return 1;
+    } else {
+        return 0;
+    }
+}
+
+# A character is titlecase if it has the category Lt in the character
+# attribute database.
+
+sub title_case {
+    my($codepoint, $name, $category, $uppercase, $lowercase)= @_;
+    if (defined($category) && $category eq "Lt") {
+        return 1;
+    } else {
+        return 0;
+    }
+}
+
+# A letter is any character with one of the letter categories (Lu, Ll,
+# Lt, Lm, Lo) in the Unicode character database.
+
+sub letter {
+    my($codepoint, $name, $category, $uppercase, $lowercase)= @_;
+    if (defined($category) && ($category eq "Lu"
+                               || $category eq "Ll"
+                               || $category eq "Lt"
+                               || $category eq "Lm"
+                               || $category eq "Lo")) {
+        return 1;
+    } else {
+        return 0;
+    }
+}
+
+# A character is a digit if it has the category Nd in the character
+# attribute database. In Latin-1 and ASCII, the only such characters
+# are 0123456789. In Unicode, there are other digit characters in
+# other code blocks, such as Gujarati digits and Tibetan digits.
+
+sub digit {
+    my($codepoint, $name, $category, $uppercase, $lowercase)= @_;
+    if (defined($category) && $category eq "Nd") {
+        return 1;
+    } else {
+        return 0;
+    }
+}
+
+# The only hex digits are 0123456789abcdefABCDEF. 
+
+sub hex_digit {
+    my($codepoint, $name, $category, $uppercase, $lowercase)= @_;
+    if (($codepoint >= 0x30 && $codepoint <= 0x39)
+        || ($codepoint >= 0x41 && $codepoint <= 0x46)
+        || ($codepoint >= 0x61 && $codepoint <= 0x66)) {
+        return 1;
+    } else {
+        return 0;
+    }
+}
+
+# The union of char-set:letter and char-set:digit.
+
+sub letter_plus_digit {
+    my($codepoint, $name, $category, $uppercase, $lowercase)= @_;
+    if (letter($codepoint, $name, $category, $uppercase, $lowercase)
+        || digit($codepoint, $name, $category, $uppercase, $lowercase)) {
+        return 1;
+    } else {
+        return 0;
+    }
+}
+
+# Characters that would 'use ink' when printed
+sub graphic {
+    my($codepoint, $name, $category, $uppercase, $lowercase)= @_;
+    if ($category =~ (/L|M|N|P|S/)) {
+        return 1;
+    } else {
+        return 0;
+    }
+}
+
+# A whitespace character is either
+#    * a character with one of the space, line, or paragraph separator
+#      categories (Zs, Zl or Zp) of the Unicode character database.
+#    * U+0009 Horizontal tabulation (\t control-I)
+#    * U+000A Line feed (\n control-J)
+#    * U+000B Vertical tabulation (\v control-K)
+#    * U+000C Form feed (\f control-L)
+#    * U+000D Carriage return (\r control-M)
+
+sub whitespace {
+    my($codepoint, $name, $category, $uppercase, $lowercase)= @_;
+    if ($category =~ (/Zs|Zl|Zp/)
+        || $codepoint == 0x9
+        || $codepoint == 0xA 
+        || $codepoint == 0xB 
+        || $codepoint == 0xC 
+        || $codepoint == 0xD) { 
+        return 1;
+    } else {
+        return 0;
+    }
+}
+
+# A printing character is one that would occupy space when printed,
+# i.e., a graphic character or a space character. char-set:printing is
+# the union of char-set:whitespace and char-set:graphic.
+
+sub printing {
+    my($codepoint, $name, $category, $uppercase, $lowercase)= @_;
+    if (whitespace($codepoint, $name, $category, $uppercase, $lowercase)
+        || graphic($codepoint, $name, $category, $uppercase, $lowercase)) {
+        return 1;
+    } else {
+        return 0;
+    }
+}
+
+# The ISO control characters are the Unicode/Latin-1 characters in the
+# ranges [U+0000,U+001F] and [U+007F,U+009F].
+
+sub iso_control {
+    my($codepoint, $name, $category, $uppercase, $lowercase)= @_;
+    if (($codepoint >= 0x00 && $codepoint <= 0x1F)
+        || ($codepoint >= 0x7F && $codepoint <= 0x9F)) {
+        return 1;
+    } else {
+        return 0;
+    }
+}
+
+# A punctuation character is any character that has one of the
+# punctuation categories in the Unicode character database (Pc, Pd,
+# Ps, Pe, Pi, Pf, or Po.)
+
+# Note that srfi-14 gives conflicting requirements!!  It claims that
+# only the Unicode punctuation is necessary, but, explicitly calls out
+# the soft hyphen character (U+00AD) as punctution.  Current versions
+# of Unicode consider U+00AD to be a formatting character, not
+# punctuation.
+
+sub punctuation {
+    my($codepoint, $name, $category, $uppercase, $lowercase)= @_;
+    if ($category =~ (/P/)) {
+        return 1;
+    } else {
+        return 0;
+    }
+}
+        
+# A symbol is any character that has one of the symbol categories in
+# the Unicode character database (Sm, Sc, Sk, or So).
+
+sub symbol {
+    my($codepoint, $name, $category, $uppercase, $lowercase)= @_;
+    if ($category =~ (/S/)) {
+        return 1;
+    } else {
+        return 0;
+    }
+}
+        
+# Blank chars are horizontal whitespace.  A blank character is either
+#    * a character with the space separator category (Zs) in the
+#      Unicode character database.
+#    * U+0009 Horizontal tabulation (\t control-I) 
+sub blank {
+    my($codepoint, $name, $category, $uppercase, $lowercase)= @_;
+    if ($category =~ (/Zs/)
+        || $codepoint == 0x9) { 
+        return 1;
+    } else {
+        return 0;
+    }
+}
+
+# ASCII
+sub ascii {
+    my($codepoint, $name, $category, $uppercase, $lowercase)= @_;
+    if ($codepoint <= 0x7F) {
+        return 1;
+    } else {
+        return 0;
+    }
+}
+
+# Empty
+sub empty {
+    my($codepoint, $name, $category, $uppercase, $lowercase)= @_;
+    return 0;
+}
+
+# Full -- All characters.  
+sub full {
+    my($codepoint, $name, $category, $uppercase, $lowercase)= @_;
+    return 1;
+}
+
+
+# The procedure generates the two C structures necessary to describe a
+# given category.
+sub compute {
+    my($f) = @_;
+    my $start = -1;
+    my $end = -1;
+    my $len = 0;
+    my @rstart = (-1);
+    my @rend = (-1);
+
+    seek($in, 0, 0) or die "Can't seek to beginning of file: $!";
+
+    print "$f\n";
+
+    while (<$in>) {
+        # Parse the 14 column, semicolon-delimited UnicodeData.txt
+        # file
+        chomp;
+        my(@fields) = split(/;/);
+
+        # The codepoint: an integer
+        my $codepoint = hex($fields[0]); 
+
+        # If this is a character range, the last character in this
+        # range
+        my $codepoint_end = $codepoint;  
+
+        # The name of the character
+        my $name = $fields[1];    
+
+        # A two-character category code, such as Ll (lower-case
+        # letter)
+        my $category = $fields[2];       
+
+        # The codepoint of the uppercase version of this char
+        my $uppercase = $fields[12];   
+
+        # The codepoint of the lowercase version of this char
+        my $lowercase = $fields[13];    
+
+        my $pass = &$f($codepoint,$name,$category,$uppercase,$lowercase);
+        if ($pass == 1) {
+
+            # Some pairs of lines in UnicodeData.txt delimit ranges of
+            # characters.
+            if ($name =~ /First/) {
+                $line = <$in>;
+                die $! if $!;
+                $codepoint_end = hex( (split(/;/, $line))[0] );
+            }                 
+
+            # Compute ranges of characters [start:end] that meet the
+            # criteria.  Store the ranges.
+            if ($start == -1) {
+                $start = $codepoint;
+                $end = $codepoint_end;
+            } elsif ($end + 1 == $codepoint) {
+                $end = $codepoint_end;
+            } else {
+                $rstart[$len] = $start;
+                $rend[$len] = $end;
+                $len++;
+                $start = $codepoint;
+                $end = $codepoint_end;
+            }
+        }
+    }
+
+    # Extra logic to ensure that the last range is included
+    if ($start != -1) {
+        if ($len > 0 && $rstart[@rstart-1] != $start) {
+            $rstart[$len] = $start;
+            $rend[$len] = $end;
+            $len++;
+        } elsif ($len == 0) {
+            $rstart[0] = $start;
+            $rend[0] = $end;
+        }
+    }
+
+    # Print the C struct that contains the range list.
+    print $out "scm_t_char_range cs_" . $f . "_ranges[] = {\n";
+    if ($rstart[0] != -1) {
+        for (my $i=0; $i<@rstart-1; $i++) {
+            printf $out "  {0x%04x, 0x%04x},\n", $rstart[$i], $rend[$i];
+        }
+        printf $out "  {0x%04x, 0x%04x}\n", $rstart[@rstart-1], $rend[@rstart-1];
+    }
+    print $out "};\n\n";
+
+    # Print the C struct that contains the range list length and
+    # pointer to the range list.
+    print $out "scm_t_char_set cs_${f} = {\n";
+    print $out "  $len,\n";
+    print $out "  cs_" . $f . "_ranges\n";
+    print $out "};\n\n";
+}
+
+# Write a bit of a header
+print $out "/* srfi-14.i.c -- standard SRFI-14 character set data */\n\n";
+print $out "/* This file is #include'd by srfi-14.c.  */\n\n";
+print $out "/* This file was generated from\n"
+print $out "   http://unicode.org/Public/UNIDATA/UnicodeData.txt\n";
+print $out "   with the unidata_to_charset.pl script.  */\n\n";
+
+# Write the C structs for each SRFI-14 charset
+compute "lower_case";
+compute "upper_case";
+compute "title_case";
+compute "letter";
+compute "digit";
+compute "hex_digit";
+compute "letter_plus_digit";
+compute "graphic";
+compute "whitespace";
+compute "printing";
+compute "iso_control";
+compute "punctuation";
+compute "symbol";
+compute "blank";
+compute "ascii";
+compute "empty";
+compute "full";
+
+close $in;
+close $out;
+
+exec ('indent srfi-14.i.c') or print STDERR "call to 'indent' failed: $!";
+
+# And we're done.
+
+
+
+
+
+
diff --git a/libguile/unif.c b/libguile/unif.c
deleted file mode 100644
index ecf96dfec..000000000
--- a/libguile/unif.c
+++ /dev/null
@@ -1,2929 +0,0 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
- */
-
-
-/*
-  This file has code for arrays in lots of variants (double, integer,
-  unsigned etc. ). It suffers from hugely repetitive code because
-  there is similar (but different) code for every variant included. (urg.)
-
-  --hwn
-*/
-
-
-#ifdef HAVE_CONFIG_H
-#  include <config.h>
-#endif
-
-#include <stdio.h>
-#include <errno.h>
-#include <string.h>
-
-#include "libguile/_scm.h"
-#include "libguile/__scm.h"
-#include "libguile/eq.h"
-#include "libguile/chars.h"
-#include "libguile/eval.h"
-#include "libguile/fports.h"
-#include "libguile/smob.h"
-#include "libguile/feature.h"
-#include "libguile/root.h"
-#include "libguile/strings.h"
-#include "libguile/srfi-13.h"
-#include "libguile/srfi-4.h"
-#include "libguile/vectors.h"
-#include "libguile/list.h"
-#include "libguile/deprecation.h"
-#include "libguile/dynwind.h"
-
-#include "libguile/validate.h"
-#include "libguile/unif.h"
-#include "libguile/ramap.h"
-#include "libguile/print.h"
-#include "libguile/read.h"
-
-#ifdef HAVE_UNISTD_H
-#include <unistd.h>
-#endif
-
-#ifdef HAVE_IO_H
-#include <io.h>
-#endif
-
-
-/* The set of uniform scm_vector types is:
- *  Vector of:		 Called:   Replaced by:
- * unsigned char	string
- * char			byvect     s8 or u8, depending on signedness of 'char'
- * boolean		bvect      
- * signed long		ivect      s32
- * unsigned long	uvect      u32
- * float		fvect      f32
- * double		dvect      d32
- * complex double	cvect      c64
- * short		svect      s16
- * long long		llvect     s64
- */
-
-scm_t_bits scm_i_tc16_array;
-scm_t_bits scm_i_tc16_enclosed_array;
-
-#define SCM_SET_ARRAY_CONTIGUOUS_FLAG(x) \
-  (SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) | SCM_I_ARRAY_FLAG_CONTIGUOUS))
-#define SCM_CLR_ARRAY_CONTIGUOUS_FLAG(x) \
-  (SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) & ~SCM_I_ARRAY_FLAG_CONTIGUOUS))
-
-typedef SCM creator_proc (SCM len, SCM fill);
-
-struct {
-  char *type_name;
-  SCM type;
-  creator_proc *creator;
-} type_creator_table[] = {
-  { "a", SCM_UNSPECIFIED, scm_make_string },
-  { "b", SCM_UNSPECIFIED, scm_make_bitvector },
-  { "u8", SCM_UNSPECIFIED, scm_make_u8vector },
-  { "s8", SCM_UNSPECIFIED, scm_make_s8vector },
-  { "u16", SCM_UNSPECIFIED, scm_make_u16vector },
-  { "s16", SCM_UNSPECIFIED, scm_make_s16vector },
-  { "u32", SCM_UNSPECIFIED, scm_make_u32vector },
-  { "s32", SCM_UNSPECIFIED, scm_make_s32vector },
-  { "u64", SCM_UNSPECIFIED, scm_make_u64vector },
-  { "s64", SCM_UNSPECIFIED, scm_make_s64vector },
-  { "f32", SCM_UNSPECIFIED, scm_make_f32vector },
-  { "f64", SCM_UNSPECIFIED, scm_make_f64vector },
-  { "c32", SCM_UNSPECIFIED, scm_make_c32vector },
-  { "c64", SCM_UNSPECIFIED, scm_make_c64vector },
-  { NULL }
-};
-
-static void
-init_type_creator_table ()
-{
-  int i;
-  for (i = 0; type_creator_table[i].type_name; i++)
-    {
-      SCM sym = scm_from_locale_symbol (type_creator_table[i].type_name);
-      type_creator_table[i].type = scm_permanent_object (sym);
-    }
-}
-
-static creator_proc *
-type_to_creator (SCM type)
-{
-  int i;
-
-  if (scm_is_eq (type, SCM_BOOL_T))
-    return scm_make_vector;
-  for (i = 0; type_creator_table[i].type_name; i++)
-    if (scm_is_eq (type, type_creator_table[i].type))
-      return type_creator_table[i].creator;
-
-  scm_misc_error (NULL, "unknown array type: ~a", scm_list_1 (type));
-}
-
-static SCM
-make_typed_vector (SCM type, size_t len)
-{
-  creator_proc *creator = type_to_creator (type);
-  return creator (scm_from_size_t (len), SCM_UNDEFINED);
-}
-
-#if SCM_ENABLE_DEPRECATED
-
-SCM_SYMBOL (scm_sym_s, "s");
-SCM_SYMBOL (scm_sym_l, "l");
-
-static int
-singp (SCM obj)
-{
-  if (!SCM_REALP (obj))
-    return 0;
-  else
-    {
-      double x = SCM_REAL_VALUE (obj);
-      float fx = x;
-      return (- SCM_FLTMAX < x) && (x < SCM_FLTMAX) && (fx == x);
-    }
-}
-
-SCM_API int scm_i_inump (SCM obj);
-SCM_API scm_t_signed_bits scm_i_inum (SCM obj);
-
-static SCM
-prototype_to_type (SCM proto)
-{
-  const char *type_name;
-
-  if (scm_is_eq (proto, SCM_BOOL_T))
-    type_name = "b";
-  else if (scm_is_eq (proto, SCM_MAKE_CHAR (0)))
-    type_name = "s8";
-  else if (SCM_CHARP (proto))
-    type_name = "a";
-  else if (scm_i_inump (proto))
-    {
-      if (scm_i_inum (proto) > 0)
-	type_name = "u32";
-      else
-	type_name = "s32";
-    }
-  else if (scm_is_eq (proto, scm_sym_s))
-    type_name = "s16";
-  else if (scm_is_eq (proto, scm_sym_l))
-    type_name = "s64";
-  else if (SCM_REALP (proto)
-	   || scm_is_true (scm_eqv_p (proto,
-				      scm_divide (scm_from_int (1),
-						  scm_from_int (3)))))
-    {
-      if (singp (proto))
-	type_name = "f32";
-      else
-	type_name = "f64";
-    }
-  else if (SCM_COMPLEXP (proto))
-    type_name = "c64";
-  else if (scm_is_null (proto))
-    type_name = NULL;
-  else
-    type_name = NULL;
-
-  if (type_name)
-    return scm_from_locale_symbol (type_name);
-  else
-    return SCM_BOOL_T;
-}
-
-static SCM
-scm_i_get_old_prototype (SCM uvec)
-{
-  if (scm_is_bitvector (uvec))
-    return SCM_BOOL_T;
-  else if (scm_is_string (uvec))
-    return SCM_MAKE_CHAR ('a');
-  else if (scm_is_true (scm_s8vector_p (uvec)))
-    return SCM_MAKE_CHAR ('\0');
-  else if (scm_is_true (scm_s16vector_p (uvec)))
-    return scm_sym_s;
-  else if (scm_is_true (scm_u32vector_p (uvec)))
-    return scm_from_int (1);
-  else if (scm_is_true (scm_s32vector_p (uvec)))
-    return scm_from_int (-1);
-  else if (scm_is_true (scm_s64vector_p (uvec)))
-    return scm_sym_l;
-  else if (scm_is_true (scm_f32vector_p (uvec)))
-    return scm_from_double (1.0);
-  else if (scm_is_true (scm_f64vector_p (uvec)))
-    return scm_divide (scm_from_int (1), scm_from_int (3));
-  else if (scm_is_true (scm_c64vector_p (uvec)))
-    return scm_c_make_rectangular (0, 1);
-  else if (scm_is_vector (uvec))
-    return SCM_EOL;
-  else
-    scm_misc_error (NULL, "~a has no prototype", scm_list_1 (uvec));
-}
-
-SCM
-scm_make_uve (long k, SCM prot)
-#define FUNC_NAME "scm_make_uve"
-{
-  scm_c_issue_deprecation_warning
-    ("`scm_make_uve' is deprecated, see the manual for alternatives.");
-
-  return make_typed_vector (prototype_to_type (prot), k);
-}
-#undef FUNC_NAME
-
-#endif
-
-int
-scm_is_array (SCM obj)
-{
-  return (SCM_I_ENCLOSED_ARRAYP (obj)
-	  || SCM_I_ARRAYP (obj)
-	  || scm_is_generalized_vector (obj));
-}
-
-int
-scm_is_typed_array (SCM obj, SCM type)
-{
-  if (SCM_I_ENCLOSED_ARRAYP (obj))
-    {
-      /* Enclosed arrays are arrays but are not of any type.
-      */
-      return 0;
-    }
-
-  /* Get storage vector. 
-   */
-  if (SCM_I_ARRAYP (obj))
-    obj = SCM_I_ARRAY_V (obj);
-
-  /* It must be a generalized vector (which includes vectors, strings, etc).
-   */
-  if (!scm_is_generalized_vector (obj))
-    return 0;
-
-  return scm_is_eq (type, scm_i_generalized_vector_type (obj));
-}
-
-static SCM
-enclosed_ref (scm_t_array_handle *h, ssize_t pos)
-{
-  return scm_i_cvref (SCM_I_ARRAY_V (h->array), pos + h->base, 1);
-}
-
-static SCM
-vector_ref (scm_t_array_handle *h, ssize_t pos)
-{
-  return ((const SCM *)h->elements)[pos];
-}
-
-static SCM
-string_ref (scm_t_array_handle *h, ssize_t pos)
-{
-  pos += h->base;
-  if (SCM_I_ARRAYP (h->array))
-    return scm_c_string_ref (SCM_I_ARRAY_V (h->array), pos);
-  else
-    return scm_c_string_ref (h->array, pos);
-}
-
-static SCM
-bitvector_ref (scm_t_array_handle *h, ssize_t pos)
-{
-  pos += scm_array_handle_bit_elements_offset (h);
-  return
-    scm_from_bool (((scm_t_uint32 *)h->elements)[pos/32] & (1l << (pos % 32)));
-}
-
-static SCM
-memoize_ref (scm_t_array_handle *h, ssize_t pos)
-{
-  SCM v = h->array;
-
-  if (SCM_I_ENCLOSED_ARRAYP (v))
-    {
-      h->ref = enclosed_ref;
-      return enclosed_ref (h, pos);
-    }
-
-  if (SCM_I_ARRAYP (v))
-    v = SCM_I_ARRAY_V (v);
-
-  if (scm_is_vector (v))
-    {
-      h->elements = scm_array_handle_elements (h);
-      h->ref = vector_ref;
-    }
-  else if (scm_is_uniform_vector (v))
-    {
-      h->elements = scm_array_handle_uniform_elements (h);
-      h->ref = scm_i_uniform_vector_ref_proc (v);
-    }
-  else if (scm_is_string (v))
-    {
-      h->ref = string_ref;
-    }
-  else if (scm_is_bitvector (v))
-    {
-      h->elements = scm_array_handle_bit_elements (h);
-      h->ref = bitvector_ref;
-    }
-  else
-    scm_misc_error (NULL, "unknown array type: ~a", scm_list_1 (h->array));
-
-  return h->ref (h, pos);
-}
-
-static void
-enclosed_set (scm_t_array_handle *h, ssize_t pos, SCM val)
-{
-  scm_wrong_type_arg_msg (NULL, 0, h->array, "non-enclosed array");
-}
-
-static void
-vector_set (scm_t_array_handle *h, ssize_t pos, SCM val)
-{
-  ((SCM *)h->writable_elements)[pos] = val;
-}
-
-static void
-string_set (scm_t_array_handle *h, ssize_t pos, SCM val)
-{
-  pos += h->base;
-  if (SCM_I_ARRAYP (h->array))
-    scm_c_string_set_x (SCM_I_ARRAY_V (h->array), pos, val);
-  else
-    scm_c_string_set_x (h->array, pos, val);
-}
-
-static void
-bitvector_set (scm_t_array_handle *h, ssize_t pos, SCM val)
-{
-  scm_t_uint32 mask;
-  pos += scm_array_handle_bit_elements_offset (h);
-  mask = 1l << (pos % 32);
-  if (scm_to_bool (val))
-    ((scm_t_uint32 *)h->writable_elements)[pos/32] |= mask;
-  else
-    ((scm_t_uint32 *)h->writable_elements)[pos/32] &= ~mask;
-}
-
-static void
-memoize_set (scm_t_array_handle *h, ssize_t pos, SCM val)
-{
-  SCM v = h->array;
-
-  if (SCM_I_ENCLOSED_ARRAYP (v))
-    {
-      h->set = enclosed_set;
-      enclosed_set (h, pos, val);
-      return;
-    }
-
-  if (SCM_I_ARRAYP (v))
-    v = SCM_I_ARRAY_V (v);
-
-  if (scm_is_vector (v))
-    {
-      h->writable_elements = scm_array_handle_writable_elements (h);
-      h->set = vector_set;
-    }
-  else if (scm_is_uniform_vector (v))
-    {
-      h->writable_elements = scm_array_handle_uniform_writable_elements (h);
-      h->set = scm_i_uniform_vector_set_proc (v);
-    }
-  else if (scm_is_string (v))
-    {
-      h->set = string_set;
-    }
-  else if (scm_is_bitvector (v))
-    {
-      h->writable_elements = scm_array_handle_bit_writable_elements (h);
-      h->set = bitvector_set;
-    }
-  else
-    scm_misc_error (NULL, "unknown array type: ~a", scm_list_1 (h->array));
-
-  h->set (h, pos, val);
-}
-
-void
-scm_array_get_handle (SCM array, scm_t_array_handle *h)
-{
-  h->array = array;
-  h->ref = memoize_ref;
-  h->set = memoize_set;
-
-  if (SCM_I_ARRAYP (array) || SCM_I_ENCLOSED_ARRAYP (array))
-    {
-      h->dims = SCM_I_ARRAY_DIMS (array);
-      h->base = SCM_I_ARRAY_BASE (array);
-    }
-  else if (scm_is_generalized_vector (array))
-    {
-      h->dim0.lbnd = 0;
-      h->dim0.ubnd = scm_c_generalized_vector_length (array) - 1;
-      h->dim0.inc = 1;
-      h->dims = &h->dim0;
-      h->base = 0;
-    }
-  else
-    scm_wrong_type_arg_msg (NULL, 0, array, "array");
-}
-
-void
-scm_array_handle_release (scm_t_array_handle *h)
-{
-  /* Nothing to do here until arrays need to be reserved for real.
-   */
-}
-
-size_t
-scm_array_handle_rank (scm_t_array_handle *h)
-{
-  if (SCM_I_ARRAYP (h->array) || SCM_I_ENCLOSED_ARRAYP (h->array))
-    return SCM_I_ARRAY_NDIM (h->array);
-  else
-    return 1;
-}
-
-scm_t_array_dim *
-scm_array_handle_dims (scm_t_array_handle *h)
-{
-  return h->dims;
-}
-
-const SCM *
-scm_array_handle_elements (scm_t_array_handle *h)
-{
-  SCM vec = h->array;
-  if (SCM_I_ARRAYP (vec))
-    vec = SCM_I_ARRAY_V (vec);
-  if (SCM_I_IS_VECTOR (vec))
-    return SCM_I_VECTOR_ELTS (vec) + h->base;
-  scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array");
-}
-
-SCM *
-scm_array_handle_writable_elements (scm_t_array_handle *h)
-{
-  SCM vec = h->array;
-  if (SCM_I_ARRAYP (vec))
-    vec = SCM_I_ARRAY_V (vec);
-  if (SCM_I_IS_VECTOR (vec))
-    return SCM_I_VECTOR_WELTS (vec) + h->base;
-  scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array");
-}
-
-#if SCM_ENABLE_DEPRECATED
-
-SCM_DEFINE (scm_array_p, "array?", 1, 1, 0,
-           (SCM obj, SCM prot),
-	    "Return @code{#t} if the @var{obj} is an array, and @code{#f} if\n"
-	    "not.")
-#define FUNC_NAME s_scm_array_p
-{
-  if (!SCM_UNBNDP (prot))
-    {
-      scm_c_issue_deprecation_warning
-	("Using prototypes with `array?' is deprecated."
-	 "  Use `typed-array?' instead.");
-
-      return scm_typed_array_p (obj, prototype_to_type (prot));
-    }
-  else
-    return scm_from_bool (scm_is_array (obj));
-}
-#undef FUNC_NAME
-
-#else /* !SCM_ENABLE_DEPRECATED */
-
-/* We keep the old 2-argument C prototype for a while although the old
-   PROT argument is always ignored now.  C code should probably use
-   scm_is_array or scm_is_typed_array anyway.
-*/
-
-static SCM scm_i_array_p (SCM obj);
-
-SCM_DEFINE (scm_i_array_p, "array?", 1, 0, 0,
-           (SCM obj),
-	    "Return @code{#t} if the @var{obj} is an array, and @code{#f} if\n"
-	    "not.")
-#define FUNC_NAME s_scm_i_array_p
-{
-  return scm_from_bool (scm_is_array (obj));
-}
-#undef FUNC_NAME
-
-SCM
-scm_array_p (SCM obj, SCM prot)
-{
-  return scm_from_bool (scm_is_array (obj));
-}
-
-#endif /* !SCM_ENABLE_DEPRECATED */
-
-
-SCM_DEFINE (scm_typed_array_p, "typed-array?", 2, 0, 0,
-           (SCM obj, SCM type),
-	    "Return @code{#t} if the @var{obj} is an array of type\n"
-	    "@var{type}, and @code{#f} if not.")
-#define FUNC_NAME s_scm_typed_array_p
-{
-  return scm_from_bool (scm_is_typed_array (obj, type));
-}
-#undef FUNC_NAME
-
-size_t
-scm_c_array_rank (SCM array)
-{
-  scm_t_array_handle handle;
-  size_t res;
-
-  scm_array_get_handle (array, &handle);
-  res = scm_array_handle_rank (&handle);
-  scm_array_handle_release (&handle);
-  return res;
-}
-
-SCM_DEFINE (scm_array_rank, "array-rank", 1, 0, 0, 
-           (SCM array),
-	    "Return the number of dimensions of the array @var{array.}\n")
-#define FUNC_NAME s_scm_array_rank
-{
-  return scm_from_size_t (scm_c_array_rank (array));
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_array_dimensions, "array-dimensions", 1, 0, 0, 
-           (SCM ra),
-	    "@code{array-dimensions} is similar to @code{array-shape} but replaces\n"
-	    "elements with a @code{0} minimum with one greater than the maximum. So:\n"
-	    "@lisp\n"
-	    "(array-dimensions (make-array 'foo '(-1 3) 5)) @result{} ((-1 3) 5)\n"
-	    "@end lisp")
-#define FUNC_NAME s_scm_array_dimensions
-{
-  scm_t_array_handle handle;
-  scm_t_array_dim *s;
-  SCM res = SCM_EOL;
-  size_t k;
-      
-  scm_array_get_handle (ra, &handle);
-  s = scm_array_handle_dims (&handle);
-  k = scm_array_handle_rank (&handle);
-
-  while (k--)
-    res = scm_cons (s[k].lbnd
-		    ? scm_cons2 (scm_from_ssize_t (s[k].lbnd),
-				 scm_from_ssize_t (s[k].ubnd),
-				 SCM_EOL)
-		    : scm_from_ssize_t (1 + s[k].ubnd),
-		    res);
-
-  scm_array_handle_release (&handle);
-  return res;
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_shared_array_root, "shared-array-root", 1, 0, 0, 
-           (SCM ra),
-	    "Return the root vector of a shared array.")
-#define FUNC_NAME s_scm_shared_array_root
-{
-  if (SCM_I_ARRAYP (ra) || SCM_I_ENCLOSED_ARRAYP (ra))
-    return SCM_I_ARRAY_V (ra);
-  else if (scm_is_generalized_vector (ra))
-    return ra;
-  scm_wrong_type_arg_msg (NULL, 0, ra, "array");
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_shared_array_offset, "shared-array-offset", 1, 0, 0, 
-           (SCM ra),
-	    "Return the root vector index of the first element in the array.")
-#define FUNC_NAME s_scm_shared_array_offset
-{
-  scm_t_array_handle handle;
-  SCM res;
-
-  scm_array_get_handle (ra, &handle);
-  res = scm_from_size_t (handle.base);
-  scm_array_handle_release (&handle);
-  return res;
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_shared_array_increments, "shared-array-increments", 1, 0, 0, 
-           (SCM ra),
-	    "For each dimension, return the distance between elements in the root vector.")
-#define FUNC_NAME s_scm_shared_array_increments
-{
-  scm_t_array_handle handle;
-  SCM res = SCM_EOL;
-  size_t k;
-  scm_t_array_dim *s;
-
-  scm_array_get_handle (ra, &handle);
-  k = scm_array_handle_rank (&handle);
-  s = scm_array_handle_dims (&handle);
-  while (k--)
-    res = scm_cons (scm_from_ssize_t (s[k].inc), res);
-  scm_array_handle_release (&handle);
-  return res;
-}
-#undef FUNC_NAME
-
-ssize_t
-scm_array_handle_pos (scm_t_array_handle *h, SCM indices)
-{
-  scm_t_array_dim *s = scm_array_handle_dims (h);
-  ssize_t pos = 0, i;
-  size_t k = scm_array_handle_rank (h);
-  
-  while (k > 0 && scm_is_pair (indices))
-    {
-      i = scm_to_signed_integer (SCM_CAR (indices), s->lbnd, s->ubnd);
-      pos += (i - s->lbnd) * s->inc;
-      k--;
-      s++;
-      indices = SCM_CDR (indices);
-    }
-  if (k > 0 || !scm_is_null (indices))
-    scm_misc_error (NULL, "wrong number of indices, expecting ~a",
-		    scm_list_1 (scm_from_size_t (scm_array_handle_rank (h))));
-  return pos;
-}
-
-SCM 
-scm_i_make_ra (int ndim, int enclosed)
-{
-  scm_t_bits tag = enclosed? scm_i_tc16_enclosed_array : scm_i_tc16_array;
-  SCM ra;
-  SCM_NEWSMOB(ra, ((scm_t_bits) ndim << 17) + tag,
-              scm_gc_malloc ((sizeof (scm_i_t_array) +
-			      ndim * sizeof (scm_t_array_dim)),
-			     "array"));
-  SCM_I_ARRAY_V (ra) = SCM_BOOL_F;
-  return ra;
-}
-
-static char s_bad_spec[] = "Bad scm_array dimension";
-
-
-/* Increments will still need to be set. */
-
-static SCM 
-scm_i_shap2ra (SCM args)
-{
-  scm_t_array_dim *s;
-  SCM ra, spec, sp;
-  int ndim = scm_ilength (args);
-  if (ndim < 0)
-    scm_misc_error (NULL, s_bad_spec, SCM_EOL);
-
-  ra = scm_i_make_ra (ndim, 0);
-  SCM_I_ARRAY_BASE (ra) = 0;
-  s = SCM_I_ARRAY_DIMS (ra);
-  for (; !scm_is_null (args); s++, args = SCM_CDR (args))
-    {
-      spec = SCM_CAR (args);
-      if (scm_is_integer (spec))
-	{
-	  if (scm_to_long (spec) < 0)
-	    scm_misc_error (NULL, s_bad_spec, SCM_EOL);
-	  s->lbnd = 0;
-	  s->ubnd = scm_to_long (spec) - 1;
-	  s->inc = 1;
-	}
-      else
-	{
-	  if (!scm_is_pair (spec) || !scm_is_integer (SCM_CAR (spec)))
-	    scm_misc_error (NULL, s_bad_spec, SCM_EOL);
-	  s->lbnd = scm_to_long (SCM_CAR (spec));
-	  sp = SCM_CDR (spec);
-	  if (!scm_is_pair (sp) 
-	      || !scm_is_integer (SCM_CAR (sp))
-	      || !scm_is_null (SCM_CDR (sp)))
-	    scm_misc_error (NULL, s_bad_spec, SCM_EOL);
-	  s->ubnd = scm_to_long (SCM_CAR (sp));
-	  s->inc = 1;
-	}
-    }
-  return ra;
-}
-
-SCM_DEFINE (scm_make_typed_array, "make-typed-array", 2, 0, 1,
-	    (SCM type, SCM fill, SCM bounds),
-	    "Create and return an array of type @var{type}.")
-#define FUNC_NAME s_scm_make_typed_array
-{
-  size_t k, rlen = 1;
-  scm_t_array_dim *s;
-  creator_proc *creator;
-  SCM ra;
-  
-  creator = type_to_creator (type);
-  ra = scm_i_shap2ra (bounds);
-  SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
-  s = SCM_I_ARRAY_DIMS (ra);
-  k = SCM_I_ARRAY_NDIM (ra);
-
-  while (k--)
-    {
-      s[k].inc = rlen;
-      SCM_ASSERT_RANGE (1, bounds, s[k].lbnd <= s[k].ubnd + 1);
-      rlen = (s[k].ubnd - s[k].lbnd + 1) * s[k].inc;
-    }
-
-  if (scm_is_eq (fill, SCM_UNSPECIFIED))
-    fill = SCM_UNDEFINED;
-
-  SCM_I_ARRAY_V (ra) = creator (scm_from_size_t (rlen), fill);
-
-  if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
-    if (s->ubnd < s->lbnd || (0 == s->lbnd && 1 == s->inc))
-      return SCM_I_ARRAY_V (ra);
-  return ra;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_make_array, "make-array", 1, 0, 1,
-	    (SCM fill, SCM bounds),
-	    "Create and return an array.")
-#define FUNC_NAME s_scm_make_array
-{
-  return scm_make_typed_array (SCM_BOOL_T, fill, bounds);
-}
-#undef FUNC_NAME
-
-#if SCM_ENABLE_DEPRECATED
-
-SCM_DEFINE (scm_dimensions_to_uniform_array, "dimensions->uniform-array", 2, 1, 0,
-	    (SCM dims, SCM prot, SCM fill),
-	    "@deffnx {Scheme Procedure} make-uniform-vector length prototype [fill]\n"
-	    "Create and return a uniform array or vector of type\n"
-	    "corresponding to @var{prototype} with dimensions @var{dims} or\n"
-	    "length @var{length}.  If @var{fill} is supplied, it's used to\n"
-	    "fill the array, otherwise @var{prototype} is used.")
-#define FUNC_NAME s_scm_dimensions_to_uniform_array
-{
-  scm_c_issue_deprecation_warning
-    ("`dimensions->uniform-array' is deprecated.  "
-     "Use `make-typed-array' instead.");
-
-  if (scm_is_integer (dims))
-    dims = scm_list_1 (dims);
-
-  if (SCM_UNBNDP (fill))
-    {
-      /* Using #\nul as the prototype yields a s8 array, but numeric
-	 arrays can't store characters, so we have to special case this.
-      */
-      if (scm_is_eq (prot, SCM_MAKE_CHAR (0)))
-	fill = scm_from_int (0);
-      else
-	fill = prot;
-    }
-
-  return scm_make_typed_array (prototype_to_type (prot), fill, dims);
-}
-#undef FUNC_NAME
-
-#endif
-
-static void 
-scm_i_ra_set_contp (SCM ra)
-{
-  size_t k = SCM_I_ARRAY_NDIM (ra);
-  if (k)
-    {
-      long inc = SCM_I_ARRAY_DIMS (ra)[k - 1].inc;
-      while (k--)
-	{
-	  if (inc != SCM_I_ARRAY_DIMS (ra)[k].inc)
-	    {
-	      SCM_CLR_ARRAY_CONTIGUOUS_FLAG (ra);
-	      return;
-	    }
-	  inc *= (SCM_I_ARRAY_DIMS (ra)[k].ubnd 
-		  - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1);
-	}
-    }
-  SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
-}
-
-
-SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
-           (SCM oldra, SCM mapfunc, SCM dims),
-	    "@code{make-shared-array} can be used to create shared subarrays of other\n"
-	    "arrays.  The @var{mapper} is a function that translates coordinates in\n"
-	    "the new array into coordinates in the old array.  A @var{mapper} must be\n"
-	    "linear, and its range must stay within the bounds of the old array, but\n"
-	    "it can be otherwise arbitrary.  A simple example:\n"
-	    "@lisp\n"
-	    "(define fred (make-array #f 8 8))\n"
-	    "(define freds-diagonal\n"
-	    "  (make-shared-array fred (lambda (i) (list i i)) 8))\n"
-	    "(array-set! freds-diagonal 'foo 3)\n"
-	    "(array-ref fred 3 3) @result{} foo\n"
-	    "(define freds-center\n"
-	    "  (make-shared-array fred (lambda (i j) (list (+ 3 i) (+ 3 j))) 2 2))\n"
-	    "(array-ref freds-center 0 0) @result{} foo\n"
-	    "@end lisp")
-#define FUNC_NAME s_scm_make_shared_array
-{
-  scm_t_array_handle old_handle;
-  SCM ra;
-  SCM inds, indptr;
-  SCM imap;
-  size_t k;
-  ssize_t i;
-  long old_base, old_min, new_min, old_max, new_max;
-  scm_t_array_dim *s;
-
-  SCM_VALIDATE_REST_ARGUMENT (dims);
-  SCM_VALIDATE_PROC (2, mapfunc);
-  ra = scm_i_shap2ra (dims);
-
-  scm_array_get_handle (oldra, &old_handle);
-
-  if (SCM_I_ARRAYP (oldra))
-    {
-      SCM_I_ARRAY_V (ra) = SCM_I_ARRAY_V (oldra);
-      old_base = old_min = old_max = SCM_I_ARRAY_BASE (oldra);
-      s = scm_array_handle_dims (&old_handle);
-      k = scm_array_handle_rank (&old_handle);
-      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_I_ARRAY_V (ra) = oldra;
-      old_base = old_min = 0;
-      old_max = scm_c_generalized_vector_length (oldra) - 1;
-    }
-
-  inds = SCM_EOL;
-  s = SCM_I_ARRAY_DIMS (ra);
-  for (k = 0; k < SCM_I_ARRAY_NDIM (ra); k++)
-    {
-      inds = scm_cons (scm_from_long (s[k].lbnd), inds);
-      if (s[k].ubnd < s[k].lbnd)
-	{
-	  if (1 == SCM_I_ARRAY_NDIM (ra))
-	    ra = make_typed_vector (scm_array_type (ra), 0);
-	  else
-	    SCM_I_ARRAY_V (ra) = make_typed_vector (scm_array_type (ra), 0);
-	  scm_array_handle_release (&old_handle);
-	  return ra;
-	}
-    }
-
-  imap = scm_apply_0 (mapfunc, scm_reverse (inds));
-  i = scm_array_handle_pos (&old_handle, imap);
-  SCM_I_ARRAY_BASE (ra) = new_min = new_max = i + old_base;
-  indptr = inds;
-  k = SCM_I_ARRAY_NDIM (ra);
-  while (k--)
-    {
-      if (s[k].ubnd > s[k].lbnd)
-	{
-	  SCM_SETCAR (indptr, scm_sum (SCM_CAR (indptr), scm_from_int (1)));
-	  imap = scm_apply_0 (mapfunc, scm_reverse (inds));
-	  s[k].inc = scm_array_handle_pos (&old_handle, 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_array_handle_release (&old_handle);
-
-  if (old_min > new_min || old_max < new_max)
-    SCM_MISC_ERROR ("mapping out of range", SCM_EOL);
-  if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
-    {
-      SCM v = SCM_I_ARRAY_V (ra);
-      size_t length = scm_c_generalized_vector_length (v);
-      if (1 == s->inc && 0 == s->lbnd && length == 1 + s->ubnd)
-	return v;
-      if (s->ubnd < s->lbnd)
-	return make_typed_vector (scm_array_type (ra), 0);
-    }
-  scm_i_ra_set_contp (ra);
-  return ra;
-}
-#undef FUNC_NAME
-
-
-/* args are RA . DIMS */
-SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1, 
-           (SCM ra, SCM args),
-	    "Return an array sharing contents with @var{array}, but with\n"
-	    "dimensions arranged in a different order.  There must be one\n"
-	    "@var{dim} argument for each dimension of @var{array}.\n"
-	    "@var{dim0}, @var{dim1}, @dots{} should be integers between 0\n"
-	    "and the rank of the array to be returned.  Each integer in that\n"
-	    "range must appear at least once in the argument list.\n"
-	    "\n"
-	    "The values of @var{dim0}, @var{dim1}, @dots{} correspond to\n"
-	    "dimensions in the array to be returned, their positions in the\n"
-	    "argument list to dimensions of @var{array}.  Several @var{dim}s\n"
-	    "may have the same value, in which case the returned array will\n"
-	    "have smaller rank than @var{array}.\n"
-	    "\n"
-	    "@lisp\n"
-	    "(transpose-array '#2((a b) (c d)) 1 0) @result{} #2((a c) (b d))\n"
-	    "(transpose-array '#2((a b) (c d)) 0 0) @result{} #1(a d)\n"
-	    "(transpose-array '#3(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1 1 0) @result{}\n"
-	    "                #2((a 4) (b 5) (c 6))\n"
-	    "@end lisp")
-#define FUNC_NAME s_scm_transpose_array
-{
-  SCM res, vargs;
-  scm_t_array_dim *s, *r;
-  int ndim, i, k;
-
-  SCM_VALIDATE_REST_ARGUMENT (args);
-  SCM_ASSERT (SCM_NIMP (ra), ra, SCM_ARG1, FUNC_NAME);
-
-  if (scm_is_generalized_vector (ra))
-    {
-      /* Make sure that we are called with a single zero as
-	 arguments. 
-      */
-      if (scm_is_null (args) || !scm_is_null (SCM_CDR (args)))
-	SCM_WRONG_NUM_ARGS ();
-      SCM_VALIDATE_INT_COPY (SCM_ARG2, SCM_CAR (args), i);
-      SCM_ASSERT_RANGE (SCM_ARG2, SCM_CAR (args), i == 0);
-      return ra;
-    }
-
-  if (SCM_I_ARRAYP (ra) || SCM_I_ENCLOSED_ARRAYP (ra))
-    {
-      vargs = scm_vector (args);
-      if (SCM_SIMPLE_VECTOR_LENGTH (vargs) != SCM_I_ARRAY_NDIM (ra))
-	SCM_WRONG_NUM_ARGS ();
-      ndim = 0;
-      for (k = 0; k < SCM_I_ARRAY_NDIM (ra); k++)
-	{
-	  i = scm_to_signed_integer (SCM_SIMPLE_VECTOR_REF (vargs, k),
-				     0, SCM_I_ARRAY_NDIM(ra));
-	  if (ndim < i)
-	    ndim = i;
-	}
-      ndim++;
-      res = scm_i_make_ra (ndim, 0);
-      SCM_I_ARRAY_V (res) = SCM_I_ARRAY_V (ra);
-      SCM_I_ARRAY_BASE (res) = SCM_I_ARRAY_BASE (ra);
-      for (k = ndim; k--;)
-	{
-	  SCM_I_ARRAY_DIMS (res)[k].lbnd = 0;
-	  SCM_I_ARRAY_DIMS (res)[k].ubnd = -1;
-	}
-      for (k = SCM_I_ARRAY_NDIM (ra); k--;)
-	{
-	  i = scm_to_int (SCM_SIMPLE_VECTOR_REF (vargs, k));
-	  s = &(SCM_I_ARRAY_DIMS (ra)[k]);
-	  r = &(SCM_I_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_I_ARRAY_BASE (res) += (s->lbnd - r->lbnd) * r->inc;
-		  r->lbnd = s->lbnd;
-		}
-	      r->inc += s->inc;
-	    }
-	}
-      if (ndim > 0)
-	SCM_MISC_ERROR ("bad argument list", SCM_EOL);
-      scm_i_ra_set_contp (res);
-      return res;
-    }
-
-  scm_wrong_type_arg_msg (NULL, 0, ra, "array");
-}
-#undef FUNC_NAME
-
-/* args are RA . AXES */
-SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1, 
-           (SCM ra, SCM axes),
-	    "@var{dim0}, @var{dim1} @dots{} should be nonnegative integers less than\n"
-	    "the rank of @var{array}.  @var{enclose-array} returns an array\n"
-	    "resembling an array of shared arrays.  The dimensions of each shared\n"
-	    "array are the same as the @var{dim}th dimensions of the original array,\n"
-	    "the dimensions of the outer array are the same as those of the original\n"
-	    "array that did not match a @var{dim}.\n\n"
-	    "An enclosed array is not a general Scheme array.  Its elements may not\n"
-	    "be set using @code{array-set!}.  Two references to the same element of\n"
-	    "an enclosed array will be @code{equal?} but will not in general be\n"
-	    "@code{eq?}.  The value returned by @var{array-prototype} when given an\n"
-	    "enclosed array is unspecified.\n\n"
-	    "examples:\n"
-	    "@lisp\n"
-	    "(enclose-array '#3(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1) @result{}\n"
-	    "   #<enclosed-array (#1(a d) #1(b e) #1(c f)) (#1(1 4) #1(2 5) #1(3 6))>\n\n"
-	    "(enclose-array '#3(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1 0) @result{}\n"
-	    "   #<enclosed-array #2((a 1) (d 4)) #2((b 2) (e 5)) #2((c 3) (f 6))>\n"
-	    "@end lisp")
-#define FUNC_NAME s_scm_enclose_array
-{
-  SCM axv, res, ra_inr;
-  const char *c_axv;
-  scm_t_array_dim vdim, *s = &vdim;
-  int ndim, j, k, ninr, noutr;
-
-  SCM_VALIDATE_REST_ARGUMENT (axes);
-  if (scm_is_null (axes))
-    axes = scm_cons ((SCM_I_ARRAYP (ra) ? scm_from_size_t (SCM_I_ARRAY_NDIM (ra) - 1) : SCM_INUM0), SCM_EOL);
-  ninr = scm_ilength (axes);
-  if (ninr < 0)
-    SCM_WRONG_NUM_ARGS ();
-  ra_inr = scm_i_make_ra (ninr, 0);
-
-  if (scm_is_generalized_vector (ra))
-    {
-      s->lbnd = 0;
-      s->ubnd = scm_c_generalized_vector_length (ra) - 1;
-      s->inc = 1;
-      SCM_I_ARRAY_V (ra_inr) = ra;
-      SCM_I_ARRAY_BASE (ra_inr) = 0;
-      ndim = 1;
-    }
-  else if (SCM_I_ARRAYP (ra))
-    {
-      s = SCM_I_ARRAY_DIMS (ra);
-      SCM_I_ARRAY_V (ra_inr) = SCM_I_ARRAY_V (ra);
-      SCM_I_ARRAY_BASE (ra_inr) = SCM_I_ARRAY_BASE (ra);
-      ndim = SCM_I_ARRAY_NDIM (ra);
-    }
-  else
-    scm_wrong_type_arg_msg (NULL, 0, ra, "array");
-
-  noutr = ndim - ninr;
-  if (noutr < 0)
-    SCM_WRONG_NUM_ARGS ();
-  axv = scm_make_string (scm_from_int (ndim), SCM_MAKE_CHAR (0));
-  res = scm_i_make_ra (noutr, 1);
-  SCM_I_ARRAY_BASE (res) = SCM_I_ARRAY_BASE (ra_inr);
-  SCM_I_ARRAY_V (res) = ra_inr;
-  for (k = 0; k < ninr; k++, axes = SCM_CDR (axes))
-    {
-      if (!scm_is_integer (SCM_CAR (axes)))
-	SCM_MISC_ERROR ("bad axis", SCM_EOL);
-      j = scm_to_int (SCM_CAR (axes));
-      SCM_I_ARRAY_DIMS (ra_inr)[k].lbnd = s[j].lbnd;
-      SCM_I_ARRAY_DIMS (ra_inr)[k].ubnd = s[j].ubnd;
-      SCM_I_ARRAY_DIMS (ra_inr)[k].inc = s[j].inc;
-      scm_c_string_set_x (axv, j, SCM_MAKE_CHAR (1));
-    }
-  c_axv = scm_i_string_chars (axv);
-  for (j = 0, k = 0; k < noutr; k++, j++)
-    {
-      while (c_axv[j])
-	j++;
-      SCM_I_ARRAY_DIMS (res)[k].lbnd = s[j].lbnd;
-      SCM_I_ARRAY_DIMS (res)[k].ubnd = s[j].ubnd;
-      SCM_I_ARRAY_DIMS (res)[k].inc = s[j].inc;
-    }
-  scm_remember_upto_here_1 (axv);
-  scm_i_ra_set_contp (ra_inr);
-  scm_i_ra_set_contp (res);
-  return res;
-}
-#undef FUNC_NAME
-
-
-
-SCM_DEFINE (scm_array_in_bounds_p, "array-in-bounds?", 1, 0, 1, 
-           (SCM v, SCM args),
-	    "Return @code{#t} if its arguments would be acceptable to\n"
-	    "@code{array-ref}.")
-#define FUNC_NAME s_scm_array_in_bounds_p
-{
-  SCM res = SCM_BOOL_T;
-
-  SCM_VALIDATE_REST_ARGUMENT (args);
-
-  if (SCM_I_ARRAYP (v) || SCM_I_ENCLOSED_ARRAYP (v))
-    {
-      size_t k, ndim = SCM_I_ARRAY_NDIM (v);
-      scm_t_array_dim *s = SCM_I_ARRAY_DIMS (v);
-
-      for (k = 0; k < ndim; k++)
-	{
-	  long ind;
-
-	  if (!scm_is_pair (args))
-	    SCM_WRONG_NUM_ARGS ();
-	  ind = scm_to_long (SCM_CAR (args));
-	  args = SCM_CDR (args);
-
-	  if (ind < s[k].lbnd || ind > s[k].ubnd)
-	    {
-	      res = SCM_BOOL_F;
-	      /* We do not stop the checking after finding a violation
-		 since we want to validate the type-correctness and
-		 number of arguments in any case.
-	      */
-	    }
-	}
-    }
-  else if (scm_is_generalized_vector (v))
-    {
-      /* Since real arrays have been covered above, all generalized
-	 vectors are guaranteed to be zero-origin here.
-      */
-
-      long ind;
-
-      if (!scm_is_pair (args))
-	SCM_WRONG_NUM_ARGS ();
-      ind = scm_to_long (SCM_CAR (args));
-      args = SCM_CDR (args);
-      res = scm_from_bool (ind >= 0
-			   && ind < scm_c_generalized_vector_length (v));
-    }
-  else
-    scm_wrong_type_arg_msg (NULL, 0, v, "array");
-
-  if (!scm_is_null (args))
-    SCM_WRONG_NUM_ARGS ();
-
-  return res;
-}
-#undef FUNC_NAME
-
-SCM 
-scm_i_cvref (SCM v, size_t pos, int enclosed)
-{
-  if (enclosed)
-    {
-      int k = SCM_I_ARRAY_NDIM (v);
-      SCM res = scm_i_make_ra (k, 0);
-      SCM_I_ARRAY_V (res) = SCM_I_ARRAY_V (v);
-      SCM_I_ARRAY_BASE (res) = pos;
-      while (k--)
-	{
-	  SCM_I_ARRAY_DIMS (res)[k].ubnd = SCM_I_ARRAY_DIMS (v)[k].ubnd;
-	  SCM_I_ARRAY_DIMS (res)[k].lbnd = SCM_I_ARRAY_DIMS (v)[k].lbnd;
-	  SCM_I_ARRAY_DIMS (res)[k].inc = SCM_I_ARRAY_DIMS (v)[k].inc;
-	}
-      return res;
-    }
-  else
-    return scm_c_generalized_vector_ref (v, pos);
-}
-
-SCM_DEFINE (scm_array_ref, "array-ref", 1, 0, 1,
-           (SCM v, SCM args),
-	    "Return the element at the @code{(index1, index2)} element in\n"
-	    "@var{array}.")
-#define FUNC_NAME s_scm_array_ref
-{
-  scm_t_array_handle handle;
-  SCM res;
-
-  scm_array_get_handle (v, &handle);
-  res = scm_array_handle_ref (&handle, scm_array_handle_pos (&handle, args));
-  scm_array_handle_release (&handle);
-  return res;
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1, 
-           (SCM v, SCM obj, SCM args),
-	    "Set the element at the @code{(index1, index2)} element in @var{array} to\n"
-	    "@var{new-value}.  The value returned by array-set! is unspecified.")
-#define FUNC_NAME s_scm_array_set_x           
-{
-  scm_t_array_handle handle;
-
-  scm_array_get_handle (v, &handle);
-  scm_array_handle_set (&handle, scm_array_handle_pos (&handle, args), obj);
-  scm_array_handle_release (&handle);
-  return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-/* attempts to unroll an array into a one-dimensional array.
-   returns the unrolled array or #f if it can't be done.  */
-  /* if strict is not SCM_UNDEFINED, return #f if returned array
-		     wouldn't have contiguous elements.  */
-SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0,
-           (SCM ra, SCM strict),
-	    "If @var{array} may be @dfn{unrolled} into a one dimensional shared array\n"
-	    "without changing their order (last subscript changing fastest), then\n"
-	    "@code{array-contents} returns that shared array, otherwise it returns\n"
-	    "@code{#f}.  All arrays made by @var{make-array} and\n"
-	    "@var{make-uniform-array} may be unrolled, some arrays made by\n"
-	    "@var{make-shared-array} may not be.\n\n"
-	    "If the optional argument @var{strict} is provided, a shared array will\n"
-	    "be returned only if its elements are stored internally contiguous in\n"
-	    "memory.")
-#define FUNC_NAME s_scm_array_contents
-{
-  SCM sra;
-
-  if (scm_is_generalized_vector (ra))
-    return ra;
-
-  if (SCM_I_ARRAYP (ra))
-    {
-      size_t k, ndim = SCM_I_ARRAY_NDIM (ra), len = 1;
-      if (!SCM_I_ARRAYP (ra) || !SCM_I_ARRAY_CONTP (ra))
-	return SCM_BOOL_F;
-      for (k = 0; k < ndim; k++)
-	len *= SCM_I_ARRAY_DIMS (ra)[k].ubnd - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1;
-      if (!SCM_UNBNDP (strict))
-	{
-	  if (ndim && (1 != SCM_I_ARRAY_DIMS (ra)[ndim - 1].inc))
-	    return SCM_BOOL_F;
-	  if (scm_is_bitvector (SCM_I_ARRAY_V (ra)))
-	    {
-	      if (len != scm_c_bitvector_length (SCM_I_ARRAY_V (ra)) ||
-		  SCM_I_ARRAY_BASE (ra) % SCM_LONG_BIT ||
-		  len % SCM_LONG_BIT)
-		return SCM_BOOL_F;
-	    }
-	}
-      
-      {
-	SCM v = SCM_I_ARRAY_V (ra);
-	size_t length = scm_c_generalized_vector_length (v);
-	if ((len == length) && 0 == SCM_I_ARRAY_BASE (ra) && SCM_I_ARRAY_DIMS (ra)->inc)
-	  return v;
-      }
-      
-      sra = scm_i_make_ra (1, 0);
-      SCM_I_ARRAY_DIMS (sra)->lbnd = 0;
-      SCM_I_ARRAY_DIMS (sra)->ubnd = len - 1;
-      SCM_I_ARRAY_V (sra) = SCM_I_ARRAY_V (ra);
-      SCM_I_ARRAY_BASE (sra) = SCM_I_ARRAY_BASE (ra);
-      SCM_I_ARRAY_DIMS (sra)->inc = (ndim ? SCM_I_ARRAY_DIMS (ra)[ndim - 1].inc : 1);
-      return sra;
-    }
-  else if (SCM_I_ENCLOSED_ARRAYP (ra))
-    scm_wrong_type_arg_msg (NULL, 0, ra, "non-enclosed array");
-  else
-    scm_wrong_type_arg_msg (NULL, 0, ra, "array");
-}
-#undef FUNC_NAME
-
-
-SCM 
-scm_ra2contig (SCM ra, int copy)
-{
-  SCM ret;
-  long inc = 1;
-  size_t k, len = 1;
-  for (k = SCM_I_ARRAY_NDIM (ra); k--;)
-    len *= SCM_I_ARRAY_DIMS (ra)[k].ubnd - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1;
-  k = SCM_I_ARRAY_NDIM (ra);
-  if (SCM_I_ARRAY_CONTP (ra) && ((0 == k) || (1 == SCM_I_ARRAY_DIMS (ra)[k - 1].inc)))
-    {
-      if (!scm_is_bitvector (SCM_I_ARRAY_V (ra)))
-	return ra;
-      if ((len == scm_c_bitvector_length (SCM_I_ARRAY_V (ra)) &&
-	   0 == SCM_I_ARRAY_BASE (ra) % SCM_LONG_BIT &&
-	   0 == len % SCM_LONG_BIT))
-	return ra;
-    }
-  ret = scm_i_make_ra (k, 0);
-  SCM_I_ARRAY_BASE (ret) = 0;
-  while (k--)
-    {
-      SCM_I_ARRAY_DIMS (ret)[k].lbnd = SCM_I_ARRAY_DIMS (ra)[k].lbnd;
-      SCM_I_ARRAY_DIMS (ret)[k].ubnd = SCM_I_ARRAY_DIMS (ra)[k].ubnd;
-      SCM_I_ARRAY_DIMS (ret)[k].inc = inc;
-      inc *= SCM_I_ARRAY_DIMS (ra)[k].ubnd - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1;
-    }
-  SCM_I_ARRAY_V (ret) = make_typed_vector (scm_array_type (ra), inc);
-  if (copy)
-    scm_array_copy_x (ra, ret);
-  return ret;
-}
-
-
-
-SCM_DEFINE (scm_uniform_array_read_x, "uniform-array-read!", 1, 3, 0,
-           (SCM ura, SCM port_or_fd, SCM start, SCM end),
-	    "@deffnx {Scheme Procedure} uniform-vector-read! uve [port-or-fdes] [start] [end]\n"
-	    "Attempt to read all elements of @var{ura}, in lexicographic order, as\n"
-	    "binary objects from @var{port-or-fdes}.\n"
-	    "If an end of file is encountered,\n"
-	    "the objects up to that point are put into @var{ura}\n"
-	    "(starting at the beginning) and the remainder of the array is\n"
-	    "unchanged.\n\n"
-	    "The optional arguments @var{start} and @var{end} allow\n"
-	    "a specified region of a vector (or linearized array) to be read,\n"
-	    "leaving the remainder of the vector unchanged.\n\n"
-	    "@code{uniform-array-read!} returns the number of objects read.\n"
-	    "@var{port-or-fdes} may be omitted, in which case it defaults to the value\n"
-	    "returned by @code{(current-input-port)}.")
-#define FUNC_NAME s_scm_uniform_array_read_x
-{
-  if (SCM_UNBNDP (port_or_fd))
-    port_or_fd = scm_current_input_port ();
-
-  if (scm_is_uniform_vector (ura))
-    {
-      return scm_uniform_vector_read_x (ura, port_or_fd, start, end);
-    }
-  else if (SCM_I_ARRAYP (ura))
-    {
-      size_t base, vlen, cstart, cend;
-      SCM cra, ans;
-      
-      cra = scm_ra2contig (ura, 0);
-      base = SCM_I_ARRAY_BASE (cra);
-      vlen = SCM_I_ARRAY_DIMS (cra)->inc *
-	(SCM_I_ARRAY_DIMS (cra)->ubnd - SCM_I_ARRAY_DIMS (cra)->lbnd + 1);
-
-      cstart = 0;
-      cend = vlen;
-      if (!SCM_UNBNDP (start))
-	{
-	  cstart = scm_to_unsigned_integer (start, 0, vlen);
-	  if (!SCM_UNBNDP (end))
-	    cend = scm_to_unsigned_integer (end, cstart, vlen);
-	}
-
-      ans = scm_uniform_vector_read_x (SCM_I_ARRAY_V (cra), port_or_fd,
-				       scm_from_size_t (base + cstart),
-				       scm_from_size_t (base + cend));
-
-      if (!scm_is_eq (cra, ura))
-	scm_array_copy_x (cra, ura);
-      return ans;
-    }
-  else if (SCM_I_ENCLOSED_ARRAYP (ura))
-    scm_wrong_type_arg_msg (NULL, 0, ura, "non-enclosed array");    
-  else
-    scm_wrong_type_arg_msg (NULL, 0, ura, "array");
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_uniform_array_write, "uniform-array-write", 1, 3, 0,
-           (SCM ura, SCM port_or_fd, SCM start, SCM end),
-	    "Writes all elements of @var{ura} as binary objects to\n"
-	    "@var{port-or-fdes}.\n\n"
-	    "The optional arguments @var{start}\n"
-	    "and @var{end} allow\n"
-	    "a specified region of a vector (or linearized array) to be written.\n\n"
-	    "The number of objects actually written is returned.\n"
-	    "@var{port-or-fdes} may be\n"
-	    "omitted, in which case it defaults to the value returned by\n"
-	    "@code{(current-output-port)}.")
-#define FUNC_NAME s_scm_uniform_array_write
-{
-  if (SCM_UNBNDP (port_or_fd))
-    port_or_fd = scm_current_output_port ();
-
-  if (scm_is_uniform_vector (ura))
-    {
-      return scm_uniform_vector_write (ura, port_or_fd, start, end);
-    }
-  else if (SCM_I_ARRAYP (ura))
-    {
-      size_t base, vlen, cstart, cend;
-      SCM cra, ans;
-      
-      cra = scm_ra2contig (ura, 1);
-      base = SCM_I_ARRAY_BASE (cra);
-      vlen = SCM_I_ARRAY_DIMS (cra)->inc *
-	(SCM_I_ARRAY_DIMS (cra)->ubnd - SCM_I_ARRAY_DIMS (cra)->lbnd + 1);
-
-      cstart = 0;
-      cend = vlen;
-      if (!SCM_UNBNDP (start))
-	{
-	  cstart = scm_to_unsigned_integer (start, 0, vlen);
-	  if (!SCM_UNBNDP (end))
-	    cend = scm_to_unsigned_integer (end, cstart, vlen);
-	}
-
-      ans = scm_uniform_vector_write (SCM_I_ARRAY_V (cra), port_or_fd,
-				      scm_from_size_t (base + cstart),
-				      scm_from_size_t (base + cend));
-
-      return ans;
-    }
-  else if (SCM_I_ENCLOSED_ARRAYP (ura))
-    scm_wrong_type_arg_msg (NULL, 0, ura, "non-enclosed array");    
-  else
-    scm_wrong_type_arg_msg (NULL, 0, ura, "array");
-}
-#undef FUNC_NAME
-
-
-/** Bit vectors */
-
-static scm_t_bits scm_tc16_bitvector;
-
-#define IS_BITVECTOR(obj)       SCM_SMOB_PREDICATE(scm_tc16_bitvector,(obj))
-#define BITVECTOR_BITS(obj)     ((scm_t_uint32 *)SCM_SMOB_DATA(obj))
-#define BITVECTOR_LENGTH(obj)   ((size_t)SCM_SMOB_DATA_2(obj))
-
-
-static int
-bitvector_print (SCM vec, SCM port, scm_print_state *pstate)
-{
-  size_t bit_len = BITVECTOR_LENGTH (vec);
-  size_t word_len = (bit_len+31)/32;
-  scm_t_uint32 *bits = BITVECTOR_BITS (vec);
-  size_t i, j;
-
-  scm_puts ("#*", port);
-  for (i = 0; i < word_len; i++, bit_len -= 32)
-    {
-      scm_t_uint32 mask = 1;
-      for (j = 0; j < 32 && j < bit_len; j++, mask <<= 1)
-	scm_putc ((bits[i] & mask)? '1' : '0', port);
-    }
-    
-  return 1;
-}
-
-static SCM
-bitvector_equalp (SCM vec1, SCM vec2)
-{
-  size_t bit_len = BITVECTOR_LENGTH (vec1);
-  size_t word_len = (bit_len + 31) / 32;
-  scm_t_uint32 last_mask =  ((scm_t_uint32)-1) >> (32*word_len - bit_len);
-  scm_t_uint32 *bits1 = BITVECTOR_BITS (vec1);
-  scm_t_uint32 *bits2 = BITVECTOR_BITS (vec2);
-
-  /* compare lengths */
-  if (BITVECTOR_LENGTH (vec2) != bit_len)
-    return SCM_BOOL_F;
-  /* avoid underflow in word_len-1 below. */
-  if (bit_len == 0)
-    return SCM_BOOL_T;
-  /* compare full words */
-  if (memcmp (bits1, bits2, sizeof (scm_t_uint32) * (word_len-1)))
-    return SCM_BOOL_F;
-  /* compare partial last words */
-  if ((bits1[word_len-1] & last_mask) != (bits2[word_len-1] & last_mask))
-    return SCM_BOOL_F;
-  return SCM_BOOL_T;
-}
-
-int
-scm_is_bitvector (SCM vec)
-{
-  return IS_BITVECTOR (vec);
-}
-
-SCM_DEFINE (scm_bitvector_p, "bitvector?", 1, 0, 0,
-	    (SCM obj),
-	    "Return @code{#t} when @var{obj} is a bitvector, else\n"
-	    "return @code{#f}.")
-#define FUNC_NAME s_scm_bitvector_p
-{
-  return scm_from_bool (scm_is_bitvector (obj));
-}
-#undef FUNC_NAME
-
-SCM
-scm_c_make_bitvector (size_t len, SCM fill)
-{
-  size_t word_len = (len + 31) / 32;
-  scm_t_uint32 *bits;
-  SCM res;
-
-  bits = scm_gc_malloc (sizeof (scm_t_uint32) * word_len,
-			"bitvector");
-  SCM_NEWSMOB2 (res, scm_tc16_bitvector, bits, len);
-
-  if (!SCM_UNBNDP (fill))
-    scm_bitvector_fill_x (res, fill);
-      
-  return res;
-}
-
-SCM_DEFINE (scm_make_bitvector, "make-bitvector", 1, 1, 0,
-	    (SCM len, SCM fill),
-	    "Create a new bitvector of length @var{len} and\n"
-	    "optionally initialize all elements to @var{fill}.")
-#define FUNC_NAME s_scm_make_bitvector
-{
-  return scm_c_make_bitvector (scm_to_size_t (len), fill);
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_bitvector, "bitvector", 0, 0, 1,
-	    (SCM bits),
-	    "Create a new bitvector with the arguments as elements.")
-#define FUNC_NAME s_scm_bitvector
-{
-  return scm_list_to_bitvector (bits);
-}
-#undef FUNC_NAME
-
-size_t
-scm_c_bitvector_length (SCM vec)
-{
-  scm_assert_smob_type (scm_tc16_bitvector, vec);
-  return BITVECTOR_LENGTH (vec);
-}
-
-SCM_DEFINE (scm_bitvector_length, "bitvector-length", 1, 0, 0,
-	    (SCM vec),
-	    "Return the length of the bitvector @var{vec}.")
-#define FUNC_NAME s_scm_bitvector_length
-{
-  return scm_from_size_t (scm_c_bitvector_length (vec));
-}
-#undef FUNC_NAME
-
-const scm_t_uint32 *
-scm_array_handle_bit_elements (scm_t_array_handle *h)
-{
-  return scm_array_handle_bit_writable_elements (h);
-}
-
-scm_t_uint32 *
-scm_array_handle_bit_writable_elements (scm_t_array_handle *h)
-{
-  SCM vec = h->array;
-  if (SCM_I_ARRAYP (vec))
-    vec = SCM_I_ARRAY_V (vec);
-  if (IS_BITVECTOR (vec))
-    return BITVECTOR_BITS (vec) + h->base/32;
-  scm_wrong_type_arg_msg (NULL, 0, h->array, "bit array");
-}
-
-size_t
-scm_array_handle_bit_elements_offset (scm_t_array_handle *h)
-{
-  return h->base % 32;
-}
-
-const scm_t_uint32 *
-scm_bitvector_elements (SCM vec,
-			scm_t_array_handle *h,
-			size_t *offp,
-			size_t *lenp,
-			ssize_t *incp)
-{
-  return scm_bitvector_writable_elements (vec, h, offp, lenp, incp);
-}
-
-
-scm_t_uint32 *
-scm_bitvector_writable_elements (SCM vec,
-				 scm_t_array_handle *h,
-				 size_t *offp,
-				 size_t *lenp,
-				 ssize_t *incp)
-{
-  scm_generalized_vector_get_handle (vec, h);
-  if (offp)
-    {
-      scm_t_array_dim *dim = scm_array_handle_dims (h);
-      *offp = scm_array_handle_bit_elements_offset (h);
-      *lenp = dim->ubnd - dim->lbnd + 1;
-      *incp = dim->inc;
-    }
-  return scm_array_handle_bit_writable_elements (h);
-}
-
-SCM
-scm_c_bitvector_ref (SCM vec, size_t idx)
-{
-  scm_t_array_handle handle;
-  const scm_t_uint32 *bits;
-
-  if (IS_BITVECTOR (vec))
-    {
-      if (idx >= BITVECTOR_LENGTH (vec))
-	scm_out_of_range (NULL, scm_from_size_t (idx));
-      bits = BITVECTOR_BITS(vec);
-      return scm_from_bool (bits[idx/32] & (1L << (idx%32)));
-    }
-  else
-    {
-      SCM res;
-      size_t len, off;
-      ssize_t inc;
-  
-      bits = scm_bitvector_elements (vec, &handle, &off, &len, &inc);
-      if (idx >= len)
-	scm_out_of_range (NULL, scm_from_size_t (idx));
-      idx = idx*inc + off;
-      res = scm_from_bool (bits[idx/32] & (1L << (idx%32)));
-      scm_array_handle_release (&handle);
-      return res;
-    }
-}
-
-SCM_DEFINE (scm_bitvector_ref, "bitvector-ref", 2, 0, 0,
-	    (SCM vec, SCM idx),
-	    "Return the element at index @var{idx} of the bitvector\n"
-	    "@var{vec}.")
-#define FUNC_NAME s_scm_bitvector_ref
-{
-  return scm_c_bitvector_ref (vec, scm_to_size_t (idx));
-}
-#undef FUNC_NAME
-
-void
-scm_c_bitvector_set_x (SCM vec, size_t idx, SCM val)
-{
-  scm_t_array_handle handle;
-  scm_t_uint32 *bits, mask;
-
-  if (IS_BITVECTOR (vec))
-    {
-      if (idx >= BITVECTOR_LENGTH (vec))
-	scm_out_of_range (NULL, scm_from_size_t (idx));
-      bits = BITVECTOR_BITS(vec);
-    }
-  else
-    {
-      size_t len, off;
-      ssize_t inc;
-  
-      bits = scm_bitvector_writable_elements (vec, &handle, &off, &len, &inc);
-      if (idx >= len)
-	scm_out_of_range (NULL, scm_from_size_t (idx));
-      idx = idx*inc + off;
-    }
-
-  mask = 1L << (idx%32);
-  if (scm_is_true (val))
-    bits[idx/32] |= mask;
-  else
-    bits[idx/32] &= ~mask;
-
-  if (!IS_BITVECTOR (vec))
-      scm_array_handle_release (&handle);
-}
-
-SCM_DEFINE (scm_bitvector_set_x, "bitvector-set!", 3, 0, 0,
-	    (SCM vec, SCM idx, SCM val),
-	    "Set the element at index @var{idx} of the bitvector\n"
-	    "@var{vec} when @var{val} is true, else clear it.")
-#define FUNC_NAME s_scm_bitvector_set_x
-{
-  scm_c_bitvector_set_x (vec, scm_to_size_t (idx), val);
-  return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_bitvector_fill_x, "bitvector-fill!", 2, 0, 0,
-	    (SCM vec, SCM val),
-	    "Set all elements of the bitvector\n"
-	    "@var{vec} when @var{val} is true, else clear them.")
-#define FUNC_NAME s_scm_bitvector_fill_x
-{
-  scm_t_array_handle handle;
-  size_t off, len;
-  ssize_t inc;
-  scm_t_uint32 *bits;
-
-  bits = scm_bitvector_writable_elements (vec, &handle,
-					  &off, &len, &inc);
-
-  if (off == 0 && inc == 1 && len > 0)
-    {
-      /* the usual case
-       */
-      size_t word_len = (len + 31) / 32;
-      scm_t_uint32 last_mask =  ((scm_t_uint32)-1) >> (32*word_len - len);
-
-      if (scm_is_true (val))
-	{
-	  memset (bits, 0xFF, sizeof(scm_t_uint32)*(word_len-1));
-	  bits[word_len-1] |= last_mask;
-	}
-      else
-	{
-	  memset (bits, 0x00, sizeof(scm_t_uint32)*(word_len-1));
-	  bits[word_len-1] &= ~last_mask;
-	}
-    }
-  else
-    {
-      size_t i;
-      for (i = 0; i < len; i++)
-	scm_array_handle_set (&handle, i*inc, val);
-    }
-
-  scm_array_handle_release (&handle);
-
-  return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_list_to_bitvector, "list->bitvector", 1, 0, 0,
-	    (SCM list),
-	    "Return a new bitvector initialized with the elements\n"
-	    "of @var{list}.")
-#define FUNC_NAME s_scm_list_to_bitvector
-{
-  size_t bit_len = scm_to_size_t (scm_length (list));
-  SCM vec = scm_c_make_bitvector (bit_len, SCM_UNDEFINED);
-  size_t word_len = (bit_len+31)/32;
-  scm_t_array_handle handle;
-  scm_t_uint32 *bits = scm_bitvector_writable_elements (vec, &handle,
-							NULL, NULL, NULL);
-  size_t i, j;
-
-  for (i = 0; i < word_len && scm_is_pair (list); i++, bit_len -= 32)
-    {
-      scm_t_uint32 mask = 1;
-      bits[i] = 0;
-      for (j = 0; j < 32 && j < bit_len;
-	   j++, mask <<= 1, list = SCM_CDR (list))
-	if (scm_is_true (SCM_CAR (list)))
-	  bits[i] |= mask;
-    }
-
-  scm_array_handle_release (&handle);
-
-  return vec;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_bitvector_to_list, "bitvector->list", 1, 0, 0,
-	    (SCM vec),
-	    "Return a new list initialized with the elements\n"
-	    "of the bitvector @var{vec}.")
-#define FUNC_NAME s_scm_bitvector_to_list
-{
-  scm_t_array_handle handle;
-  size_t off, len;
-  ssize_t inc;
-  scm_t_uint32 *bits;
-  SCM res = SCM_EOL;
-
-  bits = scm_bitvector_writable_elements (vec, &handle,
-					  &off, &len, &inc);
-
-  if (off == 0 && inc == 1)
-    {
-      /* the usual case
-       */
-      size_t word_len = (len + 31) / 32;
-      size_t i, j;
-
-      for (i = 0; i < word_len; i++, len -= 32)
-	{
-	  scm_t_uint32 mask = 1;
-	  for (j = 0; j < 32 && j < len; j++, mask <<= 1)
-	    res = scm_cons ((bits[i] & mask)? SCM_BOOL_T : SCM_BOOL_F, res);
-	}
-    }
-  else
-    {
-      size_t i;
-      for (i = 0; i < len; i++)
-	res = scm_cons (scm_array_handle_ref (&handle, i*inc), res);
-    }
-
-  scm_array_handle_release (&handle);
-  
-  return scm_reverse_x (res, SCM_EOL);
-}
-#undef FUNC_NAME
-
-/* From mmix-arith.w by Knuth.
-
-  Here's a fun way to count the number of bits in a tetrabyte.
-
-  [This classical trick is called the ``Gillies--Miller method for
-  sideways addition'' in {\sl The Preparation of Programs for an
-  Electronic Digital Computer\/} by Wilkes, Wheeler, and Gill, second
-  edition (Reading, Mass.:\ Addison--Wesley, 1957), 191--193. Some of
-  the tricks used here were suggested by Balbir Singh, Peter
-  Rossmanith, and Stefan Schwoon.]
-*/
-
-static size_t
-count_ones (scm_t_uint32 x)
-{
-  x=x-((x>>1)&0x55555555);
-  x=(x&0x33333333)+((x>>2)&0x33333333);
-  x=(x+(x>>4))&0x0f0f0f0f;
-  x=x+(x>>8);
-  return (x+(x>>16)) & 0xff;
-}
-
-SCM_DEFINE (scm_bit_count, "bit-count", 2, 0, 0,
-	    (SCM b, SCM bitvector),
-	    "Return the number of occurrences of the boolean @var{b} in\n"
-	    "@var{bitvector}.")
-#define FUNC_NAME s_scm_bit_count
-{
-  scm_t_array_handle handle;
-  size_t off, len;
-  ssize_t inc;
-  scm_t_uint32 *bits;
-  int bit = scm_to_bool (b);
-  size_t count = 0;
-
-  bits = scm_bitvector_writable_elements (bitvector, &handle,
-					  &off, &len, &inc);
-
-  if (off == 0 && inc == 1 && len > 0)
-    {
-      /* the usual case
-       */
-      size_t word_len = (len + 31) / 32;
-      scm_t_uint32 last_mask =  ((scm_t_uint32)-1) >> (32*word_len - len);
-      size_t i;
-
-      for (i = 0; i < word_len-1; i++)
-	count += count_ones (bits[i]);
-      count += count_ones (bits[i] & last_mask);
-    }
-  else
-    {
-      size_t i;
-      for (i = 0; i < len; i++)
-	if (scm_is_true (scm_array_handle_ref (&handle, i*inc)))
-	  count++;
-    }
-  
-  scm_array_handle_release (&handle);
-
-  return scm_from_size_t (bit? count : len-count);
-}
-#undef FUNC_NAME
-
-/* returns 32 for x == 0. 
-*/
-static size_t
-find_first_one (scm_t_uint32 x)
-{
-  size_t pos = 0;
-  /* do a binary search in x. */
-  if ((x & 0xFFFF) == 0)
-    x >>= 16, pos += 16;
-  if ((x & 0xFF) == 0)
-    x >>= 8, pos += 8;
-  if ((x & 0xF) == 0)
-    x >>= 4, pos += 4;
-  if ((x & 0x3) == 0)
-    x >>= 2, pos += 2;
-  if ((x & 0x1) == 0)
-    pos += 1;
-  return pos;
-}
-
-SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0,
-           (SCM item, SCM v, SCM k),
-	    "Return the index of the first occurrance of @var{item} in bit\n"
-	    "vector @var{v}, starting from @var{k}.  If there is no\n"
-	    "@var{item} entry between @var{k} and the end of\n"
-	    "@var{bitvector}, then return @code{#f}.  For example,\n"
-	    "\n"
-	    "@example\n"
-	    "(bit-position #t #*000101 0)  @result{} 3\n"
-	    "(bit-position #f #*0001111 3) @result{} #f\n"
-	    "@end example")
-#define FUNC_NAME s_scm_bit_position
-{
-  scm_t_array_handle handle;
-  size_t off, len, first_bit;
-  ssize_t inc;
-  const scm_t_uint32 *bits;
-  int bit = scm_to_bool (item);
-  SCM res = SCM_BOOL_F;
-  
-  bits = scm_bitvector_elements (v, &handle, &off, &len, &inc);
-  first_bit = scm_to_unsigned_integer (k, 0, len);
-
-  if (off == 0 && inc == 1 && len > 0)
-    {
-      size_t i, word_len = (len + 31) / 32;
-      scm_t_uint32 last_mask =  ((scm_t_uint32)-1) >> (32*word_len - len);
-      size_t first_word = first_bit / 32;
-      scm_t_uint32 first_mask =
-	((scm_t_uint32)-1) << (first_bit - 32*first_word);
-      scm_t_uint32 w;
-      
-      for (i = first_word; i < word_len; i++)
-	{
-	  w = (bit? bits[i] : ~bits[i]);
-	  if (i == first_word)
-	    w &= first_mask;
-	  if (i == word_len-1)
-	    w &= last_mask;
-	  if (w)
-	    {
-	      res = scm_from_size_t (32*i + find_first_one (w));
-	      break;
-	    }
-	}
-    }
-  else
-    {
-      size_t i;
-      for (i = first_bit; i < len; i++)
-	{
-	  SCM elt = scm_array_handle_ref (&handle, i*inc);
-	  if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt)))
-	    {
-	      res = scm_from_size_t (i);
-	      break;
-	    }
-	}
-    }
-
-  scm_array_handle_release (&handle);
-
-  return res;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0,
-	    (SCM v, SCM kv, SCM obj),
-	    "Set entries of bit vector @var{v} to @var{obj}, with @var{kv}\n"
-	    "selecting the entries to change.  The return value is\n"
-	    "unspecified.\n"
-	    "\n"
-	    "If @var{kv} is a bit vector, then those entries where it has\n"
-	    "@code{#t} are the ones in @var{v} which are set to @var{obj}.\n"
-	    "@var{kv} and @var{v} must be the same length.  When @var{obj}\n"
-	    "is @code{#t} it's like @var{kv} is OR'ed into @var{v}.  Or when\n"
-	    "@var{obj} is @code{#f} it can be seen as an ANDNOT.\n"
-	    "\n"
-	    "@example\n"
-	    "(define bv #*01000010)\n"
-	    "(bit-set*! bv #*10010001 #t)\n"
-	    "bv\n"
-	    "@result{} #*11010011\n"
-	    "@end example\n"
-	    "\n"
-	    "If @var{kv} is a u32vector, then its elements are\n"
-	    "indices into @var{v} which are set to @var{obj}.\n"
-	    "\n"
-	    "@example\n"
-	    "(define bv #*01000010)\n"
-	    "(bit-set*! bv #u32(5 2 7) #t)\n"
-	    "bv\n"
-	    "@result{} #*01100111\n"
-	    "@end example")
-#define FUNC_NAME s_scm_bit_set_star_x
-{
-  scm_t_array_handle v_handle;
-  size_t v_off, v_len;
-  ssize_t v_inc;
-  scm_t_uint32 *v_bits;
-  int bit;
-
-  /* Validate that OBJ is a boolean so this is done even if we don't
-     need BIT.
-  */
-  bit = scm_to_bool (obj);
-
-  v_bits = scm_bitvector_writable_elements (v, &v_handle,
-					    &v_off, &v_len, &v_inc);
-
-  if (scm_is_bitvector (kv))
-    {
-      scm_t_array_handle kv_handle;
-      size_t kv_off, kv_len;
-      ssize_t kv_inc;
-      const scm_t_uint32 *kv_bits;
-      
-      kv_bits = scm_bitvector_elements (v, &kv_handle,
-					&kv_off, &kv_len, &kv_inc);
-
-      if (v_len != kv_len)
-	scm_misc_error (NULL,
-			"bit vectors must have equal length",
-			SCM_EOL);
-
-      if (v_off == 0 && v_inc == 1 && kv_off == 0 && kv_inc == 1 && kv_len > 0)
-	{
-	  size_t word_len = (kv_len + 31) / 32;
-	  scm_t_uint32 last_mask = ((scm_t_uint32)-1) >> (32*word_len - kv_len);
-	  size_t i;
- 
-	  if (bit == 0)
-	    {
-	      for (i = 0; i < word_len-1; i++)
-		v_bits[i] &= ~kv_bits[i];
-	      v_bits[i] &= ~(kv_bits[i] & last_mask);
-	    }
-	  else
-	    {
-	      for (i = 0; i < word_len-1; i++)
-		v_bits[i] |= kv_bits[i];
-	      v_bits[i] |= kv_bits[i] & last_mask;
-	    }
-	}
-      else
-	{
-	  size_t i;
-	  for (i = 0; i < kv_len; i++)
-	    if (scm_is_true (scm_array_handle_ref (&kv_handle, i*kv_inc)))
-	      scm_array_handle_set (&v_handle, i*v_inc, obj);
-	}
-      
-      scm_array_handle_release (&kv_handle);
-
-    }
-  else if (scm_is_true (scm_u32vector_p (kv)))
-    {
-      scm_t_array_handle kv_handle;
-      size_t i, kv_len;
-      ssize_t kv_inc;
-      const scm_t_uint32 *kv_elts;
-
-      kv_elts = scm_u32vector_elements (kv, &kv_handle, &kv_len, &kv_inc);
-      for (i = 0; i < kv_len; i++, kv_elts += kv_inc)
-	scm_array_handle_set (&v_handle, (*kv_elts)*v_inc, obj);
-
-      scm_array_handle_release (&kv_handle);
-    }
-  else 
-    scm_wrong_type_arg_msg (NULL, 0, kv, "bitvector or u32vector");
-
-  scm_array_handle_release (&v_handle);
-
-  return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0,
-           (SCM v, SCM kv, SCM obj),
-	    "Return a count of how many entries in bit vector @var{v} are\n"
-	    "equal to @var{obj}, with @var{kv} selecting the entries to\n"
-	    "consider.\n"
-	    "\n"
-	    "If @var{kv} is a bit vector, then those entries where it has\n"
-	    "@code{#t} are the ones in @var{v} which are considered.\n"
-	    "@var{kv} and @var{v} must be the same length.\n"
-	    "\n"
-	    "If @var{kv} is a u32vector, then it contains\n"
-	    "the indexes in @var{v} to consider.\n"
-	    "\n"
-	    "For example,\n"
-	    "\n"
-	    "@example\n"
-	    "(bit-count* #*01110111 #*11001101 #t) @result{} 3\n"
-	    "(bit-count* #*01110111 #u32(7 0 4) #f)  @result{} 2\n"
-	    "@end example")
-#define FUNC_NAME s_scm_bit_count_star
-{
-  scm_t_array_handle v_handle;
-  size_t v_off, v_len;
-  ssize_t v_inc;
-  const scm_t_uint32 *v_bits;
-  size_t count = 0;
-  int bit;
-
-  /* Validate that OBJ is a boolean so this is done even if we don't
-     need BIT.
-  */
-  bit = scm_to_bool (obj);
-
-  v_bits = scm_bitvector_elements (v, &v_handle,
-				   &v_off, &v_len, &v_inc);
-
-  if (scm_is_bitvector (kv))
-    {
-      scm_t_array_handle kv_handle;
-      size_t kv_off, kv_len;
-      ssize_t kv_inc;
-      const scm_t_uint32 *kv_bits;
-      
-      kv_bits = scm_bitvector_elements (v, &kv_handle,
-					&kv_off, &kv_len, &kv_inc);
-
-      if (v_len != kv_len)
-	scm_misc_error (NULL,
-			"bit vectors must have equal length",
-			SCM_EOL);
-
-      if (v_off == 0 && v_inc == 1 && kv_off == 0 && kv_inc == 1 && kv_len > 0)
-	{
-	  size_t i, word_len = (kv_len + 31) / 32;
-	  scm_t_uint32 last_mask = ((scm_t_uint32)-1) >> (32*word_len - kv_len);
-	  scm_t_uint32 xor_mask = bit? 0 : ((scm_t_uint32)-1);
-
-	  for (i = 0; i < word_len-1; i++)
-	    count += count_ones ((v_bits[i]^xor_mask) & kv_bits[i]);
-	  count += count_ones ((v_bits[i]^xor_mask) & kv_bits[i] & last_mask);
- 	}
-      else
-	{
-	  size_t i;
-	  for (i = 0; i < kv_len; i++)
-	    if (scm_is_true (scm_array_handle_ref (&kv_handle, i)))
-	      {
-		SCM elt = scm_array_handle_ref (&v_handle, i*v_inc);
-		if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt)))
-		  count++;
-	      }
-	}
-      
-      scm_array_handle_release (&kv_handle);
-
-    }
-  else if (scm_is_true (scm_u32vector_p (kv)))
-    {
-      scm_t_array_handle kv_handle;
-      size_t i, kv_len;
-      ssize_t kv_inc;
-      const scm_t_uint32 *kv_elts;
-
-      kv_elts = scm_u32vector_elements (kv, &kv_handle, &kv_len, &kv_inc);
-      for (i = 0; i < kv_len; i++, kv_elts += kv_inc)
-	{
-	  SCM elt = scm_array_handle_ref (&v_handle, (*kv_elts)*v_inc);
-	  if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt)))
-	    count++;
-	}
-
-      scm_array_handle_release (&kv_handle);
-    }
-  else 
-    scm_wrong_type_arg_msg (NULL, 0, kv, "bitvector or u32vector");
-
-  scm_array_handle_release (&v_handle);
-
-  return scm_from_size_t (count);
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_bit_invert_x, "bit-invert!", 1, 0, 0, 
-           (SCM v),
-	    "Modify the bit vector @var{v} by replacing each element with\n"
-	    "its negation.")
-#define FUNC_NAME s_scm_bit_invert_x
-{
-  scm_t_array_handle handle;
-  size_t off, len;
-  ssize_t inc;
-  scm_t_uint32 *bits;
-
-  bits = scm_bitvector_writable_elements (v, &handle, &off, &len, &inc);
-  
-  if (off == 0 && inc == 1 && len > 0)
-    {
-      size_t word_len = (len + 31) / 32;
-      scm_t_uint32 last_mask = ((scm_t_uint32)-1) >> (32*word_len - len);
-      size_t i;
-
-      for (i = 0; i < word_len-1; i++)
-	bits[i] = ~bits[i];
-      bits[i] = bits[i] ^ last_mask;
-    }
-  else
-    {
-      size_t i;
-      for (i = 0; i < len; i++)
-	scm_array_handle_set (&handle, i*inc,
-			      scm_not (scm_array_handle_ref (&handle, i*inc)));
-    }
-
-  scm_array_handle_release (&handle);
-
-  return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-
-SCM
-scm_istr2bve (SCM str)
-{
-  scm_t_array_handle handle;
-  size_t len = scm_i_string_length (str);
-  SCM vec = scm_c_make_bitvector (len, SCM_UNDEFINED);
-  SCM res = vec;
-
-  scm_t_uint32 mask;
-  size_t k, j;
-  const char *c_str;
-  scm_t_uint32 *data;
-
-  data = scm_bitvector_writable_elements (vec, &handle, NULL, NULL, NULL);
-  c_str = scm_i_string_chars (str);
-
-  for (k = 0; k < (len + 31) / 32; k++)
-    {
-      data[k] = 0L;
-      j = len - k * 32;
-      if (j > 32)
-	j = 32;
-      for (mask = 1L; j--; mask <<= 1)
-	switch (*c_str++)
-	  {
-	  case '0':
-	    break;
-	  case '1':
-	    data[k] |= mask;
-	    break;
-	  default:
-	    res = SCM_BOOL_F;
-	    goto exit;
-	  }
-    }
-  
- exit:
-  scm_array_handle_release (&handle);
-  scm_remember_upto_here_1 (str);
-  return res;
-}
-
-
-
-static SCM 
-ra2l (SCM ra, unsigned long base, unsigned long k)
-{
-  SCM res = SCM_EOL;
-  long inc;
-  size_t i;
-  int enclosed = SCM_I_ENCLOSED_ARRAYP (ra);
-  
-  if (k == SCM_I_ARRAY_NDIM (ra))
-    return scm_i_cvref (SCM_I_ARRAY_V (ra), base, enclosed);
-
-  inc = SCM_I_ARRAY_DIMS (ra)[k].inc;
-  if (SCM_I_ARRAY_DIMS (ra)[k].ubnd < SCM_I_ARRAY_DIMS (ra)[k].lbnd)
-    return SCM_EOL;
-  i = base + (1 + SCM_I_ARRAY_DIMS (ra)[k].ubnd - SCM_I_ARRAY_DIMS (ra)[k].lbnd) * inc;
-  do
-    {
-      i -= inc;
-      res = scm_cons (ra2l (ra, i, k + 1), res);
-    }
-  while (i != base);
-  return res;
-}
-
-
-SCM_DEFINE (scm_array_to_list, "array->list", 1, 0, 0, 
-           (SCM v),
-	    "Return a list consisting of all the elements, in order, of\n"
-	    "@var{array}.")
-#define FUNC_NAME s_scm_array_to_list
-{
-  if (scm_is_generalized_vector (v))
-    return scm_generalized_vector_to_list (v);
-  else if (SCM_I_ARRAYP (v) || SCM_I_ENCLOSED_ARRAYP (v))
-    return ra2l (v, SCM_I_ARRAY_BASE (v), 0);
-
-  scm_wrong_type_arg_msg (NULL, 0, v, "array");
-}
-#undef FUNC_NAME
-
-
-static void l2ra (SCM lst, scm_t_array_handle *handle, ssize_t pos, size_t k);
-
-SCM_DEFINE (scm_list_to_typed_array, "list->typed-array", 3, 0, 0,
-           (SCM type, SCM shape, SCM lst),
-	    "Return an array of the type @var{type}\n"
-	    "with elements the same as those of @var{lst}.\n"
-	    "\n"
-	    "The argument @var{shape} determines the number of dimensions\n"
-	    "of the array and their shape.  It is either an exact integer,\n"
-	    "giving the\n"
-	    "number of dimensions directly, or a list whose length\n"
-	    "specifies the number of dimensions and each element specified\n"
-	    "the lower and optionally the upper bound of the corresponding\n"
-	    "dimension.\n"
-	    "When the element is list of two elements, these elements\n"
-	    "give the lower and upper bounds.  When it is an exact\n"
-	    "integer, it gives only the lower bound.")
-#define FUNC_NAME s_scm_list_to_typed_array
-{
-  SCM row;
-  SCM ra;
-  scm_t_array_handle handle;
-
-  row = lst;
-  if (scm_is_integer (shape))
-    {
-      size_t k = scm_to_size_t (shape);
-      shape = SCM_EOL;
-      while (k-- > 0)
-	{
-	  shape = scm_cons (scm_length (row), shape);
-	  if (k > 0 && !scm_is_null (row))
-	    row = scm_car (row);
-	}
-    }
-  else
-    {
-      SCM shape_spec = shape;
-      shape = SCM_EOL;
-      while (1)
-	{
-	  SCM spec = scm_car (shape_spec);
-	  if (scm_is_pair (spec))
-	    shape = scm_cons (spec, shape);
-	  else
-	    shape = scm_cons (scm_list_2 (spec,
-					  scm_sum (scm_sum (spec,
-							    scm_length (row)),
-						   scm_from_int (-1))),
-			      shape);
-	  shape_spec = scm_cdr (shape_spec);
-	  if (scm_is_pair (shape_spec))
-	    {
-	      if (!scm_is_null (row))
-		row = scm_car (row);
-	    }
-	  else
-	    break;
-	}
-    }
-
-  ra = scm_make_typed_array (type, SCM_UNSPECIFIED,
-			     scm_reverse_x (shape, SCM_EOL));
-
-  scm_array_get_handle (ra, &handle);
-  l2ra (lst, &handle, 0, 0);
-  scm_array_handle_release (&handle);
-
-  return ra;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_list_to_array, "list->array", 2, 0, 0,
-           (SCM ndim, SCM lst),
-	    "Return an array with elements the same as those of @var{lst}.")
-#define FUNC_NAME s_scm_list_to_array
-{
-  return scm_list_to_typed_array (SCM_BOOL_T, ndim, lst);
-}
-#undef FUNC_NAME
-
-static void
-l2ra (SCM lst, scm_t_array_handle *handle, ssize_t pos, size_t k)
-{
-  if (k == scm_array_handle_rank (handle))
-    scm_array_handle_set (handle, pos, lst);
-  else
-    {
-      scm_t_array_dim *dim = scm_array_handle_dims (handle) + k;
-      ssize_t inc = dim->inc;
-      size_t len = 1 + dim->ubnd - dim->lbnd, n;
-      char *errmsg = NULL;
-
-      n = len;
-      while (n > 0 && scm_is_pair (lst))
-	{
-	  l2ra (SCM_CAR (lst), handle, pos, k + 1);
-	  pos += inc;
-	  lst = SCM_CDR (lst);
-	  n -= 1;
-	}
-      if (n != 0)
-	errmsg = "too few elements for array dimension ~a, need ~a";
-      if (!scm_is_null (lst))
-	errmsg = "too many elements for array dimension ~a, want ~a";
-      if (errmsg)
-	scm_misc_error (NULL, errmsg, scm_list_2 (scm_from_ulong (k),
-						  scm_from_size_t (len)));
-    }
-}
-
-#if SCM_ENABLE_DEPRECATED
-
-SCM_DEFINE (scm_list_to_uniform_array, "list->uniform-array", 3, 0, 0,
-           (SCM ndim, SCM prot, SCM lst),
-	    "Return a uniform array of the type indicated by prototype\n"
-	    "@var{prot} with elements the same as those of @var{lst}.\n"
-	    "Elements must be of the appropriate type, no coercions are\n"
-	    "done.\n"
-	    "\n"
-	    "The argument @var{ndim} determines the number of dimensions\n"
-	    "of the array.  It is either an exact integer, giving the\n"
-	    "number directly, or a list of exact integers, whose length\n"
-	    "specifies the number of dimensions and each element is the\n"
-	    "lower index bound of its dimension.")
-#define FUNC_NAME s_scm_list_to_uniform_array
-{
-  return scm_list_to_typed_array (prototype_to_type (prot), ndim, lst);
-}
-#undef FUNC_NAME
-
-#endif
-
-/* Print dimension DIM of ARRAY.
- */
-
-static int
-scm_i_print_array_dimension (SCM array, int dim, int base, int enclosed,
-			     SCM port, scm_print_state *pstate)
-{
-  scm_t_array_dim *dim_spec = SCM_I_ARRAY_DIMS (array) + dim;
-  long idx;
-
-  scm_putc ('(', port);
-
-  for (idx = dim_spec->lbnd; idx <= dim_spec->ubnd; idx++)
-    {
-      if (dim < SCM_I_ARRAY_NDIM(array)-1)
-	scm_i_print_array_dimension (array, dim+1, base, enclosed, 
-				     port, pstate);
-      else
-	scm_iprin1 (scm_i_cvref (SCM_I_ARRAY_V (array), base, enclosed), 
-		    port, pstate);
-      if (idx < dim_spec->ubnd)
-	scm_putc (' ', port);
-      base += dim_spec->inc;
-    }
-
-  scm_putc (')', port);
-  return 1;
-}
-
-/* Print an array.  (Only for strict arrays, not for generalized vectors.)
-*/
-
-static int
-scm_i_print_array (SCM array, SCM port, scm_print_state *pstate)
-{
-  long ndim = SCM_I_ARRAY_NDIM (array);
-  scm_t_array_dim *dim_specs = SCM_I_ARRAY_DIMS (array);
-  SCM v = SCM_I_ARRAY_V (array);
-  unsigned long base = SCM_I_ARRAY_BASE (array);
-  long i;
-  int print_lbnds = 0, zero_size = 0, print_lens = 0;
-
-  scm_putc ('#', port);
-  if (ndim != 1 || dim_specs[0].lbnd != 0)
-    scm_intprint (ndim, 10, port);
-  if (scm_is_uniform_vector (v))
-    scm_puts (scm_i_uniform_vector_tag (v), port);
-  else if (scm_is_bitvector (v))
-    scm_puts ("b", port);
-  else if (scm_is_string (v))
-    scm_puts ("a", port);
-  else if (!scm_is_vector (v))
-    scm_puts ("?", port);
-  
-  for (i = 0; i < ndim; i++)
-    {
-      if (dim_specs[i].lbnd != 0)
-	print_lbnds = 1;
-      if (dim_specs[i].ubnd - dim_specs[i].lbnd + 1 == 0)
-	zero_size = 1;
-      else if (zero_size)
-	print_lens = 1;
-    }
-
-  if (print_lbnds || print_lens)
-    for (i = 0; i < ndim; i++)
-      {
-	if (print_lbnds)
-	  {
-	    scm_putc ('@', port);
-	    scm_intprint (dim_specs[i].lbnd, 10, port);
-	  }
-	if (print_lens)
-	  {
-	    scm_putc (':', port);
-	    scm_intprint (dim_specs[i].ubnd - dim_specs[i].lbnd + 1,
-			  10, port);
-	  }
-      }
-
-  if (ndim == 0)
-    {
-      /* Rank zero arrays, which are really just scalars, are printed
-	 specially.  The consequent way would be to print them as
-
-            #0 OBJ
-
-         where OBJ is the printed representation of the scalar, but we
-         print them instead as
-
-            #0(OBJ)
-
-         to make them look less strange.
-
-	 Just printing them as
-
-            OBJ
-
-         would be correct in a way as well, but zero rank arrays are
-         not really the same as Scheme values since they are boxed and
-         can be modified with array-set!, say.
-      */
-      scm_putc ('(', port);
-      scm_iprin1 (scm_i_cvref (v, base, 0), port, pstate);
-      scm_putc (')', port);
-      return 1;
-    }
-  else
-    return scm_i_print_array_dimension (array, 0, base, 0, port, pstate);
-}
-
-static int
-scm_i_print_enclosed_array (SCM array, SCM port, scm_print_state *pstate)
-{
-  size_t base;
-
-  scm_putc ('#', port);
-  base = SCM_I_ARRAY_BASE (array);
-  scm_puts ("<enclosed-array ", port);
-  scm_i_print_array_dimension (array, 0, base, 1, port, pstate);
-  scm_putc ('>', port);
-  return 1;
-}
-
-/* Read an array.  This function can also read vectors and uniform
-   vectors.  Also, the conflict between '#f' and '#f32' and '#f64' is
-   handled here.
-
-   C is the first character read after the '#'.
-*/
-
-static SCM
-tag_to_type (const char *tag, SCM port)
-{
-#if SCM_ENABLE_DEPRECATED
-  {
-    /* Recognize the old syntax.
-     */
-    const char *instead;
-    switch (tag[0])
-      {
-      case 'u':
-	instead = "u32";
-	break;
-      case 'e':
-	instead = "s32";
-	break;
-      case 's':
-	instead = "f32";
-	break;
-      case 'i':
-	instead = "f64";
-	break;
-      case 'y':
-	instead = "s8";
-	break;
-      case 'h':
-	instead = "s16";
-	break;
-      case 'l':
-	instead = "s64";
-	break;
-      case 'c':
-	instead = "c64";
-	break;
-      default:
-	instead = NULL;
-	break;
-      }
-    
-    if (instead && tag[1] == '\0')
-      {
-	scm_c_issue_deprecation_warning_fmt
-	  ("The tag '%c' is deprecated for uniform vectors. "
-	   "Use '%s' instead.", tag[0], instead);
-	return scm_from_locale_symbol (instead);
-      }
-  }
-#endif
-  
-  if (*tag == '\0')
-    return SCM_BOOL_T;
-  else
-    return scm_from_locale_symbol (tag);
-}
-
-static int
-read_decimal_integer (SCM port, int c, ssize_t *resp)
-{
-  ssize_t sign = 1;
-  ssize_t res = 0;
-  int got_it = 0;
-
-  if (c == '-')
-    {
-      sign = -1;
-      c = scm_getc (port);
-    }
-
-  while ('0' <= c && c <= '9')
-    {
-      res = 10*res + c-'0';
-      got_it = 1;
-      c = scm_getc (port);
-    }
-
-  if (got_it)
-    *resp = sign * res;
-  return c;
-}
-
-SCM
-scm_i_read_array (SCM port, int c)
-{
-  ssize_t rank;
-  int got_rank;
-  char tag[80];
-  int tag_len;
-
-  SCM shape = SCM_BOOL_F, elements;
-
-  /* XXX - shortcut for ordinary vectors.  Shouldn't be necessary but
-     the array code can not deal with zero-length dimensions yet, and
-     we want to allow zero-length vectors, of course.
-  */
-  if (c == '(')
-    {
-      scm_ungetc (c, port);
-      return scm_vector (scm_read (port));
-    }
-
-  /* Disambiguate between '#f' and uniform floating point vectors.
-   */
-  if (c == 'f')
-    {
-      c = scm_getc (port);
-      if (c != '3' && c != '6')
-	{
-	  if (c != EOF)
-	    scm_ungetc (c, port);
-	  return SCM_BOOL_F;
-	}
-      rank = 1;
-      got_rank = 1;
-      tag[0] = 'f';
-      tag_len = 1;
-      goto continue_reading_tag;
-    }
-
-  /* Read rank. 
-   */
-  rank = 1;
-  c = read_decimal_integer (port, c, &rank);
-  if (rank < 0)
-    scm_i_input_error (NULL, port, "array rank must be non-negative",
-		       SCM_EOL);
-
-  /* Read tag. 
-   */
-  tag_len = 0;
- continue_reading_tag:
-  while (c != EOF && c != '(' && c != '@' && c != ':' && tag_len < 80)
-    {
-      tag[tag_len++] = c;
-      c = scm_getc (port);
-    }
-  tag[tag_len] = '\0';
-  
-  /* Read shape. 
-   */
-  if (c == '@' || c == ':')
-    {
-      shape = SCM_EOL;
-      
-      do
-	{
-	  ssize_t lbnd = 0, len = 0;
-	  SCM s;
-
-	  if (c == '@')
-	    {
-	      c = scm_getc (port);
-	      c = read_decimal_integer (port, c, &lbnd);
-	    }
-	  
-	  s = scm_from_ssize_t (lbnd);
-
-	  if (c == ':')
-	    {
-	      c = scm_getc (port);
-	      c = read_decimal_integer (port, c, &len);
-	      if (len < 0)
-		scm_i_input_error (NULL, port,
-				   "array length must be non-negative",
-				   SCM_EOL);
-
-	      s = scm_list_2 (s, scm_from_ssize_t (lbnd+len-1));
-	    }
-
-	  shape = scm_cons (s, shape);
-	} while (c == '@' || c == ':');
-
-      shape = scm_reverse_x (shape, SCM_EOL);
-    }
-
-  /* Read nested lists of elements.
-   */
-  if (c != '(')
-    scm_i_input_error (NULL, port,
-		       "missing '(' in vector or array literal",
-		       SCM_EOL);
-  scm_ungetc (c, port);
-  elements = scm_read (port);
-
-  if (scm_is_false (shape))
-    shape = scm_from_ssize_t (rank);
-  else if (scm_ilength (shape) != rank)
-    scm_i_input_error 
-      (NULL, port,
-       "the number of shape specifications must match the array rank",
-       SCM_EOL);
-
-  /* Handle special print syntax of rank zero arrays; see
-     scm_i_print_array for a rationale.
-  */
-  if (rank == 0)
-    {
-      if (!scm_is_pair (elements))
-	scm_i_input_error (NULL, port,
-			   "too few elements in array literal, need 1",
-			   SCM_EOL);
-      if (!scm_is_null (SCM_CDR (elements)))
-	scm_i_input_error (NULL, port,
-			   "too many elements in array literal, want 1",
-			   SCM_EOL);
-      elements = SCM_CAR (elements);
-    }
-
-  /* Construct array. 
-   */
-  return scm_list_to_typed_array (tag_to_type (tag, port), shape, elements);
-}
-
-SCM_DEFINE (scm_array_type, "array-type", 1, 0, 0, 
-           (SCM ra),
-	    "")
-#define FUNC_NAME s_scm_array_type
-{
-  if (SCM_I_ARRAYP (ra))
-    return scm_i_generalized_vector_type (SCM_I_ARRAY_V (ra));
-  else if (scm_is_generalized_vector (ra))
-    return scm_i_generalized_vector_type (ra);
-  else if (SCM_I_ENCLOSED_ARRAYP (ra))
-    scm_wrong_type_arg_msg (NULL, 0, ra, "non-enclosed array");
-  else
-    scm_wrong_type_arg_msg (NULL, 0, ra, "array");
-}
-#undef FUNC_NAME
-
-#if SCM_ENABLE_DEPRECATED
-
-SCM_DEFINE (scm_array_prototype, "array-prototype", 1, 0, 0, 
-           (SCM ra),
-	    "Return an object that would produce an array of the same type\n"
-	    "as @var{array}, if used as the @var{prototype} for\n"
-	    "@code{make-uniform-array}.")
-#define FUNC_NAME s_scm_array_prototype
-{
-  if (SCM_I_ARRAYP (ra))
-    return scm_i_get_old_prototype (SCM_I_ARRAY_V (ra));
-  else if (scm_is_generalized_vector (ra))
-    return scm_i_get_old_prototype (ra);
-  else if (SCM_I_ENCLOSED_ARRAYP (ra))
-    return SCM_UNSPECIFIED;
-  else
-    scm_wrong_type_arg_msg (NULL, 0, ra, "array");
-}
-#undef FUNC_NAME
-
-#endif
-
-
-#if SCM_ENABLE_DEPRECATED
-
-SCM 
-scm_make_ra (int ndim)
-{
-  scm_c_issue_deprecation_warning
-    ("scm_make_ra is deprecated.  Use scm_make_array or similar instead.");
-  return scm_i_make_ra (ndim, 0);
-}
-
-SCM 
-scm_shap2ra (SCM args, const char *what)
-{
-  scm_c_issue_deprecation_warning
-    ("scm_shap2ra is deprecated.  Use scm_make_array or similar instead.");
-  return scm_i_shap2ra (args);
-}
-
-SCM
-scm_cvref (SCM v, unsigned long pos, SCM last)
-{
-  scm_c_issue_deprecation_warning
-    ("scm_cvref is deprecated.  Use scm_c_generalized_vector_ref instead.");
-  return scm_c_generalized_vector_ref (v, pos);
-}
-
-void 
-scm_ra_set_contp (SCM ra)
-{
-  scm_c_issue_deprecation_warning
-    ("scm_ra_set_contp is deprecated.  There should be no need for it.");
-  scm_i_ra_set_contp (ra);
-}
-
-long 
-scm_aind (SCM ra, SCM args, const char *what)
-{
-  scm_t_array_handle handle;
-  ssize_t pos;
-
-  scm_c_issue_deprecation_warning
-    ("scm_aind is deprecated.  Use scm_array_handle_pos instead.");
-
-  if (scm_is_integer (args))
-    args = scm_list_1 (args);
-  
-  scm_array_get_handle (ra, &handle);
-  pos = scm_array_handle_pos (&handle, args) + SCM_I_ARRAY_BASE (ra);
-  scm_array_handle_release (&handle);
-  return pos;
-}
-
-int 
-scm_raprin1 (SCM exp, SCM port, scm_print_state *pstate)
-{
-  scm_c_issue_deprecation_warning
-    ("scm_raprin1 is deprecated.  Use scm_display or scm_write instead.");
-
-  scm_iprin1 (exp, port, pstate);
-  return 1;
-}
-
-#endif
-
-void
-scm_init_unif ()
-{
-  scm_i_tc16_array = scm_make_smob_type ("array", 0);
-  scm_set_smob_print (scm_i_tc16_array, scm_i_print_array);
-  scm_set_smob_equalp (scm_i_tc16_array, scm_array_equal_p);
-
-  scm_i_tc16_enclosed_array = scm_make_smob_type ("enclosed-array", 0);
-  scm_set_smob_print (scm_i_tc16_enclosed_array, scm_i_print_enclosed_array);
-  scm_set_smob_equalp (scm_i_tc16_enclosed_array, scm_array_equal_p);
-
-  scm_add_feature ("array");
-
-  scm_tc16_bitvector = scm_make_smob_type ("bitvector", 0);
-  scm_set_smob_print (scm_tc16_bitvector, bitvector_print);
-  scm_set_smob_equalp (scm_tc16_bitvector, bitvector_equalp);
-
-  init_type_creator_table ();
-
-#include "libguile/unif.x"
-
-}
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/unif.h b/libguile/unif.h
deleted file mode 100644
index a09bfc921..000000000
--- a/libguile/unif.h
+++ /dev/null
@@ -1,194 +0,0 @@
-/* classes: h_files */
-
-#ifndef SCM_UNIF_H
-#define SCM_UNIF_H
-
-/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
- */
-
-
-
-#include "libguile/__scm.h"
-#include "libguile/print.h"
-
-
-
-/* This file contains the definitions for arrays and bit vectors.
-   Uniform numeric vectors are now in srfi-4.c.
-*/
-
-
-/** Arrays */
-
-typedef struct scm_t_array_dim
-{
-  ssize_t lbnd;
-  ssize_t ubnd;
-  ssize_t inc;
-} scm_t_array_dim;
-
-SCM_API SCM scm_array_p (SCM v, SCM prot);
-SCM_API SCM scm_typed_array_p (SCM v, SCM type);
-SCM_API SCM scm_make_array (SCM fill, SCM bounds);
-SCM_API SCM scm_make_typed_array (SCM type, SCM fill, SCM bounds);
-SCM_API SCM scm_array_rank (SCM ra);
-SCM_API size_t scm_c_array_rank (SCM ra);
-SCM_API SCM scm_array_dimensions (SCM ra);
-SCM_API SCM scm_shared_array_root (SCM ra);
-SCM_API SCM scm_shared_array_offset (SCM ra);
-SCM_API SCM scm_shared_array_increments (SCM ra);
-SCM_API SCM scm_make_shared_array (SCM oldra, SCM mapfunc, SCM dims);
-SCM_API SCM scm_transpose_array (SCM ra, SCM args);
-SCM_API SCM scm_enclose_array (SCM ra, SCM axes);
-SCM_API SCM scm_array_in_bounds_p (SCM v, SCM args);
-SCM_API SCM scm_array_ref (SCM v, SCM args);
-SCM_API SCM scm_array_set_x (SCM v, SCM obj, SCM args);
-SCM_API SCM scm_array_contents (SCM ra, SCM strict);
-SCM_API SCM scm_uniform_array_read_x (SCM ra, SCM port_or_fd,
-				      SCM start, SCM end);
-SCM_API SCM scm_uniform_array_write (SCM v, SCM port_or_fd,
-				     SCM start, SCM end);
-SCM_API SCM scm_array_to_list (SCM v);
-SCM_API SCM scm_list_to_array (SCM ndim, SCM lst);
-SCM_API SCM scm_list_to_typed_array (SCM type, SCM ndim, SCM lst);
-SCM_API SCM scm_array_type (SCM ra);
-
-SCM_API int scm_is_array (SCM obj);
-SCM_API int scm_is_typed_array (SCM obj, SCM type);
-
-SCM_API SCM scm_ra2contig (SCM ra, int copy);
-
-struct scm_t_array_handle;
-
-typedef SCM (*scm_i_t_array_ref) (struct scm_t_array_handle *, ssize_t);
-typedef void (*scm_i_t_array_set) (struct scm_t_array_handle *, ssize_t, SCM);
-
-typedef struct scm_t_array_handle {
-  SCM array;
-  size_t base;
-  scm_t_array_dim *dims;
-  scm_t_array_dim dim0;
-  scm_i_t_array_ref ref;
-  scm_i_t_array_set set;
-  const void *elements;
-  void *writable_elements;
-} scm_t_array_handle;
-
-SCM_API void scm_array_get_handle (SCM array, scm_t_array_handle *h);
-SCM_API size_t scm_array_handle_rank (scm_t_array_handle *h);
-SCM_API scm_t_array_dim *scm_array_handle_dims (scm_t_array_handle *h);
-SCM_API ssize_t scm_array_handle_pos (scm_t_array_handle *h, SCM indices);
-SCM_API const SCM *scm_array_handle_elements (scm_t_array_handle *h);
-SCM_API SCM *scm_array_handle_writable_elements (scm_t_array_handle *h);
-SCM_API void scm_array_handle_release (scm_t_array_handle *h);
-
-/* See inline.h for scm_array_handle_ref and scm_array_handle_set */
-
-
-/** Bit vectors */
-
-SCM_API SCM scm_bitvector_p (SCM vec);
-SCM_API SCM scm_bitvector (SCM bits);
-SCM_API SCM scm_make_bitvector (SCM len, SCM fill);
-SCM_API SCM scm_bitvector_length (SCM vec);
-SCM_API SCM scm_bitvector_ref (SCM vec, SCM idx);
-SCM_API SCM scm_bitvector_set_x (SCM vec, SCM idx, SCM val);
-SCM_API SCM scm_list_to_bitvector (SCM list);
-SCM_API SCM scm_bitvector_to_list (SCM vec);
-SCM_API SCM scm_bitvector_fill_x (SCM vec, SCM val);
-
-SCM_API SCM scm_bit_count (SCM item, SCM seq);
-SCM_API SCM scm_bit_position (SCM item, SCM v, SCM k);
-SCM_API SCM scm_bit_set_star_x (SCM v, SCM kv, SCM obj);
-SCM_API SCM scm_bit_count_star (SCM v, SCM kv, SCM obj);
-SCM_API SCM scm_bit_invert_x (SCM v);
-SCM_API SCM scm_istr2bve (SCM str);
-
-SCM_API int scm_is_bitvector (SCM obj);
-SCM_API SCM scm_c_make_bitvector (size_t len, SCM fill);
-SCM_API size_t scm_c_bitvector_length (SCM vec);
-SCM_API SCM scm_c_bitvector_ref (SCM vec, size_t idx);
-SCM_API void scm_c_bitvector_set_x (SCM vec, size_t idx, SCM val);
-SCM_API const scm_t_uint32 *scm_array_handle_bit_elements (scm_t_array_handle *h);
-SCM_API scm_t_uint32 *scm_array_handle_bit_writable_elements (scm_t_array_handle *h);
-SCM_API size_t scm_array_handle_bit_elements_offset (scm_t_array_handle *h);
-SCM_API const scm_t_uint32 *scm_bitvector_elements (SCM vec,
-						    scm_t_array_handle *h,
-						    size_t *offp,
-						    size_t *lenp,
-						    ssize_t *incp);
-SCM_API scm_t_uint32 *scm_bitvector_writable_elements (SCM vec, 
-						       scm_t_array_handle *h,
-						       size_t *offp,
-						       size_t *lenp,
-						       ssize_t *incp);
-
-/* internal. */
-
-typedef struct scm_i_t_array
-{
-  SCM v;  /* the contents of the array, e.g., a vector or uniform vector.  */
-  unsigned long base;
-} scm_i_t_array;
-
-SCM_API scm_t_bits scm_i_tc16_array;
-SCM_API scm_t_bits scm_i_tc16_enclosed_array;
-
-#define SCM_I_ARRAY_FLAG_CONTIGUOUS (1 << 16)
-
-#define SCM_I_ARRAYP(a)	    SCM_TYP16_PREDICATE (scm_i_tc16_array, a)
-#define SCM_I_ENCLOSED_ARRAYP(a) \
-                            SCM_TYP16_PREDICATE (scm_i_tc16_enclosed_array, a)
-#define SCM_I_ARRAY_NDIM(x)  ((size_t) (SCM_CELL_WORD_0 (x) >> 17))
-#define SCM_I_ARRAY_CONTP(x) (SCM_CELL_WORD_0(x) & SCM_I_ARRAY_FLAG_CONTIGUOUS)
-
-#define SCM_I_ARRAY_MEM(a)  ((scm_i_t_array *) SCM_CELL_WORD_1 (a))
-#define SCM_I_ARRAY_V(a)    (SCM_I_ARRAY_MEM (a)->v)
-#define SCM_I_ARRAY_BASE(a) (SCM_I_ARRAY_MEM (a)->base)
-#define SCM_I_ARRAY_DIMS(a) \
-  ((scm_t_array_dim *)((char *) SCM_I_ARRAY_MEM (a) + sizeof (scm_i_t_array)))
-
-SCM_INTERNAL SCM scm_i_make_ra (int ndim, int enclosed);
-SCM_INTERNAL SCM scm_i_cvref (SCM v, size_t p, int enclosed);
-SCM_INTERNAL SCM scm_i_read_array (SCM port, int c);
-
-/* deprecated. */
-
-#if SCM_ENABLE_DEPRECATED
-
-SCM_API SCM scm_make_uve (long k, SCM prot);
-SCM_API SCM scm_array_prototype (SCM ra);
-SCM_API SCM scm_list_to_uniform_array (SCM ndim, SCM prot, SCM lst);
-SCM_API SCM scm_dimensions_to_uniform_array (SCM dims, SCM prot, SCM fill);
-SCM_API SCM scm_make_ra (int ndim);
-SCM_API SCM scm_shap2ra (SCM args, const char *what);
-SCM_API SCM scm_cvref (SCM v, unsigned long pos, SCM last);
-SCM_API void scm_ra_set_contp (SCM ra);
-SCM_API long scm_aind (SCM ra, SCM args, const char *what);
-SCM_API int scm_raprin1 (SCM exp, SCM port, scm_print_state *pstate);
-
-#endif
-
-SCM_INTERNAL void scm_init_unif (void);
-
-#endif  /* SCM_UNIF_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/uniform.c b/libguile/uniform.c
new file mode 100644
index 000000000..28125da8b
--- /dev/null
+++ b/libguile/uniform.c
@@ -0,0 +1,254 @@
+/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009 Free Software Foundation, Inc.
+ * 
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+
+
+
+#ifdef HAVE_CONFIG_H
+#  include <config.h>
+#endif
+
+#include <assert.h>
+
+#include "libguile/_scm.h"
+#include "libguile/__scm.h"
+
+#include "libguile/uniform.h"
+
+
+const size_t scm_i_array_element_type_sizes[SCM_ARRAY_ELEMENT_TYPE_LAST + 1] = {
+  0,
+  0,
+  1,
+  8,
+  8, 8,
+  16, 16,
+  32, 32,
+  64, 64,
+  32, 64,
+  64, 128
+};
+
+/* FIXME: return bit size instead of byte size? */
+size_t
+scm_array_handle_uniform_element_size (scm_t_array_handle *h)
+{
+  size_t ret = scm_i_array_element_type_sizes[h->element_type];
+  if (ret && ret % 8 == 0)
+    return ret / 8;
+  else
+    scm_wrong_type_arg_msg (NULL, 0, h->array, "uniform array");
+}
+
+const void *
+scm_array_handle_uniform_elements (scm_t_array_handle *h)
+{
+  return scm_array_handle_uniform_writable_elements (h);
+}
+
+void *
+scm_array_handle_uniform_writable_elements (scm_t_array_handle *h)
+{
+  size_t esize;
+  scm_t_uint8 *ret;
+
+  esize = scm_array_handle_uniform_element_size (h);
+  ret = ((scm_t_uint8*) h->writable_elements) + h->base * esize;
+  return ret;
+}
+
+int
+scm_is_uniform_vector (SCM obj)
+{
+  scm_t_array_handle h;
+  int ret = 0;
+
+  if (scm_is_generalized_vector (obj))
+    {
+      scm_generalized_vector_get_handle (obj, &h);
+      ret = SCM_ARRAY_ELEMENT_TYPE_IS_UNBOXED (h.element_type);
+      scm_array_handle_release (&h);
+    }
+  return ret;
+}
+
+size_t
+scm_c_uniform_vector_length (SCM uvec)
+{
+  scm_t_array_handle h;
+  size_t len;
+  ssize_t inc;
+  
+  scm_uniform_vector_elements (uvec, &h, &len, &inc);
+  scm_array_handle_release (&h);
+  return len;
+}
+
+SCM_DEFINE (scm_uniform_vector_p, "uniform-vector?", 1, 0, 0,
+	    (SCM obj),
+	    "Return @code{#t} if @var{obj} is a uniform vector.")
+#define FUNC_NAME s_scm_uniform_vector_p
+{
+  return scm_from_bool (scm_is_uniform_vector (obj));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_uniform_vector_element_type, "uniform-vector-element-type", 1, 0, 0,
+	    (SCM v),
+	    "Return the number of elements in the uniform vector, @var{v}.")
+#define FUNC_NAME s_scm_uniform_vector_element_type
+{
+  scm_t_array_handle h;
+  size_t len;
+  ssize_t inc;
+  SCM ret;
+  scm_uniform_vector_elements (v, &h, &len, &inc);
+  ret = scm_array_handle_element_type (&h);
+  scm_array_handle_release (&h);
+  return ret;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_uniform_vector_element_size, "uniform-vector-element-size", 1, 0, 0,
+	    (SCM v),
+	    "Return the number of bytes allocated to each element in the\n"
+            "uniform vector, @var{v}.")
+#define FUNC_NAME s_scm_uniform_vector_element_size
+{
+  scm_t_array_handle h;
+  size_t len;
+  ssize_t inc;
+  SCM ret;
+  scm_uniform_vector_elements (v, &h, &len, &inc);
+  ret = scm_from_size_t (scm_array_handle_uniform_element_size (&h));
+  scm_array_handle_release (&h);
+  return ret;
+}
+#undef FUNC_NAME
+
+SCM
+scm_c_uniform_vector_ref (SCM v, size_t idx)
+{
+  SCM ret;
+  scm_t_array_handle h;
+  size_t len;
+  ssize_t inc;
+  
+  scm_uniform_vector_elements (v, &h, &len, &inc);
+  ret = scm_array_handle_ref (&h, idx*inc);
+  scm_array_handle_release (&h);
+  return ret;
+}
+
+SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0,
+	    (SCM v, SCM idx),
+	    "Return the element at index @var{idx} of the\n"
+	    "homogenous numeric vector @var{v}.")
+#define FUNC_NAME s_scm_uniform_vector_ref
+{
+  return scm_c_uniform_vector_ref (v, scm_to_size_t (idx));
+}
+#undef FUNC_NAME
+
+void
+scm_c_uniform_vector_set_x (SCM v, size_t idx, SCM val)
+{
+  scm_t_array_handle h;
+  size_t len;
+  ssize_t inc;
+  
+  scm_uniform_vector_elements (v, &h, &len, &inc);
+  scm_array_handle_set (&h, idx*inc, val);
+  scm_array_handle_release (&h);
+}
+
+SCM_DEFINE (scm_uniform_vector_set_x, "uniform-vector-set!", 3, 0, 0,
+	    (SCM v, SCM idx, SCM val),
+	    "Set the element at index @var{idx} of the\n"
+	    "homogenous numeric vector @var{v} to @var{val}.")
+#define FUNC_NAME s_scm_uniform_vector_set_x
+{
+  scm_c_uniform_vector_set_x (v, scm_to_size_t (idx), val);
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_uniform_vector_to_list, "uniform-vector->list", 1, 0, 0,
+            (SCM uvec),
+	    "Convert the uniform numeric vector @var{uvec} to a list.")
+#define FUNC_NAME s_scm_uniform_vector_to_list
+{
+  SCM ret;
+  scm_t_array_handle h;
+  size_t len;
+  ssize_t inc;
+  
+  scm_uniform_vector_elements (uvec, &h, &len, &inc);
+  ret = scm_generalized_vector_to_list (uvec);
+  scm_array_handle_release (&h);
+  return ret;
+}
+#undef FUNC_NAME
+
+const void *
+scm_uniform_vector_elements (SCM uvec, 
+			     scm_t_array_handle *h,
+			     size_t *lenp, ssize_t *incp)
+{
+  return scm_uniform_vector_writable_elements (uvec, h, lenp, incp);
+}
+
+void *
+scm_uniform_vector_writable_elements (SCM uvec, 
+				      scm_t_array_handle *h,
+				      size_t *lenp, ssize_t *incp)
+{
+  void *ret;
+  scm_generalized_vector_get_handle (uvec, h);
+  /* FIXME nonlocal exit */
+  ret = scm_array_handle_uniform_writable_elements (h);
+  if (lenp)
+    {
+      scm_t_array_dim *dim = scm_array_handle_dims (h);
+      *lenp = dim->ubnd - dim->lbnd + 1;
+      *incp = dim->inc;
+    }
+  return ret;
+}
+
+SCM_DEFINE (scm_uniform_vector_length, "uniform-vector-length", 1, 0, 0, 
+	    (SCM v),
+	    "Return the number of elements in the uniform vector @var{v}.")
+#define FUNC_NAME s_scm_uniform_vector_length
+{
+  return scm_from_size_t (scm_c_uniform_vector_length (v));
+}
+#undef FUNC_NAME
+
+
+void
+scm_init_uniform (void)
+{
+#include "libguile/uniform.x"
+}
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/uniform.h b/libguile/uniform.h
new file mode 100644
index 000000000..b1f396594
--- /dev/null
+++ b/libguile/uniform.h
@@ -0,0 +1,77 @@
+/* classes: h_files */
+
+#ifndef SCM_UNIFORM_H
+#define SCM_UNIFORM_H
+
+/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009 Free Software Foundation, Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+
+
+#include "libguile/__scm.h"
+#include "libguile/generalized-vectors.h"
+
+
+
+/*
+ * Uniform vectors contain unboxed values. They are not necessarily contiguous.
+ */
+
+SCM_INTERNAL const size_t scm_i_array_element_type_sizes[];
+#define SCM_ARRAY_ELEMENT_TYPE_IS_UNBOXED(t)    \
+  (scm_i_array_element_type_sizes[(t)] != 0)
+
+/* returns type size in bits */
+SCM_API size_t scm_array_handle_uniform_element_size (scm_t_array_handle *h);
+
+SCM_API const void *scm_array_handle_uniform_elements (scm_t_array_handle *h);
+SCM_API void *scm_array_handle_uniform_writable_elements (scm_t_array_handle *h);
+
+SCM_API SCM scm_uniform_vector_p (SCM v);
+SCM_API SCM scm_uniform_vector_length (SCM v);
+SCM_API SCM scm_uniform_vector_element_type (SCM v);
+SCM_API SCM scm_uniform_vector_element_size (SCM v);
+SCM_API SCM scm_uniform_vector_ref (SCM v, SCM idx);
+SCM_API SCM scm_uniform_vector_set_x (SCM v, SCM idx, SCM val);
+SCM_API SCM scm_uniform_vector_to_list (SCM v);
+SCM_API SCM scm_uniform_vector_read_x (SCM v, SCM port_or_fd,
+				       SCM start, SCM end);
+SCM_API SCM scm_uniform_vector_write (SCM v, SCM port_or_fd,
+				      SCM start, SCM end);
+
+SCM_API int scm_is_uniform_vector (SCM obj);
+SCM_API size_t scm_c_uniform_vector_length (SCM v);
+SCM_API SCM scm_c_uniform_vector_ref (SCM v, size_t idx);
+SCM_API void scm_c_uniform_vector_set_x (SCM v, size_t idx, SCM val);
+SCM_API const void *scm_uniform_vector_elements (SCM uvec, 
+						 scm_t_array_handle *h,
+						 size_t *lenp, ssize_t *incp);
+SCM_API void *scm_uniform_vector_writable_elements (SCM uvec, 
+						    scm_t_array_handle *h,
+						    size_t *lenp,
+						    ssize_t *incp);
+
+SCM_INTERNAL void scm_init_uniform (void);
+
+#endif  /* SCM_UNIFORM_H */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/validate.h b/libguile/validate.h
index 365db3693..8c7946902 100644
--- a/libguile/validate.h
+++ b/libguile/validate.h
@@ -3,21 +3,22 @@
 #ifndef SCM_VALIDATE_H
 #define SCM_VALIDATE_H
 
-/* Copyright (C) 1999,2000,2001, 2002, 2004, 2006, 2007 Free Software Foundation, Inc.
+/* Copyright (C) 1999,2000,2001, 2002, 2004, 2006, 2007, 2009 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 /* Written by Greg J. Badros <gjb@cs.washington.edu>, Dec-1999 */
@@ -150,6 +151,10 @@
     cvar = scm_to_bool (flag); \
   } while (0)
 
+#define SCM_VALIDATE_BYTEVECTOR(_pos, _obj)			\
+  SCM_ASSERT_TYPE (SCM_BYTEVECTOR_P (_obj), (_obj), (_pos),	\
+		   FUNC_NAME, "bytevector")
+
 #define SCM_VALIDATE_CHAR(pos, scm) SCM_MAKE_VALIDATE_MSG (pos, scm, CHARP, "character")
 
 #define SCM_VALIDATE_CHAR_COPY(pos, scm, cvar) \
@@ -378,7 +383,7 @@
 
 #define SCM_VALIDATE_VECTOR_LEN(pos, v, len) \
   do { \
-    SCM_ASSERT (SCM_VECTORP (v) && len == SCM_VECTOR_LENGTH (v), v, pos, FUNC_NAME); \
+    SCM_ASSERT (scm_is_vector (v) && len == scm_c_vector_length (v), v, pos, FUNC_NAME); \
   } while (0)
 
 
diff --git a/libguile/values.c b/libguile/values.c
index e766edba1..81fdcf851 100644
--- a/libguile/values.c
+++ b/libguile/values.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 2000, 2001, 2006, 2008 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 #ifdef HAVE_CONFIG_H
diff --git a/libguile/values.h b/libguile/values.h
index f05ce9f8f..0750aecdc 100644
--- a/libguile/values.h
+++ b/libguile/values.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 2000,2001, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/variable.c b/libguile/variable.c
index 6c39b30ac..a97444c0b 100644
--- a/libguile/variable.c
+++ b/libguile/variable.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1995,1996,1997,1998,2000,2001, 2006, 2008 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/variable.h b/libguile/variable.h
index 3f6398b9c..8faced4ec 100644
--- a/libguile/variable.h
+++ b/libguile/variable.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,2000,2001, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/vectors.c b/libguile/vectors.c
index cc4c04f7b..5e710505a 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1995,1996,1998,1999,2000,2001, 2006, 2008, 2009 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
@@ -29,8 +30,11 @@
 
 #include "libguile/validate.h"
 #include "libguile/vectors.h"
-#include "libguile/unif.h"
-#include "libguile/ramap.h"
+#include "libguile/generalized-vectors.h"
+#include "libguile/arrays.h"
+#include "libguile/bitvectors.h"
+#include "libguile/bytevectors.h"
+#include "libguile/array-map.h"
 #include "libguile/srfi-4.h"
 #include "libguile/strings.h"
 #include "libguile/srfi-13.h"
@@ -606,129 +610,43 @@ SCM_DEFINE (scm_vector_move_right_x, "vector-move-right!", 5, 0, 0,
 }
 #undef FUNC_NAME
 
-
-/* Generalized vectors. */
-
-int
-scm_is_generalized_vector (SCM obj)
-{
-  return (scm_is_vector (obj)
-	  || scm_is_string (obj)
-	  || scm_is_bitvector (obj)
-	  || scm_is_uniform_vector (obj));
-}
-
-SCM_DEFINE (scm_generalized_vector_p, "generalized-vector?", 1, 0, 0,
-	    (SCM obj),
-	    "Return @code{#t} if @var{obj} is a vector, string,\n"
-	    "bitvector, or uniform numeric vector.")
-#define FUNC_NAME s_scm_generalized_vector_p
-{
-  return scm_from_bool (scm_is_generalized_vector (obj));
-}
-#undef FUNC_NAME
-
-void
-scm_generalized_vector_get_handle (SCM vec, scm_t_array_handle *h)
-{
-  scm_array_get_handle (vec, h);
-  if (scm_array_handle_rank (h) != 1)
-    scm_wrong_type_arg_msg (NULL, 0, vec, "vector");
-}
-
-size_t
-scm_c_generalized_vector_length (SCM v)
-{
-  if (scm_is_vector (v))
-    return scm_c_vector_length (v);
-  else if (scm_is_string (v))
-    return scm_c_string_length (v);
-  else if (scm_is_bitvector (v))
-    return scm_c_bitvector_length (v);
-  else if (scm_is_uniform_vector (v))
-    return scm_c_uniform_vector_length (v);
-  else
-    scm_wrong_type_arg_msg (NULL, 0, v, "generalized vector");
-}
-
-SCM_DEFINE (scm_generalized_vector_length, "generalized-vector-length", 1, 0, 0,
-	    (SCM v),
-	    "Return the length of the generalized vector @var{v}.")
-#define FUNC_NAME s_scm_generalized_vector_length
-{
-  return scm_from_size_t (scm_c_generalized_vector_length (v));
-}
-#undef FUNC_NAME
-
-SCM
-scm_c_generalized_vector_ref (SCM v, size_t idx)
-{
-  if (scm_is_vector (v))
-    return scm_c_vector_ref (v, idx);
-  else if (scm_is_string (v))
-    return scm_c_string_ref (v, idx);
-  else if (scm_is_bitvector (v))
-    return scm_c_bitvector_ref (v, idx);
-  else if (scm_is_uniform_vector (v))
-    return scm_c_uniform_vector_ref (v, idx);
-  else
-    scm_wrong_type_arg_msg (NULL, 0, v, "generalized vector");
-}
-
-SCM_DEFINE (scm_generalized_vector_ref, "generalized-vector-ref", 2, 0, 0,
-	    (SCM v, SCM idx),
-	    "Return the element at index @var{idx} of the\n"
-	    "generalized vector @var{v}.")
-#define FUNC_NAME s_scm_generalized_vector_ref
+
+static SCM
+vector_handle_ref (scm_t_array_handle *h, size_t idx)
 {
-  return scm_c_generalized_vector_ref (v, scm_to_size_t (idx));
+  if (idx > h->dims[0].ubnd)
+    scm_out_of_range ("vector-handle-ref", scm_from_size_t (idx));
+  return ((SCM*)h->elements)[idx];
 }
-#undef FUNC_NAME
 
-void
-scm_c_generalized_vector_set_x (SCM v, size_t idx, SCM val)
+static void
+vector_handle_set (scm_t_array_handle *h, size_t idx, SCM val)
 {
-  if (scm_is_vector (v))
-    scm_c_vector_set_x (v, idx, val);
-  else if (scm_is_string (v))
-    scm_c_string_set_x (v, idx, val);
-  else if (scm_is_bitvector (v))
-    scm_c_bitvector_set_x (v, idx, val);
-  else if (scm_is_uniform_vector (v))
-    scm_c_uniform_vector_set_x (v, idx, val);
-  else
-    scm_wrong_type_arg_msg (NULL, 0, v, "generalized vector");
+  if (idx > h->dims[0].ubnd)
+    scm_out_of_range ("vector-handle-set!", scm_from_size_t (idx));
+  ((SCM*)h->writable_elements)[idx] = val;
 }
 
-SCM_DEFINE (scm_generalized_vector_set_x, "generalized-vector-set!", 3, 0, 0,
-	    (SCM v, SCM idx, SCM val),
-	    "Set the element at index @var{idx} of the\n"
-	    "generalized vector @var{v} to @var{val}.")
-#define FUNC_NAME s_scm_generalized_vector_set_x
+static void
+vector_get_handle (SCM v, scm_t_array_handle *h)
 {
-  scm_c_generalized_vector_set_x (v, scm_to_size_t (idx), val);
-  return SCM_UNSPECIFIED;
+  h->array = v;
+  h->ndims = 1;
+  h->dims = &h->dim0;
+  h->dim0.lbnd = 0;
+  h->dim0.ubnd = SCM_I_VECTOR_LENGTH (v) - 1;
+  h->dim0.inc = 1;
+  h->element_type = SCM_ARRAY_ELEMENT_TYPE_SCM;
+  h->elements = h->writable_elements = SCM_I_VECTOR_WELTS (v);
 }
-#undef FUNC_NAME
 
-SCM_DEFINE (scm_generalized_vector_to_list, "generalized-vector->list", 1, 0, 0,
-	    (SCM v),
-	    "Return a new list whose elements are the elements of the\n"
-	    "generalized vector @var{v}.")
-#define FUNC_NAME s_scm_generalized_vector_to_list
-{
-  if (scm_is_vector (v))
-    return scm_vector_to_list (v);
-  else if (scm_is_string (v))
-    return scm_string_to_list (v);
-  else if (scm_is_bitvector (v))
-    return scm_bitvector_to_list (v);
-  else if (scm_is_uniform_vector (v))
-    return scm_uniform_vector_to_list (v);
-  else
-    scm_wrong_type_arg_msg (NULL, 0, v, "generalized vector");
-}
-#undef FUNC_NAME
+SCM_ARRAY_IMPLEMENTATION (scm_tc7_vector, 0x7f & ~2,
+                          vector_handle_ref, vector_handle_set,
+                          vector_get_handle);
+SCM_ARRAY_IMPLEMENTATION (scm_tc7_wvect, 0x7f & ~2,
+                          vector_handle_ref, vector_handle_set,
+                          vector_get_handle);
+SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_SCM, scm_make_vector);
 
 
 void
diff --git a/libguile/vectors.h b/libguile/vectors.h
index 7a508c77b..0e2cb6e8f 100644
--- a/libguile/vectors.h
+++ b/libguile/vectors.h
@@ -6,24 +6,25 @@
 /* Copyright (C) 1995,1996,1998,2000,2001,2002,2004,2005, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
 
 #include "libguile/__scm.h"
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
 
 
 
@@ -60,21 +61,6 @@ SCM_API SCM *scm_vector_writable_elements (SCM vec,
 #define SCM_SIMPLE_VECTOR_REF(x,idx)     ((SCM_I_VECTOR_ELTS(x))[idx])
 #define SCM_SIMPLE_VECTOR_SET(x,idx,val) ((SCM_I_VECTOR_WELTS(x))[idx]=(val))
 
-/* Generalized vectors */
-
-SCM_API SCM scm_generalized_vector_p (SCM v);
-SCM_API SCM scm_generalized_vector_length (SCM v);
-SCM_API SCM scm_generalized_vector_ref (SCM v, SCM idx);
-SCM_API SCM scm_generalized_vector_set_x (SCM v, SCM idx, SCM val);
-SCM_API SCM scm_generalized_vector_to_list (SCM v);
-
-SCM_API int scm_is_generalized_vector (SCM obj);
-SCM_API size_t scm_c_generalized_vector_length (SCM v);
-SCM_API SCM scm_c_generalized_vector_ref (SCM v, size_t idx);
-SCM_API void scm_c_generalized_vector_set_x (SCM v, size_t idx, SCM val);
-SCM_API void scm_generalized_vector_get_handle (SCM vec,
-						scm_t_array_handle *h);
-
 /* Internals */
 
 #define SCM_I_IS_VECTOR(x)     (!SCM_IMP(x) && (SCM_TYP7S(x)==scm_tc7_vector))
diff --git a/libguile/version.c b/libguile/version.c
index 6a665c53d..db1bc9f2e 100644
--- a/libguile/version.c
+++ b/libguile/version.c
@@ -1,18 +1,19 @@
 /*	Copyright (C) 1995,1996, 1999, 2000, 2001, 2006, 2008 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/version.h.in b/libguile/version.h.in
index b565efd96..394bbdb86 100644
--- a/libguile/version.h.in
+++ b/libguile/version.h.in
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,1998,1999,2000,2001, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/vm-bootstrap.h b/libguile/vm-bootstrap.h
new file mode 100644
index 000000000..7ba1a93ba
--- /dev/null
+++ b/libguile/vm-bootstrap.h
@@ -0,0 +1,30 @@
+/* Copyright (C) 2001 Free Software Foundation, Inc.
+ * 
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+#ifndef _SCM_VM_BOOTSTRAP_H_
+#define _SCM_VM_BOOTSTRAP_H_
+
+SCM_INTERNAL void scm_bootstrap_vm (void);
+
+#endif /* _SCM_VM_BOOTSTRAP_H_ */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
new file mode 100644
index 000000000..b373cd017
--- /dev/null
+++ b/libguile/vm-engine.c
@@ -0,0 +1,273 @@
+/* Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+ * 
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+/* This file is included in vm.c multiple times */
+
+#if (VM_ENGINE == SCM_VM_REGULAR_ENGINE)
+#define VM_USE_HOOKS		0	/* Various hooks */
+#define VM_USE_CLOCK		0	/* Bogoclock */
+#define VM_CHECK_OBJECT         1       /* Check object table */
+#define VM_CHECK_FREE_VARIABLES 1       /* Check free variable access */
+#define VM_PUSH_DEBUG_FRAMES    0       /* Push frames onto the evaluator debug stack */
+#elif (VM_ENGINE == SCM_VM_DEBUG_ENGINE)
+#define VM_USE_HOOKS		1
+#define VM_USE_CLOCK		1
+#define VM_CHECK_OBJECT         1
+#define VM_CHECK_FREE_VARIABLES 1
+#define VM_PUSH_DEBUG_FRAMES    1
+#else
+#error unknown debug engine VM_ENGINE
+#endif
+
+#include "vm-engine.h"
+
+
+static SCM
+VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
+{
+  /* VM registers */
+  register scm_t_uint8 *ip IP_REG;	/* instruction pointer */
+  register SCM *sp SP_REG;		/* stack pointer */
+  register SCM *fp FP_REG;		/* frame pointer */
+
+  /* Cache variables */
+  struct scm_objcode *bp = NULL;	/* program base pointer */
+  SCM *free_vars = NULL;                /* free variables */
+  size_t free_vars_count = 0;           /* length of FREE_VARS */
+  SCM *objects = NULL;			/* constant objects */
+  size_t object_count = 0;              /* length of OBJECTS */
+  SCM *stack_base = vp->stack_base;	/* stack base address */
+  SCM *stack_limit = vp->stack_limit;	/* stack limit address */
+
+  /* Internal variables */
+  int nvalues = 0;
+  long start_time = scm_c_get_internal_run_time ();
+  SCM finish_args;                      /* used both for returns: both in error
+                                           and normal situations */
+#if VM_USE_HOOKS
+  SCM hook_args = SCM_EOL;
+#endif
+
+#ifdef HAVE_LABELS_AS_VALUES
+  static void **jump_table = NULL;
+#endif
+  
+#if VM_PUSH_DEBUG_FRAMES
+  scm_t_debug_frame debug;
+  scm_t_debug_info debug_vect_body;
+  debug.status = SCM_VOIDFRAME;
+#endif
+
+#ifdef HAVE_LABELS_AS_VALUES
+  if (SCM_UNLIKELY (!jump_table))
+    {
+      int i;
+      jump_table = malloc (SCM_VM_NUM_INSTRUCTIONS * sizeof(void*));
+      for (i = 0; i < SCM_VM_NUM_INSTRUCTIONS; i++)
+        jump_table[i] = &&vm_error_bad_instruction;
+#define VM_INSTRUCTION_TO_LABEL 1
+#include <libguile/vm-expand.h>
+#include <libguile/vm-i-system.i>
+#include <libguile/vm-i-scheme.i>
+#include <libguile/vm-i-loader.i>
+#undef VM_INSTRUCTION_TO_LABEL
+    }
+#endif
+
+  /* Initialization */
+  {
+    SCM prog = program;
+
+    /* Boot program */
+    program = vm_make_boot_program (nargs);
+
+#if VM_PUSH_DEBUG_FRAMES
+    debug.prev = scm_i_last_debug_frame ();
+    debug.status = SCM_APPLYFRAME;
+    debug.vect = &debug_vect_body;
+    debug.vect[0].a.proc = program; /* the boot program */
+    debug.vect[0].a.args = SCM_EOL;
+    scm_i_set_last_debug_frame (&debug);
+#endif
+
+    /* Initial frame */
+    CACHE_REGISTER ();
+    PUSH ((SCM)fp); /* dynamic link */
+    PUSH (0); /* ra */
+    PUSH (0); /* mvra */
+    CACHE_PROGRAM ();
+    PUSH (program);
+    fp = sp + 1;
+    INIT_FRAME ();
+    /* MV-call frame, function & arguments */
+    PUSH ((SCM)fp); /* dynamic link */
+    PUSH (0); /* ra */
+    PUSH (0); /* mvra */
+    PUSH (prog);
+    if (SCM_UNLIKELY (sp + nargs >= stack_limit))
+      goto vm_error_too_many_args;
+    while (nargs--)
+      PUSH (*argv++);
+  }
+
+  /* Let's go! */
+  BOOT_HOOK ();
+  NEXT;
+
+#ifndef HAVE_LABELS_AS_VALUES
+ vm_start:
+  switch ((*ip++) & SCM_VM_INSTRUCTION_MASK) {
+#endif
+
+#include "vm-expand.h"
+#include "vm-i-system.c"
+#include "vm-i-scheme.c"
+#include "vm-i-loader.c"
+
+#ifndef HAVE_LABELS_AS_VALUES
+  default:
+    goto vm_error_bad_instruction;
+  }
+#endif
+
+  
+ vm_done:
+  SYNC_ALL ();
+#if VM_PUSH_DEBUG_FRAMES
+  scm_i_set_last_debug_frame (debug.prev);
+#endif
+  return finish_args;
+
+  /* Errors */
+  {
+    SCM err_msg;
+
+  vm_error_bad_instruction:
+    err_msg  = scm_from_locale_string ("VM: Bad instruction: ~s");
+    finish_args = scm_list_1 (scm_from_uchar (ip[-1]));
+    goto vm_error;
+
+  vm_error_unbound:
+    err_msg  = scm_from_locale_string ("VM: Unbound variable: ~s");
+    goto vm_error;
+
+  vm_error_wrong_type_arg:
+    err_msg  = scm_from_locale_string ("VM: Wrong type argument");
+    finish_args = SCM_EOL;
+    goto vm_error;
+
+  vm_error_too_many_args:
+    err_msg  = scm_from_locale_string ("VM: Too many arguments");
+    finish_args = scm_list_1 (scm_from_int (nargs));
+    goto vm_error;
+
+  vm_error_wrong_num_args:
+    /* nargs and program are valid */
+    SYNC_ALL ();
+    scm_wrong_num_args (program);
+    /* shouldn't get here */
+    goto vm_error;
+
+  vm_error_wrong_type_apply:
+    SYNC_ALL ();
+    scm_error (scm_misc_error_key, FUNC_NAME, "Wrong type to apply: ~S",
+               scm_list_1 (program), SCM_BOOL_F);
+    goto vm_error;
+
+  vm_error_stack_overflow:
+    err_msg  = scm_from_locale_string ("VM: Stack overflow");
+    finish_args = SCM_EOL;
+    goto vm_error;
+
+  vm_error_stack_underflow:
+    err_msg  = scm_from_locale_string ("VM: Stack underflow");
+    finish_args = SCM_EOL;
+    goto vm_error;
+
+  vm_error_improper_list:
+    err_msg  = scm_from_locale_string ("Expected a proper list, but got object with tail ~s");
+    goto vm_error;
+
+  vm_error_not_a_pair:
+    SYNC_ALL ();
+    scm_wrong_type_arg_msg (FUNC_NAME, 1, finish_args, "pair");
+    /* shouldn't get here */
+    goto vm_error;
+
+  vm_error_not_a_bytevector:
+    SYNC_ALL ();
+    scm_wrong_type_arg_msg (FUNC_NAME, 1, finish_args, "bytevector");
+    /* shouldn't get here */
+    goto vm_error;
+
+  vm_error_no_values:
+    err_msg  = scm_from_locale_string ("Zero values returned to single-valued continuation");
+    finish_args = SCM_EOL;
+    goto vm_error;
+
+  vm_error_not_enough_values:
+    err_msg  = scm_from_locale_string ("Too few values returned to continuation");
+    finish_args = SCM_EOL;
+    goto vm_error;
+
+  vm_error_bad_wide_string_length:
+    err_msg  = scm_from_locale_string ("VM: Bad wide string length: ~S");
+    goto vm_error;
+
+#if VM_CHECK_IP
+  vm_error_invalid_address:
+    err_msg  = scm_from_locale_string ("VM: Invalid program address");
+    finish_args = SCM_EOL;
+    goto vm_error;
+#endif
+
+#if VM_CHECK_OBJECT
+  vm_error_object:
+    err_msg = scm_from_locale_string ("VM: Invalid object table access");
+    finish_args = SCM_EOL;
+    goto vm_error;
+#endif
+
+#if VM_CHECK_FREE_VARIABLES
+  vm_error_free_variable:
+    err_msg = scm_from_locale_string ("VM: Invalid free variable access");
+    finish_args = SCM_EOL;
+    goto vm_error;
+#endif
+
+  vm_error:
+    SYNC_ALL ();
+
+    scm_ithrow (sym_vm_error, scm_list_3 (sym_vm_run, err_msg, finish_args),
+		1);
+  }
+
+  abort (); /* never reached */
+}
+
+#undef VM_USE_HOOKS
+#undef VM_USE_CLOCK
+#undef VM_CHECK_OBJECT
+#undef VM_CHECK_FREE_VARIABLE
+#undef VM_PUSH_DEBUG_FRAMES
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/vm-engine.h b/libguile/vm-engine.h
new file mode 100644
index 000000000..3c1bbf681
--- /dev/null
+++ b/libguile/vm-engine.h
@@ -0,0 +1,416 @@
+/* Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+ * 
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+/* This file is included in vm_engine.c */
+
+
+/*
+ * Registers
+ */
+
+/* Register optimization. [ stolen from librep/src/lispmach.h,v 1.3 ]
+
+   Some compilers underestimate the use of the local variables representing
+   the abstract machine registers, and don't put them in hardware registers,
+   which slows down the interpreter considerably.
+   For GCC, I have hand-assigned hardware registers for several architectures.
+*/
+
+#ifdef __GNUC__
+#ifdef __mips__
+#define IP_REG asm("$16")
+#define SP_REG asm("$17")
+#define FP_REG asm("$18")
+#endif
+#ifdef __sparc__
+#define IP_REG asm("%l0")
+#define SP_REG asm("%l1")
+#define FP_REG asm("%l2")
+#endif
+#ifdef __alpha__
+#ifdef __CRAY__
+#define IP_REG asm("r9")
+#define SP_REG asm("r10")
+#define FP_REG asm("r11")
+#else
+#define IP_REG asm("$9")
+#define SP_REG asm("$10")
+#define FP_REG asm("$11")
+#endif
+#endif
+#ifdef __i386__
+/* too few registers! because of register allocation errors with various gcs,
+   just punt on explicit assignments on i386, hoping that the "register"
+   declaration will be sufficient. */
+#endif
+#if defined(PPC) || defined(_POWER) || defined(_IBMR2)
+#define IP_REG asm("26")
+#define SP_REG asm("27")
+#define FP_REG asm("28")
+#endif
+#ifdef __hppa__
+#define IP_REG asm("%r18")
+#define SP_REG asm("%r17")
+#define FP_REG asm("%r16")
+#endif
+#ifdef __mc68000__
+#define IP_REG asm("a5")
+#define SP_REG asm("a4")
+#define FP_REG
+#endif
+#ifdef __arm__
+#define IP_REG asm("r9")
+#define SP_REG asm("r8")
+#define FP_REG asm("r7")
+#endif
+#endif
+
+#ifndef IP_REG
+#define IP_REG
+#endif
+#ifndef SP_REG
+#define SP_REG
+#endif
+#ifndef FP_REG
+#define FP_REG
+#endif
+
+
+/*
+ * Cache/Sync
+ */
+
+#ifdef VM_ENABLE_ASSERTIONS
+# define ASSERT(condition) if (SCM_UNLIKELY (!(condition))) abort()
+#else
+# define ASSERT(condition)
+#endif
+
+
+#define CACHE_REGISTER()			\
+{						\
+  ip = vp->ip;					\
+  sp = vp->sp;					\
+  fp = vp->fp;					\
+  stack_base = fp ? SCM_FRAME_UPPER_ADDRESS (fp) - 1 : vp->stack_base; \
+}
+
+#define SYNC_REGISTER()				\
+{						\
+  vp->ip = ip;					\
+  vp->sp = sp;					\
+  vp->fp = fp;					\
+}
+
+/* FIXME */
+#define ASSERT_VARIABLE(x)                                              \
+  do { if (!SCM_VARIABLEP (x)) { SYNC_REGISTER (); abort(); }           \
+  } while (0)
+#define ASSERT_BOUND_VARIABLE(x)                                        \
+  do { ASSERT_VARIABLE (x);                                             \
+    if (SCM_VARIABLE_REF (x) == SCM_UNDEFINED)                          \
+      { SYNC_REGISTER (); abort(); }                                    \
+  } while (0)
+
+#ifdef VM_ENABLE_PARANOID_ASSERTIONS
+#define CHECK_IP() \
+  do { if (ip < bp->base || ip - bp->base > bp->len) abort (); } while (0)
+#define ASSERT_ALIGNED_PROCEDURE() \
+  do { if ((scm_t_bits)bp % 8) abort (); } while (0)
+#define ASSERT_BOUND(x) \
+  do { if ((x) == SCM_UNDEFINED) { SYNC_REGISTER (); abort(); } \
+  } while (0)
+#else
+#define CHECK_IP()
+#define ASSERT_ALIGNED_PROCEDURE()
+#define ASSERT_BOUND(x)
+#endif
+
+/* Cache the object table and free variables.  */
+#define CACHE_PROGRAM()							\
+{									\
+  if (bp != SCM_PROGRAM_DATA (program)) {                               \
+    bp = SCM_PROGRAM_DATA (program);					\
+    ASSERT_ALIGNED_PROCEDURE ();                                        \
+    if (SCM_I_IS_VECTOR (SCM_PROGRAM_OBJTABLE (program))) {             \
+      objects = SCM_I_VECTOR_WELTS (SCM_PROGRAM_OBJTABLE (program));    \
+      object_count = SCM_I_VECTOR_LENGTH (SCM_PROGRAM_OBJTABLE (program)); \
+    } else {                                                            \
+      objects = NULL;                                                   \
+      object_count = 0;                                                 \
+    }                                                                   \
+  }                                                                     \
+  {                                                                     \
+    SCM c = SCM_PROGRAM_FREE_VARIABLES (program);                       \
+    if (SCM_I_IS_VECTOR (c))                                            \
+      {                                                                 \
+        free_vars = SCM_I_VECTOR_WELTS (c);                             \
+        free_vars_count = SCM_I_VECTOR_LENGTH (c);                      \
+      }                                                                 \
+    else                                                                \
+      {                                                                 \
+        free_vars = NULL;                                               \
+        free_vars_count = 0;                                            \
+      }                                                                 \
+  }                                                                     \
+}
+
+#define SYNC_BEFORE_GC()			\
+{						\
+  SYNC_REGISTER ();				\
+}
+
+#define SYNC_ALL()				\
+{						\
+  SYNC_REGISTER ();				\
+}
+
+
+/*
+ * Error check
+ */
+
+/* Accesses to a program's object table.  */
+#if VM_CHECK_OBJECT
+#define CHECK_OBJECT(_num) \
+  do { if (SCM_UNLIKELY ((_num) >= object_count)) goto vm_error_object; } while (0)
+#else
+#define CHECK_OBJECT(_num)
+#endif
+
+#if VM_CHECK_FREE_VARIABLES
+#define CHECK_FREE_VARIABLE(_num) \
+  do { if (SCM_UNLIKELY ((_num) >= free_vars_count)) goto vm_error_free_variable; } while (0)
+#else
+#define CHECK_FREE_VARIABLE(_num)
+#endif
+
+
+/*
+ * Hooks
+ */
+
+#undef RUN_HOOK
+#if VM_USE_HOOKS
+#define RUN_HOOK(h)				\
+{						\
+  if (SCM_UNLIKELY (!SCM_FALSEP (vp->hooks[h])))\
+    {						\
+      SYNC_REGISTER ();				\
+      vm_dispatch_hook (vp, vp->hooks[h], hook_args);      \
+      CACHE_REGISTER ();			\
+    }						\
+}
+#else
+#define RUN_HOOK(h)
+#endif
+
+#define BOOT_HOOK()	RUN_HOOK (SCM_VM_BOOT_HOOK)
+#define HALT_HOOK()	RUN_HOOK (SCM_VM_HALT_HOOK)
+#define NEXT_HOOK()	RUN_HOOK (SCM_VM_NEXT_HOOK)
+#define BREAK_HOOK()	RUN_HOOK (SCM_VM_BREAK_HOOK)
+#define ENTER_HOOK()	RUN_HOOK (SCM_VM_ENTER_HOOK)
+#define APPLY_HOOK()	RUN_HOOK (SCM_VM_APPLY_HOOK)
+#define EXIT_HOOK()	RUN_HOOK (SCM_VM_EXIT_HOOK)
+#define RETURN_HOOK()	RUN_HOOK (SCM_VM_RETURN_HOOK)
+
+
+/*
+ * Stack operation
+ */
+
+#ifdef VM_ENABLE_STACK_NULLING
+# define CHECK_STACK_LEAKN(_n) ASSERT (!sp[_n]);
+# define CHECK_STACK_LEAK() CHECK_STACK_LEAKN(1)
+# define NULLSTACK(_n) { int __x = _n; CHECK_STACK_LEAKN (_n+1); while (__x > 0) sp[__x--] = NULL; }
+/* If you have a nonlocal exit in a pre-wind proc while invoking a continuation
+   inside a dynwind (phew!), the stack is fully rewound but vm_reset_stack for
+   that continuation doesn't have a chance to run. It's not important on a
+   semantic level, but it does mess up our stack nulling -- so this macro is to
+   fix that. */
+# define NULLSTACK_FOR_NONLOCAL_EXIT() if (vp->sp > sp) NULLSTACK (vp->sp - sp);
+#else
+# define CHECK_STACK_LEAKN(_n)
+# define CHECK_STACK_LEAK()
+# define NULLSTACK(_n)
+# define NULLSTACK_FOR_NONLOCAL_EXIT()
+#endif
+
+#define CHECK_OVERFLOW()			\
+  if (sp >= stack_limit)			\
+    goto vm_error_stack_overflow
+
+#define CHECK_UNDERFLOW()                       \
+  if (sp < stack_base)                          \
+    goto vm_error_stack_underflow;
+
+#define PUSH(x)	do { sp++; CHECK_OVERFLOW (); *sp = x; } while (0)
+#define DROP()	do { sp--; CHECK_UNDERFLOW (); NULLSTACK (1); } while (0)
+#define DROPN(_n)	do { sp -= (_n); CHECK_UNDERFLOW (); NULLSTACK (_n); } while (0)
+#define POP(x)	do { x = *sp; DROP (); } while (0)
+
+/* A fast CONS.  This has to be fast since its used, for instance, by
+   POP_LIST when fetching a function's argument list.  Note: `scm_cell' is an
+   inlined function in Guile 1.7.  Unfortunately, it calls
+   `scm_gc_for_newcell ()' which is _not_ inlined and allocated cells on the
+   heap.  XXX  */
+#define CONS(x,y,z)					\
+{							\
+  SYNC_BEFORE_GC ();					\
+  x = scm_cell (SCM_UNPACK (y), SCM_UNPACK (z));	\
+}
+
+/* Pop the N objects on top of the stack and push a list that contains
+   them.  */
+#define POP_LIST(n)				\
+do						\
+{						\
+  int i;					\
+  SCM l = SCM_EOL, x;				\
+  for (i = n; i; i--)                           \
+    {                                           \
+      POP (x);                                  \
+      CONS (l, x, l);                           \
+    }                                           \
+  PUSH (l);					\
+} while (0)
+
+/* The opposite: push all of the elements in L onto the list. */
+#define PUSH_LIST(l, NILP)			\
+do						\
+{						\
+  for (; scm_is_pair (l); l = SCM_CDR (l))      \
+    PUSH (SCM_CAR (l));                         \
+  if (SCM_UNLIKELY (!NILP (l))) {               \
+    finish_args = scm_list_1 (l);               \
+    goto vm_error_improper_list;                \
+  }                                             \
+} while (0)
+
+
+#define POP_LIST_MARK()				\
+do {						\
+  SCM o;					\
+  SCM l = SCM_EOL;				\
+  POP (o);					\
+  while (!SCM_UNBNDP (o))			\
+    {						\
+      CONS (l, o, l);				\
+      POP (o);					\
+    }						\
+  PUSH (l);					\
+} while (0)
+
+#define POP_CONS_MARK()				\
+do {						\
+  SCM o, l;					\
+  POP (l);                                      \
+  POP (o);					\
+  while (!SCM_UNBNDP (o))			\
+    {						\
+      CONS (l, o, l);				\
+      POP (o);					\
+    }						\
+  PUSH (l);					\
+} while (0)
+
+
+/*
+ * Instruction operation
+ */
+
+#define FETCH()		(*ip++)
+#define FETCH_LENGTH(len) do { len=*ip++; len<<=8; len+=*ip++; len<<=8; len+=*ip++; } while (0)
+#define FETCH_WIDTH(width) do { width=*ip++; } while (0)
+
+#undef CLOCK
+#if VM_USE_CLOCK
+#define CLOCK(n)	vp->clock += n
+#else
+#define CLOCK(n)
+#endif
+
+#undef NEXT_JUMP
+#ifdef HAVE_LABELS_AS_VALUES
+#define NEXT_JUMP()		goto *jump_table[FETCH () & SCM_VM_INSTRUCTION_MASK]
+#else
+#define NEXT_JUMP()		goto vm_start
+#endif
+
+#define NEXT					\
+{						\
+  CLOCK (1);					\
+  NEXT_HOOK ();					\
+  CHECK_STACK_LEAK ();                          \
+  NEXT_JUMP ();					\
+}
+
+
+/*
+ * Stack frame
+ */
+
+#define INIT_ARGS()				\
+{						\
+  if (SCM_UNLIKELY (bp->nrest))                 \
+    {						\
+      int n = nargs - (bp->nargs - 1);		\
+      if (n < 0)				\
+	goto vm_error_wrong_num_args;		\
+      /* NB, can cause GC while setting up the  \
+         stack frame */                         \
+      POP_LIST (n);				\
+    }						\
+  else						\
+    {						\
+      if (SCM_UNLIKELY (nargs != bp->nargs))    \
+	goto vm_error_wrong_num_args;		\
+    }						\
+}
+
+/* See frames.h for the layout of stack frames */
+/* When this is called, bp points to the new program data,
+   and the arguments are already on the stack */
+#define INIT_FRAME()				\
+{						\
+  int i;					\
+						\
+  /* New registers */                           \
+  sp += bp->nlocs;                              \
+  CHECK_OVERFLOW ();				\
+  stack_base = sp;				\
+  ip = bp->base;				\
+						\
+  /* Init local variables */			\
+  for (i=bp->nlocs; i;)                         \
+    sp[-(--i)] = SCM_UNDEFINED;                 \
+}
+
+#define DROP_FRAME()                            \
+  {                                             \
+    sp -= 3;                                    \
+    NULLSTACK (3);                              \
+    CHECK_UNDERFLOW ();                         \
+  }
+    
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/vm-expand.h b/libguile/vm-expand.h
new file mode 100644
index 000000000..787223d07
--- /dev/null
+++ b/libguile/vm-expand.h
@@ -0,0 +1,79 @@
+/* Copyright (C) 2001 Free Software Foundation, Inc.
+ * 
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+#ifndef VM_LABEL
+#define VM_LABEL(tag) l_##tag
+#define VM_OPCODE(tag) scm_op_##tag
+
+#ifdef HAVE_LABELS_AS_VALUES
+#define VM_TAG(tag) VM_LABEL(tag):
+#define VM_ADDR(tag) &&VM_LABEL(tag)
+#else /* not HAVE_LABELS_AS_VALUES */
+#define VM_TAG(tag) case VM_OPCODE(tag):
+#define VM_ADDR(tag) NULL
+#endif /* not HAVE_LABELS_AS_VALUES */
+#endif /* VM_LABEL */
+
+#undef VM_DEFINE_FUNCTION
+#undef VM_DEFINE_LOADER
+#define VM_DEFINE_FUNCTION(code,tag,name,nargs) \
+  VM_DEFINE_INSTRUCTION(code,tag,name,0,nargs,1)
+#define VM_DEFINE_LOADER(code,tag,name)         \
+  VM_DEFINE_INSTRUCTION(code,tag,name,-1,0,1)
+
+#undef VM_DEFINE_INSTRUCTION
+/*
+ * These will go to scm_instruction_table in instructions.c
+ */
+#ifdef VM_INSTRUCTION_TO_TABLE
+#define VM_DEFINE_INSTRUCTION(code_,tag_,name_,len_,npop_,npush_) \
+  table[VM_OPCODE (tag_)].opcode = code_;                          \
+  table[VM_OPCODE (tag_)].name = name_;                            \
+  table[VM_OPCODE (tag_)].len = len_;                              \
+  table[VM_OPCODE (tag_)].npop = npop_;                            \
+  table[VM_OPCODE (tag_)].npush = npush_;
+
+#else
+#ifdef VM_INSTRUCTION_TO_LABEL
+/*
+ * These will go to jump_table in vm_engine.c
+ */
+#define VM_DEFINE_INSTRUCTION(code,tag,name,len,npop,npush)	jump_table[code] = VM_ADDR (tag);
+
+#else
+#ifdef VM_INSTRUCTION_TO_OPCODE
+/*
+ * These will go to scm_opcode in instructions.h
+ */
+#define VM_DEFINE_INSTRUCTION(code,tag,name,len,npop,npush)	VM_OPCODE (tag) = code,
+
+#else /* Otherwise */
+/*
+ * These are directly included in vm_engine.c
+ */
+#define VM_DEFINE_INSTRUCTION(code,tag,name,len,npop,npush)	VM_TAG (tag)
+
+#endif /* VM_INSTRUCTION_TO_OPCODE */
+#endif /* VM_INSTRUCTION_TO_LABEL */
+#endif /* VM_INSTRUCTION_TO_TABLE */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/vm-i-loader.c b/libguile/vm-i-loader.c
new file mode 100644
index 000000000..e242ef9bf
--- /dev/null
+++ b/libguile/vm-i-loader.c
@@ -0,0 +1,137 @@
+/* Copyright (C) 2001,2008,2009 Free Software Foundation, Inc.
+ * 
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+/* FIXME! Need to check that the fetch is within the current program */
+
+/* This file is included in vm_engine.c */
+
+VM_DEFINE_LOADER (82, load_number, "load-number")
+{
+  size_t len;
+
+  FETCH_LENGTH (len);
+  SYNC_REGISTER ();
+  PUSH (scm_string_to_number (scm_from_locale_stringn ((char *)ip, len),
+			      SCM_UNDEFINED /* radix = 10 */));
+  /* Was: scm_istring2number (ip, len, 10)); */
+  ip += len;
+  NEXT;
+}
+
+VM_DEFINE_LOADER (83, load_string, "load-string")
+{
+  size_t len;
+  char *buf;
+
+  FETCH_LENGTH (len);
+  SYNC_REGISTER ();
+  PUSH (scm_i_make_string (len, &buf));
+  memcpy (buf, (char *) ip, len);
+  ip += len;
+  NEXT;
+}
+
+VM_DEFINE_LOADER (84, load_symbol, "load-symbol")
+{
+  size_t len;
+  FETCH_LENGTH (len);
+  SYNC_REGISTER ();
+  /* FIXME: should be scm_from_latin1_symboln */
+  PUSH (scm_from_locale_symboln ((const char*)ip, len));
+  ip += len;
+  NEXT;
+}
+
+VM_DEFINE_LOADER (86, load_program, "load-program")
+{
+  scm_t_uint32 len;
+  SCM objs, objcode;
+
+  POP (objs);
+  SYNC_REGISTER ();
+
+  if (scm_is_vector (objs) && scm_is_false (scm_c_vector_ref (objs, 0)))
+    scm_c_vector_set_x (objs, 0, scm_current_module ());
+
+  objcode = scm_c_make_objcode_slice (SCM_PROGRAM_OBJCODE (fp[-1]), ip);
+  len = sizeof (struct scm_objcode) + SCM_OBJCODE_TOTAL_LEN (objcode);
+
+  PUSH (scm_make_program (objcode, objs, SCM_BOOL_F));
+
+  ip += len;
+
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (87, link_now, "link-now", 0, 1, 1)
+{
+  SCM what;
+  POP (what);
+  SYNC_REGISTER ();
+  PUSH (resolve_variable (what, scm_current_module ()));
+  NEXT;
+}
+
+VM_DEFINE_LOADER (89, load_array, "load-array")
+{
+  SCM type, shape;
+  size_t len;
+  FETCH_LENGTH (len);
+  POP (shape);
+  POP (type);
+  SYNC_REGISTER ();
+  PUSH (scm_from_contiguous_typed_array (type, shape, ip, len));
+  ip += len;
+  NEXT;
+}
+
+VM_DEFINE_LOADER (90, load_wide_string, "load-wide-string")
+{
+  size_t len;
+  scm_t_wchar *wbuf;
+
+  FETCH_LENGTH (len);
+  if (SCM_UNLIKELY (len % 4))
+    { finish_args = scm_list_1 (scm_from_size_t (len));
+      goto vm_error_bad_wide_string_length;
+    }
+
+  SYNC_REGISTER ();
+  PUSH (scm_i_make_wide_string (len / 4, &wbuf));
+  memcpy ((char *) wbuf, (char *) ip, len);
+  ip += len;
+  NEXT;
+}
+
+/*
+(defun renumber-ops ()
+  "start from top of buffer and renumber 'VM_DEFINE_FOO (\n' sequences"
+  (interactive "")
+  (save-excursion
+    (let ((counter 79)) (goto-char (point-min))
+      (while (re-search-forward "^VM_DEFINE_[^ ]+ (\\([^,]+\\)," (point-max) t)
+        (replace-match
+         (number-to-string (setq counter (1+ counter)))
+          t t nil 1)))))
+*/
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/vm-i-scheme.c b/libguile/vm-i-scheme.c
new file mode 100644
index 000000000..0cace147d
--- /dev/null
+++ b/libguile/vm-i-scheme.c
@@ -0,0 +1,577 @@
+/* Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+ * 
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+/* This file is included in vm_engine.c */
+
+
+/*
+ * Predicates
+ */
+
+#define ARGS1(a1)	SCM a1 = sp[0];
+#define ARGS2(a1,a2)	SCM a1 = sp[-1], a2 = sp[0]; sp--; NULLSTACK (1);
+#define ARGS3(a1,a2,a3)	SCM a1 = sp[-2], a2 = sp[-1], a3 = sp[0]; sp -= 2; NULLSTACK (2);
+
+#define RETURN(x)	do { *sp = x; NEXT; } while (0)
+
+VM_DEFINE_FUNCTION (100, not, "not", 1)
+{
+  ARGS1 (x);
+  RETURN (SCM_BOOL (SCM_FALSEP (x)));
+}
+
+VM_DEFINE_FUNCTION (101, not_not, "not-not", 1)
+{
+  ARGS1 (x);
+  RETURN (SCM_BOOL (!SCM_FALSEP (x)));
+}
+
+VM_DEFINE_FUNCTION (102, eq, "eq?", 2)
+{
+  ARGS2 (x, y);
+  RETURN (SCM_BOOL (SCM_EQ_P (x, y)));
+}
+
+VM_DEFINE_FUNCTION (103, not_eq, "not-eq?", 2)
+{
+  ARGS2 (x, y);
+  RETURN (SCM_BOOL (!SCM_EQ_P (x, y)));
+}
+
+VM_DEFINE_FUNCTION (104, nullp, "null?", 1)
+{
+  ARGS1 (x);
+  RETURN (SCM_BOOL (SCM_NULLP (x)));
+}
+
+VM_DEFINE_FUNCTION (105, not_nullp, "not-null?", 1)
+{
+  ARGS1 (x);
+  RETURN (SCM_BOOL (!SCM_NULLP (x)));
+}
+
+VM_DEFINE_FUNCTION (106, eqv, "eqv?", 2)
+{
+  ARGS2 (x, y);
+  if (SCM_EQ_P (x, y))
+    RETURN (SCM_BOOL_T);
+  if (SCM_IMP (x) || SCM_IMP (y))
+    RETURN (SCM_BOOL_F);
+  SYNC_REGISTER ();
+  RETURN (scm_eqv_p (x, y));
+}
+
+VM_DEFINE_FUNCTION (107, equal, "equal?", 2)
+{
+  ARGS2 (x, y);
+  if (SCM_EQ_P (x, y))
+    RETURN (SCM_BOOL_T);
+  if (SCM_IMP (x) || SCM_IMP (y))
+    RETURN (SCM_BOOL_F);
+  SYNC_REGISTER ();
+  RETURN (scm_equal_p (x, y));
+}
+
+VM_DEFINE_FUNCTION (108, pairp, "pair?", 1)
+{
+  ARGS1 (x);
+  RETURN (SCM_BOOL (SCM_CONSP (x)));
+}
+
+VM_DEFINE_FUNCTION (109, listp, "list?", 1)
+{
+  ARGS1 (x);
+  RETURN (SCM_BOOL (scm_ilength (x) >= 0));
+}
+
+
+/*
+ * Basic data
+ */
+
+VM_DEFINE_FUNCTION (110, cons, "cons", 2)
+{
+  ARGS2 (x, y);
+  CONS (x, x, y);
+  RETURN (x);
+}
+
+#define VM_VALIDATE_CONS(x)                     \
+  if (SCM_UNLIKELY (!scm_is_pair (x)))          \
+    { finish_args = x;                          \
+      goto vm_error_not_a_pair;                 \
+    }
+  
+VM_DEFINE_FUNCTION (111, car, "car", 1)
+{
+  ARGS1 (x);
+  VM_VALIDATE_CONS (x);
+  RETURN (SCM_CAR (x));
+}
+
+VM_DEFINE_FUNCTION (112, cdr, "cdr", 1)
+{
+  ARGS1 (x);
+  VM_VALIDATE_CONS (x);
+  RETURN (SCM_CDR (x));
+}
+
+VM_DEFINE_INSTRUCTION (113, set_car, "set-car!", 0, 2, 0)
+{
+  SCM x, y;
+  POP (y);
+  POP (x);
+  VM_VALIDATE_CONS (x);
+  SCM_SETCAR (x, y);
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (114, set_cdr, "set-cdr!", 0, 2, 0)
+{
+  SCM x, y;
+  POP (y);
+  POP (x);
+  VM_VALIDATE_CONS (x);
+  SCM_SETCDR (x, y);
+  NEXT;
+}
+
+
+/*
+ * Numeric relational tests
+ */
+
+#undef REL
+#define REL(crel,srel)						\
+{								\
+  ARGS2 (x, y);							\
+  if (SCM_I_INUMP (x) && SCM_I_INUMP (y))			\
+    RETURN (SCM_BOOL (SCM_I_INUM (x) crel SCM_I_INUM (y)));	\
+  SYNC_REGISTER ();                                             \
+  RETURN (srel (x, y));                                         \
+}
+
+VM_DEFINE_FUNCTION (115, ee, "ee?", 2)
+{
+  REL (==, scm_num_eq_p);
+}
+
+VM_DEFINE_FUNCTION (116, lt, "lt?", 2)
+{
+  REL (<, scm_less_p);
+}
+
+VM_DEFINE_FUNCTION (117, le, "le?", 2)
+{
+  REL (<=, scm_leq_p);
+}
+
+VM_DEFINE_FUNCTION (118, gt, "gt?", 2)
+{
+  REL (>, scm_gr_p);
+}
+
+VM_DEFINE_FUNCTION (119, ge, "ge?", 2)
+{
+  REL (>=, scm_geq_p);
+}
+
+
+/*
+ * Numeric functions
+ */
+
+#undef FUNC2
+#define FUNC2(CFUNC,SFUNC)				\
+{							\
+  ARGS2 (x, y);						\
+  if (SCM_I_INUMP (x) && SCM_I_INUMP (y))		\
+    {							\
+      scm_t_int64 n = SCM_I_INUM (x) CFUNC SCM_I_INUM (y);\
+      if (SCM_FIXABLE (n))				\
+	RETURN (SCM_I_MAKINUM (n));			\
+    }							\
+  SYNC_REGISTER ();					\
+  RETURN (SFUNC (x, y));				\
+}
+
+VM_DEFINE_FUNCTION (120, add, "add", 2)
+{
+  FUNC2 (+, scm_sum);
+}
+
+VM_DEFINE_FUNCTION (167, add1, "add1", 1)
+{
+  ARGS1 (x);
+  if (SCM_I_INUMP (x))
+    {
+      scm_t_int64 n = SCM_I_INUM (x) + 1;
+      if (SCM_FIXABLE (n))
+	RETURN (SCM_I_MAKINUM (n));
+    }
+  SYNC_REGISTER ();
+  RETURN (scm_sum (x, SCM_I_MAKINUM (1)));
+}
+
+VM_DEFINE_FUNCTION (121, sub, "sub", 2)
+{
+  FUNC2 (-, scm_difference);
+}
+
+VM_DEFINE_FUNCTION (168, sub1, "sub1", 1)
+{
+  ARGS1 (x);
+  if (SCM_I_INUMP (x))
+    {
+      scm_t_int64 n = SCM_I_INUM (x) - 1;
+      if (SCM_FIXABLE (n))
+	RETURN (SCM_I_MAKINUM (n));
+    }
+  SYNC_REGISTER ();
+  RETURN (scm_difference (x, SCM_I_MAKINUM (1)));
+}
+
+VM_DEFINE_FUNCTION (122, mul, "mul", 2)
+{
+  ARGS2 (x, y);
+  SYNC_REGISTER ();
+  RETURN (scm_product (x, y));
+}
+
+VM_DEFINE_FUNCTION (123, div, "div", 2)
+{
+  ARGS2 (x, y);
+  SYNC_REGISTER ();
+  RETURN (scm_divide (x, y));
+}
+
+VM_DEFINE_FUNCTION (124, quo, "quo", 2)
+{
+  ARGS2 (x, y);
+  SYNC_REGISTER ();
+  RETURN (scm_quotient (x, y));
+}
+
+VM_DEFINE_FUNCTION (125, rem, "rem", 2)
+{
+  ARGS2 (x, y);
+  SYNC_REGISTER ();
+  RETURN (scm_remainder (x, y));
+}
+
+VM_DEFINE_FUNCTION (126, mod, "mod", 2)
+{
+  ARGS2 (x, y);
+  SYNC_REGISTER ();
+  RETURN (scm_modulo (x, y));
+}
+
+
+/*
+ * GOOPS support
+ */
+VM_DEFINE_FUNCTION (127, slot_ref, "slot-ref", 2)
+{
+  size_t slot;
+  ARGS2 (instance, idx);
+  slot = SCM_I_INUM (idx);
+  RETURN (SCM_PACK (SCM_STRUCT_DATA (instance) [slot]));
+}
+
+VM_DEFINE_INSTRUCTION (128, slot_set, "slot-set", 0, 3, 0)
+{
+  SCM instance, idx, val;
+  size_t slot;
+  POP (val);
+  POP (idx);
+  POP (instance);
+  slot = SCM_I_INUM (idx);
+  SCM_STRUCT_DATA (instance) [slot] = SCM_UNPACK (val);
+  NEXT;
+}
+
+VM_DEFINE_FUNCTION (129, vector_ref, "vector-ref", 2)
+{
+  long i = 0;
+  ARGS2 (vect, idx);
+  if (SCM_LIKELY (SCM_I_IS_VECTOR (vect)
+                  && SCM_I_INUMP (idx)
+                  && ((i = SCM_I_INUM (idx)) >= 0)
+                  && i < SCM_I_VECTOR_LENGTH (vect)))
+    RETURN (SCM_I_VECTOR_ELTS (vect)[i]);
+  else
+    {
+      SYNC_REGISTER ();
+      RETURN (scm_vector_ref (vect, idx));
+    }
+}
+
+VM_DEFINE_INSTRUCTION (130, vector_set, "vector-set", 0, 3, 0)
+{
+  long i = 0;
+  SCM vect, idx, val;
+  POP (val); POP (idx); POP (vect);
+  if (SCM_LIKELY (SCM_I_IS_VECTOR (vect)
+                  && SCM_I_INUMP (idx)
+                  && ((i = SCM_I_INUM (idx)) >= 0)
+                  && i < SCM_I_VECTOR_LENGTH (vect)))
+    SCM_I_VECTOR_WELTS (vect)[i] = val;
+  else
+    {
+      SYNC_REGISTER ();
+      scm_vector_set_x (vect, idx, val);
+    }
+  NEXT;
+}
+
+#define VM_VALIDATE_BYTEVECTOR(x)               \
+  if (SCM_UNLIKELY (!SCM_BYTEVECTOR_P (x)))     \
+    { finish_args = x;                          \
+      goto vm_error_not_a_bytevector;           \
+    }
+
+#define BV_REF_WITH_ENDIANNESS(stem, fn_stem)                           \
+{                                                                       \
+  SCM endianness;                                                       \
+  POP (endianness);                                                     \
+  if (scm_is_eq (endianness, scm_i_native_endianness))                  \
+    goto VM_LABEL (bv_##stem##_native_ref);                             \
+  {                                                                     \
+    ARGS2 (bv, idx);                                                    \
+    RETURN (scm_bytevector_##fn_stem##_ref (bv, idx, endianness));      \
+  }                                                                     \
+}
+
+VM_DEFINE_FUNCTION (131, bv_u16_ref, "bv-u16-ref", 3)
+BV_REF_WITH_ENDIANNESS (u16, u16)
+VM_DEFINE_FUNCTION (132, bv_s16_ref, "bv-s16-ref", 3)
+BV_REF_WITH_ENDIANNESS (s16, s16)
+VM_DEFINE_FUNCTION (133, bv_u32_ref, "bv-u32-ref", 3)
+BV_REF_WITH_ENDIANNESS (u32, u32)
+VM_DEFINE_FUNCTION (134, bv_s32_ref, "bv-s32-ref", 3)
+BV_REF_WITH_ENDIANNESS (s32, s32)
+VM_DEFINE_FUNCTION (135, bv_u64_ref, "bv-u64-ref", 3)
+BV_REF_WITH_ENDIANNESS (u64, u64)
+VM_DEFINE_FUNCTION (136, bv_s64_ref, "bv-s64-ref", 3)
+BV_REF_WITH_ENDIANNESS (s64, s64)
+VM_DEFINE_FUNCTION (137, bv_f32_ref, "bv-f32-ref", 3)
+BV_REF_WITH_ENDIANNESS (f32, ieee_single)
+VM_DEFINE_FUNCTION (138, bv_f64_ref, "bv-f64-ref", 3)
+BV_REF_WITH_ENDIANNESS (f64, ieee_double)
+
+#undef BV_REF_WITH_ENDIANNESS
+
+#define BV_FIXABLE_INT_REF(stem, fn_stem, type, size)                   \
+{                                                                       \
+  long i = 0;                                                           \
+  ARGS2 (bv, idx);                                                      \
+  VM_VALIDATE_BYTEVECTOR (bv);                                          \
+  if (SCM_LIKELY (SCM_I_INUMP (idx)                                     \
+                  && ((i = SCM_I_INUM (idx)) >= 0)                        \
+                  && (i + size <= SCM_BYTEVECTOR_LENGTH (bv))           \
+                  && (i % size == 0)))                                  \
+    RETURN (SCM_I_MAKINUM (*(scm_t_##type*)                             \
+                           (SCM_BYTEVECTOR_CONTENTS (bv) + i)));        \
+  else                                                                  \
+    RETURN (scm_bytevector_##fn_stem##_ref (bv, idx));                  \
+}
+
+#define BV_INT_REF(stem, type, size)                                    \
+{                                                                       \
+  long i = 0;                                                           \
+  ARGS2 (bv, idx);                                                      \
+  VM_VALIDATE_BYTEVECTOR (bv);                                          \
+  if (SCM_LIKELY (SCM_I_INUMP (idx)                                     \
+                  && ((i = SCM_I_INUM (idx)) >= 0)                      \
+                  && (i + size <= SCM_BYTEVECTOR_LENGTH (bv))           \
+                  && (i % size == 0)))                                  \
+    { scm_t_##type x = (*(scm_t_##type*)(SCM_BYTEVECTOR_CONTENTS (bv) + i)); \
+      if (SCM_FIXABLE (x))                                              \
+        RETURN (SCM_I_MAKINUM (x));                                     \
+      else                                                              \
+        RETURN (scm_from_##type (x));                                   \
+    }                                                                   \
+  else                                                                  \
+    RETURN (scm_bytevector_##stem##_native_ref (bv, idx));              \
+}
+
+#define BV_FLOAT_REF(stem, fn_stem, type, size)                         \
+{                                                                       \
+  long i = 0;                                                           \
+  ARGS2 (bv, idx);                                                      \
+  VM_VALIDATE_BYTEVECTOR (bv);                                          \
+  if (SCM_LIKELY (SCM_I_INUMP (idx)                                     \
+                  && ((i = SCM_I_INUM (idx)) >= 0)                        \
+                  && (i + size <= SCM_BYTEVECTOR_LENGTH (bv))           \
+                  && (i % size == 0)))                                  \
+    RETURN (scm_from_double ((*(type*)(SCM_BYTEVECTOR_CONTENTS (bv) + i)))); \
+  else                                                                  \
+    RETURN (scm_bytevector_##fn_stem##_native_ref (bv, idx));           \
+}
+
+VM_DEFINE_FUNCTION (139, bv_u8_ref, "bv-u8-ref", 2)
+BV_FIXABLE_INT_REF (u8, u8, uint8, 1)
+VM_DEFINE_FUNCTION (140, bv_s8_ref, "bv-s8-ref", 2)
+BV_FIXABLE_INT_REF (s8, s8, int8, 1)
+VM_DEFINE_FUNCTION (141, bv_u16_native_ref, "bv-u16-native-ref", 2)
+BV_FIXABLE_INT_REF (u16, u16_native, uint16, 2)
+VM_DEFINE_FUNCTION (142, bv_s16_native_ref, "bv-s16-native-ref", 2)
+BV_FIXABLE_INT_REF (s16, s16_native, int16, 2)
+VM_DEFINE_FUNCTION (143, bv_u32_native_ref, "bv-u32-native-ref", 2)
+/* FIXME: u32 is always a fixnum on 64-bit builds */
+BV_INT_REF (u32, uint32, 4)
+VM_DEFINE_FUNCTION (144, bv_s32_native_ref, "bv-s32-native-ref", 2)
+BV_INT_REF (s32, int32, 4)
+VM_DEFINE_FUNCTION (145, bv_u64_native_ref, "bv-u64-native-ref", 2)
+BV_INT_REF (u64, uint64, 8)
+VM_DEFINE_FUNCTION (146, bv_s64_native_ref, "bv-s64-native-ref", 2)
+BV_INT_REF (s64, int64, 8)
+VM_DEFINE_FUNCTION (147, bv_f32_native_ref, "bv-f32-native-ref", 2)
+BV_FLOAT_REF (f32, ieee_single, float, 4)
+VM_DEFINE_FUNCTION (148, bv_f64_native_ref, "bv-f64-native-ref", 2)
+BV_FLOAT_REF (f64, ieee_double, double, 8)
+
+#undef BV_FIXABLE_INT_REF
+#undef BV_INT_REF
+#undef BV_FLOAT_REF
+
+
+
+#define BV_SET_WITH_ENDIANNESS(stem, fn_stem)                           \
+{                                                                       \
+  SCM endianness;                                                       \
+  POP (endianness);                                                     \
+  if (scm_is_eq (endianness, scm_i_native_endianness))                  \
+    goto VM_LABEL (bv_##stem##_native_set);                             \
+  {                                                                     \
+    SCM bv, idx, val; POP (val); POP (idx); POP (bv);                   \
+    scm_bytevector_##fn_stem##_set_x (bv, idx, val, endianness);        \
+    NEXT;                                                               \
+  }                                                                     \
+}
+
+VM_DEFINE_INSTRUCTION (149, bv_u16_set, "bv-u16-set", 0, 4, 0)
+BV_SET_WITH_ENDIANNESS (u16, u16)
+VM_DEFINE_INSTRUCTION (150, bv_s16_set, "bv-s16-set", 0, 4, 0)
+BV_SET_WITH_ENDIANNESS (s16, s16)
+VM_DEFINE_INSTRUCTION (151, bv_u32_set, "bv-u32-set", 0, 4, 0)
+BV_SET_WITH_ENDIANNESS (u32, u32)
+VM_DEFINE_INSTRUCTION (152, bv_s32_set, "bv-s32-set", 0, 4, 0)
+BV_SET_WITH_ENDIANNESS (s32, s32)
+VM_DEFINE_INSTRUCTION (153, bv_u64_set, "bv-u64-set", 0, 4, 0)
+BV_SET_WITH_ENDIANNESS (u64, u64)
+VM_DEFINE_INSTRUCTION (154, bv_s64_set, "bv-s64-set", 0, 4, 0)
+BV_SET_WITH_ENDIANNESS (s64, s64)
+VM_DEFINE_INSTRUCTION (155, bv_f32_set, "bv-f32-set", 0, 4, 0)
+BV_SET_WITH_ENDIANNESS (f32, ieee_single)
+VM_DEFINE_INSTRUCTION (156, bv_f64_set, "bv-f64-set", 0, 4, 0)
+BV_SET_WITH_ENDIANNESS (f64, ieee_double)
+
+#undef BV_SET_WITH_ENDIANNESS
+
+#define BV_FIXABLE_INT_SET(stem, fn_stem, type, min, max, size)         \
+{                                                                       \
+  long i = 0, j = 0;                                                    \
+  SCM bv, idx, val; POP (val); POP (idx); POP (bv);                     \
+  VM_VALIDATE_BYTEVECTOR (bv);                                          \
+  if (SCM_LIKELY (SCM_I_INUMP (idx)                                     \
+                  && ((i = SCM_I_INUM (idx)) >= 0)                      \
+                  && (i + size <= SCM_BYTEVECTOR_LENGTH (bv))           \
+                  && (i % size == 0)                                    \
+                  && (SCM_I_INUMP (val))                                \
+                  && ((j = SCM_I_INUM (val)) >= min)                    \
+                  && (j <= max)))                                       \
+    *(scm_t_##type*) (SCM_BYTEVECTOR_CONTENTS (bv) + i) = (scm_t_##type)j; \
+  else                                                                  \
+    scm_bytevector_##fn_stem##_set_x (bv, idx, val);                    \
+  NEXT;                                                                 \
+}
+
+#define BV_INT_SET(stem, type, size)                                    \
+{                                                                       \
+  long i = 0;                                                           \
+  SCM bv, idx, val; POP (val); POP (idx); POP (bv);                     \
+  VM_VALIDATE_BYTEVECTOR (bv);                                          \
+  if (SCM_LIKELY (SCM_I_INUMP (idx)                                     \
+                  && ((i = SCM_I_INUM (idx)) >= 0)                      \
+                  && (i + size <= SCM_BYTEVECTOR_LENGTH (bv))           \
+                  && (i % size == 0)))                                  \
+    *(scm_t_##type*) (SCM_BYTEVECTOR_CONTENTS (bv) + i) = scm_to_##type (val); \
+  else                                                                  \
+    scm_bytevector_##stem##_native_set_x (bv, idx, val);                \
+  NEXT;                                                                 \
+}
+
+#define BV_FLOAT_SET(stem, fn_stem, type, size)                         \
+{                                                                       \
+  long i = 0;                                                           \
+  SCM bv, idx, val; POP (val); POP (idx); POP (bv);                     \
+  VM_VALIDATE_BYTEVECTOR (bv);                                          \
+  if (SCM_LIKELY (SCM_I_INUMP (idx)                                     \
+                  && ((i = SCM_I_INUM (idx)) >= 0)                      \
+                  && (i + size <= SCM_BYTEVECTOR_LENGTH (bv))           \
+                  && (i % size == 0)))                                  \
+    *(type*) (SCM_BYTEVECTOR_CONTENTS (bv) + i) = scm_to_double (val);  \
+  else                                                                  \
+    scm_bytevector_##fn_stem##_native_set_x (bv, idx, val);             \
+  NEXT;                                                                 \
+}
+
+VM_DEFINE_INSTRUCTION (157, bv_u8_set, "bv-u8-set", 0, 3, 0)
+BV_FIXABLE_INT_SET (u8, u8, uint8, 0, SCM_T_UINT8_MAX, 1)
+VM_DEFINE_INSTRUCTION (158, bv_s8_set, "bv-s8-set", 0, 3, 0)
+BV_FIXABLE_INT_SET (s8, s8, int8, SCM_T_INT8_MIN, SCM_T_INT8_MAX, 1)
+VM_DEFINE_INSTRUCTION (159, bv_u16_native_set, "bv-u16-native-set", 0, 3, 0)
+BV_FIXABLE_INT_SET (u16, u16_native, uint16, 0, SCM_T_UINT16_MAX, 2)
+VM_DEFINE_INSTRUCTION (160, bv_s16_native_set, "bv-s16-native-set", 0, 3, 0)
+BV_FIXABLE_INT_SET (s16, s16_native, int16, SCM_T_INT16_MIN, SCM_T_INT16_MAX, 2)
+VM_DEFINE_INSTRUCTION (161, bv_u32_native_set, "bv-u32-native-set", 0, 3, 0)
+/* FIXME: u32 is always a fixnum on 64-bit builds */
+BV_INT_SET (u32, uint32, 4)
+VM_DEFINE_INSTRUCTION (162, bv_s32_native_set, "bv-s32-native-set", 0, 3, 0)
+BV_INT_SET (s32, int32, 4)
+VM_DEFINE_INSTRUCTION (163, bv_u64_native_set, "bv-u64-native-set", 0, 3, 0)
+BV_INT_SET (u64, uint64, 8)
+VM_DEFINE_INSTRUCTION (164, bv_s64_native_set, "bv-s64-native-set", 0, 3, 0)
+BV_INT_SET (s64, int64, 8)
+VM_DEFINE_INSTRUCTION (165, bv_f32_native_set, "bv-f32-native-set", 0, 3, 0)
+BV_FLOAT_SET (f32, ieee_single, float, 4)
+VM_DEFINE_INSTRUCTION (166, bv_f64_native_set, "bv-f64-native-set", 0, 3, 0)
+BV_FLOAT_SET (f64, ieee_double, double, 8)
+
+#undef BV_FIXABLE_INT_SET
+#undef BV_INT_SET
+#undef BV_FLOAT_SET
+
+/*
+(defun renumber-ops ()
+  "start from top of buffer and renumber 'VM_DEFINE_FOO (\n' sequences"
+  (interactive "")
+  (save-excursion
+    (let ((counter 99)) (goto-char (point-min))
+      (while (re-search-forward "^VM_DEFINE_[^ ]+ (\\([^,]+\\)," (point-max) t)
+        (replace-match
+         (number-to-string (setq counter (1+ counter)))
+          t t nil 1)))))
+*/
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
new file mode 100644
index 000000000..0662f8188
--- /dev/null
+++ b/libguile/vm-i-system.c
@@ -0,0 +1,1106 @@
+/* Copyright (C) 2001,2008,2009 Free Software Foundation, Inc.
+ * 
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+
+/* This file is included in vm_engine.c */
+
+
+/*
+ * Basic operations
+ */
+
+VM_DEFINE_INSTRUCTION (0, nop, "nop", 0, 0, 0)
+{
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (1, halt, "halt", 0, 0, 0)
+{
+  vp->time += scm_c_get_internal_run_time () - start_time;
+  HALT_HOOK ();
+  nvalues = SCM_I_INUM (*sp--);
+  NULLSTACK (1);
+  if (nvalues == 1)
+    POP (finish_args);
+  else
+    {
+      POP_LIST (nvalues);
+      POP (finish_args);
+      SYNC_REGISTER ();
+      finish_args = scm_values (finish_args);
+    }
+    
+  {
+    ASSERT (sp == stack_base);
+    ASSERT (stack_base == SCM_FRAME_UPPER_ADDRESS (fp) - 1);
+
+    /* Restore registers */
+    sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1;
+    ip = NULL;
+    fp = SCM_FRAME_DYNAMIC_LINK (fp);
+    NULLSTACK (stack_base - sp);
+  }
+  
+  goto vm_done;
+}
+
+VM_DEFINE_INSTRUCTION (2, break, "break", 0, 0, 0)
+{
+  BREAK_HOOK ();
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (3, drop, "drop", 0, 1, 0)
+{
+  DROP ();
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (4, dup, "dup", 0, 0, 1)
+{
+  SCM x = *sp;
+  PUSH (x);
+  NEXT;
+}
+
+
+/*
+ * Object creation
+ */
+
+VM_DEFINE_INSTRUCTION (5, void, "void", 0, 0, 1)
+{
+  PUSH (SCM_UNSPECIFIED);
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (6, make_true, "make-true", 0, 0, 1)
+{
+  PUSH (SCM_BOOL_T);
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (7, make_false, "make-false", 0, 0, 1)
+{
+  PUSH (SCM_BOOL_F);
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (8, make_eol, "make-eol", 0, 0, 1)
+{
+  PUSH (SCM_EOL);
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (9, make_int8, "make-int8", 1, 0, 1)
+{
+  PUSH (SCM_I_MAKINUM ((signed char) FETCH ()));
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (10, make_int8_0, "make-int8:0", 0, 0, 1)
+{
+  PUSH (SCM_INUM0);
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (11, make_int8_1, "make-int8:1", 0, 0, 1)
+{
+  PUSH (SCM_I_MAKINUM (1));
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (12, make_int16, "make-int16", 2, 0, 1)
+{
+  int h = FETCH ();
+  int l = FETCH ();
+  PUSH (SCM_I_MAKINUM ((signed short) (h << 8) + l));
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (13, make_int64, "make-int64", 8, 0, 1)
+{
+  scm_t_uint64 v = 0;
+  v += FETCH ();
+  v <<= 8; v += FETCH ();
+  v <<= 8; v += FETCH ();
+  v <<= 8; v += FETCH ();
+  v <<= 8; v += FETCH ();
+  v <<= 8; v += FETCH ();
+  v <<= 8; v += FETCH ();
+  v <<= 8; v += FETCH ();
+  PUSH (scm_from_int64 ((scm_t_int64) v));
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (14, make_uint64, "make-uint64", 8, 0, 1)
+{
+  scm_t_uint64 v = 0;
+  v += FETCH ();
+  v <<= 8; v += FETCH ();
+  v <<= 8; v += FETCH ();
+  v <<= 8; v += FETCH ();
+  v <<= 8; v += FETCH ();
+  v <<= 8; v += FETCH ();
+  v <<= 8; v += FETCH ();
+  v <<= 8; v += FETCH ();
+  PUSH (scm_from_uint64 (v));
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (15, make_char8, "make-char8", 1, 0, 1)
+{
+  scm_t_uint8 v = 0;
+  v = FETCH ();
+
+  PUSH (SCM_MAKE_CHAR (v));
+  /* Don't simplify this to PUSH (SCM_MAKE_CHAR (FETCH ())).  The
+     contents of SCM_MAKE_CHAR may be evaluated more than once,
+     resulting in a double fetch.  */
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (16, make_char32, "make-char32", 4, 0, 1)
+{
+  scm_t_wchar v = 0;
+  v += FETCH ();
+  v <<= 8; v += FETCH ();
+  v <<= 8; v += FETCH ();
+  v <<= 8; v += FETCH ();
+  PUSH (SCM_MAKE_CHAR (v));
+  NEXT;
+}
+
+
+
+VM_DEFINE_INSTRUCTION (17, list, "list", 2, -1, 1)
+{
+  unsigned h = FETCH ();
+  unsigned l = FETCH ();
+  unsigned len = ((h << 8) + l);
+  POP_LIST (len);
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (18, vector, "vector", 2, -1, 1)
+{
+  unsigned h = FETCH ();
+  unsigned l = FETCH ();
+  unsigned len = ((h << 8) + l);
+  SCM vect;
+  
+  SYNC_REGISTER ();
+  sp++; sp -= len;
+  CHECK_UNDERFLOW ();
+  vect = scm_make_vector (scm_from_uint (len), SCM_BOOL_F);
+  memcpy (SCM_I_VECTOR_WELTS(vect), sp, sizeof(SCM) * len);
+  NULLSTACK (len);
+  *sp = vect;
+
+  NEXT;
+}
+
+
+/*
+ * Variable access
+ */
+
+#define OBJECT_REF(i)		objects[i]
+#define OBJECT_SET(i,o)		objects[i] = o
+
+#define LOCAL_REF(i)		SCM_FRAME_VARIABLE (fp, i)
+#define LOCAL_SET(i,o)		SCM_FRAME_VARIABLE (fp, i) = o
+
+/* For the variable operations, we _must_ obviously avoid function calls to
+   `scm_variable_ref ()', `scm_variable_bound_p ()' and friends which do
+   nothing more than the corresponding macros.  */
+#define VARIABLE_REF(v)		SCM_VARIABLE_REF (v)
+#define VARIABLE_SET(v,o)	SCM_VARIABLE_SET (v, o)
+#define VARIABLE_BOUNDP(v)      (VARIABLE_REF (v) != SCM_UNDEFINED)
+
+#define FREE_VARIABLE_REF(i)	free_vars[i]
+
+/* ref */
+
+VM_DEFINE_INSTRUCTION (19, object_ref, "object-ref", 1, 0, 1)
+{
+  register unsigned objnum = FETCH ();
+  CHECK_OBJECT (objnum);
+  PUSH (OBJECT_REF (objnum));
+  NEXT;
+}
+
+/* FIXME: necessary? elt 255 of the vector could be a vector... */
+VM_DEFINE_INSTRUCTION (20, long_object_ref, "long-object-ref", 2, 0, 1)
+{
+  unsigned int objnum = FETCH ();
+  objnum <<= 8;
+  objnum += FETCH ();
+  CHECK_OBJECT (objnum);
+  PUSH (OBJECT_REF (objnum));
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (21, local_ref, "local-ref", 1, 0, 1)
+{
+  PUSH (LOCAL_REF (FETCH ()));
+  ASSERT_BOUND (*sp);
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (22, long_local_ref, "long-local-ref", 2, 0, 1)
+{
+  unsigned int i = FETCH ();
+  i <<= 8;
+  i += FETCH ();
+  PUSH (LOCAL_REF (i));
+  ASSERT_BOUND (*sp);
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (23, variable_ref, "variable-ref", 0, 0, 1)
+{
+  SCM x = *sp;
+
+  if (!VARIABLE_BOUNDP (x))
+    {
+      finish_args = scm_list_1 (x);
+      /* Was: finish_args = SCM_LIST1 (SCM_CAR (x)); */
+      goto vm_error_unbound;
+    }
+  else
+    {
+      SCM o = VARIABLE_REF (x);
+      *sp = o;
+    }
+
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (24, toplevel_ref, "toplevel-ref", 1, 0, 1)
+{
+  unsigned objnum = FETCH ();
+  SCM what;
+  CHECK_OBJECT (objnum);
+  what = OBJECT_REF (objnum);
+
+  if (!SCM_VARIABLEP (what)) 
+    {
+      SYNC_REGISTER ();
+      what = resolve_variable (what, scm_program_module (program));
+      if (!VARIABLE_BOUNDP (what))
+        {
+          finish_args = scm_list_1 (what);
+          goto vm_error_unbound;
+        }
+      OBJECT_SET (objnum, what);
+    }
+
+  PUSH (VARIABLE_REF (what));
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (25, long_toplevel_ref, "long-toplevel-ref", 2, 0, 1)
+{
+  SCM what;
+  unsigned int objnum = FETCH ();
+  objnum <<= 8;
+  objnum += FETCH ();
+  CHECK_OBJECT (objnum);
+  what = OBJECT_REF (objnum);
+
+  if (!SCM_VARIABLEP (what)) 
+    {
+      SYNC_REGISTER ();
+      what = resolve_variable (what, scm_program_module (program));
+      if (!VARIABLE_BOUNDP (what))
+        {
+          finish_args = scm_list_1 (what);
+          goto vm_error_unbound;
+        }
+      OBJECT_SET (objnum, what);
+    }
+
+  PUSH (VARIABLE_REF (what));
+  NEXT;
+}
+
+/* set */
+
+VM_DEFINE_INSTRUCTION (26, local_set, "local-set", 1, 1, 0)
+{
+  LOCAL_SET (FETCH (), *sp);
+  DROP ();
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (27, long_local_set, "long-local-set", 2, 1, 0)
+{
+  unsigned int i = FETCH ();
+  i <<= 8;
+  i += FETCH ();
+  LOCAL_SET (i, *sp);
+  DROP ();
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (28, variable_set, "variable-set", 0, 1, 0)
+{
+  VARIABLE_SET (sp[0], sp[-1]);
+  DROPN (2);
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (29, toplevel_set, "toplevel-set", 1, 1, 0)
+{
+  unsigned objnum = FETCH ();
+  SCM what;
+  CHECK_OBJECT (objnum);
+  what = OBJECT_REF (objnum);
+
+  if (!SCM_VARIABLEP (what)) 
+    {
+      SYNC_BEFORE_GC ();
+      what = resolve_variable (what, scm_program_module (program));
+      OBJECT_SET (objnum, what);
+    }
+
+  VARIABLE_SET (what, *sp);
+  DROP ();
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (30, long_toplevel_set, "long-toplevel-set", 2, 1, 0)
+{
+  SCM what;
+  unsigned int objnum = FETCH ();
+  objnum <<= 8;
+  objnum += FETCH ();
+  CHECK_OBJECT (objnum);
+  what = OBJECT_REF (objnum);
+
+  if (!SCM_VARIABLEP (what)) 
+    {
+      SYNC_BEFORE_GC ();
+      what = resolve_variable (what, scm_program_module (program));
+      OBJECT_SET (objnum, what);
+    }
+
+  VARIABLE_SET (what, *sp);
+  DROP ();
+  NEXT;
+}
+
+
+/*
+ * branch and jump
+ */
+
+/* offset must be a signed 16 bit int!!! */
+#define FETCH_OFFSET(offset)                    \
+{						\
+  int h = FETCH ();				\
+  int l = FETCH ();				\
+  offset = (h << 8) + l;                        \
+}
+
+#define BR(p)					\
+{						\
+  scm_t_int16 offset;                           \
+  FETCH_OFFSET (offset);                        \
+  if (p)					\
+    ip += ((scm_t_ptrdiff)offset) * 8 - (((unsigned long)ip) % 8);      \
+  NULLSTACK (1);				\
+  DROP ();					\
+  NEXT;						\
+}
+
+VM_DEFINE_INSTRUCTION (31, br, "br", 2, 0, 0)
+{
+  scm_t_int16 offset;
+  FETCH_OFFSET (offset);
+  ip += ((scm_t_ptrdiff)offset) * 8 - (((unsigned long)ip) % 8);
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (32, br_if, "br-if", 2, 0, 0)
+{
+  BR (!SCM_FALSEP (*sp));
+}
+
+VM_DEFINE_INSTRUCTION (33, br_if_not, "br-if-not", 2, 0, 0)
+{
+  BR (SCM_FALSEP (*sp));
+}
+
+VM_DEFINE_INSTRUCTION (34, br_if_eq, "br-if-eq", 2, 0, 0)
+{
+  sp--; /* underflow? */
+  BR (SCM_EQ_P (sp[0], sp[1]));
+}
+
+VM_DEFINE_INSTRUCTION (35, br_if_not_eq, "br-if-not-eq", 2, 0, 0)
+{
+  sp--; /* underflow? */
+  BR (!SCM_EQ_P (sp[0], sp[1]));
+}
+
+VM_DEFINE_INSTRUCTION (36, br_if_null, "br-if-null", 2, 0, 0)
+{
+  BR (SCM_NULLP (*sp));
+}
+
+VM_DEFINE_INSTRUCTION (37, br_if_not_null, "br-if-not-null", 2, 0, 0)
+{
+  BR (!SCM_NULLP (*sp));
+}
+
+
+/*
+ * Subprogram call
+ */
+
+VM_DEFINE_INSTRUCTION (38, new_frame, "new-frame", 0, 0, 3)
+{
+  PUSH ((SCM)fp); /* dynamic link */
+  PUSH (0);  /* mvra */
+  PUSH (0);  /* ra */
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (39, call, "call", 1, -1, 1)
+{
+  SCM x;
+  nargs = FETCH ();
+
+ vm_call:
+  x = sp[-nargs];
+
+  SYNC_REGISTER ();
+  SCM_TICK;	/* allow interrupt here */
+
+  /*
+   * Subprogram call
+   */
+  if (SCM_PROGRAM_P (x))
+    {
+      program = x;
+      CACHE_PROGRAM ();
+      INIT_ARGS ();
+      fp = sp - bp->nargs + 1;
+      ASSERT (SCM_FRAME_RETURN_ADDRESS (fp) == 0);
+      ASSERT (SCM_FRAME_MV_RETURN_ADDRESS (fp) == 0);
+      SCM_FRAME_SET_RETURN_ADDRESS (fp, ip);
+      SCM_FRAME_SET_MV_RETURN_ADDRESS (fp, 0);
+      INIT_FRAME ();
+      ENTER_HOOK ();
+      APPLY_HOOK ();
+      NEXT;
+    }
+  /*
+   * Other interpreted or compiled call
+   */
+  if (!SCM_FALSEP (scm_procedure_p (x)))
+    {
+      SCM args;
+      /* At this point, the stack contains the frame, the procedure and each one
+	 of its arguments. */
+      POP_LIST (nargs);
+      POP (args);
+      DROP (); /* drop the procedure */
+      DROP_FRAME ();
+      
+      SYNC_REGISTER ();
+      PUSH (scm_apply (x, args, SCM_EOL));
+      NULLSTACK_FOR_NONLOCAL_EXIT ();
+      if (SCM_UNLIKELY (SCM_VALUESP (*sp)))
+        {
+          /* truncate values */
+          SCM values;
+          POP (values);
+          values = scm_struct_ref (values, SCM_INUM0);
+          if (scm_is_null (values))
+            goto vm_error_not_enough_values;
+          PUSH (SCM_CAR (values));
+        }
+      NEXT;
+    }
+
+  program = x;
+  goto vm_error_wrong_type_apply;
+}
+
+VM_DEFINE_INSTRUCTION (40, goto_args, "goto/args", 1, -1, 1)
+{
+  register SCM x;
+  nargs = FETCH ();
+ vm_goto_args:
+  x = sp[-nargs];
+
+  SYNC_REGISTER ();
+  SCM_TICK;	/* allow interrupt here */
+
+  /*
+   * Tail call
+   */
+  if (SCM_PROGRAM_P (x))
+    {
+      int i;
+#ifdef VM_ENABLE_STACK_NULLING
+      SCM *old_sp;
+#endif
+
+      EXIT_HOOK ();
+
+      /* switch programs */
+      program = x;
+      CACHE_PROGRAM ();
+      INIT_ARGS ();
+
+#ifdef VM_ENABLE_STACK_NULLING
+      old_sp = sp;
+      CHECK_STACK_LEAK ();
+#endif
+
+      /* delay shuffling the new program+args down so that if INIT_ARGS had to
+         cons up a rest arg, going into GC, the stack still made sense */
+      for (i = -1, sp = sp - bp->nargs + 1; i < bp->nargs; i++)
+        fp[i] = sp[i];
+      sp = fp + i - 1;
+
+      NULLSTACK (old_sp - sp);
+
+      INIT_FRAME ();
+
+      ENTER_HOOK ();
+      APPLY_HOOK ();
+      NEXT;
+    }
+
+  /*
+   * Other interpreted or compiled call
+   */
+  if (!SCM_FALSEP (scm_procedure_p (x)))
+    {
+      SCM args;
+      POP_LIST (nargs);
+      POP (args);
+
+      SYNC_REGISTER ();
+      *sp = scm_apply (x, args, SCM_EOL);
+      NULLSTACK_FOR_NONLOCAL_EXIT ();
+
+      if (SCM_UNLIKELY (SCM_VALUESP (*sp)))
+        {
+          /* multiple values returned to continuation */
+          SCM values;
+          POP (values);
+          values = scm_struct_ref (values, SCM_INUM0);
+          nvalues = scm_ilength (values);
+          PUSH_LIST (values, SCM_NULLP);
+          goto vm_return_values;
+        }
+      else
+        goto vm_return;
+    }
+
+  program = x;
+
+  goto vm_error_wrong_type_apply;
+}
+
+VM_DEFINE_INSTRUCTION (41, goto_nargs, "goto/nargs", 0, 0, 1)
+{
+  SCM x;
+  POP (x);
+  nargs = scm_to_int (x);
+  /* FIXME: should truncate values? */
+  goto vm_goto_args;
+}
+
+VM_DEFINE_INSTRUCTION (42, call_nargs, "call/nargs", 0, 0, 1)
+{
+  SCM x;
+  POP (x);
+  nargs = scm_to_int (x);
+  /* FIXME: should truncate values? */
+  goto vm_call;
+}
+
+VM_DEFINE_INSTRUCTION (43, mv_call, "mv-call", 3, -1, 1)
+{
+  SCM x;
+  scm_t_int16 offset;
+  scm_t_uint8 *mvra;
+  
+  nargs = FETCH ();
+  FETCH_OFFSET (offset);
+  mvra = ip + ((scm_t_ptrdiff)offset) * 8 - ((unsigned long)ip) % 8;
+
+  x = sp[-nargs];
+
+  /*
+   * Subprogram call
+   */
+  if (SCM_PROGRAM_P (x))
+    {
+      program = x;
+      CACHE_PROGRAM ();
+      INIT_ARGS ();
+      fp = sp - bp->nargs + 1;
+      ASSERT (SCM_FRAME_RETURN_ADDRESS (fp) == 0);
+      ASSERT (SCM_FRAME_MV_RETURN_ADDRESS (fp) == 0);
+      SCM_FRAME_SET_RETURN_ADDRESS (fp, ip);
+      SCM_FRAME_SET_MV_RETURN_ADDRESS (fp, mvra);
+      INIT_FRAME ();
+      ENTER_HOOK ();
+      APPLY_HOOK ();
+      NEXT;
+    }
+  /*
+   * Other interpreted or compiled call
+   */
+  if (!SCM_FALSEP (scm_procedure_p (x)))
+    {
+      SCM args;
+      /* At this point, the stack contains the procedure and each one of its
+	 arguments.  */
+      POP_LIST (nargs);
+      POP (args);
+      DROP (); /* drop the procedure */
+      DROP_FRAME ();
+      
+      SYNC_REGISTER ();
+      PUSH (scm_apply (x, args, SCM_EOL));
+      NULLSTACK_FOR_NONLOCAL_EXIT ();
+      if (SCM_VALUESP (*sp))
+        {
+          SCM values, len;
+          POP (values);
+          values = scm_struct_ref (values, SCM_INUM0);
+          len = scm_length (values);
+          PUSH_LIST (values, SCM_NULLP);
+          PUSH (len);
+          ip = mvra;
+        }
+      NEXT;
+    }
+
+  program = x;
+  goto vm_error_wrong_type_apply;
+}
+
+VM_DEFINE_INSTRUCTION (44, apply, "apply", 1, -1, 1)
+{
+  int len;
+  SCM ls;
+  POP (ls);
+
+  nargs = FETCH ();
+  ASSERT (nargs >= 2);
+
+  len = scm_ilength (ls);
+  if (len < 0)
+    goto vm_error_wrong_type_arg;
+
+  PUSH_LIST (ls, SCM_NULL_OR_NIL_P);
+
+  nargs += len - 2;
+  goto vm_call;
+}
+
+VM_DEFINE_INSTRUCTION (45, goto_apply, "goto/apply", 1, -1, 1)
+{
+  int len;
+  SCM ls;
+  POP (ls);
+
+  nargs = FETCH ();
+  ASSERT (nargs >= 2);
+
+  len = scm_ilength (ls);
+  if (len < 0)
+    goto vm_error_wrong_type_arg;
+
+  PUSH_LIST (ls, SCM_NULL_OR_NIL_P);
+
+  nargs += len - 2;
+  goto vm_goto_args;
+}
+
+VM_DEFINE_INSTRUCTION (46, call_cc, "call/cc", 0, 1, 1)
+{
+  int first;
+  SCM proc, cont;
+  POP (proc);
+  SYNC_ALL ();
+  cont = scm_make_continuation (&first);
+  if (first) 
+    {
+      PUSH ((SCM)fp); /* dynamic link */
+      PUSH (0);  /* mvra */
+      PUSH (0);  /* ra */
+      PUSH (proc);
+      PUSH (cont);
+      nargs = 1;
+      goto vm_call;
+    }
+  ASSERT (sp == vp->sp);
+  ASSERT (fp == vp->fp);
+  else if (SCM_VALUESP (cont))
+    {
+      /* multiple values returned to continuation */
+      SCM values;
+      values = scm_struct_ref (cont, SCM_INUM0);
+      if (SCM_NULLP (values))
+        goto vm_error_no_values;
+      /* non-tail context does not accept multiple values? */
+      PUSH (SCM_CAR (values));
+      NEXT;
+    }
+  else
+    {
+      PUSH (cont);
+      NEXT;
+    }
+}
+
+VM_DEFINE_INSTRUCTION (47, goto_cc, "goto/cc", 0, 1, 1)
+{
+  int first;
+  SCM proc, cont;
+  POP (proc);
+  SYNC_ALL ();
+  cont = scm_make_continuation (&first);
+  ASSERT (sp == vp->sp);
+  ASSERT (fp == vp->fp);
+  if (first) 
+    {
+      PUSH (proc);
+      PUSH (cont);
+      nargs = 1;
+      goto vm_goto_args;
+    }
+  else if (SCM_VALUESP (cont))
+    {
+      /* multiple values returned to continuation */
+      SCM values;
+      values = scm_struct_ref (cont, SCM_INUM0);
+      nvalues = scm_ilength (values);
+      PUSH_LIST (values, SCM_NULLP);
+      goto vm_return_values;
+    }
+  else
+    {
+      PUSH (cont);
+      goto vm_return;
+    }
+}
+
+VM_DEFINE_INSTRUCTION (48, return, "return", 0, 1, 1)
+{
+ vm_return:
+  EXIT_HOOK ();
+  RETURN_HOOK ();
+  SYNC_REGISTER ();
+  SCM_TICK;	/* allow interrupt here */
+  {
+    SCM ret;
+
+    POP (ret);
+    ASSERT (sp == stack_base);
+    ASSERT (stack_base == SCM_FRAME_UPPER_ADDRESS (fp) - 1);
+
+    /* Restore registers */
+    sp = SCM_FRAME_LOWER_ADDRESS (fp);
+    ip = SCM_FRAME_RETURN_ADDRESS (fp);
+    fp = SCM_FRAME_DYNAMIC_LINK (fp);
+    {
+#ifdef VM_ENABLE_STACK_NULLING
+      int nullcount = stack_base - sp;
+#endif
+      stack_base = SCM_FRAME_UPPER_ADDRESS (fp) - 1;
+      NULLSTACK (nullcount);
+    }
+
+    /* Set return value (sp is already pushed) */
+    *sp = ret;
+  }
+
+  /* Restore the last program */
+  program = SCM_FRAME_PROGRAM (fp);
+  CACHE_PROGRAM ();
+  CHECK_IP ();
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (49, return_values, "return/values", 1, -1, -1)
+{
+  /* nvalues declared at top level, because for some reason gcc seems to think
+     that perhaps it might be used without declaration. Fooey to that, I say. */
+  nvalues = FETCH ();
+ vm_return_values:
+  EXIT_HOOK ();
+  RETURN_HOOK ();
+
+  ASSERT (stack_base == SCM_FRAME_UPPER_ADDRESS (fp) - 1);
+
+  /* data[1] is the mv return address */
+  if (nvalues != 1 && SCM_FRAME_MV_RETURN_ADDRESS (fp)) 
+    {
+      int i;
+      /* Restore registers */
+      sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1;
+      ip = SCM_FRAME_MV_RETURN_ADDRESS (fp);
+      fp = SCM_FRAME_DYNAMIC_LINK (fp);
+        
+      /* Push return values, and the number of values */
+      for (i = 0; i < nvalues; i++)
+        *++sp = stack_base[1+i];
+      *++sp = SCM_I_MAKINUM (nvalues);
+             
+      /* Finally set new stack_base */
+      NULLSTACK (stack_base - sp + nvalues + 1);
+      stack_base = SCM_FRAME_UPPER_ADDRESS (fp) - 1;
+    }
+  else if (nvalues >= 1)
+    {
+      /* Multiple values for a single-valued continuation -- here's where I
+         break with guile tradition and try and do something sensible. (Also,
+         this block handles the single-valued return to an mv
+         continuation.) */
+      /* Restore registers */
+      sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1;
+      ip = SCM_FRAME_RETURN_ADDRESS (fp);
+      fp = SCM_FRAME_DYNAMIC_LINK (fp);
+        
+      /* Push first value */
+      *++sp = stack_base[1];
+             
+      /* Finally set new stack_base */
+      NULLSTACK (stack_base - sp + nvalues + 1);
+      stack_base = SCM_FRAME_UPPER_ADDRESS (fp) - 1;
+    }
+  else
+    goto vm_error_no_values;
+
+  /* Restore the last program */
+  program = SCM_FRAME_PROGRAM (fp);
+  CACHE_PROGRAM ();
+  CHECK_IP ();
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (50, return_values_star, "return/values*", 1, -1, -1)
+{
+  SCM l;
+
+  nvalues = FETCH ();
+  ASSERT (nvalues >= 1);
+    
+  nvalues--;
+  POP (l);
+  while (SCM_CONSP (l))
+    {
+      PUSH (SCM_CAR (l));
+      l = SCM_CDR (l);
+      nvalues++;
+    }
+  if (SCM_UNLIKELY (!SCM_NULL_OR_NIL_P (l))) {
+    finish_args = scm_list_1 (l);
+    goto vm_error_improper_list;
+  }
+
+  goto vm_return_values;
+}
+
+VM_DEFINE_INSTRUCTION (51, truncate_values, "truncate-values", 2, -1, -1)
+{
+  SCM x;
+  int nbinds, rest;
+  POP (x);
+  nvalues = scm_to_int (x);
+  nbinds = FETCH ();
+  rest = FETCH ();
+
+  if (rest)
+    nbinds--;
+
+  if (nvalues < nbinds)
+    goto vm_error_not_enough_values;
+
+  if (rest)
+    POP_LIST (nvalues - nbinds);
+  else
+    DROPN (nvalues - nbinds);
+
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (52, box, "box", 1, 1, 0)
+{
+  SCM val;
+  POP (val);
+  SYNC_BEFORE_GC ();
+  LOCAL_SET (FETCH (), scm_cell (scm_tc7_variable, SCM_UNPACK (val)));
+  NEXT;
+}
+
+/* for letrec:
+   (let ((a *undef*) (b *undef*) ...)
+     (set! a (lambda () (b ...)))
+     ...)
+ */
+VM_DEFINE_INSTRUCTION (53, empty_box, "empty-box", 1, 0, 0)
+{
+  SYNC_BEFORE_GC ();
+  LOCAL_SET (FETCH (),
+             scm_cell (scm_tc7_variable, SCM_UNPACK (SCM_UNDEFINED)));
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (54, local_boxed_ref, "local-boxed-ref", 1, 0, 1)
+{
+  SCM v = LOCAL_REF (FETCH ());
+  ASSERT_BOUND_VARIABLE (v);
+  PUSH (VARIABLE_REF (v));
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (55, local_boxed_set, "local-boxed-set", 1, 1, 0)
+{
+  SCM v, val;
+  v = LOCAL_REF (FETCH ());
+  POP (val);
+  ASSERT_VARIABLE (v);
+  VARIABLE_SET (v, val);
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (56, free_ref, "free-ref", 1, 0, 1)
+{
+  scm_t_uint8 idx = FETCH ();
+  
+  CHECK_FREE_VARIABLE (idx);
+  PUSH (FREE_VARIABLE_REF (idx));
+  NEXT;
+}
+
+/* no free-set -- if a var is assigned, it should be in a box */
+
+VM_DEFINE_INSTRUCTION (57, free_boxed_ref, "free-boxed-ref", 1, 0, 1)
+{
+  SCM v;
+  scm_t_uint8 idx = FETCH ();
+  CHECK_FREE_VARIABLE (idx);
+  v = FREE_VARIABLE_REF (idx);
+  ASSERT_BOUND_VARIABLE (v);
+  PUSH (VARIABLE_REF (v));
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (58, free_boxed_set, "free-boxed-set", 1, 1, 0)
+{
+  SCM v, val;
+  scm_t_uint8 idx = FETCH ();
+  POP (val);
+  CHECK_FREE_VARIABLE (idx);
+  v = FREE_VARIABLE_REF (idx);
+  ASSERT_BOUND_VARIABLE (v);
+  VARIABLE_SET (v, val);
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (59, make_closure, "make-closure", 0, 2, 1)
+{
+  SCM vect;
+  POP (vect);
+  SYNC_BEFORE_GC ();
+  /* fixme underflow */
+  *sp = scm_double_cell (scm_tc7_program, (scm_t_bits)SCM_PROGRAM_OBJCODE (*sp),
+                         (scm_t_bits)SCM_PROGRAM_OBJTABLE (*sp), (scm_t_bits)vect);
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (60, make_variable, "make-variable", 0, 0, 1)
+{
+  SYNC_BEFORE_GC ();
+  /* fixme underflow */
+  PUSH (scm_cell (scm_tc7_variable, SCM_UNPACK (SCM_UNDEFINED)));
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (61, fix_closure, "fix-closure", 2, 0, 1)
+{
+  SCM x, vect;
+  unsigned int i = FETCH ();
+  i <<= 8;
+  i += FETCH ();
+  POP (vect);
+  /* FIXME CHECK_LOCAL (i) */ 
+  x = LOCAL_REF (i);
+  /* FIXME ASSERT_PROGRAM (x); */
+  SCM_SET_CELL_WORD_3 (x, vect);
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (62, define, "define", 0, 0, 2)
+{
+  SCM sym, val;
+  POP (sym);
+  POP (val);
+  SYNC_REGISTER ();
+  VARIABLE_SET (scm_sym2var (sym, scm_current_module_lookup_closure (),
+                             SCM_BOOL_T),
+                val);
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (63, make_keyword, "make-keyword", 0, 1, 1)
+{
+  CHECK_UNDERFLOW ();
+  SYNC_REGISTER ();
+  *sp = scm_symbol_to_keyword (*sp);
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (64, make_symbol, "make-symbol", 0, 1, 1)
+{
+  CHECK_UNDERFLOW ();
+  SYNC_REGISTER ();
+  *sp = scm_string_to_symbol (*sp);
+  NEXT;
+}
+
+
+/*
+(defun renumber-ops ()
+  "start from top of buffer and renumber 'VM_DEFINE_FOO (\n' sequences"
+  (interactive "")
+  (save-excursion
+    (let ((counter -1)) (goto-char (point-min))
+      (while (re-search-forward "^VM_DEFINE_[^ ]+ (\\([^,]+\\)," (point-max) t)
+        (replace-match
+         (number-to-string (setq counter (1+ counter)))
+          t t nil 1)))))
+*/
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/vm.c b/libguile/vm.c
new file mode 100644
index 000000000..95aaa4fe4
--- /dev/null
+++ b/libguile/vm.c
@@ -0,0 +1,683 @@
+/* Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+ * 
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+#if HAVE_CONFIG_H
+#  include <config.h>
+#endif
+
+#include <stdlib.h>
+#include <alloca.h>
+#include <string.h>
+#include <assert.h>
+
+#include "libguile/boehm-gc.h"
+#include <gc/gc_mark.h>
+
+#include "_scm.h"
+#include "vm-bootstrap.h"
+#include "frames.h"
+#include "instructions.h"
+#include "objcodes.h"
+#include "programs.h"
+#include "lang.h" /* NULL_OR_NIL_P */
+#include "vm.h"
+
+/* I sometimes use this for debugging. */
+#define vm_puts(OBJ)				\
+{						\
+  scm_display (OBJ, scm_current_error_port ()); \
+  scm_newline (scm_current_error_port ());      \
+}
+
+/* The VM has a number of internal assertions that shouldn't normally be
+   necessary, but might be if you think you found a bug in the VM. */
+#define VM_ENABLE_ASSERTIONS
+
+/* We can add a mode that ensures that all stack items above the stack pointer
+   are NULL. This is useful for checking the internal consistency of the VM's
+   assumptions and its operators, but isn't necessary for normal operation. It
+   will ensure that assertions are enabled. Slows down the VM by about 30%. */
+/* NB! If you enable this, search for NULLING in throw.c */
+/* #define VM_ENABLE_STACK_NULLING */
+
+/* #define VM_ENABLE_PARANOID_ASSERTIONS */
+
+#if defined (VM_ENABLE_STACK_NULLING) && !defined (VM_ENABLE_ASSERTIONS)
+#define VM_ENABLE_ASSERTIONS
+#endif
+
+/* When defined, arrange so that the GC doesn't scan the VM stack beyond its
+   current SP.  This should help avoid excess data retention.  See
+   http://thread.gmane.org/gmane.comp.programming.garbage-collection.boehmgc/3001
+   for a discussion.  */
+#define VM_ENABLE_PRECISE_STACK_GC_SCAN
+
+
+
+/*
+ * VM Continuation
+ */
+
+scm_t_bits scm_tc16_vm_cont;
+
+static SCM
+capture_vm_cont (struct scm_vm *vp)
+{
+  struct scm_vm_cont *p = scm_gc_malloc (sizeof (*p), "capture_vm_cont");
+  p->stack_size = vp->sp - vp->stack_base + 1;
+  p->stack_base = scm_gc_malloc (p->stack_size * sizeof (SCM),
+				 "capture_vm_cont");
+#ifdef VM_ENABLE_STACK_NULLING
+  if (vp->sp >= vp->stack_base)
+    if (!vp->sp[0] || vp->sp[1])
+      abort ();
+  memset (p->stack_base, 0, p->stack_size * sizeof (SCM));
+#endif
+  p->ip = vp->ip;
+  p->sp = vp->sp;
+  p->fp = vp->fp;
+  memcpy (p->stack_base, vp->stack_base, p->stack_size * sizeof (SCM));
+  p->reloc = p->stack_base - vp->stack_base;
+  SCM_RETURN_NEWSMOB (scm_tc16_vm_cont, p);
+}
+
+static void
+reinstate_vm_cont (struct scm_vm *vp, SCM cont)
+{
+  struct scm_vm_cont *p = SCM_VM_CONT_DATA (cont);
+  if (vp->stack_size < p->stack_size)
+    {
+      /* puts ("FIXME: Need to expand"); */
+      abort ();
+    }
+#ifdef VM_ENABLE_STACK_NULLING
+  {
+    scm_t_ptrdiff nzero = (vp->sp - p->sp);
+    if (nzero > 0)
+      memset (vp->stack_base + p->stack_size, 0, nzero * sizeof (SCM));
+    /* actually nzero should always be negative, because vm_reset_stack will
+       unwind the stack to some point *below* this continuation */
+  }
+#endif
+  vp->ip = p->ip;
+  vp->sp = p->sp;
+  vp->fp = p->fp;
+  memcpy (vp->stack_base, p->stack_base, p->stack_size * sizeof (SCM));
+}
+
+/* In theory, a number of vm instances can be active in the call trace, and we
+   only want to reify the continuations of those in the current continuation
+   root. I don't see a nice way to do this -- ideally it would involve dynwinds,
+   and previous values of the *the-vm* fluid within the current continuation
+   root. But we don't have access to continuation roots in the dynwind stack.
+   So, just punt for now -- take the current value of *the-vm*.
+
+   While I'm on the topic, ideally we could avoid copying the C stack if the
+   continuation root is inside VM code, and call/cc was invoked within that same
+   call to vm_run; but that's currently not implemented.
+ */
+SCM
+scm_vm_capture_continuations (void)
+{
+  SCM vm = scm_the_vm ();
+  return scm_acons (vm, capture_vm_cont (SCM_VM_DATA (vm)), SCM_EOL);
+}
+
+void
+scm_vm_reinstate_continuations (SCM conts)
+{
+  for (; conts != SCM_EOL; conts = SCM_CDR (conts))
+    reinstate_vm_cont (SCM_VM_DATA (SCM_CAAR (conts)), SCM_CDAR (conts));
+}
+
+static void enfalsen_frame (void *p)
+{ 
+  struct scm_vm *vp = p;
+  vp->trace_frame = SCM_BOOL_F;
+}
+
+static void
+vm_dispatch_hook (struct scm_vm *vp, SCM hook, SCM hook_args)
+{
+  if (!SCM_FALSEP (vp->trace_frame))
+    return;
+  
+  scm_dynwind_begin (0);
+  // FIXME, stack holder should be the vm
+  vp->trace_frame = scm_c_make_vm_frame (SCM_BOOL_F, vp->fp, vp->sp, vp->ip, 0);
+  scm_dynwind_unwind_handler (enfalsen_frame, vp, SCM_F_WIND_EXPLICITLY);
+
+  scm_c_run_hook (hook, hook_args);
+
+  scm_dynwind_end ();
+}
+
+
+/*
+ * VM Internal functions
+ */
+
+static SCM sym_vm_run;
+static SCM sym_vm_error;
+static SCM sym_debug;
+
+static SCM
+really_make_boot_program (long nargs)
+{
+  SCM u8vec;
+  scm_t_uint8 text[] = { scm_op_mv_call, 0, 0, 1,
+                         scm_op_make_int8_1, scm_op_nop, scm_op_nop, scm_op_nop,
+                         scm_op_halt };
+  struct scm_objcode *bp;
+  SCM ret;
+
+  if (SCM_UNLIKELY (nargs > 255 || nargs < 0))
+    abort ();
+  text[1] = (scm_t_uint8)nargs;
+
+  bp = scm_malloc (sizeof (struct scm_objcode) + sizeof (text));
+  memcpy (bp->base, text, sizeof (text));
+  bp->nargs = 0;
+  bp->nrest = 0;
+  bp->nlocs = 0;
+  bp->len = sizeof(text);
+  bp->metalen = 0;
+  bp->unused = 0;
+
+  u8vec = scm_take_u8vector ((scm_t_uint8*)bp,
+                             sizeof (struct scm_objcode) + sizeof (text));
+  ret = scm_make_program (scm_bytecode_to_objcode (u8vec),
+                          SCM_BOOL_F, SCM_BOOL_F);
+  SCM_SET_SMOB_FLAGS (ret, SCM_F_PROGRAM_IS_BOOT);
+
+  return ret;
+}
+#define NUM_BOOT_PROGS 8
+static SCM
+vm_make_boot_program (long nargs)
+{
+  static SCM programs[NUM_BOOT_PROGS] = { 0, };
+
+  if (SCM_UNLIKELY (!programs[0])) 
+    {
+      int i;
+      for (i = 0; i < NUM_BOOT_PROGS; i++)
+        programs[i] = scm_permanent_object (really_make_boot_program (i));
+    }
+  
+  if (SCM_LIKELY (nargs < NUM_BOOT_PROGS))
+    return programs[nargs];
+  else
+    return really_make_boot_program (nargs);
+}
+
+
+/*
+ * VM
+ */
+
+static SCM
+resolve_variable (SCM what, SCM program_module)
+{
+  if (SCM_LIKELY (SCM_SYMBOLP (what))) 
+    {
+      if (SCM_LIKELY (scm_module_system_booted_p
+                      && scm_is_true (program_module)))
+        /* might longjmp */
+        return scm_module_lookup (program_module, what);
+      else
+        {
+          SCM v = scm_sym2var (what, SCM_BOOL_F, SCM_BOOL_F);
+          if (scm_is_false (v))
+            scm_misc_error (NULL, "unbound variable: ~S", scm_list_1 (what));
+          else
+            return v;
+        }
+    }
+  else
+    {
+      SCM mod;
+      /* compilation of @ or @@
+         `what' is a three-element list: (MODNAME SYM INTERFACE?)
+         INTERFACE? is #t if we compiled @ or #f if we compiled @@
+      */
+      mod = scm_resolve_module (SCM_CAR (what));
+      if (scm_is_true (SCM_CADDR (what)))
+        mod = scm_module_public_interface (mod);
+      if (SCM_FALSEP (mod))
+        scm_misc_error (NULL, "no such module: ~S",
+                        scm_list_1 (SCM_CAR (what)));
+      /* might longjmp */
+      return scm_module_lookup (mod, SCM_CADR (what));
+    }
+}
+  
+
+#define VM_DEFAULT_STACK_SIZE	(64 * 1024)
+
+#define VM_NAME   vm_regular_engine
+#define FUNC_NAME "vm-regular-engine"
+#define VM_ENGINE SCM_VM_REGULAR_ENGINE
+#include "vm-engine.c"
+#undef VM_NAME
+#undef FUNC_NAME
+#undef VM_ENGINE
+
+#define VM_NAME	  vm_debug_engine
+#define FUNC_NAME "vm-debug-engine"
+#define VM_ENGINE SCM_VM_DEBUG_ENGINE
+#include "vm-engine.c"
+#undef VM_NAME
+#undef FUNC_NAME
+#undef VM_ENGINE
+
+static const scm_t_vm_engine vm_engines[] = 
+  { vm_regular_engine, vm_debug_engine };
+
+scm_t_bits scm_tc16_vm;
+
+#ifdef VM_ENABLE_PRECISE_STACK_GC_SCAN
+
+/* The GC "kind" for the VM stack.  */
+static int vm_stack_gc_kind;
+
+#endif
+
+static SCM
+make_vm (void)
+#define FUNC_NAME "make_vm"
+{
+  int i;
+
+  if (!scm_tc16_vm)
+    return SCM_BOOL_F; /* not booted yet */
+
+  struct scm_vm *vp = scm_gc_malloc (sizeof (struct scm_vm), "vm");
+
+  vp->stack_size  = VM_DEFAULT_STACK_SIZE;
+
+#ifdef VM_ENABLE_PRECISE_STACK_GC_SCAN
+  vp->stack_base = GC_generic_malloc (vp->stack_size * sizeof (SCM),
+				      vm_stack_gc_kind);
+
+  /* Keep a pointer to VP so that `vm_stack_mark ()' can know what the stack
+     top is.  */
+  *vp->stack_base = PTR2SCM (vp);
+  vp->stack_base++;
+  vp->stack_size--;
+#else
+  vp->stack_base  = scm_gc_malloc (vp->stack_size * sizeof (SCM),
+				   "stack-base");
+#endif
+
+#ifdef VM_ENABLE_STACK_NULLING
+  memset (vp->stack_base, 0, vp->stack_size * sizeof (SCM));
+#endif
+  vp->stack_limit = vp->stack_base + vp->stack_size;
+  vp->ip    	  = NULL;
+  vp->sp    	  = vp->stack_base - 1;
+  vp->fp    	  = NULL;
+  vp->engine      = SCM_VM_DEBUG_ENGINE;
+  vp->time        = 0;
+  vp->clock       = 0;
+  vp->options     = SCM_EOL;
+  for (i = 0; i < SCM_VM_NUM_HOOKS; i++)
+    vp->hooks[i] = SCM_BOOL_F;
+  vp->trace_frame = SCM_BOOL_F;
+  SCM_RETURN_NEWSMOB (scm_tc16_vm, vp);
+}
+#undef FUNC_NAME
+
+#ifdef VM_ENABLE_PRECISE_STACK_GC_SCAN
+
+/* Mark the VM stack region between its base and its current top.  */
+static struct GC_ms_entry *
+vm_stack_mark (GC_word *addr, struct GC_ms_entry *mark_stack_ptr,
+	       struct GC_ms_entry *mark_stack_limit, GC_word env)
+{
+  GC_word *word;
+  const struct scm_vm *vm;
+
+  /* The first word of the VM stack should contain a pointer to the
+     corresponding VM.  */
+  vm = * ((struct scm_vm **) addr);
+
+  if ((SCM *) addr != vm->stack_base - 1
+      || vm->stack_limit - vm->stack_base != vm->stack_size)
+    /* ADDR must be a pointer to a free-list element, which we must ignore
+       (see warning in <gc/gc_mark.h>).  */
+    return mark_stack_ptr;
+
+  for (word = (GC_word *) vm->stack_base; word <= (GC_word *) vm->sp; word++)
+    mark_stack_ptr = GC_MARK_AND_PUSH ((* (GC_word **) word),
+				       mark_stack_ptr, mark_stack_limit,
+				       NULL);
+
+  return mark_stack_ptr;
+}
+
+#endif /* VM_ENABLE_PRECISE_STACK_GC_SCAN */
+
+
+SCM
+scm_c_vm_run (SCM vm, SCM program, SCM *argv, int nargs)
+{
+  struct scm_vm *vp = SCM_VM_DATA (vm);
+  return vm_engines[vp->engine](vp, program, argv, nargs);
+}
+
+SCM
+scm_vm_apply (SCM vm, SCM program, SCM args)
+#define FUNC_NAME "scm_vm_apply"
+{
+  SCM *argv;
+  int i, nargs;
+  
+  SCM_VALIDATE_VM (1, vm);
+  SCM_VALIDATE_PROGRAM (2, program);
+
+  nargs = scm_ilength (args);
+  if (SCM_UNLIKELY (nargs < 0))
+    scm_wrong_type_arg_msg (FUNC_NAME, 3, args, "list");
+  
+  argv = alloca(nargs * sizeof(SCM));
+  for (i = 0; i < nargs; i++)
+    {
+      argv[i] = SCM_CAR (args);
+      args = SCM_CDR (args);
+    }
+
+  return scm_c_vm_run (vm, program, argv, nargs);
+}
+#undef FUNC_NAME
+
+/* Scheme interface */
+
+SCM_DEFINE (scm_vm_version, "vm-version", 0, 0, 0,
+	    (void),
+	    "")
+#define FUNC_NAME s_scm_vm_version
+{
+  return scm_from_locale_string (PACKAGE_VERSION);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_the_vm, "the-vm", 0, 0, 0,
+	    (void),
+	    "")
+#define FUNC_NAME s_scm_the_vm
+{
+  scm_i_thread *t = SCM_I_CURRENT_THREAD;
+
+  if (SCM_UNLIKELY (SCM_FALSEP ((t->vm))))
+    t->vm = make_vm ();
+
+  return t->vm;
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_vm_p, "vm?", 1, 0, 0,
+	    (SCM obj),
+	    "")
+#define FUNC_NAME s_scm_vm_p
+{
+  return SCM_BOOL (SCM_VM_P (obj));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_make_vm, "make-vm", 0, 0, 0,
+	    (void),
+	    "")
+#define FUNC_NAME s_scm_make_vm,
+{
+  return make_vm ();
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_ip, "vm:ip", 1, 0, 0,
+	    (SCM vm),
+	    "")
+#define FUNC_NAME s_scm_vm_ip
+{
+  SCM_VALIDATE_VM (1, vm);
+  return scm_from_ulong ((unsigned long) SCM_VM_DATA (vm)->ip);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_sp, "vm:sp", 1, 0, 0,
+	    (SCM vm),
+	    "")
+#define FUNC_NAME s_scm_vm_sp
+{
+  SCM_VALIDATE_VM (1, vm);
+  return scm_from_ulong ((unsigned long) SCM_VM_DATA (vm)->sp);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_fp, "vm:fp", 1, 0, 0,
+	    (SCM vm),
+	    "")
+#define FUNC_NAME s_scm_vm_fp
+{
+  SCM_VALIDATE_VM (1, vm);
+  return scm_from_ulong ((unsigned long) SCM_VM_DATA (vm)->fp);
+}
+#undef FUNC_NAME
+
+#define VM_DEFINE_HOOK(n)				\
+{							\
+  struct scm_vm *vp;					\
+  SCM_VALIDATE_VM (1, vm);				\
+  vp = SCM_VM_DATA (vm);				\
+  if (SCM_FALSEP (vp->hooks[n]))			\
+    vp->hooks[n] = scm_make_hook (SCM_I_MAKINUM (1));	\
+  return vp->hooks[n];					\
+}
+
+SCM_DEFINE (scm_vm_boot_hook, "vm-boot-hook", 1, 0, 0,
+	    (SCM vm),
+	    "")
+#define FUNC_NAME s_scm_vm_boot_hook
+{
+  VM_DEFINE_HOOK (SCM_VM_BOOT_HOOK);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_halt_hook, "vm-halt-hook", 1, 0, 0,
+	    (SCM vm),
+	    "")
+#define FUNC_NAME s_scm_vm_halt_hook
+{
+  VM_DEFINE_HOOK (SCM_VM_HALT_HOOK);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_next_hook, "vm-next-hook", 1, 0, 0,
+	    (SCM vm),
+	    "")
+#define FUNC_NAME s_scm_vm_next_hook
+{
+  VM_DEFINE_HOOK (SCM_VM_NEXT_HOOK);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_break_hook, "vm-break-hook", 1, 0, 0,
+	    (SCM vm),
+	    "")
+#define FUNC_NAME s_scm_vm_break_hook
+{
+  VM_DEFINE_HOOK (SCM_VM_BREAK_HOOK);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_enter_hook, "vm-enter-hook", 1, 0, 0,
+	    (SCM vm),
+	    "")
+#define FUNC_NAME s_scm_vm_enter_hook
+{
+  VM_DEFINE_HOOK (SCM_VM_ENTER_HOOK);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_apply_hook, "vm-apply-hook", 1, 0, 0,
+	    (SCM vm),
+	    "")
+#define FUNC_NAME s_scm_vm_apply_hook
+{
+  VM_DEFINE_HOOK (SCM_VM_APPLY_HOOK);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_exit_hook, "vm-exit-hook", 1, 0, 0,
+	    (SCM vm),
+	    "")
+#define FUNC_NAME s_scm_vm_exit_hook
+{
+  VM_DEFINE_HOOK (SCM_VM_EXIT_HOOK);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_return_hook, "vm-return-hook", 1, 0, 0,
+	    (SCM vm),
+	    "")
+#define FUNC_NAME s_scm_vm_return_hook
+{
+  VM_DEFINE_HOOK (SCM_VM_RETURN_HOOK);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_option, "vm-option", 2, 0, 0,
+	    (SCM vm, SCM key),
+	    "")
+#define FUNC_NAME s_scm_vm_option
+{
+  SCM_VALIDATE_VM (1, vm);
+  return scm_assq_ref (SCM_VM_DATA (vm)->options, key);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_set_vm_option_x, "set-vm-option!", 3, 0, 0,
+	    (SCM vm, SCM key, SCM val),
+	    "")
+#define FUNC_NAME s_scm_set_vm_option_x
+{
+  SCM_VALIDATE_VM (1, vm);
+  SCM_VM_DATA (vm)->options
+    = scm_assq_set_x (SCM_VM_DATA (vm)->options, key, val);
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_stats, "vm-stats", 1, 0, 0,
+	    (SCM vm),
+	    "")
+#define FUNC_NAME s_scm_vm_stats
+{
+  SCM stats;
+
+  SCM_VALIDATE_VM (1, vm);
+
+  stats = scm_make_vector (SCM_I_MAKINUM (2), SCM_UNSPECIFIED);
+  scm_vector_set_x (stats, SCM_I_MAKINUM (0),
+		    scm_from_ulong (SCM_VM_DATA (vm)->time));
+  scm_vector_set_x (stats, SCM_I_MAKINUM (1),
+		    scm_from_ulong (SCM_VM_DATA (vm)->clock));
+
+  return stats;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_trace_frame, "vm-trace-frame", 1, 0, 0,
+	    (SCM vm),
+	    "")
+#define FUNC_NAME s_scm_vm_trace_frame
+{
+  SCM_VALIDATE_VM (1, vm);
+  return SCM_VM_DATA (vm)->trace_frame;
+}
+#undef FUNC_NAME
+
+
+/*
+ * Initialize
+ */
+
+SCM scm_load_compiled_with_vm (SCM file)
+{
+  SCM program = scm_make_program (scm_load_objcode (file),
+                                  SCM_BOOL_F, SCM_BOOL_F);
+  
+  return scm_c_vm_run (scm_the_vm (), program, NULL, 0);
+}
+
+void
+scm_bootstrap_vm (void)
+{
+  static int strappage = 0;
+  
+  if (strappage)
+    return;
+
+  scm_bootstrap_frames ();
+  scm_bootstrap_instructions ();
+  scm_bootstrap_objcodes ();
+  scm_bootstrap_programs ();
+
+  scm_tc16_vm_cont = scm_make_smob_type ("vm-cont", 0);
+
+  scm_tc16_vm = scm_make_smob_type ("vm", 0);
+  scm_set_smob_apply (scm_tc16_vm, scm_vm_apply, 1, 0, 1);
+
+  scm_c_define ("load-compiled",
+                scm_c_make_gsubr ("load-compiled/vm", 1, 0, 0,
+                                  scm_load_compiled_with_vm));
+
+  sym_vm_run = scm_permanent_object (scm_from_locale_symbol ("vm-run"));
+  sym_vm_error = scm_permanent_object (scm_from_locale_symbol ("vm-error"));
+  sym_debug = scm_permanent_object (scm_from_locale_symbol ("debug"));
+
+  scm_c_register_extension ("libguile", "scm_init_vm",
+                            (scm_t_extension_init_func)scm_init_vm, NULL);
+
+  strappage = 1;
+
+#ifdef VM_ENABLE_PRECISE_STACK_GC_SCAN
+  vm_stack_gc_kind =
+    GC_new_kind (GC_new_free_list (),
+		 GC_MAKE_PROC (GC_new_proc (vm_stack_mark), 0),
+		 0, 1);
+
+#endif
+}
+
+void
+scm_init_vm (void)
+{
+  scm_bootstrap_vm ();
+
+#ifndef SCM_MAGIC_SNARFER
+#include "libguile/vm.x"
+#endif
+}
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/vm.h b/libguile/vm.h
new file mode 100644
index 000000000..eace1cb69
--- /dev/null
+++ b/libguile/vm.h
@@ -0,0 +1,116 @@
+/* Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+ * 
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+#ifndef _SCM_VM_H_
+#define _SCM_VM_H_
+
+#include <libguile.h>
+#include <libguile/programs.h>
+
+#define SCM_VM_BOOT_HOOK	0
+#define SCM_VM_HALT_HOOK	1
+#define SCM_VM_NEXT_HOOK	2
+#define SCM_VM_BREAK_HOOK	3
+#define SCM_VM_ENTER_HOOK	4
+#define SCM_VM_APPLY_HOOK	5
+#define SCM_VM_EXIT_HOOK	6
+#define SCM_VM_RETURN_HOOK	7
+#define SCM_VM_NUM_HOOKS	8
+
+struct scm_vm;
+
+typedef SCM (*scm_t_vm_engine) (struct scm_vm *vp, SCM program, SCM *argv, int nargs);
+
+#define SCM_VM_REGULAR_ENGINE 0
+#define SCM_VM_DEBUG_ENGINE 1
+#define SCM_VM_NUM_ENGINES 2
+
+struct scm_vm {
+  scm_t_uint8 *ip;		/* instruction pointer */
+  SCM *sp;			/* stack pointer */
+  SCM *fp;			/* frame pointer */
+  size_t stack_size;		/* stack size */
+  SCM *stack_base;		/* stack base address */
+  SCM *stack_limit;		/* stack limit address */
+  int engine;                   /* which vm engine we're using */
+  SCM hooks[SCM_VM_NUM_HOOKS];	/* hooks */
+  SCM options;			/* options */
+  unsigned long time;		/* time spent */
+  unsigned long clock;		/* bogos clock */
+  SCM trace_frame;              /* a frame being traced */
+};
+
+SCM_API SCM scm_the_vm_fluid;
+
+#define SCM_VM_P(x)		SCM_SMOB_PREDICATE (scm_tc16_vm, x)
+#define SCM_VM_DATA(vm)		((struct scm_vm *) SCM_SMOB_DATA (vm))
+#define SCM_VALIDATE_VM(pos,x)	SCM_MAKE_VALIDATE (pos, x, VM_P)
+
+SCM_API SCM scm_the_vm ();
+SCM_API SCM scm_make_vm (void);
+SCM_API SCM scm_vm_apply (SCM vm, SCM program, SCM args);
+SCM_API SCM scm_c_vm_run (SCM vm, SCM program, SCM *argv, int nargs);
+SCM_API SCM scm_vm_option_ref (SCM vm, SCM key);
+SCM_API SCM scm_vm_option_set_x (SCM vm, SCM key, SCM val);
+
+SCM_API SCM scm_vm_version (void);
+SCM_API SCM scm_the_vm (void);
+SCM_API SCM scm_vm_p (SCM obj);
+SCM_API SCM scm_vm_ip (SCM vm);
+SCM_API SCM scm_vm_sp (SCM vm);
+SCM_API SCM scm_vm_fp (SCM vm);
+SCM_API SCM scm_vm_boot_hook (SCM vm);
+SCM_API SCM scm_vm_halt_hook (SCM vm);
+SCM_API SCM scm_vm_next_hook (SCM vm);
+SCM_API SCM scm_vm_break_hook (SCM vm);
+SCM_API SCM scm_vm_enter_hook (SCM vm);
+SCM_API SCM scm_vm_apply_hook (SCM vm);
+SCM_API SCM scm_vm_exit_hook (SCM vm);
+SCM_API SCM scm_vm_return_hook (SCM vm);
+SCM_API SCM scm_vm_option (SCM vm, SCM key);
+SCM_API SCM scm_set_vm_option_x (SCM vm, SCM key, SCM val);
+SCM_API SCM scm_vm_stats (SCM vm);
+SCM_API SCM scm_vm_trace_frame (SCM vm);
+
+struct scm_vm_cont {
+  scm_t_uint8 *ip;
+  SCM *sp;
+  SCM *fp;
+  scm_t_ptrdiff stack_size;
+  SCM *stack_base;
+  scm_t_ptrdiff reloc;
+};
+
+SCM_API scm_t_bits scm_tc16_vm_cont;
+#define SCM_VM_CONT_P(OBJ)	SCM_SMOB_PREDICATE (scm_tc16_vm_cont, OBJ)
+#define SCM_VM_CONT_DATA(CONT)	((struct scm_vm_cont *) SCM_CELL_WORD_1 (CONT))
+
+SCM_API SCM scm_vm_capture_continuations (void);
+SCM_API void scm_vm_reinstate_continuations (SCM conts);
+
+SCM_API SCM scm_load_compiled_with_vm (SCM file);
+
+SCM_INTERNAL void scm_init_vm (void);
+
+#endif /* _SCM_VM_H_ */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/vports.c b/libguile/vports.c
index 564f0e73f..cea11c61d 100644
--- a/libguile/vports.c
+++ b/libguile/vports.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1995,1996,1998,1999,2000,2001, 2002, 2003, 2006 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/vports.h b/libguile/vports.h
index 365303bc1..ae64dd438 100644
--- a/libguile/vports.h
+++ b/libguile/vports.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,2000, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/weaks.c b/libguile/weaks.c
index 6af4d6722..4719980a7 100644
--- a/libguile/weaks.c
+++ b/libguile/weaks.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1995,1996,1998,2000,2001, 2003, 2006, 2008, 2009 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/weaks.h b/libguile/weaks.h
index 81c17749f..908e27628 100644
--- a/libguile/weaks.h
+++ b/libguile/weaks.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 1995,1996,2000,2001, 2003, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/win32-dirent.c b/libguile/win32-dirent.c
index cd7e8bac6..de170c70b 100644
--- a/libguile/win32-dirent.c
+++ b/libguile/win32-dirent.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 2001, 2006, 2008 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 #ifdef HAVE_CONFIG_H
diff --git a/libguile/win32-dirent.h b/libguile/win32-dirent.h
index 30bc118ea..578db49b9 100644
--- a/libguile/win32-dirent.h
+++ b/libguile/win32-dirent.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 2001, 2006 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 /* Directory stream type.
diff --git a/libguile/win32-socket.c b/libguile/win32-socket.c
index 54f80a764..e845d886a 100644
--- a/libguile/win32-socket.c
+++ b/libguile/win32-socket.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 2001, 2006 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/libguile/win32-socket.h b/libguile/win32-socket.h
index 51856051d..4ab9b942a 100644
--- a/libguile/win32-socket.h
+++ b/libguile/win32-socket.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 2001, 2006 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 #include "libguile/__scm.h"
diff --git a/libguile/win32-uname.c b/libguile/win32-uname.c
index d4d737f49..5349f1410 100644
--- a/libguile/win32-uname.c
+++ b/libguile/win32-uname.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 2001, 2006, 2008 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 #ifdef HAVE_CONFIG_H
diff --git a/libguile/win32-uname.h b/libguile/win32-uname.h
index 8593dc7d9..4b7498133 100644
--- a/libguile/win32-uname.h
+++ b/libguile/win32-uname.h
@@ -6,18 +6,19 @@
 /* Copyright (C) 2001, 2006 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 #define _UTSNAME_LENGTH 65
diff --git a/m4/00gnulib.m4 b/m4/00gnulib.m4
new file mode 100644
index 000000000..d4d04d153
--- /dev/null
+++ b/m4/00gnulib.m4
@@ -0,0 +1,30 @@
+# 00gnulib.m4 serial 2
+dnl Copyright (C) 2009 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+dnl This file must be named something that sorts before all other
+dnl gnulib-provided .m4 files.  It is needed until such time as we can
+dnl assume Autoconf 2.64, with its improved AC_DEFUN_ONCE semantics.
+
+# AC_DEFUN_ONCE([NAME], VALUE)
+# ----------------------------
+# Define NAME to expand to VALUE on the first use (whether by direct
+# expansion, or by AC_REQUIRE), and to nothing on all subsequent uses.
+# Avoid bugs in AC_REQUIRE in Autoconf 2.63 and earlier.  This
+# definition is slower than the version in Autoconf 2.64, because it
+# can only use interfaces that existed since 2.59; but it achieves the
+# same effect.  Quoting is necessary to avoid confusing Automake.
+m4_version_prereq([2.63.263], [],
+[m4_define([AC][_DEFUN_ONCE],
+  [AC][_DEFUN([$1],
+    [AC_REQUIRE([_gl_DEFUN_ONCE([$1])],
+      [m4_indir([_gl_DEFUN_ONCE([$1])])])])]dnl
+[AC][_DEFUN([_gl_DEFUN_ONCE([$1])], [$2])])])
+
+# gl_00GNULIB
+# -----------
+# Witness macro that this file has been included.  Needed to force
+# Automake to include this file prior to all other gnulib .m4 files.
+AC_DEFUN([gl_00GNULIB])
diff --git a/m4/alloca.m4 b/m4/alloca.m4
index 95f54a6d4..4b978e137 100644
--- a/m4/alloca.m4
+++ b/m4/alloca.m4
@@ -1,5 +1,5 @@
-# alloca.m4 serial 8
-dnl Copyright (C) 2002-2004, 2006, 2007 Free Software Foundation, Inc.
+# alloca.m4 serial 9
+dnl Copyright (C) 2002-2004, 2006, 2007, 2009 Free Software Foundation, Inc.
 dnl This file is free software; the Free Software Foundation
 dnl gives unlimited permission to copy and/or distribute it,
 dnl with or without modifications, as long as this notice is preserved.
@@ -26,7 +26,7 @@ AC_DEFUN([gl_FUNC_ALLOCA],
     ])
     if test $gl_cv_rpl_alloca = yes; then
       dnl OK, alloca can be implemented through a compiler built-in.
-      AC_DEFINE([HAVE_ALLOCA], 1,
+      AC_DEFINE([HAVE_ALLOCA], [1],
         [Define to 1 if you have 'alloca' after including <alloca.h>,
          a header that may be supplied by this distribution.])
       ALLOCA_H=alloca.h
diff --git a/m4/byteswap.m4 b/m4/byteswap.m4
new file mode 100644
index 000000000..ad13f2286
--- /dev/null
+++ b/m4/byteswap.m4
@@ -0,0 +1,18 @@
+# byteswap.m4 serial 3
+dnl Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+dnl Written by Oskar Liljeblad.
+
+AC_DEFUN([gl_BYTESWAP],
+[
+  dnl Prerequisites of lib/byteswap.in.h.
+  AC_CHECK_HEADERS([byteswap.h], [
+    BYTESWAP_H=''
+  ], [
+    BYTESWAP_H='byteswap.h'
+  ])
+  AC_SUBST([BYTESWAP_H])
+])
diff --git a/m4/canonicalize-lgpl.m4 b/m4/canonicalize-lgpl.m4
new file mode 100644
index 000000000..3a8ee2f95
--- /dev/null
+++ b/m4/canonicalize-lgpl.m4
@@ -0,0 +1,35 @@
+# canonicalize-lgpl.m4 serial 5
+dnl Copyright (C) 2003, 2006-2007, 2009 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN([gl_CANONICALIZE_LGPL],
+[
+  dnl Do this replacement check manually because the file name is shorter
+  dnl than the function name.
+  AC_CHECK_DECLS_ONCE([canonicalize_file_name])
+  AC_CHECK_FUNCS_ONCE([canonicalize_file_name])
+  if test $ac_cv_func_canonicalize_file_name = no; then
+    AC_LIBOBJ([canonicalize-lgpl])
+    AC_DEFINE([realpath], [rpl_realpath],
+      [Define to a replacement function name for realpath().])
+    gl_PREREQ_CANONICALIZE_LGPL
+  fi
+])
+
+# Like gl_CANONICALIZE_LGPL, except prepare for separate compilation
+# (no AC_LIBOBJ).
+AC_DEFUN([gl_CANONICALIZE_LGPL_SEPARATE],
+[
+  AC_CHECK_DECLS_ONCE([canonicalize_file_name])
+  AC_CHECK_FUNCS_ONCE([canonicalize_file_name])
+  gl_PREREQ_CANONICALIZE_LGPL
+])
+
+# Prerequisites of lib/canonicalize-lgpl.c.
+AC_DEFUN([gl_PREREQ_CANONICALIZE_LGPL],
+[
+  AC_CHECK_HEADERS_ONCE([sys/param.h unistd.h])
+  AC_CHECK_FUNCS_ONCE([getcwd readlink])
+])
diff --git a/m4/codeset.m4 b/m4/codeset.m4
index de4181d7d..413217bd4 100644
--- a/m4/codeset.m4
+++ b/m4/codeset.m4
@@ -1,5 +1,5 @@
-# codeset.m4 serial 3 (gettext-0.18)
-dnl Copyright (C) 2000-2002, 2006, 2008 Free Software Foundation, Inc.
+# codeset.m4 serial 4 (gettext-0.18)
+dnl Copyright (C) 2000-2002, 2006, 2008, 2009 Free Software Foundation, Inc.
 dnl This file is free software; the Free Software Foundation
 dnl gives unlimited permission to copy and/or distribute it,
 dnl with or without modifications, as long as this notice is preserved.
@@ -15,7 +15,7 @@ AC_DEFUN([AM_LANGINFO_CODESET],
       [am_cv_langinfo_codeset=no])
     ])
   if test $am_cv_langinfo_codeset = yes; then
-    AC_DEFINE([HAVE_LANGINFO_CODESET], 1,
+    AC_DEFINE([HAVE_LANGINFO_CODESET], [1],
       [Define if you have <langinfo.h> and nl_langinfo(CODESET).])
   fi
 ])
diff --git a/m4/eealloc.m4 b/m4/eealloc.m4
new file mode 100644
index 000000000..3c9c0b52a
--- /dev/null
+++ b/m4/eealloc.m4
@@ -0,0 +1,32 @@
+# eealloc.m4 serial 2
+dnl Copyright (C) 2003, 2009 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN([gl_EEALLOC],
+[
+  AC_REQUIRE([gl_EEMALLOC])
+  AC_REQUIRE([gl_EEREALLOC])
+  AC_REQUIRE([AC_C_INLINE])
+])
+
+AC_DEFUN([gl_EEMALLOC],
+[
+  _AC_FUNC_MALLOC_IF(
+    [gl_cv_func_malloc_0_nonnull=1],
+    [gl_cv_func_malloc_0_nonnull=0])
+  AC_DEFINE_UNQUOTED([MALLOC_0_IS_NONNULL], [$gl_cv_func_malloc_0_nonnull],
+    [If malloc(0) is != NULL, define this to 1.  Otherwise define this
+     to 0.])
+])
+
+AC_DEFUN([gl_EEREALLOC],
+[
+  _AC_FUNC_REALLOC_IF(
+    [gl_cv_func_realloc_0_nonnull=1],
+    [gl_cv_func_realloc_0_nonnull=0])
+  AC_DEFINE_UNQUOTED([REALLOC_0_IS_NONNULL], [$gl_cv_func_realloc_0_nonnull],
+    [If realloc(NULL,0) is != NULL, define this to 1.  Otherwise define this
+     to 0.])
+])
diff --git a/m4/environ.m4 b/m4/environ.m4
new file mode 100644
index 000000000..b17bb60a7
--- /dev/null
+++ b/m4/environ.m4
@@ -0,0 +1,36 @@
+# environ.m4 serial 2
+dnl Copyright (C) 2001-2004, 2006-2009 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN([gl_ENVIRON],
+[
+  AC_REQUIRE([gl_UNISTD_H_DEFAULTS])
+  dnl Persuade glibc <unistd.h> to declare environ.
+  AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
+  gt_CHECK_VAR_DECL([#include <unistd.h>], environ)
+  if test $gt_cv_var_environ_declaration != yes; then
+    HAVE_DECL_ENVIRON=0
+  fi
+])
+
+# Check if a variable is properly declared.
+# gt_CHECK_VAR_DECL(includes,variable)
+AC_DEFUN([gt_CHECK_VAR_DECL],
+[
+  define([gt_cv_var], [gt_cv_var_]$2[_declaration])
+  AC_MSG_CHECKING([if $2 is properly declared])
+  AC_CACHE_VAL([gt_cv_var], [
+    AC_TRY_COMPILE([$1
+      extern struct { int foo; } $2;],
+      [$2.foo = 1;],
+      gt_cv_var=no,
+      gt_cv_var=yes)])
+  AC_MSG_RESULT([$gt_cv_var])
+  if test $gt_cv_var = yes; then
+    AC_DEFINE([HAVE_]translit($2, [a-z], [A-Z])[_DECL], 1,
+              [Define if you have the declaration of $2.])
+  fi
+  undefine([gt_cv_var])
+])
diff --git a/m4/errno_h.m4 b/m4/errno_h.m4
new file mode 100644
index 000000000..4ce1ccbd9
--- /dev/null
+++ b/m4/errno_h.m4
@@ -0,0 +1,115 @@
+# errno_h.m4 serial 6
+dnl Copyright (C) 2004, 2006, 2008, 2009 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN_ONCE([gl_HEADER_ERRNO_H],
+[
+  AC_REQUIRE([AC_PROG_CC])
+  AC_CACHE_CHECK([for complete errno.h], [gl_cv_header_errno_h_complete], [
+    AC_EGREP_CPP([booboo],[
+#include <errno.h>
+#if !defined ENOMSG
+booboo
+#endif
+#if !defined EIDRM
+booboo
+#endif
+#if !defined ENOLINK
+booboo
+#endif
+#if !defined EPROTO
+booboo
+#endif
+#if !defined EMULTIHOP
+booboo
+#endif
+#if !defined EBADMSG
+booboo
+#endif
+#if !defined EOVERFLOW
+booboo
+#endif
+#if !defined ENOTSUP
+booboo
+#endif
+#if !defined ESTALE
+booboo
+#endif
+#if !defined ECANCELED
+booboo
+#endif
+      ],
+      [gl_cv_header_errno_h_complete=no],
+      [gl_cv_header_errno_h_complete=yes])
+  ])
+  if test $gl_cv_header_errno_h_complete = yes; then
+    ERRNO_H=''
+  else
+    gl_CHECK_NEXT_HEADERS([errno.h])
+    ERRNO_H='errno.h'
+  fi
+  AC_SUBST([ERRNO_H])
+  gl_REPLACE_ERRNO_VALUE([EMULTIHOP])
+  gl_REPLACE_ERRNO_VALUE([ENOLINK])
+  gl_REPLACE_ERRNO_VALUE([EOVERFLOW])
+])
+
+# Assuming $1 = EOVERFLOW.
+# The EOVERFLOW errno value ought to be defined in <errno.h>, according to
+# POSIX.  But some systems (like OpenBSD 4.0 or AIX 3) don't define it, and
+# some systems (like OSF/1) define it when _XOPEN_SOURCE_EXTENDED is defined.
+# Check for the value of EOVERFLOW.
+# Set the variables EOVERFLOW_HIDDEN and EOVERFLOW_VALUE.
+AC_DEFUN([gl_REPLACE_ERRNO_VALUE],
+[
+  if test -n "$ERRNO_H"; then
+    AC_CACHE_CHECK([for ]$1[ value], [gl_cv_header_errno_h_]$1, [
+      AC_EGREP_CPP([yes],[
+#include <errno.h>
+#ifdef ]$1[
+yes
+#endif
+      ],
+      [gl_cv_header_errno_h_]$1[=yes],
+      [gl_cv_header_errno_h_]$1[=no])
+      if test $gl_cv_header_errno_h_]$1[ = no; then
+        AC_EGREP_CPP([yes],[
+#define _XOPEN_SOURCE_EXTENDED 1
+#include <errno.h>
+#ifdef ]$1[
+yes
+#endif
+          ], [gl_cv_header_errno_h_]$1[=hidden])
+        if test $gl_cv_header_errno_h_]$1[ = hidden; then
+          dnl The macro exists but is hidden.
+          dnl Define it to the same value.
+          AC_COMPUTE_INT([gl_cv_header_errno_h_]$1, $1, [
+#define _XOPEN_SOURCE_EXTENDED 1
+#include <errno.h>
+/* The following two lines are a workaround against an autoconf-2.52 bug.  */
+#include <stdio.h>
+#include <stdlib.h>
+])
+        fi
+      fi
+    ])
+    case $gl_cv_header_errno_h_]$1[ in
+      yes | no)
+        ]$1[_HIDDEN=0; ]$1[_VALUE=
+        ;;
+      *)
+        ]$1[_HIDDEN=1; ]$1[_VALUE="$gl_cv_header_errno_h_]$1["
+        ;;
+    esac
+    AC_SUBST($1[_HIDDEN])
+    AC_SUBST($1[_VALUE])
+  fi
+])
+
+dnl Autoconf >= 2.61 has AC_COMPUTE_INT built-in.
+dnl Remove this when we can assume autoconf >= 2.61.
+m4_ifdef([AC_COMPUTE_INT], [], [
+  AC_DEFUN([AC_COMPUTE_INT], [_AC_COMPUTE_INT([$2],[$1],[$3],[$4])])
+])
diff --git a/m4/extensions.m4 b/m4/extensions.m4
index 611fcfdbc..ba6d5e190 100644
--- a/m4/extensions.m4
+++ b/m4/extensions.m4
@@ -1,7 +1,7 @@
-# serial 6  -*- Autoconf -*-
+# serial 8  -*- Autoconf -*-
 # Enable extensions on systems that normally disable them.
 
-# Copyright (C) 2003, 2006-2008 Free Software Foundation, Inc.
+# Copyright (C) 2003, 2006-2009 Free Software Foundation, Inc.
 # This file is free software; the Free Software Foundation
 # gives unlimited permission to copy and/or distribute it,
 # with or without modifications, as long as this notice is preserved.
@@ -20,7 +20,7 @@
 # AC_DEFINE.  The goal here is to define all known feature-enabling
 # macros, then, if reports of conflicts are made, disable macros that
 # cause problems on some platforms (such as __EXTENSIONS__).
-AC_DEFUN([AC_USE_SYSTEM_EXTENSIONS],
+AC_DEFUN_ONCE([AC_USE_SYSTEM_EXTENSIONS],
 [AC_BEFORE([$0], [AC_COMPILE_IFELSE])dnl
 AC_BEFORE([$0], [AC_RUN_IFELSE])dnl
 
@@ -90,5 +90,15 @@ AC_BEFORE([$0], [AC_RUN_IFELSE])dnl
 # ------------------------
 # Enable extensions on systems that normally disable them,
 # typically due to standards-conformance issues.
-AC_DEFUN([gl_USE_SYSTEM_EXTENSIONS],
-  [AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS])])
+AC_DEFUN_ONCE([gl_USE_SYSTEM_EXTENSIONS],
+[
+  dnl Require this macro before AC_USE_SYSTEM_EXTENSIONS.
+  dnl gnulib does not need it. But if it gets required by third-party macros
+  dnl after AC_USE_SYSTEM_EXTENSIONS is required, autoconf 2.62..2.63 emit a
+  dnl warning: "AC_COMPILE_IFELSE was called before AC_USE_SYSTEM_EXTENSIONS".
+  dnl Note: We can do this only for one of the macros AC_AIX, AC_GNU_SOURCE,
+  dnl AC_MINIX. If people still use AC_AIX or AC_MINIX, they are out of luck.
+  AC_REQUIRE([AC_GNU_SOURCE])
+
+  AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS])
+])
diff --git a/m4/float_h.m4 b/m4/float_h.m4
new file mode 100644
index 000000000..d36e3a46c
--- /dev/null
+++ b/m4/float_h.m4
@@ -0,0 +1,19 @@
+# float_h.m4 serial 3
+dnl Copyright (C) 2007 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN([gl_FLOAT_H],
+[
+  AC_REQUIRE([AC_PROG_CC])
+  AC_REQUIRE([AC_CANONICAL_HOST])
+  FLOAT_H=
+  case "$host_os" in
+    beos* | openbsd*)
+      FLOAT_H=float.h
+      gl_CHECK_NEXT_HEADERS([float.h])
+      ;;
+  esac
+  AC_SUBST([FLOAT_H])
+])
diff --git a/m4/flock.m4 b/m4/flock.m4
new file mode 100644
index 000000000..96475fc57
--- /dev/null
+++ b/m4/flock.m4
@@ -0,0 +1,26 @@
+# flock.m4 serial 1
+dnl Copyright (C) 2008 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN([gl_FUNC_FLOCK],
+[
+  AC_REQUIRE([gl_HEADER_SYS_FILE_H_DEFAULTS])
+  AC_CHECK_FUNCS_ONCE([flock])
+  if test $ac_cv_func_flock = no; then
+    HAVE_FLOCK=0
+    AC_LIBOBJ([flock])
+    gl_PREREQ_FLOCK
+  fi
+])
+
+dnl Prerequisites of lib/flock.c.
+AC_DEFUN([gl_PREREQ_FLOCK],
+[
+  AC_CHECK_FUNCS_ONCE([fcntl])
+  AC_CHECK_HEADERS_ONCE([unistd.h fcntl.h])
+
+  dnl Do we have a POSIX fcntl lock implementation?
+  AC_CHECK_MEMBERS([struct flock.l_type],[],[],[[#include <fcntl.h>]])
+])
diff --git a/m4/fpieee.m4 b/m4/fpieee.m4
new file mode 100644
index 000000000..9f4a92cb3
--- /dev/null
+++ b/m4/fpieee.m4
@@ -0,0 +1,52 @@
+# fpieee.m4 serial 1
+dnl Copyright (C) 2007 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+dnl IEEE 754 standardized three items:
+dnl - The formats of single-float and double-float - nowadays commonly
+dnl   available as 'float' and 'double' in C and C++.
+dnl   No autoconf test needed.
+dnl - The overflow and division by zero behaviour: The result are values
+dnl   '±Inf' and 'NaN', rather than exceptions as it was before.
+dnl   This file provides an autoconf macro for ensuring this behaviour of
+dnl   floating-point operations.
+dnl - A set of conditions (overflow, underflow, inexact, etc.) which can
+dnl   be configured to trigger an exception.
+dnl   This cannot be done in a portable way: it depends on the compiler,
+dnl   libc, kernel, and CPU.  No autoconf macro is provided for this.
+
+dnl Ensure non-trapping behaviour of floating-point overflow and
+dnl floating-point division by zero.
+dnl (For integer overflow, see gcc's -ftrapv option; for integer division by
+dnl zero, see the autoconf macro in intdiv0.m4.)
+
+AC_DEFUN([gl_FP_IEEE],
+[
+  AC_REQUIRE([AC_PROG_CC])
+  AC_REQUIRE([AC_CANONICAL_HOST])
+  # IEEE behaviour is the default on all CPUs except Alpha and SH
+  # (according to the test results of Bruno Haible's ieeefp/fenv_default.m4
+  # and the GCC 4.1.2 manual).
+  case "$host_cpu" in
+    alpha*)
+      # On Alpha systems, a compiler option provides the behaviour.
+      # See the ieee(3) manual page, also available at
+      # <http://h30097.www3.hp.com/docs/base_doc/DOCUMENTATION/V51B_HTML/MAN/MAN3/0600____.HTM>
+      if test -n "$GCC"; then
+        # GCC has the option -mieee.
+        CPPFLAGS="$CPPFLAGS -mieee"
+      else
+        # Compaq (ex-DEC) C has the option -ieee.
+        CPPFLAGS="$CPPFLAGS -ieee"
+      fi
+      ;;
+    sh*)
+      if test -n "$GCC"; then
+        # GCC has the option -mieee.
+        CPPFLAGS="$CPPFLAGS -mieee"
+      fi
+      ;;
+  esac
+])
diff --git a/m4/getpagesize.m4 b/m4/getpagesize.m4
new file mode 100644
index 000000000..0d07a3a53
--- /dev/null
+++ b/m4/getpagesize.m4
@@ -0,0 +1,29 @@
+# getpagesize.m4 serial 7
+dnl Copyright (C) 2002, 2004-2005, 2007 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN([gl_FUNC_GETPAGESIZE],
+[
+  AC_REQUIRE([gl_UNISTD_H_DEFAULTS])
+  AC_REQUIRE([AC_CANONICAL_HOST])
+  AC_CHECK_FUNCS([getpagesize])
+  if test $ac_cv_func_getpagesize = no; then
+    HAVE_GETPAGESIZE=0
+    AC_CHECK_HEADERS([OS.h])
+    if test $ac_cv_header_OS_h = yes; then
+      HAVE_OS_H=1
+    fi
+    AC_CHECK_HEADERS([sys/param.h])
+    if test $ac_cv_header_sys_param_h = yes; then
+      HAVE_SYS_PARAM_H=1
+    fi
+  fi
+  case "$host_os" in
+    mingw*)
+      REPLACE_GETPAGESIZE=1
+      AC_LIBOBJ([getpagesize])
+      ;;
+  esac
+])
diff --git a/m4/gnulib-cache.m4 b/m4/gnulib-cache.m4
index 2986b3cc4..b3a6d9996 100644
--- a/m4/gnulib-cache.m4
+++ b/m4/gnulib-cache.m4
@@ -15,18 +15,34 @@
 
 
 # Specification in the form of a command-line invocation:
-#   gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --lgpl --libtool --macro-prefix=gl --no-vc-files alloca-opt autobuild extensions full-read full-write strcase strftime
+#   gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --lgpl --libtool --macro-prefix=gl --no-vc-files alloca-opt autobuild byteswap canonicalize-lgpl environ extensions flock fpieee full-read full-write havelib iconv_open-utf lib-symbol-versions lib-symbol-visibility libunistring putenv stdlib strcase strftime striconveh string verify vsnprintf
 
 # Specification in the form of a few gnulib-tool.m4 macro invocations:
 gl_LOCAL_DIR([])
 gl_MODULES([
   alloca-opt
   autobuild
+  byteswap
+  canonicalize-lgpl
+  environ
   extensions
+  flock
+  fpieee
   full-read
   full-write
+  havelib
+  iconv_open-utf
+  lib-symbol-versions
+  lib-symbol-visibility
+  libunistring
+  putenv
+  stdlib
   strcase
   strftime
+  striconveh
+  string
+  verify
+  vsnprintf
 ])
 gl_AVOID([])
 gl_SOURCE_BASE([lib])
diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4
index c73db14cc..c8fda2033 100644
--- a/m4/gnulib-common.m4
+++ b/m4/gnulib-common.m4
@@ -1,5 +1,5 @@
-# gnulib-common.m4 serial 6
-dnl Copyright (C) 2007-2008 Free Software Foundation, Inc.
+# gnulib-common.m4 serial 11
+dnl Copyright (C) 2007-2009 Free Software Foundation, Inc.
 dnl This file is free software; the Free Software Foundation
 dnl gives unlimited permission to copy and/or distribute it,
 dnl with or without modifications, as long as this notice is preserved.
@@ -8,6 +8,7 @@ dnl with or without modifications, as long as this notice is preserved.
 # is expanded unconditionally through gnulib-tool magic.
 AC_DEFUN([gl_COMMON], [
   dnl Use AC_REQUIRE here, so that the code is expanded once only.
+  AC_REQUIRE([gl_00GNULIB])
   AC_REQUIRE([gl_COMMON_BODY])
 ])
 AC_DEFUN([gl_COMMON_BODY], [
@@ -52,7 +53,7 @@ m4_ifndef([m4_foreach_w],
 # is a backport of autoconf-2.60's AC_PROG_MKDIR_P.
 # Remove this macro when we can assume autoconf >= 2.60.
 m4_ifdef([AC_PROG_MKDIR_P], [], [
-  AC_DEFUN([AC_PROG_MKDIR_P],
+  AC_DEFUN_ONCE([AC_PROG_MKDIR_P],
     [AC_REQUIRE([AM_PROG_MKDIR_P])dnl defined by automake
      MKDIR_P='$(mkdir_p)'
      AC_SUBST([MKDIR_P])])])
@@ -63,7 +64,7 @@ m4_ifdef([AC_PROG_MKDIR_P], [], [
 # works.
 # This definition can be removed once autoconf >= 2.62 can be assumed.
 AC_DEFUN([AC_C_RESTRICT],
-[AC_CACHE_CHECK([for C/C++ restrict keyword], ac_cv_c_restrict,
+[AC_CACHE_CHECK([for C/C++ restrict keyword], [ac_cv_c_restrict],
   [ac_cv_c_restrict=no
    # The order here caters to the fact that C++ does not require restrict.
    for ac_kw in __restrict __restrict__ _Restrict restrict; do
@@ -99,3 +100,25 @@ AC_DEFUN([AC_C_RESTRICT],
    *)  AC_DEFINE_UNQUOTED([restrict], [$ac_cv_c_restrict]) ;;
  esac
 ])
+
+# gl_BIGENDIAN
+# is like AC_C_BIGENDIAN, except that it can be AC_REQUIREd.
+# Note that AC_REQUIRE([AC_C_BIGENDIAN]) does not work reliably because some
+# macros invoke AC_C_BIGENDIAN with arguments.
+AC_DEFUN([gl_BIGENDIAN],
+[
+  AC_C_BIGENDIAN
+])
+
+# gl_CACHE_VAL_SILENT(cache-id, command-to-set-it)
+# is like AC_CACHE_VAL(cache-id, command-to-set-it), except that it does not
+# output a spurious "(cached)" mark in the midst of other configure output.
+# This macro should be used instead of AC_CACHE_VAL when it is not surrounded
+# by an AC_MSG_CHECKING/AC_MSG_RESULT pair.
+AC_DEFUN([gl_CACHE_VAL_SILENT],
+[
+  saved_as_echo_n="$as_echo_n"
+  as_echo_n=':'
+  AC_CACHE_VAL([$1], [$2])
+  as_echo_n="$saved_as_echo_n"
+])
diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4
index 327cdd022..1acdd40cd 100644
--- a/m4/gnulib-comp.m4
+++ b/m4/gnulib-comp.m4
@@ -15,7 +15,7 @@
 # In projects using CVS, this file can be treated like other built files.
 
 
-# This macro should be invoked from ./configure.in, in the section
+# This macro should be invoked from ./configure.ac, in the section
 # "Checks for programs", right after AC_PROG_CC, and certainly before
 # any checks for libraries, header files, types and library functions.
 AC_DEFUN([gl_EARLY],
@@ -25,11 +25,13 @@ AC_DEFUN([gl_EARLY],
   m4_pattern_allow([^gl_LIBOBJS$])dnl a variable
   m4_pattern_allow([^gl_LTLIBOBJS$])dnl a variable
   AC_REQUIRE([AC_PROG_RANLIB])
+  AC_REQUIRE([AM_PROG_CC_C_O])
   AB_INIT
   AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
+  AC_REQUIRE([gl_FP_IEEE])
 ])
 
-# This macro should be invoked from ./configure.in, in the section
+# This macro should be invoked from ./configure.ac, in the section
 # "Check for header files, types and library functions".
 AC_DEFUN([gl_INIT],
 [
@@ -43,28 +45,77 @@ AC_DEFUN([gl_INIT],
   gl_COMMON
   gl_source_base='lib'
   gl_FUNC_ALLOCA
+  gl_BYTESWAP
+  gl_CANONICALIZE_LGPL
+  gl_MODULE_INDICATOR([canonicalize-lgpl])
+  gl_ENVIRON
+  gl_UNISTD_MODULE_INDICATOR([environ])
+  gl_HEADER_ERRNO_H
+  gl_FLOAT_H
+  gl_FUNC_FLOCK
+  gl_HEADER_SYS_FILE_MODULE_INDICATOR([flock])
+  gl_FUNC_GETPAGESIZE
+  gl_UNISTD_MODULE_INDICATOR([getpagesize])
+  AM_ICONV
+  gl_ICONV_H
+  gl_FUNC_ICONV_OPEN
+  gl_FUNC_ICONV_OPEN_UTF
+  gl_INLINE
+  gl_LD_VERSION_SCRIPT
+  gl_VISIBILITY
+  gl_LIBUNISTRING
   gl_LOCALCHARSET
   LOCALCHARSET_TESTS_ENVIRONMENT="CHARSETALIASDIR=\"\$(top_builddir)/$gl_source_base\""
   AC_SUBST([LOCALCHARSET_TESTS_ENVIRONMENT])
+  gl_FUNC_MALLOC_POSIX
+  gl_STDLIB_MODULE_INDICATOR([malloc-posix])
+  gl_MALLOCA
   gl_FUNC_MBRLEN
   gl_WCHAR_MODULE_INDICATOR([mbrlen])
   gl_FUNC_MBRTOWC
   gl_WCHAR_MODULE_INDICATOR([mbrtowc])
   gl_FUNC_MBSINIT
   gl_WCHAR_MODULE_INDICATOR([mbsinit])
+  gl_FUNC_MEMCHR
+  gl_STRING_MODULE_INDICATOR([memchr])
+  gl_MULTIARCH
+  gl_PATHMAX
+  gl_FUNC_PUTENV
+  gl_STDLIB_MODULE_INDICATOR([putenv])
+  gl_FUNC_READLINK
+  gl_UNISTD_MODULE_INDICATOR([readlink])
   gl_SAFE_READ
   gl_SAFE_WRITE
+  gl_SIZE_MAX
   gt_TYPE_SSIZE_T
   AM_STDBOOL_H
+  gl_STDINT_H
+  gl_STDIO_H
+  gl_STDLIB_H
   gl_STRCASE
   gl_FUNC_GNU_STRFTIME
+  if test $gl_cond_libtool = false; then
+    gl_ltlibdeps="$gl_ltlibdeps $LTLIBICONV"
+    gl_libdeps="$gl_libdeps $LIBICONV"
+  fi
+  gl_HEADER_STRING_H
   gl_HEADER_STRINGS_H
+  gl_HEADER_SYS_FILE_H
+  AC_PROG_MKDIR_P
   gl_HEADER_TIME_H
   gl_TIME_R
   gl_UNISTD_H
+  gl_MODULE_INDICATOR([unistr/u8-mbtouc])
+  gl_MODULE_INDICATOR([unistr/u8-mbtouc-unsafe])
+  gl_MODULE_INDICATOR([unistr/u8-mbtoucr])
+  gl_MODULE_INDICATOR([unistr/u8-uctomb])
+  gl_FUNC_VASNPRINTF
+  gl_FUNC_VSNPRINTF
+  gl_STDIO_MODULE_INDICATOR([vsnprintf])
   gl_WCHAR_H
   gl_FUNC_WRITE
   gl_UNISTD_MODULE_INDICATOR([write])
+  gl_XSIZE
   m4_ifval(gl_LIBSOURCES_LIST, [
     m4_syscmd([test ! -d ]m4_defn([gl_LIBSOURCES_DIR])[ ||
       for gl_file in ]gl_LIBSOURCES_LIST[ ; do
@@ -193,64 +244,168 @@ AC_DEFUN([gltests_LIBSOURCES], [
 # This macro records the list of files which have been installed by
 # gnulib-tool and may be removed by future gnulib-tool invocations.
 AC_DEFUN([gl_FILE_LIST], [
+  build-aux/config.rpath
   build-aux/link-warning.h
   lib/alloca.in.h
+  lib/asnprintf.c
+  lib/byteswap.in.h
+  lib/c-ctype.c
+  lib/c-ctype.h
+  lib/c-strcase.h
+  lib/c-strcasecmp.c
+  lib/c-strcaseeq.h
+  lib/c-strncasecmp.c
+  lib/canonicalize-lgpl.c
+  lib/canonicalize.h
   lib/config.charset
+  lib/errno.in.h
+  lib/float+.h
+  lib/float.in.h
+  lib/flock.c
   lib/full-read.c
   lib/full-read.h
   lib/full-write.c
   lib/full-write.h
+  lib/getpagesize.c
+  lib/iconv.c
+  lib/iconv.in.h
+  lib/iconv_close.c
+  lib/iconv_open-aix.gperf
+  lib/iconv_open-hpux.gperf
+  lib/iconv_open-irix.gperf
+  lib/iconv_open-osf.gperf
+  lib/iconv_open.c
+  lib/iconveh.h
   lib/localcharset.c
   lib/localcharset.h
+  lib/malloc.c
+  lib/malloca.c
+  lib/malloca.h
+  lib/malloca.valgrind
   lib/mbrlen.c
   lib/mbrtowc.c
   lib/mbsinit.c
+  lib/memchr.c
+  lib/memchr.valgrind
+  lib/pathmax.h
+  lib/printf-args.c
+  lib/printf-args.h
+  lib/printf-parse.c
+  lib/printf-parse.h
+  lib/putenv.c
+  lib/readlink.c
   lib/ref-add.sin
   lib/ref-del.sin
   lib/safe-read.c
   lib/safe-read.h
   lib/safe-write.c
   lib/safe-write.h
+  lib/size_max.h
   lib/stdbool.in.h
+  lib/stdint.in.h
+  lib/stdio-write.c
+  lib/stdio.in.h
+  lib/stdlib.in.h
   lib/strcasecmp.c
   lib/streq.h
   lib/strftime.c
   lib/strftime.h
+  lib/striconveh.c
+  lib/striconveh.h
+  lib/string.in.h
   lib/strings.in.h
   lib/strncasecmp.c
+  lib/sys_file.in.h
   lib/time.in.h
   lib/time_r.c
   lib/unistd.in.h
+  lib/unistr.h
+  lib/unistr/u8-mbtouc-aux.c
+  lib/unistr/u8-mbtouc-unsafe-aux.c
+  lib/unistr/u8-mbtouc-unsafe.c
+  lib/unistr/u8-mbtouc.c
+  lib/unistr/u8-mbtoucr.c
+  lib/unistr/u8-prev.c
+  lib/unistr/u8-uctomb-aux.c
+  lib/unistr/u8-uctomb.c
+  lib/unitypes.h
+  lib/vasnprintf.c
+  lib/vasnprintf.h
   lib/verify.h
+  lib/vsnprintf.c
   lib/wchar.in.h
   lib/write.c
+  lib/xsize.h
+  m4/00gnulib.m4
   m4/alloca.m4
   m4/autobuild.m4
+  m4/byteswap.m4
+  m4/canonicalize-lgpl.m4
   m4/codeset.m4
+  m4/eealloc.m4
+  m4/environ.m4
+  m4/errno_h.m4
   m4/extensions.m4
+  m4/float_h.m4
+  m4/flock.m4
+  m4/fpieee.m4
+  m4/getpagesize.m4
   m4/glibc21.m4
   m4/gnulib-common.m4
+  m4/iconv.m4
+  m4/iconv_h.m4
+  m4/iconv_open.m4
   m4/include_next.m4
+  m4/inline.m4
+  m4/intmax_t.m4
+  m4/inttypes_h.m4
+  m4/ld-version-script.m4
+  m4/lib-ld.m4
+  m4/lib-link.m4
+  m4/lib-prefix.m4
+  m4/libunistring.m4
   m4/localcharset.m4
   m4/locale-fr.m4
   m4/locale-ja.m4
   m4/locale-zh.m4
+  m4/longlong.m4
+  m4/malloc.m4
+  m4/malloca.m4
   m4/mbrlen.m4
   m4/mbrtowc.m4
   m4/mbsinit.m4
   m4/mbstate_t.m4
+  m4/memchr.m4
+  m4/mmap-anon.m4
+  m4/multiarch.m4
+  m4/pathmax.m4
+  m4/printf.m4
+  m4/putenv.m4
+  m4/readlink.m4
   m4/safe-read.m4
   m4/safe-write.m4
+  m4/size_max.m4
   m4/ssize_t.m4
   m4/stdbool.m4
+  m4/stdint.m4
+  m4/stdint_h.m4
+  m4/stdio_h.m4
+  m4/stdlib_h.m4
   m4/strcase.m4
   m4/strftime.m4
+  m4/string_h.m4
   m4/strings_h.m4
+  m4/sys_file_h.m4
   m4/time_h.m4
   m4/time_r.m4
   m4/tm_gmtoff.m4
   m4/unistd_h.m4
+  m4/vasnprintf.m4
+  m4/visibility.m4
+  m4/vsnprintf.m4
   m4/wchar.m4
+  m4/wchar_t.m4
   m4/wint_t.m4
   m4/write.m4
+  m4/xsize.m4
 ])
diff --git a/m4/iconv.m4 b/m4/iconv.m4
new file mode 100644
index 000000000..ce21b0b87
--- /dev/null
+++ b/m4/iconv.m4
@@ -0,0 +1,180 @@
+# iconv.m4 serial AM8 (gettext-0.18)
+dnl Copyright (C) 2000-2002, 2007-2009 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+dnl From Bruno Haible.
+
+AC_DEFUN([AM_ICONV_LINKFLAGS_BODY],
+[
+  dnl Prerequisites of AC_LIB_LINKFLAGS_BODY.
+  AC_REQUIRE([AC_LIB_PREPARE_PREFIX])
+  AC_REQUIRE([AC_LIB_RPATH])
+
+  dnl Search for libiconv and define LIBICONV, LTLIBICONV and INCICONV
+  dnl accordingly.
+  AC_LIB_LINKFLAGS_BODY([iconv])
+])
+
+AC_DEFUN([AM_ICONV_LINK],
+[
+  dnl Some systems have iconv in libc, some have it in libiconv (OSF/1 and
+  dnl those with the standalone portable GNU libiconv installed).
+  AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+
+  dnl Search for libiconv and define LIBICONV, LTLIBICONV and INCICONV
+  dnl accordingly.
+  AC_REQUIRE([AM_ICONV_LINKFLAGS_BODY])
+
+  dnl Add $INCICONV to CPPFLAGS before performing the following checks,
+  dnl because if the user has installed libiconv and not disabled its use
+  dnl via --without-libiconv-prefix, he wants to use it. The first
+  dnl AC_TRY_LINK will then fail, the second AC_TRY_LINK will succeed.
+  am_save_CPPFLAGS="$CPPFLAGS"
+  AC_LIB_APPENDTOVAR([CPPFLAGS], [$INCICONV])
+
+  AC_CACHE_CHECK([for iconv], [am_cv_func_iconv], [
+    am_cv_func_iconv="no, consider installing GNU libiconv"
+    am_cv_lib_iconv=no
+    AC_TRY_LINK([#include <stdlib.h>
+#include <iconv.h>],
+      [iconv_t cd = iconv_open("","");
+       iconv(cd,NULL,NULL,NULL,NULL);
+       iconv_close(cd);],
+      [am_cv_func_iconv=yes])
+    if test "$am_cv_func_iconv" != yes; then
+      am_save_LIBS="$LIBS"
+      LIBS="$LIBS $LIBICONV"
+      AC_TRY_LINK([#include <stdlib.h>
+#include <iconv.h>],
+        [iconv_t cd = iconv_open("","");
+         iconv(cd,NULL,NULL,NULL,NULL);
+         iconv_close(cd);],
+        [am_cv_lib_iconv=yes]
+        [am_cv_func_iconv=yes])
+      LIBS="$am_save_LIBS"
+    fi
+  ])
+  if test "$am_cv_func_iconv" = yes; then
+    AC_CACHE_CHECK([for working iconv], [am_cv_func_iconv_works], [
+      dnl This tests against bugs in AIX 5.1 and HP-UX 11.11.
+      am_save_LIBS="$LIBS"
+      if test $am_cv_lib_iconv = yes; then
+        LIBS="$LIBS $LIBICONV"
+      fi
+      AC_TRY_RUN([
+#include <iconv.h>
+#include <string.h>
+int main ()
+{
+  /* Test against AIX 5.1 bug: Failures are not distinguishable from successful
+     returns.  */
+  {
+    iconv_t cd_utf8_to_88591 = iconv_open ("ISO8859-1", "UTF-8");
+    if (cd_utf8_to_88591 != (iconv_t)(-1))
+      {
+        static const char input[] = "\342\202\254"; /* EURO SIGN */
+        char buf[10];
+        const char *inptr = input;
+        size_t inbytesleft = strlen (input);
+        char *outptr = buf;
+        size_t outbytesleft = sizeof (buf);
+        size_t res = iconv (cd_utf8_to_88591,
+                            (char **) &inptr, &inbytesleft,
+                            &outptr, &outbytesleft);
+        if (res == 0)
+          return 1;
+      }
+  }
+#if 0 /* This bug could be worked around by the caller.  */
+  /* Test against HP-UX 11.11 bug: Positive return value instead of 0.  */
+  {
+    iconv_t cd_88591_to_utf8 = iconv_open ("utf8", "iso88591");
+    if (cd_88591_to_utf8 != (iconv_t)(-1))
+      {
+        static const char input[] = "\304rger mit b\366sen B\374bchen ohne Augenma\337";
+        char buf[50];
+        const char *inptr = input;
+        size_t inbytesleft = strlen (input);
+        char *outptr = buf;
+        size_t outbytesleft = sizeof (buf);
+        size_t res = iconv (cd_88591_to_utf8,
+                            (char **) &inptr, &inbytesleft,
+                            &outptr, &outbytesleft);
+        if ((int)res > 0)
+          return 1;
+      }
+  }
+#endif
+  /* Test against HP-UX 11.11 bug: No converter from EUC-JP to UTF-8 is
+     provided.  */
+  if (/* Try standardized names.  */
+      iconv_open ("UTF-8", "EUC-JP") == (iconv_t)(-1)
+      /* Try IRIX, OSF/1 names.  */
+      && iconv_open ("UTF-8", "eucJP") == (iconv_t)(-1)
+      /* Try AIX names.  */
+      && iconv_open ("UTF-8", "IBM-eucJP") == (iconv_t)(-1)
+      /* Try HP-UX names.  */
+      && iconv_open ("utf8", "eucJP") == (iconv_t)(-1))
+    return 1;
+  return 0;
+}], [am_cv_func_iconv_works=yes], [am_cv_func_iconv_works=no],
+        [case "$host_os" in
+           aix* | hpux*) am_cv_func_iconv_works="guessing no" ;;
+           *)            am_cv_func_iconv_works="guessing yes" ;;
+         esac])
+      LIBS="$am_save_LIBS"
+    ])
+    case "$am_cv_func_iconv_works" in
+      *no) am_func_iconv=no am_cv_lib_iconv=no ;;
+      *)   am_func_iconv=yes ;;
+    esac
+  else
+    am_func_iconv=no am_cv_lib_iconv=no
+  fi
+  if test "$am_func_iconv" = yes; then
+    AC_DEFINE([HAVE_ICONV], [1],
+      [Define if you have the iconv() function and it works.])
+  fi
+  if test "$am_cv_lib_iconv" = yes; then
+    AC_MSG_CHECKING([how to link with libiconv])
+    AC_MSG_RESULT([$LIBICONV])
+  else
+    dnl If $LIBICONV didn't lead to a usable library, we don't need $INCICONV
+    dnl either.
+    CPPFLAGS="$am_save_CPPFLAGS"
+    LIBICONV=
+    LTLIBICONV=
+  fi
+  AC_SUBST([LIBICONV])
+  AC_SUBST([LTLIBICONV])
+])
+
+AC_DEFUN([AM_ICONV],
+[
+  AM_ICONV_LINK
+  if test "$am_cv_func_iconv" = yes; then
+    AC_MSG_CHECKING([for iconv declaration])
+    AC_CACHE_VAL([am_cv_proto_iconv], [
+      AC_TRY_COMPILE([
+#include <stdlib.h>
+#include <iconv.h>
+extern
+#ifdef __cplusplus
+"C"
+#endif
+#if defined(__STDC__) || defined(__cplusplus)
+size_t iconv (iconv_t cd, char * *inbuf, size_t *inbytesleft, char * *outbuf, size_t *outbytesleft);
+#else
+size_t iconv();
+#endif
+], [], [am_cv_proto_iconv_arg1=""], [am_cv_proto_iconv_arg1="const"])
+      am_cv_proto_iconv="extern size_t iconv (iconv_t cd, $am_cv_proto_iconv_arg1 char * *inbuf, size_t *inbytesleft, char * *outbuf, size_t *outbytesleft);"])
+    am_cv_proto_iconv=`echo "[$]am_cv_proto_iconv" | tr -s ' ' | sed -e 's/( /(/'`
+    AC_MSG_RESULT([
+         $am_cv_proto_iconv])
+    AC_DEFINE_UNQUOTED([ICONV_CONST], [$am_cv_proto_iconv_arg1],
+      [Define as const if the declaration of iconv() needs const.])
+  fi
+])
diff --git a/m4/iconv_h.m4 b/m4/iconv_h.m4
new file mode 100644
index 000000000..bc05b0551
--- /dev/null
+++ b/m4/iconv_h.m4
@@ -0,0 +1,34 @@
+# iconv_h.m4 serial 4
+dnl Copyright (C) 2007-2008 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN([gl_ICONV_H],
+[
+  AC_REQUIRE([gl_ICONV_H_DEFAULTS])
+  gl_CHECK_NEXT_HEADERS([iconv.h])
+])
+
+dnl Unconditionally enables the replacement of <iconv.h>.
+AC_DEFUN([gl_REPLACE_ICONV_H],
+[
+  AC_REQUIRE([gl_ICONV_H_DEFAULTS])
+  ICONV_H='iconv.h'
+])
+
+AC_DEFUN([gl_ICONV_MODULE_INDICATOR],
+[
+  dnl Use AC_REQUIRE here, so that the default settings are expanded once only.
+  AC_REQUIRE([gl_ICONV_H_DEFAULTS])
+  GNULIB_[]m4_translit([$1],[abcdefghijklmnopqrstuvwxyz./-],[ABCDEFGHIJKLMNOPQRSTUVWXYZ___])=1
+])
+
+AC_DEFUN([gl_ICONV_H_DEFAULTS],
+[
+  dnl Assume proper GNU behavior unless another module says otherwise.
+  REPLACE_ICONV=0;      AC_SUBST([REPLACE_ICONV])
+  REPLACE_ICONV_OPEN=0; AC_SUBST([REPLACE_ICONV_OPEN])
+  REPLACE_ICONV_UTF=0;  AC_SUBST([REPLACE_ICONV_UTF])
+  ICONV_H='';           AC_SUBST([ICONV_H])
+])
diff --git a/m4/iconv_open.m4 b/m4/iconv_open.m4
new file mode 100644
index 000000000..c7b948e90
--- /dev/null
+++ b/m4/iconv_open.m4
@@ -0,0 +1,237 @@
+# iconv_open.m4 serial 5
+dnl Copyright (C) 2007-2009 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN([gl_FUNC_ICONV_OPEN],
+[
+  AC_REQUIRE([AM_ICONV])
+  AC_REQUIRE([AC_CANONICAL_HOST])
+  AC_REQUIRE([gl_ICONV_H_DEFAULTS])
+  if test "$am_cv_func_iconv" = yes; then
+    dnl Test whether iconv_open accepts standardized encoding names.
+    dnl We know that GNU libiconv and GNU libc do.
+    AC_EGREP_CPP([gnu_iconv], [
+      #include <iconv.h>
+      #if defined _LIBICONV_VERSION || defined __GLIBC__
+       gnu_iconv
+      #endif
+      ], [gl_func_iconv_gnu=yes], [gl_func_iconv_gnu=no])
+    if test $gl_func_iconv_gnu = no; then
+      iconv_flavor=
+      case "$host_os" in
+        aix*)  iconv_flavor=ICONV_FLAVOR_AIX ;;
+        irix*) iconv_flavor=ICONV_FLAVOR_IRIX ;;
+        hpux*) iconv_flavor=ICONV_FLAVOR_HPUX ;;
+        osf*)  iconv_flavor=ICONV_FLAVOR_OSF ;;
+      esac
+      if test -n "$iconv_flavor"; then
+        AC_DEFINE_UNQUOTED([ICONV_FLAVOR], [$iconv_flavor],
+          [Define to a symbolic name denoting the flavor of iconv_open()
+           implementation.])
+        gl_REPLACE_ICONV_OPEN
+      fi
+    fi
+  fi
+])
+
+AC_DEFUN([gl_REPLACE_ICONV_OPEN],
+[
+  gl_REPLACE_ICONV_H
+  REPLACE_ICONV_OPEN=1
+  AC_LIBOBJ([iconv_open])
+])
+
+AC_DEFUN([gl_FUNC_ICONV_OPEN_UTF],
+[
+  AC_REQUIRE([gl_FUNC_ICONV_OPEN])
+  AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+  AC_REQUIRE([gl_ICONV_H_DEFAULTS])
+  if test "$am_cv_func_iconv" = yes; then
+    if test -n "$am_cv_proto_iconv_arg1"; then
+      ICONV_CONST="const"
+    else
+      ICONV_CONST=
+    fi
+    AC_SUBST([ICONV_CONST])
+    AC_CACHE_CHECK([whether iconv supports conversion between UTF-8 and UTF-{16,32}{BE,LE}],
+      [gl_cv_func_iconv_supports_utf],
+      [
+        save_LIBS="$LIBS"
+        LIBS="$LIBS $LIBICONV"
+        AC_TRY_RUN([
+#include <iconv.h>
+#include <errno.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#define ASSERT(expr) if (!(expr)) return 1;
+int main ()
+{
+  /* Test conversion from UTF-8 to UTF-16BE with no errors.  */
+  {
+    static const char input[] =
+      "Japanese (\346\227\245\346\234\254\350\252\236) [\360\235\224\215\360\235\224\236\360\235\224\255]";
+    static const char expected[] =
+      "\000J\000a\000p\000a\000n\000e\000s\000e\000 \000(\145\345\147\054\212\236\000)\000 \000[\330\065\335\015\330\065\335\036\330\065\335\055\000]";
+    iconv_t cd;
+    char buf[100];
+    const char *inptr;
+    size_t inbytesleft;
+    char *outptr;
+    size_t outbytesleft;
+    size_t res;
+    cd = iconv_open ("UTF-16BE", "UTF-8");
+    ASSERT (cd != (iconv_t)(-1));
+    inptr = input;
+    inbytesleft = sizeof (input) - 1;
+    outptr = buf;
+    outbytesleft = sizeof (buf);
+    res = iconv (cd,
+		 (ICONV_CONST char **) &inptr, &inbytesleft,
+		 &outptr, &outbytesleft);
+    ASSERT (res == 0 && inbytesleft == 0);
+    ASSERT (outptr == buf + (sizeof (expected) - 1));
+    ASSERT (memcmp (buf, expected, sizeof (expected) - 1) == 0);
+    ASSERT (iconv_close (cd) == 0);
+  }
+  /* Test conversion from UTF-8 to UTF-16LE with no errors.  */
+  {
+    static const char input[] =
+      "Japanese (\346\227\245\346\234\254\350\252\236) [\360\235\224\215\360\235\224\236\360\235\224\255]";
+    static const char expected[] =
+      "J\000a\000p\000a\000n\000e\000s\000e\000 \000(\000\345\145\054\147\236\212)\000 \000[\000\065\330\015\335\065\330\036\335\065\330\055\335]\000";
+    iconv_t cd;
+    char buf[100];
+    const char *inptr;
+    size_t inbytesleft;
+    char *outptr;
+    size_t outbytesleft;
+    size_t res;
+    cd = iconv_open ("UTF-16LE", "UTF-8");
+    ASSERT (cd != (iconv_t)(-1));
+    inptr = input;
+    inbytesleft = sizeof (input) - 1;
+    outptr = buf;
+    outbytesleft = sizeof (buf);
+    res = iconv (cd,
+		 (ICONV_CONST char **) &inptr, &inbytesleft,
+		 &outptr, &outbytesleft);
+    ASSERT (res == 0 && inbytesleft == 0);
+    ASSERT (outptr == buf + (sizeof (expected) - 1));
+    ASSERT (memcmp (buf, expected, sizeof (expected) - 1) == 0);
+    ASSERT (iconv_close (cd) == 0);
+  }
+  /* Test conversion from UTF-8 to UTF-32BE with no errors.  */
+  {
+    static const char input[] =
+      "Japanese (\346\227\245\346\234\254\350\252\236) [\360\235\224\215\360\235\224\236\360\235\224\255]";
+    static const char expected[] =
+      "\000\000\000J\000\000\000a\000\000\000p\000\000\000a\000\000\000n\000\000\000e\000\000\000s\000\000\000e\000\000\000 \000\000\000(\000\000\145\345\000\000\147\054\000\000\212\236\000\000\000)\000\000\000 \000\000\000[\000\001\325\015\000\001\325\036\000\001\325\055\000\000\000]";
+    iconv_t cd;
+    char buf[100];
+    const char *inptr;
+    size_t inbytesleft;
+    char *outptr;
+    size_t outbytesleft;
+    size_t res;
+    cd = iconv_open ("UTF-32BE", "UTF-8");
+    ASSERT (cd != (iconv_t)(-1));
+    inptr = input;
+    inbytesleft = sizeof (input) - 1;
+    outptr = buf;
+    outbytesleft = sizeof (buf);
+    res = iconv (cd,
+		 (ICONV_CONST char **) &inptr, &inbytesleft,
+		 &outptr, &outbytesleft);
+    ASSERT (res == 0 && inbytesleft == 0);
+    ASSERT (outptr == buf + (sizeof (expected) - 1));
+    ASSERT (memcmp (buf, expected, sizeof (expected) - 1) == 0);
+    ASSERT (iconv_close (cd) == 0);
+  }
+  /* Test conversion from UTF-8 to UTF-32LE with no errors.  */
+  {
+    static const char input[] =
+      "Japanese (\346\227\245\346\234\254\350\252\236) [\360\235\224\215\360\235\224\236\360\235\224\255]";
+    static const char expected[] =
+      "J\000\000\000a\000\000\000p\000\000\000a\000\000\000n\000\000\000e\000\000\000s\000\000\000e\000\000\000 \000\000\000(\000\000\000\345\145\000\000\054\147\000\000\236\212\000\000)\000\000\000 \000\000\000[\000\000\000\015\325\001\000\036\325\001\000\055\325\001\000]\000\000\000";
+    iconv_t cd;
+    char buf[100];
+    const char *inptr;
+    size_t inbytesleft;
+    char *outptr;
+    size_t outbytesleft;
+    size_t res;
+    cd = iconv_open ("UTF-32LE", "UTF-8");
+    ASSERT (cd != (iconv_t)(-1));
+    inptr = input;
+    inbytesleft = sizeof (input) - 1;
+    outptr = buf;
+    outbytesleft = sizeof (buf);
+    res = iconv (cd,
+		 (ICONV_CONST char **) &inptr, &inbytesleft,
+		 &outptr, &outbytesleft);
+    ASSERT (res == 0 && inbytesleft == 0);
+    ASSERT (outptr == buf + (sizeof (expected) - 1));
+    ASSERT (memcmp (buf, expected, sizeof (expected) - 1) == 0);
+    ASSERT (iconv_close (cd) == 0);
+  }
+  /* Test conversion from UTF-16BE to UTF-8 with no errors.
+     This test fails on NetBSD 3.0.  */
+  {
+    static const char input[] =
+      "\000J\000a\000p\000a\000n\000e\000s\000e\000 \000(\145\345\147\054\212\236\000)\000 \000[\330\065\335\015\330\065\335\036\330\065\335\055\000]";
+    static const char expected[] =
+      "Japanese (\346\227\245\346\234\254\350\252\236) [\360\235\224\215\360\235\224\236\360\235\224\255]";
+    iconv_t cd;
+    char buf[100];
+    const char *inptr;
+    size_t inbytesleft;
+    char *outptr;
+    size_t outbytesleft;
+    size_t res;
+    cd = iconv_open ("UTF-8", "UTF-16BE");
+    ASSERT (cd != (iconv_t)(-1));
+    inptr = input;
+    inbytesleft = sizeof (input) - 1;
+    outptr = buf;
+    outbytesleft = sizeof (buf);
+    res = iconv (cd,
+		 (ICONV_CONST char **) &inptr, &inbytesleft,
+		 &outptr, &outbytesleft);
+    ASSERT (res == 0 && inbytesleft == 0);
+    ASSERT (outptr == buf + (sizeof (expected) - 1));
+    ASSERT (memcmp (buf, expected, sizeof (expected) - 1) == 0);
+    ASSERT (iconv_close (cd) == 0);
+  }
+  return 0;
+}], [gl_cv_func_iconv_supports_utf=yes], [gl_cv_func_iconv_supports_utf=no],
+          [
+           dnl We know that GNU libiconv, GNU libc, and Solaris >= 9 do.
+           dnl OSF/1 5.1 has these encodings, but inserts a BOM in the "to"
+           dnl direction.
+           gl_cv_func_iconv_supports_utf=no
+           if test $gl_func_iconv_gnu = yes; then
+             gl_cv_func_iconv_supports_utf=yes
+           else
+changequote(,)dnl
+             case "$host_os" in
+               solaris2.9 | solaris2.1[0-9]) gl_cv_func_iconv_supports_utf=yes ;;
+             esac
+changequote([,])dnl
+           fi
+          ])
+        LIBS="$save_LIBS"
+      ])
+    if test $gl_cv_func_iconv_supports_utf = no; then
+      REPLACE_ICONV_UTF=1
+      AC_DEFINE([REPLACE_ICONV_UTF], [1],
+        [Define if the iconv() functions are enhanced to handle the UTF-{16,32}{BE,LE} encodings.])
+      REPLACE_ICONV=1
+      gl_REPLACE_ICONV_OPEN
+      AC_LIBOBJ([iconv])
+      AC_LIBOBJ([iconv_close])
+    fi
+  fi
+])
diff --git a/m4/include_next.m4 b/m4/include_next.m4
index 062753c58..5e22ded93 100644
--- a/m4/include_next.m4
+++ b/m4/include_next.m4
@@ -1,5 +1,5 @@
-# include_next.m4 serial 10
-dnl Copyright (C) 2006-2008 Free Software Foundation, Inc.
+# include_next.m4 serial 14
+dnl Copyright (C) 2006-2009 Free Software Foundation, Inc.
 dnl This file is free software; the Free Software Foundation
 dnl gives unlimited permission to copy and/or distribute it,
 dnl with or without modifications, as long as this notice is preserved.
@@ -32,14 +32,15 @@ AC_DEFUN([gl_INCLUDE_NEXT],
     [gl_cv_have_include_next],
     [rm -rf conftestd1a conftestd1b conftestd2
      mkdir conftestd1a conftestd1b conftestd2
-     dnl The include of <stdio.h> is because IBM C 9.0 on AIX 6.1 supports
-     dnl include_next when used as first preprocessor directive in a file,
-     dnl but not when preceded by another include directive. Additionally,
-     dnl with this same compiler, include_next is a no-op when used in a
-     dnl header file that was included by specifying its absolute file name.
-     dnl Despite these two bugs, include_next is used in the compiler's
-     dnl <math.h>. By virtue of the second bug, we need to use include_next
-     dnl as well in this case.
+     dnl IBM C 9.0, 10.1 (original versions, prior to the 2009-01 updates) on
+     dnl AIX 6.1 support include_next when used as first preprocessor directive
+     dnl in a file, but not when preceded by another include directive. Check
+     dnl for this bug by including <stdio.h>.
+     dnl Additionally, with this same compiler, include_next is a no-op when
+     dnl used in a header file that was included by specifying its absolute
+     dnl file name. Despite these two bugs, include_next is used in the
+     dnl compiler's <math.h>. By virtue of the second bug, we need to use
+     dnl include_next as well in this case.
      cat <<EOF > conftestd1a/conftest.h
 #define DEFINED_IN_CONFTESTD1
 #include_next <conftest.h>
@@ -103,8 +104,14 @@ EOF
 # For each arg foo.h, if #include_next works, define NEXT_FOO_H to be
 # '<foo.h>'; otherwise define it to be
 # '"///usr/include/foo.h"', or whatever other absolute file name is suitable.
+# Also, if #include_next works as first preprocessing directive in a file,
+# define NEXT_AS_FIRST_DIRECTIVE_FOO_H to be '<foo.h>'; otherwise define it to
+# be
+# '"///usr/include/foo.h"', or whatever other absolute file name is suitable.
 # That way, a header file with the following line:
 #	#@INCLUDE_NEXT@ @NEXT_FOO_H@
+# or
+#	#@INCLUDE_NEXT_AS_FIRST_DIRECTIVE@ @NEXT_AS_FIRST_DIRECTIVE_FOO_H@
 # behaves (after sed substitution) as if it contained
 #	#include_next <foo.h>
 # even if the compiler does not support include_next.
@@ -122,15 +129,15 @@ AC_DEFUN([gl_CHECK_NEXT_HEADERS],
 
   m4_foreach_w([gl_HEADER_NAME], [$1],
     [AS_VAR_PUSHDEF([gl_next_header],
-		    [gl_cv_next_]m4_quote(m4_defn([gl_HEADER_NAME])))
+		    [gl_cv_next_]m4_defn([gl_HEADER_NAME]))
      if test $gl_cv_have_include_next = yes; then
        AS_VAR_SET([gl_next_header], ['<'gl_HEADER_NAME'>'])
      else
        AC_CACHE_CHECK(
-	 [absolute name of <]m4_quote(m4_defn([gl_HEADER_NAME]))[>],
-	 m4_quote(m4_defn([gl_next_header])),
+	 [absolute name of <]m4_defn([gl_HEADER_NAME])[>],
+	 m4_defn([gl_next_header]),
 	 [AS_VAR_PUSHDEF([gl_header_exists],
-			 [ac_cv_header_]m4_quote(m4_defn([gl_HEADER_NAME])))
+			 [ac_cv_header_]m4_defn([gl_HEADER_NAME]))
 	  if test AS_VAR_GET(gl_header_exists) = yes; then
 	    AC_LANG_CONFTEST(
 	      [AC_LANG_SOURCE(
@@ -152,8 +159,8 @@ AC_DEFUN([gl_CHECK_NEXT_HEADERS],
 	    dnl so use subshell.
 	    AS_VAR_SET([gl_next_header],
 	      ['"'`(eval "$gl_absname_cpp conftest.$ac_ext") 2>&AS_MESSAGE_LOG_FD |
-	       sed -n '\#/]m4_quote(m4_defn([gl_HEADER_NAME]))[#{
-		 s#.*"\(.*/]m4_quote(m4_defn([gl_HEADER_NAME]))[\)".*#\1#
+	       sed -n '\#/]m4_defn([gl_HEADER_NAME])[#{
+		 s#.*"\(.*/]m4_defn([gl_HEADER_NAME])[\)".*#\1#
 		 s#^/[^/]#//&#
 		 p
 		 q
@@ -164,7 +171,17 @@ AC_DEFUN([gl_CHECK_NEXT_HEADERS],
 	  AS_VAR_POPDEF([gl_header_exists])])
      fi
      AC_SUBST(
-       AS_TR_CPP([NEXT_]m4_quote(m4_defn([gl_HEADER_NAME]))),
+       AS_TR_CPP([NEXT_]m4_defn([gl_HEADER_NAME])),
        [AS_VAR_GET([gl_next_header])])
+     if test $gl_cv_have_include_next = yes || test $gl_cv_have_include_next = buggy; then
+       # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include_next'
+       gl_next_as_first_directive='<'gl_HEADER_NAME'>'
+     else
+       # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include'
+       gl_next_as_first_directive=AS_VAR_GET([gl_next_header])
+     fi
+     AC_SUBST(
+       AS_TR_CPP([NEXT_AS_FIRST_DIRECTIVE_]m4_defn([gl_HEADER_NAME])),
+       [$gl_next_as_first_directive])
      AS_VAR_POPDEF([gl_next_header])])
 ])
diff --git a/m4/inline.m4 b/m4/inline.m4
new file mode 100644
index 000000000..cee51099f
--- /dev/null
+++ b/m4/inline.m4
@@ -0,0 +1,40 @@
+# inline.m4 serial 4
+dnl Copyright (C) 2006, 2009 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+dnl Test for the 'inline' keyword or equivalent.
+dnl Define 'inline' to a supported equivalent, or to nothing if not supported,
+dnl like AC_C_INLINE does.  Also, define HAVE_INLINE if 'inline' or an
+dnl equivalent is effectively supported, i.e. if the compiler is likely to
+dnl drop unused 'static inline' functions.
+AC_DEFUN([gl_INLINE],
+[
+  AC_REQUIRE([AC_C_INLINE])
+  AC_CACHE_CHECK([whether the compiler generally respects inline],
+    [gl_cv_c_inline_effective],
+    [if test $ac_cv_c_inline = no; then
+       gl_cv_c_inline_effective=no
+     else
+       dnl GCC defines __NO_INLINE__ if not optimizing or if -fno-inline is
+       dnl specified.
+       dnl Use AC_COMPILE_IFELSE here, not AC_EGREP_CPP, because the result
+       dnl depends on optimization flags, which can be in CFLAGS.
+       dnl (AC_EGREP_CPP looks only at the CPPFLAGS.)
+       AC_COMPILE_IFELSE(
+         [AC_LANG_PROGRAM([[]],
+           [[#ifdef __NO_INLINE__
+               #error "inline is not effective"
+             #endif]])],
+         [gl_cv_c_inline_effective=yes],
+         [gl_cv_c_inline_effective=no])
+     fi
+    ])
+  if test $gl_cv_c_inline_effective = yes; then
+    AC_DEFINE([HAVE_INLINE], [1],
+      [Define to 1 if the compiler supports one of the keywords
+       'inline', '__inline__', '__inline' and effectively inlines
+       functions marked as such.])
+  fi
+])
diff --git a/m4/intmax_t.m4 b/m4/intmax_t.m4
new file mode 100644
index 000000000..264cb5718
--- /dev/null
+++ b/m4/intmax_t.m4
@@ -0,0 +1,61 @@
+# intmax_t.m4 serial 7
+dnl Copyright (C) 1997-2004, 2006-2007, 2009 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+dnl From Paul Eggert.
+
+AC_PREREQ([2.13])
+
+# Define intmax_t to 'long' or 'long long'
+# if it is not already defined in <stdint.h> or <inttypes.h>.
+
+AC_DEFUN([gl_AC_TYPE_INTMAX_T],
+[
+  dnl For simplicity, we assume that a header file defines 'intmax_t' if and
+  dnl only if it defines 'uintmax_t'.
+  AC_REQUIRE([gl_AC_HEADER_INTTYPES_H])
+  AC_REQUIRE([gl_AC_HEADER_STDINT_H])
+  if test $gl_cv_header_inttypes_h = no && test $gl_cv_header_stdint_h = no; then
+    AC_REQUIRE([AC_TYPE_LONG_LONG_INT])
+    test $ac_cv_type_long_long_int = yes \
+      && ac_type='long long' \
+      || ac_type='long'
+    AC_DEFINE_UNQUOTED([intmax_t], [$ac_type],
+     [Define to long or long long if <inttypes.h> and <stdint.h> don't define.])
+  else
+    AC_DEFINE([HAVE_INTMAX_T], [1],
+      [Define if you have the 'intmax_t' type in <stdint.h> or <inttypes.h>.])
+  fi
+])
+
+dnl An alternative would be to explicitly test for 'intmax_t'.
+
+AC_DEFUN([gt_AC_TYPE_INTMAX_T],
+[
+  AC_REQUIRE([gl_AC_HEADER_INTTYPES_H])
+  AC_REQUIRE([gl_AC_HEADER_STDINT_H])
+  AC_CACHE_CHECK([for intmax_t], [gt_cv_c_intmax_t],
+    [AC_TRY_COMPILE([
+#include <stddef.h>
+#include <stdlib.h>
+#if HAVE_STDINT_H_WITH_UINTMAX
+#include <stdint.h>
+#endif
+#if HAVE_INTTYPES_H_WITH_UINTMAX
+#include <inttypes.h>
+#endif
+], [intmax_t x = -1; return !x;], gt_cv_c_intmax_t=yes, gt_cv_c_intmax_t=no)])
+  if test $gt_cv_c_intmax_t = yes; then
+    AC_DEFINE([HAVE_INTMAX_T], [1],
+      [Define if you have the 'intmax_t' type in <stdint.h> or <inttypes.h>.])
+  else
+    AC_REQUIRE([AC_TYPE_LONG_LONG_INT])
+    test $ac_cv_type_long_long_int = yes \
+      && ac_type='long long' \
+      || ac_type='long'
+    AC_DEFINE_UNQUOTED([intmax_t], [$ac_type],
+     [Define to long or long long if <stdint.h> and <inttypes.h> don't define.])
+  fi
+])
diff --git a/m4/inttypes_h.m4 b/m4/inttypes_h.m4
new file mode 100644
index 000000000..f4ca16021
--- /dev/null
+++ b/m4/inttypes_h.m4
@@ -0,0 +1,26 @@
+# inttypes_h.m4 serial 9
+dnl Copyright (C) 1997-2004, 2006, 2008, 2009 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+dnl From Paul Eggert.
+
+# Define HAVE_INTTYPES_H_WITH_UINTMAX if <inttypes.h> exists,
+# doesn't clash with <sys/types.h>, and declares uintmax_t.
+
+AC_DEFUN([gl_AC_HEADER_INTTYPES_H],
+[
+  AC_CACHE_CHECK([for inttypes.h], [gl_cv_header_inttypes_h],
+  [AC_TRY_COMPILE(
+    [#include <sys/types.h>
+#include <inttypes.h>],
+    [uintmax_t i = (uintmax_t) -1; return !i;],
+    [gl_cv_header_inttypes_h=yes],
+    [gl_cv_header_inttypes_h=no])])
+  if test $gl_cv_header_inttypes_h = yes; then
+    AC_DEFINE_UNQUOTED([HAVE_INTTYPES_H_WITH_UINTMAX], [1],
+      [Define if <inttypes.h> exists, doesn't clash with <sys/types.h>,
+       and declares uintmax_t. ])
+  fi
+])
diff --git a/m4/labels-as-values.m4 b/m4/labels-as-values.m4
new file mode 100644
index 000000000..3cf7320bd
--- /dev/null
+++ b/m4/labels-as-values.m4
@@ -0,0 +1,22 @@
+dnl check for gcc's "labels as values" feature
+AC_DEFUN([AC_C_LABELS_AS_VALUES],
+[AC_CACHE_CHECK([labels as values], ac_cv_labels_as_values,
+[AC_TRY_COMPILE([
+int foo(int);
+int foo(i)
+int i; { 
+static void *label[] = { &&l1, &&l2 };
+goto *label[i];
+l1: return 1;
+l2: return 2;
+}
+],
+[int i;], 
+ac_cv_labels_as_values=yes,
+ac_cv_labels_as_values=no)])
+if test "$ac_cv_labels_as_values" = yes; then
+AC_DEFINE([HAVE_LABELS_AS_VALUES], [],
+          [Define if compiler supports gcc's "labels as values" (aka computed goto)
+           feature, used to speed up instruction dispatch in the interpreter.])
+fi
+])
diff --git a/m4/ld-version-script.m4 b/m4/ld-version-script.m4
new file mode 100644
index 000000000..a97888f24
--- /dev/null
+++ b/m4/ld-version-script.m4
@@ -0,0 +1,44 @@
+# ld-version-script.m4 serial 1
+dnl Copyright (C) 2008, 2009 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+dnl From Simon Josefsson
+
+# FIXME: The test below returns a false positive for mingw
+# cross-compiles, 'local:' statements does not reduce number of
+# exported symbols in a DLL.  Use --disable-ld-version-script to work
+# around the problem.
+
+# gl_LD_VERSION_SCRIPT
+# --------------------
+# Check if LD supports linker scripts, and define automake conditional
+# HAVE_LD_VERSION_SCRIPT if so.
+AC_DEFUN([gl_LD_VERSION_SCRIPT],
+[
+  AC_ARG_ENABLE([ld-version-script],
+    AS_HELP_STRING([--enable-ld-version-script],
+      [enable linker version script (default is enabled when possible)]),
+      [have_ld_version_script=$enableval], [])
+  if test -z "$have_ld_version_script"; then
+    AC_MSG_CHECKING([if LD -Wl,--version-script works])
+    save_LDFLAGS="$LDFLAGS"
+    LDFLAGS="$LDFLAGS -Wl,--version-script=conftest.map"
+    cat > conftest.map <<EOF
+VERS_1 {
+	global: sym;
+};
+
+VERS_2 {
+        global: sym;
+} VERS_1;
+EOF
+    AC_LINK_IFELSE(AC_LANG_PROGRAM([], []),
+                   [have_ld_version_script=yes], [have_ld_version_script=no])
+    rm -f conftest.map
+    LDFLAGS="$save_LDFLAGS"
+    AC_MSG_RESULT($have_ld_version_script)
+  fi
+  AM_CONDITIONAL(HAVE_LD_VERSION_SCRIPT, test "$have_ld_version_script" = "yes")
+])
diff --git a/m4/lib-ld.m4 b/m4/lib-ld.m4
new file mode 100644
index 000000000..e4863f2c9
--- /dev/null
+++ b/m4/lib-ld.m4
@@ -0,0 +1,110 @@
+# lib-ld.m4 serial 4 (gettext-0.18)
+dnl Copyright (C) 1996-2003, 2009 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+dnl Subroutines of libtool.m4,
+dnl with replacements s/AC_/AC_LIB/ and s/lt_cv/acl_cv/ to avoid collision
+dnl with libtool.m4.
+
+dnl From libtool-1.4. Sets the variable with_gnu_ld to yes or no.
+AC_DEFUN([AC_LIB_PROG_LD_GNU],
+[AC_CACHE_CHECK([if the linker ($LD) is GNU ld], [acl_cv_prog_gnu_ld],
+[# I'd rather use --version here, but apparently some GNU ld's only accept -v.
+case `$LD -v 2>&1 </dev/null` in
+*GNU* | *'with BFD'*)
+  acl_cv_prog_gnu_ld=yes ;;
+*)
+  acl_cv_prog_gnu_ld=no ;;
+esac])
+with_gnu_ld=$acl_cv_prog_gnu_ld
+])
+
+dnl From libtool-1.4. Sets the variable LD.
+AC_DEFUN([AC_LIB_PROG_LD],
+[AC_ARG_WITH([gnu-ld],
+[  --with-gnu-ld           assume the C compiler uses GNU ld [default=no]],
+test "$withval" = no || with_gnu_ld=yes, with_gnu_ld=no)
+AC_REQUIRE([AC_PROG_CC])dnl
+AC_REQUIRE([AC_CANONICAL_HOST])dnl
+# Prepare PATH_SEPARATOR.
+# The user is always right.
+if test "${PATH_SEPARATOR+set}" != set; then
+  echo "#! /bin/sh" >conf$$.sh
+  echo  "exit 0"   >>conf$$.sh
+  chmod +x conf$$.sh
+  if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then
+    PATH_SEPARATOR=';'
+  else
+    PATH_SEPARATOR=:
+  fi
+  rm -f conf$$.sh
+fi
+ac_prog=ld
+if test "$GCC" = yes; then
+  # Check if gcc -print-prog-name=ld gives a path.
+  AC_MSG_CHECKING([for ld used by GCC])
+  case $host in
+  *-*-mingw*)
+    # gcc leaves a trailing carriage return which upsets mingw
+    ac_prog=`($CC -print-prog-name=ld) 2>&5 | tr -d '\015'` ;;
+  *)
+    ac_prog=`($CC -print-prog-name=ld) 2>&5` ;;
+  esac
+  case $ac_prog in
+    # Accept absolute paths.
+    [[\\/]* | [A-Za-z]:[\\/]*)]
+      [re_direlt='/[^/][^/]*/\.\./']
+      # Canonicalize the path of ld
+      ac_prog=`echo $ac_prog| sed 's%\\\\%/%g'`
+      while echo $ac_prog | grep "$re_direlt" > /dev/null 2>&1; do
+	ac_prog=`echo $ac_prog| sed "s%$re_direlt%/%"`
+      done
+      test -z "$LD" && LD="$ac_prog"
+      ;;
+  "")
+    # If it fails, then pretend we aren't using GCC.
+    ac_prog=ld
+    ;;
+  *)
+    # If it is relative, then search for the first ld in PATH.
+    with_gnu_ld=unknown
+    ;;
+  esac
+elif test "$with_gnu_ld" = yes; then
+  AC_MSG_CHECKING([for GNU ld])
+else
+  AC_MSG_CHECKING([for non-GNU ld])
+fi
+AC_CACHE_VAL([acl_cv_path_LD],
+[if test -z "$LD"; then
+  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS="${IFS}${PATH_SEPARATOR-:}"
+  for ac_dir in $PATH; do
+    test -z "$ac_dir" && ac_dir=.
+    if test -f "$ac_dir/$ac_prog" || test -f "$ac_dir/$ac_prog$ac_exeext"; then
+      acl_cv_path_LD="$ac_dir/$ac_prog"
+      # Check to see if the program is GNU ld.  I'd rather use --version,
+      # but apparently some GNU ld's only accept -v.
+      # Break only if it was the GNU/non-GNU ld that we prefer.
+      case `"$acl_cv_path_LD" -v 2>&1 < /dev/null` in
+      *GNU* | *'with BFD'*)
+	test "$with_gnu_ld" != no && break ;;
+      *)
+	test "$with_gnu_ld" != yes && break ;;
+      esac
+    fi
+  done
+  IFS="$ac_save_ifs"
+else
+  acl_cv_path_LD="$LD" # Let the user override the test with a path.
+fi])
+LD="$acl_cv_path_LD"
+if test -n "$LD"; then
+  AC_MSG_RESULT([$LD])
+else
+  AC_MSG_RESULT([no])
+fi
+test -z "$LD" && AC_MSG_ERROR([no acceptable ld found in \$PATH])
+AC_LIB_PROG_LD_GNU
+])
diff --git a/m4/lib-link.m4 b/m4/lib-link.m4
new file mode 100644
index 000000000..2f8b7ff38
--- /dev/null
+++ b/m4/lib-link.m4
@@ -0,0 +1,764 @@
+# lib-link.m4 serial 20 (gettext-0.18)
+dnl Copyright (C) 2001-2009 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+dnl From Bruno Haible.
+
+AC_PREREQ([2.54])
+
+dnl AC_LIB_LINKFLAGS(name [, dependencies]) searches for libname and
+dnl the libraries corresponding to explicit and implicit dependencies.
+dnl Sets and AC_SUBSTs the LIB${NAME} and LTLIB${NAME} variables and
+dnl augments the CPPFLAGS variable.
+dnl Sets and AC_SUBSTs the LIB${NAME}_PREFIX variable to nonempty if libname
+dnl was found in ${LIB${NAME}_PREFIX}/$acl_libdirstem.
+AC_DEFUN([AC_LIB_LINKFLAGS],
+[
+  AC_REQUIRE([AC_LIB_PREPARE_PREFIX])
+  AC_REQUIRE([AC_LIB_RPATH])
+  pushdef([Name],[translit([$1],[./-], [___])])
+  pushdef([NAME],[translit([$1],[abcdefghijklmnopqrstuvwxyz./-],
+                                [ABCDEFGHIJKLMNOPQRSTUVWXYZ___])])
+  AC_CACHE_CHECK([how to link with lib[]$1], [ac_cv_lib[]Name[]_libs], [
+    AC_LIB_LINKFLAGS_BODY([$1], [$2])
+    ac_cv_lib[]Name[]_libs="$LIB[]NAME"
+    ac_cv_lib[]Name[]_ltlibs="$LTLIB[]NAME"
+    ac_cv_lib[]Name[]_cppflags="$INC[]NAME"
+    ac_cv_lib[]Name[]_prefix="$LIB[]NAME[]_PREFIX"
+  ])
+  LIB[]NAME="$ac_cv_lib[]Name[]_libs"
+  LTLIB[]NAME="$ac_cv_lib[]Name[]_ltlibs"
+  INC[]NAME="$ac_cv_lib[]Name[]_cppflags"
+  LIB[]NAME[]_PREFIX="$ac_cv_lib[]Name[]_prefix"
+  AC_LIB_APPENDTOVAR([CPPFLAGS], [$INC]NAME)
+  AC_SUBST([LIB]NAME)
+  AC_SUBST([LTLIB]NAME)
+  AC_SUBST([LIB]NAME[_PREFIX])
+  dnl Also set HAVE_LIB[]NAME so that AC_LIB_HAVE_LINKFLAGS can reuse the
+  dnl results of this search when this library appears as a dependency.
+  HAVE_LIB[]NAME=yes
+  popdef([NAME])
+  popdef([Name])
+])
+
+dnl AC_LIB_HAVE_LINKFLAGS(name, dependencies, includes, testcode, [missing-message])
+dnl searches for libname and the libraries corresponding to explicit and
+dnl implicit dependencies, together with the specified include files and
+dnl the ability to compile and link the specified testcode. The missing-message
+dnl defaults to 'no' and may contain additional hints for the user.
+dnl If found, it sets and AC_SUBSTs HAVE_LIB${NAME}=yes and the LIB${NAME}
+dnl and LTLIB${NAME} variables and augments the CPPFLAGS variable, and
+dnl #defines HAVE_LIB${NAME} to 1. Otherwise, it sets and AC_SUBSTs
+dnl HAVE_LIB${NAME}=no and LIB${NAME} and LTLIB${NAME} to empty.
+dnl Sets and AC_SUBSTs the LIB${NAME}_PREFIX variable to nonempty if libname
+dnl was found in ${LIB${NAME}_PREFIX}/$acl_libdirstem.
+AC_DEFUN([AC_LIB_HAVE_LINKFLAGS],
+[
+  AC_REQUIRE([AC_LIB_PREPARE_PREFIX])
+  AC_REQUIRE([AC_LIB_RPATH])
+  pushdef([Name],[translit([$1],[./-], [___])])
+  pushdef([NAME],[translit([$1],[abcdefghijklmnopqrstuvwxyz./-],
+                                [ABCDEFGHIJKLMNOPQRSTUVWXYZ___])])
+
+  dnl Search for lib[]Name and define LIB[]NAME, LTLIB[]NAME and INC[]NAME
+  dnl accordingly.
+  AC_LIB_LINKFLAGS_BODY([$1], [$2])
+
+  dnl Add $INC[]NAME to CPPFLAGS before performing the following checks,
+  dnl because if the user has installed lib[]Name and not disabled its use
+  dnl via --without-lib[]Name-prefix, he wants to use it.
+  ac_save_CPPFLAGS="$CPPFLAGS"
+  AC_LIB_APPENDTOVAR([CPPFLAGS], [$INC]NAME)
+
+  AC_CACHE_CHECK([for lib[]$1], [ac_cv_lib[]Name], [
+    ac_save_LIBS="$LIBS"
+    LIBS="$LIBS $LIB[]NAME"
+    AC_TRY_LINK([$3], [$4],
+      [ac_cv_lib[]Name=yes],
+      [ac_cv_lib[]Name='m4_if([$5], [], [no], [[$5]])'])
+    LIBS="$ac_save_LIBS"
+  ])
+  if test "$ac_cv_lib[]Name" = yes; then
+    HAVE_LIB[]NAME=yes
+    AC_DEFINE([HAVE_LIB]NAME, 1, [Define if you have the lib][$1 library.])
+    AC_MSG_CHECKING([how to link with lib[]$1])
+    AC_MSG_RESULT([$LIB[]NAME])
+  else
+    HAVE_LIB[]NAME=no
+    dnl If $LIB[]NAME didn't lead to a usable library, we don't need
+    dnl $INC[]NAME either.
+    CPPFLAGS="$ac_save_CPPFLAGS"
+    LIB[]NAME=
+    LTLIB[]NAME=
+    LIB[]NAME[]_PREFIX=
+  fi
+  AC_SUBST([HAVE_LIB]NAME)
+  AC_SUBST([LIB]NAME)
+  AC_SUBST([LTLIB]NAME)
+  AC_SUBST([LIB]NAME[_PREFIX])
+  popdef([NAME])
+  popdef([Name])
+])
+
+dnl Determine the platform dependent parameters needed to use rpath:
+dnl   acl_libext,
+dnl   acl_shlibext,
+dnl   acl_hardcode_libdir_flag_spec,
+dnl   acl_hardcode_libdir_separator,
+dnl   acl_hardcode_direct,
+dnl   acl_hardcode_minus_L.
+AC_DEFUN([AC_LIB_RPATH],
+[
+  dnl Tell automake >= 1.10 to complain if config.rpath is missing.
+  m4_ifdef([AC_REQUIRE_AUX_FILE], [AC_REQUIRE_AUX_FILE([config.rpath])])
+  AC_REQUIRE([AC_PROG_CC])                dnl we use $CC, $GCC, $LDFLAGS
+  AC_REQUIRE([AC_LIB_PROG_LD])            dnl we use $LD, $with_gnu_ld
+  AC_REQUIRE([AC_CANONICAL_HOST])         dnl we use $host
+  AC_REQUIRE([AC_CONFIG_AUX_DIR_DEFAULT]) dnl we use $ac_aux_dir
+  AC_CACHE_CHECK([for shared library run path origin], [acl_cv_rpath], [
+    CC="$CC" GCC="$GCC" LDFLAGS="$LDFLAGS" LD="$LD" with_gnu_ld="$with_gnu_ld" \
+    ${CONFIG_SHELL-/bin/sh} "$ac_aux_dir/config.rpath" "$host" > conftest.sh
+    . ./conftest.sh
+    rm -f ./conftest.sh
+    acl_cv_rpath=done
+  ])
+  wl="$acl_cv_wl"
+  acl_libext="$acl_cv_libext"
+  acl_shlibext="$acl_cv_shlibext"
+  acl_libname_spec="$acl_cv_libname_spec"
+  acl_library_names_spec="$acl_cv_library_names_spec"
+  acl_hardcode_libdir_flag_spec="$acl_cv_hardcode_libdir_flag_spec"
+  acl_hardcode_libdir_separator="$acl_cv_hardcode_libdir_separator"
+  acl_hardcode_direct="$acl_cv_hardcode_direct"
+  acl_hardcode_minus_L="$acl_cv_hardcode_minus_L"
+  dnl Determine whether the user wants rpath handling at all.
+  AC_ARG_ENABLE([rpath],
+    [  --disable-rpath         do not hardcode runtime library paths],
+    :, enable_rpath=yes)
+])
+
+dnl AC_LIB_FROMPACKAGE(name, package)
+dnl declares that libname comes from the given package. The configure file
+dnl will then not have a --with-libname-prefix option but a
+dnl --with-package-prefix option. Several libraries can come from the same
+dnl package. This declaration must occur before an AC_LIB_LINKFLAGS or similar
+dnl macro call that searches for libname.
+AC_DEFUN([AC_LIB_FROMPACKAGE],
+[
+  pushdef([NAME],[translit([$1],[abcdefghijklmnopqrstuvwxyz./-],
+                                [ABCDEFGHIJKLMNOPQRSTUVWXYZ___])])
+  define([acl_frompackage_]NAME, [$2])
+  popdef([NAME])
+  pushdef([PACK],[$2])
+  pushdef([PACKUP],[translit(PACK,[abcdefghijklmnopqrstuvwxyz./-],
+                                  [ABCDEFGHIJKLMNOPQRSTUVWXYZ___])])
+  define([acl_libsinpackage_]PACKUP,
+    m4_ifdef([acl_libsinpackage_]PACKUP, [acl_libsinpackage_]PACKUP[[, ]],)[lib$1])
+  popdef([PACKUP])
+  popdef([PACK])
+])
+
+dnl AC_LIB_LINKFLAGS_BODY(name [, dependencies]) searches for libname and
+dnl the libraries corresponding to explicit and implicit dependencies.
+dnl Sets the LIB${NAME}, LTLIB${NAME} and INC${NAME} variables.
+dnl Also, sets the LIB${NAME}_PREFIX variable to nonempty if libname was found
+dnl in ${LIB${NAME}_PREFIX}/$acl_libdirstem.
+AC_DEFUN([AC_LIB_LINKFLAGS_BODY],
+[
+  AC_REQUIRE([AC_LIB_PREPARE_MULTILIB])
+  pushdef([NAME],[translit([$1],[abcdefghijklmnopqrstuvwxyz./-],
+                                [ABCDEFGHIJKLMNOPQRSTUVWXYZ___])])
+  pushdef([PACK],[m4_ifdef([acl_frompackage_]NAME, [acl_frompackage_]NAME, lib[$1])])
+  pushdef([PACKUP],[translit(PACK,[abcdefghijklmnopqrstuvwxyz./-],
+                                  [ABCDEFGHIJKLMNOPQRSTUVWXYZ___])])
+  pushdef([PACKLIBS],[m4_ifdef([acl_frompackage_]NAME, [acl_libsinpackage_]PACKUP, lib[$1])])
+  dnl Autoconf >= 2.61 supports dots in --with options.
+  pushdef([P_A_C_K],[m4_if(m4_version_compare(m4_defn([m4_PACKAGE_VERSION]),[2.61]),[-1],[translit(PACK,[.],[_])],PACK)])
+  dnl By default, look in $includedir and $libdir.
+  use_additional=yes
+  AC_LIB_WITH_FINAL_PREFIX([
+    eval additional_includedir=\"$includedir\"
+    eval additional_libdir=\"$libdir\"
+  ])
+  AC_ARG_WITH(P_A_C_K[-prefix],
+[[  --with-]]P_A_C_K[[-prefix[=DIR]  search for ]PACKLIBS[ in DIR/include and DIR/lib
+  --without-]]P_A_C_K[[-prefix     don't search for ]PACKLIBS[ in includedir and libdir]],
+[
+    if test "X$withval" = "Xno"; then
+      use_additional=no
+    else
+      if test "X$withval" = "X"; then
+        AC_LIB_WITH_FINAL_PREFIX([
+          eval additional_includedir=\"$includedir\"
+          eval additional_libdir=\"$libdir\"
+        ])
+      else
+        additional_includedir="$withval/include"
+        additional_libdir="$withval/$acl_libdirstem"
+        if test "$acl_libdirstem2" != "$acl_libdirstem" \
+           && ! test -d "$withval/$acl_libdirstem"; then
+          additional_libdir="$withval/$acl_libdirstem2"
+        fi
+      fi
+    fi
+])
+  dnl Search the library and its dependencies in $additional_libdir and
+  dnl $LDFLAGS. Using breadth-first-seach.
+  LIB[]NAME=
+  LTLIB[]NAME=
+  INC[]NAME=
+  LIB[]NAME[]_PREFIX=
+  dnl HAVE_LIB${NAME} is an indicator that LIB${NAME}, LTLIB${NAME} have been
+  dnl computed. So it has to be reset here.
+  HAVE_LIB[]NAME=
+  rpathdirs=
+  ltrpathdirs=
+  names_already_handled=
+  names_next_round='$1 $2'
+  while test -n "$names_next_round"; do
+    names_this_round="$names_next_round"
+    names_next_round=
+    for name in $names_this_round; do
+      already_handled=
+      for n in $names_already_handled; do
+        if test "$n" = "$name"; then
+          already_handled=yes
+          break
+        fi
+      done
+      if test -z "$already_handled"; then
+        names_already_handled="$names_already_handled $name"
+        dnl See if it was already located by an earlier AC_LIB_LINKFLAGS
+        dnl or AC_LIB_HAVE_LINKFLAGS call.
+        uppername=`echo "$name" | sed -e 'y|abcdefghijklmnopqrstuvwxyz./-|ABCDEFGHIJKLMNOPQRSTUVWXYZ___|'`
+        eval value=\"\$HAVE_LIB$uppername\"
+        if test -n "$value"; then
+          if test "$value" = yes; then
+            eval value=\"\$LIB$uppername\"
+            test -z "$value" || LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }$value"
+            eval value=\"\$LTLIB$uppername\"
+            test -z "$value" || LTLIB[]NAME="${LTLIB[]NAME}${LTLIB[]NAME:+ }$value"
+          else
+            dnl An earlier call to AC_LIB_HAVE_LINKFLAGS has determined
+            dnl that this library doesn't exist. So just drop it.
+            :
+          fi
+        else
+          dnl Search the library lib$name in $additional_libdir and $LDFLAGS
+          dnl and the already constructed $LIBNAME/$LTLIBNAME.
+          found_dir=
+          found_la=
+          found_so=
+          found_a=
+          eval libname=\"$acl_libname_spec\"    # typically: libname=lib$name
+          if test -n "$acl_shlibext"; then
+            shrext=".$acl_shlibext"             # typically: shrext=.so
+          else
+            shrext=
+          fi
+          if test $use_additional = yes; then
+            dir="$additional_libdir"
+            dnl The same code as in the loop below:
+            dnl First look for a shared library.
+            if test -n "$acl_shlibext"; then
+              if test -f "$dir/$libname$shrext"; then
+                found_dir="$dir"
+                found_so="$dir/$libname$shrext"
+              else
+                if test "$acl_library_names_spec" = '$libname$shrext$versuffix'; then
+                  ver=`(cd "$dir" && \
+                        for f in "$libname$shrext".*; do echo "$f"; done \
+                        | sed -e "s,^$libname$shrext\\\\.,," \
+                        | sort -t '.' -n -r -k1,1 -k2,2 -k3,3 -k4,4 -k5,5 \
+                        | sed 1q ) 2>/dev/null`
+                  if test -n "$ver" && test -f "$dir/$libname$shrext.$ver"; then
+                    found_dir="$dir"
+                    found_so="$dir/$libname$shrext.$ver"
+                  fi
+                else
+                  eval library_names=\"$acl_library_names_spec\"
+                  for f in $library_names; do
+                    if test -f "$dir/$f"; then
+                      found_dir="$dir"
+                      found_so="$dir/$f"
+                      break
+                    fi
+                  done
+                fi
+              fi
+            fi
+            dnl Then look for a static library.
+            if test "X$found_dir" = "X"; then
+              if test -f "$dir/$libname.$acl_libext"; then
+                found_dir="$dir"
+                found_a="$dir/$libname.$acl_libext"
+              fi
+            fi
+            if test "X$found_dir" != "X"; then
+              if test -f "$dir/$libname.la"; then
+                found_la="$dir/$libname.la"
+              fi
+            fi
+          fi
+          if test "X$found_dir" = "X"; then
+            for x in $LDFLAGS $LTLIB[]NAME; do
+              AC_LIB_WITH_FINAL_PREFIX([eval x=\"$x\"])
+              case "$x" in
+                -L*)
+                  dir=`echo "X$x" | sed -e 's/^X-L//'`
+                  dnl First look for a shared library.
+                  if test -n "$acl_shlibext"; then
+                    if test -f "$dir/$libname$shrext"; then
+                      found_dir="$dir"
+                      found_so="$dir/$libname$shrext"
+                    else
+                      if test "$acl_library_names_spec" = '$libname$shrext$versuffix'; then
+                        ver=`(cd "$dir" && \
+                              for f in "$libname$shrext".*; do echo "$f"; done \
+                              | sed -e "s,^$libname$shrext\\\\.,," \
+                              | sort -t '.' -n -r -k1,1 -k2,2 -k3,3 -k4,4 -k5,5 \
+                              | sed 1q ) 2>/dev/null`
+                        if test -n "$ver" && test -f "$dir/$libname$shrext.$ver"; then
+                          found_dir="$dir"
+                          found_so="$dir/$libname$shrext.$ver"
+                        fi
+                      else
+                        eval library_names=\"$acl_library_names_spec\"
+                        for f in $library_names; do
+                          if test -f "$dir/$f"; then
+                            found_dir="$dir"
+                            found_so="$dir/$f"
+                            break
+                          fi
+                        done
+                      fi
+                    fi
+                  fi
+                  dnl Then look for a static library.
+                  if test "X$found_dir" = "X"; then
+                    if test -f "$dir/$libname.$acl_libext"; then
+                      found_dir="$dir"
+                      found_a="$dir/$libname.$acl_libext"
+                    fi
+                  fi
+                  if test "X$found_dir" != "X"; then
+                    if test -f "$dir/$libname.la"; then
+                      found_la="$dir/$libname.la"
+                    fi
+                  fi
+                  ;;
+              esac
+              if test "X$found_dir" != "X"; then
+                break
+              fi
+            done
+          fi
+          if test "X$found_dir" != "X"; then
+            dnl Found the library.
+            LTLIB[]NAME="${LTLIB[]NAME}${LTLIB[]NAME:+ }-L$found_dir -l$name"
+            if test "X$found_so" != "X"; then
+              dnl Linking with a shared library. We attempt to hardcode its
+              dnl directory into the executable's runpath, unless it's the
+              dnl standard /usr/lib.
+              if test "$enable_rpath" = no \
+                 || test "X$found_dir" = "X/usr/$acl_libdirstem" \
+                 || test "X$found_dir" = "X/usr/$acl_libdirstem2"; then
+                dnl No hardcoding is needed.
+                LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }$found_so"
+              else
+                dnl Use an explicit option to hardcode DIR into the resulting
+                dnl binary.
+                dnl Potentially add DIR to ltrpathdirs.
+                dnl The ltrpathdirs will be appended to $LTLIBNAME at the end.
+                haveit=
+                for x in $ltrpathdirs; do
+                  if test "X$x" = "X$found_dir"; then
+                    haveit=yes
+                    break
+                  fi
+                done
+                if test -z "$haveit"; then
+                  ltrpathdirs="$ltrpathdirs $found_dir"
+                fi
+                dnl The hardcoding into $LIBNAME is system dependent.
+                if test "$acl_hardcode_direct" = yes; then
+                  dnl Using DIR/libNAME.so during linking hardcodes DIR into the
+                  dnl resulting binary.
+                  LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }$found_so"
+                else
+                  if test -n "$acl_hardcode_libdir_flag_spec" && test "$acl_hardcode_minus_L" = no; then
+                    dnl Use an explicit option to hardcode DIR into the resulting
+                    dnl binary.
+                    LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }$found_so"
+                    dnl Potentially add DIR to rpathdirs.
+                    dnl The rpathdirs will be appended to $LIBNAME at the end.
+                    haveit=
+                    for x in $rpathdirs; do
+                      if test "X$x" = "X$found_dir"; then
+                        haveit=yes
+                        break
+                      fi
+                    done
+                    if test -z "$haveit"; then
+                      rpathdirs="$rpathdirs $found_dir"
+                    fi
+                  else
+                    dnl Rely on "-L$found_dir".
+                    dnl But don't add it if it's already contained in the LDFLAGS
+                    dnl or the already constructed $LIBNAME
+                    haveit=
+                    for x in $LDFLAGS $LIB[]NAME; do
+                      AC_LIB_WITH_FINAL_PREFIX([eval x=\"$x\"])
+                      if test "X$x" = "X-L$found_dir"; then
+                        haveit=yes
+                        break
+                      fi
+                    done
+                    if test -z "$haveit"; then
+                      LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }-L$found_dir"
+                    fi
+                    if test "$acl_hardcode_minus_L" != no; then
+                      dnl FIXME: Not sure whether we should use
+                      dnl "-L$found_dir -l$name" or "-L$found_dir $found_so"
+                      dnl here.
+                      LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }$found_so"
+                    else
+                      dnl We cannot use $acl_hardcode_runpath_var and LD_RUN_PATH
+                      dnl here, because this doesn't fit in flags passed to the
+                      dnl compiler. So give up. No hardcoding. This affects only
+                      dnl very old systems.
+                      dnl FIXME: Not sure whether we should use
+                      dnl "-L$found_dir -l$name" or "-L$found_dir $found_so"
+                      dnl here.
+                      LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }-l$name"
+                    fi
+                  fi
+                fi
+              fi
+            else
+              if test "X$found_a" != "X"; then
+                dnl Linking with a static library.
+                LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }$found_a"
+              else
+                dnl We shouldn't come here, but anyway it's good to have a
+                dnl fallback.
+                LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }-L$found_dir -l$name"
+              fi
+            fi
+            dnl Assume the include files are nearby.
+            additional_includedir=
+            case "$found_dir" in
+              */$acl_libdirstem | */$acl_libdirstem/)
+                basedir=`echo "X$found_dir" | sed -e 's,^X,,' -e "s,/$acl_libdirstem/"'*$,,'`
+                if test "$name" = '$1'; then
+                  LIB[]NAME[]_PREFIX="$basedir"
+                fi
+                additional_includedir="$basedir/include"
+                ;;
+              */$acl_libdirstem2 | */$acl_libdirstem2/)
+                basedir=`echo "X$found_dir" | sed -e 's,^X,,' -e "s,/$acl_libdirstem2/"'*$,,'`
+                if test "$name" = '$1'; then
+                  LIB[]NAME[]_PREFIX="$basedir"
+                fi
+                additional_includedir="$basedir/include"
+                ;;
+            esac
+            if test "X$additional_includedir" != "X"; then
+              dnl Potentially add $additional_includedir to $INCNAME.
+              dnl But don't add it
+              dnl   1. if it's the standard /usr/include,
+              dnl   2. if it's /usr/local/include and we are using GCC on Linux,
+              dnl   3. if it's already present in $CPPFLAGS or the already
+              dnl      constructed $INCNAME,
+              dnl   4. if it doesn't exist as a directory.
+              if test "X$additional_includedir" != "X/usr/include"; then
+                haveit=
+                if test "X$additional_includedir" = "X/usr/local/include"; then
+                  if test -n "$GCC"; then
+                    case $host_os in
+                      linux* | gnu* | k*bsd*-gnu) haveit=yes;;
+                    esac
+                  fi
+                fi
+                if test -z "$haveit"; then
+                  for x in $CPPFLAGS $INC[]NAME; do
+                    AC_LIB_WITH_FINAL_PREFIX([eval x=\"$x\"])
+                    if test "X$x" = "X-I$additional_includedir"; then
+                      haveit=yes
+                      break
+                    fi
+                  done
+                  if test -z "$haveit"; then
+                    if test -d "$additional_includedir"; then
+                      dnl Really add $additional_includedir to $INCNAME.
+                      INC[]NAME="${INC[]NAME}${INC[]NAME:+ }-I$additional_includedir"
+                    fi
+                  fi
+                fi
+              fi
+            fi
+            dnl Look for dependencies.
+            if test -n "$found_la"; then
+              dnl Read the .la file. It defines the variables
+              dnl dlname, library_names, old_library, dependency_libs, current,
+              dnl age, revision, installed, dlopen, dlpreopen, libdir.
+              save_libdir="$libdir"
+              case "$found_la" in
+                */* | *\\*) . "$found_la" ;;
+                *) . "./$found_la" ;;
+              esac
+              libdir="$save_libdir"
+              dnl We use only dependency_libs.
+              for dep in $dependency_libs; do
+                case "$dep" in
+                  -L*)
+                    additional_libdir=`echo "X$dep" | sed -e 's/^X-L//'`
+                    dnl Potentially add $additional_libdir to $LIBNAME and $LTLIBNAME.
+                    dnl But don't add it
+                    dnl   1. if it's the standard /usr/lib,
+                    dnl   2. if it's /usr/local/lib and we are using GCC on Linux,
+                    dnl   3. if it's already present in $LDFLAGS or the already
+                    dnl      constructed $LIBNAME,
+                    dnl   4. if it doesn't exist as a directory.
+                    if test "X$additional_libdir" != "X/usr/$acl_libdirstem" \
+                       && test "X$additional_libdir" != "X/usr/$acl_libdirstem2"; then
+                      haveit=
+                      if test "X$additional_libdir" = "X/usr/local/$acl_libdirstem" \
+                         || test "X$additional_libdir" = "X/usr/local/$acl_libdirstem2"; then
+                        if test -n "$GCC"; then
+                          case $host_os in
+                            linux* | gnu* | k*bsd*-gnu) haveit=yes;;
+                          esac
+                        fi
+                      fi
+                      if test -z "$haveit"; then
+                        haveit=
+                        for x in $LDFLAGS $LIB[]NAME; do
+                          AC_LIB_WITH_FINAL_PREFIX([eval x=\"$x\"])
+                          if test "X$x" = "X-L$additional_libdir"; then
+                            haveit=yes
+                            break
+                          fi
+                        done
+                        if test -z "$haveit"; then
+                          if test -d "$additional_libdir"; then
+                            dnl Really add $additional_libdir to $LIBNAME.
+                            LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }-L$additional_libdir"
+                          fi
+                        fi
+                        haveit=
+                        for x in $LDFLAGS $LTLIB[]NAME; do
+                          AC_LIB_WITH_FINAL_PREFIX([eval x=\"$x\"])
+                          if test "X$x" = "X-L$additional_libdir"; then
+                            haveit=yes
+                            break
+                          fi
+                        done
+                        if test -z "$haveit"; then
+                          if test -d "$additional_libdir"; then
+                            dnl Really add $additional_libdir to $LTLIBNAME.
+                            LTLIB[]NAME="${LTLIB[]NAME}${LTLIB[]NAME:+ }-L$additional_libdir"
+                          fi
+                        fi
+                      fi
+                    fi
+                    ;;
+                  -R*)
+                    dir=`echo "X$dep" | sed -e 's/^X-R//'`
+                    if test "$enable_rpath" != no; then
+                      dnl Potentially add DIR to rpathdirs.
+                      dnl The rpathdirs will be appended to $LIBNAME at the end.
+                      haveit=
+                      for x in $rpathdirs; do
+                        if test "X$x" = "X$dir"; then
+                          haveit=yes
+                          break
+                        fi
+                      done
+                      if test -z "$haveit"; then
+                        rpathdirs="$rpathdirs $dir"
+                      fi
+                      dnl Potentially add DIR to ltrpathdirs.
+                      dnl The ltrpathdirs will be appended to $LTLIBNAME at the end.
+                      haveit=
+                      for x in $ltrpathdirs; do
+                        if test "X$x" = "X$dir"; then
+                          haveit=yes
+                          break
+                        fi
+                      done
+                      if test -z "$haveit"; then
+                        ltrpathdirs="$ltrpathdirs $dir"
+                      fi
+                    fi
+                    ;;
+                  -l*)
+                    dnl Handle this in the next round.
+                    names_next_round="$names_next_round "`echo "X$dep" | sed -e 's/^X-l//'`
+                    ;;
+                  *.la)
+                    dnl Handle this in the next round. Throw away the .la's
+                    dnl directory; it is already contained in a preceding -L
+                    dnl option.
+                    names_next_round="$names_next_round "`echo "X$dep" | sed -e 's,^X.*/,,' -e 's,^lib,,' -e 's,\.la$,,'`
+                    ;;
+                  *)
+                    dnl Most likely an immediate library name.
+                    LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }$dep"
+                    LTLIB[]NAME="${LTLIB[]NAME}${LTLIB[]NAME:+ }$dep"
+                    ;;
+                esac
+              done
+            fi
+          else
+            dnl Didn't find the library; assume it is in the system directories
+            dnl known to the linker and runtime loader. (All the system
+            dnl directories known to the linker should also be known to the
+            dnl runtime loader, otherwise the system is severely misconfigured.)
+            LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }-l$name"
+            LTLIB[]NAME="${LTLIB[]NAME}${LTLIB[]NAME:+ }-l$name"
+          fi
+        fi
+      fi
+    done
+  done
+  if test "X$rpathdirs" != "X"; then
+    if test -n "$acl_hardcode_libdir_separator"; then
+      dnl Weird platform: only the last -rpath option counts, the user must
+      dnl pass all path elements in one option. We can arrange that for a
+      dnl single library, but not when more than one $LIBNAMEs are used.
+      alldirs=
+      for found_dir in $rpathdirs; do
+        alldirs="${alldirs}${alldirs:+$acl_hardcode_libdir_separator}$found_dir"
+      done
+      dnl Note: acl_hardcode_libdir_flag_spec uses $libdir and $wl.
+      acl_save_libdir="$libdir"
+      libdir="$alldirs"
+      eval flag=\"$acl_hardcode_libdir_flag_spec\"
+      libdir="$acl_save_libdir"
+      LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }$flag"
+    else
+      dnl The -rpath options are cumulative.
+      for found_dir in $rpathdirs; do
+        acl_save_libdir="$libdir"
+        libdir="$found_dir"
+        eval flag=\"$acl_hardcode_libdir_flag_spec\"
+        libdir="$acl_save_libdir"
+        LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }$flag"
+      done
+    fi
+  fi
+  if test "X$ltrpathdirs" != "X"; then
+    dnl When using libtool, the option that works for both libraries and
+    dnl executables is -R. The -R options are cumulative.
+    for found_dir in $ltrpathdirs; do
+      LTLIB[]NAME="${LTLIB[]NAME}${LTLIB[]NAME:+ }-R$found_dir"
+    done
+  fi
+  popdef([P_A_C_K])
+  popdef([PACKLIBS])
+  popdef([PACKUP])
+  popdef([PACK])
+  popdef([NAME])
+])
+
+dnl AC_LIB_APPENDTOVAR(VAR, CONTENTS) appends the elements of CONTENTS to VAR,
+dnl unless already present in VAR.
+dnl Works only for CPPFLAGS, not for LIB* variables because that sometimes
+dnl contains two or three consecutive elements that belong together.
+AC_DEFUN([AC_LIB_APPENDTOVAR],
+[
+  for element in [$2]; do
+    haveit=
+    for x in $[$1]; do
+      AC_LIB_WITH_FINAL_PREFIX([eval x=\"$x\"])
+      if test "X$x" = "X$element"; then
+        haveit=yes
+        break
+      fi
+    done
+    if test -z "$haveit"; then
+      [$1]="${[$1]}${[$1]:+ }$element"
+    fi
+  done
+])
+
+dnl For those cases where a variable contains several -L and -l options
+dnl referring to unknown libraries and directories, this macro determines the
+dnl necessary additional linker options for the runtime path.
+dnl AC_LIB_LINKFLAGS_FROM_LIBS([LDADDVAR], [LIBSVALUE], [USE-LIBTOOL])
+dnl sets LDADDVAR to linker options needed together with LIBSVALUE.
+dnl If USE-LIBTOOL evaluates to non-empty, linking with libtool is assumed,
+dnl otherwise linking without libtool is assumed.
+AC_DEFUN([AC_LIB_LINKFLAGS_FROM_LIBS],
+[
+  AC_REQUIRE([AC_LIB_RPATH])
+  AC_REQUIRE([AC_LIB_PREPARE_MULTILIB])
+  $1=
+  if test "$enable_rpath" != no; then
+    if test -n "$acl_hardcode_libdir_flag_spec" && test "$acl_hardcode_minus_L" = no; then
+      dnl Use an explicit option to hardcode directories into the resulting
+      dnl binary.
+      rpathdirs=
+      next=
+      for opt in $2; do
+        if test -n "$next"; then
+          dir="$next"
+          dnl No need to hardcode the standard /usr/lib.
+          if test "X$dir" != "X/usr/$acl_libdirstem" \
+             && test "X$dir" != "X/usr/$acl_libdirstem2"; then
+            rpathdirs="$rpathdirs $dir"
+          fi
+          next=
+        else
+          case $opt in
+            -L) next=yes ;;
+            -L*) dir=`echo "X$opt" | sed -e 's,^X-L,,'`
+                 dnl No need to hardcode the standard /usr/lib.
+                 if test "X$dir" != "X/usr/$acl_libdirstem" \
+                    && test "X$dir" != "X/usr/$acl_libdirstem2"; then
+                   rpathdirs="$rpathdirs $dir"
+                 fi
+                 next= ;;
+            *) next= ;;
+          esac
+        fi
+      done
+      if test "X$rpathdirs" != "X"; then
+        if test -n ""$3""; then
+          dnl libtool is used for linking. Use -R options.
+          for dir in $rpathdirs; do
+            $1="${$1}${$1:+ }-R$dir"
+          done
+        else
+          dnl The linker is used for linking directly.
+          if test -n "$acl_hardcode_libdir_separator"; then
+            dnl Weird platform: only the last -rpath option counts, the user
+            dnl must pass all path elements in one option.
+            alldirs=
+            for dir in $rpathdirs; do
+              alldirs="${alldirs}${alldirs:+$acl_hardcode_libdir_separator}$dir"
+            done
+            acl_save_libdir="$libdir"
+            libdir="$alldirs"
+            eval flag=\"$acl_hardcode_libdir_flag_spec\"
+            libdir="$acl_save_libdir"
+            $1="$flag"
+          else
+            dnl The -rpath options are cumulative.
+            for dir in $rpathdirs; do
+              acl_save_libdir="$libdir"
+              libdir="$dir"
+              eval flag=\"$acl_hardcode_libdir_flag_spec\"
+              libdir="$acl_save_libdir"
+              $1="${$1}${$1:+ }$flag"
+            done
+          fi
+        fi
+      fi
+    fi
+  fi
+  AC_SUBST([$1])
+])
diff --git a/m4/lib-prefix.m4 b/m4/lib-prefix.m4
new file mode 100644
index 000000000..4b7ee3358
--- /dev/null
+++ b/m4/lib-prefix.m4
@@ -0,0 +1,224 @@
+# lib-prefix.m4 serial 7 (gettext-0.18)
+dnl Copyright (C) 2001-2005, 2008-2009 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+dnl From Bruno Haible.
+
+dnl AC_LIB_ARG_WITH is synonymous to AC_ARG_WITH in autoconf-2.13, and
+dnl similar to AC_ARG_WITH in autoconf 2.52...2.57 except that is doesn't
+dnl require excessive bracketing.
+ifdef([AC_HELP_STRING],
+[AC_DEFUN([AC_LIB_ARG_WITH], [AC_ARG_WITH([$1],[[$2]],[$3],[$4])])],
+[AC_DEFUN([AC_][LIB_ARG_WITH], [AC_ARG_WITH([$1],[$2],[$3],[$4])])])
+
+dnl AC_LIB_PREFIX adds to the CPPFLAGS and LDFLAGS the flags that are needed
+dnl to access previously installed libraries. The basic assumption is that
+dnl a user will want packages to use other packages he previously installed
+dnl with the same --prefix option.
+dnl This macro is not needed if only AC_LIB_LINKFLAGS is used to locate
+dnl libraries, but is otherwise very convenient.
+AC_DEFUN([AC_LIB_PREFIX],
+[
+  AC_BEFORE([$0], [AC_LIB_LINKFLAGS])
+  AC_REQUIRE([AC_PROG_CC])
+  AC_REQUIRE([AC_CANONICAL_HOST])
+  AC_REQUIRE([AC_LIB_PREPARE_MULTILIB])
+  AC_REQUIRE([AC_LIB_PREPARE_PREFIX])
+  dnl By default, look in $includedir and $libdir.
+  use_additional=yes
+  AC_LIB_WITH_FINAL_PREFIX([
+    eval additional_includedir=\"$includedir\"
+    eval additional_libdir=\"$libdir\"
+  ])
+  AC_LIB_ARG_WITH([lib-prefix],
+[  --with-lib-prefix[=DIR] search for libraries in DIR/include and DIR/lib
+  --without-lib-prefix    don't search for libraries in includedir and libdir],
+[
+    if test "X$withval" = "Xno"; then
+      use_additional=no
+    else
+      if test "X$withval" = "X"; then
+        AC_LIB_WITH_FINAL_PREFIX([
+          eval additional_includedir=\"$includedir\"
+          eval additional_libdir=\"$libdir\"
+        ])
+      else
+        additional_includedir="$withval/include"
+        additional_libdir="$withval/$acl_libdirstem"
+      fi
+    fi
+])
+  if test $use_additional = yes; then
+    dnl Potentially add $additional_includedir to $CPPFLAGS.
+    dnl But don't add it
+    dnl   1. if it's the standard /usr/include,
+    dnl   2. if it's already present in $CPPFLAGS,
+    dnl   3. if it's /usr/local/include and we are using GCC on Linux,
+    dnl   4. if it doesn't exist as a directory.
+    if test "X$additional_includedir" != "X/usr/include"; then
+      haveit=
+      for x in $CPPFLAGS; do
+        AC_LIB_WITH_FINAL_PREFIX([eval x=\"$x\"])
+        if test "X$x" = "X-I$additional_includedir"; then
+          haveit=yes
+          break
+        fi
+      done
+      if test -z "$haveit"; then
+        if test "X$additional_includedir" = "X/usr/local/include"; then
+          if test -n "$GCC"; then
+            case $host_os in
+              linux* | gnu* | k*bsd*-gnu) haveit=yes;;
+            esac
+          fi
+        fi
+        if test -z "$haveit"; then
+          if test -d "$additional_includedir"; then
+            dnl Really add $additional_includedir to $CPPFLAGS.
+            CPPFLAGS="${CPPFLAGS}${CPPFLAGS:+ }-I$additional_includedir"
+          fi
+        fi
+      fi
+    fi
+    dnl Potentially add $additional_libdir to $LDFLAGS.
+    dnl But don't add it
+    dnl   1. if it's the standard /usr/lib,
+    dnl   2. if it's already present in $LDFLAGS,
+    dnl   3. if it's /usr/local/lib and we are using GCC on Linux,
+    dnl   4. if it doesn't exist as a directory.
+    if test "X$additional_libdir" != "X/usr/$acl_libdirstem"; then
+      haveit=
+      for x in $LDFLAGS; do
+        AC_LIB_WITH_FINAL_PREFIX([eval x=\"$x\"])
+        if test "X$x" = "X-L$additional_libdir"; then
+          haveit=yes
+          break
+        fi
+      done
+      if test -z "$haveit"; then
+        if test "X$additional_libdir" = "X/usr/local/$acl_libdirstem"; then
+          if test -n "$GCC"; then
+            case $host_os in
+              linux*) haveit=yes;;
+            esac
+          fi
+        fi
+        if test -z "$haveit"; then
+          if test -d "$additional_libdir"; then
+            dnl Really add $additional_libdir to $LDFLAGS.
+            LDFLAGS="${LDFLAGS}${LDFLAGS:+ }-L$additional_libdir"
+          fi
+        fi
+      fi
+    fi
+  fi
+])
+
+dnl AC_LIB_PREPARE_PREFIX creates variables acl_final_prefix,
+dnl acl_final_exec_prefix, containing the values to which $prefix and
+dnl $exec_prefix will expand at the end of the configure script.
+AC_DEFUN([AC_LIB_PREPARE_PREFIX],
+[
+  dnl Unfortunately, prefix and exec_prefix get only finally determined
+  dnl at the end of configure.
+  if test "X$prefix" = "XNONE"; then
+    acl_final_prefix="$ac_default_prefix"
+  else
+    acl_final_prefix="$prefix"
+  fi
+  if test "X$exec_prefix" = "XNONE"; then
+    acl_final_exec_prefix='${prefix}'
+  else
+    acl_final_exec_prefix="$exec_prefix"
+  fi
+  acl_save_prefix="$prefix"
+  prefix="$acl_final_prefix"
+  eval acl_final_exec_prefix=\"$acl_final_exec_prefix\"
+  prefix="$acl_save_prefix"
+])
+
+dnl AC_LIB_WITH_FINAL_PREFIX([statement]) evaluates statement, with the
+dnl variables prefix and exec_prefix bound to the values they will have
+dnl at the end of the configure script.
+AC_DEFUN([AC_LIB_WITH_FINAL_PREFIX],
+[
+  acl_save_prefix="$prefix"
+  prefix="$acl_final_prefix"
+  acl_save_exec_prefix="$exec_prefix"
+  exec_prefix="$acl_final_exec_prefix"
+  $1
+  exec_prefix="$acl_save_exec_prefix"
+  prefix="$acl_save_prefix"
+])
+
+dnl AC_LIB_PREPARE_MULTILIB creates
+dnl - a variable acl_libdirstem, containing the basename of the libdir, either
+dnl   "lib" or "lib64" or "lib/64",
+dnl - a variable acl_libdirstem2, as a secondary possible value for
+dnl   acl_libdirstem, either the same as acl_libdirstem or "lib/sparcv9" or
+dnl   "lib/amd64".
+AC_DEFUN([AC_LIB_PREPARE_MULTILIB],
+[
+  dnl There is no formal standard regarding lib and lib64.
+  dnl On glibc systems, the current practice is that on a system supporting
+  dnl 32-bit and 64-bit instruction sets or ABIs, 64-bit libraries go under
+  dnl $prefix/lib64 and 32-bit libraries go under $prefix/lib. We determine
+  dnl the compiler's default mode by looking at the compiler's library search
+  dnl path. If at least one of its elements ends in /lib64 or points to a
+  dnl directory whose absolute pathname ends in /lib64, we assume a 64-bit ABI.
+  dnl Otherwise we use the default, namely "lib".
+  dnl On Solaris systems, the current practice is that on a system supporting
+  dnl 32-bit and 64-bit instruction sets or ABIs, 64-bit libraries go under
+  dnl $prefix/lib/64 (which is a symlink to either $prefix/lib/sparcv9 or
+  dnl $prefix/lib/amd64) and 32-bit libraries go under $prefix/lib.
+  AC_REQUIRE([AC_CANONICAL_HOST])
+  acl_libdirstem=lib
+  acl_libdirstem2=
+  case "$host_os" in
+    solaris*)
+      dnl See Solaris 10 Software Developer Collection > Solaris 64-bit Developer's Guide > The Development Environment
+      dnl <http://docs.sun.com/app/docs/doc/816-5138/dev-env?l=en&a=view>.
+      dnl "Portable Makefiles should refer to any library directories using the 64 symbolic link."
+      dnl But we want to recognize the sparcv9 or amd64 subdirectory also if the
+      dnl symlink is missing, so we set acl_libdirstem2 too.
+      AC_CACHE_CHECK([for 64-bit host], [gl_cv_solaris_64bit],
+        [AC_EGREP_CPP([sixtyfour bits], [
+#ifdef _LP64
+sixtyfour bits
+#endif
+           ], [gl_cv_solaris_64bit=yes], [gl_cv_solaris_64bit=no])
+        ])
+      if test $gl_cv_solaris_64bit = yes; then
+        acl_libdirstem=lib/64
+        case "$host_cpu" in
+          sparc*)        acl_libdirstem2=lib/sparcv9 ;;
+          i*86 | x86_64) acl_libdirstem2=lib/amd64 ;;
+        esac
+      fi
+      ;;
+    *)
+      searchpath=`(LC_ALL=C $CC -print-search-dirs) 2>/dev/null | sed -n -e 's,^libraries: ,,p' | sed -e 's,^=,,'`
+      if test -n "$searchpath"; then
+        acl_save_IFS="${IFS= 	}"; IFS=":"
+        for searchdir in $searchpath; do
+          if test -d "$searchdir"; then
+            case "$searchdir" in
+              */lib64/ | */lib64 ) acl_libdirstem=lib64 ;;
+              */../ | */.. )
+                # Better ignore directories of this form. They are misleading.
+                ;;
+              *) searchdir=`cd "$searchdir" && pwd`
+                 case "$searchdir" in
+                   */lib64 ) acl_libdirstem=lib64 ;;
+                 esac ;;
+            esac
+          fi
+        done
+        IFS="$acl_save_IFS"
+      fi
+      ;;
+  esac
+  test -n "$acl_libdirstem2" || acl_libdirstem2="$acl_libdirstem"
+])
diff --git a/m4/libunistring.m4 b/m4/libunistring.m4
new file mode 100644
index 000000000..52ff06b61
--- /dev/null
+++ b/m4/libunistring.m4
@@ -0,0 +1,37 @@
+# libunistring.m4 serial 1
+dnl Copyright (C) 2009 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+dnl gl_LIBUNISTRING
+dnl Searches for an installed libunistring.
+dnl If found, it sets and AC_SUBSTs HAVE_LIBUNISTRING=yes and the LIBUNISTRING
+dnl and LTLIBUNISTRING variables and augments the CPPFLAGS variable, and
+dnl #defines HAVE_LIBUNISTRING to 1. Otherwise, it sets and AC_SUBSTs
+dnl HAVE_LIBUNISTRING=no and LIBUNINSTRING and LTLIBUNISTRING to empty.
+
+AC_DEFUN([gl_LIBUNISTRING],
+[
+  dnl First, try to link without -liconv. libunistring often depends on
+  dnl libiconv, but we don't know (and often don't need to know) where
+  dnl libiconv is installed.
+  AC_LIB_HAVE_LINKFLAGS([unistring], [],
+    [#include <uniconv.h>], [u8_strconv_from_locale((char*)0);],
+    [no, consider installing GNU libunistring])
+  if test "$ac_cv_libunistring" != yes; then
+    dnl Second try, with -liconv.
+    AC_REQUIRE([AM_ICONV])
+    if test -n "$LIBICONV"; then
+      glus_save_LIBS="$LIBS"
+      LIBS="$LIBS $LIBICONV"
+      AC_LIB_HAVE_LINKFLAGS([unistring], [],
+        [#include <uniconv.h>], [u8_strconv_from_locale((char*)0);],
+        [no, consider installing GNU libunistring])
+      if test -n "$LIBUNISTRING"; then
+        LIBUNISTRING="$LIBUNISTRING $LIBICONV"
+      fi
+      LIBS="$glus_save_LIBS"
+    fi
+  fi
+])
diff --git a/m4/localcharset.m4 b/m4/localcharset.m4
index b2b77338e..e9601041c 100644
--- a/m4/localcharset.m4
+++ b/m4/localcharset.m4
@@ -1,5 +1,5 @@
-# localcharset.m4 serial 5
-dnl Copyright (C) 2002, 2004, 2006 Free Software Foundation, Inc.
+# localcharset.m4 serial 6
+dnl Copyright (C) 2002, 2004, 2006, 2009 Free Software Foundation, Inc.
 dnl This file is free software; the Free Software Foundation
 dnl gives unlimited permission to copy and/or distribute it,
 dnl with or without modifications, as long as this notice is preserved.
@@ -8,7 +8,7 @@ AC_DEFUN([gl_LOCALCHARSET],
 [
   dnl Prerequisites of lib/localcharset.c.
   AC_REQUIRE([AM_LANGINFO_CODESET])
-  AC_CHECK_DECLS_ONCE(getc_unlocked)
+  AC_CHECK_DECLS_ONCE([getc_unlocked])
 
   dnl Prerequisites of the lib/Makefile.am snippet.
   AC_REQUIRE([AC_CANONICAL_HOST])
diff --git a/m4/locale-fr.m4 b/m4/locale-fr.m4
index ac8a78d2c..653a5bc2b 100644
--- a/m4/locale-fr.m4
+++ b/m4/locale-fr.m4
@@ -1,5 +1,5 @@
-# locale-fr.m4 serial 9
-dnl Copyright (C) 2003, 2005-2008 Free Software Foundation, Inc.
+# locale-fr.m4 serial 11
+dnl Copyright (C) 2003, 2005-2009 Free Software Foundation, Inc.
 dnl This file is free software; the Free Software Foundation
 dnl gives unlimited permission to copy and/or distribute it,
 dnl with or without modifications, as long as this notice is preserved.
@@ -11,26 +11,8 @@ AC_DEFUN([gt_LOCALE_FR],
 [
   AC_REQUIRE([AC_CANONICAL_HOST])
   AC_REQUIRE([AM_LANGINFO_CODESET])
-  AC_CACHE_CHECK([for a traditional french locale], gt_cv_locale_fr, [
-    macosx=
-changequote(,)dnl
-    case "$host_os" in
-      darwin[56]*) ;;
-      darwin*) macosx=yes;;
-    esac
-changequote([,])dnl
-    if test -n "$macosx"; then
-      # On Darwin 7 (MacOS X), the libc supports some locales in non-UTF-8
-      # encodings, but the kernel does not support them. The documentation
-      # says:
-      #   "... all code that calls BSD system routines should ensure
-      #    that the const *char parameters of these routines are in UTF-8
-      #    encoding. All BSD system functions expect their string
-      #    parameters to be in UTF-8 encoding and nothing else."
-      # See the comments in config.charset. Therefore we bypass the test.
-      gt_cv_locale_fr=none
-    else
-      AC_LANG_CONFTEST([AC_LANG_SOURCE([
+  AC_CACHE_CHECK([for a traditional french locale], [gt_cv_locale_fr], [
+    AC_LANG_CONFTEST([AC_LANG_SOURCE([
 changequote(,)dnl
 #include <locale.h>
 #include <time.h>
@@ -75,42 +57,41 @@ int main () {
   return 0;
 }
 changequote([,])dnl
-        ])])
-      if AC_TRY_EVAL([ac_link]) && test -s conftest$ac_exeext; then
-        # Setting LC_ALL is not enough. Need to set LC_TIME to empty, because
-        # otherwise on MacOS X 10.3.5 the LC_TIME=C from the beginning of the
-        # configure script would override the LC_ALL setting. Likewise for
-        # LC_CTYPE, which is also set at the beginning of the configure script.
-        # Test for the usual locale name.
-        if (LC_ALL=fr_FR LC_TIME= LC_CTYPE= ./conftest; exit) 2>/dev/null; then
-          gt_cv_locale_fr=fr_FR
+      ])])
+    if AC_TRY_EVAL([ac_link]) && test -s conftest$ac_exeext; then
+      # Setting LC_ALL is not enough. Need to set LC_TIME to empty, because
+      # otherwise on MacOS X 10.3.5 the LC_TIME=C from the beginning of the
+      # configure script would override the LC_ALL setting. Likewise for
+      # LC_CTYPE, which is also set at the beginning of the configure script.
+      # Test for the usual locale name.
+      if (LC_ALL=fr_FR LC_TIME= LC_CTYPE= ./conftest; exit) 2>/dev/null; then
+        gt_cv_locale_fr=fr_FR
+      else
+        # Test for the locale name with explicit encoding suffix.
+        if (LC_ALL=fr_FR.ISO-8859-1 LC_TIME= LC_CTYPE= ./conftest; exit) 2>/dev/null; then
+          gt_cv_locale_fr=fr_FR.ISO-8859-1
         else
-          # Test for the locale name with explicit encoding suffix.
-          if (LC_ALL=fr_FR.ISO-8859-1 LC_TIME= LC_CTYPE= ./conftest; exit) 2>/dev/null; then
-            gt_cv_locale_fr=fr_FR.ISO-8859-1
+          # Test for the AIX, OSF/1, FreeBSD, NetBSD, OpenBSD locale name.
+          if (LC_ALL=fr_FR.ISO8859-1 LC_TIME= LC_CTYPE= ./conftest; exit) 2>/dev/null; then
+            gt_cv_locale_fr=fr_FR.ISO8859-1
           else
-            # Test for the AIX, OSF/1, FreeBSD, NetBSD, OpenBSD locale name.
-            if (LC_ALL=fr_FR.ISO8859-1 LC_TIME= LC_CTYPE= ./conftest; exit) 2>/dev/null; then
-              gt_cv_locale_fr=fr_FR.ISO8859-1
+            # Test for the HP-UX locale name.
+            if (LC_ALL=fr_FR.iso88591 LC_TIME= LC_CTYPE= ./conftest; exit) 2>/dev/null; then
+              gt_cv_locale_fr=fr_FR.iso88591
             else
-              # Test for the HP-UX locale name.
-              if (LC_ALL=fr_FR.iso88591 LC_TIME= LC_CTYPE= ./conftest; exit) 2>/dev/null; then
-                gt_cv_locale_fr=fr_FR.iso88591
+              # Test for the Solaris 7 locale name.
+              if (LC_ALL=fr LC_TIME= LC_CTYPE= ./conftest; exit) 2>/dev/null; then
+                gt_cv_locale_fr=fr
               else
-                # Test for the Solaris 7 locale name.
-                if (LC_ALL=fr LC_TIME= LC_CTYPE= ./conftest; exit) 2>/dev/null; then
-                  gt_cv_locale_fr=fr
-                else
-                  # None found.
-                  gt_cv_locale_fr=none
-                fi
+                # None found.
+                gt_cv_locale_fr=none
               fi
             fi
           fi
         fi
       fi
-      rm -fr conftest*
     fi
+    rm -fr conftest*
   ])
   LOCALE_FR=$gt_cv_locale_fr
   AC_SUBST([LOCALE_FR])
@@ -120,7 +101,7 @@ dnl Determine the name of a french locale with UTF-8 encoding.
 AC_DEFUN([gt_LOCALE_FR_UTF8],
 [
   AC_REQUIRE([AM_LANGINFO_CODESET])
-  AC_CACHE_CHECK([for a french Unicode locale], gt_cv_locale_fr_utf8, [
+  AC_CACHE_CHECK([for a french Unicode locale], [gt_cv_locale_fr_utf8], [
     AC_LANG_CONFTEST([AC_LANG_SOURCE([
 changequote(,)dnl
 #include <locale.h>
diff --git a/m4/locale-ja.m4 b/m4/locale-ja.m4
index c42064f72..936057647 100644
--- a/m4/locale-ja.m4
+++ b/m4/locale-ja.m4
@@ -1,5 +1,5 @@
-# locale-ja.m4 serial 5
-dnl Copyright (C) 2003, 2005-2008 Free Software Foundation, Inc.
+# locale-ja.m4 serial 7
+dnl Copyright (C) 2003, 2005-2009 Free Software Foundation, Inc.
 dnl This file is free software; the Free Software Foundation
 dnl gives unlimited permission to copy and/or distribute it,
 dnl with or without modifications, as long as this notice is preserved.
@@ -11,26 +11,8 @@ AC_DEFUN([gt_LOCALE_JA],
 [
   AC_REQUIRE([AC_CANONICAL_HOST])
   AC_REQUIRE([AM_LANGINFO_CODESET])
-  AC_CACHE_CHECK([for a traditional japanese locale], gt_cv_locale_ja, [
-    macosx=
-changequote(,)dnl
-    case "$host_os" in
-      darwin[56]*) ;;
-      darwin*) macosx=yes;;
-    esac
-changequote([,])dnl
-    if test -n "$macosx"; then
-      # On Darwin 7 (MacOS X), the libc supports some locales in non-UTF-8
-      # encodings, but the kernel does not support them. The documentation
-      # says:
-      #   "... all code that calls BSD system routines should ensure
-      #    that the const *char parameters of these routines are in UTF-8
-      #    encoding. All BSD system functions expect their string
-      #    parameters to be in UTF-8 encoding and nothing else."
-      # See the comments in config.charset. Therefore we bypass the test.
-      gt_cv_locale_ja=none
-    else
-      AC_LANG_CONFTEST([AC_LANG_SOURCE([
+  AC_CACHE_CHECK([for a traditional japanese locale], [gt_cv_locale_ja], [
+    AC_LANG_CONFTEST([AC_LANG_SOURCE([
 changequote(,)dnl
 #include <locale.h>
 #include <time.h>
@@ -79,47 +61,46 @@ int main ()
   return 0;
 }
 changequote([,])dnl
-        ])])
-      if AC_TRY_EVAL([ac_link]) && test -s conftest$ac_exeext; then
-        # Setting LC_ALL is not enough. Need to set LC_TIME to empty, because
-        # otherwise on MacOS X 10.3.5 the LC_TIME=C from the beginning of the
-        # configure script would override the LC_ALL setting. Likewise for
-        # LC_CTYPE, which is also set at the beginning of the configure script.
-        # Test for the AIX locale name.
-        if (LC_ALL=ja_JP LC_TIME= LC_CTYPE= ./conftest; exit) 2>/dev/null; then
-          gt_cv_locale_ja=ja_JP
+      ])])
+    if AC_TRY_EVAL([ac_link]) && test -s conftest$ac_exeext; then
+      # Setting LC_ALL is not enough. Need to set LC_TIME to empty, because
+      # otherwise on MacOS X 10.3.5 the LC_TIME=C from the beginning of the
+      # configure script would override the LC_ALL setting. Likewise for
+      # LC_CTYPE, which is also set at the beginning of the configure script.
+      # Test for the AIX locale name.
+      if (LC_ALL=ja_JP LC_TIME= LC_CTYPE= ./conftest; exit) 2>/dev/null; then
+        gt_cv_locale_ja=ja_JP
+      else
+        # Test for the locale name with explicit encoding suffix.
+        if (LC_ALL=ja_JP.EUC-JP LC_TIME= LC_CTYPE= ./conftest; exit) 2>/dev/null; then
+          gt_cv_locale_ja=ja_JP.EUC-JP
         else
-          # Test for the locale name with explicit encoding suffix.
-          if (LC_ALL=ja_JP.EUC-JP LC_TIME= LC_CTYPE= ./conftest; exit) 2>/dev/null; then
-            gt_cv_locale_ja=ja_JP.EUC-JP
+          # Test for the HP-UX, OSF/1, NetBSD locale name.
+          if (LC_ALL=ja_JP.eucJP LC_TIME= LC_CTYPE= ./conftest; exit) 2>/dev/null; then
+            gt_cv_locale_ja=ja_JP.eucJP
           else
-            # Test for the HP-UX, OSF/1, NetBSD locale name.
-            if (LC_ALL=ja_JP.eucJP LC_TIME= LC_CTYPE= ./conftest; exit) 2>/dev/null; then
-              gt_cv_locale_ja=ja_JP.eucJP
+            # Test for the IRIX, FreeBSD locale name.
+            if (LC_ALL=ja_JP.EUC LC_TIME= LC_CTYPE= ./conftest; exit) 2>/dev/null; then
+              gt_cv_locale_ja=ja_JP.EUC
             else
-              # Test for the IRIX, FreeBSD locale name.
-              if (LC_ALL=ja_JP.EUC LC_TIME= LC_CTYPE= ./conftest; exit) 2>/dev/null; then
-                gt_cv_locale_ja=ja_JP.EUC
+              # Test for the Solaris 7 locale name.
+              if (LC_ALL=ja LC_TIME= LC_CTYPE= ./conftest; exit) 2>/dev/null; then
+                gt_cv_locale_ja=ja
               else
-                # Test for the Solaris 7 locale name.
-                if (LC_ALL=ja LC_TIME= LC_CTYPE= ./conftest; exit) 2>/dev/null; then
-                  gt_cv_locale_ja=ja
+                # Special test for NetBSD 1.6.
+                if test -f /usr/share/locale/ja_JP.eucJP/LC_CTYPE; then
+                  gt_cv_locale_ja=ja_JP.eucJP
                 else
-                  # Special test for NetBSD 1.6.
-                  if test -f /usr/share/locale/ja_JP.eucJP/LC_CTYPE; then
-                    gt_cv_locale_ja=ja_JP.eucJP
-                  else
-                    # None found.
-                    gt_cv_locale_ja=none
-                  fi
+                  # None found.
+                  gt_cv_locale_ja=none
                 fi
               fi
             fi
           fi
         fi
       fi
-      rm -fr conftest*
     fi
+    rm -fr conftest*
   ])
   LOCALE_JA=$gt_cv_locale_ja
   AC_SUBST([LOCALE_JA])
diff --git a/m4/locale-zh.m4 b/m4/locale-zh.m4
index 594f62a69..36a5f1dfb 100644
--- a/m4/locale-zh.m4
+++ b/m4/locale-zh.m4
@@ -1,5 +1,5 @@
-# locale-zh.m4 serial 4
-dnl Copyright (C) 2003, 2005-2008 Free Software Foundation, Inc.
+# locale-zh.m4 serial 6
+dnl Copyright (C) 2003, 2005-2009 Free Software Foundation, Inc.
 dnl This file is free software; the Free Software Foundation
 dnl gives unlimited permission to copy and/or distribute it,
 dnl with or without modifications, as long as this notice is preserved.
@@ -11,26 +11,8 @@ AC_DEFUN([gt_LOCALE_ZH_CN],
 [
   AC_REQUIRE([AC_CANONICAL_HOST])
   AC_REQUIRE([AM_LANGINFO_CODESET])
-  AC_CACHE_CHECK([for a transitional chinese locale], gt_cv_locale_zh_CN, [
-    macosx=
-changequote(,)dnl
-    case "$host_os" in
-      darwin[56]*) ;;
-      darwin*) macosx=yes;;
-    esac
-changequote([,])dnl
-    if test -n "$macosx"; then
-      # On Darwin 7 (MacOS X), the libc supports some locales in non-UTF-8
-      # encodings, but the kernel does not support them. The documentation
-      # says:
-      #   "... all code that calls BSD system routines should ensure
-      #    that the const *char parameters of these routines are in UTF-8
-      #    encoding. All BSD system functions expect their string
-      #    parameters to be in UTF-8 encoding and nothing else."
-      # See the comments in config.charset. Therefore we bypass the test.
-      gt_cv_locale_zh_CN=none
-    else
-      AC_LANG_CONFTEST([AC_LANG_SOURCE([
+  AC_CACHE_CHECK([for a transitional chinese locale], [gt_cv_locale_zh_CN], [
+    AC_LANG_CONFTEST([AC_LANG_SOURCE([
 changequote(,)dnl
 #include <locale.h>
 #include <stdlib.h>
@@ -80,31 +62,30 @@ int main ()
   return 0;
 }
 changequote([,])dnl
-        ])])
-      if AC_TRY_EVAL([ac_link]) && test -s conftest$ac_exeext; then
-        # Setting LC_ALL is not enough. Need to set LC_TIME to empty, because
-        # otherwise on MacOS X 10.3.5 the LC_TIME=C from the beginning of the
-        # configure script would override the LC_ALL setting. Likewise for
-        # LC_CTYPE, which is also set at the beginning of the configure script.
-        # Test for the locale name without encoding suffix.
-        if (LC_ALL=zh_CN LC_TIME= LC_CTYPE= ./conftest; exit) 2>/dev/null; then
-          gt_cv_locale_zh_CN=zh_CN
+      ])])
+    if AC_TRY_EVAL([ac_link]) && test -s conftest$ac_exeext; then
+      # Setting LC_ALL is not enough. Need to set LC_TIME to empty, because
+      # otherwise on MacOS X 10.3.5 the LC_TIME=C from the beginning of the
+      # configure script would override the LC_ALL setting. Likewise for
+      # LC_CTYPE, which is also set at the beginning of the configure script.
+      # Test for the locale name without encoding suffix.
+      if (LC_ALL=zh_CN LC_TIME= LC_CTYPE= ./conftest; exit) 2>/dev/null; then
+        gt_cv_locale_zh_CN=zh_CN
+      else
+        # Test for the locale name with explicit encoding suffix.
+        if (LC_ALL=zh_CN.GB18030 LC_TIME= LC_CTYPE= ./conftest; exit) 2>/dev/null; then
+          gt_cv_locale_zh_CN=zh_CN.GB18030
         else
-          # Test for the locale name with explicit encoding suffix.
-          if (LC_ALL=zh_CN.GB18030 LC_TIME= LC_CTYPE= ./conftest; exit) 2>/dev/null; then
-            gt_cv_locale_zh_CN=zh_CN.GB18030
-          else
-            # None found.
-            gt_cv_locale_zh_CN=none
-          fi
+          # None found.
+          gt_cv_locale_zh_CN=none
         fi
-      else
-        # If there was a link error, due to mblen(), the system is so old that
-        # it certainly doesn't have a chinese locale.
-        gt_cv_locale_zh_CN=none
       fi
-      rm -fr conftest*
+    else
+      # If there was a link error, due to mblen(), the system is so old that
+      # it certainly doesn't have a chinese locale.
+      gt_cv_locale_zh_CN=none
     fi
+    rm -fr conftest*
   ])
   LOCALE_ZH_CN=$gt_cv_locale_zh_CN
   AC_SUBST([LOCALE_ZH_CN])
diff --git a/m4/longlong.m4 b/m4/longlong.m4
new file mode 100644
index 000000000..eedc8d568
--- /dev/null
+++ b/m4/longlong.m4
@@ -0,0 +1,106 @@
+# longlong.m4 serial 14
+dnl Copyright (C) 1999-2007, 2009 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+dnl From Paul Eggert.
+
+# Define HAVE_LONG_LONG_INT if 'long long int' works.
+# This fixes a bug in Autoconf 2.61, but can be removed once we
+# assume 2.62 everywhere.
+
+# Note: If the type 'long long int' exists but is only 32 bits large
+# (as on some very old compilers), HAVE_LONG_LONG_INT will not be
+# defined. In this case you can treat 'long long int' like 'long int'.
+
+AC_DEFUN([AC_TYPE_LONG_LONG_INT],
+[
+  AC_CACHE_CHECK([for long long int], [ac_cv_type_long_long_int],
+    [AC_LINK_IFELSE(
+       [_AC_TYPE_LONG_LONG_SNIPPET],
+       [dnl This catches a bug in Tandem NonStop Kernel (OSS) cc -O circa 2004.
+	dnl If cross compiling, assume the bug isn't important, since
+	dnl nobody cross compiles for this platform as far as we know.
+	AC_RUN_IFELSE(
+	  [AC_LANG_PROGRAM(
+	     [[@%:@include <limits.h>
+	       @%:@ifndef LLONG_MAX
+	       @%:@ define HALF \
+			(1LL << (sizeof (long long int) * CHAR_BIT - 2))
+	       @%:@ define LLONG_MAX (HALF - 1 + HALF)
+	       @%:@endif]],
+	     [[long long int n = 1;
+	       int i;
+	       for (i = 0; ; i++)
+		 {
+		   long long int m = n << i;
+		   if (m >> i != n)
+		     return 1;
+		   if (LLONG_MAX / 2 < m)
+		     break;
+		 }
+	       return 0;]])],
+	  [ac_cv_type_long_long_int=yes],
+	  [ac_cv_type_long_long_int=no],
+	  [ac_cv_type_long_long_int=yes])],
+       [ac_cv_type_long_long_int=no])])
+  if test $ac_cv_type_long_long_int = yes; then
+    AC_DEFINE([HAVE_LONG_LONG_INT], [1],
+      [Define to 1 if the system has the type `long long int'.])
+  fi
+])
+
+# Define HAVE_UNSIGNED_LONG_LONG_INT if 'unsigned long long int' works.
+# This fixes a bug in Autoconf 2.61, but can be removed once we
+# assume 2.62 everywhere.
+
+# Note: If the type 'unsigned long long int' exists but is only 32 bits
+# large (as on some very old compilers), AC_TYPE_UNSIGNED_LONG_LONG_INT
+# will not be defined. In this case you can treat 'unsigned long long int'
+# like 'unsigned long int'.
+
+AC_DEFUN([AC_TYPE_UNSIGNED_LONG_LONG_INT],
+[
+  AC_CACHE_CHECK([for unsigned long long int],
+    [ac_cv_type_unsigned_long_long_int],
+    [AC_LINK_IFELSE(
+       [_AC_TYPE_LONG_LONG_SNIPPET],
+       [ac_cv_type_unsigned_long_long_int=yes],
+       [ac_cv_type_unsigned_long_long_int=no])])
+  if test $ac_cv_type_unsigned_long_long_int = yes; then
+    AC_DEFINE([HAVE_UNSIGNED_LONG_LONG_INT], [1],
+      [Define to 1 if the system has the type `unsigned long long int'.])
+  fi
+])
+
+# Expands to a C program that can be used to test for simultaneous support
+# of 'long long' and 'unsigned long long'. We don't want to say that
+# 'long long' is available if 'unsigned long long' is not, or vice versa,
+# because too many programs rely on the symmetry between signed and unsigned
+# integer types (excluding 'bool').
+AC_DEFUN([_AC_TYPE_LONG_LONG_SNIPPET],
+[
+  AC_LANG_PROGRAM(
+    [[/* For now, do not test the preprocessor; as of 2007 there are too many
+	 implementations with broken preprocessors.  Perhaps this can
+	 be revisited in 2012.  In the meantime, code should not expect
+	 #if to work with literals wider than 32 bits.  */
+      /* Test literals.  */
+      long long int ll = 9223372036854775807ll;
+      long long int nll = -9223372036854775807LL;
+      unsigned long long int ull = 18446744073709551615ULL;
+      /* Test constant expressions.   */
+      typedef int a[((-9223372036854775807LL < 0 && 0 < 9223372036854775807ll)
+		     ? 1 : -1)];
+      typedef int b[(18446744073709551615ULL <= (unsigned long long int) -1
+		     ? 1 : -1)];
+      int i = 63;]],
+    [[/* Test availability of runtime routines for shift and division.  */
+      long long int llmax = 9223372036854775807ll;
+      unsigned long long int ullmax = 18446744073709551615ull;
+      return ((ll << 63) | (ll >> 63) | (ll < i) | (ll > i)
+	      | (llmax / ll) | (llmax % ll)
+	      | (ull << 63) | (ull >> 63) | (ull << i) | (ull >> i)
+	      | (ullmax / ull) | (ullmax % ull));]])
+])
diff --git a/m4/malloc.m4 b/m4/malloc.m4
new file mode 100644
index 000000000..807017166
--- /dev/null
+++ b/m4/malloc.m4
@@ -0,0 +1,41 @@
+# malloc.m4 serial 9
+dnl Copyright (C) 2007, 2009 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+# gl_FUNC_MALLOC_POSIX
+# --------------------
+# Test whether 'malloc' is POSIX compliant (sets errno to ENOMEM when it
+# fails), and replace malloc if it is not.
+AC_DEFUN([gl_FUNC_MALLOC_POSIX],
+[
+  AC_REQUIRE([gl_CHECK_MALLOC_POSIX])
+  if test $gl_cv_func_malloc_posix = yes; then
+    HAVE_MALLOC_POSIX=1
+    AC_DEFINE([HAVE_MALLOC_POSIX], [1],
+      [Define if the 'malloc' function is POSIX compliant.])
+  else
+    AC_LIBOBJ([malloc])
+    HAVE_MALLOC_POSIX=0
+  fi
+  AC_SUBST([HAVE_MALLOC_POSIX])
+])
+
+# Test whether malloc, realloc, calloc are POSIX compliant,
+# Set gl_cv_func_malloc_posix to yes or no accordingly.
+AC_DEFUN([gl_CHECK_MALLOC_POSIX],
+[
+  AC_CACHE_CHECK([whether malloc, realloc, calloc are POSIX compliant],
+    [gl_cv_func_malloc_posix],
+    [
+      dnl It is too dangerous to try to allocate a large amount of memory:
+      dnl some systems go to their knees when you do that. So assume that
+      dnl all Unix implementations of the function are POSIX compliant.
+      AC_TRY_COMPILE([],
+        [#if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
+         choke me
+         #endif
+        ], [gl_cv_func_malloc_posix=yes], [gl_cv_func_malloc_posix=no])
+    ])
+])
diff --git a/m4/malloca.m4 b/m4/malloca.m4
new file mode 100644
index 000000000..2841ae83a
--- /dev/null
+++ b/m4/malloca.m4
@@ -0,0 +1,14 @@
+# malloca.m4 serial 1
+dnl Copyright (C) 2003-2004, 2006-2007 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN([gl_MALLOCA],
+[
+  dnl Use the autoconf tests for alloca(), but not the AC_SUBSTed variables
+  dnl @ALLOCA@ and @LTALLOCA@.
+  dnl gl_FUNC_ALLOCA   dnl Already brought in by the module dependencies.
+  AC_REQUIRE([gl_EEMALLOC])
+  AC_REQUIRE([AC_TYPE_LONG_LONG_INT])
+])
diff --git a/m4/mbrtowc.m4 b/m4/mbrtowc.m4
index da0d426f0..2fddcc8a1 100644
--- a/m4/mbrtowc.m4
+++ b/m4/mbrtowc.m4
@@ -1,5 +1,5 @@
-# mbrtowc.m4 serial 12
-dnl Copyright (C) 2001-2002, 2004-2005, 2008 Free Software Foundation, Inc.
+# mbrtowc.m4 serial 16
+dnl Copyright (C) 2001-2002, 2004-2005, 2008, 2009 Free Software Foundation, Inc.
 dnl This file is free software; the Free Software Foundation
 dnl gives unlimited permission to copy and/or distribute it,
 dnl with or without modifications, as long as this notice is preserved.
@@ -65,9 +65,15 @@ AC_DEFUN([gl_MBSTATE_T_BROKEN],
   AC_CHECK_FUNCS_ONCE([mbrtowc])
   if test $ac_cv_func_mbsinit = yes && test $ac_cv_func_mbrtowc = yes; then
     gl_MBRTOWC_INCOMPLETE_STATE
+    gl_MBRTOWC_SANITYCHECK
+    REPLACE_MBSTATE_T=0
     case "$gl_cv_func_mbrtowc_incomplete_state" in
-      *yes) REPLACE_MBSTATE_T=0 ;;
-      *)    REPLACE_MBSTATE_T=1 ;;
+      *yes) ;;
+      *) REPLACE_MBSTATE_T=1 ;;
+    esac
+    case "$gl_cv_func_mbrtowc_sanitycheck" in
+      *yes) ;;
+      *) REPLACE_MBSTATE_T=1 ;;
     esac
   else
     REPLACE_MBSTATE_T=1
@@ -121,7 +127,59 @@ int main ()
 }],
           [gl_cv_func_mbrtowc_incomplete_state=yes],
           [gl_cv_func_mbrtowc_incomplete_state=no],
-          [])
+          [:])
+      fi
+    ])
+])
+
+dnl Test whether mbrtowc works not worse than mbtowc.
+dnl Result is gl_cv_func_mbrtowc_sanitycheck.
+
+AC_DEFUN([gl_MBRTOWC_SANITYCHECK],
+[
+  AC_REQUIRE([AC_PROG_CC])
+  AC_REQUIRE([gt_LOCALE_ZH_CN])
+  AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+  AC_CACHE_CHECK([whether mbrtowc works as well as mbtowc],
+    [gl_cv_func_mbrtowc_sanitycheck],
+    [
+      dnl Initial guess, used when cross-compiling or when no suitable locale
+      dnl is present.
+changequote(,)dnl
+      case "$host_os" in
+                    # Guess no on Solaris 8.
+        solaris2.8) gl_cv_func_mbrtowc_sanitycheck="guessing no" ;;
+                    # Guess yes otherwise.
+        *)          gl_cv_func_mbrtowc_sanitycheck="guessing yes" ;;
+      esac
+changequote([,])dnl
+      if test $LOCALE_ZH_CN != none; then
+        AC_TRY_RUN([
+#include <locale.h>
+#include <stdlib.h>
+#include <string.h>
+#include <wchar.h>
+int main ()
+{
+  /* This fails on Solaris 8:
+     mbrtowc returns 2, and sets wc to 0x00F0.
+     mbtowc returns 4 (correct) and sets wc to 0x5EDC.  */
+  if (setlocale (LC_ALL, "$LOCALE_ZH_CN") != NULL)
+    {
+      char input[] = "B\250\271\201\060\211\070er"; /* "Büßer" */
+      mbstate_t state;
+      wchar_t wc;
+
+      memset (&state, '\0', sizeof (mbstate_t));
+      if (mbrtowc (&wc, input + 3, 6, &state) != 4
+          && mbtowc (&wc, input + 3, 6) == 4)
+        return 1;
+    }
+  return 0;
+}],
+          [gl_cv_func_mbrtowc_sanitycheck=yes],
+          [gl_cv_func_mbrtowc_sanitycheck=no],
+          [:])
       fi
     ])
 ])
@@ -168,7 +226,7 @@ int main ()
         return 1;
     }
   return 0;
-}], [gl_cv_func_mbrtowc_null_arg=yes], [gl_cv_func_mbrtowc_null_arg=no], [])
+}], [gl_cv_func_mbrtowc_null_arg=yes], [gl_cv_func_mbrtowc_null_arg=no], [:])
       fi
     ])
 ])
@@ -238,7 +296,7 @@ int main ()
 }],
           [gl_cv_func_mbrtowc_retval=yes],
           [gl_cv_func_mbrtowc_retval=no],
-          [])
+          [:])
       fi
     ])
 ])
@@ -258,10 +316,10 @@ AC_DEFUN([gl_MBRTOWC_NUL_RETVAL],
       dnl is present.
 changequote(,)dnl
       case "$host_os" in
-                    # Guess no on Solaris 9.
-        solaris2.9) gl_cv_func_mbrtowc_nul_retval="guessing no" ;;
-                    # Guess yes otherwise.
-        *)          gl_cv_func_mbrtowc_nul_retval="guessing yes" ;;
+                       # Guess no on Solaris 8 and 9.
+        solaris2.[89]) gl_cv_func_mbrtowc_nul_retval="guessing no" ;;
+                       # Guess yes otherwise.
+        *)             gl_cv_func_mbrtowc_nul_retval="guessing yes" ;;
       esac
 changequote([,])dnl
       if test $LOCALE_ZH_CN != none; then
@@ -271,7 +329,7 @@ changequote([,])dnl
 #include <wchar.h>
 int main ()
 {
-  /* This fails on Solaris 9.  */
+  /* This fails on Solaris 8 and 9.  */
   if (setlocale (LC_ALL, "$LOCALE_ZH_CN") != NULL)
     {
       mbstate_t state;
@@ -285,7 +343,7 @@ int main ()
 }],
           [gl_cv_func_mbrtowc_nul_retval=yes],
           [gl_cv_func_mbrtowc_nul_retval=no],
-          [])
+          [:])
       fi
     ])
 ])
@@ -318,7 +376,7 @@ AC_DEFUN([AC_FUNC_MBRTOWC],
        gl_cv_func_mbrtowc=yes,
        gl_cv_func_mbrtowc=no)])
   if test $gl_cv_func_mbrtowc = yes; then
-    AC_DEFINE([HAVE_MBRTOWC], 1,
+    AC_DEFINE([HAVE_MBRTOWC], [1],
       [Define to 1 if mbrtowc and mbstate_t are properly declared.])
   fi
 ])
diff --git a/m4/mbstate_t.m4 b/m4/mbstate_t.m4
index d2153d9bc..d4ec6f0fc 100644
--- a/m4/mbstate_t.m4
+++ b/m4/mbstate_t.m4
@@ -1,5 +1,5 @@
-# mbstate_t.m4 serial 11
-dnl Copyright (C) 2000-2002, 2008 Free Software Foundation, Inc.
+# mbstate_t.m4 serial 12
+dnl Copyright (C) 2000-2002, 2008, 2009 Free Software Foundation, Inc.
 dnl This file is free software; the Free Software Foundation
 dnl gives unlimited permission to copy and/or distribute it,
 dnl with or without modifications, as long as this notice is preserved.
@@ -16,7 +16,7 @@ AC_DEFUN([AC_TYPE_MBSTATE_T],
 [
    AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS]) dnl for HP-UX 11.11
 
-   AC_CACHE_CHECK([for mbstate_t], ac_cv_type_mbstate_t,
+   AC_CACHE_CHECK([for mbstate_t], [ac_cv_type_mbstate_t],
      [AC_COMPILE_IFELSE(
 	[AC_LANG_PROGRAM(
 	   [AC_INCLUDES_DEFAULT[
@@ -25,10 +25,10 @@ AC_DEFUN([AC_TYPE_MBSTATE_T],
 	[ac_cv_type_mbstate_t=yes],
 	[ac_cv_type_mbstate_t=no])])
    if test $ac_cv_type_mbstate_t = yes; then
-     AC_DEFINE([HAVE_MBSTATE_T], 1,
+     AC_DEFINE([HAVE_MBSTATE_T], [1],
 	       [Define to 1 if <wchar.h> declares mbstate_t.])
    else
-     AC_DEFINE([mbstate_t], int,
+     AC_DEFINE([mbstate_t], [int],
 	       [Define to a type if <wchar.h> does not define.])
    fi
 ])
diff --git a/m4/memchr.m4 b/m4/memchr.m4
new file mode 100644
index 000000000..1194bac2e
--- /dev/null
+++ b/m4/memchr.m4
@@ -0,0 +1,86 @@
+# memchr.m4 serial 7
+dnl Copyright (C) 2002, 2003, 2004, 2009 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN_ONCE([gl_FUNC_MEMCHR],
+[
+  dnl Check for prerequisites for memory fence checks.
+  gl_FUNC_MMAP_ANON
+  AC_CHECK_HEADERS_ONCE([sys/mman.h])
+  AC_CHECK_FUNCS_ONCE([mprotect])
+
+  dnl These days, we assume memchr is present.  But just in case...
+  AC_REQUIRE([gl_HEADER_STRING_H_DEFAULTS])
+  AC_REPLACE_FUNCS([memchr])
+  if test $ac_cv_func_memchr = no; then
+    gl_PREREQ_MEMCHR
+    REPLACE_MEMCHR=1
+  fi
+
+  if test $ac_cv_func_memchr = yes; then
+    # Detect platform-specific bugs in some versions of glibc:
+    # memchr should not dereference anything with length 0
+    #   http://bugzilla.redhat.com/499689
+    # memchr should not dereference overestimated length after a match
+    #   http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=521737
+    #   http://sourceware.org/bugzilla/show_bug.cgi?id=10162
+    # Assume that memchr works on platforms that lack mprotect.
+    AC_CACHE_CHECK([whether memchr works], [gl_cv_func_memchr_works],
+      [AC_RUN_IFELSE([AC_LANG_PROGRAM([[
+#include <string.h>
+#if HAVE_SYS_MMAN_H
+# include <fcntl.h>
+# include <unistd.h>
+# include <sys/types.h>
+# include <sys/mman.h>
+# ifndef MAP_FILE
+#  define MAP_FILE 0
+# endif
+#endif
+]], [[
+  char *fence = NULL;
+#if HAVE_SYS_MMAN_H && HAVE_MPROTECT
+# if HAVE_MAP_ANONYMOUS
+  const int flags = MAP_ANONYMOUS | MAP_PRIVATE;
+  const int fd = -1;
+# else /* !HAVE_MAP_ANONYMOUS */
+  const int flags = MAP_FILE | MAP_PRIVATE;
+  int fd = open ("/dev/zero", O_RDONLY, 0666);
+  if (fd >= 0)
+# endif
+    {
+      int pagesize = getpagesize ();
+      char *two_pages =
+	(char *) mmap (NULL, 2 * pagesize, PROT_READ | PROT_WRITE,
+		       flags, fd, 0);
+      if (two_pages != (char *)(-1)
+	  && mprotect (two_pages + pagesize, pagesize, PROT_NONE) == 0)
+	fence = two_pages + pagesize;
+    }
+#endif
+  if (fence)
+    {
+      if (memchr (fence, 0, 0))
+        return 1;
+      strcpy (fence - 9, "12345678");
+      if (memchr (fence - 9, 0, 79) != fence - 1)
+        return 2;
+    }
+  return 0;
+]])], [gl_cv_func_memchr_works=yes], [gl_cv_func_memchr_works=no],
+      [dnl Be pessimistic for now.
+       gl_cv_func_memchr_works="guessing no"])])
+    if test "$gl_cv_func_memchr_works" != yes; then
+      gl_PREREQ_MEMCHR
+      REPLACE_MEMCHR=1
+      AC_LIBOBJ([memchr])
+    fi
+  fi
+])
+
+# Prerequisites of lib/memchr.c.
+AC_DEFUN([gl_PREREQ_MEMCHR], [
+  AC_CHECK_HEADERS([bp-sym.h])
+])
diff --git a/m4/mmap-anon.m4 b/m4/mmap-anon.m4
new file mode 100644
index 000000000..14b6270d2
--- /dev/null
+++ b/m4/mmap-anon.m4
@@ -0,0 +1,59 @@
+# mmap-anon.m4 serial 8
+dnl Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+# Detect how mmap can be used to create anonymous (not file-backed) memory
+# mappings.
+# - On Linux, AIX, OSF/1, Solaris, Cygwin, Interix, Haiku, both MAP_ANONYMOUS
+#   and MAP_ANON exist and have the same value.
+# - On HP-UX, only MAP_ANONYMOUS exists.
+# - On MacOS X, FreeBSD, NetBSD, OpenBSD, only MAP_ANON exists.
+# - On IRIX, neither exists, and a file descriptor opened to /dev/zero must be
+#   used.
+
+AC_DEFUN([gl_FUNC_MMAP_ANON],
+[
+  dnl Work around a bug of AC_EGREP_CPP in autoconf-2.57.
+  AC_REQUIRE([AC_PROG_CPP])
+  AC_REQUIRE([AC_PROG_EGREP])
+
+  dnl Persuade glibc <sys/mman.h> to define MAP_ANONYMOUS.
+  AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
+
+  # Check for mmap(). Don't use AC_FUNC_MMAP, because it checks too much: it
+  # fails on HP-UX 11, because MAP_FIXED mappings do not work. But this is
+  # irrelevant for anonymous mappings.
+  AC_CHECK_FUNC([mmap], [gl_have_mmap=yes], [gl_have_mmap=no])
+
+  # Try to allow MAP_ANONYMOUS.
+  gl_have_mmap_anonymous=no
+  if test $gl_have_mmap = yes; then
+    AC_MSG_CHECKING([for MAP_ANONYMOUS])
+    AC_EGREP_CPP([I cant identify this map.], [
+#include <sys/mman.h>
+#ifdef MAP_ANONYMOUS
+    I cant identify this map.
+#endif
+],
+      [gl_have_mmap_anonymous=yes])
+    if test $gl_have_mmap_anonymous != yes; then
+      AC_EGREP_CPP([I cant identify this map.], [
+#include <sys/mman.h>
+#ifdef MAP_ANON
+    I cant identify this map.
+#endif
+],
+        [AC_DEFINE([MAP_ANONYMOUS], [MAP_ANON],
+          [Define to a substitute value for mmap()'s MAP_ANONYMOUS flag.])
+         gl_have_mmap_anonymous=yes])
+    fi
+    AC_MSG_RESULT([$gl_have_mmap_anonymous])
+    if test $gl_have_mmap_anonymous = yes; then
+      AC_DEFINE([HAVE_MAP_ANONYMOUS], [1],
+        [Define to 1 if mmap()'s MAP_ANONYMOUS flag is available after including
+         config.h and <sys/mman.h>.])
+    fi
+  fi
+])
diff --git a/m4/multiarch.m4 b/m4/multiarch.m4
new file mode 100644
index 000000000..ec377bac8
--- /dev/null
+++ b/m4/multiarch.m4
@@ -0,0 +1,65 @@
+# multiarch.m4 serial 5
+dnl Copyright (C) 2008, 2009 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+# Determine whether the compiler is or may be producing universal binaries.
+#
+# On MacOS X 10.5 and later systems, the user can create libraries and
+# executables that work on multiple system types--known as "fat" or
+# "universal" binaries--by specifying multiple '-arch' options to the
+# compiler but only a single '-arch' option to the preprocessor.  Like
+# this:
+#
+#     ./configure CC="gcc -arch i386 -arch x86_64 -arch ppc -arch ppc64" \
+#                 CXX="g++ -arch i386 -arch x86_64 -arch ppc -arch ppc64" \
+#                 CPP="gcc -E" CXXCPP="g++ -E"
+#
+# Detect this situation and set the macro AA_APPLE_UNIVERSAL_BUILD at the
+# beginning of config.h and set APPLE_UNIVERSAL_BUILD accordingly.
+
+AC_DEFUN_ONCE([gl_MULTIARCH],
+[
+  dnl Code similar to autoconf-2.63 AC_C_BIGENDIAN.
+  gl_cv_c_multiarch=no
+  AC_COMPILE_IFELSE(
+    [AC_LANG_SOURCE(
+      [[#ifndef __APPLE_CC__
+         not a universal capable compiler
+        #endif
+        typedef int dummy;
+      ]])],
+    [
+     dnl Check for potential -arch flags.  It is not universal unless
+     dnl there are at least two -arch flags with different values.
+     arch=
+     prev=
+     for word in ${CC} ${CFLAGS} ${CPPFLAGS} ${LDFLAGS}; do
+       if test -n "$prev"; then
+         case $word in
+           i?86 | x86_64 | ppc | ppc64)
+             if test -z "$arch" || test "$arch" = "$word"; then
+               arch="$word"
+             else
+               gl_cv_c_multiarch=yes
+             fi
+             ;;
+         esac
+         prev=
+       else
+         if test "x$word" = "x-arch"; then
+           prev=arch
+         fi
+       fi
+     done
+    ])
+  if test $gl_cv_c_multiarch = yes; then
+    AC_DEFINE([AA_APPLE_UNIVERSAL_BUILD], [1],
+      [Define if the compiler is building for multiple architectures of Apple platforms at once.])
+    APPLE_UNIVERSAL_BUILD=1
+  else
+    APPLE_UNIVERSAL_BUILD=0
+  fi
+  AC_SUBST([APPLE_UNIVERSAL_BUILD])
+])
diff --git a/m4/pathmax.m4 b/m4/pathmax.m4
new file mode 100644
index 000000000..465180161
--- /dev/null
+++ b/m4/pathmax.m4
@@ -0,0 +1,12 @@
+# pathmax.m4 serial 8
+dnl Copyright (C) 2002, 2003, 2005, 2006, 2009 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN([gl_PATHMAX],
+[
+  dnl Prerequisites of lib/pathmax.h.
+  AC_CHECK_FUNCS_ONCE([pathconf])
+  AC_CHECK_HEADERS_ONCE([sys/param.h])
+])
diff --git a/m4/printf.m4 b/m4/printf.m4
new file mode 100644
index 000000000..87aa45c5e
--- /dev/null
+++ b/m4/printf.m4
@@ -0,0 +1,1416 @@
+# printf.m4 serial 33
+dnl Copyright (C) 2003, 2007-2009 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+dnl Test whether the *printf family of functions supports the 'j', 'z', 't',
+dnl 'L' size specifiers. (ISO C99, POSIX:2001)
+dnl Result is gl_cv_func_printf_sizes_c99.
+
+AC_DEFUN([gl_PRINTF_SIZES_C99],
+[
+  AC_REQUIRE([AC_PROG_CC])
+  AC_REQUIRE([gl_AC_HEADER_STDINT_H])
+  AC_REQUIRE([gl_AC_HEADER_INTTYPES_H])
+  AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+  AC_CACHE_CHECK([whether printf supports size specifiers as in C99],
+    [gl_cv_func_printf_sizes_c99],
+    [
+      AC_TRY_RUN([
+#include <stddef.h>
+#include <stdio.h>
+#include <string.h>
+#include <sys/types.h>
+#if HAVE_STDINT_H_WITH_UINTMAX
+# include <stdint.h>
+#endif
+#if HAVE_INTTYPES_H_WITH_UINTMAX
+# include <inttypes.h>
+#endif
+static char buf[100];
+int main ()
+{
+#if HAVE_STDINT_H_WITH_UINTMAX || HAVE_INTTYPES_H_WITH_UINTMAX
+  buf[0] = '\0';
+  if (sprintf (buf, "%ju %d", (uintmax_t) 12345671, 33, 44, 55) < 0
+      || strcmp (buf, "12345671 33") != 0)
+    return 1;
+#endif
+  buf[0] = '\0';
+  if (sprintf (buf, "%zu %d", (size_t) 12345672, 33, 44, 55) < 0
+      || strcmp (buf, "12345672 33") != 0)
+    return 1;
+  buf[0] = '\0';
+  if (sprintf (buf, "%tu %d", (ptrdiff_t) 12345673, 33, 44, 55) < 0
+      || strcmp (buf, "12345673 33") != 0)
+    return 1;
+  buf[0] = '\0';
+  if (sprintf (buf, "%Lg %d", (long double) 1.5, 33, 44, 55) < 0
+      || strcmp (buf, "1.5 33") != 0)
+    return 1;
+  return 0;
+}], [gl_cv_func_printf_sizes_c99=yes], [gl_cv_func_printf_sizes_c99=no],
+      [
+changequote(,)dnl
+       case "$host_os" in
+                               # Guess yes on glibc systems.
+         *-gnu*)               gl_cv_func_printf_sizes_c99="guessing yes";;
+                               # Guess yes on FreeBSD >= 5.
+         freebsd[1-4]*)        gl_cv_func_printf_sizes_c99="guessing no";;
+         freebsd* | kfreebsd*) gl_cv_func_printf_sizes_c99="guessing yes";;
+                               # Guess yes on MacOS X >= 10.3.
+         darwin[1-6].*)        gl_cv_func_printf_sizes_c99="guessing no";;
+         darwin*)              gl_cv_func_printf_sizes_c99="guessing yes";;
+                               # Guess yes on OpenBSD >= 3.9.
+         openbsd[1-2].* | openbsd3.[0-8] | openbsd3.[0-8].*)
+                               gl_cv_func_printf_sizes_c99="guessing no";;
+         openbsd*)             gl_cv_func_printf_sizes_c99="guessing yes";;
+                               # Guess yes on Solaris >= 2.10.
+         solaris2.[0-9]*)      gl_cv_func_printf_sizes_c99="guessing no";;
+         solaris*)             gl_cv_func_printf_sizes_c99="guessing yes";;
+                               # Guess yes on NetBSD >= 3.
+         netbsd[1-2]* | netbsdelf[1-2]* | netbsdaout[1-2]* | netbsdcoff[1-2]*)
+                               gl_cv_func_printf_sizes_c99="guessing no";;
+         netbsd*)              gl_cv_func_printf_sizes_c99="guessing yes";;
+                               # If we don't know, assume the worst.
+         *)                    gl_cv_func_printf_sizes_c99="guessing no";;
+       esac
+changequote([,])dnl
+      ])
+    ])
+])
+
+dnl Test whether the *printf family of functions supports 'long double'
+dnl arguments together with the 'L' size specifier. (ISO C99, POSIX:2001)
+dnl Result is gl_cv_func_printf_long_double.
+
+AC_DEFUN([gl_PRINTF_LONG_DOUBLE],
+[
+  AC_REQUIRE([AC_PROG_CC])
+  AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+  AC_CACHE_CHECK([whether printf supports 'long double' arguments],
+    [gl_cv_func_printf_long_double],
+    [
+      AC_TRY_RUN([
+#include <stdio.h>
+#include <string.h>
+static char buf[10000];
+int main ()
+{
+  buf[0] = '\0';
+  if (sprintf (buf, "%Lf %d", 1.75L, 33, 44, 55) < 0
+      || strcmp (buf, "1.750000 33") != 0)
+    return 1;
+  buf[0] = '\0';
+  if (sprintf (buf, "%Le %d", 1.75L, 33, 44, 55) < 0
+      || strcmp (buf, "1.750000e+00 33") != 0)
+    return 1;
+  buf[0] = '\0';
+  if (sprintf (buf, "%Lg %d", 1.75L, 33, 44, 55) < 0
+      || strcmp (buf, "1.75 33") != 0)
+    return 1;
+  return 0;
+}], [gl_cv_func_printf_long_double=yes], [gl_cv_func_printf_long_double=no],
+      [
+changequote(,)dnl
+       case "$host_os" in
+         beos*)        gl_cv_func_printf_long_double="guessing no";;
+         mingw* | pw*) gl_cv_func_printf_long_double="guessing no";;
+         *)            gl_cv_func_printf_long_double="guessing yes";;
+       esac
+changequote([,])dnl
+      ])
+    ])
+])
+
+dnl Test whether the *printf family of functions supports infinite and NaN
+dnl 'double' arguments and negative zero arguments in the %f, %e, %g
+dnl directives. (ISO C99, POSIX:2001)
+dnl Result is gl_cv_func_printf_infinite.
+
+AC_DEFUN([gl_PRINTF_INFINITE],
+[
+  AC_REQUIRE([AC_PROG_CC])
+  AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+  AC_CACHE_CHECK([whether printf supports infinite 'double' arguments],
+    [gl_cv_func_printf_infinite],
+    [
+      AC_TRY_RUN([
+#include <stdio.h>
+#include <string.h>
+static int
+strisnan (const char *string, size_t start_index, size_t end_index)
+{
+  if (start_index < end_index)
+    {
+      if (string[start_index] == '-')
+        start_index++;
+      if (start_index + 3 <= end_index
+          && memcmp (string + start_index, "nan", 3) == 0)
+        {
+          start_index += 3;
+          if (start_index == end_index
+              || (string[start_index] == '(' && string[end_index - 1] == ')'))
+            return 1;
+        }
+    }
+  return 0;
+}
+static int
+have_minus_zero ()
+{
+  static double plus_zero = 0.0;
+  double minus_zero = - plus_zero;
+  return memcmp (&plus_zero, &minus_zero, sizeof (double)) != 0;
+}
+static char buf[10000];
+static double zero = 0.0;
+int main ()
+{
+  if (sprintf (buf, "%f", 1.0 / 0.0) < 0
+      || (strcmp (buf, "inf") != 0 && strcmp (buf, "infinity") != 0))
+    return 1;
+  if (sprintf (buf, "%f", -1.0 / 0.0) < 0
+      || (strcmp (buf, "-inf") != 0 && strcmp (buf, "-infinity") != 0))
+    return 1;
+  if (sprintf (buf, "%f", zero / zero) < 0
+      || !strisnan (buf, 0, strlen (buf)))
+    return 1;
+  if (sprintf (buf, "%e", 1.0 / 0.0) < 0
+      || (strcmp (buf, "inf") != 0 && strcmp (buf, "infinity") != 0))
+    return 1;
+  if (sprintf (buf, "%e", -1.0 / 0.0) < 0
+      || (strcmp (buf, "-inf") != 0 && strcmp (buf, "-infinity") != 0))
+    return 1;
+  if (sprintf (buf, "%e", zero / zero) < 0
+      || !strisnan (buf, 0, strlen (buf)))
+    return 1;
+  if (sprintf (buf, "%g", 1.0 / 0.0) < 0
+      || (strcmp (buf, "inf") != 0 && strcmp (buf, "infinity") != 0))
+    return 1;
+  if (sprintf (buf, "%g", -1.0 / 0.0) < 0
+      || (strcmp (buf, "-inf") != 0 && strcmp (buf, "-infinity") != 0))
+    return 1;
+  if (sprintf (buf, "%g", zero / zero) < 0
+      || !strisnan (buf, 0, strlen (buf)))
+    return 1;
+  /* This test fails on HP-UX 10.20.  */
+  if (have_minus_zero ())
+    if (sprintf (buf, "%g", - zero) < 0
+        || strcmp (buf, "-0") != 0)
+    return 1;
+  return 0;
+}], [gl_cv_func_printf_infinite=yes], [gl_cv_func_printf_infinite=no],
+      [
+changequote(,)dnl
+       case "$host_os" in
+                               # Guess yes on glibc systems.
+         *-gnu*)               gl_cv_func_printf_infinite="guessing yes";;
+                               # Guess yes on FreeBSD >= 6.
+         freebsd[1-5]*)        gl_cv_func_printf_infinite="guessing no";;
+         freebsd* | kfreebsd*) gl_cv_func_printf_infinite="guessing yes";;
+                               # Guess yes on MacOS X >= 10.3.
+         darwin[1-6].*)        gl_cv_func_printf_infinite="guessing no";;
+         darwin*)              gl_cv_func_printf_infinite="guessing yes";;
+                               # Guess yes on HP-UX >= 11.
+         hpux[7-9]* | hpux10*) gl_cv_func_printf_infinite="guessing no";;
+         hpux*)                gl_cv_func_printf_infinite="guessing yes";;
+                               # Guess yes on NetBSD >= 3.
+         netbsd[1-2]* | netbsdelf[1-2]* | netbsdaout[1-2]* | netbsdcoff[1-2]*)
+                               gl_cv_func_printf_infinite="guessing no";;
+         netbsd*)              gl_cv_func_printf_infinite="guessing yes";;
+                               # Guess yes on BeOS.
+         beos*)                gl_cv_func_printf_infinite="guessing yes";;
+                               # If we don't know, assume the worst.
+         *)                    gl_cv_func_printf_infinite="guessing no";;
+       esac
+changequote([,])dnl
+      ])
+    ])
+])
+
+dnl Test whether the *printf family of functions supports infinite and NaN
+dnl 'long double' arguments in the %f, %e, %g directives. (ISO C99, POSIX:2001)
+dnl Result is gl_cv_func_printf_infinite_long_double.
+
+AC_DEFUN([gl_PRINTF_INFINITE_LONG_DOUBLE],
+[
+  AC_REQUIRE([gl_PRINTF_LONG_DOUBLE])
+  AC_REQUIRE([AC_PROG_CC])
+  AC_REQUIRE([gl_BIGENDIAN])
+  AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+  dnl The user can set or unset the variable gl_printf_safe to indicate
+  dnl that he wishes a safe handling of non-IEEE-754 'long double' values.
+  if test -n "$gl_printf_safe"; then
+    AC_DEFINE([CHECK_PRINTF_SAFE], [1],
+      [Define if you wish *printf() functions that have a safe handling of
+       non-IEEE-754 'long double' values.])
+  fi
+  case "$gl_cv_func_printf_long_double" in
+    *yes)
+      AC_CACHE_CHECK([whether printf supports infinite 'long double' arguments],
+        [gl_cv_func_printf_infinite_long_double],
+        [
+          AC_TRY_RUN([
+]GL_NOCRASH[
+#include <float.h>
+#include <stdio.h>
+#include <string.h>
+static int
+strisnan (const char *string, size_t start_index, size_t end_index)
+{
+  if (start_index < end_index)
+    {
+      if (string[start_index] == '-')
+        start_index++;
+      if (start_index + 3 <= end_index
+          && memcmp (string + start_index, "nan", 3) == 0)
+        {
+          start_index += 3;
+          if (start_index == end_index
+              || (string[start_index] == '(' && string[end_index - 1] == ')'))
+            return 1;
+        }
+    }
+  return 0;
+}
+static char buf[10000];
+static long double zeroL = 0.0L;
+int main ()
+{
+  nocrash_init();
+  if (sprintf (buf, "%Lf", 1.0L / 0.0L) < 0
+      || (strcmp (buf, "inf") != 0 && strcmp (buf, "infinity") != 0))
+    return 1;
+  if (sprintf (buf, "%Lf", -1.0L / 0.0L) < 0
+      || (strcmp (buf, "-inf") != 0 && strcmp (buf, "-infinity") != 0))
+    return 1;
+  if (sprintf (buf, "%Lf", zeroL / zeroL) < 0
+      || !strisnan (buf, 0, strlen (buf)))
+    return 1;
+  if (sprintf (buf, "%Le", 1.0L / 0.0L) < 0
+      || (strcmp (buf, "inf") != 0 && strcmp (buf, "infinity") != 0))
+    return 1;
+  if (sprintf (buf, "%Le", -1.0L / 0.0L) < 0
+      || (strcmp (buf, "-inf") != 0 && strcmp (buf, "-infinity") != 0))
+    return 1;
+  if (sprintf (buf, "%Le", zeroL / zeroL) < 0
+      || !strisnan (buf, 0, strlen (buf)))
+    return 1;
+  if (sprintf (buf, "%Lg", 1.0L / 0.0L) < 0
+      || (strcmp (buf, "inf") != 0 && strcmp (buf, "infinity") != 0))
+    return 1;
+  if (sprintf (buf, "%Lg", -1.0L / 0.0L) < 0
+      || (strcmp (buf, "-inf") != 0 && strcmp (buf, "-infinity") != 0))
+    return 1;
+  if (sprintf (buf, "%Lg", zeroL / zeroL) < 0
+      || !strisnan (buf, 0, strlen (buf)))
+    return 1;
+#if CHECK_PRINTF_SAFE && ((defined __ia64 && LDBL_MANT_DIG == 64) || (defined __x86_64__ || defined __amd64__) || (defined __i386 || defined __i386__ || defined _I386 || defined _M_IX86 || defined _X86_))
+/* Representation of an 80-bit 'long double' as an initializer for a sequence
+   of 'unsigned int' words.  */
+# ifdef WORDS_BIGENDIAN
+#  define LDBL80_WORDS(exponent,manthi,mantlo) \
+     { ((unsigned int) (exponent) << 16) | ((unsigned int) (manthi) >> 16), \
+       ((unsigned int) (manthi) << 16) | (unsigned int) (mantlo) >> 16),    \
+       (unsigned int) (mantlo) << 16                                        \
+     }
+# else
+#  define LDBL80_WORDS(exponent,manthi,mantlo) \
+     { mantlo, manthi, exponent }
+# endif
+  { /* Quiet NaN.  */
+    static union { unsigned int word[4]; long double value; } x =
+      { LDBL80_WORDS (0xFFFF, 0xC3333333, 0x00000000) };
+    if (sprintf (buf, "%Lf", x.value) < 0
+        || !strisnan (buf, 0, strlen (buf)))
+      return 1;
+    if (sprintf (buf, "%Le", x.value) < 0
+        || !strisnan (buf, 0, strlen (buf)))
+      return 1;
+    if (sprintf (buf, "%Lg", x.value) < 0
+        || !strisnan (buf, 0, strlen (buf)))
+      return 1;
+  }
+  {
+    /* Signalling NaN.  */
+    static union { unsigned int word[4]; long double value; } x =
+      { LDBL80_WORDS (0xFFFF, 0x83333333, 0x00000000) };
+    if (sprintf (buf, "%Lf", x.value) < 0
+        || !strisnan (buf, 0, strlen (buf)))
+      return 1;
+    if (sprintf (buf, "%Le", x.value) < 0
+        || !strisnan (buf, 0, strlen (buf)))
+      return 1;
+    if (sprintf (buf, "%Lg", x.value) < 0
+        || !strisnan (buf, 0, strlen (buf)))
+      return 1;
+  }
+  { /* Pseudo-NaN.  */
+    static union { unsigned int word[4]; long double value; } x =
+      { LDBL80_WORDS (0xFFFF, 0x40000001, 0x00000000) };
+    if (sprintf (buf, "%Lf", x.value) < 0
+        || !strisnan (buf, 0, strlen (buf)))
+      return 1;
+    if (sprintf (buf, "%Le", x.value) < 0
+        || !strisnan (buf, 0, strlen (buf)))
+      return 1;
+    if (sprintf (buf, "%Lg", x.value) < 0
+        || !strisnan (buf, 0, strlen (buf)))
+      return 1;
+  }
+  { /* Pseudo-Infinity.  */
+    static union { unsigned int word[4]; long double value; } x =
+      { LDBL80_WORDS (0xFFFF, 0x00000000, 0x00000000) };
+    if (sprintf (buf, "%Lf", x.value) < 0
+        || !strisnan (buf, 0, strlen (buf)))
+      return 1;
+    if (sprintf (buf, "%Le", x.value) < 0
+        || !strisnan (buf, 0, strlen (buf)))
+      return 1;
+    if (sprintf (buf, "%Lg", x.value) < 0
+        || !strisnan (buf, 0, strlen (buf)))
+      return 1;
+  }
+  { /* Pseudo-Zero.  */
+    static union { unsigned int word[4]; long double value; } x =
+      { LDBL80_WORDS (0x4004, 0x00000000, 0x00000000) };
+    if (sprintf (buf, "%Lf", x.value) < 0
+        || !strisnan (buf, 0, strlen (buf)))
+      return 1;
+    if (sprintf (buf, "%Le", x.value) < 0
+        || !strisnan (buf, 0, strlen (buf)))
+      return 1;
+    if (sprintf (buf, "%Lg", x.value) < 0
+        || !strisnan (buf, 0, strlen (buf)))
+      return 1;
+  }
+  { /* Unnormalized number.  */
+    static union { unsigned int word[4]; long double value; } x =
+      { LDBL80_WORDS (0x4000, 0x63333333, 0x00000000) };
+    if (sprintf (buf, "%Lf", x.value) < 0
+        || !strisnan (buf, 0, strlen (buf)))
+      return 1;
+    if (sprintf (buf, "%Le", x.value) < 0
+        || !strisnan (buf, 0, strlen (buf)))
+      return 1;
+    if (sprintf (buf, "%Lg", x.value) < 0
+        || !strisnan (buf, 0, strlen (buf)))
+      return 1;
+  }
+  { /* Pseudo-Denormal.  */
+    static union { unsigned int word[4]; long double value; } x =
+      { LDBL80_WORDS (0x0000, 0x83333333, 0x00000000) };
+    if (sprintf (buf, "%Lf", x.value) < 0
+        || !strisnan (buf, 0, strlen (buf)))
+      return 1;
+    if (sprintf (buf, "%Le", x.value) < 0
+        || !strisnan (buf, 0, strlen (buf)))
+      return 1;
+    if (sprintf (buf, "%Lg", x.value) < 0
+        || !strisnan (buf, 0, strlen (buf)))
+      return 1;
+  }
+#endif
+  return 0;
+}],
+          [gl_cv_func_printf_infinite_long_double=yes],
+          [gl_cv_func_printf_infinite_long_double=no],
+          [
+changequote(,)dnl
+           case "$host_cpu" in
+                                   # Guess no on ia64, x86_64, i386.
+             ia64 | x86_64 | i*86) gl_cv_func_printf_infinite_long_double="guessing no";;
+             *)
+               case "$host_os" in
+                                       # Guess yes on glibc systems.
+                 *-gnu*)               gl_cv_func_printf_infinite_long_double="guessing yes";;
+                                       # Guess yes on FreeBSD >= 6.
+                 freebsd[1-5]*)        gl_cv_func_printf_infinite_long_double="guessing no";;
+                 freebsd* | kfreebsd*) gl_cv_func_printf_infinite_long_double="guessing yes";;
+                                       # Guess yes on MacOS X >= 10.3.
+                 darwin[1-6].*)        gl_cv_func_printf_infinite_long_double="guessing no";;
+                 darwin*)              gl_cv_func_printf_infinite_long_double="guessing yes";;
+                                       # Guess yes on HP-UX >= 11.
+                 hpux[7-9]* | hpux10*) gl_cv_func_printf_infinite_long_double="guessing no";;
+                 hpux*)                gl_cv_func_printf_infinite_long_double="guessing yes";;
+                                       # Guess yes on NetBSD >= 3.
+                 netbsd[1-2]* | netbsdelf[1-2]* | netbsdaout[1-2]* | netbsdcoff[1-2]*)
+                                       gl_cv_func_printf_infinite_long_double="guessing no";;
+                 netbsd*)              gl_cv_func_printf_infinite_long_double="guessing yes";;
+                                       # If we don't know, assume the worst.
+                 *)                    gl_cv_func_printf_infinite_long_double="guessing no";;
+               esac
+               ;;
+           esac
+changequote([,])dnl
+          ])
+        ])
+      ;;
+    *)
+      gl_cv_func_printf_infinite_long_double="irrelevant"
+      ;;
+  esac
+])
+
+dnl Test whether the *printf family of functions supports the 'a' and 'A'
+dnl conversion specifier for hexadecimal output of floating-point numbers.
+dnl (ISO C99, POSIX:2001)
+dnl Result is gl_cv_func_printf_directive_a.
+
+AC_DEFUN([gl_PRINTF_DIRECTIVE_A],
+[
+  AC_REQUIRE([AC_PROG_CC])
+  AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+  AC_CACHE_CHECK([whether printf supports the 'a' and 'A' directives],
+    [gl_cv_func_printf_directive_a],
+    [
+      AC_TRY_RUN([
+#include <stdio.h>
+#include <string.h>
+static char buf[100];
+int main ()
+{
+  if (sprintf (buf, "%a %d", 3.1416015625, 33, 44, 55) < 0
+      || (strcmp (buf, "0x1.922p+1 33") != 0
+          && strcmp (buf, "0x3.244p+0 33") != 0
+          && strcmp (buf, "0x6.488p-1 33") != 0
+          && strcmp (buf, "0xc.91p-2 33") != 0))
+    return 1;
+  if (sprintf (buf, "%A %d", -3.1416015625, 33, 44, 55) < 0
+      || (strcmp (buf, "-0X1.922P+1 33") != 0
+          && strcmp (buf, "-0X3.244P+0 33") != 0
+          && strcmp (buf, "-0X6.488P-1 33") != 0
+          && strcmp (buf, "-0XC.91P-2 33") != 0))
+    return 1;
+  /* This catches a FreeBSD 6.1 bug: it doesn't round.  */
+  if (sprintf (buf, "%.2a %d", 1.51, 33, 44, 55) < 0
+      || (strcmp (buf, "0x1.83p+0 33") != 0
+          && strcmp (buf, "0x3.05p-1 33") != 0
+          && strcmp (buf, "0x6.0ap-2 33") != 0
+          && strcmp (buf, "0xc.14p-3 33") != 0))
+    return 1;
+  /* This catches a FreeBSD 6.1 bug.  See
+     <http://lists.gnu.org/archive/html/bug-gnulib/2007-04/msg00107.html> */
+  if (sprintf (buf, "%010a %d", 1.0 / 0.0, 33, 44, 55) < 0
+      || buf[0] == '0')
+    return 1;
+  /* This catches a MacOS X 10.3.9 (Darwin 7.9) bug.  */
+  if (sprintf (buf, "%.1a", 1.999) < 0
+      || (strcmp (buf, "0x1.0p+1") != 0
+          && strcmp (buf, "0x2.0p+0") != 0
+          && strcmp (buf, "0x4.0p-1") != 0
+          && strcmp (buf, "0x8.0p-2") != 0))
+    return 1;
+  /* This catches the same MacOS X 10.3.9 (Darwin 7.9) bug and also a
+     glibc 2.4 bug <http://sourceware.org/bugzilla/show_bug.cgi?id=2908>.  */
+  if (sprintf (buf, "%.1La", 1.999L) < 0
+      || (strcmp (buf, "0x1.0p+1") != 0
+          && strcmp (buf, "0x2.0p+0") != 0
+          && strcmp (buf, "0x4.0p-1") != 0
+          && strcmp (buf, "0x8.0p-2") != 0))
+    return 1;
+  return 0;
+}], [gl_cv_func_printf_directive_a=yes], [gl_cv_func_printf_directive_a=no],
+      [
+       case "$host_os" in
+                               # Guess yes on glibc >= 2.5 systems.
+         *-gnu*)
+           AC_EGREP_CPP([BZ2908], [
+             #include <features.h>
+             #ifdef __GNU_LIBRARY__
+              #if (__GLIBC__ == 2 && __GLIBC_MINOR__ >= 5) || (__GLIBC__ > 2)
+               BZ2908
+              #endif
+             #endif
+             ],
+             [gl_cv_func_printf_directive_a="guessing yes"],
+             [gl_cv_func_printf_directive_a="guessing no"])
+           ;;
+                               # If we don't know, assume the worst.
+         *)                    gl_cv_func_printf_directive_a="guessing no";;
+       esac
+      ])
+    ])
+])
+
+dnl Test whether the *printf family of functions supports the %F format
+dnl directive. (ISO C99, POSIX:2001)
+dnl Result is gl_cv_func_printf_directive_f.
+
+AC_DEFUN([gl_PRINTF_DIRECTIVE_F],
+[
+  AC_REQUIRE([AC_PROG_CC])
+  AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+  AC_CACHE_CHECK([whether printf supports the 'F' directive],
+    [gl_cv_func_printf_directive_f],
+    [
+      AC_TRY_RUN([
+#include <stdio.h>
+#include <string.h>
+static char buf[100];
+int main ()
+{
+  if (sprintf (buf, "%F %d", 1234567.0, 33, 44, 55) < 0
+      || strcmp (buf, "1234567.000000 33") != 0)
+    return 1;
+  if (sprintf (buf, "%F", 1.0 / 0.0) < 0
+      || (strcmp (buf, "INF") != 0 && strcmp (buf, "INFINITY") != 0))
+    return 1;
+  /* This catches a Cygwin 1.5.x bug.  */
+  if (sprintf (buf, "%.F", 1234.0) < 0
+      || strcmp (buf, "1234") != 0)
+    return 1;
+  return 0;
+}], [gl_cv_func_printf_directive_f=yes], [gl_cv_func_printf_directive_f=no],
+      [
+changequote(,)dnl
+       case "$host_os" in
+                               # Guess yes on glibc systems.
+         *-gnu*)               gl_cv_func_printf_directive_f="guessing yes";;
+                               # Guess yes on FreeBSD >= 6.
+         freebsd[1-5]*)        gl_cv_func_printf_directive_f="guessing no";;
+         freebsd* | kfreebsd*) gl_cv_func_printf_directive_f="guessing yes";;
+                               # Guess yes on MacOS X >= 10.3.
+         darwin[1-6].*)        gl_cv_func_printf_directive_f="guessing no";;
+         darwin*)              gl_cv_func_printf_directive_f="guessing yes";;
+                               # Guess yes on Solaris >= 2.10.
+         solaris2.[0-9]*)      gl_cv_func_printf_directive_f="guessing no";;
+         solaris*)             gl_cv_func_printf_directive_f="guessing yes";;
+                               # If we don't know, assume the worst.
+         *)                    gl_cv_func_printf_directive_f="guessing no";;
+       esac
+changequote([,])dnl
+      ])
+    ])
+])
+
+dnl Test whether the *printf family of functions supports the %n format
+dnl directive. (ISO C99, POSIX:2001)
+dnl Result is gl_cv_func_printf_directive_n.
+
+AC_DEFUN([gl_PRINTF_DIRECTIVE_N],
+[
+  AC_REQUIRE([AC_PROG_CC])
+  AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+  AC_CACHE_CHECK([whether printf supports the 'n' directive],
+    [gl_cv_func_printf_directive_n],
+    [
+      AC_TRY_RUN([
+#include <stdio.h>
+#include <string.h>
+static char fmtstring[10];
+static char buf[100];
+int main ()
+{
+  int count = -1;
+  /* Copy the format string.  Some systems (glibc with _FORTIFY_SOURCE=2)
+     support %n in format strings in read-only memory but not in writable
+     memory.  */
+  strcpy (fmtstring, "%d %n");
+  if (sprintf (buf, fmtstring, 123, &count, 33, 44, 55) < 0
+      || strcmp (buf, "123 ") != 0
+      || count != 4)
+    return 1;
+  return 0;
+}], [gl_cv_func_printf_directive_n=yes], [gl_cv_func_printf_directive_n=no],
+      [
+changequote(,)dnl
+       case "$host_os" in
+         *)     gl_cv_func_printf_directive_n="guessing yes";;
+       esac
+changequote([,])dnl
+      ])
+    ])
+])
+
+dnl Test whether the *printf family of functions supports the %ls format
+dnl directive and in particular, when a precision is specified, whether
+dnl the functions stop converting the wide string argument when the number
+dnl of bytes that have been produced by this conversion equals or exceeds
+dnl the precision.
+dnl Result is gl_cv_func_printf_directive_ls.
+
+AC_DEFUN([gl_PRINTF_DIRECTIVE_LS],
+[
+  AC_REQUIRE([AC_PROG_CC])
+  AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+  AC_CACHE_CHECK([whether printf supports the 'ls' directive],
+    [gl_cv_func_printf_directive_ls],
+    [
+      AC_TRY_RUN([
+/* Tru64 with Desktop Toolkit C has a bug: <stdio.h> must be included before
+   <wchar.h>.
+   BSD/OS 4.0.1 has a bug: <stddef.h>, <stdio.h> and <time.h> must be
+   included before <wchar.h>.  */
+#include <stddef.h>
+#include <stdio.h>
+#include <time.h>
+#include <wchar.h>
+#include <string.h>
+int main ()
+{
+  char buf[100];
+  /* Test whether %ls works at all.
+     This test fails on OpenBSD 4.0, IRIX 6.5, Solaris 2.6, Haiku, but not on
+     Cygwin 1.5.  */
+  {
+    static const wchar_t wstring[] = { 'a', 'b', 'c', 0 };
+    buf[0] = '\0';
+    if (sprintf (buf, "%ls", wstring) < 0
+        || strcmp (buf, "abc") != 0)
+      return 1;
+  }
+  /* This test fails on IRIX 6.5, Solaris 2.6, Cygwin 1.5, Haiku (with an
+     assertion failure inside libc), but not on OpenBSD 4.0.  */
+  {
+    static const wchar_t wstring[] = { 'a', 0 };
+    buf[0] = '\0';
+    if (sprintf (buf, "%ls", wstring) < 0
+        || strcmp (buf, "a") != 0)
+      return 1;
+  }
+  /* Test whether precisions in %ls are supported as specified in ISO C 99
+     section 7.19.6.1:
+       "If a precision is specified, no more than that many bytes are written
+        (including shift sequences, if any), and the array shall contain a
+        null wide character if, to equal the multibyte character sequence
+        length given by the precision, the function would need to access a
+        wide character one past the end of the array."
+     This test fails on Solaris 10.  */
+  {
+    static const wchar_t wstring[] = { 'a', 'b', (wchar_t) 0xfdfdfdfd, 0 };
+    buf[0] = '\0';
+    if (sprintf (buf, "%.2ls", wstring) < 0
+        || strcmp (buf, "ab") != 0)
+      return 1;
+  }
+  return 0;
+}], [gl_cv_func_printf_directive_ls=yes], [gl_cv_func_printf_directive_ls=no],
+      [
+changequote(,)dnl
+       case "$host_os" in
+         openbsd*)        gl_cv_func_printf_directive_ls="guessing no";;
+         irix*)           gl_cv_func_printf_directive_ls="guessing no";;
+         solaris*)        gl_cv_func_printf_directive_ls="guessing no";;
+         cygwin*)         gl_cv_func_printf_directive_ls="guessing no";;
+         beos* | haiku*)  gl_cv_func_printf_directive_ls="guessing no";;
+         *)               gl_cv_func_printf_directive_ls="guessing yes";;
+       esac
+changequote([,])dnl
+      ])
+    ])
+])
+
+dnl Test whether the *printf family of functions supports POSIX/XSI format
+dnl strings with positions. (POSIX:2001)
+dnl Result is gl_cv_func_printf_positions.
+
+AC_DEFUN([gl_PRINTF_POSITIONS],
+[
+  AC_REQUIRE([AC_PROG_CC])
+  AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+  AC_CACHE_CHECK([whether printf supports POSIX/XSI format strings with positions],
+    [gl_cv_func_printf_positions],
+    [
+      AC_TRY_RUN([
+#include <stdio.h>
+#include <string.h>
+/* The string "%2$d %1$d", with dollar characters protected from the shell's
+   dollar expansion (possibly an autoconf bug).  */
+static char format[] = { '%', '2', '$', 'd', ' ', '%', '1', '$', 'd', '\0' };
+static char buf[100];
+int main ()
+{
+  sprintf (buf, format, 33, 55);
+  return (strcmp (buf, "55 33") != 0);
+}], [gl_cv_func_printf_positions=yes], [gl_cv_func_printf_positions=no],
+      [
+changequote(,)dnl
+       case "$host_os" in
+         netbsd[1-3]* | netbsdelf[1-3]* | netbsdaout[1-3]* | netbsdcoff[1-3]*)
+                       gl_cv_func_printf_positions="guessing no";;
+         beos*)        gl_cv_func_printf_positions="guessing no";;
+         mingw* | pw*) gl_cv_func_printf_positions="guessing no";;
+         *)            gl_cv_func_printf_positions="guessing yes";;
+       esac
+changequote([,])dnl
+      ])
+    ])
+])
+
+dnl Test whether the *printf family of functions supports POSIX/XSI format
+dnl strings with the ' flag for grouping of decimal digits. (POSIX:2001)
+dnl Result is gl_cv_func_printf_flag_grouping.
+
+AC_DEFUN([gl_PRINTF_FLAG_GROUPING],
+[
+  AC_REQUIRE([AC_PROG_CC])
+  AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+  AC_CACHE_CHECK([whether printf supports the grouping flag],
+    [gl_cv_func_printf_flag_grouping],
+    [
+      AC_TRY_RUN([
+#include <stdio.h>
+#include <string.h>
+static char buf[100];
+int main ()
+{
+  if (sprintf (buf, "%'d %d", 1234567, 99) < 0
+      || buf[strlen (buf) - 1] != '9')
+    return 1;
+  return 0;
+}], [gl_cv_func_printf_flag_grouping=yes], [gl_cv_func_printf_flag_grouping=no],
+      [
+changequote(,)dnl
+       case "$host_os" in
+         cygwin*)      gl_cv_func_printf_flag_grouping="guessing no";;
+         netbsd*)      gl_cv_func_printf_flag_grouping="guessing no";;
+         mingw* | pw*) gl_cv_func_printf_flag_grouping="guessing no";;
+         *)            gl_cv_func_printf_flag_grouping="guessing yes";;
+       esac
+changequote([,])dnl
+      ])
+    ])
+])
+
+dnl Test whether the *printf family of functions supports the - flag correctly.
+dnl (ISO C99.) See
+dnl <http://lists.gnu.org/archive/html/bug-coreutils/2008-02/msg00035.html>
+dnl Result is gl_cv_func_printf_flag_leftadjust.
+
+AC_DEFUN([gl_PRINTF_FLAG_LEFTADJUST],
+[
+  AC_REQUIRE([AC_PROG_CC])
+  AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+  AC_CACHE_CHECK([whether printf supports the left-adjust flag correctly],
+    [gl_cv_func_printf_flag_leftadjust],
+    [
+      AC_TRY_RUN([
+#include <stdio.h>
+#include <string.h>
+static char buf[100];
+int main ()
+{
+  /* Check that a '-' flag is not annihilated by a negative width.  */
+  if (sprintf (buf, "a%-*sc", -3, "b") < 0
+      || strcmp (buf, "ab  c") != 0)
+    return 1;
+  return 0;
+}],
+        [gl_cv_func_printf_flag_leftadjust=yes],
+        [gl_cv_func_printf_flag_leftadjust=no],
+        [
+changequote(,)dnl
+         case "$host_os" in
+                    # Guess yes on HP-UX 11.
+           hpux11*) gl_cv_func_printf_flag_leftadjust="guessing yes";;
+                    # Guess no on HP-UX 10 and older.
+           hpux*)   gl_cv_func_printf_flag_leftadjust="guessing no";;
+                    # Guess yes otherwise.
+           *)       gl_cv_func_printf_flag_leftadjust="guessing yes";;
+         esac
+changequote([,])dnl
+        ])
+    ])
+])
+
+dnl Test whether the *printf family of functions supports padding of non-finite
+dnl values with the 0 flag correctly. (ISO C99 + TC1 + TC2.) See
+dnl <http://lists.gnu.org/archive/html/bug-gnulib/2007-04/msg00107.html>
+dnl Result is gl_cv_func_printf_flag_zero.
+
+AC_DEFUN([gl_PRINTF_FLAG_ZERO],
+[
+  AC_REQUIRE([AC_PROG_CC])
+  AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+  AC_CACHE_CHECK([whether printf supports the zero flag correctly],
+    [gl_cv_func_printf_flag_zero],
+    [
+      AC_TRY_RUN([
+#include <stdio.h>
+#include <string.h>
+static char buf[100];
+int main ()
+{
+  if (sprintf (buf, "%010f", 1.0 / 0.0, 33, 44, 55) < 0
+      || (strcmp (buf, "       inf") != 0
+          && strcmp (buf, "  infinity") != 0))
+    return 1;
+  return 0;
+}], [gl_cv_func_printf_flag_zero=yes], [gl_cv_func_printf_flag_zero=no],
+      [
+changequote(,)dnl
+       case "$host_os" in
+                 # Guess yes on glibc systems.
+         *-gnu*) gl_cv_func_printf_flag_zero="guessing yes";;
+                 # Guess yes on BeOS.
+         beos*)  gl_cv_func_printf_flag_zero="guessing yes";;
+                 # If we don't know, assume the worst.
+         *)      gl_cv_func_printf_flag_zero="guessing no";;
+       esac
+changequote([,])dnl
+      ])
+    ])
+])
+
+dnl Test whether the *printf family of functions supports large precisions.
+dnl On mingw, precisions larger than 512 are treated like 512, in integer,
+dnl floating-point or pointer output. On BeOS, precisions larger than 1044
+dnl crash the program.
+dnl Result is gl_cv_func_printf_precision.
+
+AC_DEFUN([gl_PRINTF_PRECISION],
+[
+  AC_REQUIRE([AC_PROG_CC])
+  AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+  AC_CACHE_CHECK([whether printf supports large precisions],
+    [gl_cv_func_printf_precision],
+    [
+      AC_TRY_RUN([
+#include <stdio.h>
+#include <string.h>
+static char buf[5000];
+int main ()
+{
+#ifdef __BEOS__
+  /* On BeOS, this would crash and show a dialog box.  Avoid the crash.  */
+  return 1;
+#endif
+  if (sprintf (buf, "%.4000d %d", 1, 33, 44) < 4000 + 3)
+    return 1;
+  return 0;
+}], [gl_cv_func_printf_precision=yes], [gl_cv_func_printf_precision=no],
+      [
+changequote(,)dnl
+       case "$host_os" in
+         # Guess no only on native Win32 and BeOS systems.
+         mingw* | pw*) gl_cv_func_printf_precision="guessing no" ;;
+         beos*)        gl_cv_func_printf_precision="guessing no" ;;
+         *)            gl_cv_func_printf_precision="guessing yes" ;;
+       esac
+changequote([,])dnl
+      ])
+    ])
+])
+
+dnl Test whether the *printf family of functions recovers gracefully in case
+dnl of an out-of-memory condition, or whether it crashes the entire program.
+dnl Result is gl_cv_func_printf_enomem.
+
+AC_DEFUN([gl_PRINTF_ENOMEM],
+[
+  AC_REQUIRE([AC_PROG_CC])
+  AC_REQUIRE([gl_MULTIARCH])
+  AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+  AC_CACHE_CHECK([whether printf survives out-of-memory conditions],
+    [gl_cv_func_printf_enomem],
+    [
+      gl_cv_func_printf_enomem="guessing no"
+      if test "$cross_compiling" = no; then
+        if test $APPLE_UNIVERSAL_BUILD = 0; then
+          AC_LANG_CONFTEST([AC_LANG_SOURCE([
+]GL_NOCRASH[
+changequote(,)dnl
+#include <stdio.h>
+#include <sys/types.h>
+#include <sys/time.h>
+#include <sys/resource.h>
+#include <errno.h>
+int main()
+{
+  struct rlimit limit;
+  int ret;
+  nocrash_init ();
+  /* Some printf implementations allocate temporary space with malloc.  */
+  /* On BSD systems, malloc() is limited by RLIMIT_DATA.  */
+#ifdef RLIMIT_DATA
+  if (getrlimit (RLIMIT_DATA, &limit) < 0)
+    return 77;
+  if (limit.rlim_max == RLIM_INFINITY || limit.rlim_max > 5000000)
+    limit.rlim_max = 5000000;
+  limit.rlim_cur = limit.rlim_max;
+  if (setrlimit (RLIMIT_DATA, &limit) < 0)
+    return 77;
+#endif
+  /* On Linux systems, malloc() is limited by RLIMIT_AS.  */
+#ifdef RLIMIT_AS
+  if (getrlimit (RLIMIT_AS, &limit) < 0)
+    return 77;
+  if (limit.rlim_max == RLIM_INFINITY || limit.rlim_max > 5000000)
+    limit.rlim_max = 5000000;
+  limit.rlim_cur = limit.rlim_max;
+  if (setrlimit (RLIMIT_AS, &limit) < 0)
+    return 77;
+#endif
+  /* Some printf implementations allocate temporary space on the stack.  */
+#ifdef RLIMIT_STACK
+  if (getrlimit (RLIMIT_STACK, &limit) < 0)
+    return 77;
+  if (limit.rlim_max == RLIM_INFINITY || limit.rlim_max > 5000000)
+    limit.rlim_max = 5000000;
+  limit.rlim_cur = limit.rlim_max;
+  if (setrlimit (RLIMIT_STACK, &limit) < 0)
+    return 77;
+#endif
+  ret = printf ("%.5000000f", 1.0);
+  return !(ret == 5000002 || (ret < 0 && errno == ENOMEM));
+}
+changequote([,])dnl
+          ])])
+          if AC_TRY_EVAL([ac_link]) && test -s conftest$ac_exeext; then
+            (./conftest
+             result=$?
+             if test $result != 0 && test $result != 77; then result=1; fi
+             exit $result
+            ) >/dev/null 2>/dev/null
+            case $? in
+              0) gl_cv_func_printf_enomem="yes" ;;
+              77) gl_cv_func_printf_enomem="guessing no" ;;
+              *) gl_cv_func_printf_enomem="no" ;;
+            esac
+          else
+            gl_cv_func_printf_enomem="guessing no"
+          fi
+          rm -fr conftest*
+        else
+          dnl A universal build on Apple MacOS X platforms.
+          dnl The result would be 'no' in 32-bit mode and 'yes' in 64-bit mode.
+          dnl But we need a configuration result that is valid in both modes.
+          gl_cv_func_printf_enomem="guessing no"
+        fi
+      fi
+      if test "$gl_cv_func_printf_enomem" = "guessing no"; then
+changequote(,)dnl
+        case "$host_os" in
+                    # Guess yes on glibc systems.
+          *-gnu*)   gl_cv_func_printf_enomem="guessing yes";;
+                    # Guess yes on Solaris.
+          solaris*) gl_cv_func_printf_enomem="guessing yes";;
+                    # Guess yes on AIX.
+          aix*)     gl_cv_func_printf_enomem="guessing yes";;
+                    # Guess yes on HP-UX/hppa.
+          hpux*)    case "$host_cpu" in
+                      hppa*) gl_cv_func_printf_enomem="guessing yes";;
+                      *)     gl_cv_func_printf_enomem="guessing no";;
+                    esac
+                    ;;
+                    # Guess yes on IRIX.
+          irix*)    gl_cv_func_printf_enomem="guessing yes";;
+                    # Guess yes on OSF/1.
+          osf*)     gl_cv_func_printf_enomem="guessing yes";;
+                    # Guess yes on BeOS.
+          beos*)    gl_cv_func_printf_enomem="guessing yes";;
+                    # Guess yes on Haiku.
+          haiku*)   gl_cv_func_printf_enomem="guessing yes";;
+                    # If we don't know, assume the worst.
+          *)        gl_cv_func_printf_enomem="guessing no";;
+        esac
+changequote([,])dnl
+      fi
+    ])
+])
+
+dnl Test whether the snprintf function exists. (ISO C99, POSIX:2001)
+dnl Result is ac_cv_func_snprintf.
+
+AC_DEFUN([gl_SNPRINTF_PRESENCE],
+[
+  AC_CHECK_FUNCS_ONCE([snprintf])
+])
+
+dnl Test whether the string produced by the snprintf function is always NUL
+dnl terminated. (ISO C99, POSIX:2001)
+dnl Result is gl_cv_func_snprintf_truncation_c99.
+
+AC_DEFUN([gl_SNPRINTF_TRUNCATION_C99],
+[
+  AC_REQUIRE([AC_PROG_CC])
+  AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+  AC_CACHE_CHECK([whether snprintf truncates the result as in C99],
+    [gl_cv_func_snprintf_truncation_c99],
+    [
+      AC_TRY_RUN([
+#include <stdio.h>
+#include <string.h>
+static char buf[100];
+int main ()
+{
+  strcpy (buf, "ABCDEF");
+  snprintf (buf, 3, "%d %d", 4567, 89);
+  if (memcmp (buf, "45\0DEF", 6) != 0)
+    return 1;
+  return 0;
+}], [gl_cv_func_snprintf_truncation_c99=yes], [gl_cv_func_snprintf_truncation_c99=no],
+      [
+changequote(,)dnl
+       case "$host_os" in
+                               # Guess yes on glibc systems.
+         *-gnu*)               gl_cv_func_snprintf_truncation_c99="guessing yes";;
+                               # Guess yes on FreeBSD >= 5.
+         freebsd[1-4]*)        gl_cv_func_snprintf_truncation_c99="guessing no";;
+         freebsd* | kfreebsd*) gl_cv_func_snprintf_truncation_c99="guessing yes";;
+                               # Guess yes on MacOS X >= 10.3.
+         darwin[1-6].*)        gl_cv_func_snprintf_truncation_c99="guessing no";;
+         darwin*)              gl_cv_func_snprintf_truncation_c99="guessing yes";;
+                               # Guess yes on OpenBSD >= 3.9.
+         openbsd[1-2].* | openbsd3.[0-8] | openbsd3.[0-8].*)
+                               gl_cv_func_snprintf_truncation_c99="guessing no";;
+         openbsd*)             gl_cv_func_snprintf_truncation_c99="guessing yes";;
+                               # Guess yes on Solaris >= 2.6.
+         solaris2.[0-5]*)      gl_cv_func_snprintf_truncation_c99="guessing no";;
+         solaris*)             gl_cv_func_snprintf_truncation_c99="guessing yes";;
+                               # Guess yes on AIX >= 4.
+         aix[1-3]*)            gl_cv_func_snprintf_truncation_c99="guessing no";;
+         aix*)                 gl_cv_func_snprintf_truncation_c99="guessing yes";;
+                               # Guess yes on HP-UX >= 11.
+         hpux[7-9]* | hpux10*) gl_cv_func_snprintf_truncation_c99="guessing no";;
+         hpux*)                gl_cv_func_snprintf_truncation_c99="guessing yes";;
+                               # Guess yes on IRIX >= 6.5.
+         irix6.5)              gl_cv_func_snprintf_truncation_c99="guessing yes";;
+                               # Guess yes on OSF/1 >= 5.
+         osf[3-4]*)            gl_cv_func_snprintf_truncation_c99="guessing no";;
+         osf*)                 gl_cv_func_snprintf_truncation_c99="guessing yes";;
+                               # Guess yes on NetBSD >= 3.
+         netbsd[1-2]* | netbsdelf[1-2]* | netbsdaout[1-2]* | netbsdcoff[1-2]*)
+                               gl_cv_func_snprintf_truncation_c99="guessing no";;
+         netbsd*)              gl_cv_func_snprintf_truncation_c99="guessing yes";;
+                               # Guess yes on BeOS.
+         beos*)                gl_cv_func_snprintf_truncation_c99="guessing yes";;
+                               # If we don't know, assume the worst.
+         *)                    gl_cv_func_snprintf_truncation_c99="guessing no";;
+       esac
+changequote([,])dnl
+      ])
+    ])
+])
+
+dnl Test whether the return value of the snprintf function is the number
+dnl of bytes (excluding the terminating NUL) that would have been produced
+dnl if the buffer had been large enough. (ISO C99, POSIX:2001)
+dnl For example, this test program fails on IRIX 6.5:
+dnl     ---------------------------------------------------------------------
+dnl     #include <stdio.h>
+dnl     int main()
+dnl     {
+dnl       static char buf[8];
+dnl       int retval = snprintf (buf, 3, "%d", 12345);
+dnl       return retval >= 0 && retval < 3;
+dnl     }
+dnl     ---------------------------------------------------------------------
+dnl Result is gl_cv_func_snprintf_retval_c99.
+
+AC_DEFUN([gl_SNPRINTF_RETVAL_C99],
+[
+  AC_REQUIRE([AC_PROG_CC])
+  AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+  AC_CACHE_CHECK([whether snprintf returns a byte count as in C99],
+    [gl_cv_func_snprintf_retval_c99],
+    [
+      AC_TRY_RUN([
+#include <stdio.h>
+#include <string.h>
+static char buf[100];
+int main ()
+{
+  strcpy (buf, "ABCDEF");
+  if (snprintf (buf, 3, "%d %d", 4567, 89) != 7)
+    return 1;
+  return 0;
+}], [gl_cv_func_snprintf_retval_c99=yes], [gl_cv_func_snprintf_retval_c99=no],
+      [
+changequote(,)dnl
+       case "$host_os" in
+                               # Guess yes on glibc systems.
+         *-gnu*)               gl_cv_func_snprintf_retval_c99="guessing yes";;
+                               # Guess yes on FreeBSD >= 5.
+         freebsd[1-4]*)        gl_cv_func_snprintf_retval_c99="guessing no";;
+         freebsd* | kfreebsd*) gl_cv_func_snprintf_retval_c99="guessing yes";;
+                               # Guess yes on MacOS X >= 10.3.
+         darwin[1-6].*)        gl_cv_func_snprintf_retval_c99="guessing no";;
+         darwin*)              gl_cv_func_snprintf_retval_c99="guessing yes";;
+                               # Guess yes on OpenBSD >= 3.9.
+         openbsd[1-2].* | openbsd3.[0-8] | openbsd3.[0-8].*)
+                               gl_cv_func_snprintf_retval_c99="guessing no";;
+         openbsd*)             gl_cv_func_snprintf_retval_c99="guessing yes";;
+                               # Guess yes on Solaris >= 2.6.
+         solaris2.[0-5]*)      gl_cv_func_snprintf_retval_c99="guessing no";;
+         solaris*)             gl_cv_func_snprintf_retval_c99="guessing yes";;
+                               # Guess yes on AIX >= 4.
+         aix[1-3]*)            gl_cv_func_snprintf_retval_c99="guessing no";;
+         aix*)                 gl_cv_func_snprintf_retval_c99="guessing yes";;
+                               # Guess yes on NetBSD >= 3.
+         netbsd[1-2]* | netbsdelf[1-2]* | netbsdaout[1-2]* | netbsdcoff[1-2]*)
+                               gl_cv_func_snprintf_retval_c99="guessing no";;
+         netbsd*)              gl_cv_func_snprintf_retval_c99="guessing yes";;
+                               # Guess yes on BeOS.
+         beos*)                gl_cv_func_snprintf_retval_c99="guessing yes";;
+                               # If we don't know, assume the worst.
+         *)                    gl_cv_func_snprintf_retval_c99="guessing no";;
+       esac
+changequote([,])dnl
+      ])
+    ])
+])
+
+dnl Test whether the snprintf function supports the %n format directive
+dnl also in truncated portions of the format string. (ISO C99, POSIX:2001)
+dnl Result is gl_cv_func_snprintf_directive_n.
+
+AC_DEFUN([gl_SNPRINTF_DIRECTIVE_N],
+[
+  AC_REQUIRE([AC_PROG_CC])
+  AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+  AC_CACHE_CHECK([whether snprintf fully supports the 'n' directive],
+    [gl_cv_func_snprintf_directive_n],
+    [
+      AC_TRY_RUN([
+#include <stdio.h>
+#include <string.h>
+static char fmtstring[10];
+static char buf[100];
+int main ()
+{
+  int count = -1;
+  /* Copy the format string.  Some systems (glibc with _FORTIFY_SOURCE=2)
+     support %n in format strings in read-only memory but not in writable
+     memory.  */
+  strcpy (fmtstring, "%d %n");
+  snprintf (buf, 4, fmtstring, 12345, &count, 33, 44, 55);
+  if (count != 6)
+    return 1;
+  return 0;
+}], [gl_cv_func_snprintf_directive_n=yes], [gl_cv_func_snprintf_directive_n=no],
+      [
+changequote(,)dnl
+       case "$host_os" in
+                               # Guess yes on glibc systems.
+         *-gnu*)               gl_cv_func_snprintf_directive_n="guessing yes";;
+                               # Guess yes on FreeBSD >= 5.
+         freebsd[1-4]*)        gl_cv_func_snprintf_directive_n="guessing no";;
+         freebsd* | kfreebsd*) gl_cv_func_snprintf_directive_n="guessing yes";;
+                               # Guess yes on MacOS X >= 10.3.
+         darwin[1-6].*)        gl_cv_func_snprintf_directive_n="guessing no";;
+         darwin*)              gl_cv_func_snprintf_directive_n="guessing yes";;
+                               # Guess yes on Solaris >= 2.6.
+         solaris2.[0-5]*)      gl_cv_func_snprintf_directive_n="guessing no";;
+         solaris*)             gl_cv_func_snprintf_directive_n="guessing yes";;
+                               # Guess yes on AIX >= 4.
+         aix[1-3]*)            gl_cv_func_snprintf_directive_n="guessing no";;
+         aix*)                 gl_cv_func_snprintf_directive_n="guessing yes";;
+                               # Guess yes on IRIX >= 6.5.
+         irix6.5)              gl_cv_func_snprintf_directive_n="guessing yes";;
+                               # Guess yes on OSF/1 >= 5.
+         osf[3-4]*)            gl_cv_func_snprintf_directive_n="guessing no";;
+         osf*)                 gl_cv_func_snprintf_directive_n="guessing yes";;
+                               # Guess yes on NetBSD >= 3.
+         netbsd[1-2]* | netbsdelf[1-2]* | netbsdaout[1-2]* | netbsdcoff[1-2]*)
+                               gl_cv_func_snprintf_directive_n="guessing no";;
+         netbsd*)              gl_cv_func_snprintf_directive_n="guessing yes";;
+                               # Guess yes on BeOS.
+         beos*)                gl_cv_func_snprintf_directive_n="guessing yes";;
+                               # If we don't know, assume the worst.
+         *)                    gl_cv_func_snprintf_directive_n="guessing no";;
+       esac
+changequote([,])dnl
+      ])
+    ])
+])
+
+dnl Test whether the snprintf function, when passed a size = 1, writes any
+dnl output without bounds in this case, behaving like sprintf. This is the
+dnl case on Linux libc5.
+dnl Result is gl_cv_func_snprintf_size1.
+
+AC_DEFUN([gl_SNPRINTF_SIZE1],
+[
+  AC_REQUIRE([AC_PROG_CC])
+  AC_CACHE_CHECK([whether snprintf respects a size of 1],
+    [gl_cv_func_snprintf_size1],
+    [
+      AC_TRY_RUN([
+#include <stdio.h>
+int main()
+{
+  static char buf[8] = { 'D', 'E', 'A', 'D', 'B', 'E', 'E', 'F' };
+  snprintf (buf, 1, "%d", 12345);
+  return buf[1] != 'E';
+}],
+      [gl_cv_func_snprintf_size1=yes],
+      [gl_cv_func_snprintf_size1=no],
+      [gl_cv_func_snprintf_size1="guessing yes"])
+    ])
+])
+
+dnl Test whether the vsnprintf function, when passed a zero size, produces no
+dnl output. (ISO C99, POSIX:2001)
+dnl For example, snprintf nevertheless writes a NUL byte in this case
+dnl on OSF/1 5.1:
+dnl     ---------------------------------------------------------------------
+dnl     #include <stdio.h>
+dnl     int main()
+dnl     {
+dnl       static char buf[8] = { 'D', 'E', 'A', 'D', 'B', 'E', 'E', 'F' };
+dnl       snprintf (buf, 0, "%d", 12345);
+dnl       return buf[0] != 'D';
+dnl     }
+dnl     ---------------------------------------------------------------------
+dnl And vsnprintf writes any output without bounds in this case, behaving like
+dnl vsprintf, on HP-UX 11 and OSF/1 5.1:
+dnl     ---------------------------------------------------------------------
+dnl     #include <stdarg.h>
+dnl     #include <stdio.h>
+dnl     static int my_snprintf (char *buf, int size, const char *format, ...)
+dnl     {
+dnl       va_list args;
+dnl       int ret;
+dnl       va_start (args, format);
+dnl       ret = vsnprintf (buf, size, format, args);
+dnl       va_end (args);
+dnl       return ret;
+dnl     }
+dnl     int main()
+dnl     {
+dnl       static char buf[8] = { 'D', 'E', 'A', 'D', 'B', 'E', 'E', 'F' };
+dnl       my_snprintf (buf, 0, "%d", 12345);
+dnl       return buf[0] != 'D';
+dnl     }
+dnl     ---------------------------------------------------------------------
+dnl Result is gl_cv_func_vsnprintf_zerosize_c99.
+
+AC_DEFUN([gl_VSNPRINTF_ZEROSIZE_C99],
+[
+  AC_REQUIRE([AC_PROG_CC])
+  AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+  AC_CACHE_CHECK([whether vsnprintf respects a zero size as in C99],
+    [gl_cv_func_vsnprintf_zerosize_c99],
+    [
+      AC_TRY_RUN([
+#include <stdarg.h>
+#include <stdio.h>
+static int my_snprintf (char *buf, int size, const char *format, ...)
+{
+  va_list args;
+  int ret;
+  va_start (args, format);
+  ret = vsnprintf (buf, size, format, args);
+  va_end (args);
+  return ret;
+}
+int main()
+{
+  static char buf[8] = { 'D', 'E', 'A', 'D', 'B', 'E', 'E', 'F' };
+  my_snprintf (buf, 0, "%d", 12345);
+  return buf[0] != 'D';
+}],
+      [gl_cv_func_vsnprintf_zerosize_c99=yes],
+      [gl_cv_func_vsnprintf_zerosize_c99=no],
+      [
+changequote(,)dnl
+       case "$host_os" in
+                               # Guess yes on glibc systems.
+         *-gnu*)               gl_cv_func_vsnprintf_zerosize_c99="guessing yes";;
+                               # Guess yes on FreeBSD >= 5.
+         freebsd[1-4]*)        gl_cv_func_vsnprintf_zerosize_c99="guessing no";;
+         freebsd* | kfreebsd*) gl_cv_func_vsnprintf_zerosize_c99="guessing yes";;
+                               # Guess yes on MacOS X >= 10.3.
+         darwin[1-6].*)        gl_cv_func_vsnprintf_zerosize_c99="guessing no";;
+         darwin*)              gl_cv_func_vsnprintf_zerosize_c99="guessing yes";;
+                               # Guess yes on Cygwin.
+         cygwin*)              gl_cv_func_vsnprintf_zerosize_c99="guessing yes";;
+                               # Guess yes on Solaris >= 2.6.
+         solaris2.[0-5]*)      gl_cv_func_vsnprintf_zerosize_c99="guessing no";;
+         solaris*)             gl_cv_func_vsnprintf_zerosize_c99="guessing yes";;
+                               # Guess yes on AIX >= 4.
+         aix[1-3]*)            gl_cv_func_vsnprintf_zerosize_c99="guessing no";;
+         aix*)                 gl_cv_func_vsnprintf_zerosize_c99="guessing yes";;
+                               # Guess yes on IRIX >= 6.5.
+         irix6.5)              gl_cv_func_vsnprintf_zerosize_c99="guessing yes";;
+                               # Guess yes on NetBSD >= 3.
+         netbsd[1-2]* | netbsdelf[1-2]* | netbsdaout[1-2]* | netbsdcoff[1-2]*)
+                               gl_cv_func_vsnprintf_zerosize_c99="guessing no";;
+         netbsd*)              gl_cv_func_vsnprintf_zerosize_c99="guessing yes";;
+                               # Guess yes on BeOS.
+         beos*)                gl_cv_func_vsnprintf_zerosize_c99="guessing yes";;
+                               # Guess yes on mingw.
+         mingw* | pw*)         gl_cv_func_vsnprintf_zerosize_c99="guessing yes";;
+                               # If we don't know, assume the worst.
+         *)                    gl_cv_func_vsnprintf_zerosize_c99="guessing no";;
+       esac
+changequote([,])dnl
+      ])
+    ])
+])
+
+dnl The results of these tests on various platforms are:
+dnl
+dnl 1 = gl_PRINTF_SIZES_C99
+dnl 2 = gl_PRINTF_LONG_DOUBLE
+dnl 3 = gl_PRINTF_INFINITE
+dnl 4 = gl_PRINTF_INFINITE_LONG_DOUBLE
+dnl 5 = gl_PRINTF_DIRECTIVE_A
+dnl 6 = gl_PRINTF_DIRECTIVE_F
+dnl 7 = gl_PRINTF_DIRECTIVE_N
+dnl 8 = gl_PRINTF_DIRECTIVE_LS
+dnl 9 = gl_PRINTF_POSITIONS
+dnl 10 = gl_PRINTF_FLAG_GROUPING
+dnl 11 = gl_PRINTF_FLAG_LEFTADJUST
+dnl 12 = gl_PRINTF_FLAG_ZERO
+dnl 13 = gl_PRINTF_PRECISION
+dnl 14 = gl_PRINTF_ENOMEM
+dnl 15 = gl_SNPRINTF_PRESENCE
+dnl 16 = gl_SNPRINTF_TRUNCATION_C99
+dnl 17 = gl_SNPRINTF_RETVAL_C99
+dnl 18 = gl_SNPRINTF_DIRECTIVE_N
+dnl 19 = gl_SNPRINTF_SIZE1
+dnl 20 = gl_VSNPRINTF_ZEROSIZE_C99
+dnl
+dnl 1 = checking whether printf supports size specifiers as in C99...
+dnl 2 = checking whether printf supports 'long double' arguments...
+dnl 3 = checking whether printf supports infinite 'double' arguments...
+dnl 4 = checking whether printf supports infinite 'long double' arguments...
+dnl 5 = checking whether printf supports the 'a' and 'A' directives...
+dnl 6 = checking whether printf supports the 'F' directive...
+dnl 7 = checking whether printf supports the 'n' directive...
+dnl 8 = checking whether printf supports the 'ls' directive...
+dnl 9 = checking whether printf supports POSIX/XSI format strings with positions...
+dnl 10 = checking whether printf supports the grouping flag...
+dnl 11 = checking whether printf supports the left-adjust flag correctly...
+dnl 12 = checking whether printf supports the zero flag correctly...
+dnl 13 = checking whether printf supports large precisions...
+dnl 14 = checking whether printf survives out-of-memory conditions...
+dnl 15 = checking for snprintf...
+dnl 16 = checking whether snprintf truncates the result as in C99...
+dnl 17 = checking whether snprintf returns a byte count as in C99...
+dnl 18 = checking whether snprintf fully supports the 'n' directive...
+dnl 19 = checking whether snprintf respects a size of 1...
+dnl 20 = checking whether vsnprintf respects a zero size as in C99...
+dnl
+dnl . = yes, # = no.
+dnl
+dnl                                  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20
+dnl   glibc 2.5                      .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .
+dnl   glibc 2.3.6                    .  .  .  .  #  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .
+dnl   FreeBSD 5.4, 6.1               .  .  .  .  #  .  .  .  .  .  .  #  .  #  .  .  .  .  .  .
+dnl   MacOS X 10.3.9                 .  .  .  .  #  .  .  .  .  .  .  #  .  #  .  .  .  .  .  .
+dnl   OpenBSD 3.9, 4.0               .  .  #  #  #  #  .  #  .  #  .  #  .  #  .  .  .  .  .  .
+dnl   Cygwin 1.7.0 (2009)            .  .  .  #  .  .  .  ?  .  .  .  .  .  ?  .  .  .  .  .  .
+dnl   Cygwin 1.5.25 (2008)           .  .  .  #  #  .  .  #  .  .  .  .  .  #  .  .  .  .  .  .
+dnl   Cygwin 1.5.19 (2006)           #  .  .  #  #  #  .  #  .  #  .  #  #  #  .  .  .  .  .  .
+dnl   Solaris 10                     .  .  #  #  #  .  .  #  .  .  .  #  .  .  .  .  .  .  .  .
+dnl   Solaris 2.6 ... 9              #  .  #  #  #  #  .  #  .  .  .  #  .  .  .  .  .  .  .  .
+dnl   Solaris 2.5.1                  #  .  #  #  #  #  .  #  .  .  .  #  .  .  #  #  #  #  #  #
+dnl   AIX 5.2                        .  .  #  #  #  .  .  .  .  .  .  #  .  .  .  .  .  .  .  .
+dnl   AIX 4.3.2, 5.1                 #  .  #  #  #  #  .  .  .  .  .  #  .  .  .  .  .  .  .  .
+dnl   HP-UX 11.31                    .  .  .  .  #  .  .  .  .  .  .  #  .  .  .  .  #  #  .  .
+dnl   HP-UX 11.{00,11,23}            #  .  .  .  #  #  .  .  .  .  .  #  .  .  .  .  #  #  .  #
+dnl   HP-UX 10.20                    #  .  #  .  #  #  .  ?  .  .  #  #  .  .  .  .  #  #  ?  #
+dnl   IRIX 6.5                       #  .  #  #  #  #  .  #  .  .  .  #  .  .  .  .  #  .  .  .
+dnl   OSF/1 5.1                      #  .  #  #  #  #  .  .  .  .  .  #  .  .  .  .  #  .  .  #
+dnl   OSF/1 4.0d                     #  .  #  #  #  #  .  .  .  .  .  #  .  .  #  #  #  #  #  #
+dnl   NetBSD 4.0                     .  ?  ?  ?  ?  ?  .  ?  .  ?  ?  ?  ?  ?  .  .  .  ?  ?  ?
+dnl   NetBSD 3.0                     .  .  .  .  #  #  .  ?  #  #  ?  #  .  #  .  .  .  .  .  .
+dnl   Haiku                          .  .  .  #  #  #  .  #  .  .  .  .  .  ?  .  .  .  .  .  .
+dnl   BeOS                           #  #  .  #  #  #  .  ?  #  .  ?  .  #  ?  .  .  .  .  .  .
+dnl   mingw                          #  #  #  #  #  #  .  .  #  #  .  #  #  ?  .  #  #  #  .  .
diff --git a/m4/putenv.m4 b/m4/putenv.m4
new file mode 100644
index 000000000..120f5a4a5
--- /dev/null
+++ b/m4/putenv.m4
@@ -0,0 +1,41 @@
+# putenv.m4 serial 16
+dnl Copyright (C) 2002-2009 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+dnl From Jim Meyering.
+dnl
+dnl Check whether putenv ("FOO") removes FOO from the environment.
+dnl The putenv in libc on at least SunOS 4.1.4 does *not* do that.
+
+AC_DEFUN([gl_FUNC_PUTENV],
+[
+  AC_REQUIRE([gl_STDLIB_H_DEFAULTS])
+  AC_CACHE_CHECK([for putenv compatible with GNU and SVID],
+   [gl_cv_func_svid_putenv],
+   [AC_RUN_IFELSE([AC_LANG_PROGRAM([AC_INCLUDES_DEFAULT],[[
+    /* Put it in env.  */
+    if (putenv ("CONFTEST_putenv=val"))
+      return 1;
+
+    /* Try to remove it.  */
+    if (putenv ("CONFTEST_putenv"))
+      return 1;
+
+    /* Make sure it was deleted.  */
+    if (getenv ("CONFTEST_putenv") != 0)
+      return 1;
+
+    return 0;
+	      ]])],
+	     gl_cv_func_svid_putenv=yes,
+	     gl_cv_func_svid_putenv=no,
+	     dnl When crosscompiling, assume putenv is broken.
+	     gl_cv_func_svid_putenv=no)
+   ])
+  if test $gl_cv_func_svid_putenv = no; then
+    REPLACE_PUTENV=1
+    AC_LIBOBJ([putenv])
+  fi
+])
diff --git a/m4/readlink.m4 b/m4/readlink.m4
new file mode 100644
index 000000000..ff3f1f587
--- /dev/null
+++ b/m4/readlink.m4
@@ -0,0 +1,29 @@
+# readlink.m4 serial 5
+dnl Copyright (C) 2003, 2007, 2009 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN([gl_FUNC_READLINK],
+[
+  AC_REQUIRE([gl_UNISTD_H_DEFAULTS])
+  AC_CHECK_FUNCS_ONCE([readlink])
+  if test $ac_cv_func_readlink = no; then
+    HAVE_READLINK=0
+    AC_LIBOBJ([readlink])
+    gl_PREREQ_READLINK
+  fi
+])
+
+# Like gl_FUNC_READLINK, except prepare for separate compilation (no AC_LIBOBJ).
+AC_DEFUN([gl_FUNC_READLINK_SEPARATE],
+[
+  AC_CHECK_FUNCS_ONCE([readlink])
+  gl_PREREQ_READLINK
+])
+
+# Prerequisites of lib/readlink.c.
+AC_DEFUN([gl_PREREQ_READLINK],
+[
+  :
+])
diff --git a/m4/size_max.m4 b/m4/size_max.m4
new file mode 100644
index 000000000..35bd3d6ae
--- /dev/null
+++ b/m4/size_max.m4
@@ -0,0 +1,75 @@
+# size_max.m4 serial 9
+dnl Copyright (C) 2003, 2005-2006, 2008-2009 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+dnl From Bruno Haible.
+
+AC_DEFUN([gl_SIZE_MAX],
+[
+  AC_CHECK_HEADERS([stdint.h])
+  dnl First test whether the system already has SIZE_MAX.
+  AC_CACHE_CHECK([for SIZE_MAX], [gl_cv_size_max], [
+    gl_cv_size_max=
+    AC_EGREP_CPP([Found it], [
+#include <limits.h>
+#if HAVE_STDINT_H
+#include <stdint.h>
+#endif
+#ifdef SIZE_MAX
+Found it
+#endif
+], [gl_cv_size_max=yes])
+    if test -z "$gl_cv_size_max"; then
+      dnl Define it ourselves. Here we assume that the type 'size_t' is not wider
+      dnl than the type 'unsigned long'. Try hard to find a definition that can
+      dnl be used in a preprocessor #if, i.e. doesn't contain a cast.
+      AC_COMPUTE_INT([size_t_bits_minus_1], [sizeof (size_t) * CHAR_BIT - 1],
+        [#include <stddef.h>
+#include <limits.h>], [size_t_bits_minus_1=])
+      AC_COMPUTE_INT([fits_in_uint], [sizeof (size_t) <= sizeof (unsigned int)],
+        [#include <stddef.h>], [fits_in_uint=])
+      if test -n "$size_t_bits_minus_1" && test -n "$fits_in_uint"; then
+        if test $fits_in_uint = 1; then
+          dnl Even though SIZE_MAX fits in an unsigned int, it must be of type
+          dnl 'unsigned long' if the type 'size_t' is the same as 'unsigned long'.
+          AC_TRY_COMPILE([#include <stddef.h>
+            extern size_t foo;
+            extern unsigned long foo;
+            ], [], [fits_in_uint=0])
+        fi
+        dnl We cannot use 'expr' to simplify this expression, because 'expr'
+        dnl works only with 'long' integers in the host environment, while we
+        dnl might be cross-compiling from a 32-bit platform to a 64-bit platform.
+        if test $fits_in_uint = 1; then
+          gl_cv_size_max="(((1U << $size_t_bits_minus_1) - 1) * 2 + 1)"
+        else
+          gl_cv_size_max="(((1UL << $size_t_bits_minus_1) - 1) * 2 + 1)"
+        fi
+      else
+        dnl Shouldn't happen, but who knows...
+        gl_cv_size_max='((size_t)~(size_t)0)'
+      fi
+    fi
+  ])
+  if test "$gl_cv_size_max" != yes; then
+    AC_DEFINE_UNQUOTED([SIZE_MAX], [$gl_cv_size_max],
+      [Define as the maximum value of type 'size_t', if the system doesn't define it.])
+  fi
+  dnl Don't redefine SIZE_MAX in config.h if config.h is re-included after
+  dnl <stdint.h>. Remember that the #undef in AH_VERBATIM gets replaced with
+  dnl #define by AC_DEFINE_UNQUOTED.
+  AH_VERBATIM([SIZE_MAX],
+[/* Define as the maximum value of type 'size_t', if the system doesn't define
+   it. */
+#ifndef SIZE_MAX
+# undef SIZE_MAX
+#endif])
+])
+
+dnl Autoconf >= 2.61 has AC_COMPUTE_INT built-in.
+dnl Remove this when we can assume autoconf >= 2.61.
+m4_ifdef([AC_COMPUTE_INT], [], [
+  AC_DEFUN([AC_COMPUTE_INT], [_AC_COMPUTE_INT([$2],[$1],[$3],[$4])])
+])
diff --git a/m4/stdbool.m4 b/m4/stdbool.m4
index 2204ecd98..57c804a80 100644
--- a/m4/stdbool.m4
+++ b/m4/stdbool.m4
@@ -1,6 +1,6 @@
 # Check for stdbool.h that conforms to C99.
 
-dnl Copyright (C) 2002-2006 Free Software Foundation, Inc.
+dnl Copyright (C) 2002-2006, 2009 Free Software Foundation, Inc.
 dnl This file is free software; the Free Software Foundation
 dnl gives unlimited permission to copy and/or distribute it,
 dnl with or without modifications, as long as this notice is preserved.
@@ -111,5 +111,5 @@ AC_DEFUN([AC_HEADER_STDBOOL],
 	[ac_cv_header_stdbool_h=no])])
    AC_CHECK_TYPES([_Bool])
    if test $ac_cv_header_stdbool_h = yes; then
-     AC_DEFINE(HAVE_STDBOOL_H, 1, [Define to 1 if stdbool.h conforms to C99.])
+     AC_DEFINE([HAVE_STDBOOL_H], [1], [Define to 1 if stdbool.h conforms to C99.])
    fi])
diff --git a/m4/stdint.m4 b/m4/stdint.m4
new file mode 100644
index 000000000..a2e8bdd62
--- /dev/null
+++ b/m4/stdint.m4
@@ -0,0 +1,472 @@
+# stdint.m4 serial 34
+dnl Copyright (C) 2001-2009 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+dnl From Paul Eggert and Bruno Haible.
+dnl Test whether <stdint.h> is supported or must be substituted.
+
+AC_DEFUN([gl_STDINT_H],
+[
+  AC_PREREQ([2.59])dnl
+
+  dnl Check for long long int and unsigned long long int.
+  AC_REQUIRE([AC_TYPE_LONG_LONG_INT])
+  if test $ac_cv_type_long_long_int = yes; then
+    HAVE_LONG_LONG_INT=1
+  else
+    HAVE_LONG_LONG_INT=0
+  fi
+  AC_SUBST([HAVE_LONG_LONG_INT])
+  AC_REQUIRE([AC_TYPE_UNSIGNED_LONG_LONG_INT])
+  if test $ac_cv_type_unsigned_long_long_int = yes; then
+    HAVE_UNSIGNED_LONG_LONG_INT=1
+  else
+    HAVE_UNSIGNED_LONG_LONG_INT=0
+  fi
+  AC_SUBST([HAVE_UNSIGNED_LONG_LONG_INT])
+
+  dnl Check for <inttypes.h>.
+  dnl AC_INCLUDES_DEFAULT defines $ac_cv_header_inttypes_h.
+  if test $ac_cv_header_inttypes_h = yes; then
+    HAVE_INTTYPES_H=1
+  else
+    HAVE_INTTYPES_H=0
+  fi
+  AC_SUBST([HAVE_INTTYPES_H])
+
+  dnl Check for <sys/types.h>.
+  dnl AC_INCLUDES_DEFAULT defines $ac_cv_header_sys_types_h.
+  if test $ac_cv_header_sys_types_h = yes; then
+    HAVE_SYS_TYPES_H=1
+  else
+    HAVE_SYS_TYPES_H=0
+  fi
+  AC_SUBST([HAVE_SYS_TYPES_H])
+
+  gl_CHECK_NEXT_HEADERS([stdint.h])
+  if test $ac_cv_header_stdint_h = yes; then
+    HAVE_STDINT_H=1
+  else
+    HAVE_STDINT_H=0
+  fi
+  AC_SUBST([HAVE_STDINT_H])
+
+  dnl Now see whether we need a substitute <stdint.h>.
+  if test $ac_cv_header_stdint_h = yes; then
+    AC_CACHE_CHECK([whether stdint.h conforms to C99],
+      [gl_cv_header_working_stdint_h],
+      [gl_cv_header_working_stdint_h=no
+       AC_COMPILE_IFELSE([
+         AC_LANG_PROGRAM([[
+#define __STDC_LIMIT_MACROS 1 /* to make it work also in C++ mode */
+#define __STDC_CONSTANT_MACROS 1 /* to make it work also in C++ mode */
+#define _GL_JUST_INCLUDE_SYSTEM_STDINT_H 1 /* work if build isn't clean */
+#include <stdint.h>
+/* Dragonfly defines WCHAR_MIN, WCHAR_MAX only in <wchar.h>.  */
+#if !(defined WCHAR_MIN && defined WCHAR_MAX)
+#error "WCHAR_MIN, WCHAR_MAX not defined in <stdint.h>"
+#endif
+]
+gl_STDINT_INCLUDES
+[
+#ifdef INT8_MAX
+int8_t a1 = INT8_MAX;
+int8_t a1min = INT8_MIN;
+#endif
+#ifdef INT16_MAX
+int16_t a2 = INT16_MAX;
+int16_t a2min = INT16_MIN;
+#endif
+#ifdef INT32_MAX
+int32_t a3 = INT32_MAX;
+int32_t a3min = INT32_MIN;
+#endif
+#ifdef INT64_MAX
+int64_t a4 = INT64_MAX;
+int64_t a4min = INT64_MIN;
+#endif
+#ifdef UINT8_MAX
+uint8_t b1 = UINT8_MAX;
+#else
+typedef int b1[(unsigned char) -1 != 255 ? 1 : -1];
+#endif
+#ifdef UINT16_MAX
+uint16_t b2 = UINT16_MAX;
+#endif
+#ifdef UINT32_MAX
+uint32_t b3 = UINT32_MAX;
+#endif
+#ifdef UINT64_MAX
+uint64_t b4 = UINT64_MAX;
+#endif
+int_least8_t c1 = INT8_C (0x7f);
+int_least8_t c1max = INT_LEAST8_MAX;
+int_least8_t c1min = INT_LEAST8_MIN;
+int_least16_t c2 = INT16_C (0x7fff);
+int_least16_t c2max = INT_LEAST16_MAX;
+int_least16_t c2min = INT_LEAST16_MIN;
+int_least32_t c3 = INT32_C (0x7fffffff);
+int_least32_t c3max = INT_LEAST32_MAX;
+int_least32_t c3min = INT_LEAST32_MIN;
+int_least64_t c4 = INT64_C (0x7fffffffffffffff);
+int_least64_t c4max = INT_LEAST64_MAX;
+int_least64_t c4min = INT_LEAST64_MIN;
+uint_least8_t d1 = UINT8_C (0xff);
+uint_least8_t d1max = UINT_LEAST8_MAX;
+uint_least16_t d2 = UINT16_C (0xffff);
+uint_least16_t d2max = UINT_LEAST16_MAX;
+uint_least32_t d3 = UINT32_C (0xffffffff);
+uint_least32_t d3max = UINT_LEAST32_MAX;
+uint_least64_t d4 = UINT64_C (0xffffffffffffffff);
+uint_least64_t d4max = UINT_LEAST64_MAX;
+int_fast8_t e1 = INT_FAST8_MAX;
+int_fast8_t e1min = INT_FAST8_MIN;
+int_fast16_t e2 = INT_FAST16_MAX;
+int_fast16_t e2min = INT_FAST16_MIN;
+int_fast32_t e3 = INT_FAST32_MAX;
+int_fast32_t e3min = INT_FAST32_MIN;
+int_fast64_t e4 = INT_FAST64_MAX;
+int_fast64_t e4min = INT_FAST64_MIN;
+uint_fast8_t f1 = UINT_FAST8_MAX;
+uint_fast16_t f2 = UINT_FAST16_MAX;
+uint_fast32_t f3 = UINT_FAST32_MAX;
+uint_fast64_t f4 = UINT_FAST64_MAX;
+#ifdef INTPTR_MAX
+intptr_t g = INTPTR_MAX;
+intptr_t gmin = INTPTR_MIN;
+#endif
+#ifdef UINTPTR_MAX
+uintptr_t h = UINTPTR_MAX;
+#endif
+intmax_t i = INTMAX_MAX;
+uintmax_t j = UINTMAX_MAX;
+
+#include <limits.h> /* for CHAR_BIT */
+#define TYPE_MINIMUM(t) \
+  ((t) ((t) 0 < (t) -1 ? (t) 0 : ~ (t) 0 << (sizeof (t) * CHAR_BIT - 1)))
+#define TYPE_MAXIMUM(t) \
+  ((t) ((t) 0 < (t) -1 ? (t) -1 : ~ (~ (t) 0 << (sizeof (t) * CHAR_BIT - 1))))
+struct s {
+  int check_PTRDIFF:
+      PTRDIFF_MIN == TYPE_MINIMUM (ptrdiff_t)
+      && PTRDIFF_MAX == TYPE_MAXIMUM (ptrdiff_t)
+      ? 1 : -1;
+  /* Detect bug in FreeBSD 6.0 / ia64.  */
+  int check_SIG_ATOMIC:
+      SIG_ATOMIC_MIN == TYPE_MINIMUM (sig_atomic_t)
+      && SIG_ATOMIC_MAX == TYPE_MAXIMUM (sig_atomic_t)
+      ? 1 : -1;
+  int check_SIZE: SIZE_MAX == TYPE_MAXIMUM (size_t) ? 1 : -1;
+  int check_WCHAR:
+      WCHAR_MIN == TYPE_MINIMUM (wchar_t)
+      && WCHAR_MAX == TYPE_MAXIMUM (wchar_t)
+      ? 1 : -1;
+  /* Detect bug in mingw.  */
+  int check_WINT:
+      WINT_MIN == TYPE_MINIMUM (wint_t)
+      && WINT_MAX == TYPE_MAXIMUM (wint_t)
+      ? 1 : -1;
+
+  /* Detect bugs in glibc 2.4 and Solaris 10 stdint.h, among others.  */
+  int check_UINT8_C:
+        (-1 < UINT8_C (0)) == (-1 < (uint_least8_t) 0) ? 1 : -1;
+  int check_UINT16_C:
+        (-1 < UINT16_C (0)) == (-1 < (uint_least16_t) 0) ? 1 : -1;
+
+  /* Detect bugs in OpenBSD 3.9 stdint.h.  */
+#ifdef UINT8_MAX
+  int check_uint8: (uint8_t) -1 == UINT8_MAX ? 1 : -1;
+#endif
+#ifdef UINT16_MAX
+  int check_uint16: (uint16_t) -1 == UINT16_MAX ? 1 : -1;
+#endif
+#ifdef UINT32_MAX
+  int check_uint32: (uint32_t) -1 == UINT32_MAX ? 1 : -1;
+#endif
+#ifdef UINT64_MAX
+  int check_uint64: (uint64_t) -1 == UINT64_MAX ? 1 : -1;
+#endif
+  int check_uint_least8: (uint_least8_t) -1 == UINT_LEAST8_MAX ? 1 : -1;
+  int check_uint_least16: (uint_least16_t) -1 == UINT_LEAST16_MAX ? 1 : -1;
+  int check_uint_least32: (uint_least32_t) -1 == UINT_LEAST32_MAX ? 1 : -1;
+  int check_uint_least64: (uint_least64_t) -1 == UINT_LEAST64_MAX ? 1 : -1;
+  int check_uint_fast8: (uint_fast8_t) -1 == UINT_FAST8_MAX ? 1 : -1;
+  int check_uint_fast16: (uint_fast16_t) -1 == UINT_FAST16_MAX ? 1 : -1;
+  int check_uint_fast32: (uint_fast32_t) -1 == UINT_FAST32_MAX ? 1 : -1;
+  int check_uint_fast64: (uint_fast64_t) -1 == UINT_FAST64_MAX ? 1 : -1;
+  int check_uintptr: (uintptr_t) -1 == UINTPTR_MAX ? 1 : -1;
+  int check_uintmax: (uintmax_t) -1 == UINTMAX_MAX ? 1 : -1;
+  int check_size: (size_t) -1 == SIZE_MAX ? 1 : -1;
+};
+         ]])],
+         [dnl Determine whether the various *_MIN, *_MAX macros are usable
+          dnl in preprocessor expression. We could do it by compiling a test
+          dnl program for each of these macros. It is faster to run a program
+          dnl that inspects the macro expansion.
+          dnl This detects a bug on HP-UX 11.23/ia64.
+          AC_RUN_IFELSE([
+            AC_LANG_PROGRAM([[
+#define __STDC_LIMIT_MACROS 1 /* to make it work also in C++ mode */
+#define __STDC_CONSTANT_MACROS 1 /* to make it work also in C++ mode */
+#define _GL_JUST_INCLUDE_SYSTEM_STDINT_H 1 /* work if build isn't clean */
+#include <stdint.h>
+]
+gl_STDINT_INCLUDES
+[
+#include <stdio.h>
+#include <string.h>
+#define MVAL(macro) MVAL1(macro)
+#define MVAL1(expression) #expression
+static const char *macro_values[] =
+  {
+#ifdef INT8_MAX
+    MVAL (INT8_MAX),
+#endif
+#ifdef INT16_MAX
+    MVAL (INT16_MAX),
+#endif
+#ifdef INT32_MAX
+    MVAL (INT32_MAX),
+#endif
+#ifdef INT64_MAX
+    MVAL (INT64_MAX),
+#endif
+#ifdef UINT8_MAX
+    MVAL (UINT8_MAX),
+#endif
+#ifdef UINT16_MAX
+    MVAL (UINT16_MAX),
+#endif
+#ifdef UINT32_MAX
+    MVAL (UINT32_MAX),
+#endif
+#ifdef UINT64_MAX
+    MVAL (UINT64_MAX),
+#endif
+    NULL
+  };
+]], [[
+  const char **mv;
+  for (mv = macro_values; *mv != NULL; mv++)
+    {
+      const char *value = *mv;
+      /* Test whether it looks like a cast expression.  */
+      if (strncmp (value, "((unsigned int)"/*)*/, 15) == 0
+          || strncmp (value, "((unsigned short)"/*)*/, 17) == 0
+          || strncmp (value, "((unsigned char)"/*)*/, 16) == 0
+          || strncmp (value, "((int)"/*)*/, 6) == 0
+          || strncmp (value, "((signed short)"/*)*/, 15) == 0
+          || strncmp (value, "((signed char)"/*)*/, 14) == 0)
+        return 1;
+    }
+  return 0;
+]])],
+              [gl_cv_header_working_stdint_h=yes],
+              [],
+              [dnl When cross-compiling, assume it works.
+               gl_cv_header_working_stdint_h=yes
+              ])
+         ])
+      ])
+  fi
+  if test "$gl_cv_header_working_stdint_h" = yes; then
+    STDINT_H=
+  else
+    dnl Check for <sys/inttypes.h>, and for
+    dnl <sys/bitypes.h> (used in Linux libc4 >= 4.6.7 and libc5).
+    AC_CHECK_HEADERS([sys/inttypes.h sys/bitypes.h])
+    if test $ac_cv_header_sys_inttypes_h = yes; then
+      HAVE_SYS_INTTYPES_H=1
+    else
+      HAVE_SYS_INTTYPES_H=0
+    fi
+    AC_SUBST([HAVE_SYS_INTTYPES_H])
+    if test $ac_cv_header_sys_bitypes_h = yes; then
+      HAVE_SYS_BITYPES_H=1
+    else
+      HAVE_SYS_BITYPES_H=0
+    fi
+    AC_SUBST([HAVE_SYS_BITYPES_H])
+
+    dnl Check for <wchar.h> (missing in Linux uClibc when built without wide
+    dnl character support).
+    AC_CHECK_HEADERS_ONCE([wchar.h])
+
+    gl_STDINT_TYPE_PROPERTIES
+    STDINT_H=stdint.h
+  fi
+  AC_SUBST([STDINT_H])
+])
+
+dnl gl_STDINT_BITSIZEOF(TYPES, INCLUDES)
+dnl Determine the size of each of the given types in bits.
+AC_DEFUN([gl_STDINT_BITSIZEOF],
+[
+  dnl Use a shell loop, to avoid bloating configure, and
+  dnl - extra AH_TEMPLATE calls, so that autoheader knows what to put into
+  dnl   config.h.in,
+  dnl - extra AC_SUBST calls, so that the right substitutions are made.
+  m4_foreach_w([gltype], [$1],
+    [AH_TEMPLATE([BITSIZEOF_]translit(gltype,[abcdefghijklmnopqrstuvwxyz ],[ABCDEFGHIJKLMNOPQRSTUVWXYZ_]),
+       [Define to the number of bits in type ']gltype['.])])
+  for gltype in $1 ; do
+    AC_CACHE_CHECK([for bit size of $gltype], [gl_cv_bitsizeof_${gltype}],
+      [AC_COMPUTE_INT([result], [sizeof ($gltype) * CHAR_BIT],
+         [$2
+#include <limits.h>], [result=unknown])
+       eval gl_cv_bitsizeof_${gltype}=\$result
+      ])
+    eval result=\$gl_cv_bitsizeof_${gltype}
+    if test $result = unknown; then
+      dnl Use a nonempty default, because some compilers, such as IRIX 5 cc,
+      dnl do a syntax check even on unused #if conditions and give an error
+      dnl on valid C code like this:
+      dnl   #if 0
+      dnl   # if  > 32
+      dnl   # endif
+      dnl   #endif
+      result=0
+    fi
+    GLTYPE=`echo "$gltype" | tr 'abcdefghijklmnopqrstuvwxyz ' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ_'`
+    AC_DEFINE_UNQUOTED([BITSIZEOF_${GLTYPE}], [$result])
+    eval BITSIZEOF_${GLTYPE}=\$result
+  done
+  m4_foreach_w([gltype], [$1],
+    [AC_SUBST([BITSIZEOF_]translit(gltype,[abcdefghijklmnopqrstuvwxyz ],[ABCDEFGHIJKLMNOPQRSTUVWXYZ_]))])
+])
+
+dnl gl_CHECK_TYPES_SIGNED(TYPES, INCLUDES)
+dnl Determine the signedness of each of the given types.
+dnl Define HAVE_SIGNED_TYPE if type is signed.
+AC_DEFUN([gl_CHECK_TYPES_SIGNED],
+[
+  dnl Use a shell loop, to avoid bloating configure, and
+  dnl - extra AH_TEMPLATE calls, so that autoheader knows what to put into
+  dnl   config.h.in,
+  dnl - extra AC_SUBST calls, so that the right substitutions are made.
+  m4_foreach_w([gltype], [$1],
+    [AH_TEMPLATE([HAVE_SIGNED_]translit(gltype,[abcdefghijklmnopqrstuvwxyz ],[ABCDEFGHIJKLMNOPQRSTUVWXYZ_]),
+       [Define to 1 if ']gltype[' is a signed integer type.])])
+  for gltype in $1 ; do
+    AC_CACHE_CHECK([whether $gltype is signed], [gl_cv_type_${gltype}_signed],
+      [AC_COMPILE_IFELSE(
+         [AC_LANG_PROGRAM([$2[
+            int verify[2 * (($gltype) -1 < ($gltype) 0) - 1];]])],
+         result=yes, result=no)
+       eval gl_cv_type_${gltype}_signed=\$result
+      ])
+    eval result=\$gl_cv_type_${gltype}_signed
+    GLTYPE=`echo $gltype | tr 'abcdefghijklmnopqrstuvwxyz ' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ_'`
+    if test "$result" = yes; then
+      AC_DEFINE_UNQUOTED([HAVE_SIGNED_${GLTYPE}], [1])
+      eval HAVE_SIGNED_${GLTYPE}=1
+    else
+      eval HAVE_SIGNED_${GLTYPE}=0
+    fi
+  done
+  m4_foreach_w([gltype], [$1],
+    [AC_SUBST([HAVE_SIGNED_]translit(gltype,[abcdefghijklmnopqrstuvwxyz ],[ABCDEFGHIJKLMNOPQRSTUVWXYZ_]))])
+])
+
+dnl gl_INTEGER_TYPE_SUFFIX(TYPES, INCLUDES)
+dnl Determine the suffix to use for integer constants of the given types.
+dnl Define t_SUFFIX for each such type.
+AC_DEFUN([gl_INTEGER_TYPE_SUFFIX],
+[
+  dnl Use a shell loop, to avoid bloating configure, and
+  dnl - extra AH_TEMPLATE calls, so that autoheader knows what to put into
+  dnl   config.h.in,
+  dnl - extra AC_SUBST calls, so that the right substitutions are made.
+  m4_foreach_w([gltype], [$1],
+    [AH_TEMPLATE(translit(gltype,[abcdefghijklmnopqrstuvwxyz ],[ABCDEFGHIJKLMNOPQRSTUVWXYZ_])[_SUFFIX],
+       [Define to l, ll, u, ul, ull, etc., as suitable for
+        constants of type ']gltype['.])])
+  for gltype in $1 ; do
+    AC_CACHE_CHECK([for $gltype integer literal suffix],
+      [gl_cv_type_${gltype}_suffix],
+      [eval gl_cv_type_${gltype}_suffix=no
+       eval result=\$gl_cv_type_${gltype}_signed
+       if test "$result" = yes; then
+         glsufu=
+       else
+         glsufu=u
+       fi
+       for glsuf in "$glsufu" ${glsufu}l ${glsufu}ll ${glsufu}i64; do
+         case $glsuf in
+           '')  gltype1='int';;
+           l)	gltype1='long int';;
+           ll)	gltype1='long long int';;
+           i64)	gltype1='__int64';;
+           u)	gltype1='unsigned int';;
+           ul)	gltype1='unsigned long int';;
+           ull)	gltype1='unsigned long long int';;
+           ui64)gltype1='unsigned __int64';;
+         esac
+         AC_COMPILE_IFELSE(
+           [AC_LANG_PROGRAM([$2[
+              extern $gltype foo;
+              extern $gltype1 foo;]])],
+           [eval gl_cv_type_${gltype}_suffix=\$glsuf])
+         eval result=\$gl_cv_type_${gltype}_suffix
+         test "$result" != no && break
+       done])
+    GLTYPE=`echo $gltype | tr 'abcdefghijklmnopqrstuvwxyz ' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ_'`
+    eval result=\$gl_cv_type_${gltype}_suffix
+    test "$result" = no && result=
+    eval ${GLTYPE}_SUFFIX=\$result
+    AC_DEFINE_UNQUOTED([${GLTYPE}_SUFFIX], [$result])
+  done
+  m4_foreach_w([gltype], [$1],
+    [AC_SUBST(translit(gltype,[abcdefghijklmnopqrstuvwxyz ],[ABCDEFGHIJKLMNOPQRSTUVWXYZ_])[_SUFFIX])])
+])
+
+dnl gl_STDINT_INCLUDES
+AC_DEFUN([gl_STDINT_INCLUDES],
+[[
+  /* BSD/OS 4.0.1 has a bug: <stddef.h>, <stdio.h> and <time.h> must be
+     included before <wchar.h>.  */
+  #include <stddef.h>
+  #include <signal.h>
+  #if HAVE_WCHAR_H
+  # include <stdio.h>
+  # include <time.h>
+  # include <wchar.h>
+  #endif
+]])
+
+dnl gl_STDINT_TYPE_PROPERTIES
+dnl Compute HAVE_SIGNED_t, BITSIZEOF_t and t_SUFFIX, for all the types t
+dnl of interest to stdint.in.h.
+AC_DEFUN([gl_STDINT_TYPE_PROPERTIES],
+[
+  AC_REQUIRE([gl_MULTIARCH])
+  if test $APPLE_UNIVERSAL_BUILD = 0; then
+    gl_STDINT_BITSIZEOF([ptrdiff_t size_t],
+      [gl_STDINT_INCLUDES])
+  fi
+  gl_STDINT_BITSIZEOF([sig_atomic_t wchar_t wint_t],
+    [gl_STDINT_INCLUDES])
+  gl_CHECK_TYPES_SIGNED([sig_atomic_t wchar_t wint_t],
+    [gl_STDINT_INCLUDES])
+  gl_cv_type_ptrdiff_t_signed=yes
+  gl_cv_type_size_t_signed=no
+  if test $APPLE_UNIVERSAL_BUILD = 0; then
+    gl_INTEGER_TYPE_SUFFIX([ptrdiff_t size_t],
+      [gl_STDINT_INCLUDES])
+  fi
+  gl_INTEGER_TYPE_SUFFIX([sig_atomic_t wchar_t wint_t],
+    [gl_STDINT_INCLUDES])
+])
+
+dnl Autoconf >= 2.61 has AC_COMPUTE_INT built-in.
+dnl Remove this when we can assume autoconf >= 2.61.
+m4_ifdef([AC_COMPUTE_INT], [], [
+  AC_DEFUN([AC_COMPUTE_INT], [_AC_COMPUTE_INT([$2],[$1],[$3],[$4])])
+])
+
+# Hey Emacs!
+# Local Variables:
+# indent-tabs-mode: nil
+# End:
diff --git a/m4/stdint_h.m4 b/m4/stdint_h.m4
new file mode 100644
index 000000000..82f0c244c
--- /dev/null
+++ b/m4/stdint_h.m4
@@ -0,0 +1,26 @@
+# stdint_h.m4 serial 8
+dnl Copyright (C) 1997-2004, 2006, 2008, 2009 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+dnl From Paul Eggert.
+
+# Define HAVE_STDINT_H_WITH_UINTMAX if <stdint.h> exists,
+# doesn't clash with <sys/types.h>, and declares uintmax_t.
+
+AC_DEFUN([gl_AC_HEADER_STDINT_H],
+[
+  AC_CACHE_CHECK([for stdint.h], [gl_cv_header_stdint_h],
+  [AC_TRY_COMPILE(
+    [#include <sys/types.h>
+#include <stdint.h>],
+    [uintmax_t i = (uintmax_t) -1; return !i;],
+    [gl_cv_header_stdint_h=yes],
+    [gl_cv_header_stdint_h=no])])
+  if test $gl_cv_header_stdint_h = yes; then
+    AC_DEFINE_UNQUOTED([HAVE_STDINT_H_WITH_UINTMAX], [1],
+      [Define if <stdint.h> exists, doesn't clash with <sys/types.h>,
+       and declares uintmax_t. ])
+  fi
+])
diff --git a/m4/stdio_h.m4 b/m4/stdio_h.m4
new file mode 100644
index 000000000..fcbe68f6b
--- /dev/null
+++ b/m4/stdio_h.m4
@@ -0,0 +1,136 @@
+# stdio_h.m4 serial 16
+dnl Copyright (C) 2007-2009 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN([gl_STDIO_H],
+[
+  AC_REQUIRE([gl_STDIO_H_DEFAULTS])
+  gl_CHECK_NEXT_HEADERS([stdio.h])
+  dnl No need to create extra modules for these functions. Everyone who uses
+  dnl <stdio.h> likely needs them.
+  GNULIB_FPRINTF=1
+  GNULIB_PRINTF=1
+  GNULIB_VFPRINTF=1
+  GNULIB_VPRINTF=1
+  GNULIB_FPUTC=1
+  GNULIB_PUTC=1
+  GNULIB_PUTCHAR=1
+  GNULIB_FPUTS=1
+  GNULIB_PUTS=1
+  GNULIB_FWRITE=1
+  dnl This ifdef is just an optimization, to avoid performing a configure
+  dnl check whose result is not used. It does not make the test of
+  dnl GNULIB_STDIO_H_SIGPIPE or GNULIB_SIGPIPE redundant.
+  m4_ifdef([gl_SIGNAL_SIGPIPE], [
+    gl_SIGNAL_SIGPIPE
+    if test $gl_cv_header_signal_h_SIGPIPE != yes; then
+      REPLACE_STDIO_WRITE_FUNCS=1
+      AC_LIBOBJ([stdio-write])
+    fi
+  ])
+])
+
+AC_DEFUN([gl_STDIO_MODULE_INDICATOR],
+[
+  dnl Use AC_REQUIRE here, so that the default settings are expanded once only.
+  AC_REQUIRE([gl_STDIO_H_DEFAULTS])
+  GNULIB_[]m4_translit([$1],[abcdefghijklmnopqrstuvwxyz./-],[ABCDEFGHIJKLMNOPQRSTUVWXYZ___])=1
+])
+
+AC_DEFUN([gl_STDIO_H_DEFAULTS],
+[
+  GNULIB_FPRINTF=0;              AC_SUBST([GNULIB_FPRINTF])
+  GNULIB_FPRINTF_POSIX=0;        AC_SUBST([GNULIB_FPRINTF_POSIX])
+  GNULIB_PRINTF=0;               AC_SUBST([GNULIB_PRINTF])
+  GNULIB_PRINTF_POSIX=0;         AC_SUBST([GNULIB_PRINTF_POSIX])
+  GNULIB_SNPRINTF=0;             AC_SUBST([GNULIB_SNPRINTF])
+  GNULIB_SPRINTF_POSIX=0;        AC_SUBST([GNULIB_SPRINTF_POSIX])
+  GNULIB_VFPRINTF=0;             AC_SUBST([GNULIB_VFPRINTF])
+  GNULIB_VFPRINTF_POSIX=0;       AC_SUBST([GNULIB_VFPRINTF_POSIX])
+  GNULIB_VPRINTF=0;              AC_SUBST([GNULIB_VPRINTF])
+  GNULIB_VPRINTF_POSIX=0;        AC_SUBST([GNULIB_VPRINTF_POSIX])
+  GNULIB_VSNPRINTF=0;            AC_SUBST([GNULIB_VSNPRINTF])
+  GNULIB_VSPRINTF_POSIX=0;       AC_SUBST([GNULIB_VSPRINTF_POSIX])
+  GNULIB_DPRINTF=0;              AC_SUBST([GNULIB_DPRINTF])
+  GNULIB_VDPRINTF=0;             AC_SUBST([GNULIB_VDPRINTF])
+  GNULIB_VASPRINTF=0;            AC_SUBST([GNULIB_VASPRINTF])
+  GNULIB_OBSTACK_PRINTF=0;       AC_SUBST([GNULIB_OBSTACK_PRINTF])
+  GNULIB_OBSTACK_PRINTF_POSIX=0; AC_SUBST([GNULIB_OBSTACK_PRINTF_POSIX])
+  GNULIB_FOPEN=0;                AC_SUBST([GNULIB_FOPEN])
+  GNULIB_FREOPEN=0;              AC_SUBST([GNULIB_FREOPEN])
+  GNULIB_FSEEK=0;                AC_SUBST([GNULIB_FSEEK])
+  GNULIB_FSEEKO=0;               AC_SUBST([GNULIB_FSEEKO])
+  GNULIB_FTELL=0;                AC_SUBST([GNULIB_FTELL])
+  GNULIB_FTELLO=0;               AC_SUBST([GNULIB_FTELLO])
+  GNULIB_FFLUSH=0;               AC_SUBST([GNULIB_FFLUSH])
+  GNULIB_FPURGE=0;               AC_SUBST([GNULIB_FPURGE])
+  GNULIB_FCLOSE=0;               AC_SUBST([GNULIB_FCLOSE])
+  GNULIB_FPUTC=0;                AC_SUBST([GNULIB_FPUTC])
+  GNULIB_PUTC=0;                 AC_SUBST([GNULIB_PUTC])
+  GNULIB_PUTCHAR=0;              AC_SUBST([GNULIB_PUTCHAR])
+  GNULIB_FPUTS=0;                AC_SUBST([GNULIB_FPUTS])
+  GNULIB_PUTS=0;                 AC_SUBST([GNULIB_PUTS])
+  GNULIB_FWRITE=0;               AC_SUBST([GNULIB_FWRITE])
+  GNULIB_GETDELIM=0;             AC_SUBST([GNULIB_GETDELIM])
+  GNULIB_GETLINE=0;              AC_SUBST([GNULIB_GETLINE])
+  GNULIB_PERROR=0;               AC_SUBST([GNULIB_PERROR])
+  GNULIB_STDIO_H_SIGPIPE=0;      AC_SUBST([GNULIB_STDIO_H_SIGPIPE])
+  dnl Assume proper GNU behavior unless another module says otherwise.
+  REPLACE_STDIO_WRITE_FUNCS=0;   AC_SUBST([REPLACE_STDIO_WRITE_FUNCS])
+  REPLACE_FPRINTF=0;             AC_SUBST([REPLACE_FPRINTF])
+  REPLACE_VFPRINTF=0;            AC_SUBST([REPLACE_VFPRINTF])
+  REPLACE_PRINTF=0;              AC_SUBST([REPLACE_PRINTF])
+  REPLACE_VPRINTF=0;             AC_SUBST([REPLACE_VPRINTF])
+  REPLACE_SNPRINTF=0;            AC_SUBST([REPLACE_SNPRINTF])
+  HAVE_DECL_SNPRINTF=1;          AC_SUBST([HAVE_DECL_SNPRINTF])
+  REPLACE_VSNPRINTF=0;           AC_SUBST([REPLACE_VSNPRINTF])
+  HAVE_DECL_VSNPRINTF=1;         AC_SUBST([HAVE_DECL_VSNPRINTF])
+  REPLACE_SPRINTF=0;             AC_SUBST([REPLACE_SPRINTF])
+  REPLACE_VSPRINTF=0;            AC_SUBST([REPLACE_VSPRINTF])
+  HAVE_DPRINTF=1;                AC_SUBST([HAVE_DPRINTF])
+  REPLACE_DPRINTF=0;             AC_SUBST([REPLACE_DPRINTF])
+  HAVE_VDPRINTF=1;               AC_SUBST([HAVE_VDPRINTF])
+  REPLACE_VDPRINTF=0;            AC_SUBST([REPLACE_VDPRINTF])
+  HAVE_VASPRINTF=1;              AC_SUBST([HAVE_VASPRINTF])
+  REPLACE_VASPRINTF=0;           AC_SUBST([REPLACE_VASPRINTF])
+  HAVE_DECL_OBSTACK_PRINTF=1;    AC_SUBST([HAVE_DECL_OBSTACK_PRINTF])
+  REPLACE_OBSTACK_PRINTF=0;      AC_SUBST([REPLACE_OBSTACK_PRINTF])
+  REPLACE_FOPEN=0;               AC_SUBST([REPLACE_FOPEN])
+  REPLACE_FREOPEN=0;             AC_SUBST([REPLACE_FREOPEN])
+  HAVE_FSEEKO=1;                 AC_SUBST([HAVE_FSEEKO])
+  REPLACE_FSEEKO=0;              AC_SUBST([REPLACE_FSEEKO])
+  REPLACE_FSEEK=0;               AC_SUBST([REPLACE_FSEEK])
+  HAVE_FTELLO=1;                 AC_SUBST([HAVE_FTELLO])
+  REPLACE_FTELLO=0;              AC_SUBST([REPLACE_FTELLO])
+  REPLACE_FTELL=0;               AC_SUBST([REPLACE_FTELL])
+  REPLACE_FFLUSH=0;              AC_SUBST([REPLACE_FFLUSH])
+  REPLACE_FPURGE=0;              AC_SUBST([REPLACE_FPURGE])
+  HAVE_DECL_FPURGE=1;            AC_SUBST([HAVE_DECL_FPURGE])
+  REPLACE_FCLOSE=0;              AC_SUBST([REPLACE_FCLOSE])
+  HAVE_DECL_GETDELIM=1;          AC_SUBST([HAVE_DECL_GETDELIM])
+  HAVE_DECL_GETLINE=1;           AC_SUBST([HAVE_DECL_GETLINE])
+  REPLACE_GETLINE=0;             AC_SUBST([REPLACE_GETLINE])
+  REPLACE_PERROR=0;              AC_SUBST([REPLACE_PERROR])
+])
+
+dnl Code shared by fseeko and ftello.  Determine if large files are supported,
+dnl but stdin does not start as a large file by default.
+AC_DEFUN([gl_STDIN_LARGE_OFFSET],
+  [
+    AC_CACHE_CHECK([whether stdin defaults to large file offsets],
+      [gl_cv_var_stdin_large_offset],
+      [AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <stdio.h>]],
+[[#if defined __SL64 && defined __SCLE /* cygwin */
+  /* Cygwin 1.5.24 and earlier fail to put stdin in 64-bit mode, making
+     fseeko/ftello needlessly fail.  This bug was fixed in 1.5.25, and
+     it is easier to do a version check than building a runtime test.  */
+# include <cygwin/version.h>
+# if CYGWIN_VERSION_DLL_COMBINED < CYGWIN_VERSION_DLL_MAKE_COMBINED (1005, 25)
+  choke me
+# endif
+#endif]])],
+	[gl_cv_var_stdin_large_offset=yes],
+	[gl_cv_var_stdin_large_offset=no])])
+])
diff --git a/m4/stdlib_h.m4 b/m4/stdlib_h.m4
new file mode 100644
index 000000000..b295f16b2
--- /dev/null
+++ b/m4/stdlib_h.m4
@@ -0,0 +1,73 @@
+# stdlib_h.m4 serial 15
+dnl Copyright (C) 2007-2009 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN([gl_STDLIB_H],
+[
+  AC_REQUIRE([gl_STDLIB_H_DEFAULTS])
+  gl_CHECK_NEXT_HEADERS([stdlib.h])
+  AC_CHECK_HEADERS([random.h], [], [], [AC_INCLUDES_DEFAULT])
+  if test $ac_cv_header_random_h = yes; then
+    HAVE_RANDOM_H=1
+  else
+    HAVE_RANDOM_H=0
+  fi
+  AC_SUBST([HAVE_RANDOM_H])
+  AC_CHECK_TYPES([struct random_data],
+    [], [HAVE_STRUCT_RANDOM_DATA=0],
+    [[#include <stdlib.h>
+      #if HAVE_RANDOM_H
+      # include <random.h>
+      #endif
+    ]])
+])
+
+AC_DEFUN([gl_STDLIB_MODULE_INDICATOR],
+[
+  dnl Use AC_REQUIRE here, so that the default settings are expanded once only.
+  AC_REQUIRE([gl_STDLIB_H_DEFAULTS])
+  GNULIB_[]m4_translit([$1],[abcdefghijklmnopqrstuvwxyz./-],[ABCDEFGHIJKLMNOPQRSTUVWXYZ___])=1
+])
+
+AC_DEFUN([gl_STDLIB_H_DEFAULTS],
+[
+  GNULIB_MALLOC_POSIX=0;  AC_SUBST([GNULIB_MALLOC_POSIX])
+  GNULIB_REALLOC_POSIX=0; AC_SUBST([GNULIB_REALLOC_POSIX])
+  GNULIB_CALLOC_POSIX=0;  AC_SUBST([GNULIB_CALLOC_POSIX])
+  GNULIB_ATOLL=0;         AC_SUBST([GNULIB_ATOLL])
+  GNULIB_GETLOADAVG=0;    AC_SUBST([GNULIB_GETLOADAVG])
+  GNULIB_GETSUBOPT=0;     AC_SUBST([GNULIB_GETSUBOPT])
+  GNULIB_MKDTEMP=0;       AC_SUBST([GNULIB_MKDTEMP])
+  GNULIB_MKSTEMP=0;       AC_SUBST([GNULIB_MKSTEMP])
+  GNULIB_PUTENV=0;        AC_SUBST([GNULIB_PUTENV])
+  GNULIB_RANDOM_R=0;      AC_SUBST([GNULIB_RANDOM_R])
+  GNULIB_RPMATCH=0;       AC_SUBST([GNULIB_RPMATCH])
+  GNULIB_SETENV=0;        AC_SUBST([GNULIB_SETENV])
+  GNULIB_STRTOD=0;        AC_SUBST([GNULIB_STRTOD])
+  GNULIB_STRTOLL=0;       AC_SUBST([GNULIB_STRTOLL])
+  GNULIB_STRTOULL=0;      AC_SUBST([GNULIB_STRTOULL])
+  GNULIB_UNSETENV=0;      AC_SUBST([GNULIB_UNSETENV])
+  dnl Assume proper GNU behavior unless another module says otherwise.
+  HAVE_ATOLL=1;              AC_SUBST([HAVE_ATOLL])
+  HAVE_CALLOC_POSIX=1;       AC_SUBST([HAVE_CALLOC_POSIX])
+  HAVE_GETSUBOPT=1;          AC_SUBST([HAVE_GETSUBOPT])
+  HAVE_MALLOC_POSIX=1;       AC_SUBST([HAVE_MALLOC_POSIX])
+  HAVE_MKDTEMP=1;            AC_SUBST([HAVE_MKDTEMP])
+  HAVE_REALLOC_POSIX=1;      AC_SUBST([HAVE_REALLOC_POSIX])
+  HAVE_RANDOM_R=1;           AC_SUBST([HAVE_RANDOM_R])
+  HAVE_RPMATCH=1;            AC_SUBST([HAVE_RPMATCH])
+  HAVE_SETENV=1;             AC_SUBST([HAVE_SETENV])
+  HAVE_STRTOD=1;             AC_SUBST([HAVE_STRTOD])
+  HAVE_STRTOLL=1;            AC_SUBST([HAVE_STRTOLL])
+  HAVE_STRTOULL=1;           AC_SUBST([HAVE_STRTOULL])
+  HAVE_STRUCT_RANDOM_DATA=1; AC_SUBST([HAVE_STRUCT_RANDOM_DATA])
+  HAVE_SYS_LOADAVG_H=0;      AC_SUBST([HAVE_SYS_LOADAVG_H])
+  HAVE_UNSETENV=1;           AC_SUBST([HAVE_UNSETENV])
+  HAVE_DECL_GETLOADAVG=1;    AC_SUBST([HAVE_DECL_GETLOADAVG])
+  REPLACE_MKSTEMP=0;         AC_SUBST([REPLACE_MKSTEMP])
+  REPLACE_PUTENV=0;          AC_SUBST([REPLACE_PUTENV])
+  REPLACE_STRTOD=0;          AC_SUBST([REPLACE_STRTOD])
+  VOID_UNSETENV=0;           AC_SUBST([VOID_UNSETENV])
+])
diff --git a/m4/strcase.m4 b/m4/strcase.m4
index 79c525c11..0dfdb1a18 100644
--- a/m4/strcase.m4
+++ b/m4/strcase.m4
@@ -1,5 +1,5 @@
-# strcase.m4 serial 9
-dnl Copyright (C) 2002, 2005-2008 Free Software Foundation, Inc.
+# strcase.m4 serial 10
+dnl Copyright (C) 2002, 2005-2009 Free Software Foundation, Inc.
 dnl This file is free software; the Free Software Foundation
 dnl gives unlimited permission to copy and/or distribute it,
 dnl with or without modifications, as long as this notice is preserved.
@@ -13,7 +13,7 @@ AC_DEFUN([gl_STRCASE],
 AC_DEFUN([gl_FUNC_STRCASECMP],
 [
   AC_REQUIRE([gl_HEADER_STRINGS_H_DEFAULTS])
-  AC_REPLACE_FUNCS(strcasecmp)
+  AC_REPLACE_FUNCS([strcasecmp])
   if test $ac_cv_func_strcasecmp = no; then
     HAVE_STRCASECMP=0
     gl_PREREQ_STRCASECMP
@@ -23,11 +23,11 @@ AC_DEFUN([gl_FUNC_STRCASECMP],
 AC_DEFUN([gl_FUNC_STRNCASECMP],
 [
   AC_REQUIRE([gl_HEADER_STRINGS_H_DEFAULTS])
-  AC_REPLACE_FUNCS(strncasecmp)
+  AC_REPLACE_FUNCS([strncasecmp])
   if test $ac_cv_func_strncasecmp = no; then
     gl_PREREQ_STRNCASECMP
   fi
-  AC_CHECK_DECLS(strncasecmp)
+  AC_CHECK_DECLS([strncasecmp])
   if test $ac_cv_have_decl_strncasecmp = no; then
     HAVE_DECL_STRNCASECMP=0
   fi
diff --git a/m4/strftime.m4 b/m4/strftime.m4
index 70b537894..15a87708e 100644
--- a/m4/strftime.m4
+++ b/m4/strftime.m4
@@ -1,7 +1,7 @@
-#serial 29
+# serial 32
 
 # Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
-# 2006, 2007 Free Software Foundation, Inc.
+# 2006, 2007, 2009 Free Software Foundation, Inc.
 #
 # This file is free software; the Free Software Foundation
 # gives unlimited permission to copy and/or distribute it,
@@ -25,8 +25,8 @@ AC_DEFUN([gl_FUNC_STRFTIME],
  AC_REQUIRE([AC_TYPE_MBSTATE_T])
  AC_REQUIRE([gl_TM_GMTOFF])
 
- AC_CHECK_FUNCS_ONCE(mblen mbrlen mempcpy tzset)
- AC_CHECK_HEADERS_ONCE(wchar.h)
+ AC_CHECK_FUNCS_ONCE([tzset])
+ AC_CHECK_HEADERS_ONCE([wchar.h])
 
  AC_DEFINE([my_strftime], [nstrftime],
    [Define to the name of the strftime replacement function.])
diff --git a/m4/string_h.m4 b/m4/string_h.m4
new file mode 100644
index 000000000..11f09c8b8
--- /dev/null
+++ b/m4/string_h.m4
@@ -0,0 +1,94 @@
+# Configure a GNU-like replacement for <string.h>.
+
+# Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc.
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# serial 7
+
+# Written by Paul Eggert.
+
+AC_DEFUN([gl_HEADER_STRING_H],
+[
+  dnl Use AC_REQUIRE here, so that the default behavior below is expanded
+  dnl once only, before all statements that occur in other macros.
+  AC_REQUIRE([gl_HEADER_STRING_H_BODY])
+])
+
+AC_DEFUN([gl_HEADER_STRING_H_BODY],
+[
+  AC_REQUIRE([AC_C_RESTRICT])
+  AC_REQUIRE([gl_HEADER_STRING_H_DEFAULTS])
+  gl_CHECK_NEXT_HEADERS([string.h])
+])
+
+AC_DEFUN([gl_STRING_MODULE_INDICATOR],
+[
+  dnl Use AC_REQUIRE here, so that the default settings are expanded once only.
+  AC_REQUIRE([gl_HEADER_STRING_H_DEFAULTS])
+  GNULIB_[]m4_translit([$1],[abcdefghijklmnopqrstuvwxyz./-],[ABCDEFGHIJKLMNOPQRSTUVWXYZ___])=1
+])
+
+AC_DEFUN([gl_HEADER_STRING_H_DEFAULTS],
+[
+  GNULIB_MEMCHR=0;      AC_SUBST([GNULIB_MEMCHR])
+  GNULIB_MEMMEM=0;      AC_SUBST([GNULIB_MEMMEM])
+  GNULIB_MEMPCPY=0;     AC_SUBST([GNULIB_MEMPCPY])
+  GNULIB_MEMRCHR=0;     AC_SUBST([GNULIB_MEMRCHR])
+  GNULIB_RAWMEMCHR=0;   AC_SUBST([GNULIB_RAWMEMCHR])
+  GNULIB_STPCPY=0;      AC_SUBST([GNULIB_STPCPY])
+  GNULIB_STPNCPY=0;     AC_SUBST([GNULIB_STPNCPY])
+  GNULIB_STRCHRNUL=0;   AC_SUBST([GNULIB_STRCHRNUL])
+  GNULIB_STRDUP=0;      AC_SUBST([GNULIB_STRDUP])
+  GNULIB_STRNDUP=0;     AC_SUBST([GNULIB_STRNDUP])
+  GNULIB_STRNLEN=0;     AC_SUBST([GNULIB_STRNLEN])
+  GNULIB_STRPBRK=0;     AC_SUBST([GNULIB_STRPBRK])
+  GNULIB_STRSEP=0;      AC_SUBST([GNULIB_STRSEP])
+  GNULIB_STRSTR=0;      AC_SUBST([GNULIB_STRSTR])
+  GNULIB_STRCASESTR=0;  AC_SUBST([GNULIB_STRCASESTR])
+  GNULIB_STRTOK_R=0;    AC_SUBST([GNULIB_STRTOK_R])
+  GNULIB_MBSLEN=0;      AC_SUBST([GNULIB_MBSLEN])
+  GNULIB_MBSNLEN=0;     AC_SUBST([GNULIB_MBSNLEN])
+  GNULIB_MBSCHR=0;      AC_SUBST([GNULIB_MBSCHR])
+  GNULIB_MBSRCHR=0;     AC_SUBST([GNULIB_MBSRCHR])
+  GNULIB_MBSSTR=0;      AC_SUBST([GNULIB_MBSSTR])
+  GNULIB_MBSCASECMP=0;  AC_SUBST([GNULIB_MBSCASECMP])
+  GNULIB_MBSNCASECMP=0; AC_SUBST([GNULIB_MBSNCASECMP])
+  GNULIB_MBSPCASECMP=0; AC_SUBST([GNULIB_MBSPCASECMP])
+  GNULIB_MBSCASESTR=0;  AC_SUBST([GNULIB_MBSCASESTR])
+  GNULIB_MBSCSPN=0;     AC_SUBST([GNULIB_MBSCSPN])
+  GNULIB_MBSPBRK=0;     AC_SUBST([GNULIB_MBSPBRK])
+  GNULIB_MBSSPN=0;      AC_SUBST([GNULIB_MBSSPN])
+  GNULIB_MBSSEP=0;      AC_SUBST([GNULIB_MBSSEP])
+  GNULIB_MBSTOK_R=0;    AC_SUBST([GNULIB_MBSTOK_R])
+  GNULIB_STRERROR=0;    AC_SUBST([GNULIB_STRERROR])
+  GNULIB_STRSIGNAL=0;   AC_SUBST([GNULIB_STRSIGNAL])
+  GNULIB_STRVERSCMP=0;   AC_SUBST([GNULIB_STRVERSCMP])
+  dnl Assume proper GNU behavior unless another module says otherwise.
+  HAVE_DECL_MEMMEM=1;		AC_SUBST([HAVE_DECL_MEMMEM])
+  HAVE_MEMPCPY=1;		AC_SUBST([HAVE_MEMPCPY])
+  HAVE_DECL_MEMRCHR=1;		AC_SUBST([HAVE_DECL_MEMRCHR])
+  HAVE_RAWMEMCHR=1;		AC_SUBST([HAVE_RAWMEMCHR])
+  HAVE_STPCPY=1;		AC_SUBST([HAVE_STPCPY])
+  HAVE_STPNCPY=1;		AC_SUBST([HAVE_STPNCPY])
+  HAVE_STRCHRNUL=1;		AC_SUBST([HAVE_STRCHRNUL])
+  HAVE_DECL_STRDUP=1;		AC_SUBST([HAVE_DECL_STRDUP])
+  HAVE_STRNDUP=1;		AC_SUBST([HAVE_STRNDUP])
+  HAVE_DECL_STRNDUP=1;		AC_SUBST([HAVE_DECL_STRNDUP])
+  HAVE_DECL_STRNLEN=1;		AC_SUBST([HAVE_DECL_STRNLEN])
+  HAVE_STRPBRK=1;		AC_SUBST([HAVE_STRPBRK])
+  HAVE_STRSEP=1;		AC_SUBST([HAVE_STRSEP])
+  HAVE_STRCASESTR=1;		AC_SUBST([HAVE_STRCASESTR])
+  HAVE_DECL_STRTOK_R=1;		AC_SUBST([HAVE_DECL_STRTOK_R])
+  HAVE_DECL_STRERROR=1;		AC_SUBST([HAVE_DECL_STRERROR])
+  HAVE_DECL_STRSIGNAL=1;	AC_SUBST([HAVE_DECL_STRSIGNAL])
+  HAVE_STRVERSCMP=1;		AC_SUBST([HAVE_STRVERSCMP])
+  REPLACE_MEMCHR=0;		AC_SUBST([REPLACE_MEMCHR])
+  REPLACE_MEMMEM=0;		AC_SUBST([REPLACE_MEMMEM])
+  REPLACE_STRDUP=0;		AC_SUBST([REPLACE_STRDUP])
+  REPLACE_STRSTR=0;		AC_SUBST([REPLACE_STRSTR])
+  REPLACE_STRCASESTR=0;		AC_SUBST([REPLACE_STRCASESTR])
+  REPLACE_STRERROR=0;		AC_SUBST([REPLACE_STRERROR])
+  REPLACE_STRSIGNAL=0;		AC_SUBST([REPLACE_STRSIGNAL])
+])
diff --git a/m4/sys_file_h.m4 b/m4/sys_file_h.m4
new file mode 100644
index 000000000..436c6fec1
--- /dev/null
+++ b/m4/sys_file_h.m4
@@ -0,0 +1,41 @@
+# Configure a replacement for <sys/file.h>.
+
+# Copyright (C) 2008 Free Software Foundation, Inc.
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# Written by Richard W.M. Jones.
+
+AC_DEFUN([gl_HEADER_SYS_FILE_H],
+[
+  AC_REQUIRE([gl_HEADER_SYS_FILE_H_DEFAULTS])
+
+  dnl Only flock is defined in a working <sys/file.h>.  If that
+  dnl function is already there, we don't want to do any substitution.
+  AC_CHECK_FUNCS_ONCE([flock])
+
+  gl_CHECK_NEXT_HEADERS([sys/file.h])
+  SYS_FILE_H='sys/file.h'
+  AC_SUBST([SYS_FILE_H])
+
+  AC_CHECK_HEADERS_ONCE([sys/file.h])
+  if test $ac_cv_header_sys_file_h = yes; then
+    HAVE_SYS_FILE_H=1
+  else
+    HAVE_SYS_FILE_H=0
+  fi
+  AC_SUBST([HAVE_SYS_FILE_H])
+])
+
+AC_DEFUN([gl_HEADER_SYS_FILE_MODULE_INDICATOR],
+[
+  AC_REQUIRE([gl_HEADER_SYS_FILE_H_DEFAULTS])
+  GNULIB_[]m4_translit([$1],[abcdefghijklmnopqrstuvwxyz./-],[ABCDEFGHIJKLMNOPQRSTUVWXYZ___])=1
+])
+
+AC_DEFUN([gl_HEADER_SYS_FILE_H_DEFAULTS],
+[
+  GNULIB_FLOCK=0;        AC_SUBST([GNULIB_FLOCK])
+  HAVE_FLOCK=1;          AC_SUBST([HAVE_FLOCK])
+])
diff --git a/m4/time_h.m4 b/m4/time_h.m4
index d42a635ec..16fefa197 100644
--- a/m4/time_h.m4
+++ b/m4/time_h.m4
@@ -1,7 +1,6 @@
 # Configure a more-standard replacement for <time.h>.
 
-# Copyright (C) 2000, 2001, 2003, 2004, 2005, 2006, 2007 Free Software
-# Foundation, Inc.
+# Copyright (C) 2000-2001, 2003-2007, 2009 Free Software Foundation, Inc.
 
 # This file is free software; the Free Software Foundation
 # gives unlimited permission to copy and/or distribute it,
@@ -30,6 +29,7 @@ AC_DEFUN([gl_HEADER_TIME_H_DEFAULTS],
   dnl Otherwise, replace only if someone compiles with -DGNULIB_PORTCHECK;
   dnl this lets maintainers check for portability.
   REPLACE_LOCALTIME_R=GNULIB_PORTCHECK;  AC_SUBST([REPLACE_LOCALTIME_R])
+  REPLACE_MKTIME=GNULIB_PORTCHECK;       AC_SUBST([REPLACE_MKTIME])
   REPLACE_NANOSLEEP=GNULIB_PORTCHECK;    AC_SUBST([REPLACE_NANOSLEEP])
   REPLACE_STRPTIME=GNULIB_PORTCHECK;     AC_SUBST([REPLACE_STRPTIME])
   REPLACE_TIMEGM=GNULIB_PORTCHECK;       AC_SUBST([REPLACE_TIMEGM])
diff --git a/m4/tm_gmtoff.m4 b/m4/tm_gmtoff.m4
index cb0b3c884..911af0a40 100644
--- a/m4/tm_gmtoff.m4
+++ b/m4/tm_gmtoff.m4
@@ -1,5 +1,5 @@
-# tm_gmtoff.m4 serial 2
-dnl Copyright (C) 2002 Free Software Foundation, Inc.
+# tm_gmtoff.m4 serial 3
+dnl Copyright (C) 2002, 2009 Free Software Foundation, Inc.
 dnl This file is free software; the Free Software Foundation
 dnl gives unlimited permission to copy and/or distribute it,
 dnl with or without modifications, as long as this notice is preserved.
@@ -7,7 +7,7 @@ dnl with or without modifications, as long as this notice is preserved.
 AC_DEFUN([gl_TM_GMTOFF],
 [
  AC_CHECK_MEMBER([struct tm.tm_gmtoff],
-                 [AC_DEFINE(HAVE_TM_GMTOFF, 1,
+                 [AC_DEFINE([HAVE_TM_GMTOFF], [1],
                             [Define if struct tm has the tm_gmtoff member.])],
                  ,
                  [#include <time.h>])
diff --git a/m4/unistd_h.m4 b/m4/unistd_h.m4
index 568527365..96fddba7f 100644
--- a/m4/unistd_h.m4
+++ b/m4/unistd_h.m4
@@ -1,5 +1,5 @@
-# unistd_h.m4 serial 16
-dnl Copyright (C) 2006-2008 Free Software Foundation, Inc.
+# unistd_h.m4 serial 18
+dnl Copyright (C) 2006-2009 Free Software Foundation, Inc.
 dnl This file is free software; the Free Software Foundation
 dnl gives unlimited permission to copy and/or distribute it,
 dnl with or without modifications, as long as this notice is preserved.
@@ -48,6 +48,7 @@ AC_DEFUN([gl_UNISTD_H_DEFAULTS],
   GNULIB_GETPAGESIZE=0;      AC_SUBST([GNULIB_GETPAGESIZE])
   GNULIB_GETUSERSHELL=0;     AC_SUBST([GNULIB_GETUSERSHELL])
   GNULIB_LCHOWN=0;           AC_SUBST([GNULIB_LCHOWN])
+  GNULIB_LINK=0;             AC_SUBST([GNULIB_LINK])
   GNULIB_LSEEK=0;            AC_SUBST([GNULIB_LSEEK])
   GNULIB_READLINK=0;         AC_SUBST([GNULIB_READLINK])
   GNULIB_SLEEP=0;            AC_SUBST([GNULIB_SLEEP])
@@ -63,6 +64,7 @@ AC_DEFUN([gl_UNISTD_H_DEFAULTS],
   HAVE_GETHOSTNAME=1;     AC_SUBST([HAVE_GETHOSTNAME])
   HAVE_GETPAGESIZE=1;     AC_SUBST([HAVE_GETPAGESIZE])
   HAVE_GETUSERSHELL=1;    AC_SUBST([HAVE_GETUSERSHELL])
+  HAVE_LINK=1;            AC_SUBST([HAVE_LINK])
   HAVE_READLINK=1;        AC_SUBST([HAVE_READLINK])
   HAVE_SLEEP=1;           AC_SUBST([HAVE_SLEEP])
   HAVE_DECL_ENVIRON=1;    AC_SUBST([HAVE_DECL_ENVIRON])
@@ -71,6 +73,7 @@ AC_DEFUN([gl_UNISTD_H_DEFAULTS],
   HAVE_SYS_PARAM_H=0;     AC_SUBST([HAVE_SYS_PARAM_H])
   REPLACE_CHOWN=0;        AC_SUBST([REPLACE_CHOWN])
   REPLACE_CLOSE=0;        AC_SUBST([REPLACE_CLOSE])
+  REPLACE_DUP2=0;         AC_SUBST([REPLACE_DUP2])
   REPLACE_FCHDIR=0;       AC_SUBST([REPLACE_FCHDIR])
   REPLACE_GETCWD=0;       AC_SUBST([REPLACE_GETCWD])
   REPLACE_GETPAGESIZE=0;  AC_SUBST([REPLACE_GETPAGESIZE])
diff --git a/m4/vasnprintf.m4 b/m4/vasnprintf.m4
new file mode 100644
index 000000000..3a1d1e010
--- /dev/null
+++ b/m4/vasnprintf.m4
@@ -0,0 +1,276 @@
+# vasnprintf.m4 serial 29
+dnl Copyright (C) 2002-2004, 2006-2009 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN([gl_FUNC_VASNPRINTF],
+[
+  AC_CHECK_FUNCS_ONCE([vasnprintf])
+  if test $ac_cv_func_vasnprintf = no; then
+    gl_REPLACE_VASNPRINTF
+  fi
+])
+
+AC_DEFUN([gl_REPLACE_VASNPRINTF],
+[
+  AC_CHECK_FUNCS_ONCE([vasnprintf])
+  AC_LIBOBJ([vasnprintf])
+  AC_LIBOBJ([printf-args])
+  AC_LIBOBJ([printf-parse])
+  AC_LIBOBJ([asnprintf])
+  if test $ac_cv_func_vasnprintf = yes; then
+    AC_DEFINE([REPLACE_VASNPRINTF], [1],
+      [Define if vasnprintf exists but is overridden by gnulib.])
+  fi
+  gl_PREREQ_PRINTF_ARGS
+  gl_PREREQ_PRINTF_PARSE
+  gl_PREREQ_VASNPRINTF
+  gl_PREREQ_ASNPRINTF
+])
+
+# Prequisites of lib/printf-args.h, lib/printf-args.c.
+AC_DEFUN([gl_PREREQ_PRINTF_ARGS],
+[
+  AC_REQUIRE([AC_TYPE_LONG_LONG_INT])
+  AC_REQUIRE([gt_TYPE_WCHAR_T])
+  AC_REQUIRE([gt_TYPE_WINT_T])
+])
+
+# Prequisites of lib/printf-parse.h, lib/printf-parse.c.
+AC_DEFUN([gl_PREREQ_PRINTF_PARSE],
+[
+  AC_REQUIRE([AC_TYPE_LONG_LONG_INT])
+  AC_REQUIRE([gt_TYPE_WCHAR_T])
+  AC_REQUIRE([gt_TYPE_WINT_T])
+  AC_REQUIRE([AC_TYPE_SIZE_T])
+  AC_CHECK_TYPE([ptrdiff_t], ,
+    [AC_DEFINE([ptrdiff_t], [long],
+       [Define as the type of the result of subtracting two pointers, if the system doesn't define it.])
+    ])
+  AC_REQUIRE([gt_AC_TYPE_INTMAX_T])
+])
+
+# Prerequisites of lib/vasnprintf.c.
+AC_DEFUN_ONCE([gl_PREREQ_VASNPRINTF],
+[
+  AC_REQUIRE([AC_FUNC_ALLOCA])
+  AC_REQUIRE([AC_TYPE_LONG_LONG_INT])
+  AC_REQUIRE([gt_TYPE_WCHAR_T])
+  AC_REQUIRE([gt_TYPE_WINT_T])
+  AC_CHECK_FUNCS([snprintf strnlen wcslen wcsnlen mbrtowc wcrtomb])
+  dnl Use the _snprintf function only if it is declared (because on NetBSD it
+  dnl is defined as a weak alias of snprintf; we prefer to use the latter).
+  AC_CHECK_DECLS([_snprintf], , , [#include <stdio.h>])
+])
+
+# Extra prerequisites of lib/vasnprintf.c for supporting 'long double'
+# arguments.
+AC_DEFUN_ONCE([gl_PREREQ_VASNPRINTF_LONG_DOUBLE],
+[
+  AC_REQUIRE([gl_PRINTF_LONG_DOUBLE])
+  case "$gl_cv_func_printf_long_double" in
+    *yes)
+      ;;
+    *)
+      AC_DEFINE([NEED_PRINTF_LONG_DOUBLE], [1],
+        [Define if the vasnprintf implementation needs special code for
+         'long double' arguments.])
+      ;;
+  esac
+])
+
+# Extra prerequisites of lib/vasnprintf.c for supporting infinite 'double'
+# arguments.
+AC_DEFUN([gl_PREREQ_VASNPRINTF_INFINITE_DOUBLE],
+[
+  AC_REQUIRE([gl_PRINTF_INFINITE])
+  case "$gl_cv_func_printf_infinite" in
+    *yes)
+      ;;
+    *)
+      AC_DEFINE([NEED_PRINTF_INFINITE_DOUBLE], [1],
+        [Define if the vasnprintf implementation needs special code for
+         infinite 'double' arguments.])
+      ;;
+  esac
+])
+
+# Extra prerequisites of lib/vasnprintf.c for supporting infinite 'long double'
+# arguments.
+AC_DEFUN([gl_PREREQ_VASNPRINTF_INFINITE_LONG_DOUBLE],
+[
+  AC_REQUIRE([gl_PRINTF_INFINITE_LONG_DOUBLE])
+  dnl There is no need to set NEED_PRINTF_INFINITE_LONG_DOUBLE if
+  dnl NEED_PRINTF_LONG_DOUBLE is already set.
+  AC_REQUIRE([gl_PREREQ_VASNPRINTF_LONG_DOUBLE])
+  case "$gl_cv_func_printf_long_double" in
+    *yes)
+      case "$gl_cv_func_printf_infinite_long_double" in
+        *yes)
+          ;;
+        *)
+          AC_DEFINE([NEED_PRINTF_INFINITE_LONG_DOUBLE], [1],
+            [Define if the vasnprintf implementation needs special code for
+             infinite 'long double' arguments.])
+          ;;
+      esac
+      ;;
+  esac
+])
+
+# Extra prerequisites of lib/vasnprintf.c for supporting the 'a' directive.
+AC_DEFUN([gl_PREREQ_VASNPRINTF_DIRECTIVE_A],
+[
+  AC_REQUIRE([gl_PRINTF_DIRECTIVE_A])
+  case "$gl_cv_func_printf_directive_a" in
+    *yes)
+      ;;
+    *)
+      AC_DEFINE([NEED_PRINTF_DIRECTIVE_A], [1],
+        [Define if the vasnprintf implementation needs special code for
+         the 'a' and 'A' directives.])
+      AC_CHECK_FUNCS([nl_langinfo])
+      ;;
+  esac
+])
+
+# Extra prerequisites of lib/vasnprintf.c for supporting the 'F' directive.
+AC_DEFUN([gl_PREREQ_VASNPRINTF_DIRECTIVE_F],
+[
+  AC_REQUIRE([gl_PRINTF_DIRECTIVE_F])
+  case "$gl_cv_func_printf_directive_f" in
+    *yes)
+      ;;
+    *)
+      AC_DEFINE([NEED_PRINTF_DIRECTIVE_F], [1],
+        [Define if the vasnprintf implementation needs special code for
+         the 'F' directive.])
+      ;;
+  esac
+])
+
+# Extra prerequisites of lib/vasnprintf.c for supporting the 'ls' directive.
+AC_DEFUN([gl_PREREQ_VASNPRINTF_DIRECTIVE_LS],
+[
+  AC_REQUIRE([gl_PRINTF_DIRECTIVE_LS])
+  case "$gl_cv_func_printf_directive_ls" in
+    *yes)
+      ;;
+    *)
+      AC_DEFINE([NEED_PRINTF_DIRECTIVE_LS], [1],
+        [Define if the vasnprintf implementation needs special code for
+         the 'ls' directive.])
+      ;;
+  esac
+])
+
+# Extra prerequisites of lib/vasnprintf.c for supporting the ' flag.
+AC_DEFUN([gl_PREREQ_VASNPRINTF_FLAG_GROUPING],
+[
+  AC_REQUIRE([gl_PRINTF_FLAG_GROUPING])
+  case "$gl_cv_func_printf_flag_grouping" in
+    *yes)
+      ;;
+    *)
+      AC_DEFINE([NEED_PRINTF_FLAG_GROUPING], [1],
+        [Define if the vasnprintf implementation needs special code for the
+         ' flag.])
+      ;;
+  esac
+])
+
+# Extra prerequisites of lib/vasnprintf.c for supporting the '-' flag.
+AC_DEFUN([gl_PREREQ_VASNPRINTF_FLAG_LEFTADJUST],
+[
+  AC_REQUIRE([gl_PRINTF_FLAG_LEFTADJUST])
+  case "$gl_cv_func_printf_flag_leftadjust" in
+    *yes)
+      ;;
+    *)
+      AC_DEFINE([NEED_PRINTF_FLAG_LEFTADJUST], [1],
+        [Define if the vasnprintf implementation needs special code for the
+         '-' flag.])
+      ;;
+  esac
+])
+
+# Extra prerequisites of lib/vasnprintf.c for supporting the 0 flag.
+AC_DEFUN([gl_PREREQ_VASNPRINTF_FLAG_ZERO],
+[
+  AC_REQUIRE([gl_PRINTF_FLAG_ZERO])
+  case "$gl_cv_func_printf_flag_zero" in
+    *yes)
+      ;;
+    *)
+      AC_DEFINE([NEED_PRINTF_FLAG_ZERO], [1],
+        [Define if the vasnprintf implementation needs special code for the
+         0 flag.])
+      ;;
+  esac
+])
+
+# Extra prerequisites of lib/vasnprintf.c for supporting large precisions.
+AC_DEFUN([gl_PREREQ_VASNPRINTF_PRECISION],
+[
+  AC_REQUIRE([gl_PRINTF_PRECISION])
+  case "$gl_cv_func_printf_precision" in
+    *yes)
+      ;;
+    *)
+      AC_DEFINE([NEED_PRINTF_UNBOUNDED_PRECISION], [1],
+        [Define if the vasnprintf implementation needs special code for
+         supporting large precisions without arbitrary bounds.])
+      AC_DEFINE([NEED_PRINTF_DOUBLE], [1],
+        [Define if the vasnprintf implementation needs special code for
+         'double' arguments.])
+      AC_DEFINE([NEED_PRINTF_LONG_DOUBLE], [1],
+        [Define if the vasnprintf implementation needs special code for
+         'long double' arguments.])
+      ;;
+  esac
+])
+
+# Extra prerequisites of lib/vasnprintf.c for surviving out-of-memory
+# conditions.
+AC_DEFUN([gl_PREREQ_VASNPRINTF_ENOMEM],
+[
+  AC_REQUIRE([gl_PRINTF_ENOMEM])
+  case "$gl_cv_func_printf_enomem" in
+    *yes)
+      ;;
+    *)
+      AC_DEFINE([NEED_PRINTF_ENOMEM], [1],
+        [Define if the vasnprintf implementation needs special code for
+         surviving out-of-memory conditions.])
+      AC_DEFINE([NEED_PRINTF_DOUBLE], [1],
+        [Define if the vasnprintf implementation needs special code for
+         'double' arguments.])
+      AC_DEFINE([NEED_PRINTF_LONG_DOUBLE], [1],
+        [Define if the vasnprintf implementation needs special code for
+         'long double' arguments.])
+      ;;
+  esac
+])
+
+# Prerequisites of lib/vasnprintf.c including all extras for POSIX compliance.
+AC_DEFUN([gl_PREREQ_VASNPRINTF_WITH_EXTRAS],
+[
+  AC_REQUIRE([gl_PREREQ_VASNPRINTF])
+  gl_PREREQ_VASNPRINTF_LONG_DOUBLE
+  gl_PREREQ_VASNPRINTF_INFINITE_DOUBLE
+  gl_PREREQ_VASNPRINTF_INFINITE_LONG_DOUBLE
+  gl_PREREQ_VASNPRINTF_DIRECTIVE_A
+  gl_PREREQ_VASNPRINTF_DIRECTIVE_F
+  gl_PREREQ_VASNPRINTF_DIRECTIVE_LS
+  gl_PREREQ_VASNPRINTF_FLAG_GROUPING
+  gl_PREREQ_VASNPRINTF_FLAG_LEFTADJUST
+  gl_PREREQ_VASNPRINTF_FLAG_ZERO
+  gl_PREREQ_VASNPRINTF_PRECISION
+  gl_PREREQ_VASNPRINTF_ENOMEM
+])
+
+# Prerequisites of lib/asnprintf.c.
+AC_DEFUN([gl_PREREQ_ASNPRINTF],
+[
+])
diff --git a/m4/visibility.m4 b/m4/visibility.m4
new file mode 100644
index 000000000..70bca5643
--- /dev/null
+++ b/m4/visibility.m4
@@ -0,0 +1,52 @@
+# visibility.m4 serial 2 (gettext-0.18)
+dnl Copyright (C) 2005, 2008 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+dnl From Bruno Haible.
+
+dnl Tests whether the compiler supports the command-line option
+dnl -fvisibility=hidden and the function and variable attributes
+dnl __attribute__((__visibility__("hidden"))) and
+dnl __attribute__((__visibility__("default"))).
+dnl Does *not* test for __visibility__("protected") - which has tricky
+dnl semantics (see the 'vismain' test in glibc) and does not exist e.g. on
+dnl MacOS X.
+dnl Does *not* test for __visibility__("internal") - which has processor
+dnl dependent semantics.
+dnl Does *not* test for #pragma GCC visibility push(hidden) - which is
+dnl "really only recommended for legacy code".
+dnl Set the variable CFLAG_VISIBILITY.
+dnl Defines and sets the variable HAVE_VISIBILITY.
+
+AC_DEFUN([gl_VISIBILITY],
+[
+  AC_REQUIRE([AC_PROG_CC])
+  CFLAG_VISIBILITY=
+  HAVE_VISIBILITY=0
+  if test -n "$GCC"; then
+    AC_MSG_CHECKING([for simple visibility declarations])
+    AC_CACHE_VAL([gl_cv_cc_visibility], [
+      gl_save_CFLAGS="$CFLAGS"
+      CFLAGS="$CFLAGS -fvisibility=hidden"
+      AC_TRY_COMPILE(
+        [extern __attribute__((__visibility__("hidden"))) int hiddenvar;
+         extern __attribute__((__visibility__("default"))) int exportedvar;
+         extern __attribute__((__visibility__("hidden"))) int hiddenfunc (void);
+         extern __attribute__((__visibility__("default"))) int exportedfunc (void);],
+        [],
+        [gl_cv_cc_visibility=yes],
+        [gl_cv_cc_visibility=no])
+      CFLAGS="$gl_save_CFLAGS"])
+    AC_MSG_RESULT([$gl_cv_cc_visibility])
+    if test $gl_cv_cc_visibility = yes; then
+      CFLAG_VISIBILITY="-fvisibility=hidden"
+      HAVE_VISIBILITY=1
+    fi
+  fi
+  AC_SUBST([CFLAG_VISIBILITY])
+  AC_SUBST([HAVE_VISIBILITY])
+  AC_DEFINE_UNQUOTED([HAVE_VISIBILITY], [$HAVE_VISIBILITY],
+    [Define to 1 or 0, depending whether the compiler supports simple visibility declarations.])
+])
diff --git a/m4/vsnprintf.m4 b/m4/vsnprintf.m4
new file mode 100644
index 000000000..3b37d460b
--- /dev/null
+++ b/m4/vsnprintf.m4
@@ -0,0 +1,40 @@
+# vsnprintf.m4 serial 5
+dnl Copyright (C) 2002-2004, 2007-2008 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN([gl_FUNC_VSNPRINTF],
+[
+  AC_REQUIRE([gl_STDIO_H_DEFAULTS])
+  gl_cv_func_vsnprintf_usable=no
+  AC_CHECK_FUNCS([vsnprintf])
+  if test $ac_cv_func_vsnprintf = yes; then
+    gl_SNPRINTF_SIZE1
+    case "$gl_cv_func_snprintf_size1" in
+      *yes)
+        gl_cv_func_vsnprintf_usable=yes
+        ;;
+    esac
+  fi
+  if test $gl_cv_func_vsnprintf_usable = no; then
+    gl_REPLACE_VSNPRINTF
+  fi
+  AC_CHECK_DECLS_ONCE([vsnprintf])
+  if test $ac_cv_have_decl_vsnprintf = no; then
+    HAVE_DECL_VSNPRINTF=0
+  fi
+])
+
+AC_DEFUN([gl_REPLACE_VSNPRINTF],
+[
+  AC_REQUIRE([gl_STDIO_H_DEFAULTS])
+  AC_LIBOBJ([vsnprintf])
+  if test $ac_cv_func_vsnprintf = yes; then
+    REPLACE_VSNPRINTF=1
+  fi
+  gl_PREREQ_VSNPRINTF
+])
+
+# Prerequisites of lib/vsnprintf.c.
+AC_DEFUN([gl_PREREQ_VSNPRINTF], [:])
diff --git a/m4/wchar.m4 b/m4/wchar.m4
index ba8ee6ab7..2e52a82ac 100644
--- a/m4/wchar.m4
+++ b/m4/wchar.m4
@@ -1,13 +1,13 @@
 dnl A placeholder for ISO C99 <wchar.h>, for platforms that have issues.
 
-dnl Copyright (C) 2007-2008 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-2009 Free Software Foundation, Inc.
 dnl This file is free software; the Free Software Foundation
 dnl gives unlimited permission to copy and/or distribute it,
 dnl with or without modifications, as long as this notice is preserved.
 
 dnl Written by Eric Blake.
 
-# wchar.m4 serial 22
+# wchar.m4 serial 23
 
 AC_DEFUN([gl_WCHAR_H],
 [
@@ -73,27 +73,28 @@ AC_DEFUN([gl_WCHAR_H_DEFAULTS],
   GNULIB_WCSNRTOMBS=0; AC_SUBST([GNULIB_WCSNRTOMBS])
   GNULIB_WCWIDTH=0;    AC_SUBST([GNULIB_WCWIDTH])
   dnl Assume proper GNU behavior unless another module says otherwise.
-  HAVE_BTOWC=1;        AC_SUBST([HAVE_BTOWC])
-  HAVE_MBSINIT=1;      AC_SUBST([HAVE_MBSINIT])
-  HAVE_MBRTOWC=1;      AC_SUBST([HAVE_MBRTOWC])
-  HAVE_MBRLEN=1;       AC_SUBST([HAVE_MBRLEN])
-  HAVE_MBSRTOWCS=1;    AC_SUBST([HAVE_MBSRTOWCS])
-  HAVE_MBSNRTOWCS=1;   AC_SUBST([HAVE_MBSNRTOWCS])
-  HAVE_WCRTOMB=1;      AC_SUBST([HAVE_WCRTOMB])
-  HAVE_WCSRTOMBS=1;    AC_SUBST([HAVE_WCSRTOMBS])
-  HAVE_WCSNRTOMBS=1;   AC_SUBST([HAVE_WCSNRTOMBS])
-  HAVE_DECL_WCTOB=1;   AC_SUBST([HAVE_DECL_WCTOB])
-  HAVE_DECL_WCWIDTH=1; AC_SUBST([HAVE_DECL_WCWIDTH])
-  REPLACE_MBSTATE_T=0; AC_SUBST([REPLACE_MBSTATE_T])
-  REPLACE_BTOWC=0;     AC_SUBST([REPLACE_BTOWC])
-  REPLACE_WCTOB=0;     AC_SUBST([REPLACE_WCTOB])
-  REPLACE_MBSINIT=0;   AC_SUBST([REPLACE_MBSINIT])
-  REPLACE_MBRTOWC=0;   AC_SUBST([REPLACE_MBRTOWC])
-  REPLACE_MBRLEN=0;    AC_SUBST([REPLACE_MBRLEN])
-  REPLACE_MBSRTOWCS=0; AC_SUBST([REPLACE_MBSRTOWCS])
-  REPLACE_MBSNRTOWCS=0;AC_SUBST([REPLACE_MBSNRTOWCS])
-  REPLACE_WCRTOMB=0;   AC_SUBST([REPLACE_WCRTOMB])
-  REPLACE_WCSRTOMBS=0; AC_SUBST([REPLACE_WCSRTOMBS])
-  REPLACE_WCWIDTH=0;   AC_SUBST([REPLACE_WCWIDTH])
-  WCHAR_H='';          AC_SUBST([WCHAR_H])
+  HAVE_BTOWC=1;         AC_SUBST([HAVE_BTOWC])
+  HAVE_MBSINIT=1;       AC_SUBST([HAVE_MBSINIT])
+  HAVE_MBRTOWC=1;       AC_SUBST([HAVE_MBRTOWC])
+  HAVE_MBRLEN=1;        AC_SUBST([HAVE_MBRLEN])
+  HAVE_MBSRTOWCS=1;     AC_SUBST([HAVE_MBSRTOWCS])
+  HAVE_MBSNRTOWCS=1;    AC_SUBST([HAVE_MBSNRTOWCS])
+  HAVE_WCRTOMB=1;       AC_SUBST([HAVE_WCRTOMB])
+  HAVE_WCSRTOMBS=1;     AC_SUBST([HAVE_WCSRTOMBS])
+  HAVE_WCSNRTOMBS=1;    AC_SUBST([HAVE_WCSNRTOMBS])
+  HAVE_DECL_WCTOB=1;    AC_SUBST([HAVE_DECL_WCTOB])
+  HAVE_DECL_WCWIDTH=1;  AC_SUBST([HAVE_DECL_WCWIDTH])
+  REPLACE_MBSTATE_T=0;  AC_SUBST([REPLACE_MBSTATE_T])
+  REPLACE_BTOWC=0;      AC_SUBST([REPLACE_BTOWC])
+  REPLACE_WCTOB=0;      AC_SUBST([REPLACE_WCTOB])
+  REPLACE_MBSINIT=0;    AC_SUBST([REPLACE_MBSINIT])
+  REPLACE_MBRTOWC=0;    AC_SUBST([REPLACE_MBRTOWC])
+  REPLACE_MBRLEN=0;     AC_SUBST([REPLACE_MBRLEN])
+  REPLACE_MBSRTOWCS=0;  AC_SUBST([REPLACE_MBSRTOWCS])
+  REPLACE_MBSNRTOWCS=0; AC_SUBST([REPLACE_MBSNRTOWCS])
+  REPLACE_WCRTOMB=0;    AC_SUBST([REPLACE_WCRTOMB])
+  REPLACE_WCSRTOMBS=0;  AC_SUBST([REPLACE_WCSRTOMBS])
+  REPLACE_WCSNRTOMBS=0; AC_SUBST([REPLACE_WCSNRTOMBS])
+  REPLACE_WCWIDTH=0;    AC_SUBST([REPLACE_WCWIDTH])
+  WCHAR_H='';           AC_SUBST([WCHAR_H])
 ])
diff --git a/m4/wchar_t.m4 b/m4/wchar_t.m4
new file mode 100644
index 000000000..fb27a7f65
--- /dev/null
+++ b/m4/wchar_t.m4
@@ -0,0 +1,20 @@
+# wchar_t.m4 serial 3 (gettext-0.18)
+dnl Copyright (C) 2002-2003, 2008, 2009 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+dnl From Bruno Haible.
+dnl Test whether <stddef.h> has the 'wchar_t' type.
+dnl Prerequisite: AC_PROG_CC
+
+AC_DEFUN([gt_TYPE_WCHAR_T],
+[
+  AC_CACHE_CHECK([for wchar_t], [gt_cv_c_wchar_t],
+    [AC_TRY_COMPILE([#include <stddef.h>
+       wchar_t foo = (wchar_t)'\0';], ,
+       [gt_cv_c_wchar_t=yes], [gt_cv_c_wchar_t=no])])
+  if test $gt_cv_c_wchar_t = yes; then
+    AC_DEFINE([HAVE_WCHAR_T], [1], [Define if you have the 'wchar_t' type.])
+  fi
+])
diff --git a/m4/wint_t.m4 b/m4/wint_t.m4
index 0026a1318..47a4363d7 100644
--- a/m4/wint_t.m4
+++ b/m4/wint_t.m4
@@ -1,5 +1,5 @@
-# wint_t.m4 serial 3 (gettext-0.18)
-dnl Copyright (C) 2003, 2007-2008 Free Software Foundation, Inc.
+# wint_t.m4 serial 4 (gettext-0.18)
+dnl Copyright (C) 2003, 2007-2009 Free Software Foundation, Inc.
 dnl This file is free software; the Free Software Foundation
 dnl gives unlimited permission to copy and/or distribute it,
 dnl with or without modifications, as long as this notice is preserved.
@@ -23,6 +23,6 @@ AC_DEFUN([gt_TYPE_WINT_T],
        wint_t foo = (wchar_t)'\0';], ,
        [gt_cv_c_wint_t=yes], [gt_cv_c_wint_t=no])])
   if test $gt_cv_c_wint_t = yes; then
-    AC_DEFINE([HAVE_WINT_T], 1, [Define if you have the 'wint_t' type.])
+    AC_DEFINE([HAVE_WINT_T], [1], [Define if you have the 'wint_t' type.])
   fi
 ])
diff --git a/m4/xsize.m4 b/m4/xsize.m4
new file mode 100644
index 000000000..631893cf5
--- /dev/null
+++ b/m4/xsize.m4
@@ -0,0 +1,13 @@
+# xsize.m4 serial 4
+dnl Copyright (C) 2003-2004, 2008 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN([gl_XSIZE],
+[
+  dnl Prerequisites of lib/xsize.h.
+  AC_REQUIRE([gl_SIZE_MAX])
+  AC_REQUIRE([AC_C_INLINE])
+  AC_CHECK_HEADERS([stdint.h])
+])
diff --git a/guile-config/ChangeLog-2008 b/meta/ChangeLog-2008
index d450f2536..d450f2536 100644
--- a/guile-config/ChangeLog-2008
+++ b/meta/ChangeLog-2008
diff --git a/meta/Makefile.am b/meta/Makefile.am
new file mode 100644
index 000000000..34e7f2cf3
--- /dev/null
+++ b/meta/Makefile.am
@@ -0,0 +1,35 @@
+## Process this file with Automake to create Makefile.in
+## Jim Blandy <jimb@red-bean.com> --- September 1997
+##
+##  	Copyright (C) 1998, 1999, 2001, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+##
+##   This file is part of GUILE.
+##   
+##   GUILE is free software; you can redistribute it and/or modify it
+##   under the terms of the GNU Lesser General Public License as
+##   published by the Free Software Foundation; either version 3, or
+##   (at your option) any later version.
+##   
+##   GUILE is distributed in the hope that it will be useful, but
+##   WITHOUT ANY WARRANTY; without even the implied warranty of
+##   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+##   GNU Lesser General Public License for more details.
+##   
+##   You should have received a copy of the GNU Lesser General Public
+##   License along with GUILE; see the file COPYING.LESSER.  If not,
+##   write to the Free Software Foundation, Inc., 51 Franklin Street,
+##   Fifth Floor, Boston, MA 02110-1301 USA
+
+bin_SCRIPTS = guile-config guile-tools
+EXTRA_DIST= $(bin_SCRIPTS)			\
+  guile.m4 ChangeLog-2008			\
+  guile-2.0.pc.in guile-2.0-uninstalled.pc.in	\
+  guile-tools.in
+
+pkgconfigdir = $(libdir)/pkgconfig
+pkgconfig_DATA = guile-2.0.pc
+
+## FIXME: in the future there will be direct automake support for
+## doing this.  When that happens, switch over.
+aclocaldir = $(datadir)/aclocal
+aclocal_DATA = guile.m4
diff --git a/meta/gdb-uninstalled-guile.in b/meta/gdb-uninstalled-guile.in
new file mode 100644
index 000000000..d55e215cb
--- /dev/null
+++ b/meta/gdb-uninstalled-guile.in
@@ -0,0 +1,40 @@
+#!/bin/sh
+
+#	Copyright (C) 2002, 2006, 2008, 2009 Free Software Foundation
+#
+#   This file is part of GUILE.
+#
+#   GUILE is free software; you can redistribute it and/or modify it
+#   under the terms of the GNU Lesser General Public License as
+#   published by the Free Software Foundation; either version 3, or
+#   (at your option) any later version.
+#
+#   GUILE is distributed in the hope that it will be useful, but
+#   WITHOUT ANY WARRANTY; without even the implied warranty of
+#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#   GNU Lesser General Public License for more details.
+#
+#   You should have received a copy of the GNU Lesser General Public
+#   License along with GUILE; see the file COPYING.LESSER.  If not,
+#   write to the Free Software Foundation, Inc., 51 Franklin Street,
+#   Fifth Floor, Boston, MA 02110-1301 USA
+
+# Commentary:
+
+# Usage: gdb-uninstalled-guile [ARGS]
+#
+# This script runs Guile from the build tree under GDB. See
+# ./guile for more information.
+#
+# In addition to running ./gdb-uninstalled-guile, sometimes it's useful to
+# run e.g. ./check-guile -i meta/gdb-uninstalled-guile foo.test.
+
+# Code:
+
+set -e
+# env (set by configure)
+top_builddir="@top_builddir_absolute@"
+XDG_CACHE_HOME=${top_builddir}/cache
+export XDG_CACHE_HOME
+exec ${top_builddir}/meta/uninstalled-env libtool --mode=execute \
+    gdb --args ${top_builddir}/libguile/guile "$@"
diff --git a/meta/guile-2.0-uninstalled.pc.in b/meta/guile-2.0-uninstalled.pc.in
new file mode 100644
index 000000000..6e687eabd
--- /dev/null
+++ b/meta/guile-2.0-uninstalled.pc.in
@@ -0,0 +1,8 @@
+builddir=@abs_top_builddir@
+srcdir=@abs_top_srcdir@
+
+Name: GNU Guile (uninstalled)
+Description: GNU's Ubiquitous Intelligent Language for Extension (uninstalled)
+Version: @GUILE_VERSION@
+Libs: -L${builddir}/libguile -lguile @GUILE_LIBS@
+Cflags: -I${srcdir} -I${builddir} @GUILE_CFLAGS@ @BDW_GC_CFLAGS@
diff --git a/guile-1.8.pc.in b/meta/guile-2.0.pc.in
index 15c83d84b..5cacaaa3e 100644
--- a/guile-1.8.pc.in
+++ b/meta/guile-2.0.pc.in
@@ -4,6 +4,7 @@ libdir=@libdir@
 includedir=@includedir@
 datarootdir=@datarootdir@
 datadir=@datadir@
+pkgdatadir=@datadir@/guile
 
 sitedir=@sitedir@
 libguileinterface=@LIBGUILE_INTERFACE@
@@ -12,4 +13,4 @@ Name: GNU Guile
 Description: GNU's Ubiquitous Intelligent Language for Extension
 Version: @GUILE_VERSION@
 Libs: -L${libdir} -lguile @GUILE_LIBS@
-Cflags: -I${includedir} @GUILE_CFLAGS@
+Cflags: -I${includedir} @GUILE_CFLAGS@ @BDW_GC_CFLAGS@
diff --git a/guile-config/guile-config.in b/meta/guile-config
index b782292d8..6c640c40c 100644..100755
--- a/guile-config/guile-config.in
+++ b/meta/guile-config
@@ -1,15 +1,15 @@
-#!@-bindir-@/guile \
--e main -s
+#!/bin/sh
+exec guile -e main -s $0 "$@"
 !#
 ;;;; guile-config --- utility for linking programs with Guile
 ;;;; Jim Blandy <jim@red-bean.com> --- September 1997
 ;;;; 
-;;;; 	Copyright (C) 1998, 2001, 2004, 2005, 2006, 2008 Free Software Foundation, Inc.
+;;;; 	Copyright (C) 1998, 2001, 2004, 2005, 2006, 2008, 2009 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -17,16 +17,14 @@
 ;;;; Lesser General Public License for more details.
 ;;;; 
 ;;;; You should have received a copy of the GNU Lesser General Public
-;;;; License along with this library; if not, write to the Free Software
-;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+;;;; License along with this library; if not, write to the Free
+;;;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;;;; Boston, MA 02110-1301 USA
 
-;;; TODO:
-;;; * Add some plausible structure for returning the right exit status,
-;;;   just something that encourages people to do the correct thing.
-;;; * Implement the static library support.  This requires that
-;;;   some portion of the module system be done.
+;;; This script has been deprecated. Just use pkg-config.
 
-(use-modules (ice-9 string-fun))
+(use-modules (ice-9 popen)
+             (ice-9 rdelim))
 
 
 ;;;; main function, command-line processing
@@ -47,7 +45,6 @@
 
 (define program-name #f)
 (define subcommand-name #f)
-(define program-version "@-GUILE_VERSION-@")
 
 ;;; Given an executable path PATH, set program-name to something
 ;;; appropriate f or use in error messages (i.e., with leading
@@ -74,8 +71,24 @@
     (dle "  " p " --help      - show usage info (this message)")
     (dle "  " p " --help SUBCOMMAND - show help for SUBCOMMAND")))
 
+(define guile-module "guile-2.0")
+
+(define (pkg-config . args)
+  (let* ((real-args (cons "pkg-config" args))
+         (pipe (apply open-pipe* OPEN_READ real-args))
+         (output (read-delimited "" pipe))
+         (ret (close-pipe pipe)))
+    (case (status:exit-val ret)
+      ((0) (if (eof-object? output) "" output))
+      (else (display-line-error
+             (format #f "error: ~s exited with non-zero error code ~A"
+                     (cons "pkg-config" args) (status:exit-val ret)))
+            ;; assume pkg-config sent diagnostics to stdout
+            (exit (status:exit-val ret))))))
+
 (define (show-version args)
-  (display-line-error program-name " - Guile version " program-version))
+  (format (current-error-port) "~A - Guile version ~A"
+          program-name (pkg-config "--modversion" guile-module)))
 
 (define (help-version)
   (let ((dle display-line-error))
@@ -98,69 +111,7 @@
 ;;; now, we're just going to reach into Guile's configuration info and
 ;;; hack it out.
 (define (build-link args)
-
-  ;; If PATH has the form FOO/libBAR.a, return the substring
-  ;; BAR, otherwise return #f.
-  (define (match-lib path)
-    (let* ((base (basename path))
-	   (len (string-length base)))
-      (if (and (> len 5)
-	       (string=? (substring base 0 3) "lib")
-	       (string=? (substring base (- len 2)) ".a"))
-	  (substring base 3 (- len 2))
-	  #f)))
-
-  (if (> (length args) 0)
-      (error
-       (string-append program-name
-		      " link: arguments to subcommand not yet implemented")))
-
-  (let ((libdir (get-build-info 'libdir))
-        (other-flags
-         (let loop ((libs
-                     ;; Get the string of linker flags we used to build
-                     ;; Guile, and break it up into a list.
-                     (separate-fields-discarding-char #\space
-                                                      (get-build-info 'LIBS)
-                                                      list)))
-            
-           (cond
-            ((null? libs) '())
-            
-            ;; Turn any "FOO/libBAR.a" elements into "-lBAR".
-            ((match-lib (car libs))
-             => (lambda (bar)
-                  (cons (string-append "-l" bar)
-                        (loop (cdr libs)))))
-            
-            ;; Remove any empty strings that may have seeped in there.
-            ((string=? (car libs) "") (loop (cdr libs)))
-            
-            (else (cons (car libs) (loop (cdr libs))))))))
-    
-    ;; Include libguile itself in the list, along with the directory
-    ;; it was installed in, but do *not* add /usr/lib since that may
-    ;; prevent other programs from specifying non-/usr/lib versions
-    ;; via their foo-config scripts.  If *any* app puts -L/usr/lib in
-    ;; the output of its foo-config script then it may prevent the use
-    ;; a non-/usr/lib install of anything that also has a /usr/lib
-    ;; install. For now we hard-code /usr/lib, but later maybe we can
-    ;; do something more dynamic (i.e. what do we need.
-    
-    ;; Display the flags, separated by spaces.
-    (display (string-join
-	      (list
-	       (get-build-info 'CFLAGS)
-               (if (or (string=? libdir "/usr/lib")
-                       (string=? libdir "/usr/lib/"))
-		   ""
-		   (string-append "-L" (get-build-info 'libdir)))
-               "-lguile -lltdl"
-	       (string-join other-flags)
-
-	       )))
-    (newline)))
-
+  (display (apply pkg-config "--libs" guile-module args)))
 
 (define (help-link)
   (let ((dle display-line-error))
@@ -178,23 +129,7 @@
 ;;;; The "compile" subcommand
 
 (define (build-compile args)
-  (if (> (length args) 0)
-      (error
-       (string-append program-name
-		      " compile: no arguments expected")))
-
-  ;; See gcc manual wrt fixincludes.  Search for "Use of
-  ;; `-I/usr/include' may cause trouble."  For now we hard-code this.
-  ;; Later maybe we can do something more dynamic.
-  (display
-   (string-append
-    (if (not (string=? (get-build-info 'includedir) "/usr/include"))
-	 (string-append "-I" (get-build-info 'includedir) " ")
-	 " ")
-    
-    (get-build-info 'CFLAGS)
-    "\n"
-    )))
+  (display (apply pkg-config "--cflags" guile-module args)))
 
 (define (help-compile)
   (let ((dle display-line-error))
@@ -211,44 +146,34 @@
 
 (define (build-info args)
   (cond
-   ((null? args) (show-all-vars))
-   ((null? (cdr args)) (show-var (car args)))
-   (else (display-line-error "Usage: " program-name " info [VAR]")
+   ((null? args)
+    (display-line-error "guile-config info with no args has been removed")
+    (quit 2))
+   ((null? (cdr args))
+    (cond
+     ((string=? (car args) "guileversion")
+      (display (pkg-config "--modversion" guile-module)))
+     (else
+      (display (pkg-config (format #f "--variable=~A" (car args))
+                           guile-module)))))
+   (else (display-line-error "Usage: " program-name " info VAR")
 	 (quit 2))))
 
-(define (show-all-vars)
-  (for-each (lambda (binding)
-	      (display-line (car binding) " = " (cdr binding)))
-	    %guile-build-info))
-
-(define (show-var var)
-  (display (get-build-info (string->symbol var)))
-  (newline))
-
 (define (help-info)
   (let ((d display-line-error))
-    (d "Usage: " program-name " info [VAR]")
-    (d "Display the value of the Makefile variable VAR used when Guile")
-    (d "was built.  If VAR is omitted, display all Makefile variables.")
+    (d "Usage: " program-name " info VAR")
+    (d "Display the value of the pkg-config variable VAR used when Guile")
+    (d "was built.\n")
     (d "Use this command to find out where Guile was installed,")
     (d "where it will look for Scheme code at run-time, and so on.")))
 
 (define (usage-info)
   (display-line-error
-   "  " program-name " info [VAR]  - print Guile build directories"))
+   "  " program-name " info VAR    - print Guile build directories"))
 
 
 ;;;; trivial utilities
 
-(define (get-build-info name)
-  (let ((val (assq name %guile-build-info)))
-    (if (not (pair? val))
-	(begin
-	  (display-line-error
-	   program-name " " subcommand-name ": no such build-info: " name)
-	  (quit 2)))
-    (cdr val)))
-
 (define (display-line . args)
   (apply display-line-port (current-output-port) args))
 
diff --git a/meta/guile-tools.in b/meta/guile-tools.in
new file mode 100755
index 000000000..51d103fe8
--- /dev/null
+++ b/meta/guile-tools.in
@@ -0,0 +1,116 @@
+#!/bin/sh
+# -*- scheme -*-
+exec guile $GUILE_FLAGS -e '(@@ (guile-tools) main)' -s "$0" "$@"
+!#
+
+;;;; guile-tools --- running scripts bundled with Guile
+;;;; Andy Wingo <wingo@pobox.com> --- April 2009
+;;;; 
+;;;; 	Copyright (C) 2009 Free Software Foundation, Inc.
+;;;; 
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free
+;;;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;;;; Boston, MA 02110-1301 USA
+
+(define-module (guile-tools))
+
+;; Hack to provide scripts with the bug-report address.
+(module-define! the-scm-module
+                '%guile-bug-report-address
+                "@PACKAGE_BUGREPORT@")
+
+
+;; We can't import srfi-1, unfortunately, as we are used early in the
+;; boot process, before the srfi-1 shlib is built.
+
+(define (fold kons seed seq)
+  (if (null? seq)
+      seed
+      (fold kons (kons (car seq) seed) (cdr seq))))
+
+(define (help)
+  (display "\
+Usage: guile-tools --version
+       guile-tools --help
+       guile-tools PROGRAM [ARGS]
+
+If PROGRAM is \"list\" or omitted, display available scripts, otherwise
+PROGRAM is run with ARGS.
+"))
+
+(define (directory-files dir)
+  (if (and (file-exists? dir) (file-is-directory? dir))
+      (let ((dir-stream (opendir dir)))
+        (let loop ((new (readdir dir-stream))
+                   (acc '()))
+          (if (eof-object? new)
+              (begin
+                (closedir dir-stream)
+                acc)
+              (loop (readdir dir-stream)
+                    (if (or (string=? "."  new)             ; ignore
+                            (string=? ".." new))            ; ignore
+                        acc
+                        (cons new acc))))))
+      '()))
+
+(define (strip-extensions path)
+  (or-map (lambda (ext)
+            (and
+             (string-suffix? ext path)
+             (substring path 0
+                        (- (string-length path) (string-length ext)))))
+          (append %load-compiled-extensions %load-extensions)))
+
+(define (unique l)
+  (cond ((null? l) l)
+        ((null? (cdr l)) l)
+        ((equal? (car l) (cadr l)) (unique (cdr l)))
+        (else (cons (car l) (unique (cdr l))))))
+
+;; for want of srfi-1
+(define (append-map f l)
+  (apply append (map f l)))
+
+(define (find-submodules head)
+  (let ((shead (map symbol->string head)))
+    (unique
+     (sort
+      (append-map (lambda (path)
+                    (fold (lambda (x rest)
+                            (let ((stripped (strip-extensions x)))
+                              (if stripped (cons stripped rest) rest)))
+                          '()
+                          (directory-files
+                           (fold (lambda (x y) (in-vicinity y x)) path shead))))
+                  %load-path)
+      string<?))))
+
+(define (list-scripts)
+  (for-each (lambda (x)
+              ;; would be nice to show a summary.
+              (format #t "~A\n" x))
+            (find-submodules '(scripts))))
+
+(define (find-script s)
+  (let ((m (resolve-module (append '(scripts) (list (string->symbol s))))))
+    (and (module-public-interface m)
+         m)))
+
+(define (main args)
+  (if (or (equal? (cdr args) '())
+          (equal? (cdr args) '("list")))
+      (list-scripts)
+      (let ((mod (find-script (cadr args))))
+        (exit (apply (module-ref mod 'main) (cddr args))))))
diff --git a/meta/guile.in b/meta/guile.in
new file mode 100644
index 000000000..d1ae0d4fa
--- /dev/null
+++ b/meta/guile.in
@@ -0,0 +1,53 @@
+#!/bin/sh
+
+#	Copyright (C) 2002, 2006, 2008, 2009 Free Software Foundation
+#
+#   This file is part of GUILE.
+#
+#   GUILE is free software; you can redistribute it and/or modify it
+#   under the terms of the GNU Lesser General Public License as
+#   published by the Free Software Foundation; either version 3, or
+#   (at your option) any later version.
+#
+#   GUILE is distributed in the hope that it will be useful, but
+#   WITHOUT ANY WARRANTY; without even the implied warranty of
+#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#   GNU Lesser General Public License for more details.
+#
+#   You should have received a copy of the GNU Lesser General Public
+#   License along with GUILE; see the file COPYING.LESSER.  If not,
+#   write to the Free Software Foundation, Inc., 51 Franklin Street,
+#   Fifth Floor, Boston, MA 02110-1301 USA
+
+# Commentary:
+
+# Usage: guile [ARGS]
+#
+# This script arranges for the environment to support, and eventaully execs,
+# the uninstalled binary guile executable located somewhere under libguile/,
+# passing ARGS to it.  In the process, env var GUILE is clobbered, and the
+# following env vars are modified (but not clobbered):
+#   GUILE_LOAD_PATH
+#   LTDL_LIBRARY_PATH
+#
+# This script can be used as a drop-in replacement for $bindir/guile;
+# if there is a discrepency in behavior, that's a bug.
+
+# Code:
+
+# env (set by configure)
+top_builddir="@top_builddir_absolute@"
+
+# set GUILE (clobber)
+GUILE=${top_builddir}/libguile/guile
+export GUILE
+XDG_CACHE_HOME=${top_builddir}/cache
+export XDG_CACHE_HOME
+
+# do it
+exec ${top_builddir}/meta/uninstalled-env $GUILE "$@"
+
+# never reached
+exit 1
+
+# guile ends here
diff --git a/guile-config/guile.m4 b/meta/guile.m4
index bcded2bdc..5ba725f51 100644
--- a/guile-config/guile.m4
+++ b/meta/guile.m4
@@ -3,9 +3,9 @@
 ##   Copyright (C) 1998,2001, 2006 Free Software Foundation, Inc.
 ##
 ## This library is free software; you can redistribute it and/or
-## modify it under the terms of the GNU Lesser General Public
-## License as published by the Free Software Foundation; either
-## version 2.1 of the License, or (at your option) any later version.
+## modify it under the terms of the GNU Lesser General Public License
+## as published by the Free Software Foundation; either version 3 of
+## the License, or (at your option) any later version.
 ## 
 ## This library is distributed in the hope that it will be useful,
 ## but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -14,7 +14,8 @@
 ## 
 ## You should have received a copy of the GNU Lesser General Public
 ## License along with this library; if not, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+## 02110-1301 USA
 
 # serial 9
 
@@ -107,7 +108,7 @@ AC_DEFUN([GUILE_FLAGS],
 AC_DEFUN([GUILE_SITE_DIR],
  [AC_REQUIRE([GUILE_PROGS])dnl
   AC_MSG_CHECKING(for Guile site directory)
-  GUILE_SITE=`[$GUILE_CONFIG] info pkgdatadir`/site
+  GUILE_SITE=`[$GUILE_CONFIG] info sitedir`
   AC_MSG_RESULT($GUILE_SITE)
   AC_SUBST(GUILE_SITE)
  ])
diff --git a/meta/uninstalled-env.in b/meta/uninstalled-env.in
new file mode 100644
index 000000000..9a6227230
--- /dev/null
+++ b/meta/uninstalled-env.in
@@ -0,0 +1,118 @@
+#!/bin/sh
+
+#	Copyright (C) 2003, 2006, 2008, 2009 Free Software Foundation
+#
+#   This file is part of GUILE.
+#
+# This script is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as
+# published by the Free Software Foundation; either version 3 of the
+# License, or (at your option) any later version.
+#
+# This library is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# Lesser General Public License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public
+# License along with this library; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 USA
+
+# NOTE: If you update this file, please update uninstalled.in as
+# well, if appropriate.
+
+# Usage: uninstalled-env [ARGS]
+
+# This script arranges for the environment to support running Guile
+# from the build tree.  The following env vars are modified (but not
+# clobbered): GUILE_LOAD_PATH, LTDL_LIBRARY_PATH, and PATH.
+
+# Example: uninstalled-env guile -c '(display "hello\n")'
+# Example: ../../uninstalled-env ./guile-test-foo
+
+# config
+subdirs_with_ltlibs="srfi guile-readline libguile"       # maintain me
+
+# env (set by configure)
+top_srcdir="@top_srcdir_absolute@"
+top_builddir="@top_builddir_absolute@"
+
+[ x"$top_srcdir"   = x -o ! -d "$top_srcdir" -o \
+  x"$top_builddir" = x -o ! -d "$top_builddir" ] && {
+    echo $0: bad environment
+    echo top_srcdir=$top_srcdir
+    echo top_builddir=$top_builddir
+    exit 1
+}
+
+if [ x"$GUILE_LOAD_PATH" = x ]
+then
+    if test "${top_srcdir}" != "${top_builddir}"; then
+        GUILE_LOAD_PATH="${top_builddir}/guile-readline:${top_srcdir}/guile-readline:${top_builddir}:${top_srcdir}:${top_builddir}/module:${top_srcdir}/module"
+    else
+        GUILE_LOAD_PATH="${top_srcdir}/guile-readline:${top_srcdir}:${top_srcdir}/module:${top_srcdir}/module"
+    fi
+else
+  for d in "${top_srcdir}" "${top_srcdir}/guile-readline" \
+           "${top_srcdir}/module" "${top_builddir}/module"
+  do
+    # This hair prevents double inclusion.
+    # The ":" prevents prefix aliasing.
+    case x"$GUILE_LOAD_PATH" in
+      x*${d}:*) ;;
+      *) GUILE_LOAD_PATH="${d}:$GUILE_LOAD_PATH" ;;
+    esac
+  done
+fi
+export GUILE_LOAD_PATH
+
+if [ x"$GUILE_LOAD_COMPILED_PATH" = x ]
+then
+  GUILE_LOAD_COMPILED_PATH="${top_builddir}/guile-readline:${top_builddir}:${top_builddir}/module"
+else
+  for d in "${top_builddir}" "${top_builddir}/guile-readline" \
+           "${top_builddir}/module"
+  do
+    # This hair prevents double inclusion.
+    # The ":" prevents prefix aliasing.
+    case x"$GUILE_LOAD_COMPILED_PATH" in
+      x*${d}:*) ;;
+      *) GUILE_LOAD_COMPILED_PATH="${d}:$GUILE_LOAD_COMPILED_PATH" ;;
+    esac
+  done
+fi
+export GUILE_LOAD_COMPILED_PATH
+
+# Don't look in installed dirs for guile modules
+if ( env | grep -v -q -E '^GUILE_SYSTEM_COMPILED_PATH=' ); then
+  export GUILE_SYSTEM_COMPILED_PATH=
+fi
+
+# handle LTDL_LIBRARY_PATH (no clobber)
+ltdl_prefix=""
+dyld_prefix=""
+for dir in $subdirs_with_ltlibs ; do
+    ltdl_prefix="${top_builddir}/${dir}:${ltdl_prefix}"
+    dyld_prefix="${top_builddir}/${dir}/.libs:${dyld_prefix}"
+done
+LTDL_LIBRARY_PATH="${ltdl_prefix}$LTDL_LIBRARY_PATH"
+export LTDL_LIBRARY_PATH
+DYLD_LIBRARY_PATH="${dyld_prefix}$DYLD_LIBRARY_PATH"
+export DYLD_LIBRARY_PATH
+
+if [ x"$PKG_CONFIG_PATH" = x ]
+then
+    PKG_CONFIG_PATH="${top_builddir}/meta"
+else
+    PKG_CONFIG_PATH="${top_builddir}/meta:$PKG_CONFIG_PATH"
+fi
+export PKG_CONFIG_PATH
+
+# handle PATH (no clobber)
+PATH="${top_builddir}/libguile:${PATH}"
+PATH="${top_srcdir}/meta:${PATH}"
+PATH="${top_builddir}/meta:${PATH}"
+export PATH
+
+exec "$@"
diff --git a/module/Makefile.am b/module/Makefile.am
new file mode 100644
index 000000000..668b8a597
--- /dev/null
+++ b/module/Makefile.am
@@ -0,0 +1,275 @@
+## Process this file with automake to produce Makefile.in.
+##
+##  	Copyright (C) 2009 Free Software Foundation, Inc.
+##
+##   This file is part of GUILE.
+##
+##   GUILE is free software; you can redistribute it and/or modify it
+##   under the terms of the GNU Lesser General Public License as
+##   published by the Free Software Foundation; either version 3, or
+##   (at your option) any later version.
+##
+##   GUILE is distributed in the hope that it will be useful, but
+##   WITHOUT ANY WARRANTY; without even the implied warranty of
+##   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+##   GNU Lesser General Public License for more details.
+##
+##   You should have received a copy of the GNU Lesser General Public
+##   License along with GUILE; see the file COPYING.LESSER.  If not,
+##   write to the Free Software Foundation, Inc., 51 Franklin Street,
+##   Fifth Floor, Boston, MA 02110-1301 USA
+
+include $(top_srcdir)/am/guilec
+
+# We're at the root of the module hierarchy.
+modpath =
+
+# Compile psyntax and boot-9 first, so that we get the speed benefit in
+# the rest of the compilation. Also, if there is too much switching back
+# and forth between interpreted and compiled code, we end up using more
+# of the C stack than the interpreter would have; so avoid that by
+# putting these core modules first.
+
+SOURCES =								\
+  ice-9/psyntax-pp.scm 							\
+  system/base/pmatch.scm system/base/syntax.scm				\
+  system/base/compile.scm system/base/language.scm			\
+  system/base/message.scm						\
+									\
+  language/tree-il.scm							\
+  language/glil.scm language/assembly.scm				\
+									\
+  $(SCHEME_LANG_SOURCES) 						\
+  $(TREE_IL_LANG_SOURCES)						\
+  $(GLIL_LANG_SOURCES)							\
+  $(ASSEMBLY_LANG_SOURCES) $(BYTECODE_LANG_SOURCES)			\
+  $(OBJCODE_LANG_SOURCES) $(VALUE_LANG_SOURCES)				\
+									\
+  $(ICE_9_SOURCES)							\
+  $(SRFI_SOURCES)							\
+  $(RNRS_SOURCES)							\
+  $(OOP_SOURCES)							\
+  $(SYSTEM_SOURCES)                                                     \
+  $(SCRIPTS_SOURCES)                                                    \
+  $(GHIL_LANG_SOURCES)                                                  \
+  $(ECMASCRIPT_LANG_SOURCES)						\
+  $(BRAINFUCK_LANG_SOURCES)
+
+## test.scm is not currently installed.
+EXTRA_DIST += ice-9/test.scm ice-9/compile-psyntax.scm ice-9/ChangeLog-2008
+
+# We expect this to never be invoked when there is not already
+# ice-9/psyntax-pp.scm in %load-path, since compile-psyntax.scm depends
+# on ice-9/syncase.scm, which does `(load-from-path "ice-9/psyntax-pp.scm")'.
+# In other words, to bootstrap this file, you need to do something like:
+#    GUILE_LOAD_PATH=/usr/local/share/guile/1.5.4 make psyntax-pp.scm
+include $(top_srcdir)/am/pre-inst-guile
+ice-9/psyntax-pp.scm: ice-9/psyntax.scm
+	$(preinstguile) --no-autocompile -s $(srcdir)/ice-9/compile-psyntax.scm \
+		$(srcdir)/ice-9/psyntax.scm $(srcdir)/ice-9/psyntax-pp.scm
+
+SCHEME_LANG_SOURCES =						\
+  language/scheme/compile-ghil.scm 				\
+  language/scheme/spec.scm					\
+  language/scheme/compile-tree-il.scm				\
+  language/scheme/decompile-tree-il.scm				\
+  language/scheme/inline.scm
+
+TREE_IL_LANG_SOURCES =						\
+  language/tree-il/primitives.scm				\
+  language/tree-il/optimize.scm                                 \
+  language/tree-il/inline.scm                                   \
+  language/tree-il/fix-letrec.scm                               \
+  language/tree-il/analyze.scm					\
+  language/tree-il/compile-glil.scm 				\
+  language/tree-il/spec.scm
+
+GHIL_LANG_SOURCES =						\
+  language/ghil.scm language/ghil/spec.scm language/ghil/compile-glil.scm
+
+GLIL_LANG_SOURCES =						\
+  language/glil/spec.scm language/glil/compile-assembly.scm 	\
+  language/glil/decompile-assembly.scm
+
+ASSEMBLY_LANG_SOURCES =				\
+  language/assembly/spec.scm			\
+  language/assembly/compile-bytecode.scm	\
+  language/assembly/decompile-bytecode.scm	\
+  language/assembly/disassemble.scm
+
+BYTECODE_LANG_SOURCES =				\
+  language/bytecode/spec.scm
+
+OBJCODE_LANG_SOURCES =				\
+  language/objcode/spec.scm
+
+VALUE_LANG_SOURCES =				\
+  language/value/spec.scm
+
+ECMASCRIPT_LANG_SOURCES =			\
+  language/ecmascript/parse-lalr.scm		\
+  language/ecmascript/tokenize.scm		\
+  language/ecmascript/parse.scm			\
+  language/ecmascript/impl.scm			\
+  language/ecmascript/base.scm			\
+  language/ecmascript/function.scm		\
+  language/ecmascript/array.scm			\
+  language/ecmascript/compile-tree-il.scm	\
+  language/ecmascript/spec.scm
+
+BRAINFUCK_LANG_SOURCES =			\
+  language/brainfuck/parse.scm			\
+  language/brainfuck/compile-scheme.scm		\
+  language/brainfuck/compile-tree-il.scm	\
+  language/brainfuck/spec.scm
+
+SCRIPTS_SOURCES =				\
+  scripts/PROGRAM.scm				\
+  scripts/autofrisk.scm				\
+  scripts/compile.scm				\
+  scripts/disassemble.scm			\
+  scripts/display-commentary.scm		\
+  scripts/doc-snarf.scm				\
+  scripts/frisk.scm				\
+  scripts/generate-autoload.scm			\
+  scripts/lint.scm				\
+  scripts/punify.scm				\
+  scripts/read-scheme-source.scm		\
+  scripts/read-text-outline.scm			\
+  scripts/use2dot.scm				\
+  scripts/snarf-check-and-output-texi.scm	\
+  scripts/summarize-guile-TODO.scm		\
+  scripts/scan-api.scm				\
+  scripts/api-diff.scm				\
+  scripts/read-rfc822.scm			\
+  scripts/snarf-guile-m4-docs.scm
+
+ICE_9_SOURCES = \
+  ice-9/boot-9.scm \
+  ice-9/r4rs.scm \
+  ice-9/r5rs.scm \
+  ice-9/and-let-star.scm \
+  ice-9/calling.scm \
+  ice-9/common-list.scm \
+  ice-9/debug.scm \
+  ice-9/debugger.scm \
+  ice-9/documentation.scm \
+  ice-9/emacs.scm \
+  ice-9/expect.scm \
+  ice-9/format.scm \
+  ice-9/getopt-long.scm \
+  ice-9/hcons.scm \
+  ice-9/i18n.scm \
+  ice-9/lineio.scm \
+  ice-9/ls.scm \
+  ice-9/mapping.scm \
+  ice-9/match.scm \
+  ice-9/networking.scm \
+  ice-9/null.scm \
+  ice-9/occam-channel.scm \
+  ice-9/optargs.scm \
+  ice-9/poe.scm \
+  ice-9/popen.scm \
+  ice-9/posix.scm \
+  ice-9/q.scm \
+  ice-9/rdelim.scm \
+  ice-9/receive.scm \
+  ice-9/regex.scm \
+  ice-9/runq.scm \
+  ice-9/rw.scm \
+  ice-9/safe-r5rs.scm \
+  ice-9/safe.scm \
+  ice-9/session.scm \
+  ice-9/slib.scm \
+  ice-9/stack-catch.scm \
+  ice-9/streams.scm \
+  ice-9/string-fun.scm \
+  ice-9/syncase.scm \
+  ice-9/threads.scm \
+  ice-9/buffered-input.scm \
+  ice-9/time.scm \
+  ice-9/history.scm \
+  ice-9/channel.scm \
+  ice-9/pretty-print.scm \
+  ice-9/ftw.scm \
+  ice-9/gap-buffer.scm \
+  ice-9/weak-vector.scm \
+  ice-9/deprecated.scm \
+  ice-9/list.scm \
+  ice-9/serialize.scm \
+  ice-9/gds-server.scm
+
+SRFI_SOURCES = \
+  srfi/srfi-1.scm \
+  srfi/srfi-2.scm \
+  srfi/srfi-4.scm \
+  srfi/srfi-4/gnu.scm \
+  srfi/srfi-6.scm \
+  srfi/srfi-8.scm \
+  srfi/srfi-9.scm \
+  srfi/srfi-10.scm \
+  srfi/srfi-11.scm \
+  srfi/srfi-13.scm \
+  srfi/srfi-14.scm \
+  srfi/srfi-16.scm \
+  srfi/srfi-17.scm \
+  srfi/srfi-18.scm \
+  srfi/srfi-19.scm \
+  srfi/srfi-26.scm \
+  srfi/srfi-31.scm \
+  srfi/srfi-34.scm \
+  srfi/srfi-35.scm \
+  srfi/srfi-37.scm \
+  srfi/srfi-39.scm \
+  srfi/srfi-60.scm \
+  srfi/srfi-69.scm \
+  srfi/srfi-88.scm \
+  srfi/srfi-98.scm
+
+RNRS_SOURCES =					\
+  rnrs/bytevector.scm				\
+  rnrs/io/ports.scm
+
+EXTRA_DIST += scripts/ChangeLog-2008
+EXTRA_DIST += scripts/README
+
+OOP_SOURCES = \
+  oop/goops.scm \
+  oop/goops/active-slot.scm \
+  oop/goops/compile.scm \
+  oop/goops/composite-slot.scm \
+  oop/goops/describe.scm \
+  oop/goops/dispatch.scm \
+  oop/goops/internal.scm \
+  oop/goops/save.scm \
+  oop/goops/stklos.scm \
+  oop/goops/util.scm \
+  oop/goops/accessors.scm \
+  oop/goops/simple.scm
+
+SYSTEM_SOURCES = \
+  system/vm/debug.scm system/vm/frame.scm system/vm/instruction.scm	\
+  system/vm/objcode.scm system/vm/profile.scm system/vm/program.scm	\
+  system/vm/trace.scm system/vm/vm.scm					\
+									\
+  system/xref.scm							\
+									\
+  system/repl/repl.scm system/repl/common.scm				\
+  system/repl/command.scm
+
+EXTRA_DIST += oop/ChangeLog-2008
+
+NOCOMP_SOURCES =				\
+  ice-9/gds-client.scm \
+  ice-9/psyntax.scm \
+  system/repl/describe.scm \
+  ice-9/debugger/command-loop.scm \
+  ice-9/debugger/commands.scm \
+  ice-9/debugger/state.scm \
+  ice-9/debugger/trc.scm \
+  ice-9/debugger/utils.scm \
+  ice-9/debugging/example-fns.scm \
+  ice-9/debugging/steps.scm \
+  ice-9/debugging/trace.scm \
+  ice-9/debugging/traps.scm \
+  ice-9/debugging/trc.scm
diff --git a/ice-9/ChangeLog-2008 b/module/ice-9/ChangeLog-2008
index 9007c0044..9007c0044 100644
--- a/ice-9/ChangeLog-2008
+++ b/module/ice-9/ChangeLog-2008
diff --git a/ice-9/README b/module/ice-9/README
index f659b9ee7..f659b9ee7 100644
--- a/ice-9/README
+++ b/module/ice-9/README
diff --git a/ice-9/and-let-star.scm b/module/ice-9/and-let-star.scm
index b8cb2a679..bfd597b1e 100644
--- a/ice-9/and-let-star.scm
+++ b/module/ice-9/and-let-star.scm
@@ -6,7 +6,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/module/ice-9/arrays.scm b/module/ice-9/arrays.scm
new file mode 100644
index 000000000..f7f9e5eed
--- /dev/null
+++ b/module/ice-9/arrays.scm
@@ -0,0 +1,22 @@
+;;; installed-scm-file
+
+;;;; Copyright (C) 1999, 2001, 2004, 2006 Free Software Foundation, Inc.
+;;;; 
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+;;;; 
+
+(define (array-shape a)
+  (map (lambda (ind) (if (number? ind) (list 0 (+ -1 ind)) ind))
+       (array-dimensions a)))
diff --git a/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 1a0283da1..21e3506cd 100644
--- a/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -1,12 +1,12 @@
 ;;; installed-scm-file
 
-;;;; Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008
+;;;; Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009
 ;;;; Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -33,6 +33,52 @@
 
 
 
+;; Before compiling, make sure any symbols are resolved in the (guile)
+;; module, the primary location of those symbols, rather than in
+;; (guile-user), the default module that we compile in.
+
+(eval-when (compile)
+  (set-current-module (resolve-module '(guile))))
+
+;;; {R4RS compliance}
+;;;
+
+(primitive-load-path "ice-9/r4rs")
+
+
+
+;;; {Simple Debugging Tools}
+;;;
+
+;; peek takes any number of arguments, writes them to the
+;; current ouput port, and returns the last argument.
+;; It is handy to wrap around an expression to look at
+;; a value each time is evaluated, e.g.:
+;;
+;;	(+ 10 (troublesome-fn))
+;;	=> (+ 10 (pk 'troublesome-fn-returned (troublesome-fn)))
+;;
+
+(define (peek . stuff)
+  (newline)
+  (display ";;; ")
+  (write stuff)
+  (newline)
+  (car (last-pair stuff)))
+
+(define pk peek)
+
+(define (warn . stuff)
+  (with-output-to-port (current-error-port)
+    (lambda ()
+      (newline)
+      (display ";;; WARNING ")
+      (display stuff)
+      (newline)
+      (car (last-pair stuff)))))
+
+
+
 ;;; {Features}
 ;;;
 
@@ -47,6 +93,42 @@
 (define (provided? feature)
   (and (memq feature *features*) #t))
 
+
+
+;;; {and-map and or-map}
+;;;
+;;; (and-map fn lst) is like (and (fn (car lst)) (fn (cadr lst)) (fn...) ...)
+;;; (or-map fn lst) is like (or (fn (car lst)) (fn (cadr lst)) (fn...) ...)
+;;;
+
+;; and-map f l
+;;
+;; Apply f to successive elements of l until exhaustion or f returns #f.
+;; If returning early, return #f.  Otherwise, return the last value returned
+;; by f.  If f has never been called because l is empty, return #t.
+;;
+(define (and-map f lst)
+  (let loop ((result #t)
+	     (l lst))
+    (and result
+	 (or (and (null? l)
+		  result)
+	     (loop (f (car l)) (cdr l))))))
+
+;; or-map f l
+;;
+;; Apply f to successive elements of l until exhaustion or while f returns #f.
+;; If returning early, return the return value of f.
+;;
+(define (or-map f lst)
+  (let loop ((result #f)
+	     (l lst))
+    (or result
+	(and (not (null? l))
+	     (loop (f (car l)) (cdr l))))))
+
+
+
 ;; let format alias simple-format until the more complete version is loaded
 
 (define format simple-format)
@@ -86,104 +168,213 @@
 
 
 
-;;; {EVAL-CASE}
-;;;
-
-;; (eval-case ((situation*) forms)* (else forms)?)
-;;
-;; Evaluate certain code based on the situation that eval-case is used
-;; in.  The only defined situation right now is `load-toplevel' which
-;; triggers for code evaluated at the top-level, for example from the
-;; REPL or when loading a file.
-
-(define eval-case
-  (procedure->memoizing-macro
-   (lambda (exp env)
-     (define (toplevel-env? env)
-       (or (not (pair? env)) (not (pair? (car env)))))
-     (define (syntax)
-       (error "syntax error in eval-case"))
-     (let loop ((clauses (cdr exp)))
-       (cond
-	((null? clauses)
-	 #f)
-	((not (list? (car clauses)))
-	 (syntax))
-	((eq? 'else (caar clauses))
-	 (or (null? (cdr clauses))
-	     (syntax))
-	 (cons 'begin (cdar clauses)))
-	((not (list? (caar clauses)))
-	 (syntax))
-	((and (toplevel-env? env)
-	      (memq 'load-toplevel (caar clauses)))
-	 (cons 'begin (cdar clauses)))
-	(else
-	 (loop (cdr clauses))))))))
+;; Define a minimal stub of the module API for psyntax, before modules
+;; have booted.
+(define (module-name x)
+  '(guile))
+(define (module-define! module sym val)
+  (let ((v (hashq-ref (%get-pre-modules-obarray) sym)))
+    (if v
+        (variable-set! v val)
+        (hashq-set! (%get-pre-modules-obarray) sym
+                    (make-variable val)))))
+(define (module-ref module sym)
+  (let ((v (module-variable module sym)))
+    (if v (variable-ref v) (error "badness!" (pk module) (pk sym)))))
+(define (resolve-module . args)
+  #f)
+
+;; Input hook to syncase -- so that we might be able to pass annotated
+;; expressions in. Currently disabled. Maybe we should just use
+;; source-properties directly.
+(define (annotation? x) #f)
+
+;; API provided by psyntax
+(define syntax-violation #f)
+(define datum->syntax #f)
+(define syntax->datum #f)
+(define identifier? #f)
+(define generate-temporaries #f)
+(define bound-identifier=? #f)
+(define free-identifier=? #f)
+(define sc-expand #f)
+
+;; $sc-expand is an implementation detail of psyntax. It is used by
+;; expanded macros, to dispatch an input against a set of patterns.
+(define $sc-dispatch #f)
+
+;; Load it up!
+(primitive-load-path "ice-9/psyntax-pp")
+
+;; %pre-modules-transformer is the Scheme expander from now until the
+;; module system has booted up.
+(define %pre-modules-transformer sc-expand)
+
+(define-syntax and
+  (syntax-rules ()
+    ((_) #t)
+    ((_ x) x)
+    ((_ x y ...) (if x (and y ...) #f))))
+
+(define-syntax or
+  (syntax-rules ()
+    ((_) #f)
+    ((_ x) x)
+    ((_ x y ...) (let ((t x)) (if t t (or y ...))))))
+
+;; The "maybe-more" bits are something of a hack, so that we can support
+;; SRFI-61. Rewrites into a standalone syntax-case macro would be
+;; appreciated.
+(define-syntax cond
+  (syntax-rules (=> else)
+    ((_ "maybe-more" test consequent)
+     (if test consequent))
+
+    ((_ "maybe-more" test consequent clause ...)
+     (if test consequent (cond clause ...)))
+
+    ((_ (else else1 else2 ...))
+     (begin else1 else2 ...))
+
+    ((_ (test => receiver) more-clause ...)
+     (let ((t test))
+       (cond "maybe-more" t (receiver t) more-clause ...)))
+
+    ((_ (generator guard => receiver) more-clause ...)
+     (call-with-values (lambda () generator)
+       (lambda t
+         (cond "maybe-more"
+               (apply guard t) (apply receiver t) more-clause ...))))
+
+    ((_ (test => receiver ...) more-clause ...)
+     (syntax-violation 'cond "wrong number of receiver expressions"
+                       '(test => receiver ...)))
+    ((_ (generator guard => receiver ...) more-clause ...)
+     (syntax-violation 'cond "wrong number of receiver expressions"
+                       '(generator guard => receiver ...)))
+    
+    ((_ (test) more-clause ...)
+     (let ((t test))
+       (cond "maybe-more" t t more-clause ...)))
+
+    ((_ (test body1 body2 ...) more-clause ...)
+     (cond "maybe-more"
+           test (begin body1 body2 ...) more-clause ...))))
+
+(define-syntax case
+  (syntax-rules (else)
+    ((case (key ...)
+       clauses ...)
+     (let ((atom-key (key ...)))
+       (case atom-key clauses ...)))
+    ((case key
+       (else result1 result2 ...))
+     (begin result1 result2 ...))
+    ((case key
+       ((atoms ...) result1 result2 ...))
+     (if (memv key '(atoms ...))
+         (begin result1 result2 ...)))
+    ((case key
+       ((atoms ...) result1 result2 ...)
+       clause clauses ...)
+     (if (memv key '(atoms ...))
+         (begin result1 result2 ...)
+         (case key clause clauses ...)))))
+
+(define-syntax do
+  (syntax-rules ()
+    ((do ((var init step ...) ...)
+         (test expr ...)
+         command ...)
+     (letrec
+       ((loop
+         (lambda (var ...)
+           (if test
+               (begin
+                 (if #f #f)
+                 expr ...)
+               (begin
+                 command
+                 ...
+                 (loop (do "step" var step ...)
+                       ...))))))
+       (loop init ...)))
+    ((do "step" x)
+     x)
+    ((do "step" x y)
+     y)))
+
+(define-syntax delay
+  (syntax-rules ()
+    ((_ exp) (make-promise (lambda () exp)))))
+
+;;; @bind is used by the old elisp code as a dynamic scoping mechanism.
+;;; Please let the Guile developers know if you are using this macro.
+;;;
+(define-syntax @bind
+  (lambda (x)
+    (define (bound-member id ids)
+      (cond ((null? ids) #f)
+            ((bound-identifier=? id (car ids)) #t)
+            ((bound-member (car ids) (cdr ids)))))
+    
+    (syntax-case x ()
+      ((_ () b0 b1 ...)
+       #'(let () b0 b1 ...))
+      ((_ ((id val) ...) b0 b1 ...)
+       (and-map identifier? #'(id ...))
+       (if (let lp ((ids #'(id ...)))
+             (cond ((null? ids) #f)
+                   ((bound-member (car ids) (cdr ids)) #t)
+                   (else (lp (cdr ids)))))
+           (syntax-violation '@bind "duplicate bound identifier" x)
+           (with-syntax (((old-v ...) (generate-temporaries #'(id ...)))
+                         ((v ...) (generate-temporaries #'(id ...))))
+             #'(let ((old-v id) ...
+                     (v val) ...)
+                 (dynamic-wind
+                   (lambda ()
+                     (set! id v) ...)
+                   (lambda () b0 b1 ...)
+                   (lambda ()
+                     (set! id old-v) ...)))))))))
+
 
 
 
 ;;; {Defmacros}
 ;;;
-;;; Depends on: features, eval-case
-;;;
-
-(define macro-table (make-weak-key-hash-table 61))
-(define xformer-table (make-weak-key-hash-table 61))
-
-(define (defmacro? m)  (hashq-ref macro-table m))
-(define (assert-defmacro?! m) (hashq-set! macro-table m #t))
-(define (defmacro-transformer m) (hashq-ref xformer-table m))
-(define (set-defmacro-transformer! m t) (hashq-set! xformer-table m t))
-
-(define defmacro:transformer
-  (lambda (f)
-    (let* ((xform (lambda (exp env)
-		    (copy-tree (apply f (cdr exp)))))
-	   (a (procedure->memoizing-macro xform)))
-      (assert-defmacro?! a)
-      (set-defmacro-transformer! a f)
-      a)))
-
 
-(define defmacro
-  (let ((defmacro-transformer
-	  (lambda (name parms . body)
-	    (let ((transformer `(lambda ,parms ,@body)))
-	      `(eval-case
-		((load-toplevel)
-		 (define ,name (defmacro:transformer ,transformer)))
-		(else
-		 (error "defmacro can only be used at the top level")))))))
-    (defmacro:transformer defmacro-transformer)))
-
-(define defmacro:syntax-transformer
-  (lambda (f)
-    (procedure->syntax
-	      (lambda (exp env)
-		(copy-tree (apply f (cdr exp)))))))
-
-
-;; XXX - should the definition of the car really be looked up in the
-;; current module?
-
-(define (macroexpand-1 e)
-  (cond
-   ((pair? e) (let* ((a (car e))
-		     (val (and (symbol? a) (local-ref (list a)))))
-		(if (defmacro? val)
-		    (apply (defmacro-transformer val) (cdr e))
-		    e)))
-   (#t e)))
-
-(define (macroexpand e)
-  (cond
-   ((pair? e) (let* ((a (car e))
-		     (val (and (symbol? a) (local-ref (list a)))))
-		(if (defmacro? val)
-		    (macroexpand (apply (defmacro-transformer val) (cdr e)))
-		    e)))
-   (#t e)))
+(define-syntax define-macro
+  (lambda (x)
+    "Define a defmacro."
+    (syntax-case x ()
+      ((_ (macro . args) doc body1 body ...)
+       (string? (syntax->datum (syntax doc)))
+       (syntax (define-macro macro doc (lambda args body1 body ...))))
+      ((_ (macro . args) body ...)
+       (syntax (define-macro macro #f (lambda args body ...))))
+      ((_ macro doc transformer)
+       (or (string? (syntax->datum (syntax doc)))
+           (not (syntax->datum (syntax doc))))
+       (syntax
+        (define-syntax macro
+          (lambda (y)
+            doc
+            (syntax-case y ()
+              ((_ . args)
+               (let ((v (syntax->datum (syntax args))))
+                 (datum->syntax y (apply transformer v))))))))))))
+
+(define-syntax defmacro
+  (lambda (x)
+    "Define a defmacro, with the old lispy defun syntax."
+    (syntax-case x ()
+      ((_ macro args doc body1 body ...)
+       (string? (syntax->datum (syntax doc)))
+       (syntax (define-macro macro doc (lambda args body1 body ...))))
+      ((_ macro args body ...)
+       (syntax (define-macro macro #f (lambda args body ...)))))))
 
 (provide 'defmacro)
 
@@ -196,47 +387,8 @@
 
 (defmacro begin-deprecated forms
   (if (include-deprecated-features)
-      (cons begin forms)
-      #f))
-
-
-
-;;; {R4RS compliance}
-;;;
-
-(primitive-load-path "ice-9/r4rs.scm")
-
-
-
-;;; {Simple Debugging Tools}
-;;;
-
-;; peek takes any number of arguments, writes them to the
-;; current ouput port, and returns the last argument.
-;; It is handy to wrap around an expression to look at
-;; a value each time is evaluated, e.g.:
-;;
-;;	(+ 10 (troublesome-fn))
-;;	=> (+ 10 (pk 'troublesome-fn-returned (troublesome-fn)))
-;;
-
-(define (peek . stuff)
-  (newline)
-  (display ";;; ")
-  (write stuff)
-  (newline)
-  (car (last-pair stuff)))
-
-(define pk peek)
-
-(define (warn . stuff)
-  (with-output-to-port (current-error-port)
-    (lambda ()
-      (newline)
-      (display ";;; WARNING ")
-      (display stuff)
-      (newline)
-      (car (last-pair stuff)))))
+      `(begin ,@forms)
+      `(begin)))
 
 
 
@@ -262,8 +414,12 @@
 (define (apply-to-args args fn) (apply fn args))
 
 (defmacro false-if-exception (expr)
-  `(catch #t (lambda () ,expr)
-	  (lambda args #f)))
+  `(catch #t
+     (lambda ()
+       ;; avoid saving backtraces inside false-if-exception
+       (with-fluid* the-last-stack (fluid-ref the-last-stack)
+         (lambda () ,expr)))
+     (lambda args #f)))
 
 
 
@@ -327,22 +483,6 @@
 
 
 
-;;; {Environments}
-;;;
-
-(define the-environment
-  (procedure->syntax
-   (lambda (x e)
-     e)))
-
-(define the-root-environment (the-environment))
-
-(define (environment-module env)
-  (let ((closure (and (pair? env) (car (last-pair env)))))
-    (and closure (procedure-property closure 'module))))
-
-
-
 ;;; {Records}
 ;;;
 
@@ -418,14 +558,14 @@
 
 (define (record-constructor rtd . opt)
   (let ((field-names (if (pair? opt) (car opt) (record-type-fields rtd))))
-    (local-eval `(lambda ,field-names
-		   (make-struct ',rtd 0 ,@(map (lambda (f)
-						 (if (memq f field-names)
-						     f
-						     #f))
-					       (record-type-fields rtd))))
-		the-root-environment)))
-
+    (primitive-eval
+     `(lambda ,field-names
+        (make-struct ',rtd 0 ,@(map (lambda (f)
+                                      (if (memq f field-names)
+                                          f
+                                          #f))
+                                    (record-type-fields rtd)))))))
+          
 (define (record-predicate rtd)
   (lambda (obj) (and (struct? obj) (eq? rtd (struct-vtable obj)))))
 
@@ -437,25 +577,22 @@
 		 #f)))
 
 (define (record-accessor rtd field-name)
-  (let* ((pos (list-index (record-type-fields rtd) field-name)))
+  (let ((pos (list-index (record-type-fields rtd) field-name)))
     (if (not pos)
 	(error 'no-such-field field-name))
-    (local-eval `(lambda (obj)
-                   (if (eq? (struct-vtable obj) ,rtd)
-                       (struct-ref obj ,pos)
-                       (%record-type-error ,rtd obj)))
-		the-root-environment)))
+    (lambda (obj)
+      (if (eq? (struct-vtable obj) rtd)
+          (struct-ref obj pos)
+          (%record-type-error rtd obj)))))
 
 (define (record-modifier rtd field-name)
-  (let* ((pos (list-index (record-type-fields rtd) field-name)))
+  (let ((pos (list-index (record-type-fields rtd) field-name)))
     (if (not pos)
 	(error 'no-such-field field-name))
-    (local-eval `(lambda (obj val)
-                   (if (eq? (struct-vtable obj) ,rtd)
-                       (struct-set! obj ,pos val)
-                       (%record-type-error ,rtd obj)))
-		the-root-environment)))
-
+    (lambda (obj val)
+      (if (eq? (struct-vtable obj) rtd)
+          (struct-set! obj pos val)
+          (%record-type-error rtd obj)))))
 
 (define (record? obj)
   (and (struct? obj) (record-type? (struct-vtable obj))))
@@ -503,53 +640,17 @@
 
 
 
-;;; {and-map and or-map}
-;;;
-;;; (and-map fn lst) is like (and (fn (car lst)) (fn (cadr lst)) (fn...) ...)
-;;; (or-map fn lst) is like (or (fn (car lst)) (fn (cadr lst)) (fn...) ...)
-;;;
-
-;; and-map f l
-;;
-;; Apply f to successive elements of l until exhaustion or f returns #f.
-;; If returning early, return #f.  Otherwise, return the last value returned
-;; by f.  If f has never been called because l is empty, return #t.
-;;
-(define (and-map f lst)
-  (let loop ((result #t)
-	     (l lst))
-    (and result
-	 (or (and (null? l)
-		  result)
-	     (loop (f (car l)) (cdr l))))))
-
-;; or-map f l
-;;
-;; Apply f to successive elements of l until exhaustion or while f returns #f.
-;; If returning early, return the return value of f.
-;;
-(define (or-map f lst)
-  (let loop ((result #f)
-	     (l lst))
-    (or result
-	(and (not (null? l))
-	     (loop (f (car l)) (cdr l))))))
-
-
-
 (if (provided? 'posix)
-    (primitive-load-path "ice-9/posix.scm"))
+    (primitive-load-path "ice-9/posix"))
 
 (if (provided? 'socket)
-    (primitive-load-path "ice-9/networking.scm"))
+    (primitive-load-path "ice-9/networking"))
 
 ;; For reference, Emacs file-exists-p uses stat in this same way.
-;; ENHANCE-ME: Catching an exception from stat is a bit wasteful, do this in
-;; C where all that's needed is to inspect the return from stat().
 (define file-exists?
   (if (provided? 'posix)
       (lambda (str)
-	(->bool (false-if-exception (stat str))))
+	(->bool (stat str #f)))
       (lambda (str)
 	(let ((port (catch 'system-error (lambda () (open-file str OPEN_READ))
 			   (lambda args #f))))
@@ -569,10 +670,7 @@
 	      #f)))))
 
 (define (has-suffix? str suffix)
-  (let ((sufl (string-length suffix))
-	(sl (string-length str)))
-    (and (> sl sufl)
-	 (string=? (substring str (- sl sufl) sl) suffix))))
+  (string-suffix? suffix str))
 
 (define (system-error-errno args)
   (if (eq? (car args) 'system-error)
@@ -768,6 +866,14 @@
 
 
 
+;;; {The interpreter stack}
+;;;
+
+(defmacro start-stack (tag exp)
+  `(%start-stack ,tag (lambda () ,exp)))
+
+
+
 ;;; {Loading by paths}
 ;;;
 
@@ -778,6 +884,61 @@
   (start-stack 'load-stack
 	       (primitive-load-path name)))
 
+(define %load-verbosely #f)
+(define (assert-load-verbosity v) (set! %load-verbosely v))
+
+(define (%load-announce file)
+  (if %load-verbosely
+      (with-output-to-port (current-error-port)
+	(lambda ()
+	  (display ";;; ")
+	  (display "loading ")
+	  (display file)
+	  (newline)
+	  (force-output)))))
+
+(set! %load-hook %load-announce)
+
+;;; Returns the .go file corresponding to `name'. Does not search load
+;;; paths, only the fallback path. If the .go file is missing or out of
+;;; date, and autocompilation is enabled, will try autocompilation, just
+;;; as primitive-load-path does internally. primitive-load is
+;;; unaffected. Returns #f if autocompilation failed or was disabled.
+(define (autocompiled-file-name name)
+  (catch #t
+    (lambda ()
+      (let* ((cfn ((@ (system base compile) compiled-file-name) name))
+             (scmstat (stat name))
+             (gostat (stat cfn #f)))
+        (if (and gostat (= (stat:mtime gostat) (stat:mtime scmstat)))
+            cfn
+            (begin
+              (if gostat
+                  (format (current-error-port)
+                    ";;; note: source file ~a\n;;;       newer than compiled ~a\n"
+                    name cfn))
+              (cond
+               (%load-should-autocompile
+                (%warn-autocompilation-enabled)
+                (format (current-error-port) ";;; compiling ~a\n" name)
+                (let ((cfn ((@ (system base compile) compile-file) name)))
+                  (format (current-error-port) ";;; compiled ~a\n" cfn)
+                  cfn))
+               (else #f))))))
+    (lambda (k . args)
+      (format (current-error-port)
+              ";;; WARNING: compilation of ~a failed:\n;;; key ~a, throw_args ~s\n"
+              name k args)
+      #f)))
+
+(define (load name . reader)
+  (with-fluid* current-reader (and (pair? reader) (car reader))
+    (lambda ()
+      (let ((cfn (autocompiled-file-name name)))
+        (if cfn
+            (load-compiled cfn)
+            (start-stack 'load-stack
+                         (primitive-load name)))))))
 
 
 
@@ -869,9 +1030,6 @@
 ;;; Reader code for various "#c" forms.
 ;;;
 
-(read-hash-extend #\' (lambda (c port)
-			(read port)))
-
 (define read-eval? (make-fluid))
 (fluid-set! read-eval? #f)
 (read-hash-extend #\.
@@ -1154,11 +1312,8 @@
 (define (%print-module mod port)  ; unused args: depth length style table)
   (display "#<" port)
   (display (or (module-kind mod) "module") port)
-  (let ((name (module-name mod)))
-    (if name
-	(begin
-	  (display " " port)
-	  (display name port))))
+  (display " " port)
+  (display (module-name mod) port)
   (display " " port)
   (display (number->string (object-address mod) 16) port)
   (display ">" port))
@@ -1215,7 +1370,8 @@
 	     "Lazy-binder expected to be a procedure or #f." binder))
 
 	(let ((module (module-constructor (make-hash-table size)
-					  uses binder #f #f #f #f #f
+					  uses binder #f %pre-modules-transformer
+                                          #f #f #f
 					  (make-hash-table %default-import-size)
 					  '()
 					  (make-weak-key-hash-table 31))))
@@ -1240,7 +1396,7 @@
 
 (define module-transformer (record-accessor module-type 'transformer))
 (define set-module-transformer! (record-modifier module-type 'transformer))
-(define module-name (record-accessor module-type 'name))
+;; (define module-name (record-accessor module-type 'name)) wait until mods are booted
 (define set-module-name! (record-modifier module-type 'name))
 (define module-kind (record-accessor module-type 'kind))
 (define set-module-kind! (record-modifier module-type 'kind))
@@ -1306,7 +1462,7 @@
   *unspecified*)
 
 (define module-defer-observers #f)
-(define module-defer-observers-mutex (make-mutex))
+(define module-defer-observers-mutex (make-mutex 'recursive))
 (define module-defer-observers-table (make-hash-table))
 
 (define (module-modified m)
@@ -1394,7 +1550,9 @@
 ;; or its uses?
 ;;
 (define (module-bound? m v)
-  (module-search module-locally-bound? m v))
+  (let ((var (module-variable m v)))
+    (and var
+	 (variable-bound? var))))
 
 ;;; {Is a symbol interned in a module?}
 ;;;
@@ -1695,7 +1853,8 @@
 ;; Add INTERFACE to the list of interfaces used by MODULE.
 ;;
 (define (module-use! module interface)
-  (if (not (eq? module interface))
+  (if (not (or (eq? module interface)
+               (memq interface (module-uses module))))
       (begin
         ;; Newly used modules must be appended rather than consed, so that
         ;; `module-variable' traverses the use list starting from the first
@@ -1803,8 +1962,7 @@
 ;;; The directory of all modules and the standard root module.
 ;;;
 
-(define (module-public-interface m)
-  (module-ref m '%module-public-interface #f))
+;; module-public-interface is defined in C.
 (define (set-module-public-interface! m i)
   (module-define! m '%module-public-interface i))
 (define (set-system-module! m s)
@@ -1815,23 +1973,26 @@
 (set-module-name! the-root-module '(guile))
 (set-module-name! the-scm-module '(guile))
 (set-module-kind! the-scm-module 'interface)
-(for-each set-system-module! (list the-root-module the-scm-module) '(#t #t))
+(set-system-module! the-root-module #t)
+(set-system-module! the-scm-module #t)
 
 ;; NOTE: This binding is used in libguile/modules.c.
 ;;
 (define (make-modules-in module name)
   (if (null? name)
       module
-      (cond
-       ((module-ref module (car name) #f)
-	=> (lambda (m) (make-modules-in m (cdr name))))
-       (else	(let ((m (make-module 31)))
-		  (set-module-kind! m 'directory)
-		  (set-module-name! m (append (or (module-name module)
-						  '())
-					      (list (car name))))
-		  (module-define! module (car name) m)
-		  (make-modules-in m (cdr name)))))))
+      (make-modules-in
+       (let* ((var (module-local-variable module (car name)))
+              (val (and var (variable-bound? var) (variable-ref var))))
+         (if (module? val)
+             val
+             (let ((m (make-module 31)))
+               (set-module-kind! m 'directory)
+               (set-module-name! m (append (module-name module)
+                                           (list (car name))))
+               (module-define! module (car name) m)
+               m)))
+       (cdr name))))
 
 (define (beautify-user-module! module)
   (let ((interface (module-public-interface module)))
@@ -1848,25 +2009,28 @@
 
 ;; NOTE: This binding is used in libguile/modules.c.
 ;;
-(define (resolve-module name . maybe-autoload)
-  (let ((full-name (append '(%app modules) name)))
-    (let ((already (nested-ref the-root-module full-name)))
-      (if already
-	  ;; The module already exists...
-	  (if (and (or (null? maybe-autoload) (car maybe-autoload))
-		   (not (module-public-interface already)))
-	      ;; ...but we are told to load and it doesn't contain source, so
-	      (begin
-		(try-load-module name)
-		already)
-	      ;; simply return it.
-	      already)
-	  (begin
-	    ;; Try to autoload it if we are told so
-	    (if (or (null? maybe-autoload) (car maybe-autoload))
-		(try-load-module name))
-	    ;; Get/create it.
-	    (make-modules-in (current-module) full-name))))))
+(define resolve-module
+  (let ((the-root-module the-root-module))
+    (lambda (name . maybe-autoload)
+      (if (equal? name '(guile))
+          the-root-module
+          (let ((full-name (append '(%app modules) name)))
+            (let ((already (nested-ref the-root-module full-name))
+                  (autoload (or (null? maybe-autoload) (car maybe-autoload))))
+              (cond
+               ((and already (module? already)
+                     (or (not autoload) (module-public-interface already)))
+                ;; A hit, a palpable hit.
+                already)
+               (autoload
+                ;; Try to autoload the module, and recurse.
+                (try-load-module name)
+                (resolve-module name #f))
+               (else
+                ;; A module is not bound (but maybe something else is),
+                ;; we're not autoloading -- here's the weird semantics,
+                ;; we create an empty module.
+                (make-modules-in the-root-module full-name)))))))))
 
 ;; Cheat.  These bindings are needed by modules.c, but we don't want
 ;; to move their real definition here because that would be unnatural.
@@ -1877,22 +2041,37 @@
 (define module-export! #f)
 (define default-duplicate-binding-procedures #f)
 
+(define %app (make-module 31))
+(set-module-name! %app '(%app))
+(define app %app) ;; for backwards compatability
+
+(let ((m (make-module 31)))
+  (set-module-name! m '())
+  (local-define '(%app modules) m))
+(local-define '(%app modules guile) the-root-module)
+
 ;; This boots the module system.  All bindings needed by modules.c
 ;; must have been defined by now.
 ;;
 (set-current-module the-root-module)
-
-(define %app (make-module 31))
-(define app %app) ;; for backwards compatability
-(local-define '(%app modules) (make-module 31))
-(local-define '(%app modules guile) the-root-module)
+;; definition deferred for syncase's benefit.
+(define module-name
+  (let ((accessor (record-accessor module-type 'name)))
+    (lambda (mod)
+      (or (accessor mod)
+          (let ((name (list (gensym))))
+            ;; Name MOD and bind it in THE-ROOT-MODULE so that it's visible
+            ;; to `resolve-module'.  This is important as `psyntax' stores
+            ;; module names and relies on being able to `resolve-module'
+            ;; them.
+            (set-module-name! mod name)
+            (nested-define! the-root-module `(%app modules ,@name) mod)
+            (accessor mod))))))
 
 ;; (define-special-value '(%app modules new-ws) (lambda () (make-scm-module)))
 
 (define (try-load-module name)
-  (or (begin-deprecated (try-module-linked name))
-      (try-module-autoload name)
-      (begin-deprecated (try-module-dynamic-link name))))
+  (try-module-autoload name))
 
 (define (purify-module! module)
   "Removes bindings in MODULE which are inherited from the (guile) module."
@@ -2007,98 +2186,109 @@
                          (error "unrecognized define-module argument" arg))))
     (beautify-user-module! module)
     (let loop ((kws kws)
-	       (reversed-interfaces '())
-	       (exports '())
-	       (re-exports '())
-	       (replacements '())
+               (reversed-interfaces '())
+               (exports '())
+               (re-exports '())
+               (replacements '())
                (autoloads '()))
 
       (if (null? kws)
-	  (call-with-deferred-observers
-	   (lambda ()
-	     (module-use-interfaces! module (reverse reversed-interfaces))
-	     (module-export! module exports)
-	     (module-replace! module replacements)
-	     (module-re-export! module re-exports)
+          (call-with-deferred-observers
+           (lambda ()
+             (module-use-interfaces! module (reverse reversed-interfaces))
+             (module-export! module exports)
+             (module-replace! module replacements)
+             (module-re-export! module re-exports)
              (if (not (null? autoloads))
                  (apply module-autoload! module autoloads))))
-	  (case (car kws)
-	    ((#:use-module #:use-syntax)
-	     (or (pair? (cdr kws))
-		 (unrecognized kws))
-	     (let* ((interface-args (cadr kws))
-		    (interface (apply resolve-interface interface-args)))
-	       (and (eq? (car kws) #:use-syntax)
-		    (or (symbol? (caar interface-args))
-			(error "invalid module name for use-syntax"
-			       (car interface-args)))
-		    (set-module-transformer!
-		     module
-		     (module-ref interface
-				 (car (last-pair (car interface-args)))
-				 #f)))
-	       (loop (cddr kws)
-		     (cons interface reversed-interfaces)
-		     exports
-		     re-exports
-		     replacements
-                     autoloads)))
-	    ((#:autoload)
-	     (or (and (pair? (cdr kws)) (pair? (cddr kws)))
-		 (unrecognized kws))
-	     (loop (cdddr kws)
+          (case (car kws)
+            ((#:use-module #:use-syntax)
+             (or (pair? (cdr kws))
+                 (unrecognized kws))
+             (cond
+              ((equal? (caadr kws) '(ice-9 syncase))
+               (issue-deprecation-warning
+                "(ice-9 syncase) is deprecated. Support for syntax-case is now in Guile core.")
+               (loop (cddr kws)
+                     reversed-interfaces
+                     exports
+                     re-exports
+                     replacements
+                     autoloads))
+              (else
+               (let* ((interface-args (cadr kws))
+                      (interface (apply resolve-interface interface-args)))
+                 (and (eq? (car kws) #:use-syntax)
+                      (or (symbol? (caar interface-args))
+                          (error "invalid module name for use-syntax"
+                                 (car interface-args)))
+                      (set-module-transformer!
+                       module
+                       (module-ref interface
+                                   (car (last-pair (car interface-args)))
+                                   #f)))
+                 (loop (cddr kws)
+                       (cons interface reversed-interfaces)
+                       exports
+                       re-exports
+                       replacements
+                       autoloads)))))
+            ((#:autoload)
+             (or (and (pair? (cdr kws)) (pair? (cddr kws)))
+                 (unrecognized kws))
+             (loop (cdddr kws)
                    reversed-interfaces
-		   exports
-		   re-exports
-		   replacements
+                   exports
+                   re-exports
+                   replacements
                    (let ((name (cadr kws))
                          (bindings (caddr kws)))
                      (cons* name bindings autoloads))))
-	    ((#:no-backtrace)
-	     (set-system-module! module #t)
-	     (loop (cdr kws) reversed-interfaces exports re-exports
+            ((#:no-backtrace)
+             (set-system-module! module #t)
+             (loop (cdr kws) reversed-interfaces exports re-exports
                    replacements autoloads))
-	    ((#:pure)
-	     (purify-module! module)
-	     (loop (cdr kws) reversed-interfaces exports re-exports
+            ((#:pure)
+             (purify-module! module)
+             (loop (cdr kws) reversed-interfaces exports re-exports
                    replacements autoloads))
-	    ((#:duplicates)
-	     (if (not (pair? (cdr kws)))
-		 (unrecognized kws))
-	     (set-module-duplicates-handlers!
-	      module
-	      (lookup-duplicates-handlers (cadr kws)))
-	     (loop (cddr kws) reversed-interfaces exports re-exports
+            ((#:duplicates)
+             (if (not (pair? (cdr kws)))
+                 (unrecognized kws))
+             (set-module-duplicates-handlers!
+              module
+              (lookup-duplicates-handlers (cadr kws)))
+             (loop (cddr kws) reversed-interfaces exports re-exports
                    replacements autoloads))
-	    ((#:export #:export-syntax)
-	     (or (pair? (cdr kws))
-		 (unrecognized kws))
-	     (loop (cddr kws)
-		   reversed-interfaces
-		   (append (cadr kws) exports)
-		   re-exports
-		   replacements
+            ((#:export #:export-syntax)
+             (or (pair? (cdr kws))
+                 (unrecognized kws))
+             (loop (cddr kws)
+                   reversed-interfaces
+                   (append (cadr kws) exports)
+                   re-exports
+                   replacements
                    autoloads))
-	    ((#:re-export #:re-export-syntax)
-	     (or (pair? (cdr kws))
-		 (unrecognized kws))
-	     (loop (cddr kws)
-		   reversed-interfaces
-		   exports
-		   (append (cadr kws) re-exports)
-		   replacements
+            ((#:re-export #:re-export-syntax)
+             (or (pair? (cdr kws))
+                 (unrecognized kws))
+             (loop (cddr kws)
+                   reversed-interfaces
+                   exports
+                   (append (cadr kws) re-exports)
+                   replacements
                    autoloads))
-	    ((#:replace #:replace-syntax)
-	     (or (pair? (cdr kws))
-		 (unrecognized kws))
-	     (loop (cddr kws)
-		   reversed-interfaces
-		   exports
-		   re-exports
-		   (append (cadr kws) replacements)
+            ((#:replace #:replace-syntax)
+             (or (pair? (cdr kws))
+                 (unrecognized kws))
+             (loop (cddr kws)
+                   reversed-interfaces
+                   exports
+                   re-exports
+                   (append (cadr kws) replacements)
                    autoloads))
-	    (else
-	     (unrecognized kws)))))
+            (else
+             (unrecognized kws)))))
     (run-hook module-defined-hook module)
     module))
 
@@ -2145,10 +2335,6 @@ module '(ice-9 q) '(make-q q-length))}."
              (loop (cddr args)))))))
 
 
-;;; {Compiled module}
-
-(define load-compiled #f)
-
 
 
 ;;; {Autoloading modules}
@@ -2170,21 +2356,15 @@ module '(ice-9 q) '(make-q q-length))}."
     (resolve-module dir-hint-module-name #f)
     (and (not (autoload-done-or-in-progress? dir-hint name))
 	 (let ((didit #f))
-	   (define (load-file proc file)
-	     (save-module-excursion (lambda () (proc file)))
-	     (set! didit #t))
 	   (dynamic-wind
 	    (lambda () (autoload-in-progress! dir-hint name))
 	    (lambda ()
-	      (let ((file (in-vicinity dir-hint name)))
-		(cond ((and load-compiled
-			    (%search-load-path (string-append file ".go")))
-		       => (lambda (full)
-			    (load-file load-compiled full)))
-		      ((%search-load-path file)
-		       => (lambda (full)
-			    (with-fluids ((current-reader #f))
-			      (load-file primitive-load full)))))))
+	      (with-fluid* current-reader #f
+                (lambda ()
+                  (save-module-excursion
+                   (lambda () 
+                     (primitive-load-path (in-vicinity dir-hint name) #f)
+                     (set! didit #t))))))
 	    (lambda () (set-autoloaded! dir-hint name didit)))
 	   didit))))
 
@@ -2225,22 +2405,10 @@ module '(ice-9 q) '(make-q q-length))}."
 ;;; {Run-time options}
 ;;;
 
-(define define-option-interface
-  (let* ((option-name car)
-	 (option-value cadr)
-	 (option-documentation caddr)
-
-	 (print-option (lambda (option)
-			 (display (option-name option))
-			 (if (< (string-length
-				 (symbol->string (option-name option)))
-				8)
-			     (display #\tab))
-			 (display #\tab)
-			 (display (option-value option))
-			 (display #\tab)
-			 (display (option-documentation option))
-			 (newline)))
+(defmacro define-option-interface (option-group)
+  (let* ((option-name 'car)
+	 (option-value 'cadr)
+	 (option-documentation 'caddr)
 
 	 ;; Below follow the macros defining the run-time option interfaces.
 
@@ -2249,8 +2417,19 @@ module '(ice-9 q) '(make-q q-length))}."
 			    (cond ((null? args) (,interface))
 				  ((list? (car args))
 				   (,interface (car args)) (,interface))
-				  (else (for-each ,print-option
-						  (,interface #t)))))))
+				  (else (for-each
+                                         (lambda (option)
+                                           (display (,option-name option))
+                                           (if (< (string-length
+                                                   (symbol->string (,option-name option)))
+                                                  8)
+                                               (display #\tab))
+                                           (display #\tab)
+                                           (display (,option-value option))
+                                           (display #\tab)
+                                           (display (,option-documentation option))
+                                           (newline))
+                                         (,interface #t)))))))
 
 	 (make-enable (lambda (interface)
 			`(lambda flags
@@ -2265,22 +2444,19 @@ module '(ice-9 q) '(make-q q-length))}."
 					flags)
 			      (,interface options)
 			      (,interface))))))
-    (procedure->memoizing-macro
-     (lambda (exp env)
-       (let* ((option-group (cadr exp))
-	      (interface (car option-group))
-	      (options/enable/disable (cadr option-group)))
-	 `(begin
-	    (define ,(car options/enable/disable)
-	      ,(make-options interface))
-	    (define ,(cadr options/enable/disable)
-	      ,(make-enable interface))
-	    (define ,(caddr options/enable/disable)
-	      ,(make-disable interface))
-	    (defmacro ,(caaddr option-group) (opt val)
-	      `(,,(car options/enable/disable)
-		(append (,,(car options/enable/disable))
-			(list ',opt ,val))))))))))
+    (let* ((interface (car option-group))
+           (options/enable/disable (cadr option-group)))
+      `(begin
+         (define ,(car options/enable/disable)
+           ,(make-options interface))
+         (define ,(cadr options/enable/disable)
+           ,(make-enable interface))
+         (define ,(caddr options/enable/disable)
+           ,(make-disable interface))
+         (defmacro ,(caaddr option-group) (opt val)
+           `(,',(car options/enable/disable)
+             (append (,',(car options/enable/disable))
+                     (list ',opt ,val))))))))
 
 (define-option-interface
   (eval-options-interface
@@ -2335,12 +2511,13 @@ module '(ice-9 q) '(make-q q-length))}."
 
 (define (set-repl-prompt! v) (set! scm-repl-prompt v))
 
-(define (default-lazy-handler key . args)
-  (save-stack lazy-handler-dispatch)
+(define (default-pre-unwind-handler key . args)
+  (save-stack 1)
   (apply throw key args))
 
-(define (lazy-handler-dispatch key . args)
-  (apply default-lazy-handler key args))
+(begin-deprecated
+ (define (pre-unwind-handler-dispatch key . args)
+   (apply default-pre-unwind-handler key args)))
 
 (define abort-hook (make-hook))
 
@@ -2417,15 +2594,7 @@ module '(ice-9 q) '(make-q q-length))}."
 				 (else
 				  (apply bad-throw key args)))))))
 
-		    ;; Note that having just `lazy-handler-dispatch'
-		    ;; here is connected with the mechanism that
-		    ;; produces a nice backtrace upon error.  If, for
-		    ;; example, this is replaced with (lambda args
-		    ;; (apply lazy-handler-dispatch args)), the stack
-		    ;; cutting (in save-stack) goes wrong and ends up
-		    ;; saving no stack at all, so there is no
-		    ;; backtrace.
-		    lazy-handler-dispatch)))
+                    default-pre-unwind-handler)))
 
 	(if next (loop next) status)))
     (set! set-batch-mode?! (lambda (arg)
@@ -2536,7 +2705,7 @@ module '(ice-9 q) '(make-q q-length))}."
 ;;; the readline library.
 (define repl-reader
   (lambda (prompt)
-    (display prompt)
+    (display (if (string? prompt) prompt (prompt)))
     (force-output)
     (run-hook before-read-hook)
     ((or (fluid-ref current-reader) read) (current-input-port))))
@@ -2700,46 +2869,6 @@ module '(ice-9 q) '(make-q q-length))}."
 	`(with-fluids* (list ,@fluids) (list ,@values)
 		       (lambda () ,@body)))))
 
-
-
-;;; {Macros}
-;;;
-
-;; actually....hobbit might be able to hack these with a little
-;; coaxing
-;;
-
-(define (primitive-macro? m)
-  (and (macro? m)
-       (not (macro-transformer m))))
-
-(defmacro define-macro (first . rest)
-  (let ((name (if (symbol? first) first (car first)))
-	(transformer
-	 (if (symbol? first)
-	     (car rest)
-	     `(lambda ,(cdr first) ,@rest))))
-    `(eval-case
-      ((load-toplevel)
-       (define ,name (defmacro:transformer ,transformer)))
-      (else
-       (error "define-macro can only be used at the top level")))))
-
-
-(defmacro define-syntax-macro (first . rest)
-  (let ((name (if (symbol? first) first (car first)))
-	(transformer
-	 (if (symbol? first)
-	     (car rest)
-	     `(lambda ,(cdr first) ,@rest))))
-    `(eval-case
-      ((load-toplevel)
-       (define ,name (defmacro:syntax-transformer ,transformer)))
-      (else
-       (error "define-syntax-macro can only be used at the top level")))))
-
-
-
 ;;; {While}
 ;;;
 ;;; with `continue' and `break'.
@@ -2748,32 +2877,25 @@ module '(ice-9 q) '(make-q q-length))}."
 ;; The inner `do' loop avoids re-establishing a catch every iteration,
 ;; that's only necessary if continue is actually used.  A new key is
 ;; generated every time, so break and continue apply to their originating
-;; `while' even when recursing.  `while-helper' is an easy way to keep the
-;; `key' binding away from the cond and body code.
-;;
-;; FIXME: This is supposed to have an `unquote' on the `do' the same used
-;; for lambda and not, so as to protect against any user rebinding of that
-;; symbol, but unfortunately an unquote breaks with ice-9 syncase, eg.
+;; `while' even when recursing.
 ;;
-;;     (use-modules (ice-9 syncase))
-;;     (while #f)
-;;     => ERROR: invalid syntax ()
-;;
-;; This is probably a bug in syncase.
+;; FIXME: This macro is unintentionally unhygienic with respect to let,
+;; make-symbol, do, throw, catch, lambda, and not.
 ;;
 (define-macro (while cond . body)
-  (define (while-helper proc)
-    (do ((key (make-symbol "while-key")))
-	((catch key
-		(lambda ()
-		  (proc (lambda () (throw key #t))
-			(lambda () (throw key #f))))
-		(lambda (key arg) arg)))))
-  `(,while-helper (,lambda (break continue)
-		    (do ()
-			((,not ,cond))
-		      ,@body)
-		    #t)))
+  (let ((keyvar (make-symbol "while-keyvar")))
+    `(let ((,keyvar (make-symbol "while-key")))
+       (do ()
+           ((catch ,keyvar
+                   (lambda ()
+                     (let ((break (lambda () (throw ,keyvar #t)))
+                           (continue (lambda () (throw ,keyvar #f))))
+                       (do ()
+                           ((not ,cond))
+                         ,@body)
+                       #t))
+                   (lambda (key arg)
+                     arg)))))))
 
 
 
@@ -2784,6 +2906,11 @@ module '(ice-9 q) '(make-q q-length))}."
 ;; Return a list of expressions that evaluate to the appropriate
 ;; arguments for resolve-interface according to SPEC.
 
+(eval-when
+ (compile)
+ (if (memq 'prefix (read-options))
+     (error "boot-9 must be compiled with #:kw, not :kw")))
+
 (define (compile-interface-spec spec)
   (define (make-keyarg sym key quote?)
     (cond ((or (memq sym spec)
@@ -2847,14 +2974,12 @@ module '(ice-9 q) '(make-q q-length))}."
 		 (cddr args))))))
 
 (defmacro define-module args
-  `(eval-case
-    ((load-toplevel)
-     (let ((m (process-define-module
-	       (list ,@(compile-define-module-args args)))))
-       (set-current-module m)
-       m))
-    (else
-     (error "define-module can only be used at the top level"))))
+  `(eval-when
+    (eval load compile)
+    (let ((m (process-define-module
+              (list ,@(compile-define-module-args args)))))
+      (set-current-module m)
+      m)))
 
 ;; The guts of the use-modules macro.  Add the interfaces of the named
 ;; modules to the use-list of the current module, in order.
@@ -2872,65 +2997,42 @@ module '(ice-9 q) '(make-q q-length))}."
        (module-use-interfaces! (current-module) interfaces)))))
 
 (defmacro use-modules modules
-  `(eval-case
-    ((load-toplevel)
-     (process-use-modules
-      (list ,@(map (lambda (m)
-		     `(list ,@(compile-interface-spec m)))
-		   modules)))
-     *unspecified*)
-    (else
-     (error "use-modules can only be used at the top level"))))
+  `(eval-when
+    (eval load compile)
+    (process-use-modules
+     (list ,@(map (lambda (m)
+                    `(list ,@(compile-interface-spec m)))
+                  modules)))
+    *unspecified*))
 
 (defmacro use-syntax (spec)
-  `(eval-case
-    ((load-toplevel)
-     ,@(if (pair? spec)
-	   `((process-use-modules (list
-				   (list ,@(compile-interface-spec spec))))
-	     (set-module-transformer! (current-module)
-				      ,(car (last-pair spec))))
-	   `((set-module-transformer! (current-module) ,spec)))
-     *unspecified*)
-    (else
-     (error "use-syntax can only be used at the top level"))))
-
-;; Dirk:FIXME:: This incorrect (according to R5RS) syntax needs to be changed
-;; as soon as guile supports hygienic macros.
-(define define-private define)
-
-(defmacro define-public args
-  (define (syntax)
-    (error "bad syntax" (list 'define-public args)))
-  (define (defined-name n)
-    (cond
-     ((symbol? n) n)
-     ((pair? n) (defined-name (car n)))
-     (else (syntax))))
-  (cond
-   ((null? args)
-    (syntax))
-   (#t
-    (let ((name (defined-name (car args))))
-      `(begin
-	 (define-private ,@args)
-	 (eval-case ((load-toplevel) (export ,name))))))))
-
-(defmacro defmacro-public args
-  (define (syntax)
-    (error "bad syntax" (list 'defmacro-public args)))
-  (define (defined-name n)
-    (cond
-     ((symbol? n) n)
-     (else (syntax))))
-  (cond
-   ((null? args)
-    (syntax))
-   (#t
-    (let ((name (defined-name (car args))))
-      `(begin
-	 (eval-case ((load-toplevel) (export-syntax ,name)))
-	 (defmacro ,@args))))))
+  `(eval-when
+    (eval load compile)
+    (issue-deprecation-warning
+     "`use-syntax' is deprecated. Please contact guile-devel for more info.")
+    (process-use-modules (list (list ,@(compile-interface-spec spec))))
+    *unspecified*))
+
+(define-syntax define-private
+  (syntax-rules ()
+    ((_ foo bar)
+     (define foo bar))))
+
+(define-syntax define-public
+  (syntax-rules ()
+    ((_ (name . args) . body)
+     (define-public name (lambda args . body)))
+    ((_ name val)
+     (begin
+       (define name val)
+       (export name)))))
+
+(define-syntax defmacro-public
+  (syntax-rules ()
+    ((_ name args . body)
+     (begin
+       (defmacro name args . body)
+       (export-syntax name)))))
 
 ;; Export a local variable
 
@@ -2967,22 +3069,14 @@ module '(ice-9 q) '(make-q q-length))}."
 	      names)))
 
 (defmacro export names
-  `(eval-case
-    ((load-toplevel)
-     (call-with-deferred-observers
-      (lambda ()
-	(module-export! (current-module) ',names))))
-    (else
-     (error "export can only be used at the top level"))))
+  `(call-with-deferred-observers
+    (lambda ()
+      (module-export! (current-module) ',names))))
 
 (defmacro re-export names
-  `(eval-case
-    ((load-toplevel)
-     (call-with-deferred-observers
-      (lambda ()
-	(module-re-export! (current-module) ',names))))
-    (else
-     (error "re-export can only be used at the top level"))))
+  `(call-with-deferred-observers
+    (lambda ()
+      (module-re-export! (current-module) ',names))))
 
 (defmacro export-syntax names
   `(export ,@names))
@@ -2992,31 +3086,6 @@ module '(ice-9 q) '(make-q q-length))}."
 
 (define load load-module)
 
-;; The following macro allows one to write, for example,
-;;
-;;    (@ (ice-9 pretty-print) pretty-print)
-;;
-;; to refer directly to the pretty-print variable in module (ice-9
-;; pretty-print).  It works by looking up the variable and inserting
-;; it directly into the code.  This is understood by the evaluator.
-;; Indeed, all references to global variables are memoized into such
-;; variable objects.
-
-(define-macro (@ mod-name var-name)
-  (let ((var (module-variable (resolve-interface mod-name) var-name)))
-    (if (not var)
-	(error "no such public variable" (list '@ mod-name var-name)))
-    var))
-
-;; The '@@' macro is like '@' but it can also access bindings that
-;; have not been explicitely exported.
-
-(define-macro (@@ mod-name var-name)
-  (let ((var (module-variable (resolve-module mod-name) var-name)))
-    (if (not var)
-	(error "no such variable" (list '@@ mod-name var-name)))
-    var))
-
 
 
 ;;; {Parameters}
@@ -3205,69 +3274,66 @@ module '(ice-9 q) '(make-q q-length))}."
 		     (append (hashq-ref %cond-expand-table mod '())
 			     features)))))
 
-(define cond-expand
-  (procedure->memoizing-macro
-   (lambda (exp env)
-     (let ((clauses (cdr exp))
-	   (syntax-error (lambda (cl)
-			   (error "invalid clause in `cond-expand'" cl))))
-       (letrec
-	   ((test-clause
-	     (lambda (clause)
-	       (cond
-		((symbol? clause)
-		 (or (memq clause %cond-expand-features)
-		     (let lp ((uses (module-uses (env-module env))))
-		       (if (pair? uses)
-			   (or (memq clause
-				     (hashq-ref %cond-expand-table
-						(car uses) '()))
-			       (lp (cdr uses)))
-			   #f))))
-		((pair? clause)
-		 (cond
-		  ((eq? 'and (car clause))
-		   (let lp ((l (cdr clause)))
-		     (cond ((null? l)
-			    #t)
-			   ((pair? l)
-			    (and (test-clause (car l)) (lp (cdr l))))
-			   (else
-			    (syntax-error clause)))))
-		  ((eq? 'or (car clause))
-		   (let lp ((l (cdr clause)))
-		     (cond ((null? l)
-			    #f)
-			   ((pair? l)
-			    (or (test-clause (car l)) (lp (cdr l))))
-			   (else
-			    (syntax-error clause)))))
-		  ((eq? 'not (car clause))
-		   (cond ((not (pair? (cdr clause)))
-			  (syntax-error clause))
-			 ((pair? (cddr clause))
-			  ((syntax-error clause))))
-		   (not (test-clause (cadr clause))))
-		  (else
-		   (syntax-error clause))))
-		(else
-		 (syntax-error clause))))))
-	 (let lp ((c clauses))
-	   (cond
-	    ((null? c)
-	     (error "Unfulfilled `cond-expand'"))
-	    ((not (pair? c))
-	     (syntax-error c))
-	    ((not (pair? (car c)))
-	     (syntax-error (car c)))
-	    ((test-clause (caar c))
-	     `(begin ,@(cdar c)))
-	    ((eq? (caar c) 'else)
-	     (if (pair? (cdr c))
-		 (syntax-error c))
-	     `(begin ,@(cdar c)))
-	    (else
-	     (lp (cdr c))))))))))
+(define-macro (cond-expand . clauses)
+  (let ((syntax-error (lambda (cl)
+                        (error "invalid clause in `cond-expand'" cl))))
+    (letrec
+        ((test-clause
+          (lambda (clause)
+            (cond
+             ((symbol? clause)
+              (or (memq clause %cond-expand-features)
+                  (let lp ((uses (module-uses (current-module))))
+                    (if (pair? uses)
+                        (or (memq clause
+                                  (hashq-ref %cond-expand-table
+                                             (car uses) '()))
+                            (lp (cdr uses)))
+                        #f))))
+             ((pair? clause)
+              (cond
+               ((eq? 'and (car clause))
+                (let lp ((l (cdr clause)))
+                  (cond ((null? l)
+                         #t)
+                        ((pair? l)
+                         (and (test-clause (car l)) (lp (cdr l))))
+                        (else
+                         (syntax-error clause)))))
+               ((eq? 'or (car clause))
+                (let lp ((l (cdr clause)))
+                  (cond ((null? l)
+                         #f)
+                        ((pair? l)
+                         (or (test-clause (car l)) (lp (cdr l))))
+                        (else
+                         (syntax-error clause)))))
+               ((eq? 'not (car clause))
+                (cond ((not (pair? (cdr clause)))
+                       (syntax-error clause))
+                      ((pair? (cddr clause))
+                       ((syntax-error clause))))
+                (not (test-clause (cadr clause))))
+               (else
+                (syntax-error clause))))
+             (else
+              (syntax-error clause))))))
+      (let lp ((c clauses))
+        (cond
+         ((null? c)
+          (error "Unfulfilled `cond-expand'"))
+         ((not (pair? c))
+          (syntax-error c))
+         ((not (pair? (car c)))
+          (syntax-error (car c)))
+         ((test-clause (caar c))
+          `(begin ,@(cdar c)))
+         ((eq? (caar c) 'else)
+          (if (pair? (cdr c))
+              (syntax-error c))
+          `(begin ,@(cdar c)))
+         (else
+          (lp (cdr c))))))))
 
 ;; This procedure gets called from the startup code with a list of
 ;; numbers, which are the numbers of the SRFIs to be loaded on startup.
@@ -3364,6 +3430,8 @@ module '(ice-9 q) '(make-q q-length))}."
     ;; scmsigs.c scm_sigaction_for_thread), so the handlers setup here have
     ;; no effect.
     (let ((old-handlers #f)
+          (start-repl (module-ref (resolve-interface '(system repl repl))
+                                  'start-repl))
 	  (signals (if (provided? 'posix)
 		       `((,SIGINT . "User interrupt")
 			 (,SIGFPE . "Arithmetic error")
@@ -3398,7 +3466,7 @@ module '(ice-9 q) '(make-q q-length))}."
 
 	  ;; the protected thunk.
 	  (lambda ()
-	    (let ((status (scm-style-repl)))
+            (let ((status (start-repl 'scheme)))
 	      (run-hook exit-hook)
 	      status))
 
@@ -3430,13 +3498,20 @@ module '(ice-9 q) '(make-q q-length))}."
    (provided? sym)))
 
 (begin-deprecated
- (primitive-load-path "ice-9/deprecated.scm"))
+ (primitive-load-path "ice-9/deprecated"))
 
 
 
 ;;; Place the user in the guile-user module.
 ;;;
 
-(define-module (guile-user))
+;;; FIXME: annotate ?
+;; (define (syncase exp)
+;;   (with-fluids ((expansion-eval-closure
+;; 		 (module-eval-closure (current-module))))
+;;     (deannotate/source-properties (sc-expand (annotate exp)))))
+
+(define-module (guile-user)
+  #:autoload (system base compile) (compile))
 
 ;;; boot-9.scm ends here
diff --git a/ice-9/buffered-input.scm b/module/ice-9/buffered-input.scm
index 11530e897..05e9255c0 100644
--- a/ice-9/buffered-input.scm
+++ b/module/ice-9/buffered-input.scm
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/ice-9/calling.scm b/module/ice-9/calling.scm
index 07f7a7805..f66bba27e 100644
--- a/ice-9/calling.scm
+++ b/module/ice-9/calling.scm
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/ice-9/channel.scm b/module/ice-9/channel.scm
index 8cbb00190..b9d470044 100644
--- a/ice-9/channel.scm
+++ b/module/ice-9/channel.scm
@@ -2,19 +2,19 @@
 
 ;; Copyright (C) 2001, 2006 Free Software Foundation, Inc.
 
-;; This library is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU Lesser General Public
-;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
-;; 
-;; This library is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;; Lesser General Public License for more details.
-;; 
-;; You should have received a copy of the GNU Lesser General Public
-;; License along with this library; if not, write to the Free Software
-;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 ;;; Commentary:
 
diff --git a/ice-9/common-list.scm b/module/ice-9/common-list.scm
index 7d62bc319..ea1b0f3de 100644
--- a/ice-9/common-list.scm
+++ b/module/ice-9/common-list.scm
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/module/ice-9/compile-psyntax.scm b/module/ice-9/compile-psyntax.scm
new file mode 100644
index 000000000..8b53267fe
--- /dev/null
+++ b/module/ice-9/compile-psyntax.scm
@@ -0,0 +1,20 @@
+(use-modules (language tree-il) (ice-9 pretty-print))
+(let ((source (list-ref (command-line) 1))
+      (target (list-ref (command-line) 2)))
+  (let ((in (open-input-file source))
+        (out (open-output-file (string-append target ".tmp"))))
+    (write '(eval-when (compile) (set-current-module (resolve-module '(guile))))
+           out)
+    (newline out)
+    (let loop ((x (read in)))
+      (if (eof-object? x)
+          (begin
+            (close-port out)
+            (close-port in))
+          (begin
+            (pretty-print (tree-il->scheme
+                           (sc-expand x 'c '(compile load eval)))
+                          out)
+            (newline out)
+            (loop (read in))))))
+  (system (format #f "mv -f ~s.tmp ~s" target target)))
diff --git a/ice-9/debug.scm b/module/ice-9/debug.scm
index 0e751590d..1fd5b66da 100644
--- a/ice-9/debug.scm
+++ b/module/ice-9/debug.scm
@@ -3,7 +3,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/ice-9/debugger.scm b/module/ice-9/debugger.scm
index 0ad014881..d6fe2990c 100644
--- a/ice-9/debugger.scm
+++ b/module/ice-9/debugger.scm
@@ -2,24 +2,25 @@
 
 ;;; Copyright (C) 1999, 2001, 2002, 2006 Free Software Foundation, Inc.
 ;;;
-;; This library is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU Lesser General Public
-;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
-;; 
-;; This library is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;; Lesser General Public License for more details.
-;; 
-;; You should have received a copy of the GNU Lesser General Public
-;; License along with this library; if not, write to the Free Software
-;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (ice-9 debugger)
   #:use-module (ice-9 debugger command-loop)
   #:use-module (ice-9 debugger state)
   #:use-module (ice-9 debugger utils)
+  #:use-module (ice-9 debugging traps)
   #:use-module (ice-9 format)
   #:export (debug-stack
 	    debug
@@ -131,16 +132,34 @@ Indicates that the debugger should display an introductory message.
 
 (define (debug-on-error syms)
   "Enable or disable debug on error."
-  (set! lazy-handler-dispatch
+  (set! pre-unwind-handler-dispatch
 	(if syms
 	    (lambda (key . args)
 	      (if (memq key syms)
 		  (begin
-		    (debug-stack (make-stack #t lazy-handler-dispatch)
+		    (debug-stack (make-stack #t pre-unwind-handler-dispatch)
 				 #:with-introduction
 				 #:continuable)
 		    (throw 'abort key)))
-	      (apply default-lazy-handler key args))
-	    default-lazy-handler)))
+	      (apply default-pre-unwind-handler key args))
+	    default-pre-unwind-handler)))
+
+;;; Also provide a `debug-trap' entry point.  This maps from a
+;;; trap-context to a debug-stack call.
+
+(define-public (debug-trap trap-context)
+  "Invoke the Guile debugger to explore the stack at the specified @var{trap-context}."
+  (let* ((stack (tc:stack trap-context))
+	 (flags1 (let ((trap-type (tc:type trap-context)))
+		   (case trap-type
+		     ((#:return #:error)
+		      (list trap-type
+			    (tc:return-value trap-context)))
+		     (else
+		      (list trap-type)))))
+	 (flags (if (tc:continuation trap-context)
+		    (cons #:continuable flags1)
+		    flags1)))
+    (apply debug-stack stack flags)))
 
 ;;; (ice-9 debugger) ends here.
diff --git a/ice-9/debugger/command-loop.scm b/module/ice-9/debugger/command-loop.scm
index 62a08ea65..18ea00314 100644
--- a/ice-9/debugger/command-loop.scm
+++ b/module/ice-9/debugger/command-loop.scm
@@ -2,22 +2,25 @@
 
 ;;; Copyright (C) 1999, 2001, 2002, 2003, 2006 Free Software Foundation, Inc.
 ;;;
-;; This library is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU Lesser General Public
-;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
-;; 
-;; This library is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;; Lesser General Public License for more details.
-;; 
-;; You should have received a copy of the GNU Lesser General Public
-;; License along with this library; if not, write to the Free Software
-;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (ice-9 debugger command-loop)
   #:use-module ((ice-9 debugger commands) :prefix debugger:)
+  #:use-module (ice-9 debugger)
+  #:use-module (ice-9 debugger state)
+  #:use-module (ice-9 debugging traps)
   #:export (debugger-command-loop
 	    debugger-command-loop-error
 	    debugger-command-loop-quit)
@@ -540,3 +543,11 @@
 (define-command-alias "where" "backtrace")
 (define-command-alias "p" "evaluate")
 (define-command-alias '("info" "stack") "backtrace")
+
+(define-command "continue" '() debugger:continue)
+
+(define-command "finish" '() debugger:finish)
+
+(define-command "step" '('optional exact-integer) debugger:step)
+
+(define-command "next" '('optional exact-integer) debugger:next)
diff --git a/ice-9/debugger/commands.scm b/module/ice-9/debugger/commands.scm
index ef6f79026..00cab87f6 100644
--- a/ice-9/debugger/commands.scm
+++ b/module/ice-9/debugger/commands.scm
@@ -2,25 +2,26 @@
 
 ;;; Copyright (C) 2002, 2006 Free Software Foundation, Inc.
 ;;;
-;; This library is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU Lesser General Public
-;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
-;; 
-;; This library is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;; Lesser General Public License for more details.
-;; 
-;; You should have received a copy of the GNU Lesser General Public
-;; License along with this library; if not, write to the Free Software
-;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (ice-9 debugger commands)
   #:use-module (ice-9 debug)
   #:use-module (ice-9 debugger)
   #:use-module (ice-9 debugger state)
   #:use-module (ice-9 debugger utils)
+  #:use-module (ice-9 debugging steps)
   #:export (backtrace
 	    evaluate
 	    info-args
@@ -28,7 +29,11 @@
 	    position
 	    up
 	    down
-	    frame))
+	    frame
+	    continue
+	    finish
+	    step
+	    next))
 
 (define (backtrace state n-frames)
   "Print backtrace of all stack frames, or innermost COUNT frames.
@@ -151,4 +156,52 @@ An argument specifies the frame to select; it must be a stack-frame number."
   (if n (set-stack-index! state (frame-number->index n (state-stack state))))
   (write-state-short state))
 
+(define (assert-continuable state)
+  ;; Check that debugger is in a state where `continuing' makes sense.
+  ;; If not, signal an error.
+  (or (memq #:continuable (state-flags state))
+      (user-error "This debug session is not continuable.")))
+
+(define (continue state)
+  "Tell the program being debugged to continue running.  (In fact this is
+the same as the @code{quit} command, because it exits the debugger
+command loop and so allows whatever code it was that invoked the
+debugger to continue.)"
+  (assert-continuable state)
+  (throw 'exit-debugger))
+
+(define (finish state)
+  "Continue until evaluation of the current frame is complete, and
+print the result obtained."
+  (assert-continuable state)
+  (at-exit (- (stack-length (state-stack state))
+	      (state-index state))
+	   (list trace-trap debug-trap))
+  (continue state))
+
+(define (step state n)
+  "Tell the debugged program to do @var{n} more steps from its current
+position.  One @dfn{step} means executing until the next frame entry
+or exit of any kind.  @var{n} defaults to 1."
+  (assert-continuable state)
+  (at-step debug-trap (or n 1))
+  (continue state))
+
+(define (next state n)
+  "Tell the debugged program to do @var{n} more steps from its current
+position, but only counting frame entries and exits where the
+corresponding source code comes from the same file as the current
+stack frame.  (See @ref{Step Traps} for the details of how this
+works.)  If the current stack frame has no source code, the effect of
+this command is the same as of @code{step}.  @var{n} defaults to 1."
+  (assert-continuable state)
+  (at-step debug-trap
+	   (or n 1)
+	   (frame-file-name (stack-ref (state-stack state)
+				       (state-index state)))
+	   (if (memq #:return (state-flags state))
+	       #f
+	       (- (stack-length (state-stack state)) (state-index state))))
+  (continue state))
+
 ;;; (ice-9 debugger commands) ends here.
diff --git a/ice-9/debugger/state.scm b/module/ice-9/debugger/state.scm
index 11b8ebbf0..0bda0fad5 100644
--- a/ice-9/debugger/state.scm
+++ b/module/ice-9/debugger/state.scm
@@ -2,19 +2,19 @@
 
 ;;; Copyright (C) 2002, 2006 Free Software Foundation, Inc.
 ;;;
-;; This library is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU Lesser General Public
-;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
-;; 
-;; This library is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;; Lesser General Public License for more details.
-;; 
-;; You should have received a copy of the GNU Lesser General Public
-;; License along with this library; if not, write to the Free Software
-;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (ice-9 debugger state)
   #:export (make-state
diff --git a/ice-9/debugger/trc.scm b/module/ice-9/debugger/trc.scm
index 49af2747d..3e7e2f359 100644
--- a/ice-9/debugger/trc.scm
+++ b/module/ice-9/debugger/trc.scm
@@ -2,19 +2,19 @@
 
 ;;; Copyright (C) 2002, 2006 Free Software Foundation, Inc.
 ;;;
-;; This library is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU Lesser General Public
-;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
-;; 
-;; This library is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;; Lesser General Public License for more details.
-;; 
-;; You should have received a copy of the GNU Lesser General Public
-;; License along with this library; if not, write to the Free Software
-;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (ice-9 debugger trc)
   #:export (trc trc-syms trc-all trc-none trc-add trc-remove trc-port))
diff --git a/ice-9/debugger/utils.scm b/module/ice-9/debugger/utils.scm
index dfef25b1f..dfef25b1f 100644
--- a/ice-9/debugger/utils.scm
+++ b/module/ice-9/debugger/utils.scm
diff --git a/module/ice-9/debugging/breakpoints.scm b/module/ice-9/debugging/breakpoints.scm
new file mode 100644
index 000000000..0690699a7
--- /dev/null
+++ b/module/ice-9/debugging/breakpoints.scm
@@ -0,0 +1,414 @@
+;;;; (ice-9 debugging breakpoints) -- practical breakpoints
+
+;;; Copyright (C) 2005 Neil Jerram
+;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; This module provides a practical interface for setting and
+;;; manipulating breakpoints.
+
+(define-module (ice-9 debugging breakpoints)
+  #:use-module (ice-9 debugger)
+  #:use-module (ice-9 ls)
+  #:use-module (ice-9 optargs)
+  #:use-module (ice-9 regex)
+  #:use-module (oop goops)
+  #:use-module (ice-9 debugging traps)
+  #:use-module (ice-9 debugging trc)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-13)
+  #:export (break-in
+	    break-at
+	    default-breakpoint-behaviour
+	    delete-breakpoint
+	    for-each-breakpoint
+	    setup-before-load
+	    setup-after-load
+	    setup-after-read
+	    setup-after-eval))
+
+;; If the running Guile does not provide before- and after- load hooks
+;; itself, install them using the (ice-9 debugging load-hooks) module.
+(or (defined? 'after-load-hook)
+    (begin
+      (use-modules (ice-9 debugging load-hooks))
+      (install-load-hooks)))
+
+;; Getter/setter for default breakpoint behaviour.
+(define default-breakpoint-behaviour
+  (let ((behaviour debug-trap))
+    (make-procedure-with-setter
+     ;; Getter: return current default behaviour.
+     (lambda ()
+       behaviour)
+     ;; Setter: set default behaviour to given procedure.
+     (lambda (new-behaviour)
+       (set! behaviour new-behaviour)))))
+
+;; Base class for breakpoints.  (We don't need to use GOOPS to
+;; represent breakpoints, but it's a nice way to describe a composite
+;; object.)
+(define-class <breakpoint> ()
+  ;; This breakpoint's trap options, which include its behaviour.
+  (trap-options #:init-keyword #:trap-options)
+  ;; All the traps relating to this breakpoint.
+  (traps #:init-value '())
+  ;; Observer.  This is a procedure that is called when the breakpoint
+  ;; trap list changes.
+  (observer #:init-value #f))
+
+;; Noop base class definitions of all the possible setup methods.
+(define-method (setup-before-load (bp <breakpoint>) filename)
+  *unspecified*)
+(define-method (setup-after-load (bp <breakpoint>) filename)
+  *unspecified*)
+(define-method (setup-after-read (bp <breakpoint>) x)
+  *unspecified*)
+(define-method (setup-after-eval (bp <breakpoint>) filename)
+  *unspecified*)
+
+;; Call the breakpoint's observer, if it has one.
+(define-method (call-observer (bp <breakpoint>))
+  (cond ((slot-ref bp 'observer)
+	 =>
+	 (lambda (proc)
+	   (proc)))))
+
+;; Delete a breakpoint.
+(define (delete-breakpoint bp)
+  ;; Remove this breakpoint from the global list.
+  (set! breakpoints (delq! bp breakpoints))
+  ;; Uninstall and discard all its traps.
+  (for-each uninstall-trap (slot-ref bp 'traps))
+  (slot-set! bp 'traps '()))
+
+;; Class for `break-in' breakpoints.
+(define-class <break-in> (<breakpoint>)
+  ;; The name of the procedure to break in.
+  (procedure-name #:init-keyword #:procedure-name)
+  ;; The name of the module or file that the procedure is defined in.
+  ;; A module name is a list of symbols that exactly names the
+  ;; relevant module.  A file name is a string, which can in fact be
+  ;; any substring of the relevant full file name.
+  (module-or-file-name #:init-keyword #:module-or-file-name))
+
+;; Class for `break-at' breakpoints.
+(define-class <break-at> (<breakpoint>)
+  ;; The name of the file to break in.  This is a string, which can in
+  ;; fact be any substring of the relevant full file name.
+  (file-name #:init-keyword #:file-name)
+  ;; Line and column number to break at.
+  (line #:init-keyword #:line)
+  (column #:init-keyword #:column))
+
+;; Global list of non-deleted breakpoints.
+(define breakpoints '())
+
+;; Add to the above list.
+(define-method (add-to-global-breakpoint-list (bp <breakpoint>))
+  (set! breakpoints (append! breakpoints (list bp))))
+
+;; break-in: create a `break-in' breakpoint.
+(define (break-in procedure-name . options)
+  ;; Sort out the optional args.
+  (let* ((module-or-file-name+options
+	  (cond ((and (not (null? options))
+		      (or (string? (car options))
+			  (list? (car options))))
+		 options)
+		(else
+		 (cons (module-name (current-module)) options))))
+	 (module-or-file-name (car module-or-file-name+options))
+	 (trap-options (cdr module-or-file-name+options))
+	 ;; Create the new breakpoint object.
+	 (bp (make <break-in>
+	       #:procedure-name procedure-name
+	       #:module-or-file-name module-or-file-name
+	       #:trap-options (if (memq #:behaviour trap-options)
+				  trap-options
+				  (cons* #:behaviour
+					 (default-breakpoint-behaviour)
+					 trap-options)))))
+    ;; Add it to the global breakpoint list.
+    (add-to-global-breakpoint-list bp)
+    ;; Set the new breakpoint, if possible, in already loaded code.
+    (set-in-existing-code bp)
+    ;; Return the breakpoint object to our caller.
+    bp))
+
+;; break-at: create a `break-at' breakpoint.
+(define (break-at file-name line column . trap-options)
+  ;; Create the new breakpoint object.
+  (let* ((bp (make <break-at>
+	       #:file-name file-name
+	       #:line line
+	       #:column column
+	       #:trap-options (if (memq #:behaviour trap-options)
+				  trap-options
+				  (cons* #:behaviour
+					 (default-breakpoint-behaviour)
+					 trap-options)))))
+    ;; Add it to the global breakpoint list.
+    (add-to-global-breakpoint-list bp)
+    ;; Set the new breakpoint, if possible, in already loaded code.
+    (set-in-existing-code bp)
+    ;; Return the breakpoint object to our caller.
+    bp))
+
+;; Set a `break-in' breakpoint in already loaded code, if possible.
+(define-method (set-in-existing-code (bp <break-in>))
+  ;; Get the module or file name that was specified for this
+  ;; breakpoint.
+  (let ((module-or-file-name (slot-ref bp 'module-or-file-name)))
+    ;; Handling is simpler for a module name.
+    (cond ((list? module-or-file-name)
+	   ;; See if the named module exists yet.
+	   (let ((m (module-if-already-loaded module-or-file-name)))
+	     (maybe-break-in-module-proc m bp)))
+	  ((string? module-or-file-name)
+	   ;; Try all loaded modules.
+	   (or-map (lambda (m)
+		     (maybe-break-in-module-proc m bp))
+		   (all-loaded-modules)))
+	  (else
+	   (error "Bad module-or-file-name:" module-or-file-name)))))
+
+(define (make-observer bp trap)
+  (lambda (event)
+    (trap-target-gone bp trap)))
+
+;; Set a `break-at' breakpoint in already loaded code, if possible.
+(define-method (set-in-existing-code (bp <break-at>) . code)
+  ;; Procedure to install a source trap on each expression that we
+  ;; find matching this breakpoint.
+  (define (install-source-trap x)
+    (or (or-map (lambda (trap)
+		  (and (is-a? trap <source-trap>)
+		       (eq? (slot-ref trap 'expression) x)))
+		(slot-ref bp 'traps))
+	(let ((trap (apply make <source-trap>
+			   #:expression x
+			   (slot-ref bp 'trap-options))))
+	  (slot-set! trap 'observer (make-observer bp trap))
+	  (install-trap trap)
+	  (trc 'install-source-trap (object-address trap) (object-address x))
+	  (trap-installed bp trap #t))))
+  ;; Scan the source whash, and install a trap on all code matching
+  ;; this breakpoint.
+  (trc 'set-in-existing-code (length code))
+  (if (null? code)
+      (scan-source-whash (slot-ref bp 'file-name)
+			 (slot-ref bp 'line)
+			 (slot-ref bp 'column)
+			 install-source-trap)
+      (scan-code (car code)
+		 (slot-ref bp 'file-name)
+		 (slot-ref bp 'line)
+		 (slot-ref bp 'column)
+		 install-source-trap)))
+
+;; Temporary implementation of scan-source-whash - this _really_ needs
+;; to be implemented in C.
+(define (scan-source-whash file-name line column proc)
+  ;; Procedure to call for each source expression in the whash.
+  (define (folder x props acc)
+    (if (and (= line (source-property x 'line))
+	     (= column (source-property x 'column))
+	     (let ((fn (source-property x 'filename)))
+	       (trc 'scan-source-whash fn)
+	       (and (string? fn)
+		    (string-contains fn file-name))))
+	(proc x)))
+  ;; Tracing.
+  (trc 'scan-source-whash file-name line column)
+  ;; Apply this procedure to the whash.
+  (hash-fold folder 0 source-whash))
+
+(define (scan-code x file-name line column proc)
+  (trc 'scan-code file-name line column)
+  (if (pair? x)
+      (begin
+	(if (and (eq? line (source-property x 'line))
+		 (eq? column (source-property x 'column))
+		 (let ((fn (source-property x 'filename)))
+		   (trc 'scan-code fn)
+		   (and (string? fn)
+			(string-contains fn file-name))))
+	    (proc x))
+	(scan-code (car x) file-name line column proc)
+	(scan-code (cdr x) file-name line column proc))))
+
+;; If a module named MODULE-NAME has been loaded, return its module
+;; object; otherwise return #f.
+(define (module-if-already-loaded module-name)
+  (nested-ref the-root-module (append '(app modules) module-name)))
+
+;; Construct and return a list of all loaded modules.
+(define (all-loaded-modules)
+  ;; This is the list that accumulates known modules.  It has to be
+  ;; defined outside the following functions, and accumulated using
+  ;; set!, so as to avoid infinite loops - because of the fact that
+  ;; all non-pure modules have a variable `app'.
+  (define known-modules '())
+  ;; Return an alist of submodules of the given PARENT-MODULE-NAME.
+  ;; Each element of the alist is (NAME . MODULE), where NAME is the
+  ;; module's leaf name (i.e. relative to PARENT-MODULE-NAME) and
+  ;; MODULE is the module object.  By a "submodule of a parent
+  ;; module", we mean any module value that is bound to a symbol in
+  ;; the parent module, and which is not an interface module.
+  (define (direct-submodules parent-module-name)
+    (filter (lambda (name+value)
+	      (and (module? (cdr name+value))
+		   (not (eq? (module-kind (cdr name+value)) 'interface))))
+	    (map (lambda (name)
+		   (cons name (local-ref (append parent-module-name
+						 (list name)))))
+		 (cdar (lls parent-module-name)))))
+  ;; Add all submodules (direct and indirect) of the module named
+  ;; PARENT-MODULE-NAME to `known-modules', if not already there.
+  (define (add-submodules-of parent-module-name)
+    (let ((ds (direct-submodules parent-module-name)))
+      (for-each
+       (lambda (name+module)
+         (or (memq (cdr name+module) known-modules)
+             (begin
+               (set! known-modules (cons (cdr name+module) known-modules))
+               (add-submodules-of (append parent-module-name
+                                          (list (car name+module)))))))
+       ds)))
+  ;; Add submodules recursively, starting from the root of all
+  ;; modules.
+  (add-submodules-of '(app modules))
+  ;; Return the result.
+  known-modules)
+
+;; Before-load setup for `break-at' breakpoints.
+(define-method (setup-before-load (bp <break-at>) filename)
+  (let ((trap (apply make <location-trap>
+		     #:file-regexp (regexp-quote (slot-ref bp 'file-name))
+		     #:line (slot-ref bp 'line)
+		     #:column (slot-ref bp 'column)
+		     (slot-ref bp 'trap-options))))
+    (install-trap trap)
+    (trap-installed bp trap #f)
+    (letrec ((uninstaller
+	      (lambda (file-name)
+		(uninstall-trap trap)
+		(remove-hook! after-load-hook uninstaller))))
+      (add-hook! after-load-hook uninstaller))))
+
+;; After-load setup for `break-in' breakpoints.
+(define-method (setup-after-load (bp <break-in>) filename)
+  ;; Get the module that the loaded file created or was loaded into,
+  ;; and the module or file name that were specified for this
+  ;; breakpoint.
+  (let ((m (current-module))
+	(module-or-file-name (slot-ref bp 'module-or-file-name)))
+    ;; Decide whether the breakpoint spec matches this load.
+    (if (or (and (string? module-or-file-name)
+		 (string-contains filename module-or-file-name))
+	    (and (list? module-or-file-name)
+		 (equal? (module-name (current-module)) module-or-file-name)))
+	;; It does, so try to install the breakpoint.
+	(maybe-break-in-module-proc m bp))))
+
+;; After-load setup for `break-at' breakpoints.
+(define-method (setup-after-load (bp <break-at>) filename)
+  (if (string-contains filename (slot-ref bp 'file-name))
+      (set-in-existing-code bp)))
+
+(define (maybe-break-in-module-proc m bp)
+  "If module M defines a procedure matching the specification of
+breakpoint BP, install a trap on it."
+  (let ((proc (module-ref m (slot-ref bp 'procedure-name) #f)))
+    (if (and proc
+	     (procedure? proc)
+	     (let ((module-or-file-name (slot-ref bp 'module-or-file-name)))
+	       (if (string? module-or-file-name)
+		   (source-file-matches (procedure-source proc)
+					module-or-file-name)
+		   #t))
+	     (not (or-map (lambda (trap)
+			    (and (is-a? trap <procedure-trap>)
+				 (eq? (slot-ref trap 'procedure) proc)))
+			  (slot-ref bp 'traps))))
+	;; There is, so install a <procedure-trap> on it.
+	(letrec ((trap (apply make <procedure-trap>
+			      #:procedure proc
+			      (slot-ref bp 'trap-options))))
+	  (slot-set! trap 'observer (make-observer bp trap))
+	  (install-trap trap)
+	  (trap-installed bp trap #t)
+	  ;; Tell caller that we installed a trap.
+	  #t)
+	;; Tell caller that we did not install a trap.
+	#f)))
+
+;; After-read setup for `break-at' breakpoints.
+(define-method (setup-after-read (bp <break-at>) x)
+  (set-in-existing-code bp x))
+
+;; Common code for associating a newly created and installed trap with
+;; a breakpoint object.
+(define (trap-installed bp trap record?)
+  (if record?
+      ;; Remember this trap in the breakpoint object.
+      (slot-set! bp 'traps (append! (slot-ref bp 'traps) (list trap))))
+  ;; Update the breakpoint status.
+  (call-observer bp))
+
+;; Common code for handling when the target of one of a breakpoint's
+;; traps is being GC'd.
+(define (trap-target-gone bp trap)
+  (trc 'trap-target-gone (object-address trap))
+  ;; Remove this trap from the breakpoint's list.
+  (slot-set! bp 'traps (delq! trap (slot-ref bp 'traps)))
+  ;; Update the breakpoint status.
+  (call-observer bp))
+
+(define (source-file-matches source file-name)
+  "Return #t if any of the expressions in SOURCE have a 'filename
+source property that includes FILE-NAME; otherwise return #f."
+  (and (pair? source)
+       (or (let ((source-file-name (source-property source 'filename)))
+	     (and source-file-name
+		  (string? source-file-name)
+		  (string-contains source-file-name file-name)))
+	   (let loop ((source source))
+	     (and (pair? source)
+		  (or (source-file-matches (car source) file-name)
+		      (loop (cdr source))))))))
+
+;; Install load hook functions.
+(add-hook! before-load-hook
+	   (lambda (fn)
+	     (for-each-breakpoint setup-before-load fn)))
+
+(add-hook! after-load-hook
+	   (lambda (fn)
+	     (for-each-breakpoint setup-after-load fn)))
+
+;;; Apply generic function GF to each breakpoint, passing the
+;;; breakpoint object and ARGS as args on each call.
+(define (for-each-breakpoint gf . args)
+  (for-each (lambda (bp)
+	      (apply gf bp args))
+	    breakpoints))
+
+;; Make sure that recording of source positions is enabled.  Without
+;; this break-at breakpoints will obviously not work.
+(read-enable 'positions)
+
+;;; (ice-9 debugging breakpoints) ends here.
diff --git a/ice-9/debugging/example-fns.scm b/module/ice-9/debugging/example-fns.scm
index 30d412f00..30d412f00 100644
--- a/ice-9/debugging/example-fns.scm
+++ b/module/ice-9/debugging/example-fns.scm
diff --git a/module/ice-9/debugging/ice-9-debugger-extensions.scm b/module/ice-9/debugging/ice-9-debugger-extensions.scm
new file mode 100644
index 000000000..e69de29bb
--- /dev/null
+++ b/module/ice-9/debugging/ice-9-debugger-extensions.scm
diff --git a/module/ice-9/debugging/load-hooks.scm b/module/ice-9/debugging/load-hooks.scm
new file mode 100644
index 000000000..fb869ed23
--- /dev/null
+++ b/module/ice-9/debugging/load-hooks.scm
@@ -0,0 +1,33 @@
+
+(define-module (ice-9 debugging load-hooks)
+  #:export (before-load-hook
+            after-load-hook
+            install-load-hooks
+            uninstall-load-hooks))
+
+;; real-primitive-load: holds the real (C-implemented) definition of
+;; primitive-load, when the load hooks are installed.
+(define real-primitive-load #f)
+
+;; The load hooks themselves.  These are called with one argument, the
+;; name of the file concerned.
+(define before-load-hook (make-hook 1))
+(define after-load-hook (make-hook 1))
+
+;; primitive-load-with-hooks: our new definition for primitive-load.
+(define (primitive-load-with-hooks filename)
+  (run-hook before-load-hook filename)
+  (real-primitive-load filename)
+  (run-hook after-load-hook filename))
+
+(define (install-load-hooks)
+  (if real-primitive-load
+      (error "load hooks are already installed"))
+  (set! real-primitive-load primitive-load)
+  (set! primitive-load primitive-load-with-hooks))
+
+(define (uninstall-load-hooks)
+  (or real-primitive-load
+      (error "load hooks are not installed"))
+  (set! primitive-load real-primitive-load)
+  (set! real-primitive-load #f))
diff --git a/ice-9/debugging/steps.scm b/module/ice-9/debugging/steps.scm
index fedbc6a32..cd328bd7d 100644
--- a/ice-9/debugging/steps.scm
+++ b/module/ice-9/debugging/steps.scm
@@ -2,19 +2,19 @@
 
 ;;; Copyright (C) 2002, 2004 Free Software Foundation, Inc.
 ;;;
-;; This library is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU Lesser General Public
-;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
-;; 
-;; This library is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;; Lesser General Public License for more details.
-;; 
-;; You should have received a copy of the GNU Lesser General Public
-;; License along with this library; if not, write to the Free Software
-;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (ice-9 debugging steps)
   #:use-module (ice-9 debugging traps)
diff --git a/ice-9/debugging/trace.scm b/module/ice-9/debugging/trace.scm
index ad3015ddf..76160e177 100644
--- a/ice-9/debugging/trace.scm
+++ b/module/ice-9/debugging/trace.scm
@@ -2,24 +2,24 @@
 
 ;;; Copyright (C) 2002 Free Software Foundation, Inc.
 ;;;
-;; This library is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU Lesser General Public
-;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
-;; 
-;; This library is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;; Lesser General Public License for more details.
-;; 
-;; You should have received a copy of the GNU Lesser General Public
-;; License along with this library; if not, write to the Free Software
-;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (ice-9 debugging trace)
   #:use-module (ice-9 debug)
   #:use-module (ice-9 debugger)
-  #:use-module (ice-9 debugging ice-9-debugger-extensions)
+  #:use-module (ice-9 debugger utils)
   #:use-module (ice-9 debugging steps)
   #:use-module (ice-9 debugging traps)
   #:export (trace-trap
@@ -40,9 +40,6 @@
 	    trace-at-exit
 	    trace-until-exit))
 
-(cond ((string>=? (version) "1.7")
-       (use-modules (ice-9 debugger utils))))
-
 (define trace-format-string #f)
 (define trace-arg-procs #f)
 
diff --git a/ice-9/debugging/traps.scm b/module/ice-9/debugging/traps.scm
index 080d7bc31..292456d43 100755
--- a/ice-9/debugging/traps.scm
+++ b/module/ice-9/debugging/traps.scm
@@ -3,19 +3,19 @@
 ;;; Copyright (C) 2002, 2004 Free Software Foundation, Inc.
 ;;; Copyright (C) 2005 Neil Jerram
 ;;;
-;; This library is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU Lesser General Public
-;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
-;; 
-;; This library is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;; Lesser General Public License for more details.
-;; 
-;; You should have received a copy of the GNU Lesser General Public
-;; License along with this library; if not, write to the Free Software
-;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 ;;; This module provides an abstraction around Guile's low level trap
 ;;; handler interface; its aim is to make the low level trap mechanism
@@ -25,6 +25,7 @@
 
 (define-module (ice-9 debugging traps)
   #:use-module (ice-9 regex)
+  #:use-module (ice-9 weak-vector)
   #:use-module (oop goops)
   #:use-module (oop goops describe)
   #:use-module (ice-9 debugging trc)
@@ -59,7 +60,7 @@
 	    trap-ordering
             behaviour-ordering
 	    throw->trap-context
-	    on-lazy-handler-dispatch
+	    on-pre-unwind-handler-dispatch
 	    ;; Interface for authors of new <trap> subclasses.
 	    <trap-context>
 	    <trap>
@@ -86,11 +87,6 @@
 ;; "(trc " to find other symbols that can be passed to trc-add.
 ;; (trc-add 'after-gc-hook)
 
-;; In Guile 1.7 onwards, weak-vector and friends are provided by the
-;; (ice-9 weak-vector) module.
-(cond ((string>=? (version) "1.7")
-       (use-modules (ice-9 weak-vector))))
-
 ;;; The current low level traps interface is as follows.
 ;;;
 ;;; All trap handlers are subject to SCM_TRAPS_P, which is controlled
@@ -467,14 +463,14 @@ it twice."
 ;;; same code for certain events that are trap-like, but not actually
 ;;; traps in the sense of the calls made by libguile's evaluator.
 
-;;; The main example of this is when an error is signalled.  Guile
-;;; doesn't yet have a 100% reliable way of hooking into errors, but
-;;; in practice most errors go through a lazy-catch whose handler is
-;;; lazy-handler-dispatch (defined in ice-9/boot-9.scm), which in turn
-;;; calls default-lazy-handler.  So we can present most errors as
-;;; pseudo-traps by modifying default-lazy-handler.
+;;; The main example of this is when an error is signalled. Guile
+;;; doesn't yet have a 100% reliable way of hooking into errors, but in
+;;; practice most errors go through a catch whose pre-unwind handler is
+;;; pre-unwind-handler-dispatch (defined in ice-9/boot-9.scm), which in
+;;; turn calls default-pre-unwind-handler. So we can present most errors
+;;; as pseudo-traps by modifying default-pre-unwind-handler.
 
-(define default-default-lazy-handler default-lazy-handler)
+(define default-default-pre-unwind-handler default-pre-unwind-handler)
 
 (define (throw->trap-context key args . stack-args)
   (let ((ctx (make <trap-context>
@@ -489,16 +485,16 @@ it twice."
 		     (apply make-stack #t stack-args))))
     ctx))
 
-(define (on-lazy-handler-dispatch behaviour . ignored-keys)
-  (set! default-lazy-handler
+(define (on-pre-unwind-handler-dispatch behaviour . ignored-keys)
+  (set! default-pre-unwind-handler
 	(if behaviour
 	    (lambda (key . args)
 	      (or (memq key ignored-keys)
 		  (behaviour (throw->trap-context key
 						  args
-						  lazy-handler-dispatch)))
-	      (apply default-default-lazy-handler key args))
-	    default-default-lazy-handler)))
+						  pre-unwind-handler-dispatch)))
+	      (apply default-default-pre-unwind-handler key args))
+	    default-default-pre-unwind-handler)))
 
 ;;; {Trap Classes}
 
@@ -1002,34 +998,7 @@ it twice."
 		(trap-disable 'traps)
 		(thunk))))
 
-(define guile-trap-features
-  ;; Helper procedure, to test whether a specific possible Guile
-  ;; feature is supported.
-  (let ((supported?
-         (lambda (test-feature)
-           (case test-feature
-             ((tweaking)
-              ;; Tweaking is supported if the description of the cheap
-              ;; traps option includes the word "obsolete", or if the
-              ;; option isn't there any more.
-              (and (string>=? (version) "1.7")
-                   (let ((cheap-opt-desc
-                          (assq 'cheap (debug-options-interface 'help))))
-                     (or (not cheap-opt-desc)
-                         (string-match "obsolete" (caddr cheap-opt-desc))))))
-             (else
-              (error "Unexpected feature name:" test-feature))))))
-    ;; Compile the list of actually supported features from all
-    ;; possible features.
-    (let loop ((possible-features '(tweaking))
-               (actual-features '()))
-      (if (null? possible-features)
-          (reverse! actual-features)
-          (let ((test-feature (car possible-features)))
-            (loop (cdr possible-features)
-                  (if (supported? test-feature)
-                      (cons test-feature actual-features)
-                      actual-features)))))))
+(define guile-trap-features '(tweaking))
 
 ;; Make sure that traps are enabled.
 (trap-enable 'traps)
diff --git a/ice-9/debugging/trc.scm b/module/ice-9/debugging/trc.scm
index 9e95d7e5c..face227d6 100644
--- a/ice-9/debugging/trc.scm
+++ b/module/ice-9/debugging/trc.scm
@@ -2,19 +2,19 @@
 
 ;;; Copyright (C) 2002, 2004 Free Software Foundation, Inc.
 ;;;
-;; This library is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU Lesser General Public
-;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
-;; 
-;; This library is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;; Lesser General Public License for more details.
-;; 
-;; You should have received a copy of the GNU Lesser General Public
-;; License along with this library; if not, write to the Free Software
-;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (ice-9 debugging trc)
   #:export (trc trc-syms trc-all trc-none trc-add trc-remove trc-port))
diff --git a/ice-9/deprecated.scm b/module/ice-9/deprecated.scm
index 91f4d7445..c8d762143 100644
--- a/ice-9/deprecated.scm
+++ b/module/ice-9/deprecated.scm
@@ -1,9 +1,9 @@
-;;;; Copyright (C) 2003, 2005, 2006 Free Software Foundation, Inc.
+;;;; Copyright (C) 2003, 2005, 2006, 2009 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -21,7 +21,7 @@
 (define substring-move-right! substring-move!)
 
 ;; This method of dynamically linking Guile Extensions is deprecated.
-;; Use `load-extension' explicitely from Scheme code instead.
+;; Use `load-extension' explicitly from Scheme code instead.
 
 (define (split-c-module-name str)
   (let loop ((rev '())
@@ -169,12 +169,19 @@
 ;; The strange prototype system for uniform arrays has been
 ;; deprecated.
 
-(define uniform-vector-fill! array-fill!)
-
-(define make-uniform-vector dimensions->uniform-array)
-
-(define (make-uniform-array prot . bounds)
-  (dimensions->uniform-array bounds prot))
- 
-(define (list->uniform-vector prot lst)
-  (list->uniform-array 1 prot lst))
+(define-macro (eval-case . clauses)
+  (issue-deprecation-warning
+   "`eval-case' is deprecated.  Use `eval-when' instead.")
+  ;; Practically speaking, eval-case only had load-toplevel and else as
+  ;; conditions.
+  (cond
+   ((assoc-ref clauses '(load-toplevel))
+    => (lambda (exps)
+         ;; the *unspecified so that non-toplevel definitions will be
+         ;; caught
+         `(begin *unspecified* . ,exps)))
+   ((assoc-ref clauses 'else)
+    => (lambda (exps)
+         `(begin *unspecified* . ,exps)))
+   (else
+    `(begin))))
diff --git a/ice-9/documentation.scm b/module/ice-9/documentation.scm
index 6e74799e6..bbd6713f6 100644
--- a/ice-9/documentation.scm
+++ b/module/ice-9/documentation.scm
@@ -3,7 +3,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -80,6 +80,7 @@
 
 (define-module (ice-9 documentation)
   :use-module (ice-9 rdelim)
+  :use-module ((system vm program) :select (program? program-documentation))
   :export (file-commentary
            documentation-files search-documentation-files
            object-documentation)
@@ -194,13 +195,11 @@ OBJECT can be a procedure, macro or any object that has its
 `documentation' property set."
   (or (and (procedure? object)
 	   (proc-doc object))
-      (and (defmacro? object)
-	   (proc-doc (defmacro-transformer object)))
-      (and (macro? object)
-	   (let ((transformer (macro-transformer object)))
-	     (and transformer
-		  (proc-doc transformer))))
       (object-property object 'documentation)
+      (and (program? object)
+           (program-documentation object))
+      (and (macro? object)
+           (object-documentation (macro-transformer object)))
       (and (procedure? object)
 	   (not (closure? object))
 	   (procedure-name object)
diff --git a/ice-9/emacs.scm b/module/ice-9/emacs.scm
index 12d8228ee..88035862f 100644
--- a/ice-9/emacs.scm
+++ b/module/ice-9/emacs.scm
@@ -3,7 +3,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/ice-9/expect.scm b/module/ice-9/expect.scm
index a024e91e8..ffc2e1742 100644
--- a/ice-9/expect.scm
+++ b/module/ice-9/expect.scm
@@ -3,7 +3,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/ice-9/format.scm b/module/ice-9/format.scm
index 4bf623757..4bf623757 100644
--- a/ice-9/format.scm
+++ b/module/ice-9/format.scm
diff --git a/ice-9/ftw.scm b/module/ice-9/ftw.scm
index 23f341521..ce2fb165e 100644
--- a/ice-9/ftw.scm
+++ b/module/ice-9/ftw.scm
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/ice-9/gap-buffer.scm b/module/ice-9/gap-buffer.scm
index b6162e802..4533bb539 100644
--- a/ice-9/gap-buffer.scm
+++ b/module/ice-9/gap-buffer.scm
@@ -2,19 +2,19 @@
 
 ;;;	Copyright (C) 2002, 2003, 2006 Free Software Foundation, Inc.
 ;;;
-;; This library is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU Lesser General Public
-;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
-;; 
-;; This library is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;; Lesser General Public License for more details.
-;; 
-;; You should have received a copy of the GNU Lesser General Public
-;; License along with this library; if not, write to the Free Software
-;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 ;;;
 
 ;;; Author: Thien-Thi Nguyen <ttn@gnu.org>
diff --git a/ice-9/gds-client.scm b/module/ice-9/gds-client.scm
index 960015abd..03e292737 100755
--- a/ice-9/gds-client.scm
+++ b/module/ice-9/gds-client.scm
@@ -13,16 +13,7 @@
 	    run-utility
 	    gds-accept-input))
 
-(cond ((string>=? (version) "1.7")
-       (use-modules (ice-9 debugger utils)))
-      (else
-       (define the-ice-9-debugger-module (resolve-module '(ice-9 debugger)))
-       (module-export! the-ice-9-debugger-module
-		       '(source-position
-			 write-frame-short/application
-			 write-frame-short/expression
-			 write-frame-args-long
-			 write-frame-long))))
+(use-modules (ice-9 debugger utils))
 
 (use-modules (ice-9 debugger))
 
@@ -172,23 +163,20 @@
 
 (define (connect-to-gds . application-name)
   (or gds-port
-      (begin
+      (let ((gds-unix-socket-name (getenv "GDS_UNIX_SOCKET_NAME")))
         (set! gds-port
-	      (or (let ((s (socket PF_INET SOCK_STREAM 0))
-			(SOL_TCP 6)
-			(TCP_NODELAY 1))
-		    (setsockopt s SOL_TCP TCP_NODELAY 1)
-		    (catch #t
-			   (lambda ()
-			     (connect s AF_INET (inet-aton "127.0.0.1") 8333)
-			     s)
-			   (lambda _ #f)))
-		  (let ((s (socket PF_UNIX SOCK_STREAM 0)))
-		    (catch #t
-			   (lambda ()
-			     (connect s AF_UNIX "/tmp/.gds_socket")
-			     s)
-			   (lambda _ #f)))
+	      (or (and gds-unix-socket-name
+		       (false-if-exception
+			(let ((s (socket PF_UNIX SOCK_STREAM 0)))
+			  (connect s AF_UNIX gds-unix-socket-name)
+			  s)))
+		  (false-if-exception
+		   (let ((s (socket PF_INET SOCK_STREAM 0))
+			 (SOL_TCP 6)
+			 (TCP_NODELAY 1))
+		     (setsockopt s SOL_TCP TCP_NODELAY 1)
+		     (connect s AF_INET (inet-aton "127.0.0.1") 8333)
+		     s))
 		  (error "Couldn't connect to GDS by TCP or Unix domain socket")))
         (write-form (list 'name (getpid) (apply client-name application-name))))))
 
@@ -204,11 +192,11 @@
 		(else
 		 (format #f "~A (PID ~A)" arg (getpid))))))))
 
-(if (not (defined? 'make-mutex))
-    (begin
-      (define (make-mutex) #f)
-      (define lock-mutex noop)
-      (define unlock-mutex noop)))
+;;(if (not (defined? 'make-mutex))
+;;    (begin
+;;      (define (make-mutex) #f)
+;;      (define lock-mutex noop)
+;;      (define unlock-mutex noop)))
 
 (define write-mutex (make-mutex))
 
diff --git a/ice-9/gds-server.scm b/module/ice-9/gds-server.scm
index f59758729..5ec867535 100644
--- a/ice-9/gds-server.scm
+++ b/module/ice-9/gds-server.scm
@@ -2,19 +2,19 @@
 
 ;;; Copyright (C) 2003 Free Software Foundation, Inc.
 ;;;
-;; This library is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU Lesser General Public
-;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
-;; 
-;; This library is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;; Lesser General Public License for more details.
-;; 
-;; You should have received a copy of the GNU Lesser General Public
-;; License along with this library; if not, write to the Free Software
-;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (ice-9 gds-server)
   #:export (run-server))
@@ -36,38 +36,31 @@
 
 (define connection->id (make-object-property))
 
-(define (run-server port-or-path)
+(define (run-server unix-socket-name tcp-port)
 
-  (or (integer? port-or-path)
-      (string? port-or-path)
-      (error "port-or-path should be an integer (port number) or a string (file name)"
-	     port-or-path))
+  (let ((unix-server (socket PF_UNIX SOCK_STREAM 0))
+	(tcp-server (socket PF_INET SOCK_STREAM 0)))
 
-  (let ((server (socket (if (integer? port-or-path) PF_INET PF_UNIX)
-			SOCK_STREAM
-			0)))
+    ;; Bind and start listening on the Unix domain socket.
+    (false-if-exception (delete-file unix-socket-name))
+    (bind unix-server AF_UNIX unix-socket-name)
+    (listen unix-server 5)
 
-    ;; Initialize server socket.
-    (if (integer? port-or-path)
-	(begin
-	  (setsockopt server SOL_SOCKET SO_REUSEADDR 1)
-	  (bind server AF_INET INADDR_ANY port-or-path))
-	(begin
-	  (catch #t
-		 (lambda () (delete-file port-or-path))
-		 (lambda _ #f))
-	  (bind server AF_UNIX port-or-path)))
-
-    ;; Start listening.
-    (listen server 5)
+    ;; Bind and start listening on the TCP socket.
+    (setsockopt tcp-server SOL_SOCKET SO_REUSEADDR 1)
+    (false-if-exception (bind tcp-server AF_INET INADDR_ANY tcp-port))
+    (listen tcp-server 5)
 
+    ;; Main loop.
     (let loop ((clients '()) (readable-sockets '()))
 
       (define (do-read port)
 	(cond ((eq? port (current-input-port))
 	       (do-read-from-ui))
-	      ((eq? port server)
-	       (accept-new-client))
+	      ((eq? port unix-server)
+	       (accept-new-client unix-server))
+	      ((eq? port tcp-server)
+	       (accept-new-client tcp-server))
 	      (else
 	       (do-read-from-client port))))
 
@@ -86,7 +79,7 @@
 	      (trc "client not found")))	
 	clients)
 
-      (define (accept-new-client)
+      (define (accept-new-client server)
         (let ((new-port (car (accept server))))
 	  ;; Read the client's ID.
 	  (let ((name-form (read new-port)))
@@ -122,8 +115,10 @@
       ;;(trc 'readable-sockets readable-sockets)
 
       (if (null? readable-sockets)
-	  (loop clients (car (select (cons (current-input-port)
-					   (cons server clients))
+	  (loop clients (car (select (cons* (current-input-port)
+					    unix-server
+					    tcp-server
+					    clients)
 				     '()
 				     '())))
 	  (loop (do-read (car readable-sockets)) (cdr readable-sockets))))))
diff --git a/ice-9/getopt-long.scm b/module/ice-9/getopt-long.scm
index 9e39e60c0..891a2e3b3 100644
--- a/ice-9/getopt-long.scm
+++ b/module/ice-9/getopt-long.scm
@@ -1,18 +1,18 @@
-;;; Copyright (C) 1998, 2001, 2006 Free Software Foundation, Inc.
+;;; Copyright (C) 1998, 2001, 2006, 2009 Free Software Foundation, Inc.
 ;;;
-;; This library is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU Lesser General Public
-;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
-;; 
-;; This library is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;; Lesser General Public License for more details.
-;; 
-;; You should have received a copy of the GNU Lesser General Public
-;; License along with this library; if not, write to the Free Software
-;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 ;;; Author: Russ McManus (rewritten by Thien-Thi Nguyen)
 
@@ -160,23 +160,29 @@
   :use-module ((ice-9 common-list) :select (some remove-if-not))
   :export (getopt-long option-ref))
 
-(define option-spec-fields '(name
-                             value
-                             required?
-                             single-char
-                             predicate
-                             value-policy))
+(eval-when (eval load compile)
+  ;; This binding is used both at compile-time and run-time.
+  (define option-spec-fields '(name
+                               value
+                               required?
+                               single-char
+                               predicate
+                               value-policy)))
 
 (define option-spec (make-record-type 'option-spec option-spec-fields))
 (define make-option-spec (record-constructor option-spec option-spec-fields))
 
-(define (define-one-option-spec-field-accessor field)
-  `(define ,(symbol-append 'option-spec-> field)        ;;; name slib-compat
-     (record-accessor option-spec ',field)))
+(eval-when (eval load compile)
+  ;; The following procedures are used only at compile-time when expanding
+  ;; `define-all-option-spec-accessors/modifiers' (see below).
 
-(define (define-one-option-spec-field-modifier field)
-  `(define ,(symbol-append 'set-option-spec- field '!)  ;;; name slib-compat
-     (record-modifier option-spec ',field)))
+  (define (define-one-option-spec-field-accessor field)
+    `(define ,(symbol-append 'option-spec-> field) ;;; name slib-compat
+       (record-accessor option-spec ',field)))
+
+  (define (define-one-option-spec-field-modifier field)
+    `(define ,(symbol-append 'set-option-spec- field '!) ;;; name slib-compat
+       (record-modifier option-spec ',field))))
 
 (defmacro define-all-option-spec-accessors/modifiers ()
   `(begin
diff --git a/ice-9/hcons.scm b/module/ice-9/hcons.scm
index 6323506d2..7275cf476 100644
--- a/ice-9/hcons.scm
+++ b/module/ice-9/hcons.scm
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/ice-9/history.scm b/module/ice-9/history.scm
index 921a25741..e9097c2cc 100644
--- a/ice-9/history.scm
+++ b/module/ice-9/history.scm
@@ -3,7 +3,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/ice-9/i18n.scm b/module/ice-9/i18n.scm
index e7c116e53..dd14e6754 100644
--- a/ice-9/i18n.scm
+++ b/module/ice-9/i18n.scm
@@ -5,13 +5,13 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
-;;;;
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 ;;;; Lesser General Public License for more details.
-;;;;
+;;;; 
 ;;;; You should have received a copy of the GNU Lesser General Public
 ;;;; License along with this library; if not, write to the Free Software
 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
@@ -83,7 +83,8 @@
            locale-yes-regexp locale-no-regexp))
 
 
-(load-extension "libguile-i18n-v-0" "scm_init_i18n")
+(eval-when (eval load compile)
+  (load-extension "libguile-i18n-v-0" "scm_init_i18n"))
 
 
 ;;;
diff --git a/ice-9/lineio.scm b/module/ice-9/lineio.scm
index f122268df..68f290369 100644
--- a/ice-9/lineio.scm
+++ b/module/ice-9/lineio.scm
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -20,7 +20,7 @@
 
 
 (define-module (ice-9 lineio)
-  :use-module (ice-9 readline)
+  :use-module (ice-9 rdelim)
   :export (unread-string read-string lineio-port?
 	   make-line-buffering-input-port))
 
diff --git a/module/ice-9/list.scm b/module/ice-9/list.scm
new file mode 100644
index 000000000..1b898a368
--- /dev/null
+++ b/module/ice-9/list.scm
@@ -0,0 +1,36 @@
+;;;; List functions not provided in R5RS or srfi-1
+
+;;; Copyright (C) 2003, 2006 Free Software Foundation, Inc.
+;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (ice-9 list)
+  :export (rassoc rassv rassq))
+
+(define (generic-rassoc key alist =)
+  (let loop ((ls alist))
+      (and (not (null? ls))
+	   (if (= key (cdar ls))
+	       (car ls)
+	       (loop (cdr ls))))))
+
+(define (rassoc key alist . =)
+  (generic-rassoc key alist (if (null? =) equal? (car =))))
+
+(define (rassv key alist)
+  (generic-rassoc key alist eqv?))
+
+(define (rassq key alist)
+  (generic-rassoc key alist eq?))
diff --git a/ice-9/ls.scm b/module/ice-9/ls.scm
index e848be32a..f729d58ce 100644
--- a/ice-9/ls.scm
+++ b/module/ice-9/ls.scm
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/ice-9/mapping.scm b/module/ice-9/mapping.scm
index c4ef4fe99..2907a8d89 100644
--- a/ice-9/mapping.scm
+++ b/module/ice-9/mapping.scm
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/ice-9/match.scm b/module/ice-9/match.scm
index e6fe56063..d7589239e 100644
--- a/ice-9/match.scm
+++ b/module/ice-9/match.scm
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -194,6 +194,6 @@
 (define match:runtime-structures #f)
 (define match:set-runtime-structures (lambda (v) (set! match:runtime-structures v)))
 (define match:primitive-vector? vector?)
-(defmacro defstruct args (let ((field? (lambda (x) (if (symbol? x) ((lambda () #t)) (if (and (pair? x) (symbol? (car x)) (pair? (cdr x)) (symbol? (cadr x)) (null? (cddr x))) ((lambda () #t)) ((lambda () #f)))))) (selector-name (lambda (x) (if (symbol? x) ((lambda () x)) (if (and (pair? x) (symbol? (car x)) (pair? (cdr x)) (null? (cddr x))) ((lambda (s) s) (car x)) (match:error x))))) (mutator-name (lambda (x) (if (symbol? x) ((lambda () #f)) (if (and (pair? x) (pair? (cdr x)) (symbol? (cadr x)) (null? (cddr x))) ((lambda (s) s) (cadr x)) (match:error x))))) (filter-map-with-index (lambda (f l) (letrec ((mapi (lambda (l i) (cond ((null? l) (quote ())) ((f (car l) i) => (lambda (x) (cons x (mapi (cdr l) (+ 1 i))))) (else (mapi (cdr l) (+ 1 i))))))) (mapi l 1))))) (let ((g296 (lambda () (match:syntax-err (quasiquote ((unquote defstruct) (unquote-splicing args))) "syntax error in")))) (if (and (pair? args) (symbol? (car args)) (pair? (cdr args)) (symbol? (cadr args)) (pair? (cddr args)) (symbol? (caddr args)) (list? (cdddr args))) (let g298 ((g299 (cdddr args)) (g297 (quote ()))) (if (null? g299) ((lambda (name constructor predicate fields) (let* ((selectors (map selector-name fields)) (mutators (map mutator-name fields)) (tag (if match:runtime-structures (gensym) (quasiquote (quote (unquote (match:make-structure-tag name)))))) (vectorP (cond ((eq? match:structure-control (quote disjoint)) (quote match:primitive-vector?)) ((eq? match:structure-control (quote vector)) (quote vector?))))) (cond ((eq? match:structure-control (quote disjoint)) (if (eq? vector? match:primitive-vector?) (set! vector? (lambda (v) (and (match:primitive-vector? v) (or (zero? (vector-length v)) (not (symbol? (vector-ref v 0))) (not (match:structure? (vector-ref v 0)))))))) (if (not (memq predicate match:disjoint-predicates)) (set! match:disjoint-predicates (cons predicate match:disjoint-predicates)))) ((eq? match:structure-control (quote vector)) (if (not (memq predicate match:vector-structures)) (set! match:vector-structures (cons predicate match:vector-structures)))) (else (match:syntax-err (quote (vector disjoint)) "invalid value for match:structure-control, legal values are"))) (quasiquote (begin (unquote-splicing (if match:runtime-structures (quasiquote ((define (unquote tag) (match:make-structure-tag (quote (unquote name)))))) (quote ()))) (define (unquote constructor) (lambda (unquote selectors) (vector (unquote tag) (unquote-splicing selectors)))) (define (unquote predicate) (lambda (obj) (and ((unquote vectorP) obj) (= (vector-length obj) (unquote (+ 1 (length selectors)))) (eq? (vector-ref obj 0) (unquote tag))))) (unquote-splicing (filter-map-with-index (lambda (n i) (quasiquote (define (unquote n) (lambda (obj) (vector-ref obj (unquote i)))))) selectors)) (unquote-splicing (filter-map-with-index (lambda (n i) (and n (quasiquote (define (unquote n) (lambda (obj newval) (vector-set! obj (unquote i) newval)))))) mutators)))))) (car args) (cadr args) (caddr args) (reverse g297)) (if (field? (car g299)) (g298 (cdr g299) (cons (car g299) g297)) (g296)))) (g296)))))
+(defmacro defstruct args (let ((field? (lambda (x) (if (symbol? x) ((lambda () #t)) (if (and (pair? x) (symbol? (car x)) (pair? (cdr x)) (symbol? (cadr x)) (null? (cddr x))) ((lambda () #t)) ((lambda () #f)))))) (selector-name (lambda (x) (if (symbol? x) ((lambda () x)) (if (and (pair? x) (symbol? (car x)) (pair? (cdr x)) (null? (cddr x))) ((lambda (s) s) (car x)) (match:error x))))) (mutator-name (lambda (x) (if (symbol? x) ((lambda () #f)) (if (and (pair? x) (pair? (cdr x)) (symbol? (cadr x)) (null? (cddr x))) ((lambda (s) s) (cadr x)) (match:error x))))) (filter-map-with-index (lambda (f l) (letrec ((mapi (lambda (l i) (cond ((null? l) (quote ())) ((f (car l) i) => (lambda (x) (cons x (mapi (cdr l) (+ 1 i))))) (else (mapi (cdr l) (+ 1 i))))))) (mapi l 1))))) (let ((g296 (lambda () (match:syntax-err (quasiquote (defstruct (unquote-splicing args))) "syntax error in")))) (if (and (pair? args) (symbol? (car args)) (pair? (cdr args)) (symbol? (cadr args)) (pair? (cddr args)) (symbol? (caddr args)) (list? (cdddr args))) (let g298 ((g299 (cdddr args)) (g297 (quote ()))) (if (null? g299) ((lambda (name constructor predicate fields) (let* ((selectors (map selector-name fields)) (mutators (map mutator-name fields)) (tag (if match:runtime-structures (gensym) (quasiquote (quote (unquote (match:make-structure-tag name)))))) (vectorP (cond ((eq? match:structure-control (quote disjoint)) (quote match:primitive-vector?)) ((eq? match:structure-control (quote vector)) (quote vector?))))) (cond ((eq? match:structure-control (quote disjoint)) (if (eq? vector? match:primitive-vector?) (set! vector? (lambda (v) (and (match:primitive-vector? v) (or (zero? (vector-length v)) (not (symbol? (vector-ref v 0))) (not (match:structure? (vector-ref v 0)))))))) (if (not (memq predicate match:disjoint-predicates)) (set! match:disjoint-predicates (cons predicate match:disjoint-predicates)))) ((eq? match:structure-control (quote vector)) (if (not (memq predicate match:vector-structures)) (set! match:vector-structures (cons predicate match:vector-structures)))) (else (match:syntax-err (quote (vector disjoint)) "invalid value for match:structure-control, legal values are"))) (quasiquote (begin (unquote-splicing (if match:runtime-structures (quasiquote ((define (unquote tag) (match:make-structure-tag (quote (unquote name)))))) (quote ()))) (define (unquote constructor) (lambda (unquote selectors) (vector (unquote tag) (unquote-splicing selectors)))) (define (unquote predicate) (lambda (obj) (and ((unquote vectorP) obj) (= (vector-length obj) (unquote (+ 1 (length selectors)))) (eq? (vector-ref obj 0) (unquote tag))))) (unquote-splicing (filter-map-with-index (lambda (n i) (quasiquote (define (unquote n) (lambda (obj) (vector-ref obj (unquote i)))))) selectors)) (unquote-splicing (filter-map-with-index (lambda (n i) (and n (quasiquote (define (unquote n) (lambda (obj newval) (vector-set! obj (unquote i) newval)))))) mutators)))))) (car args) (cadr args) (caddr args) (reverse g297)) (if (field? (car g299)) (g298 (cdr g299) (cons (car g299) g297)) (g296)))) (g296)))))
 (defmacro define-structure args (let ((g311 (lambda () (match:syntax-err (quasiquote (define-structure (unquote-splicing args))) "syntax error in")))) (if (and (pair? args) (pair? (car args)) (list? (cdar args))) (if (null? (cdr args)) ((lambda (name id1) (quasiquote (define-structure ((unquote name) (unquote-splicing id1)) ()))) (caar args) (cdar args)) (if (and (pair? (cdr args)) (list? (cadr args))) (let g308 ((g309 (cadr args)) (g307 (quote ())) (g306 (quote ()))) (if (null? g309) (if (null? (cddr args)) ((lambda (name id1 id2 val) (let ((mk-id (lambda (id) (if (and (pair? id) (equal? (car id) (quote @)) (pair? (cdr id)) (symbol? (cadr id)) (null? (cddr id))) ((lambda (x) x) (cadr id)) ((lambda () (quasiquote (! (unquote id))))))))) (quasiquote (define-const-structure ((unquote name) (unquote-splicing (map mk-id id1))) (unquote (map (lambda (id v) (quasiquote ((unquote (mk-id id)) (unquote v)))) id2 val)))))) (caar args) (cdar args) (reverse g306) (reverse g307)) (g311)) (if (and (pair? (car g309)) (pair? (cdar g309)) (null? (cddar g309))) (g308 (cdr g309) (cons (cadar g309) g307) (cons (caar g309) g306)) (g311)))) (g311))) (g311))))
-(defmacro define-const-structure args (let ((field? (lambda (id) (if (symbol? id) ((lambda () #t)) (if (and (pair? id) (equal? (car id) (quote !)) (pair? (cdr id)) (symbol? (cadr id)) (null? (cddr id))) ((lambda () #t)) ((lambda () #f)))))) (field-name (lambda (x) (if (symbol? x) x (cadr x)))) (has-mutator? (lambda (x) (not (symbol? x)))) (filter-map-with-index (lambda (f l) (letrec ((mapi (lambda (l i) (cond ((null? l) (quote ())) ((f (car l) i) => (lambda (x) (cons x (mapi (cdr l) (+ 1 i))))) (else (mapi (cdr l) (+ 1 i))))))) (mapi l 1)))) (symbol-append (lambda l (string->symbol (apply string-append (map (lambda (x) (cond ((symbol? x) (symbol->string x)) ((number? x) (number->string x)) (else x))) l)))))) (let ((g335 (lambda () (match:syntax-err (quasiquote (define-const-structure (unquote-splicing args))) "syntax error in")))) (if (and (pair? args) (pair? (car args)) (list? (cdar args))) (if (null? (cdr args)) ((lambda (name id1) (quasiquote (define-const-structure ((unquote name) (unquote-splicing id1)) ()))) (caar args) (cdar args)) (if (symbol? (caar args)) (let g328 ((g329 (cdar args)) (g327 (quote ()))) (if (null? g329) (if (and (pair? (cdr args)) (list? (cadr args))) (let g332 ((g333 (cadr args)) (g331 (quote ())) (g330 (quote ()))) (if (null? g333) (if (null? (cddr args)) ((lambda (name id1 id2 val) (let* ((id1id2 (append id1 id2)) (raw-constructor (symbol-append (quote make-raw-) name)) (constructor (symbol-append (quote make-) name)) (predicate (symbol-append name (quote ?)))) (quasiquote (begin ((unquote defstruct) (unquote name) (unquote raw-constructor) (unquote predicate) (unquote-splicing (filter-map-with-index (lambda (arg i) (if (has-mutator? arg) (quasiquote ((unquote (symbol-append name (quote -) i)) (unquote (symbol-append (quote set-) name (quote -) i (quote !))))) (symbol-append name (quote -) i))) id1id2))) (unquote (if (null? id2) (quasiquote (define (unquote constructor) (unquote raw-constructor))) (let* ((make-fresh (lambda (x) (if (eq? (quote _) x) (gensym) x))) (names1 (map make-fresh (map field-name id1))) (names2 (map make-fresh (map field-name id2)))) (quasiquote (define (unquote constructor) (lambda (unquote names1) (let* (unquote (map list names2 val)) ((unquote raw-constructor) (unquote-splicing names1) (unquote-splicing names2))))))))) (unquote-splicing (filter-map-with-index (lambda (field i) (if (eq? (field-name field) (quote _)) #f (quasiquote (define (unquote (symbol-append name (quote -) (field-name field))) (unquote (symbol-append name (quote -) i)))))) id1id2)) (unquote-splicing (filter-map-with-index (lambda (field i) (if (or (eq? (field-name field) (quote _)) (not (has-mutator? field))) #f (quasiquote (define (unquote (symbol-append (quote set-) name (quote -) (field-name field) (quote !))) (unquote (symbol-append (quote set-) name (quote -) i (quote !))))))) id1id2)))))) (caar args) (reverse g327) (reverse g330) (reverse g331)) (g335)) (if (and (pair? (car g333)) (field? (caar g333)) (pair? (cdar g333)) (null? (cddar g333))) (g332 (cdr g333) (cons (cadar g333) g331) (cons (caar g333) g330)) (g335)))) (g335)) (if (field? (car g329)) (g328 (cdr g329) (cons (car g329) g327)) (g335)))) (g335))) (g335)))))
+(defmacro define-const-structure args (let ((field? (lambda (id) (if (symbol? id) ((lambda () #t)) (if (and (pair? id) (equal? (car id) (quote !)) (pair? (cdr id)) (symbol? (cadr id)) (null? (cddr id))) ((lambda () #t)) ((lambda () #f)))))) (field-name (lambda (x) (if (symbol? x) x (cadr x)))) (has-mutator? (lambda (x) (not (symbol? x)))) (filter-map-with-index (lambda (f l) (letrec ((mapi (lambda (l i) (cond ((null? l) (quote ())) ((f (car l) i) => (lambda (x) (cons x (mapi (cdr l) (+ 1 i))))) (else (mapi (cdr l) (+ 1 i))))))) (mapi l 1)))) (symbol-append (lambda l (string->symbol (apply string-append (map (lambda (x) (cond ((symbol? x) (symbol->string x)) ((number? x) (number->string x)) (else x))) l)))))) (let ((g335 (lambda () (match:syntax-err (quasiquote (define-const-structure (unquote-splicing args))) "syntax error in")))) (if (and (pair? args) (pair? (car args)) (list? (cdar args))) (if (null? (cdr args)) ((lambda (name id1) (quasiquote (define-const-structure ((unquote name) (unquote-splicing id1)) ()))) (caar args) (cdar args)) (if (symbol? (caar args)) (let g328 ((g329 (cdar args)) (g327 (quote ()))) (if (null? g329) (if (and (pair? (cdr args)) (list? (cadr args))) (let g332 ((g333 (cadr args)) (g331 (quote ())) (g330 (quote ()))) (if (null? g333) (if (null? (cddr args)) ((lambda (name id1 id2 val) (let* ((id1id2 (append id1 id2)) (raw-constructor (symbol-append (quote make-raw-) name)) (constructor (symbol-append (quote make-) name)) (predicate (symbol-append name (quote ?)))) (quasiquote (begin (defstruct (unquote name) (unquote raw-constructor) (unquote predicate) (unquote-splicing (filter-map-with-index (lambda (arg i) (if (has-mutator? arg) (quasiquote ((unquote (symbol-append name (quote -) i)) (unquote (symbol-append (quote set-) name (quote -) i (quote !))))) (symbol-append name (quote -) i))) id1id2))) (unquote (if (null? id2) (quasiquote (define (unquote constructor) (unquote raw-constructor))) (let* ((make-fresh (lambda (x) (if (eq? (quote _) x) (gensym) x))) (names1 (map make-fresh (map field-name id1))) (names2 (map make-fresh (map field-name id2)))) (quasiquote (define (unquote constructor) (lambda (unquote names1) (let* (unquote (map list names2 val)) ((unquote raw-constructor) (unquote-splicing names1) (unquote-splicing names2))))))))) (unquote-splicing (filter-map-with-index (lambda (field i) (if (eq? (field-name field) (quote _)) #f (quasiquote (define (unquote (symbol-append name (quote -) (field-name field))) (unquote (symbol-append name (quote -) i)))))) id1id2)) (unquote-splicing (filter-map-with-index (lambda (field i) (if (or (eq? (field-name field) (quote _)) (not (has-mutator? field))) #f (quasiquote (define (unquote (symbol-append (quote set-) name (quote -) (field-name field) (quote !))) (unquote (symbol-append (quote set-) name (quote -) i (quote !))))))) id1id2)))))) (caar args) (reverse g327) (reverse g330) (reverse g331)) (g335)) (if (and (pair? (car g333)) (field? (caar g333)) (pair? (cdar g333)) (null? (cddar g333))) (g332 (cdr g333) (cons (cadar g333) g331) (cons (caar g333) g330)) (g335)))) (g335)) (if (field? (car g329)) (g328 (cdr g329) (cons (car g329) g327)) (g335)))) (g335))) (g335)))))
diff --git a/ice-9/networking.scm b/module/ice-9/networking.scm
index c0218821f..7e84f0969 100644
--- a/ice-9/networking.scm
+++ b/module/ice-9/networking.scm
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -17,6 +17,9 @@
 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 ;;;; 
 
+(eval-when (compile)
+  (set-current-module (resolve-module '(guile))))
+
 (define (gethostbyaddr addr) (gethost addr))
 (define (gethostbyname name) (gethost name))
 
diff --git a/ice-9/null.scm b/module/ice-9/null.scm
index b9212e605..58b271e31 100644
--- a/ice-9/null.scm
+++ b/module/ice-9/null.scm
@@ -3,7 +3,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -18,7 +18,6 @@
 ;;;; The null environment - only syntactic bindings
 
 (define-module (ice-9 null)
-  :use-module (ice-9 syncase)
   :re-export-syntax (define quote lambda if set!
 	
 		     cond case and or
diff --git a/ice-9/occam-channel.scm b/module/ice-9/occam-channel.scm
index e28f73d3b..ea1154b52 100644
--- a/ice-9/occam-channel.scm
+++ b/module/ice-9/occam-channel.scm
@@ -2,22 +2,21 @@
 
 ;;; Copyright (C) 2003, 2006 Free Software Foundation, Inc.
 ;;;
-;; This library is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU Lesser General Public
-;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
-;; 
-;; This library is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;; Lesser General Public License for more details.
-;; 
-;; You should have received a copy of the GNU Lesser General Public
-;; License along with this library; if not, write to the Free Software
-;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (ice-9 occam-channel)
-  #:use-syntax (ice-9 syncase)
   #:use-module (oop goops)
   #:use-module (ice-9 threads)
   #:export-syntax (alt
diff --git a/ice-9/optargs.scm b/module/ice-9/optargs.scm
index 99329c750..3093e15a4 100644
--- a/ice-9/optargs.scm
+++ b/module/ice-9/optargs.scm
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -149,11 +149,10 @@
 				 => cdr)
 				(else
 				 ,(cadr key)))))))
-	  `(let* ((ra->kbl ,rest-arg->keyword-binding-list)
-		  (,kb-list-gensym (ra->kbl ,REST-ARG ',(map
-							 (lambda (x) (symbol->keyword (if (pair? x) (car x) x)))
-							 BINDINGS)
-					    ,ALLOW-OTHER-KEYS?)))
+	  `(let ((,kb-list-gensym ((@@ (ice-9 optargs) rest-arg->keyword-binding-list)
+                                   ,REST-ARG ',(map (lambda (x) (symbol->keyword (if (pair? x) (car x) x)))
+                                                    BINDINGS)
+                                   ,ALLOW-OTHER-KEYS?)))
 	     ,(let-o-k-template REST-ARG BINDINGS BODY let-type bindfilter)))))
 
 
@@ -411,15 +410,11 @@
 ;;   (defmacro* transmorgify (a #:optional b)
 
 (defmacro defmacro* (NAME ARGLIST . BODY)
-  (defmacro*-guts 'define NAME ARGLIST BODY))
+  `(define-macro ,NAME #f (lambda* ,ARGLIST ,@BODY)))
 
 (defmacro defmacro*-public (NAME ARGLIST . BODY)
-  (defmacro*-guts 'define-public NAME ARGLIST BODY))
-
-;; The guts of defmacro* and defmacro*-public
-(define (defmacro*-guts DT NAME ARGLIST BODY)
-  `(,DT ,NAME
-	(,(lambda (transformer) (defmacro:transformer transformer))
-	 (lambda* ,ARGLIST ,@BODY))))
+  `(begin
+     (defmacro* ,NAME ,ARGLIST ,@BODY)
+     (export-syntax ,NAME)))
 
 ;;; optargs.scm ends here
diff --git a/ice-9/poe.scm b/module/ice-9/poe.scm
index fe963db08..e7b6e3a75 100644
--- a/ice-9/poe.scm
+++ b/module/ice-9/poe.scm
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/ice-9/popen.scm b/module/ice-9/popen.scm
index 275faaa0c..1a1892851 100644
--- a/ice-9/popen.scm
+++ b/module/ice-9/popen.scm
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/ice-9/posix.scm b/module/ice-9/posix.scm
index 53d01a026..a1be33c19 100644
--- a/ice-9/posix.scm
+++ b/module/ice-9/posix.scm
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -17,6 +17,9 @@
 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 ;;;; 
 
+(eval-when (compile)
+  (set-current-module (resolve-module '(guile))))
+
 (define (stat:dev f) (vector-ref f 0))
 (define (stat:ino f) (vector-ref f 1))
 (define (stat:mode f) (vector-ref f 2))
diff --git a/ice-9/pretty-print.scm b/module/ice-9/pretty-print.scm
index bef76ddcb..0ce6a8003 100644
--- a/ice-9/pretty-print.scm
+++ b/module/ice-9/pretty-print.scm
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
new file mode 100644
index 000000000..fecd2b25d
--- /dev/null
+++ b/module/ice-9/psyntax-pp.scm
@@ -0,0 +1,12150 @@
+(eval-when (compile) (set-current-module (resolve-module (quote (guile)))))
+(if #f #f)
+
+(letrec ((#{and-map*\ 1199}#
+           (lambda (#{f\ 1239}# #{first\ 1238}# . #{rest\ 1237}#)
+             (let ((#{t\ 1240}# (null? #{first\ 1238}#)))
+               (if #{t\ 1240}#
+                 #{t\ 1240}#
+                 (if (null? #{rest\ 1237}#)
+                   (letrec ((#{andmap\ 1241}#
+                              (lambda (#{first\ 1242}#)
+                                (let ((#{x\ 1243}# (car #{first\ 1242}#))
+                                      (#{first\ 1244}# (cdr #{first\ 1242}#)))
+                                  (if (null? #{first\ 1244}#)
+                                    (#{f\ 1239}# #{x\ 1243}#)
+                                    (if (#{f\ 1239}# #{x\ 1243}#)
+                                      (#{andmap\ 1241}# #{first\ 1244}#)
+                                      #f))))))
+                     (#{andmap\ 1241}# #{first\ 1238}#))
+                   (letrec ((#{andmap\ 1245}#
+                              (lambda (#{first\ 1246}# #{rest\ 1247}#)
+                                (let ((#{x\ 1248}# (car #{first\ 1246}#))
+                                      (#{xr\ 1249}# (map car #{rest\ 1247}#))
+                                      (#{first\ 1250}# (cdr #{first\ 1246}#))
+                                      (#{rest\ 1251}#
+                                        (map cdr #{rest\ 1247}#)))
+                                  (if (null? #{first\ 1250}#)
+                                    (apply #{f\ 1239}#
+                                           (cons #{x\ 1248}# #{xr\ 1249}#))
+                                    (if (apply #{f\ 1239}#
+                                               (cons #{x\ 1248}# #{xr\ 1249}#))
+                                      (#{andmap\ 1245}#
+                                        #{first\ 1250}#
+                                        #{rest\ 1251}#)
+                                      #f))))))
+                     (#{andmap\ 1245}# #{first\ 1238}# #{rest\ 1237}#))))))))
+  (letrec ((#{lambda-var-list\ 1345}#
+             (lambda (#{vars\ 1469}#)
+               (letrec ((#{lvl\ 1470}#
+                          (lambda (#{vars\ 1471}# #{ls\ 1472}# #{w\ 1473}#)
+                            (if (pair? #{vars\ 1471}#)
+                              (#{lvl\ 1470}#
+                                (cdr #{vars\ 1471}#)
+                                (cons (#{wrap\ 1325}#
+                                        (car #{vars\ 1471}#)
+                                        #{w\ 1473}#
+                                        #f)
+                                      #{ls\ 1472}#)
+                                #{w\ 1473}#)
+                              (if (#{id?\ 1297}# #{vars\ 1471}#)
+                                (cons (#{wrap\ 1325}#
+                                        #{vars\ 1471}#
+                                        #{w\ 1473}#
+                                        #f)
+                                      #{ls\ 1472}#)
+                                (if (null? #{vars\ 1471}#)
+                                  #{ls\ 1472}#
+                                  (if (#{syntax-object?\ 1281}# #{vars\ 1471}#)
+                                    (#{lvl\ 1470}#
+                                      (#{syntax-object-expression\ 1282}#
+                                        #{vars\ 1471}#)
+                                      #{ls\ 1472}#
+                                      (#{join-wraps\ 1316}#
+                                        #{w\ 1473}#
+                                        (#{syntax-object-wrap\ 1283}#
+                                          #{vars\ 1471}#)))
+                                    (cons #{vars\ 1471}# #{ls\ 1472}#))))))))
+                 (#{lvl\ 1470}#
+                   #{vars\ 1469}#
+                   '()
+                   '(())))))
+           (#{gen-var\ 1344}#
+             (lambda (#{id\ 1474}#)
+               (let ((#{id\ 1475}#
+                       (if (#{syntax-object?\ 1281}# #{id\ 1474}#)
+                         (#{syntax-object-expression\ 1282}# #{id\ 1474}#)
+                         #{id\ 1474}#)))
+                 (gensym
+                   (string-append (symbol->string #{id\ 1475}#) " ")))))
+           (#{strip\ 1343}#
+             (lambda (#{x\ 1476}# #{w\ 1477}#)
+               (if (memq 'top
+                         (#{wrap-marks\ 1300}# #{w\ 1477}#))
+                 #{x\ 1476}#
+                 (letrec ((#{f\ 1478}#
+                            (lambda (#{x\ 1479}#)
+                              (if (#{syntax-object?\ 1281}# #{x\ 1479}#)
+                                (#{strip\ 1343}#
+                                  (#{syntax-object-expression\ 1282}#
+                                    #{x\ 1479}#)
+                                  (#{syntax-object-wrap\ 1283}# #{x\ 1479}#))
+                                (if (pair? #{x\ 1479}#)
+                                  (let ((#{a\ 1480}#
+                                          (#{f\ 1478}# (car #{x\ 1479}#)))
+                                        (#{d\ 1481}#
+                                          (#{f\ 1478}# (cdr #{x\ 1479}#))))
+                                    (if (if (eq? #{a\ 1480}# (car #{x\ 1479}#))
+                                          (eq? #{d\ 1481}# (cdr #{x\ 1479}#))
+                                          #f)
+                                      #{x\ 1479}#
+                                      (cons #{a\ 1480}# #{d\ 1481}#)))
+                                  (if (vector? #{x\ 1479}#)
+                                    (let ((#{old\ 1482}#
+                                            (vector->list #{x\ 1479}#)))
+                                      (let ((#{new\ 1483}#
+                                              (map #{f\ 1478}# #{old\ 1482}#)))
+                                        (if (#{and-map*\ 1199}#
+                                              eq?
+                                              #{old\ 1482}#
+                                              #{new\ 1483}#)
+                                          #{x\ 1479}#
+                                          (list->vector #{new\ 1483}#))))
+                                    #{x\ 1479}#))))))
+                   (#{f\ 1478}# #{x\ 1476}#)))))
+           (#{ellipsis?\ 1342}#
+             (lambda (#{x\ 1484}#)
+               (if (#{nonsymbol-id?\ 1296}# #{x\ 1484}#)
+                 (#{free-id=?\ 1320}#
+                   #{x\ 1484}#
+                   '#(syntax-object
+                      ...
+                      ((top)
+                       #(ribcage () () ())
+                       #(ribcage () () ())
+                       #(ribcage #(x) #((top)) #("i"))
+                       #(ribcage
+                         (lambda-var-list
+                           gen-var
+                           strip
+                           ellipsis?
+                           chi-void
+                           eval-local-transformer
+                           chi-local-syntax
+                           chi-lambda-clause
+                           chi-body
+                           chi-macro
+                           chi-application
+                           chi-expr
+                           chi
+                           chi-top
+                           syntax-type
+                           chi-when-list
+                           chi-install-global
+                           chi-top-sequence
+                           chi-sequence
+                           source-wrap
+                           wrap
+                           bound-id-member?
+                           distinct-bound-ids?
+                           valid-bound-ids?
+                           bound-id=?
+                           free-id=?
+                           id-var-name
+                           same-marks?
+                           join-marks
+                           join-wraps
+                           smart-append
+                           make-binding-wrap
+                           extend-ribcage!
+                           make-empty-ribcage
+                           new-mark
+                           anti-mark
+                           the-anti-mark
+                           top-marked?
+                           top-wrap
+                           empty-wrap
+                           set-ribcage-labels!
+                           set-ribcage-marks!
+                           set-ribcage-symnames!
+                           ribcage-labels
+                           ribcage-marks
+                           ribcage-symnames
+                           ribcage?
+                           make-ribcage
+                           gen-labels
+                           gen-label
+                           make-rename
+                           rename-marks
+                           rename-new
+                           rename-old
+                           subst-rename?
+                           wrap-subst
+                           wrap-marks
+                           make-wrap
+                           id-sym-name&marks
+                           id-sym-name
+                           id?
+                           nonsymbol-id?
+                           global-extend
+                           lookup
+                           macros-only-env
+                           extend-var-env
+                           extend-env
+                           null-env
+                           binding-value
+                           binding-type
+                           make-binding
+                           arg-check
+                           source-annotation
+                           no-source
+                           set-syntax-object-module!
+                           set-syntax-object-wrap!
+                           set-syntax-object-expression!
+                           syntax-object-module
+                           syntax-object-wrap
+                           syntax-object-expression
+                           syntax-object?
+                           make-syntax-object
+                           build-lexical-var
+                           build-letrec
+                           build-named-let
+                           build-let
+                           build-sequence
+                           build-data
+                           build-primref
+                           build-lambda
+                           build-global-definition
+                           maybe-name-value!
+                           build-global-assignment
+                           build-global-reference
+                           analyze-variable
+                           build-lexical-assignment
+                           build-lexical-reference
+                           build-conditional
+                           build-application
+                           build-void
+                           decorate-source
+                           get-global-definition-hook
+                           put-global-definition-hook
+                           gensym-hook
+                           local-eval-hook
+                           top-level-eval-hook
+                           fx<
+                           fx=
+                           fx-
+                           fx+
+                           *mode*
+                           noexpand)
+                         ((top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top)
+                          (top))
+                         ("i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"
+                          "i"))
+                       #(ribcage
+                         (define-structure and-map*)
+                         ((top) (top))
+                         ("i" "i")))
+                      (hygiene guile)))
+                 #f)))
+           (#{chi-void\ 1341}#
+             (lambda () (#{build-void\ 1263}# #f)))
+           (#{eval-local-transformer\ 1340}#
+             (lambda (#{expanded\ 1485}# #{mod\ 1486}#)
+               (let ((#{p\ 1487}#
+                       (#{local-eval-hook\ 1259}#
+                         #{expanded\ 1485}#
+                         #{mod\ 1486}#)))
+                 (if (procedure? #{p\ 1487}#)
+                   #{p\ 1487}#
+                   (syntax-violation
+                     #f
+                     "nonprocedure transformer"
+                     #{p\ 1487}#)))))
+           (#{chi-local-syntax\ 1339}#
+             (lambda (#{rec?\ 1488}#
+                      #{e\ 1489}#
+                      #{r\ 1490}#
+                      #{w\ 1491}#
+                      #{s\ 1492}#
+                      #{mod\ 1493}#
+                      #{k\ 1494}#)
+               ((lambda (#{tmp\ 1495}#)
+                  ((lambda (#{tmp\ 1496}#)
+                     (if #{tmp\ 1496}#
+                       (apply (lambda (#{_\ 1497}#
+                                       #{id\ 1498}#
+                                       #{val\ 1499}#
+                                       #{e1\ 1500}#
+                                       #{e2\ 1501}#)
+                                (let ((#{ids\ 1502}# #{id\ 1498}#))
+                                  (if (not (#{valid-bound-ids?\ 1322}#
+                                             #{ids\ 1502}#))
+                                    (syntax-violation
+                                      #f
+                                      "duplicate bound keyword"
+                                      #{e\ 1489}#)
+                                    (let ((#{labels\ 1504}#
+                                            (#{gen-labels\ 1303}#
+                                              #{ids\ 1502}#)))
+                                      (let ((#{new-w\ 1505}#
+                                              (#{make-binding-wrap\ 1314}#
+                                                #{ids\ 1502}#
+                                                #{labels\ 1504}#
+                                                #{w\ 1491}#)))
+                                        (#{k\ 1494}#
+                                          (cons #{e1\ 1500}# #{e2\ 1501}#)
+                                          (#{extend-env\ 1291}#
+                                            #{labels\ 1504}#
+                                            (let ((#{w\ 1507}#
+                                                    (if #{rec?\ 1488}#
+                                                      #{new-w\ 1505}#
+                                                      #{w\ 1491}#))
+                                                  (#{trans-r\ 1508}#
+                                                    (#{macros-only-env\ 1293}#
+                                                      #{r\ 1490}#)))
+                                              (map (lambda (#{x\ 1509}#)
+                                                     (cons 'macro
+                                                           (#{eval-local-transformer\ 1340}#
+                                                             (#{chi\ 1333}#
+                                                               #{x\ 1509}#
+                                                               #{trans-r\ 1508}#
+                                                               #{w\ 1507}#
+                                                               #{mod\ 1493}#)
+                                                             #{mod\ 1493}#)))
+                                                   #{val\ 1499}#))
+                                            #{r\ 1490}#)
+                                          #{new-w\ 1505}#
+                                          #{s\ 1492}#
+                                          #{mod\ 1493}#))))))
+                              #{tmp\ 1496}#)
+                       ((lambda (#{_\ 1511}#)
+                          (syntax-violation
+                            #f
+                            "bad local syntax definition"
+                            (#{source-wrap\ 1326}#
+                              #{e\ 1489}#
+                              #{w\ 1491}#
+                              #{s\ 1492}#
+                              #{mod\ 1493}#)))
+                        #{tmp\ 1495}#)))
+                   ($sc-dispatch
+                     #{tmp\ 1495}#
+                     '(any #(each (any any)) any . each-any))))
+                #{e\ 1489}#)))
+           (#{chi-lambda-clause\ 1338}#
+             (lambda (#{e\ 1512}#
+                      #{docstring\ 1513}#
+                      #{c\ 1514}#
+                      #{r\ 1515}#
+                      #{w\ 1516}#
+                      #{mod\ 1517}#
+                      #{k\ 1518}#)
+               ((lambda (#{tmp\ 1519}#)
+                  ((lambda (#{tmp\ 1520}#)
+                     (if (if #{tmp\ 1520}#
+                           (apply (lambda (#{args\ 1521}#
+                                           #{doc\ 1522}#
+                                           #{e1\ 1523}#
+                                           #{e2\ 1524}#)
+                                    (if (string? (syntax->datum #{doc\ 1522}#))
+                                      (not #{docstring\ 1513}#)
+                                      #f))
+                                  #{tmp\ 1520}#)
+                           #f)
+                       (apply (lambda (#{args\ 1525}#
+                                       #{doc\ 1526}#
+                                       #{e1\ 1527}#
+                                       #{e2\ 1528}#)
+                                (#{chi-lambda-clause\ 1338}#
+                                  #{e\ 1512}#
+                                  #{doc\ 1526}#
+                                  (cons #{args\ 1525}#
+                                        (cons #{e1\ 1527}# #{e2\ 1528}#))
+                                  #{r\ 1515}#
+                                  #{w\ 1516}#
+                                  #{mod\ 1517}#
+                                  #{k\ 1518}#))
+                              #{tmp\ 1520}#)
+                       ((lambda (#{tmp\ 1530}#)
+                          (if #{tmp\ 1530}#
+                            (apply (lambda (#{id\ 1531}#
+                                            #{e1\ 1532}#
+                                            #{e2\ 1533}#)
+                                     (let ((#{ids\ 1534}# #{id\ 1531}#))
+                                       (if (not (#{valid-bound-ids?\ 1322}#
+                                                  #{ids\ 1534}#))
+                                         (syntax-violation
+                                           'lambda
+                                           "invalid parameter list"
+                                           #{e\ 1512}#)
+                                         (let ((#{labels\ 1536}#
+                                                 (#{gen-labels\ 1303}#
+                                                   #{ids\ 1534}#))
+                                               (#{new-vars\ 1537}#
+                                                 (map #{gen-var\ 1344}#
+                                                      #{ids\ 1534}#)))
+                                           (#{k\ 1518}#
+                                             (map syntax->datum #{ids\ 1534}#)
+                                             #{new-vars\ 1537}#
+                                             (if #{docstring\ 1513}#
+                                               (syntax->datum
+                                                 #{docstring\ 1513}#)
+                                               #f)
+                                             (#{chi-body\ 1337}#
+                                               (cons #{e1\ 1532}# #{e2\ 1533}#)
+                                               #{e\ 1512}#
+                                               (#{extend-var-env\ 1292}#
+                                                 #{labels\ 1536}#
+                                                 #{new-vars\ 1537}#
+                                                 #{r\ 1515}#)
+                                               (#{make-binding-wrap\ 1314}#
+                                                 #{ids\ 1534}#
+                                                 #{labels\ 1536}#
+                                                 #{w\ 1516}#)
+                                               #{mod\ 1517}#))))))
+                                   #{tmp\ 1530}#)
+                            ((lambda (#{tmp\ 1539}#)
+                               (if #{tmp\ 1539}#
+                                 (apply (lambda (#{ids\ 1540}#
+                                                 #{e1\ 1541}#
+                                                 #{e2\ 1542}#)
+                                          (let ((#{old-ids\ 1543}#
+                                                  (#{lambda-var-list\ 1345}#
+                                                    #{ids\ 1540}#)))
+                                            (if (not (#{valid-bound-ids?\ 1322}#
+                                                       #{old-ids\ 1543}#))
+                                              (syntax-violation
+                                                'lambda
+                                                "invalid parameter list"
+                                                #{e\ 1512}#)
+                                              (let ((#{labels\ 1544}#
+                                                      (#{gen-labels\ 1303}#
+                                                        #{old-ids\ 1543}#))
+                                                    (#{new-vars\ 1545}#
+                                                      (map #{gen-var\ 1344}#
+                                                           #{old-ids\ 1543}#)))
+                                                (#{k\ 1518}#
+                                                  (letrec ((#{f\ 1546}#
+                                                             (lambda (#{ls1\ 1547}#
+                                                                      #{ls2\ 1548}#)
+                                                               (if (null? #{ls1\ 1547}#)
+                                                                 (syntax->datum
+                                                                   #{ls2\ 1548}#)
+                                                                 (#{f\ 1546}#
+                                                                   (cdr #{ls1\ 1547}#)
+                                                                   (cons (syntax->datum
+                                                                           (car #{ls1\ 1547}#))
+                                                                         #{ls2\ 1548}#))))))
+                                                    (#{f\ 1546}#
+                                                      (cdr #{old-ids\ 1543}#)
+                                                      (car #{old-ids\ 1543}#)))
+                                                  (letrec ((#{f\ 1549}#
+                                                             (lambda (#{ls1\ 1550}#
+                                                                      #{ls2\ 1551}#)
+                                                               (if (null? #{ls1\ 1550}#)
+                                                                 #{ls2\ 1551}#
+                                                                 (#{f\ 1549}#
+                                                                   (cdr #{ls1\ 1550}#)
+                                                                   (cons (car #{ls1\ 1550}#)
+                                                                         #{ls2\ 1551}#))))))
+                                                    (#{f\ 1549}#
+                                                      (cdr #{new-vars\ 1545}#)
+                                                      (car #{new-vars\ 1545}#)))
+                                                  (if #{docstring\ 1513}#
+                                                    (syntax->datum
+                                                      #{docstring\ 1513}#)
+                                                    #f)
+                                                  (#{chi-body\ 1337}#
+                                                    (cons #{e1\ 1541}#
+                                                          #{e2\ 1542}#)
+                                                    #{e\ 1512}#
+                                                    (#{extend-var-env\ 1292}#
+                                                      #{labels\ 1544}#
+                                                      #{new-vars\ 1545}#
+                                                      #{r\ 1515}#)
+                                                    (#{make-binding-wrap\ 1314}#
+                                                      #{old-ids\ 1543}#
+                                                      #{labels\ 1544}#
+                                                      #{w\ 1516}#)
+                                                    #{mod\ 1517}#))))))
+                                        #{tmp\ 1539}#)
+                                 ((lambda (#{_\ 1553}#)
+                                    (syntax-violation
+                                      'lambda
+                                      "bad lambda"
+                                      #{e\ 1512}#))
+                                  #{tmp\ 1519}#)))
+                             ($sc-dispatch
+                               #{tmp\ 1519}#
+                               '(any any . each-any)))))
+                        ($sc-dispatch
+                          #{tmp\ 1519}#
+                          '(each-any any . each-any)))))
+                   ($sc-dispatch
+                     #{tmp\ 1519}#
+                     '(any any any . each-any))))
+                #{c\ 1514}#)))
+           (#{chi-body\ 1337}#
+             (lambda (#{body\ 1554}#
+                      #{outer-form\ 1555}#
+                      #{r\ 1556}#
+                      #{w\ 1557}#
+                      #{mod\ 1558}#)
+               (let ((#{r\ 1559}#
+                       (cons '("placeholder" placeholder)
+                             #{r\ 1556}#)))
+                 (let ((#{ribcage\ 1560}#
+                         (#{make-ribcage\ 1304}#
+                           '()
+                           '()
+                           '())))
+                   (let ((#{w\ 1561}#
+                           (#{make-wrap\ 1299}#
+                             (#{wrap-marks\ 1300}# #{w\ 1557}#)
+                             (cons #{ribcage\ 1560}#
+                                   (#{wrap-subst\ 1301}# #{w\ 1557}#)))))
+                     (letrec ((#{parse\ 1562}#
+                                (lambda (#{body\ 1563}#
+                                         #{ids\ 1564}#
+                                         #{labels\ 1565}#
+                                         #{var-ids\ 1566}#
+                                         #{vars\ 1567}#
+                                         #{vals\ 1568}#
+                                         #{bindings\ 1569}#)
+                                  (if (null? #{body\ 1563}#)
+                                    (syntax-violation
+                                      #f
+                                      "no expressions in body"
+                                      #{outer-form\ 1555}#)
+                                    (let ((#{e\ 1571}# (cdar #{body\ 1563}#))
+                                          (#{er\ 1572}# (caar #{body\ 1563}#)))
+                                      (call-with-values
+                                        (lambda ()
+                                          (#{syntax-type\ 1331}#
+                                            #{e\ 1571}#
+                                            #{er\ 1572}#
+                                            '(())
+                                            (#{source-annotation\ 1288}#
+                                              #{er\ 1572}#)
+                                            #{ribcage\ 1560}#
+                                            #{mod\ 1558}#
+                                            #f))
+                                        (lambda (#{type\ 1573}#
+                                                 #{value\ 1574}#
+                                                 #{e\ 1575}#
+                                                 #{w\ 1576}#
+                                                 #{s\ 1577}#
+                                                 #{mod\ 1578}#)
+                                          (if (memv #{type\ 1573}#
+                                                    '(define-form))
+                                            (let ((#{id\ 1579}#
+                                                    (#{wrap\ 1325}#
+                                                      #{value\ 1574}#
+                                                      #{w\ 1576}#
+                                                      #{mod\ 1578}#))
+                                                  (#{label\ 1580}#
+                                                    (#{gen-label\ 1302}#)))
+                                              (let ((#{var\ 1581}#
+                                                      (#{gen-var\ 1344}#
+                                                        #{id\ 1579}#)))
+                                                (begin
+                                                  (#{extend-ribcage!\ 1313}#
+                                                    #{ribcage\ 1560}#
+                                                    #{id\ 1579}#
+                                                    #{label\ 1580}#)
+                                                  (#{parse\ 1562}#
+                                                    (cdr #{body\ 1563}#)
+                                                    (cons #{id\ 1579}#
+                                                          #{ids\ 1564}#)
+                                                    (cons #{label\ 1580}#
+                                                          #{labels\ 1565}#)
+                                                    (cons #{id\ 1579}#
+                                                          #{var-ids\ 1566}#)
+                                                    (cons #{var\ 1581}#
+                                                          #{vars\ 1567}#)
+                                                    (cons (cons #{er\ 1572}#
+                                                                (#{wrap\ 1325}#
+                                                                  #{e\ 1575}#
+                                                                  #{w\ 1576}#
+                                                                  #{mod\ 1578}#))
+                                                          #{vals\ 1568}#)
+                                                    (cons (cons 'lexical
+                                                                #{var\ 1581}#)
+                                                          #{bindings\ 1569}#)))))
+                                            (if (memv #{type\ 1573}#
+                                                      '(define-syntax-form))
+                                              (let ((#{id\ 1582}#
+                                                      (#{wrap\ 1325}#
+                                                        #{value\ 1574}#
+                                                        #{w\ 1576}#
+                                                        #{mod\ 1578}#))
+                                                    (#{label\ 1583}#
+                                                      (#{gen-label\ 1302}#)))
+                                                (begin
+                                                  (#{extend-ribcage!\ 1313}#
+                                                    #{ribcage\ 1560}#
+                                                    #{id\ 1582}#
+                                                    #{label\ 1583}#)
+                                                  (#{parse\ 1562}#
+                                                    (cdr #{body\ 1563}#)
+                                                    (cons #{id\ 1582}#
+                                                          #{ids\ 1564}#)
+                                                    (cons #{label\ 1583}#
+                                                          #{labels\ 1565}#)
+                                                    #{var-ids\ 1566}#
+                                                    #{vars\ 1567}#
+                                                    #{vals\ 1568}#
+                                                    (cons (cons 'macro
+                                                                (cons #{er\ 1572}#
+                                                                      (#{wrap\ 1325}#
+                                                                        #{e\ 1575}#
+                                                                        #{w\ 1576}#
+                                                                        #{mod\ 1578}#)))
+                                                          #{bindings\ 1569}#))))
+                                              (if (memv #{type\ 1573}#
+                                                        '(begin-form))
+                                                ((lambda (#{tmp\ 1584}#)
+                                                   ((lambda (#{tmp\ 1585}#)
+                                                      (if #{tmp\ 1585}#
+                                                        (apply (lambda (#{_\ 1586}#
+                                                                        #{e1\ 1587}#)
+                                                                 (#{parse\ 1562}#
+                                                                   (letrec ((#{f\ 1588}#
+                                                                              (lambda (#{forms\ 1589}#)
+                                                                                (if (null? #{forms\ 1589}#)
+                                                                                  (cdr #{body\ 1563}#)
+                                                                                  (cons (cons #{er\ 1572}#
+                                                                                              (#{wrap\ 1325}#
+                                                                                                (car #{forms\ 1589}#)
+                                                                                                #{w\ 1576}#
+                                                                                                #{mod\ 1578}#))
+                                                                                        (#{f\ 1588}#
+                                                                                          (cdr #{forms\ 1589}#)))))))
+                                                                     (#{f\ 1588}#
+                                                                       #{e1\ 1587}#))
+                                                                   #{ids\ 1564}#
+                                                                   #{labels\ 1565}#
+                                                                   #{var-ids\ 1566}#
+                                                                   #{vars\ 1567}#
+                                                                   #{vals\ 1568}#
+                                                                   #{bindings\ 1569}#))
+                                                               #{tmp\ 1585}#)
+                                                        (syntax-violation
+                                                          #f
+                                                          "source expression failed to match any pattern"
+                                                          #{tmp\ 1584}#)))
+                                                    ($sc-dispatch
+                                                      #{tmp\ 1584}#
+                                                      '(any . each-any))))
+                                                 #{e\ 1575}#)
+                                                (if (memv #{type\ 1573}#
+                                                          '(local-syntax-form))
+                                                  (#{chi-local-syntax\ 1339}#
+                                                    #{value\ 1574}#
+                                                    #{e\ 1575}#
+                                                    #{er\ 1572}#
+                                                    #{w\ 1576}#
+                                                    #{s\ 1577}#
+                                                    #{mod\ 1578}#
+                                                    (lambda (#{forms\ 1591}#
+                                                             #{er\ 1592}#
+                                                             #{w\ 1593}#
+                                                             #{s\ 1594}#
+                                                             #{mod\ 1595}#)
+                                                      (#{parse\ 1562}#
+                                                        (letrec ((#{f\ 1596}#
+                                                                   (lambda (#{forms\ 1597}#)
+                                                                     (if (null? #{forms\ 1597}#)
+                                                                       (cdr #{body\ 1563}#)
+                                                                       (cons (cons #{er\ 1592}#
+                                                                                   (#{wrap\ 1325}#
+                                                                                     (car #{forms\ 1597}#)
+                                                                                     #{w\ 1593}#
+                                                                                     #{mod\ 1595}#))
+                                                                             (#{f\ 1596}#
+                                                                               (cdr #{forms\ 1597}#)))))))
+                                                          (#{f\ 1596}#
+                                                            #{forms\ 1591}#))
+                                                        #{ids\ 1564}#
+                                                        #{labels\ 1565}#
+                                                        #{var-ids\ 1566}#
+                                                        #{vars\ 1567}#
+                                                        #{vals\ 1568}#
+                                                        #{bindings\ 1569}#)))
+                                                  (if (null? #{ids\ 1564}#)
+                                                    (#{build-sequence\ 1276}#
+                                                      #f
+                                                      (map (lambda (#{x\ 1598}#)
+                                                             (#{chi\ 1333}#
+                                                               (cdr #{x\ 1598}#)
+                                                               (car #{x\ 1598}#)
+                                                               '(())
+                                                               #{mod\ 1578}#))
+                                                           (cons (cons #{er\ 1572}#
+                                                                       (#{source-wrap\ 1326}#
+                                                                         #{e\ 1575}#
+                                                                         #{w\ 1576}#
+                                                                         #{s\ 1577}#
+                                                                         #{mod\ 1578}#))
+                                                                 (cdr #{body\ 1563}#))))
+                                                    (begin
+                                                      (if (not (#{valid-bound-ids?\ 1322}#
+                                                                 #{ids\ 1564}#))
+                                                        (syntax-violation
+                                                          #f
+                                                          "invalid or duplicate identifier in definition"
+                                                          #{outer-form\ 1555}#))
+                                                      (letrec ((#{loop\ 1599}#
+                                                                 (lambda (#{bs\ 1600}#
+                                                                          #{er-cache\ 1601}#
+                                                                          #{r-cache\ 1602}#)
+                                                                   (if (not (null? #{bs\ 1600}#))
+                                                                     (let ((#{b\ 1603}#
+                                                                             (car #{bs\ 1600}#)))
+                                                                       (if (eq? (car #{b\ 1603}#)
+                                                                                'macro)
+                                                                         (let ((#{er\ 1604}#
+                                                                                 (cadr #{b\ 1603}#)))
+                                                                           (let ((#{r-cache\ 1605}#
+                                                                                   (if (eq? #{er\ 1604}#
+                                                                                            #{er-cache\ 1601}#)
+                                                                                     #{r-cache\ 1602}#
+                                                                                     (#{macros-only-env\ 1293}#
+                                                                                       #{er\ 1604}#))))
+                                                                             (begin
+                                                                               (set-cdr!
+                                                                                 #{b\ 1603}#
+                                                                                 (#{eval-local-transformer\ 1340}#
+                                                                                   (#{chi\ 1333}#
+                                                                                     (cddr #{b\ 1603}#)
+                                                                                     #{r-cache\ 1605}#
+                                                                                     '(())
+                                                                                     #{mod\ 1578}#)
+                                                                                   #{mod\ 1578}#))
+                                                                               (#{loop\ 1599}#
+                                                                                 (cdr #{bs\ 1600}#)
+                                                                                 #{er\ 1604}#
+                                                                                 #{r-cache\ 1605}#))))
+                                                                         (#{loop\ 1599}#
+                                                                           (cdr #{bs\ 1600}#)
+                                                                           #{er-cache\ 1601}#
+                                                                           #{r-cache\ 1602}#)))))))
+                                                        (#{loop\ 1599}#
+                                                          #{bindings\ 1569}#
+                                                          #f
+                                                          #f))
+                                                      (set-cdr!
+                                                        #{r\ 1559}#
+                                                        (#{extend-env\ 1291}#
+                                                          #{labels\ 1565}#
+                                                          #{bindings\ 1569}#
+                                                          (cdr #{r\ 1559}#)))
+                                                      (#{build-letrec\ 1279}#
+                                                        #f
+                                                        (map syntax->datum
+                                                             #{var-ids\ 1566}#)
+                                                        #{vars\ 1567}#
+                                                        (map (lambda (#{x\ 1606}#)
+                                                               (#{chi\ 1333}#
+                                                                 (cdr #{x\ 1606}#)
+                                                                 (car #{x\ 1606}#)
+                                                                 '(())
+                                                                 #{mod\ 1578}#))
+                                                             #{vals\ 1568}#)
+                                                        (#{build-sequence\ 1276}#
+                                                          #f
+                                                          (map (lambda (#{x\ 1607}#)
+                                                                 (#{chi\ 1333}#
+                                                                   (cdr #{x\ 1607}#)
+                                                                   (car #{x\ 1607}#)
+                                                                   '(())
+                                                                   #{mod\ 1578}#))
+                                                               (cons (cons #{er\ 1572}#
+                                                                           (#{source-wrap\ 1326}#
+                                                                             #{e\ 1575}#
+                                                                             #{w\ 1576}#
+                                                                             #{s\ 1577}#
+                                                                             #{mod\ 1578}#))
+                                                                     (cdr #{body\ 1563}#))))))))))))))))))
+                       (#{parse\ 1562}#
+                         (map (lambda (#{x\ 1570}#)
+                                (cons #{r\ 1559}#
+                                      (#{wrap\ 1325}#
+                                        #{x\ 1570}#
+                                        #{w\ 1561}#
+                                        #{mod\ 1558}#)))
+                              #{body\ 1554}#)
+                         '()
+                         '()
+                         '()
+                         '()
+                         '()
+                         '())))))))
+           (#{chi-macro\ 1336}#
+             (lambda (#{p\ 1608}#
+                      #{e\ 1609}#
+                      #{r\ 1610}#
+                      #{w\ 1611}#
+                      #{rib\ 1612}#
+                      #{mod\ 1613}#)
+               (letrec ((#{rebuild-macro-output\ 1614}#
+                          (lambda (#{x\ 1615}# #{m\ 1616}#)
+                            (if (pair? #{x\ 1615}#)
+                              (cons (#{rebuild-macro-output\ 1614}#
+                                      (car #{x\ 1615}#)
+                                      #{m\ 1616}#)
+                                    (#{rebuild-macro-output\ 1614}#
+                                      (cdr #{x\ 1615}#)
+                                      #{m\ 1616}#))
+                              (if (#{syntax-object?\ 1281}# #{x\ 1615}#)
+                                (let ((#{w\ 1617}#
+                                        (#{syntax-object-wrap\ 1283}#
+                                          #{x\ 1615}#)))
+                                  (let ((#{ms\ 1618}#
+                                          (#{wrap-marks\ 1300}# #{w\ 1617}#))
+                                        (#{s\ 1619}#
+                                          (#{wrap-subst\ 1301}# #{w\ 1617}#)))
+                                    (if (if (pair? #{ms\ 1618}#)
+                                          (eq? (car #{ms\ 1618}#) #f)
+                                          #f)
+                                      (#{make-syntax-object\ 1280}#
+                                        (#{syntax-object-expression\ 1282}#
+                                          #{x\ 1615}#)
+                                        (#{make-wrap\ 1299}#
+                                          (cdr #{ms\ 1618}#)
+                                          (if #{rib\ 1612}#
+                                            (cons #{rib\ 1612}#
+                                                  (cdr #{s\ 1619}#))
+                                            (cdr #{s\ 1619}#)))
+                                        (#{syntax-object-module\ 1284}#
+                                          #{x\ 1615}#))
+                                      (#{make-syntax-object\ 1280}#
+                                        (#{syntax-object-expression\ 1282}#
+                                          #{x\ 1615}#)
+                                        (#{make-wrap\ 1299}#
+                                          (cons #{m\ 1616}# #{ms\ 1618}#)
+                                          (if #{rib\ 1612}#
+                                            (cons #{rib\ 1612}#
+                                                  (cons 'shift
+                                                        #{s\ 1619}#))
+                                            (cons (quote shift) #{s\ 1619}#)))
+                                        (let ((#{pmod\ 1620}#
+                                                (procedure-module
+                                                  #{p\ 1608}#)))
+                                          (if #{pmod\ 1620}#
+                                            (cons 'hygiene
+                                                  (module-name #{pmod\ 1620}#))
+                                            '(hygiene guile)))))))
+                                (if (vector? #{x\ 1615}#)
+                                  (let ((#{n\ 1621}#
+                                          (vector-length #{x\ 1615}#)))
+                                    (let ((#{v\ 1622}#
+                                            (make-vector #{n\ 1621}#)))
+                                      (letrec ((#{loop\ 1623}#
+                                                 (lambda (#{i\ 1624}#)
+                                                   (if (#{fx=\ 1256}#
+                                                         #{i\ 1624}#
+                                                         #{n\ 1621}#)
+                                                     (begin
+                                                       (if #f #f)
+                                                       #{v\ 1622}#)
+                                                     (begin
+                                                       (vector-set!
+                                                         #{v\ 1622}#
+                                                         #{i\ 1624}#
+                                                         (#{rebuild-macro-output\ 1614}#
+                                                           (vector-ref
+                                                             #{x\ 1615}#
+                                                             #{i\ 1624}#)
+                                                           #{m\ 1616}#))
+                                                       (#{loop\ 1623}#
+                                                         (#{fx+\ 1254}#
+                                                           #{i\ 1624}#
+                                                           1)))))))
+                                        (#{loop\ 1623}# 0))))
+                                  (if (symbol? #{x\ 1615}#)
+                                    (syntax-violation
+                                      #f
+                                      "encountered raw symbol in macro output"
+                                      (#{source-wrap\ 1326}#
+                                        #{e\ 1609}#
+                                        #{w\ 1611}#
+                                        s
+                                        #{mod\ 1613}#)
+                                      #{x\ 1615}#)
+                                    #{x\ 1615}#)))))))
+                 (#{rebuild-macro-output\ 1614}#
+                   (#{p\ 1608}#
+                     (#{wrap\ 1325}#
+                       #{e\ 1609}#
+                       (#{anti-mark\ 1312}# #{w\ 1611}#)
+                       #{mod\ 1613}#))
+                   (string #\m)))))
+           (#{chi-application\ 1335}#
+             (lambda (#{x\ 1625}#
+                      #{e\ 1626}#
+                      #{r\ 1627}#
+                      #{w\ 1628}#
+                      #{s\ 1629}#
+                      #{mod\ 1630}#)
+               ((lambda (#{tmp\ 1631}#)
+                  ((lambda (#{tmp\ 1632}#)
+                     (if #{tmp\ 1632}#
+                       (apply (lambda (#{e0\ 1633}# #{e1\ 1634}#)
+                                (#{build-application\ 1264}#
+                                  #{s\ 1629}#
+                                  #{x\ 1625}#
+                                  (map (lambda (#{e\ 1635}#)
+                                         (#{chi\ 1333}#
+                                           #{e\ 1635}#
+                                           #{r\ 1627}#
+                                           #{w\ 1628}#
+                                           #{mod\ 1630}#))
+                                       #{e1\ 1634}#)))
+                              #{tmp\ 1632}#)
+                       (syntax-violation
+                         #f
+                         "source expression failed to match any pattern"
+                         #{tmp\ 1631}#)))
+                   ($sc-dispatch
+                     #{tmp\ 1631}#
+                     '(any . each-any))))
+                #{e\ 1626}#)))
+           (#{chi-expr\ 1334}#
+             (lambda (#{type\ 1637}#
+                      #{value\ 1638}#
+                      #{e\ 1639}#
+                      #{r\ 1640}#
+                      #{w\ 1641}#
+                      #{s\ 1642}#
+                      #{mod\ 1643}#)
+               (if (memv #{type\ 1637}# (quote (lexical)))
+                 (#{build-lexical-reference\ 1266}#
+                   'value
+                   #{s\ 1642}#
+                   #{e\ 1639}#
+                   #{value\ 1638}#)
+                 (if (memv #{type\ 1637}# (quote (core core-form)))
+                   (#{value\ 1638}#
+                     #{e\ 1639}#
+                     #{r\ 1640}#
+                     #{w\ 1641}#
+                     #{s\ 1642}#
+                     #{mod\ 1643}#)
+                   (if (memv #{type\ 1637}# (quote (module-ref)))
+                     (call-with-values
+                       (lambda () (#{value\ 1638}# #{e\ 1639}#))
+                       (lambda (#{id\ 1644}# #{mod\ 1645}#)
+                         (#{build-global-reference\ 1269}#
+                           #{s\ 1642}#
+                           #{id\ 1644}#
+                           #{mod\ 1645}#)))
+                     (if (memv #{type\ 1637}# (quote (lexical-call)))
+                       (#{chi-application\ 1335}#
+                         (#{build-lexical-reference\ 1266}#
+                           'fun
+                           (#{source-annotation\ 1288}# (car #{e\ 1639}#))
+                           (car #{e\ 1639}#)
+                           #{value\ 1638}#)
+                         #{e\ 1639}#
+                         #{r\ 1640}#
+                         #{w\ 1641}#
+                         #{s\ 1642}#
+                         #{mod\ 1643}#)
+                       (if (memv #{type\ 1637}# (quote (global-call)))
+                         (#{chi-application\ 1335}#
+                           (#{build-global-reference\ 1269}#
+                             (#{source-annotation\ 1288}# (car #{e\ 1639}#))
+                             (if (#{syntax-object?\ 1281}# #{value\ 1638}#)
+                               (#{syntax-object-expression\ 1282}#
+                                 #{value\ 1638}#)
+                               #{value\ 1638}#)
+                             (if (#{syntax-object?\ 1281}# #{value\ 1638}#)
+                               (#{syntax-object-module\ 1284}# #{value\ 1638}#)
+                               #{mod\ 1643}#))
+                           #{e\ 1639}#
+                           #{r\ 1640}#
+                           #{w\ 1641}#
+                           #{s\ 1642}#
+                           #{mod\ 1643}#)
+                         (if (memv #{type\ 1637}# (quote (constant)))
+                           (#{build-data\ 1275}#
+                             #{s\ 1642}#
+                             (#{strip\ 1343}#
+                               (#{source-wrap\ 1326}#
+                                 #{e\ 1639}#
+                                 #{w\ 1641}#
+                                 #{s\ 1642}#
+                                 #{mod\ 1643}#)
+                               '(())))
+                           (if (memv #{type\ 1637}# (quote (global)))
+                             (#{build-global-reference\ 1269}#
+                               #{s\ 1642}#
+                               #{value\ 1638}#
+                               #{mod\ 1643}#)
+                             (if (memv #{type\ 1637}# (quote (call)))
+                               (#{chi-application\ 1335}#
+                                 (#{chi\ 1333}#
+                                   (car #{e\ 1639}#)
+                                   #{r\ 1640}#
+                                   #{w\ 1641}#
+                                   #{mod\ 1643}#)
+                                 #{e\ 1639}#
+                                 #{r\ 1640}#
+                                 #{w\ 1641}#
+                                 #{s\ 1642}#
+                                 #{mod\ 1643}#)
+                               (if (memv #{type\ 1637}# (quote (begin-form)))
+                                 ((lambda (#{tmp\ 1646}#)
+                                    ((lambda (#{tmp\ 1647}#)
+                                       (if #{tmp\ 1647}#
+                                         (apply (lambda (#{_\ 1648}#
+                                                         #{e1\ 1649}#
+                                                         #{e2\ 1650}#)
+                                                  (#{chi-sequence\ 1327}#
+                                                    (cons #{e1\ 1649}#
+                                                          #{e2\ 1650}#)
+                                                    #{r\ 1640}#
+                                                    #{w\ 1641}#
+                                                    #{s\ 1642}#
+                                                    #{mod\ 1643}#))
+                                                #{tmp\ 1647}#)
+                                         (syntax-violation
+                                           #f
+                                           "source expression failed to match any pattern"
+                                           #{tmp\ 1646}#)))
+                                     ($sc-dispatch
+                                       #{tmp\ 1646}#
+                                       '(any any . each-any))))
+                                  #{e\ 1639}#)
+                                 (if (memv #{type\ 1637}#
+                                           '(local-syntax-form))
+                                   (#{chi-local-syntax\ 1339}#
+                                     #{value\ 1638}#
+                                     #{e\ 1639}#
+                                     #{r\ 1640}#
+                                     #{w\ 1641}#
+                                     #{s\ 1642}#
+                                     #{mod\ 1643}#
+                                     #{chi-sequence\ 1327}#)
+                                   (if (memv #{type\ 1637}#
+                                             '(eval-when-form))
+                                     ((lambda (#{tmp\ 1652}#)
+                                        ((lambda (#{tmp\ 1653}#)
+                                           (if #{tmp\ 1653}#
+                                             (apply (lambda (#{_\ 1654}#
+                                                             #{x\ 1655}#
+                                                             #{e1\ 1656}#
+                                                             #{e2\ 1657}#)
+                                                      (let ((#{when-list\ 1658}#
+                                                              (#{chi-when-list\ 1330}#
+                                                                #{e\ 1639}#
+                                                                #{x\ 1655}#
+                                                                #{w\ 1641}#)))
+                                                        (if (memq 'eval
+                                                                  #{when-list\ 1658}#)
+                                                          (#{chi-sequence\ 1327}#
+                                                            (cons #{e1\ 1656}#
+                                                                  #{e2\ 1657}#)
+                                                            #{r\ 1640}#
+                                                            #{w\ 1641}#
+                                                            #{s\ 1642}#
+                                                            #{mod\ 1643}#)
+                                                          (#{chi-void\ 1341}#))))
+                                                    #{tmp\ 1653}#)
+                                             (syntax-violation
+                                               #f
+                                               "source expression failed to match any pattern"
+                                               #{tmp\ 1652}#)))
+                                         ($sc-dispatch
+                                           #{tmp\ 1652}#
+                                           '(any each-any any . each-any))))
+                                      #{e\ 1639}#)
+                                     (if (memv #{type\ 1637}#
+                                               '(define-form
+                                                  define-syntax-form))
+                                       (syntax-violation
+                                         #f
+                                         "definition in expression context"
+                                         #{e\ 1639}#
+                                         (#{wrap\ 1325}#
+                                           #{value\ 1638}#
+                                           #{w\ 1641}#
+                                           #{mod\ 1643}#))
+                                       (if (memv #{type\ 1637}#
+                                                 '(syntax))
+                                         (syntax-violation
+                                           #f
+                                           "reference to pattern variable outside syntax form"
+                                           (#{source-wrap\ 1326}#
+                                             #{e\ 1639}#
+                                             #{w\ 1641}#
+                                             #{s\ 1642}#
+                                             #{mod\ 1643}#))
+                                         (if (memv #{type\ 1637}#
+                                                   '(displaced-lexical))
+                                           (syntax-violation
+                                             #f
+                                             "reference to identifier outside its scope"
+                                             (#{source-wrap\ 1326}#
+                                               #{e\ 1639}#
+                                               #{w\ 1641}#
+                                               #{s\ 1642}#
+                                               #{mod\ 1643}#))
+                                           (syntax-violation
+                                             #f
+                                             "unexpected syntax"
+                                             (#{source-wrap\ 1326}#
+                                               #{e\ 1639}#
+                                               #{w\ 1641}#
+                                               #{s\ 1642}#
+                                               #{mod\ 1643}#))))))))))))))))))
+           (#{chi\ 1333}#
+             (lambda (#{e\ 1661}#
+                      #{r\ 1662}#
+                      #{w\ 1663}#
+                      #{mod\ 1664}#)
+               (call-with-values
+                 (lambda ()
+                   (#{syntax-type\ 1331}#
+                     #{e\ 1661}#
+                     #{r\ 1662}#
+                     #{w\ 1663}#
+                     (#{source-annotation\ 1288}# #{e\ 1661}#)
+                     #f
+                     #{mod\ 1664}#
+                     #f))
+                 (lambda (#{type\ 1665}#
+                          #{value\ 1666}#
+                          #{e\ 1667}#
+                          #{w\ 1668}#
+                          #{s\ 1669}#
+                          #{mod\ 1670}#)
+                   (#{chi-expr\ 1334}#
+                     #{type\ 1665}#
+                     #{value\ 1666}#
+                     #{e\ 1667}#
+                     #{r\ 1662}#
+                     #{w\ 1668}#
+                     #{s\ 1669}#
+                     #{mod\ 1670}#)))))
+           (#{chi-top\ 1332}#
+             (lambda (#{e\ 1671}#
+                      #{r\ 1672}#
+                      #{w\ 1673}#
+                      #{m\ 1674}#
+                      #{esew\ 1675}#
+                      #{mod\ 1676}#)
+               (call-with-values
+                 (lambda ()
+                   (#{syntax-type\ 1331}#
+                     #{e\ 1671}#
+                     #{r\ 1672}#
+                     #{w\ 1673}#
+                     (#{source-annotation\ 1288}# #{e\ 1671}#)
+                     #f
+                     #{mod\ 1676}#
+                     #f))
+                 (lambda (#{type\ 1684}#
+                          #{value\ 1685}#
+                          #{e\ 1686}#
+                          #{w\ 1687}#
+                          #{s\ 1688}#
+                          #{mod\ 1689}#)
+                   (if (memv #{type\ 1684}# (quote (begin-form)))
+                     ((lambda (#{tmp\ 1690}#)
+                        ((lambda (#{tmp\ 1691}#)
+                           (if #{tmp\ 1691}#
+                             (apply (lambda (#{_\ 1692}#) (#{chi-void\ 1341}#))
+                                    #{tmp\ 1691}#)
+                             ((lambda (#{tmp\ 1693}#)
+                                (if #{tmp\ 1693}#
+                                  (apply (lambda (#{_\ 1694}#
+                                                  #{e1\ 1695}#
+                                                  #{e2\ 1696}#)
+                                           (#{chi-top-sequence\ 1328}#
+                                             (cons #{e1\ 1695}# #{e2\ 1696}#)
+                                             #{r\ 1672}#
+                                             #{w\ 1687}#
+                                             #{s\ 1688}#
+                                             #{m\ 1674}#
+                                             #{esew\ 1675}#
+                                             #{mod\ 1689}#))
+                                         #{tmp\ 1693}#)
+                                  (syntax-violation
+                                    #f
+                                    "source expression failed to match any pattern"
+                                    #{tmp\ 1690}#)))
+                              ($sc-dispatch
+                                #{tmp\ 1690}#
+                                '(any any . each-any)))))
+                         ($sc-dispatch #{tmp\ 1690}# (quote (any)))))
+                      #{e\ 1686}#)
+                     (if (memv #{type\ 1684}# (quote (local-syntax-form)))
+                       (#{chi-local-syntax\ 1339}#
+                         #{value\ 1685}#
+                         #{e\ 1686}#
+                         #{r\ 1672}#
+                         #{w\ 1687}#
+                         #{s\ 1688}#
+                         #{mod\ 1689}#
+                         (lambda (#{body\ 1698}#
+                                  #{r\ 1699}#
+                                  #{w\ 1700}#
+                                  #{s\ 1701}#
+                                  #{mod\ 1702}#)
+                           (#{chi-top-sequence\ 1328}#
+                             #{body\ 1698}#
+                             #{r\ 1699}#
+                             #{w\ 1700}#
+                             #{s\ 1701}#
+                             #{m\ 1674}#
+                             #{esew\ 1675}#
+                             #{mod\ 1702}#)))
+                       (if (memv #{type\ 1684}# (quote (eval-when-form)))
+                         ((lambda (#{tmp\ 1703}#)
+                            ((lambda (#{tmp\ 1704}#)
+                               (if #{tmp\ 1704}#
+                                 (apply (lambda (#{_\ 1705}#
+                                                 #{x\ 1706}#
+                                                 #{e1\ 1707}#
+                                                 #{e2\ 1708}#)
+                                          (let ((#{when-list\ 1709}#
+                                                  (#{chi-when-list\ 1330}#
+                                                    #{e\ 1686}#
+                                                    #{x\ 1706}#
+                                                    #{w\ 1687}#))
+                                                (#{body\ 1710}#
+                                                  (cons #{e1\ 1707}#
+                                                        #{e2\ 1708}#)))
+                                            (if (eq? #{m\ 1674}# (quote e))
+                                              (if (memq 'eval
+                                                        #{when-list\ 1709}#)
+                                                (#{chi-top-sequence\ 1328}#
+                                                  #{body\ 1710}#
+                                                  #{r\ 1672}#
+                                                  #{w\ 1687}#
+                                                  #{s\ 1688}#
+                                                  'e
+                                                  '(eval)
+                                                  #{mod\ 1689}#)
+                                                (#{chi-void\ 1341}#))
+                                              (if (memq 'load
+                                                        #{when-list\ 1709}#)
+                                                (if (let ((#{t\ 1713}#
+                                                            (memq 'compile
+                                                                  #{when-list\ 1709}#)))
+                                                      (if #{t\ 1713}#
+                                                        #{t\ 1713}#
+                                                        (if (eq? #{m\ 1674}#
+                                                                 'c&e)
+                                                          (memq 'eval
+                                                                #{when-list\ 1709}#)
+                                                          #f)))
+                                                  (#{chi-top-sequence\ 1328}#
+                                                    #{body\ 1710}#
+                                                    #{r\ 1672}#
+                                                    #{w\ 1687}#
+                                                    #{s\ 1688}#
+                                                    'c&e
+                                                    '(compile load)
+                                                    #{mod\ 1689}#)
+                                                  (if (memq #{m\ 1674}#
+                                                            '(c c&e))
+                                                    (#{chi-top-sequence\ 1328}#
+                                                      #{body\ 1710}#
+                                                      #{r\ 1672}#
+                                                      #{w\ 1687}#
+                                                      #{s\ 1688}#
+                                                      'c
+                                                      '(load)
+                                                      #{mod\ 1689}#)
+                                                    (#{chi-void\ 1341}#)))
+                                                (if (let ((#{t\ 1714}#
+                                                            (memq 'compile
+                                                                  #{when-list\ 1709}#)))
+                                                      (if #{t\ 1714}#
+                                                        #{t\ 1714}#
+                                                        (if (eq? #{m\ 1674}#
+                                                                 'c&e)
+                                                          (memq 'eval
+                                                                #{when-list\ 1709}#)
+                                                          #f)))
+                                                  (begin
+                                                    (#{top-level-eval-hook\ 1258}#
+                                                      (#{chi-top-sequence\ 1328}#
+                                                        #{body\ 1710}#
+                                                        #{r\ 1672}#
+                                                        #{w\ 1687}#
+                                                        #{s\ 1688}#
+                                                        'e
+                                                        '(eval)
+                                                        #{mod\ 1689}#)
+                                                      #{mod\ 1689}#)
+                                                    (#{chi-void\ 1341}#))
+                                                  (#{chi-void\ 1341}#))))))
+                                        #{tmp\ 1704}#)
+                                 (syntax-violation
+                                   #f
+                                   "source expression failed to match any pattern"
+                                   #{tmp\ 1703}#)))
+                             ($sc-dispatch
+                               #{tmp\ 1703}#
+                               '(any each-any any . each-any))))
+                          #{e\ 1686}#)
+                         (if (memv #{type\ 1684}#
+                                   '(define-syntax-form))
+                           (let ((#{n\ 1715}#
+                                   (#{id-var-name\ 1319}#
+                                     #{value\ 1685}#
+                                     #{w\ 1687}#))
+                                 (#{r\ 1716}#
+                                   (#{macros-only-env\ 1293}# #{r\ 1672}#)))
+                             (if (memv #{m\ 1674}# (quote (c)))
+                               (if (memq (quote compile) #{esew\ 1675}#)
+                                 (let ((#{e\ 1717}#
+                                         (#{chi-install-global\ 1329}#
+                                           #{n\ 1715}#
+                                           (#{chi\ 1333}#
+                                             #{e\ 1686}#
+                                             #{r\ 1716}#
+                                             #{w\ 1687}#
+                                             #{mod\ 1689}#))))
+                                   (begin
+                                     (#{top-level-eval-hook\ 1258}#
+                                       #{e\ 1717}#
+                                       #{mod\ 1689}#)
+                                     (if (memq (quote load) #{esew\ 1675}#)
+                                       #{e\ 1717}#
+                                       (#{chi-void\ 1341}#))))
+                                 (if (memq (quote load) #{esew\ 1675}#)
+                                   (#{chi-install-global\ 1329}#
+                                     #{n\ 1715}#
+                                     (#{chi\ 1333}#
+                                       #{e\ 1686}#
+                                       #{r\ 1716}#
+                                       #{w\ 1687}#
+                                       #{mod\ 1689}#))
+                                   (#{chi-void\ 1341}#)))
+                               (if (memv #{m\ 1674}# (quote (c&e)))
+                                 (let ((#{e\ 1718}#
+                                         (#{chi-install-global\ 1329}#
+                                           #{n\ 1715}#
+                                           (#{chi\ 1333}#
+                                             #{e\ 1686}#
+                                             #{r\ 1716}#
+                                             #{w\ 1687}#
+                                             #{mod\ 1689}#))))
+                                   (begin
+                                     (#{top-level-eval-hook\ 1258}#
+                                       #{e\ 1718}#
+                                       #{mod\ 1689}#)
+                                     #{e\ 1718}#))
+                                 (begin
+                                   (if (memq (quote eval) #{esew\ 1675}#)
+                                     (#{top-level-eval-hook\ 1258}#
+                                       (#{chi-install-global\ 1329}#
+                                         #{n\ 1715}#
+                                         (#{chi\ 1333}#
+                                           #{e\ 1686}#
+                                           #{r\ 1716}#
+                                           #{w\ 1687}#
+                                           #{mod\ 1689}#))
+                                       #{mod\ 1689}#))
+                                   (#{chi-void\ 1341}#)))))
+                           (if (memv #{type\ 1684}# (quote (define-form)))
+                             (let ((#{n\ 1719}#
+                                     (#{id-var-name\ 1319}#
+                                       #{value\ 1685}#
+                                       #{w\ 1687}#)))
+                               (let ((#{type\ 1720}#
+                                       (#{binding-type\ 1289}#
+                                         (#{lookup\ 1294}#
+                                           #{n\ 1719}#
+                                           #{r\ 1672}#
+                                           #{mod\ 1689}#))))
+                                 (if (memv #{type\ 1720}#
+                                           '(global core macro module-ref))
+                                   (begin
+                                     (if (if (not (module-local-variable
+                                                    (current-module)
+                                                    #{n\ 1719}#))
+                                           (current-module)
+                                           #f)
+                                       (let ((#{old\ 1721}#
+                                               (module-variable
+                                                 (current-module)
+                                                 #{n\ 1719}#)))
+                                         (module-define!
+                                           (current-module)
+                                           #{n\ 1719}#
+                                           (if (variable? #{old\ 1721}#)
+                                             (variable-ref #{old\ 1721}#)
+                                             #f))))
+                                     (let ((#{x\ 1722}#
+                                             (#{build-global-definition\ 1272}#
+                                               #{s\ 1688}#
+                                               #{n\ 1719}#
+                                               (#{chi\ 1333}#
+                                                 #{e\ 1686}#
+                                                 #{r\ 1672}#
+                                                 #{w\ 1687}#
+                                                 #{mod\ 1689}#))))
+                                       (begin
+                                         (if (eq? #{m\ 1674}# (quote c&e))
+                                           (#{top-level-eval-hook\ 1258}#
+                                             #{x\ 1722}#
+                                             #{mod\ 1689}#))
+                                         #{x\ 1722}#)))
+                                   (if (memv #{type\ 1720}#
+                                             '(displaced-lexical))
+                                     (syntax-violation
+                                       #f
+                                       "identifier out of context"
+                                       #{e\ 1686}#
+                                       (#{wrap\ 1325}#
+                                         #{value\ 1685}#
+                                         #{w\ 1687}#
+                                         #{mod\ 1689}#))
+                                     (syntax-violation
+                                       #f
+                                       "cannot define keyword at top level"
+                                       #{e\ 1686}#
+                                       (#{wrap\ 1325}#
+                                         #{value\ 1685}#
+                                         #{w\ 1687}#
+                                         #{mod\ 1689}#))))))
+                             (let ((#{x\ 1723}#
+                                     (#{chi-expr\ 1334}#
+                                       #{type\ 1684}#
+                                       #{value\ 1685}#
+                                       #{e\ 1686}#
+                                       #{r\ 1672}#
+                                       #{w\ 1687}#
+                                       #{s\ 1688}#
+                                       #{mod\ 1689}#)))
+                               (begin
+                                 (if (eq? #{m\ 1674}# (quote c&e))
+                                   (#{top-level-eval-hook\ 1258}#
+                                     #{x\ 1723}#
+                                     #{mod\ 1689}#))
+                                 #{x\ 1723}#)))))))))))
+           (#{syntax-type\ 1331}#
+             (lambda (#{e\ 1724}#
+                      #{r\ 1725}#
+                      #{w\ 1726}#
+                      #{s\ 1727}#
+                      #{rib\ 1728}#
+                      #{mod\ 1729}#
+                      #{for-car?\ 1730}#)
+               (if (symbol? #{e\ 1724}#)
+                 (let ((#{n\ 1731}#
+                         (#{id-var-name\ 1319}# #{e\ 1724}# #{w\ 1726}#)))
+                   (let ((#{b\ 1732}#
+                           (#{lookup\ 1294}#
+                             #{n\ 1731}#
+                             #{r\ 1725}#
+                             #{mod\ 1729}#)))
+                     (let ((#{type\ 1733}#
+                             (#{binding-type\ 1289}# #{b\ 1732}#)))
+                       (if (memv #{type\ 1733}# (quote (lexical)))
+                         (values
+                           #{type\ 1733}#
+                           (#{binding-value\ 1290}# #{b\ 1732}#)
+                           #{e\ 1724}#
+                           #{w\ 1726}#
+                           #{s\ 1727}#
+                           #{mod\ 1729}#)
+                         (if (memv #{type\ 1733}# (quote (global)))
+                           (values
+                             #{type\ 1733}#
+                             #{n\ 1731}#
+                             #{e\ 1724}#
+                             #{w\ 1726}#
+                             #{s\ 1727}#
+                             #{mod\ 1729}#)
+                           (if (memv #{type\ 1733}# (quote (macro)))
+                             (if #{for-car?\ 1730}#
+                               (values
+                                 #{type\ 1733}#
+                                 (#{binding-value\ 1290}# #{b\ 1732}#)
+                                 #{e\ 1724}#
+                                 #{w\ 1726}#
+                                 #{s\ 1727}#
+                                 #{mod\ 1729}#)
+                               (#{syntax-type\ 1331}#
+                                 (#{chi-macro\ 1336}#
+                                   (#{binding-value\ 1290}# #{b\ 1732}#)
+                                   #{e\ 1724}#
+                                   #{r\ 1725}#
+                                   #{w\ 1726}#
+                                   #{rib\ 1728}#
+                                   #{mod\ 1729}#)
+                                 #{r\ 1725}#
+                                 '(())
+                                 #{s\ 1727}#
+                                 #{rib\ 1728}#
+                                 #{mod\ 1729}#
+                                 #f))
+                             (values
+                               #{type\ 1733}#
+                               (#{binding-value\ 1290}# #{b\ 1732}#)
+                               #{e\ 1724}#
+                               #{w\ 1726}#
+                               #{s\ 1727}#
+                               #{mod\ 1729}#)))))))
+                 (if (pair? #{e\ 1724}#)
+                   (let ((#{first\ 1734}# (car #{e\ 1724}#)))
+                     (call-with-values
+                       (lambda ()
+                         (#{syntax-type\ 1331}#
+                           #{first\ 1734}#
+                           #{r\ 1725}#
+                           #{w\ 1726}#
+                           #{s\ 1727}#
+                           #{rib\ 1728}#
+                           #{mod\ 1729}#
+                           #t))
+                       (lambda (#{ftype\ 1735}#
+                                #{fval\ 1736}#
+                                #{fe\ 1737}#
+                                #{fw\ 1738}#
+                                #{fs\ 1739}#
+                                #{fmod\ 1740}#)
+                         (if (memv #{ftype\ 1735}# (quote (lexical)))
+                           (values
+                             'lexical-call
+                             #{fval\ 1736}#
+                             #{e\ 1724}#
+                             #{w\ 1726}#
+                             #{s\ 1727}#
+                             #{mod\ 1729}#)
+                           (if (memv #{ftype\ 1735}# (quote (global)))
+                             (values
+                               'global-call
+                               (#{make-syntax-object\ 1280}#
+                                 #{fval\ 1736}#
+                                 #{w\ 1726}#
+                                 #{fmod\ 1740}#)
+                               #{e\ 1724}#
+                               #{w\ 1726}#
+                               #{s\ 1727}#
+                               #{mod\ 1729}#)
+                             (if (memv #{ftype\ 1735}# (quote (macro)))
+                               (#{syntax-type\ 1331}#
+                                 (#{chi-macro\ 1336}#
+                                   #{fval\ 1736}#
+                                   #{e\ 1724}#
+                                   #{r\ 1725}#
+                                   #{w\ 1726}#
+                                   #{rib\ 1728}#
+                                   #{mod\ 1729}#)
+                                 #{r\ 1725}#
+                                 '(())
+                                 #{s\ 1727}#
+                                 #{rib\ 1728}#
+                                 #{mod\ 1729}#
+                                 #{for-car?\ 1730}#)
+                               (if (memv #{ftype\ 1735}# (quote (module-ref)))
+                                 (call-with-values
+                                   (lambda () (#{fval\ 1736}# #{e\ 1724}#))
+                                   (lambda (#{sym\ 1741}# #{mod\ 1742}#)
+                                     (#{syntax-type\ 1331}#
+                                       #{sym\ 1741}#
+                                       #{r\ 1725}#
+                                       #{w\ 1726}#
+                                       #{s\ 1727}#
+                                       #{rib\ 1728}#
+                                       #{mod\ 1742}#
+                                       #{for-car?\ 1730}#)))
+                                 (if (memv #{ftype\ 1735}# (quote (core)))
+                                   (values
+                                     'core-form
+                                     #{fval\ 1736}#
+                                     #{e\ 1724}#
+                                     #{w\ 1726}#
+                                     #{s\ 1727}#
+                                     #{mod\ 1729}#)
+                                   (if (memv #{ftype\ 1735}#
+                                             '(local-syntax))
+                                     (values
+                                       'local-syntax-form
+                                       #{fval\ 1736}#
+                                       #{e\ 1724}#
+                                       #{w\ 1726}#
+                                       #{s\ 1727}#
+                                       #{mod\ 1729}#)
+                                     (if (memv #{ftype\ 1735}# (quote (begin)))
+                                       (values
+                                         'begin-form
+                                         #f
+                                         #{e\ 1724}#
+                                         #{w\ 1726}#
+                                         #{s\ 1727}#
+                                         #{mod\ 1729}#)
+                                       (if (memv #{ftype\ 1735}#
+                                                 '(eval-when))
+                                         (values
+                                           'eval-when-form
+                                           #f
+                                           #{e\ 1724}#
+                                           #{w\ 1726}#
+                                           #{s\ 1727}#
+                                           #{mod\ 1729}#)
+                                         (if (memv #{ftype\ 1735}#
+                                                   '(define))
+                                           ((lambda (#{tmp\ 1743}#)
+                                              ((lambda (#{tmp\ 1744}#)
+                                                 (if (if #{tmp\ 1744}#
+                                                       (apply (lambda (#{_\ 1745}#
+                                                                       #{name\ 1746}#
+                                                                       #{val\ 1747}#)
+                                                                (#{id?\ 1297}#
+                                                                  #{name\ 1746}#))
+                                                              #{tmp\ 1744}#)
+                                                       #f)
+                                                   (apply (lambda (#{_\ 1748}#
+                                                                   #{name\ 1749}#
+                                                                   #{val\ 1750}#)
+                                                            (values
+                                                              'define-form
+                                                              #{name\ 1749}#
+                                                              #{val\ 1750}#
+                                                              #{w\ 1726}#
+                                                              #{s\ 1727}#
+                                                              #{mod\ 1729}#))
+                                                          #{tmp\ 1744}#)
+                                                   ((lambda (#{tmp\ 1751}#)
+                                                      (if (if #{tmp\ 1751}#
+                                                            (apply (lambda (#{_\ 1752}#
+                                                                            #{name\ 1753}#
+                                                                            #{args\ 1754}#
+                                                                            #{e1\ 1755}#
+                                                                            #{e2\ 1756}#)
+                                                                     (if (#{id?\ 1297}#
+                                                                           #{name\ 1753}#)
+                                                                       (#{valid-bound-ids?\ 1322}#
+                                                                         (#{lambda-var-list\ 1345}#
+                                                                           #{args\ 1754}#))
+                                                                       #f))
+                                                                   #{tmp\ 1751}#)
+                                                            #f)
+                                                        (apply (lambda (#{_\ 1757}#
+                                                                        #{name\ 1758}#
+                                                                        #{args\ 1759}#
+                                                                        #{e1\ 1760}#
+                                                                        #{e2\ 1761}#)
+                                                                 (values
+                                                                   'define-form
+                                                                   (#{wrap\ 1325}#
+                                                                     #{name\ 1758}#
+                                                                     #{w\ 1726}#
+                                                                     #{mod\ 1729}#)
+                                                                   (#{decorate-source\ 1262}#
+                                                                     (cons '#(syntax-object
+                                                                              lambda
+                                                                              ((top)
+                                                                               #(ribcage
+                                                                                 #(_
+                                                                                   name
+                                                                                   args
+                                                                                   e1
+                                                                                   e2)
+                                                                                 #((top)
+                                                                                   (top)
+                                                                                   (top)
+                                                                                   (top)
+                                                                                   (top))
+                                                                                 #("i"
+                                                                                   "i"
+                                                                                   "i"
+                                                                                   "i"
+                                                                                   "i"))
+                                                                               #(ribcage
+                                                                                 ()
+                                                                                 ()
+                                                                                 ())
+                                                                               #(ribcage
+                                                                                 ()
+                                                                                 ()
+                                                                                 ())
+                                                                               #(ribcage
+                                                                                 #(ftype
+                                                                                   fval
+                                                                                   fe
+                                                                                   fw
+                                                                                   fs
+                                                                                   fmod)
+                                                                                 #((top)
+                                                                                   (top)
+                                                                                   (top)
+                                                                                   (top)
+                                                                                   (top)
+                                                                                   (top))
+                                                                                 #("i"
+                                                                                   "i"
+                                                                                   "i"
+                                                                                   "i"
+                                                                                   "i"
+                                                                                   "i"))
+                                                                               #(ribcage
+                                                                                 ()
+                                                                                 ()
+                                                                                 ())
+                                                                               #(ribcage
+                                                                                 #(first)
+                                                                                 #((top))
+                                                                                 #("i"))
+                                                                               #(ribcage
+                                                                                 ()
+                                                                                 ()
+                                                                                 ())
+                                                                               #(ribcage
+                                                                                 ()
+                                                                                 ()
+                                                                                 ())
+                                                                               #(ribcage
+                                                                                 ()
+                                                                                 ()
+                                                                                 ())
+                                                                               #(ribcage
+                                                                                 #(e
+                                                                                   r
+                                                                                   w
+                                                                                   s
+                                                                                   rib
+                                                                                   mod
+                                                                                   for-car?)
+                                                                                 #((top)
+                                                                                   (top)
+                                                                                   (top)
+                                                                                   (top)
+                                                                                   (top)
+                                                                                   (top)
+                                                                                   (top))
+                                                                                 #("i"
+                                                                                   "i"
+                                                                                   "i"
+                                                                                   "i"
+                                                                                   "i"
+                                                                                   "i"
+                                                                                   "i"))
+                                                                               #(ribcage
+                                                                                 (lambda-var-list
+                                                                                   gen-var
+                                                                                   strip
+                                                                                   ellipsis?
+                                                                                   chi-void
+                                                                                   eval-local-transformer
+                                                                                   chi-local-syntax
+                                                                                   chi-lambda-clause
+                                                                                   chi-body
+                                                                                   chi-macro
+                                                                                   chi-application
+                                                                                   chi-expr
+                                                                                   chi
+                                                                                   chi-top
+                                                                                   syntax-type
+                                                                                   chi-when-list
+                                                                                   chi-install-global
+                                                                                   chi-top-sequence
+                                                                                   chi-sequence
+                                                                                   source-wrap
+                                                                                   wrap
+                                                                                   bound-id-member?
+                                                                                   distinct-bound-ids?
+                                                                                   valid-bound-ids?
+                                                                                   bound-id=?
+                                                                                   free-id=?
+                                                                                   id-var-name
+                                                                                   same-marks?
+                                                                                   join-marks
+                                                                                   join-wraps
+                                                                                   smart-append
+                                                                                   make-binding-wrap
+                                                                                   extend-ribcage!
+                                                                                   make-empty-ribcage
+                                                                                   new-mark
+                                                                                   anti-mark
+                                                                                   the-anti-mark
+                                                                                   top-marked?
+                                                                                   top-wrap
+                                                                                   empty-wrap
+                                                                                   set-ribcage-labels!
+                                                                                   set-ribcage-marks!
+                                                                                   set-ribcage-symnames!
+                                                                                   ribcage-labels
+                                                                                   ribcage-marks
+                                                                                   ribcage-symnames
+                                                                                   ribcage?
+                                                                                   make-ribcage
+                                                                                   gen-labels
+                                                                                   gen-label
+                                                                                   make-rename
+                                                                                   rename-marks
+                                                                                   rename-new
+                                                                                   rename-old
+                                                                                   subst-rename?
+                                                                                   wrap-subst
+                                                                                   wrap-marks
+                                                                                   make-wrap
+                                                                                   id-sym-name&marks
+                                                                                   id-sym-name
+                                                                                   id?
+                                                                                   nonsymbol-id?
+                                                                                   global-extend
+                                                                                   lookup
+                                                                                   macros-only-env
+                                                                                   extend-var-env
+                                                                                   extend-env
+                                                                                   null-env
+                                                                                   binding-value
+                                                                                   binding-type
+                                                                                   make-binding
+                                                                                   arg-check
+                                                                                   source-annotation
+                                                                                   no-source
+                                                                                   set-syntax-object-module!
+                                                                                   set-syntax-object-wrap!
+                                                                                   set-syntax-object-expression!
+                                                                                   syntax-object-module
+                                                                                   syntax-object-wrap
+                                                                                   syntax-object-expression
+                                                                                   syntax-object?
+                                                                                   make-syntax-object
+                                                                                   build-lexical-var
+                                                                                   build-letrec
+                                                                                   build-named-let
+                                                                                   build-let
+                                                                                   build-sequence
+                                                                                   build-data
+                                                                                   build-primref
+                                                                                   build-lambda
+                                                                                   build-global-definition
+                                                                                   maybe-name-value!
+                                                                                   build-global-assignment
+                                                                                   build-global-reference
+                                                                                   analyze-variable
+                                                                                   build-lexical-assignment
+                                                                                   build-lexical-reference
+                                                                                   build-conditional
+                                                                                   build-application
+                                                                                   build-void
+                                                                                   decorate-source
+                                                                                   get-global-definition-hook
+                                                                                   put-global-definition-hook
+                                                                                   gensym-hook
+                                                                                   local-eval-hook
+                                                                                   top-level-eval-hook
+                                                                                   fx<
+                                                                                   fx=
+                                                                                   fx-
+                                                                                   fx+
+                                                                                   *mode*
+                                                                                   noexpand)
+                                                                                 ((top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top))
+                                                                                 ("i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"))
+                                                                               #(ribcage
+                                                                                 (define-structure
+                                                                                   and-map*)
+                                                                                 ((top)
+                                                                                  (top))
+                                                                                 ("i"
+                                                                                  "i")))
+                                                                              (hygiene
+                                                                                guile))
+                                                                           (#{wrap\ 1325}#
+                                                                             (cons #{args\ 1759}#
+                                                                                   (cons #{e1\ 1760}#
+                                                                                         #{e2\ 1761}#))
+                                                                             #{w\ 1726}#
+                                                                             #{mod\ 1729}#))
+                                                                     #{s\ 1727}#)
+                                                                   '(())
+                                                                   #{s\ 1727}#
+                                                                   #{mod\ 1729}#))
+                                                               #{tmp\ 1751}#)
+                                                        ((lambda (#{tmp\ 1763}#)
+                                                           (if (if #{tmp\ 1763}#
+                                                                 (apply (lambda (#{_\ 1764}#
+                                                                                 #{name\ 1765}#)
+                                                                          (#{id?\ 1297}#
+                                                                            #{name\ 1765}#))
+                                                                        #{tmp\ 1763}#)
+                                                                 #f)
+                                                             (apply (lambda (#{_\ 1766}#
+                                                                             #{name\ 1767}#)
+                                                                      (values
+                                                                        'define-form
+                                                                        (#{wrap\ 1325}#
+                                                                          #{name\ 1767}#
+                                                                          #{w\ 1726}#
+                                                                          #{mod\ 1729}#)
+                                                                        '(#(syntax-object
+                                                                            if
+                                                                            ((top)
+                                                                             #(ribcage
+                                                                               #(_
+                                                                                 name)
+                                                                               #((top)
+                                                                                 (top))
+                                                                               #("i"
+                                                                                 "i"))
+                                                                             #(ribcage
+                                                                               ()
+                                                                               ()
+                                                                               ())
+                                                                             #(ribcage
+                                                                               ()
+                                                                               ()
+                                                                               ())
+                                                                             #(ribcage
+                                                                               #(ftype
+                                                                                 fval
+                                                                                 fe
+                                                                                 fw
+                                                                                 fs
+                                                                                 fmod)
+                                                                               #((top)
+                                                                                 (top)
+                                                                                 (top)
+                                                                                 (top)
+                                                                                 (top)
+                                                                                 (top))
+                                                                               #("i"
+                                                                                 "i"
+                                                                                 "i"
+                                                                                 "i"
+                                                                                 "i"
+                                                                                 "i"))
+                                                                             #(ribcage
+                                                                               ()
+                                                                               ()
+                                                                               ())
+                                                                             #(ribcage
+                                                                               #(first)
+                                                                               #((top))
+                                                                               #("i"))
+                                                                             #(ribcage
+                                                                               ()
+                                                                               ()
+                                                                               ())
+                                                                             #(ribcage
+                                                                               ()
+                                                                               ()
+                                                                               ())
+                                                                             #(ribcage
+                                                                               ()
+                                                                               ()
+                                                                               ())
+                                                                             #(ribcage
+                                                                               #(e
+                                                                                 r
+                                                                                 w
+                                                                                 s
+                                                                                 rib
+                                                                                 mod
+                                                                                 for-car?)
+                                                                               #((top)
+                                                                                 (top)
+                                                                                 (top)
+                                                                                 (top)
+                                                                                 (top)
+                                                                                 (top)
+                                                                                 (top))
+                                                                               #("i"
+                                                                                 "i"
+                                                                                 "i"
+                                                                                 "i"
+                                                                                 "i"
+                                                                                 "i"
+                                                                                 "i"))
+                                                                             #(ribcage
+                                                                               (lambda-var-list
+                                                                                 gen-var
+                                                                                 strip
+                                                                                 ellipsis?
+                                                                                 chi-void
+                                                                                 eval-local-transformer
+                                                                                 chi-local-syntax
+                                                                                 chi-lambda-clause
+                                                                                 chi-body
+                                                                                 chi-macro
+                                                                                 chi-application
+                                                                                 chi-expr
+                                                                                 chi
+                                                                                 chi-top
+                                                                                 syntax-type
+                                                                                 chi-when-list
+                                                                                 chi-install-global
+                                                                                 chi-top-sequence
+                                                                                 chi-sequence
+                                                                                 source-wrap
+                                                                                 wrap
+                                                                                 bound-id-member?
+                                                                                 distinct-bound-ids?
+                                                                                 valid-bound-ids?
+                                                                                 bound-id=?
+                                                                                 free-id=?
+                                                                                 id-var-name
+                                                                                 same-marks?
+                                                                                 join-marks
+                                                                                 join-wraps
+                                                                                 smart-append
+                                                                                 make-binding-wrap
+                                                                                 extend-ribcage!
+                                                                                 make-empty-ribcage
+                                                                                 new-mark
+                                                                                 anti-mark
+                                                                                 the-anti-mark
+                                                                                 top-marked?
+                                                                                 top-wrap
+                                                                                 empty-wrap
+                                                                                 set-ribcage-labels!
+                                                                                 set-ribcage-marks!
+                                                                                 set-ribcage-symnames!
+                                                                                 ribcage-labels
+                                                                                 ribcage-marks
+                                                                                 ribcage-symnames
+                                                                                 ribcage?
+                                                                                 make-ribcage
+                                                                                 gen-labels
+                                                                                 gen-label
+                                                                                 make-rename
+                                                                                 rename-marks
+                                                                                 rename-new
+                                                                                 rename-old
+                                                                                 subst-rename?
+                                                                                 wrap-subst
+                                                                                 wrap-marks
+                                                                                 make-wrap
+                                                                                 id-sym-name&marks
+                                                                                 id-sym-name
+                                                                                 id?
+                                                                                 nonsymbol-id?
+                                                                                 global-extend
+                                                                                 lookup
+                                                                                 macros-only-env
+                                                                                 extend-var-env
+                                                                                 extend-env
+                                                                                 null-env
+                                                                                 binding-value
+                                                                                 binding-type
+                                                                                 make-binding
+                                                                                 arg-check
+                                                                                 source-annotation
+                                                                                 no-source
+                                                                                 set-syntax-object-module!
+                                                                                 set-syntax-object-wrap!
+                                                                                 set-syntax-object-expression!
+                                                                                 syntax-object-module
+                                                                                 syntax-object-wrap
+                                                                                 syntax-object-expression
+                                                                                 syntax-object?
+                                                                                 make-syntax-object
+                                                                                 build-lexical-var
+                                                                                 build-letrec
+                                                                                 build-named-let
+                                                                                 build-let
+                                                                                 build-sequence
+                                                                                 build-data
+                                                                                 build-primref
+                                                                                 build-lambda
+                                                                                 build-global-definition
+                                                                                 maybe-name-value!
+                                                                                 build-global-assignment
+                                                                                 build-global-reference
+                                                                                 analyze-variable
+                                                                                 build-lexical-assignment
+                                                                                 build-lexical-reference
+                                                                                 build-conditional
+                                                                                 build-application
+                                                                                 build-void
+                                                                                 decorate-source
+                                                                                 get-global-definition-hook
+                                                                                 put-global-definition-hook
+                                                                                 gensym-hook
+                                                                                 local-eval-hook
+                                                                                 top-level-eval-hook
+                                                                                 fx<
+                                                                                 fx=
+                                                                                 fx-
+                                                                                 fx+
+                                                                                 *mode*
+                                                                                 noexpand)
+                                                                               ((top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top))
+                                                                               ("i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"))
+                                                                             #(ribcage
+                                                                               (define-structure
+                                                                                 and-map*)
+                                                                               ((top)
+                                                                                (top))
+                                                                               ("i"
+                                                                                "i")))
+                                                                            (hygiene
+                                                                              guile))
+                                                                          #(syntax-object
+                                                                            #f
+                                                                            ((top)
+                                                                             #(ribcage
+                                                                               #(_
+                                                                                 name)
+                                                                               #((top)
+                                                                                 (top))
+                                                                               #("i"
+                                                                                 "i"))
+                                                                             #(ribcage
+                                                                               ()
+                                                                               ()
+                                                                               ())
+                                                                             #(ribcage
+                                                                               ()
+                                                                               ()
+                                                                               ())
+                                                                             #(ribcage
+                                                                               #(ftype
+                                                                                 fval
+                                                                                 fe
+                                                                                 fw
+                                                                                 fs
+                                                                                 fmod)
+                                                                               #((top)
+                                                                                 (top)
+                                                                                 (top)
+                                                                                 (top)
+                                                                                 (top)
+                                                                                 (top))
+                                                                               #("i"
+                                                                                 "i"
+                                                                                 "i"
+                                                                                 "i"
+                                                                                 "i"
+                                                                                 "i"))
+                                                                             #(ribcage
+                                                                               ()
+                                                                               ()
+                                                                               ())
+                                                                             #(ribcage
+                                                                               #(first)
+                                                                               #((top))
+                                                                               #("i"))
+                                                                             #(ribcage
+                                                                               ()
+                                                                               ()
+                                                                               ())
+                                                                             #(ribcage
+                                                                               ()
+                                                                               ()
+                                                                               ())
+                                                                             #(ribcage
+                                                                               ()
+                                                                               ()
+                                                                               ())
+                                                                             #(ribcage
+                                                                               #(e
+                                                                                 r
+                                                                                 w
+                                                                                 s
+                                                                                 rib
+                                                                                 mod
+                                                                                 for-car?)
+                                                                               #((top)
+                                                                                 (top)
+                                                                                 (top)
+                                                                                 (top)
+                                                                                 (top)
+                                                                                 (top)
+                                                                                 (top))
+                                                                               #("i"
+                                                                                 "i"
+                                                                                 "i"
+                                                                                 "i"
+                                                                                 "i"
+                                                                                 "i"
+                                                                                 "i"))
+                                                                             #(ribcage
+                                                                               (lambda-var-list
+                                                                                 gen-var
+                                                                                 strip
+                                                                                 ellipsis?
+                                                                                 chi-void
+                                                                                 eval-local-transformer
+                                                                                 chi-local-syntax
+                                                                                 chi-lambda-clause
+                                                                                 chi-body
+                                                                                 chi-macro
+                                                                                 chi-application
+                                                                                 chi-expr
+                                                                                 chi
+                                                                                 chi-top
+                                                                                 syntax-type
+                                                                                 chi-when-list
+                                                                                 chi-install-global
+                                                                                 chi-top-sequence
+                                                                                 chi-sequence
+                                                                                 source-wrap
+                                                                                 wrap
+                                                                                 bound-id-member?
+                                                                                 distinct-bound-ids?
+                                                                                 valid-bound-ids?
+                                                                                 bound-id=?
+                                                                                 free-id=?
+                                                                                 id-var-name
+                                                                                 same-marks?
+                                                                                 join-marks
+                                                                                 join-wraps
+                                                                                 smart-append
+                                                                                 make-binding-wrap
+                                                                                 extend-ribcage!
+                                                                                 make-empty-ribcage
+                                                                                 new-mark
+                                                                                 anti-mark
+                                                                                 the-anti-mark
+                                                                                 top-marked?
+                                                                                 top-wrap
+                                                                                 empty-wrap
+                                                                                 set-ribcage-labels!
+                                                                                 set-ribcage-marks!
+                                                                                 set-ribcage-symnames!
+                                                                                 ribcage-labels
+                                                                                 ribcage-marks
+                                                                                 ribcage-symnames
+                                                                                 ribcage?
+                                                                                 make-ribcage
+                                                                                 gen-labels
+                                                                                 gen-label
+                                                                                 make-rename
+                                                                                 rename-marks
+                                                                                 rename-new
+                                                                                 rename-old
+                                                                                 subst-rename?
+                                                                                 wrap-subst
+                                                                                 wrap-marks
+                                                                                 make-wrap
+                                                                                 id-sym-name&marks
+                                                                                 id-sym-name
+                                                                                 id?
+                                                                                 nonsymbol-id?
+                                                                                 global-extend
+                                                                                 lookup
+                                                                                 macros-only-env
+                                                                                 extend-var-env
+                                                                                 extend-env
+                                                                                 null-env
+                                                                                 binding-value
+                                                                                 binding-type
+                                                                                 make-binding
+                                                                                 arg-check
+                                                                                 source-annotation
+                                                                                 no-source
+                                                                                 set-syntax-object-module!
+                                                                                 set-syntax-object-wrap!
+                                                                                 set-syntax-object-expression!
+                                                                                 syntax-object-module
+                                                                                 syntax-object-wrap
+                                                                                 syntax-object-expression
+                                                                                 syntax-object?
+                                                                                 make-syntax-object
+                                                                                 build-lexical-var
+                                                                                 build-letrec
+                                                                                 build-named-let
+                                                                                 build-let
+                                                                                 build-sequence
+                                                                                 build-data
+                                                                                 build-primref
+                                                                                 build-lambda
+                                                                                 build-global-definition
+                                                                                 maybe-name-value!
+                                                                                 build-global-assignment
+                                                                                 build-global-reference
+                                                                                 analyze-variable
+                                                                                 build-lexical-assignment
+                                                                                 build-lexical-reference
+                                                                                 build-conditional
+                                                                                 build-application
+                                                                                 build-void
+                                                                                 decorate-source
+                                                                                 get-global-definition-hook
+                                                                                 put-global-definition-hook
+                                                                                 gensym-hook
+                                                                                 local-eval-hook
+                                                                                 top-level-eval-hook
+                                                                                 fx<
+                                                                                 fx=
+                                                                                 fx-
+                                                                                 fx+
+                                                                                 *mode*
+                                                                                 noexpand)
+                                                                               ((top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top))
+                                                                               ("i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"))
+                                                                             #(ribcage
+                                                                               (define-structure
+                                                                                 and-map*)
+                                                                               ((top)
+                                                                                (top))
+                                                                               ("i"
+                                                                                "i")))
+                                                                            (hygiene
+                                                                              guile))
+                                                                          #(syntax-object
+                                                                            #f
+                                                                            ((top)
+                                                                             #(ribcage
+                                                                               #(_
+                                                                                 name)
+                                                                               #((top)
+                                                                                 (top))
+                                                                               #("i"
+                                                                                 "i"))
+                                                                             #(ribcage
+                                                                               ()
+                                                                               ()
+                                                                               ())
+                                                                             #(ribcage
+                                                                               ()
+                                                                               ()
+                                                                               ())
+                                                                             #(ribcage
+                                                                               #(ftype
+                                                                                 fval
+                                                                                 fe
+                                                                                 fw
+                                                                                 fs
+                                                                                 fmod)
+                                                                               #((top)
+                                                                                 (top)
+                                                                                 (top)
+                                                                                 (top)
+                                                                                 (top)
+                                                                                 (top))
+                                                                               #("i"
+                                                                                 "i"
+                                                                                 "i"
+                                                                                 "i"
+                                                                                 "i"
+                                                                                 "i"))
+                                                                             #(ribcage
+                                                                               ()
+                                                                               ()
+                                                                               ())
+                                                                             #(ribcage
+                                                                               #(first)
+                                                                               #((top))
+                                                                               #("i"))
+                                                                             #(ribcage
+                                                                               ()
+                                                                               ()
+                                                                               ())
+                                                                             #(ribcage
+                                                                               ()
+                                                                               ()
+                                                                               ())
+                                                                             #(ribcage
+                                                                               ()
+                                                                               ()
+                                                                               ())
+                                                                             #(ribcage
+                                                                               #(e
+                                                                                 r
+                                                                                 w
+                                                                                 s
+                                                                                 rib
+                                                                                 mod
+                                                                                 for-car?)
+                                                                               #((top)
+                                                                                 (top)
+                                                                                 (top)
+                                                                                 (top)
+                                                                                 (top)
+                                                                                 (top)
+                                                                                 (top))
+                                                                               #("i"
+                                                                                 "i"
+                                                                                 "i"
+                                                                                 "i"
+                                                                                 "i"
+                                                                                 "i"
+                                                                                 "i"))
+                                                                             #(ribcage
+                                                                               (lambda-var-list
+                                                                                 gen-var
+                                                                                 strip
+                                                                                 ellipsis?
+                                                                                 chi-void
+                                                                                 eval-local-transformer
+                                                                                 chi-local-syntax
+                                                                                 chi-lambda-clause
+                                                                                 chi-body
+                                                                                 chi-macro
+                                                                                 chi-application
+                                                                                 chi-expr
+                                                                                 chi
+                                                                                 chi-top
+                                                                                 syntax-type
+                                                                                 chi-when-list
+                                                                                 chi-install-global
+                                                                                 chi-top-sequence
+                                                                                 chi-sequence
+                                                                                 source-wrap
+                                                                                 wrap
+                                                                                 bound-id-member?
+                                                                                 distinct-bound-ids?
+                                                                                 valid-bound-ids?
+                                                                                 bound-id=?
+                                                                                 free-id=?
+                                                                                 id-var-name
+                                                                                 same-marks?
+                                                                                 join-marks
+                                                                                 join-wraps
+                                                                                 smart-append
+                                                                                 make-binding-wrap
+                                                                                 extend-ribcage!
+                                                                                 make-empty-ribcage
+                                                                                 new-mark
+                                                                                 anti-mark
+                                                                                 the-anti-mark
+                                                                                 top-marked?
+                                                                                 top-wrap
+                                                                                 empty-wrap
+                                                                                 set-ribcage-labels!
+                                                                                 set-ribcage-marks!
+                                                                                 set-ribcage-symnames!
+                                                                                 ribcage-labels
+                                                                                 ribcage-marks
+                                                                                 ribcage-symnames
+                                                                                 ribcage?
+                                                                                 make-ribcage
+                                                                                 gen-labels
+                                                                                 gen-label
+                                                                                 make-rename
+                                                                                 rename-marks
+                                                                                 rename-new
+                                                                                 rename-old
+                                                                                 subst-rename?
+                                                                                 wrap-subst
+                                                                                 wrap-marks
+                                                                                 make-wrap
+                                                                                 id-sym-name&marks
+                                                                                 id-sym-name
+                                                                                 id?
+                                                                                 nonsymbol-id?
+                                                                                 global-extend
+                                                                                 lookup
+                                                                                 macros-only-env
+                                                                                 extend-var-env
+                                                                                 extend-env
+                                                                                 null-env
+                                                                                 binding-value
+                                                                                 binding-type
+                                                                                 make-binding
+                                                                                 arg-check
+                                                                                 source-annotation
+                                                                                 no-source
+                                                                                 set-syntax-object-module!
+                                                                                 set-syntax-object-wrap!
+                                                                                 set-syntax-object-expression!
+                                                                                 syntax-object-module
+                                                                                 syntax-object-wrap
+                                                                                 syntax-object-expression
+                                                                                 syntax-object?
+                                                                                 make-syntax-object
+                                                                                 build-lexical-var
+                                                                                 build-letrec
+                                                                                 build-named-let
+                                                                                 build-let
+                                                                                 build-sequence
+                                                                                 build-data
+                                                                                 build-primref
+                                                                                 build-lambda
+                                                                                 build-global-definition
+                                                                                 maybe-name-value!
+                                                                                 build-global-assignment
+                                                                                 build-global-reference
+                                                                                 analyze-variable
+                                                                                 build-lexical-assignment
+                                                                                 build-lexical-reference
+                                                                                 build-conditional
+                                                                                 build-application
+                                                                                 build-void
+                                                                                 decorate-source
+                                                                                 get-global-definition-hook
+                                                                                 put-global-definition-hook
+                                                                                 gensym-hook
+                                                                                 local-eval-hook
+                                                                                 top-level-eval-hook
+                                                                                 fx<
+                                                                                 fx=
+                                                                                 fx-
+                                                                                 fx+
+                                                                                 *mode*
+                                                                                 noexpand)
+                                                                               ((top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top)
+                                                                                (top))
+                                                                               ("i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"
+                                                                                "i"))
+                                                                             #(ribcage
+                                                                               (define-structure
+                                                                                 and-map*)
+                                                                               ((top)
+                                                                                (top))
+                                                                               ("i"
+                                                                                "i")))
+                                                                            (hygiene
+                                                                              guile)))
+                                                                        '(())
+                                                                        #{s\ 1727}#
+                                                                        #{mod\ 1729}#))
+                                                                    #{tmp\ 1763}#)
+                                                             (syntax-violation
+                                                               #f
+                                                               "source expression failed to match any pattern"
+                                                               #{tmp\ 1743}#)))
+                                                         ($sc-dispatch
+                                                           #{tmp\ 1743}#
+                                                           '(any any)))))
+                                                    ($sc-dispatch
+                                                      #{tmp\ 1743}#
+                                                      '(any (any . any)
+                                                            any
+                                                            .
+                                                            each-any)))))
+                                               ($sc-dispatch
+                                                 #{tmp\ 1743}#
+                                                 '(any any any))))
+                                            #{e\ 1724}#)
+                                           (if (memv #{ftype\ 1735}#
+                                                     '(define-syntax))
+                                             ((lambda (#{tmp\ 1768}#)
+                                                ((lambda (#{tmp\ 1769}#)
+                                                   (if (if #{tmp\ 1769}#
+                                                         (apply (lambda (#{_\ 1770}#
+                                                                         #{name\ 1771}#
+                                                                         #{val\ 1772}#)
+                                                                  (#{id?\ 1297}#
+                                                                    #{name\ 1771}#))
+                                                                #{tmp\ 1769}#)
+                                                         #f)
+                                                     (apply (lambda (#{_\ 1773}#
+                                                                     #{name\ 1774}#
+                                                                     #{val\ 1775}#)
+                                                              (values
+                                                                'define-syntax-form
+                                                                #{name\ 1774}#
+                                                                #{val\ 1775}#
+                                                                #{w\ 1726}#
+                                                                #{s\ 1727}#
+                                                                #{mod\ 1729}#))
+                                                            #{tmp\ 1769}#)
+                                                     (syntax-violation
+                                                       #f
+                                                       "source expression failed to match any pattern"
+                                                       #{tmp\ 1768}#)))
+                                                 ($sc-dispatch
+                                                   #{tmp\ 1768}#
+                                                   '(any any any))))
+                                              #{e\ 1724}#)
+                                             (values
+                                               'call
+                                               #f
+                                               #{e\ 1724}#
+                                               #{w\ 1726}#
+                                               #{s\ 1727}#
+                                               #{mod\ 1729}#))))))))))))))
+                   (if (#{syntax-object?\ 1281}# #{e\ 1724}#)
+                     (#{syntax-type\ 1331}#
+                       (#{syntax-object-expression\ 1282}# #{e\ 1724}#)
+                       #{r\ 1725}#
+                       (#{join-wraps\ 1316}#
+                         #{w\ 1726}#
+                         (#{syntax-object-wrap\ 1283}# #{e\ 1724}#))
+                       #{s\ 1727}#
+                       #{rib\ 1728}#
+                       (let ((#{t\ 1776}#
+                               (#{syntax-object-module\ 1284}# #{e\ 1724}#)))
+                         (if #{t\ 1776}# #{t\ 1776}# #{mod\ 1729}#))
+                       #{for-car?\ 1730}#)
+                     (if (self-evaluating? #{e\ 1724}#)
+                       (values
+                         'constant
+                         #f
+                         #{e\ 1724}#
+                         #{w\ 1726}#
+                         #{s\ 1727}#
+                         #{mod\ 1729}#)
+                       (values
+                         'other
+                         #f
+                         #{e\ 1724}#
+                         #{w\ 1726}#
+                         #{s\ 1727}#
+                         #{mod\ 1729}#)))))))
+           (#{chi-when-list\ 1330}#
+             (lambda (#{e\ 1777}# #{when-list\ 1778}# #{w\ 1779}#)
+               (letrec ((#{f\ 1780}#
+                          (lambda (#{when-list\ 1781}# #{situations\ 1782}#)
+                            (if (null? #{when-list\ 1781}#)
+                              #{situations\ 1782}#
+                              (#{f\ 1780}#
+                                (cdr #{when-list\ 1781}#)
+                                (cons (let ((#{x\ 1783}#
+                                              (car #{when-list\ 1781}#)))
+                                        (if (#{free-id=?\ 1320}#
+                                              #{x\ 1783}#
+                                              '#(syntax-object
+                                                 compile
+                                                 ((top)
+                                                  #(ribcage () () ())
+                                                  #(ribcage () () ())
+                                                  #(ribcage () () ())
+                                                  #(ribcage
+                                                    #(x)
+                                                    #((top))
+                                                    #("i"))
+                                                  #(ribcage () () ())
+                                                  #(ribcage
+                                                    #(f when-list situations)
+                                                    #((top) (top) (top))
+                                                    #("i" "i" "i"))
+                                                  #(ribcage () () ())
+                                                  #(ribcage
+                                                    #(e when-list w)
+                                                    #((top) (top) (top))
+                                                    #("i" "i" "i"))
+                                                  #(ribcage
+                                                    (lambda-var-list
+                                                      gen-var
+                                                      strip
+                                                      ellipsis?
+                                                      chi-void
+                                                      eval-local-transformer
+                                                      chi-local-syntax
+                                                      chi-lambda-clause
+                                                      chi-body
+                                                      chi-macro
+                                                      chi-application
+                                                      chi-expr
+                                                      chi
+                                                      chi-top
+                                                      syntax-type
+                                                      chi-when-list
+                                                      chi-install-global
+                                                      chi-top-sequence
+                                                      chi-sequence
+                                                      source-wrap
+                                                      wrap
+                                                      bound-id-member?
+                                                      distinct-bound-ids?
+                                                      valid-bound-ids?
+                                                      bound-id=?
+                                                      free-id=?
+                                                      id-var-name
+                                                      same-marks?
+                                                      join-marks
+                                                      join-wraps
+                                                      smart-append
+                                                      make-binding-wrap
+                                                      extend-ribcage!
+                                                      make-empty-ribcage
+                                                      new-mark
+                                                      anti-mark
+                                                      the-anti-mark
+                                                      top-marked?
+                                                      top-wrap
+                                                      empty-wrap
+                                                      set-ribcage-labels!
+                                                      set-ribcage-marks!
+                                                      set-ribcage-symnames!
+                                                      ribcage-labels
+                                                      ribcage-marks
+                                                      ribcage-symnames
+                                                      ribcage?
+                                                      make-ribcage
+                                                      gen-labels
+                                                      gen-label
+                                                      make-rename
+                                                      rename-marks
+                                                      rename-new
+                                                      rename-old
+                                                      subst-rename?
+                                                      wrap-subst
+                                                      wrap-marks
+                                                      make-wrap
+                                                      id-sym-name&marks
+                                                      id-sym-name
+                                                      id?
+                                                      nonsymbol-id?
+                                                      global-extend
+                                                      lookup
+                                                      macros-only-env
+                                                      extend-var-env
+                                                      extend-env
+                                                      null-env
+                                                      binding-value
+                                                      binding-type
+                                                      make-binding
+                                                      arg-check
+                                                      source-annotation
+                                                      no-source
+                                                      set-syntax-object-module!
+                                                      set-syntax-object-wrap!
+                                                      set-syntax-object-expression!
+                                                      syntax-object-module
+                                                      syntax-object-wrap
+                                                      syntax-object-expression
+                                                      syntax-object?
+                                                      make-syntax-object
+                                                      build-lexical-var
+                                                      build-letrec
+                                                      build-named-let
+                                                      build-let
+                                                      build-sequence
+                                                      build-data
+                                                      build-primref
+                                                      build-lambda
+                                                      build-global-definition
+                                                      maybe-name-value!
+                                                      build-global-assignment
+                                                      build-global-reference
+                                                      analyze-variable
+                                                      build-lexical-assignment
+                                                      build-lexical-reference
+                                                      build-conditional
+                                                      build-application
+                                                      build-void
+                                                      decorate-source
+                                                      get-global-definition-hook
+                                                      put-global-definition-hook
+                                                      gensym-hook
+                                                      local-eval-hook
+                                                      top-level-eval-hook
+                                                      fx<
+                                                      fx=
+                                                      fx-
+                                                      fx+
+                                                      *mode*
+                                                      noexpand)
+                                                    ((top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top))
+                                                    ("i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"))
+                                                  #(ribcage
+                                                    (define-structure and-map*)
+                                                    ((top) (top))
+                                                    ("i" "i")))
+                                                 (hygiene guile)))
+                                          'compile
+                                          (if (#{free-id=?\ 1320}#
+                                                #{x\ 1783}#
+                                                '#(syntax-object
+                                                   load
+                                                   ((top)
+                                                    #(ribcage () () ())
+                                                    #(ribcage () () ())
+                                                    #(ribcage () () ())
+                                                    #(ribcage
+                                                      #(x)
+                                                      #((top))
+                                                      #("i"))
+                                                    #(ribcage () () ())
+                                                    #(ribcage
+                                                      #(f when-list situations)
+                                                      #((top) (top) (top))
+                                                      #("i" "i" "i"))
+                                                    #(ribcage () () ())
+                                                    #(ribcage
+                                                      #(e when-list w)
+                                                      #((top) (top) (top))
+                                                      #("i" "i" "i"))
+                                                    #(ribcage
+                                                      (lambda-var-list
+                                                        gen-var
+                                                        strip
+                                                        ellipsis?
+                                                        chi-void
+                                                        eval-local-transformer
+                                                        chi-local-syntax
+                                                        chi-lambda-clause
+                                                        chi-body
+                                                        chi-macro
+                                                        chi-application
+                                                        chi-expr
+                                                        chi
+                                                        chi-top
+                                                        syntax-type
+                                                        chi-when-list
+                                                        chi-install-global
+                                                        chi-top-sequence
+                                                        chi-sequence
+                                                        source-wrap
+                                                        wrap
+                                                        bound-id-member?
+                                                        distinct-bound-ids?
+                                                        valid-bound-ids?
+                                                        bound-id=?
+                                                        free-id=?
+                                                        id-var-name
+                                                        same-marks?
+                                                        join-marks
+                                                        join-wraps
+                                                        smart-append
+                                                        make-binding-wrap
+                                                        extend-ribcage!
+                                                        make-empty-ribcage
+                                                        new-mark
+                                                        anti-mark
+                                                        the-anti-mark
+                                                        top-marked?
+                                                        top-wrap
+                                                        empty-wrap
+                                                        set-ribcage-labels!
+                                                        set-ribcage-marks!
+                                                        set-ribcage-symnames!
+                                                        ribcage-labels
+                                                        ribcage-marks
+                                                        ribcage-symnames
+                                                        ribcage?
+                                                        make-ribcage
+                                                        gen-labels
+                                                        gen-label
+                                                        make-rename
+                                                        rename-marks
+                                                        rename-new
+                                                        rename-old
+                                                        subst-rename?
+                                                        wrap-subst
+                                                        wrap-marks
+                                                        make-wrap
+                                                        id-sym-name&marks
+                                                        id-sym-name
+                                                        id?
+                                                        nonsymbol-id?
+                                                        global-extend
+                                                        lookup
+                                                        macros-only-env
+                                                        extend-var-env
+                                                        extend-env
+                                                        null-env
+                                                        binding-value
+                                                        binding-type
+                                                        make-binding
+                                                        arg-check
+                                                        source-annotation
+                                                        no-source
+                                                        set-syntax-object-module!
+                                                        set-syntax-object-wrap!
+                                                        set-syntax-object-expression!
+                                                        syntax-object-module
+                                                        syntax-object-wrap
+                                                        syntax-object-expression
+                                                        syntax-object?
+                                                        make-syntax-object
+                                                        build-lexical-var
+                                                        build-letrec
+                                                        build-named-let
+                                                        build-let
+                                                        build-sequence
+                                                        build-data
+                                                        build-primref
+                                                        build-lambda
+                                                        build-global-definition
+                                                        maybe-name-value!
+                                                        build-global-assignment
+                                                        build-global-reference
+                                                        analyze-variable
+                                                        build-lexical-assignment
+                                                        build-lexical-reference
+                                                        build-conditional
+                                                        build-application
+                                                        build-void
+                                                        decorate-source
+                                                        get-global-definition-hook
+                                                        put-global-definition-hook
+                                                        gensym-hook
+                                                        local-eval-hook
+                                                        top-level-eval-hook
+                                                        fx<
+                                                        fx=
+                                                        fx-
+                                                        fx+
+                                                        *mode*
+                                                        noexpand)
+                                                      ((top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top))
+                                                      ("i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"))
+                                                    #(ribcage
+                                                      (define-structure
+                                                        and-map*)
+                                                      ((top) (top))
+                                                      ("i" "i")))
+                                                   (hygiene guile)))
+                                            'load
+                                            (if (#{free-id=?\ 1320}#
+                                                  #{x\ 1783}#
+                                                  '#(syntax-object
+                                                     eval
+                                                     ((top)
+                                                      #(ribcage () () ())
+                                                      #(ribcage () () ())
+                                                      #(ribcage () () ())
+                                                      #(ribcage
+                                                        #(x)
+                                                        #((top))
+                                                        #("i"))
+                                                      #(ribcage () () ())
+                                                      #(ribcage
+                                                        #(f
+                                                          when-list
+                                                          situations)
+                                                        #((top) (top) (top))
+                                                        #("i" "i" "i"))
+                                                      #(ribcage () () ())
+                                                      #(ribcage
+                                                        #(e when-list w)
+                                                        #((top) (top) (top))
+                                                        #("i" "i" "i"))
+                                                      #(ribcage
+                                                        (lambda-var-list
+                                                          gen-var
+                                                          strip
+                                                          ellipsis?
+                                                          chi-void
+                                                          eval-local-transformer
+                                                          chi-local-syntax
+                                                          chi-lambda-clause
+                                                          chi-body
+                                                          chi-macro
+                                                          chi-application
+                                                          chi-expr
+                                                          chi
+                                                          chi-top
+                                                          syntax-type
+                                                          chi-when-list
+                                                          chi-install-global
+                                                          chi-top-sequence
+                                                          chi-sequence
+                                                          source-wrap
+                                                          wrap
+                                                          bound-id-member?
+                                                          distinct-bound-ids?
+                                                          valid-bound-ids?
+                                                          bound-id=?
+                                                          free-id=?
+                                                          id-var-name
+                                                          same-marks?
+                                                          join-marks
+                                                          join-wraps
+                                                          smart-append
+                                                          make-binding-wrap
+                                                          extend-ribcage!
+                                                          make-empty-ribcage
+                                                          new-mark
+                                                          anti-mark
+                                                          the-anti-mark
+                                                          top-marked?
+                                                          top-wrap
+                                                          empty-wrap
+                                                          set-ribcage-labels!
+                                                          set-ribcage-marks!
+                                                          set-ribcage-symnames!
+                                                          ribcage-labels
+                                                          ribcage-marks
+                                                          ribcage-symnames
+                                                          ribcage?
+                                                          make-ribcage
+                                                          gen-labels
+                                                          gen-label
+                                                          make-rename
+                                                          rename-marks
+                                                          rename-new
+                                                          rename-old
+                                                          subst-rename?
+                                                          wrap-subst
+                                                          wrap-marks
+                                                          make-wrap
+                                                          id-sym-name&marks
+                                                          id-sym-name
+                                                          id?
+                                                          nonsymbol-id?
+                                                          global-extend
+                                                          lookup
+                                                          macros-only-env
+                                                          extend-var-env
+                                                          extend-env
+                                                          null-env
+                                                          binding-value
+                                                          binding-type
+                                                          make-binding
+                                                          arg-check
+                                                          source-annotation
+                                                          no-source
+                                                          set-syntax-object-module!
+                                                          set-syntax-object-wrap!
+                                                          set-syntax-object-expression!
+                                                          syntax-object-module
+                                                          syntax-object-wrap
+                                                          syntax-object-expression
+                                                          syntax-object?
+                                                          make-syntax-object
+                                                          build-lexical-var
+                                                          build-letrec
+                                                          build-named-let
+                                                          build-let
+                                                          build-sequence
+                                                          build-data
+                                                          build-primref
+                                                          build-lambda
+                                                          build-global-definition
+                                                          maybe-name-value!
+                                                          build-global-assignment
+                                                          build-global-reference
+                                                          analyze-variable
+                                                          build-lexical-assignment
+                                                          build-lexical-reference
+                                                          build-conditional
+                                                          build-application
+                                                          build-void
+                                                          decorate-source
+                                                          get-global-definition-hook
+                                                          put-global-definition-hook
+                                                          gensym-hook
+                                                          local-eval-hook
+                                                          top-level-eval-hook
+                                                          fx<
+                                                          fx=
+                                                          fx-
+                                                          fx+
+                                                          *mode*
+                                                          noexpand)
+                                                        ((top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top)
+                                                         (top))
+                                                        ("i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"))
+                                                      #(ribcage
+                                                        (define-structure
+                                                          and-map*)
+                                                        ((top) (top))
+                                                        ("i" "i")))
+                                                     (hygiene guile)))
+                                              'eval
+                                              (syntax-violation
+                                                'eval-when
+                                                "invalid situation"
+                                                #{e\ 1777}#
+                                                (#{wrap\ 1325}#
+                                                  #{x\ 1783}#
+                                                  #{w\ 1779}#
+                                                  #f))))))
+                                      #{situations\ 1782}#))))))
+                 (#{f\ 1780}# #{when-list\ 1778}# (quote ())))))
+           (#{chi-install-global\ 1329}#
+             (lambda (#{name\ 1784}# #{e\ 1785}#)
+               (#{build-global-definition\ 1272}#
+                 #f
+                 #{name\ 1784}#
+                 (if (let ((#{v\ 1786}#
+                             (module-variable
+                               (current-module)
+                               #{name\ 1784}#)))
+                       (if #{v\ 1786}#
+                         (if (variable-bound? #{v\ 1786}#)
+                           (if (macro? (variable-ref #{v\ 1786}#))
+                             (not (eq? (macro-type (variable-ref #{v\ 1786}#))
+                                       'syncase-macro))
+                             #f)
+                           #f)
+                         #f))
+                   (#{build-application\ 1264}#
+                     #f
+                     (#{build-primref\ 1274}#
+                       #f
+                       'make-extended-syncase-macro)
+                     (list (#{build-application\ 1264}#
+                             #f
+                             (#{build-primref\ 1274}# #f (quote module-ref))
+                             (list (#{build-application\ 1264}#
+                                     #f
+                                     (#{build-primref\ 1274}#
+                                       #f
+                                       'current-module)
+                                     '())
+                                   (#{build-data\ 1275}# #f #{name\ 1784}#)))
+                           (#{build-data\ 1275}# #f (quote macro))
+                           #{e\ 1785}#))
+                   (#{build-application\ 1264}#
+                     #f
+                     (#{build-primref\ 1274}#
+                       #f
+                       'make-syncase-macro)
+                     (list (#{build-data\ 1275}# #f (quote macro))
+                           #{e\ 1785}#))))))
+           (#{chi-top-sequence\ 1328}#
+             (lambda (#{body\ 1787}#
+                      #{r\ 1788}#
+                      #{w\ 1789}#
+                      #{s\ 1790}#
+                      #{m\ 1791}#
+                      #{esew\ 1792}#
+                      #{mod\ 1793}#)
+               (#{build-sequence\ 1276}#
+                 #{s\ 1790}#
+                 (letrec ((#{dobody\ 1794}#
+                            (lambda (#{body\ 1795}#
+                                     #{r\ 1796}#
+                                     #{w\ 1797}#
+                                     #{m\ 1798}#
+                                     #{esew\ 1799}#
+                                     #{mod\ 1800}#)
+                              (if (null? #{body\ 1795}#)
+                                '()
+                                (let ((#{first\ 1801}#
+                                        (#{chi-top\ 1332}#
+                                          (car #{body\ 1795}#)
+                                          #{r\ 1796}#
+                                          #{w\ 1797}#
+                                          #{m\ 1798}#
+                                          #{esew\ 1799}#
+                                          #{mod\ 1800}#)))
+                                  (cons #{first\ 1801}#
+                                        (#{dobody\ 1794}#
+                                          (cdr #{body\ 1795}#)
+                                          #{r\ 1796}#
+                                          #{w\ 1797}#
+                                          #{m\ 1798}#
+                                          #{esew\ 1799}#
+                                          #{mod\ 1800}#)))))))
+                   (#{dobody\ 1794}#
+                     #{body\ 1787}#
+                     #{r\ 1788}#
+                     #{w\ 1789}#
+                     #{m\ 1791}#
+                     #{esew\ 1792}#
+                     #{mod\ 1793}#)))))
+           (#{chi-sequence\ 1327}#
+             (lambda (#{body\ 1802}#
+                      #{r\ 1803}#
+                      #{w\ 1804}#
+                      #{s\ 1805}#
+                      #{mod\ 1806}#)
+               (#{build-sequence\ 1276}#
+                 #{s\ 1805}#
+                 (letrec ((#{dobody\ 1807}#
+                            (lambda (#{body\ 1808}#
+                                     #{r\ 1809}#
+                                     #{w\ 1810}#
+                                     #{mod\ 1811}#)
+                              (if (null? #{body\ 1808}#)
+                                '()
+                                (let ((#{first\ 1812}#
+                                        (#{chi\ 1333}#
+                                          (car #{body\ 1808}#)
+                                          #{r\ 1809}#
+                                          #{w\ 1810}#
+                                          #{mod\ 1811}#)))
+                                  (cons #{first\ 1812}#
+                                        (#{dobody\ 1807}#
+                                          (cdr #{body\ 1808}#)
+                                          #{r\ 1809}#
+                                          #{w\ 1810}#
+                                          #{mod\ 1811}#)))))))
+                   (#{dobody\ 1807}#
+                     #{body\ 1802}#
+                     #{r\ 1803}#
+                     #{w\ 1804}#
+                     #{mod\ 1806}#)))))
+           (#{source-wrap\ 1326}#
+             (lambda (#{x\ 1813}#
+                      #{w\ 1814}#
+                      #{s\ 1815}#
+                      #{defmod\ 1816}#)
+               (#{wrap\ 1325}#
+                 (#{decorate-source\ 1262}#
+                   #{x\ 1813}#
+                   #{s\ 1815}#)
+                 #{w\ 1814}#
+                 #{defmod\ 1816}#)))
+           (#{wrap\ 1325}#
+             (lambda (#{x\ 1817}# #{w\ 1818}# #{defmod\ 1819}#)
+               (if (if (null? (#{wrap-marks\ 1300}# #{w\ 1818}#))
+                     (null? (#{wrap-subst\ 1301}# #{w\ 1818}#))
+                     #f)
+                 #{x\ 1817}#
+                 (if (#{syntax-object?\ 1281}# #{x\ 1817}#)
+                   (#{make-syntax-object\ 1280}#
+                     (#{syntax-object-expression\ 1282}# #{x\ 1817}#)
+                     (#{join-wraps\ 1316}#
+                       #{w\ 1818}#
+                       (#{syntax-object-wrap\ 1283}# #{x\ 1817}#))
+                     (#{syntax-object-module\ 1284}# #{x\ 1817}#))
+                   (if (null? #{x\ 1817}#)
+                     #{x\ 1817}#
+                     (#{make-syntax-object\ 1280}#
+                       #{x\ 1817}#
+                       #{w\ 1818}#
+                       #{defmod\ 1819}#))))))
+           (#{bound-id-member?\ 1324}#
+             (lambda (#{x\ 1820}# #{list\ 1821}#)
+               (if (not (null? #{list\ 1821}#))
+                 (let ((#{t\ 1822}#
+                         (#{bound-id=?\ 1321}#
+                           #{x\ 1820}#
+                           (car #{list\ 1821}#))))
+                   (if #{t\ 1822}#
+                     #{t\ 1822}#
+                     (#{bound-id-member?\ 1324}#
+                       #{x\ 1820}#
+                       (cdr #{list\ 1821}#))))
+                 #f)))
+           (#{distinct-bound-ids?\ 1323}#
+             (lambda (#{ids\ 1823}#)
+               (letrec ((#{distinct?\ 1824}#
+                          (lambda (#{ids\ 1825}#)
+                            (let ((#{t\ 1826}# (null? #{ids\ 1825}#)))
+                              (if #{t\ 1826}#
+                                #{t\ 1826}#
+                                (if (not (#{bound-id-member?\ 1324}#
+                                           (car #{ids\ 1825}#)
+                                           (cdr #{ids\ 1825}#)))
+                                  (#{distinct?\ 1824}# (cdr #{ids\ 1825}#))
+                                  #f))))))
+                 (#{distinct?\ 1824}# #{ids\ 1823}#))))
+           (#{valid-bound-ids?\ 1322}#
+             (lambda (#{ids\ 1827}#)
+               (if (letrec ((#{all-ids?\ 1828}#
+                              (lambda (#{ids\ 1829}#)
+                                (let ((#{t\ 1830}# (null? #{ids\ 1829}#)))
+                                  (if #{t\ 1830}#
+                                    #{t\ 1830}#
+                                    (if (#{id?\ 1297}# (car #{ids\ 1829}#))
+                                      (#{all-ids?\ 1828}# (cdr #{ids\ 1829}#))
+                                      #f))))))
+                     (#{all-ids?\ 1828}# #{ids\ 1827}#))
+                 (#{distinct-bound-ids?\ 1323}# #{ids\ 1827}#)
+                 #f)))
+           (#{bound-id=?\ 1321}#
+             (lambda (#{i\ 1831}# #{j\ 1832}#)
+               (if (if (#{syntax-object?\ 1281}# #{i\ 1831}#)
+                     (#{syntax-object?\ 1281}# #{j\ 1832}#)
+                     #f)
+                 (if (eq? (#{syntax-object-expression\ 1282}# #{i\ 1831}#)
+                          (#{syntax-object-expression\ 1282}# #{j\ 1832}#))
+                   (#{same-marks?\ 1318}#
+                     (#{wrap-marks\ 1300}#
+                       (#{syntax-object-wrap\ 1283}# #{i\ 1831}#))
+                     (#{wrap-marks\ 1300}#
+                       (#{syntax-object-wrap\ 1283}# #{j\ 1832}#)))
+                   #f)
+                 (eq? #{i\ 1831}# #{j\ 1832}#))))
+           (#{free-id=?\ 1320}#
+             (lambda (#{i\ 1833}# #{j\ 1834}#)
+               (if (eq? (let ((#{x\ 1835}# #{i\ 1833}#))
+                          (if (#{syntax-object?\ 1281}# #{x\ 1835}#)
+                            (#{syntax-object-expression\ 1282}# #{x\ 1835}#)
+                            #{x\ 1835}#))
+                        (let ((#{x\ 1836}# #{j\ 1834}#))
+                          (if (#{syntax-object?\ 1281}# #{x\ 1836}#)
+                            (#{syntax-object-expression\ 1282}# #{x\ 1836}#)
+                            #{x\ 1836}#)))
+                 (eq? (#{id-var-name\ 1319}# #{i\ 1833}# (quote (())))
+                      (#{id-var-name\ 1319}# #{j\ 1834}# (quote (()))))
+                 #f)))
+           (#{id-var-name\ 1319}#
+             (lambda (#{id\ 1837}# #{w\ 1838}#)
+               (letrec ((#{search-vector-rib\ 1841}#
+                          (lambda (#{sym\ 1847}#
+                                   #{subst\ 1848}#
+                                   #{marks\ 1849}#
+                                   #{symnames\ 1850}#
+                                   #{ribcage\ 1851}#)
+                            (let ((#{n\ 1852}#
+                                    (vector-length #{symnames\ 1850}#)))
+                              (letrec ((#{f\ 1853}#
+                                         (lambda (#{i\ 1854}#)
+                                           (if (#{fx=\ 1256}#
+                                                 #{i\ 1854}#
+                                                 #{n\ 1852}#)
+                                             (#{search\ 1839}#
+                                               #{sym\ 1847}#
+                                               (cdr #{subst\ 1848}#)
+                                               #{marks\ 1849}#)
+                                             (if (if (eq? (vector-ref
+                                                            #{symnames\ 1850}#
+                                                            #{i\ 1854}#)
+                                                          #{sym\ 1847}#)
+                                                   (#{same-marks?\ 1318}#
+                                                     #{marks\ 1849}#
+                                                     (vector-ref
+                                                       (#{ribcage-marks\ 1307}#
+                                                         #{ribcage\ 1851}#)
+                                                       #{i\ 1854}#))
+                                                   #f)
+                                               (values
+                                                 (vector-ref
+                                                   (#{ribcage-labels\ 1308}#
+                                                     #{ribcage\ 1851}#)
+                                                   #{i\ 1854}#)
+                                                 #{marks\ 1849}#)
+                                               (#{f\ 1853}#
+                                                 (#{fx+\ 1254}#
+                                                   #{i\ 1854}#
+                                                   1)))))))
+                                (#{f\ 1853}# 0)))))
+                        (#{search-list-rib\ 1840}#
+                          (lambda (#{sym\ 1855}#
+                                   #{subst\ 1856}#
+                                   #{marks\ 1857}#
+                                   #{symnames\ 1858}#
+                                   #{ribcage\ 1859}#)
+                            (letrec ((#{f\ 1860}#
+                                       (lambda (#{symnames\ 1861}# #{i\ 1862}#)
+                                         (if (null? #{symnames\ 1861}#)
+                                           (#{search\ 1839}#
+                                             #{sym\ 1855}#
+                                             (cdr #{subst\ 1856}#)
+                                             #{marks\ 1857}#)
+                                           (if (if (eq? (car #{symnames\ 1861}#)
+                                                        #{sym\ 1855}#)
+                                                 (#{same-marks?\ 1318}#
+                                                   #{marks\ 1857}#
+                                                   (list-ref
+                                                     (#{ribcage-marks\ 1307}#
+                                                       #{ribcage\ 1859}#)
+                                                     #{i\ 1862}#))
+                                                 #f)
+                                             (values
+                                               (list-ref
+                                                 (#{ribcage-labels\ 1308}#
+                                                   #{ribcage\ 1859}#)
+                                                 #{i\ 1862}#)
+                                               #{marks\ 1857}#)
+                                             (#{f\ 1860}#
+                                               (cdr #{symnames\ 1861}#)
+                                               (#{fx+\ 1254}#
+                                                 #{i\ 1862}#
+                                                 1)))))))
+                              (#{f\ 1860}# #{symnames\ 1858}# 0))))
+                        (#{search\ 1839}#
+                          (lambda (#{sym\ 1863}#
+                                   #{subst\ 1864}#
+                                   #{marks\ 1865}#)
+                            (if (null? #{subst\ 1864}#)
+                              (values #f #{marks\ 1865}#)
+                              (let ((#{fst\ 1866}# (car #{subst\ 1864}#)))
+                                (if (eq? #{fst\ 1866}# (quote shift))
+                                  (#{search\ 1839}#
+                                    #{sym\ 1863}#
+                                    (cdr #{subst\ 1864}#)
+                                    (cdr #{marks\ 1865}#))
+                                  (let ((#{symnames\ 1867}#
+                                          (#{ribcage-symnames\ 1306}#
+                                            #{fst\ 1866}#)))
+                                    (if (vector? #{symnames\ 1867}#)
+                                      (#{search-vector-rib\ 1841}#
+                                        #{sym\ 1863}#
+                                        #{subst\ 1864}#
+                                        #{marks\ 1865}#
+                                        #{symnames\ 1867}#
+                                        #{fst\ 1866}#)
+                                      (#{search-list-rib\ 1840}#
+                                        #{sym\ 1863}#
+                                        #{subst\ 1864}#
+                                        #{marks\ 1865}#
+                                        #{symnames\ 1867}#
+                                        #{fst\ 1866}#)))))))))
+                 (if (symbol? #{id\ 1837}#)
+                   (let ((#{t\ 1868}#
+                           (call-with-values
+                             (lambda ()
+                               (#{search\ 1839}#
+                                 #{id\ 1837}#
+                                 (#{wrap-subst\ 1301}# #{w\ 1838}#)
+                                 (#{wrap-marks\ 1300}# #{w\ 1838}#)))
+                             (lambda (#{x\ 1870}# . #{ignore\ 1869}#)
+                               #{x\ 1870}#))))
+                     (if #{t\ 1868}# #{t\ 1868}# #{id\ 1837}#))
+                   (if (#{syntax-object?\ 1281}# #{id\ 1837}#)
+                     (let ((#{id\ 1871}#
+                             (#{syntax-object-expression\ 1282}# #{id\ 1837}#))
+                           (#{w1\ 1872}#
+                             (#{syntax-object-wrap\ 1283}# #{id\ 1837}#)))
+                       (let ((#{marks\ 1873}#
+                               (#{join-marks\ 1317}#
+                                 (#{wrap-marks\ 1300}# #{w\ 1838}#)
+                                 (#{wrap-marks\ 1300}# #{w1\ 1872}#))))
+                         (call-with-values
+                           (lambda ()
+                             (#{search\ 1839}#
+                               #{id\ 1871}#
+                               (#{wrap-subst\ 1301}# #{w\ 1838}#)
+                               #{marks\ 1873}#))
+                           (lambda (#{new-id\ 1874}# #{marks\ 1875}#)
+                             (let ((#{t\ 1876}# #{new-id\ 1874}#))
+                               (if #{t\ 1876}#
+                                 #{t\ 1876}#
+                                 (let ((#{t\ 1877}#
+                                         (call-with-values
+                                           (lambda ()
+                                             (#{search\ 1839}#
+                                               #{id\ 1871}#
+                                               (#{wrap-subst\ 1301}#
+                                                 #{w1\ 1872}#)
+                                               #{marks\ 1875}#))
+                                           (lambda (#{x\ 1879}#
+                                                    .
+                                                    #{ignore\ 1878}#)
+                                             #{x\ 1879}#))))
+                                   (if #{t\ 1877}#
+                                     #{t\ 1877}#
+                                     #{id\ 1871}#))))))))
+                     (syntax-violation
+                       'id-var-name
+                       "invalid id"
+                       #{id\ 1837}#))))))
+           (#{same-marks?\ 1318}#
+             (lambda (#{x\ 1880}# #{y\ 1881}#)
+               (let ((#{t\ 1882}# (eq? #{x\ 1880}# #{y\ 1881}#)))
+                 (if #{t\ 1882}#
+                   #{t\ 1882}#
+                   (if (not (null? #{x\ 1880}#))
+                     (if (not (null? #{y\ 1881}#))
+                       (if (eq? (car #{x\ 1880}#) (car #{y\ 1881}#))
+                         (#{same-marks?\ 1318}#
+                           (cdr #{x\ 1880}#)
+                           (cdr #{y\ 1881}#))
+                         #f)
+                       #f)
+                     #f)))))
+           (#{join-marks\ 1317}#
+             (lambda (#{m1\ 1883}# #{m2\ 1884}#)
+               (#{smart-append\ 1315}#
+                 #{m1\ 1883}#
+                 #{m2\ 1884}#)))
+           (#{join-wraps\ 1316}#
+             (lambda (#{w1\ 1885}# #{w2\ 1886}#)
+               (let ((#{m1\ 1887}#
+                       (#{wrap-marks\ 1300}# #{w1\ 1885}#))
+                     (#{s1\ 1888}#
+                       (#{wrap-subst\ 1301}# #{w1\ 1885}#)))
+                 (if (null? #{m1\ 1887}#)
+                   (if (null? #{s1\ 1888}#)
+                     #{w2\ 1886}#
+                     (#{make-wrap\ 1299}#
+                       (#{wrap-marks\ 1300}# #{w2\ 1886}#)
+                       (#{smart-append\ 1315}#
+                         #{s1\ 1888}#
+                         (#{wrap-subst\ 1301}# #{w2\ 1886}#))))
+                   (#{make-wrap\ 1299}#
+                     (#{smart-append\ 1315}#
+                       #{m1\ 1887}#
+                       (#{wrap-marks\ 1300}# #{w2\ 1886}#))
+                     (#{smart-append\ 1315}#
+                       #{s1\ 1888}#
+                       (#{wrap-subst\ 1301}# #{w2\ 1886}#)))))))
+           (#{smart-append\ 1315}#
+             (lambda (#{m1\ 1889}# #{m2\ 1890}#)
+               (if (null? #{m2\ 1890}#)
+                 #{m1\ 1889}#
+                 (append #{m1\ 1889}# #{m2\ 1890}#))))
+           (#{make-binding-wrap\ 1314}#
+             (lambda (#{ids\ 1891}# #{labels\ 1892}# #{w\ 1893}#)
+               (if (null? #{ids\ 1891}#)
+                 #{w\ 1893}#
+                 (#{make-wrap\ 1299}#
+                   (#{wrap-marks\ 1300}# #{w\ 1893}#)
+                   (cons (let ((#{labelvec\ 1894}#
+                                 (list->vector #{labels\ 1892}#)))
+                           (let ((#{n\ 1895}#
+                                   (vector-length #{labelvec\ 1894}#)))
+                             (let ((#{symnamevec\ 1896}#
+                                     (make-vector #{n\ 1895}#))
+                                   (#{marksvec\ 1897}#
+                                     (make-vector #{n\ 1895}#)))
+                               (begin
+                                 (letrec ((#{f\ 1898}#
+                                            (lambda (#{ids\ 1899}# #{i\ 1900}#)
+                                              (if (not (null? #{ids\ 1899}#))
+                                                (call-with-values
+                                                  (lambda ()
+                                                    (#{id-sym-name&marks\ 1298}#
+                                                      (car #{ids\ 1899}#)
+                                                      #{w\ 1893}#))
+                                                  (lambda (#{symname\ 1901}#
+                                                           #{marks\ 1902}#)
+                                                    (begin
+                                                      (vector-set!
+                                                        #{symnamevec\ 1896}#
+                                                        #{i\ 1900}#
+                                                        #{symname\ 1901}#)
+                                                      (vector-set!
+                                                        #{marksvec\ 1897}#
+                                                        #{i\ 1900}#
+                                                        #{marks\ 1902}#)
+                                                      (#{f\ 1898}#
+                                                        (cdr #{ids\ 1899}#)
+                                                        (#{fx+\ 1254}#
+                                                          #{i\ 1900}#
+                                                          1)))))))))
+                                   (#{f\ 1898}# #{ids\ 1891}# 0))
+                                 (#{make-ribcage\ 1304}#
+                                   #{symnamevec\ 1896}#
+                                   #{marksvec\ 1897}#
+                                   #{labelvec\ 1894}#)))))
+                         (#{wrap-subst\ 1301}# #{w\ 1893}#))))))
+           (#{extend-ribcage!\ 1313}#
+             (lambda (#{ribcage\ 1903}# #{id\ 1904}# #{label\ 1905}#)
+               (begin
+                 (#{set-ribcage-symnames!\ 1309}#
+                   #{ribcage\ 1903}#
+                   (cons (#{syntax-object-expression\ 1282}# #{id\ 1904}#)
+                         (#{ribcage-symnames\ 1306}# #{ribcage\ 1903}#)))
+                 (#{set-ribcage-marks!\ 1310}#
+                   #{ribcage\ 1903}#
+                   (cons (#{wrap-marks\ 1300}#
+                           (#{syntax-object-wrap\ 1283}# #{id\ 1904}#))
+                         (#{ribcage-marks\ 1307}# #{ribcage\ 1903}#)))
+                 (#{set-ribcage-labels!\ 1311}#
+                   #{ribcage\ 1903}#
+                   (cons #{label\ 1905}#
+                         (#{ribcage-labels\ 1308}# #{ribcage\ 1903}#))))))
+           (#{anti-mark\ 1312}#
+             (lambda (#{w\ 1906}#)
+               (#{make-wrap\ 1299}#
+                 (cons #f (#{wrap-marks\ 1300}# #{w\ 1906}#))
+                 (cons 'shift
+                       (#{wrap-subst\ 1301}# #{w\ 1906}#)))))
+           (#{set-ribcage-labels!\ 1311}#
+             (lambda (#{x\ 1907}# #{update\ 1908}#)
+               (vector-set! #{x\ 1907}# 3 #{update\ 1908}#)))
+           (#{set-ribcage-marks!\ 1310}#
+             (lambda (#{x\ 1909}# #{update\ 1910}#)
+               (vector-set! #{x\ 1909}# 2 #{update\ 1910}#)))
+           (#{set-ribcage-symnames!\ 1309}#
+             (lambda (#{x\ 1911}# #{update\ 1912}#)
+               (vector-set! #{x\ 1911}# 1 #{update\ 1912}#)))
+           (#{ribcage-labels\ 1308}#
+             (lambda (#{x\ 1913}#) (vector-ref #{x\ 1913}# 3)))
+           (#{ribcage-marks\ 1307}#
+             (lambda (#{x\ 1914}#) (vector-ref #{x\ 1914}# 2)))
+           (#{ribcage-symnames\ 1306}#
+             (lambda (#{x\ 1915}#) (vector-ref #{x\ 1915}# 1)))
+           (#{ribcage?\ 1305}#
+             (lambda (#{x\ 1916}#)
+               (if (vector? #{x\ 1916}#)
+                 (if (= (vector-length #{x\ 1916}#) 4)
+                   (eq? (vector-ref #{x\ 1916}# 0) (quote ribcage))
+                   #f)
+                 #f)))
+           (#{make-ribcage\ 1304}#
+             (lambda (#{symnames\ 1917}#
+                      #{marks\ 1918}#
+                      #{labels\ 1919}#)
+               (vector
+                 'ribcage
+                 #{symnames\ 1917}#
+                 #{marks\ 1918}#
+                 #{labels\ 1919}#)))
+           (#{gen-labels\ 1303}#
+             (lambda (#{ls\ 1920}#)
+               (if (null? #{ls\ 1920}#)
+                 '()
+                 (cons (#{gen-label\ 1302}#)
+                       (#{gen-labels\ 1303}# (cdr #{ls\ 1920}#))))))
+           (#{gen-label\ 1302}# (lambda () (string #\i)))
+           (#{wrap-subst\ 1301}# cdr)
+           (#{wrap-marks\ 1300}# car)
+           (#{make-wrap\ 1299}# cons)
+           (#{id-sym-name&marks\ 1298}#
+             (lambda (#{x\ 1921}# #{w\ 1922}#)
+               (if (#{syntax-object?\ 1281}# #{x\ 1921}#)
+                 (values
+                   (#{syntax-object-expression\ 1282}# #{x\ 1921}#)
+                   (#{join-marks\ 1317}#
+                     (#{wrap-marks\ 1300}# #{w\ 1922}#)
+                     (#{wrap-marks\ 1300}#
+                       (#{syntax-object-wrap\ 1283}# #{x\ 1921}#))))
+                 (values
+                   #{x\ 1921}#
+                   (#{wrap-marks\ 1300}# #{w\ 1922}#)))))
+           (#{id?\ 1297}#
+             (lambda (#{x\ 1923}#)
+               (if (symbol? #{x\ 1923}#)
+                 #t
+                 (if (#{syntax-object?\ 1281}# #{x\ 1923}#)
+                   (symbol?
+                     (#{syntax-object-expression\ 1282}# #{x\ 1923}#))
+                   #f))))
+           (#{nonsymbol-id?\ 1296}#
+             (lambda (#{x\ 1924}#)
+               (if (#{syntax-object?\ 1281}# #{x\ 1924}#)
+                 (symbol?
+                   (#{syntax-object-expression\ 1282}# #{x\ 1924}#))
+                 #f)))
+           (#{global-extend\ 1295}#
+             (lambda (#{type\ 1925}# #{sym\ 1926}# #{val\ 1927}#)
+               (#{put-global-definition-hook\ 1260}#
+                 #{sym\ 1926}#
+                 #{type\ 1925}#
+                 #{val\ 1927}#)))
+           (#{lookup\ 1294}#
+             (lambda (#{x\ 1928}# #{r\ 1929}# #{mod\ 1930}#)
+               (let ((#{t\ 1931}# (assq #{x\ 1928}# #{r\ 1929}#)))
+                 (if #{t\ 1931}#
+                   (cdr #{t\ 1931}#)
+                   (if (symbol? #{x\ 1928}#)
+                     (let ((#{t\ 1932}#
+                             (#{get-global-definition-hook\ 1261}#
+                               #{x\ 1928}#
+                               #{mod\ 1930}#)))
+                       (if #{t\ 1932}# #{t\ 1932}# (quote (global))))
+                     '(displaced-lexical))))))
+           (#{macros-only-env\ 1293}#
+             (lambda (#{r\ 1933}#)
+               (if (null? #{r\ 1933}#)
+                 '()
+                 (let ((#{a\ 1934}# (car #{r\ 1933}#)))
+                   (if (eq? (cadr #{a\ 1934}#) (quote macro))
+                     (cons #{a\ 1934}#
+                           (#{macros-only-env\ 1293}# (cdr #{r\ 1933}#)))
+                     (#{macros-only-env\ 1293}# (cdr #{r\ 1933}#)))))))
+           (#{extend-var-env\ 1292}#
+             (lambda (#{labels\ 1935}# #{vars\ 1936}# #{r\ 1937}#)
+               (if (null? #{labels\ 1935}#)
+                 #{r\ 1937}#
+                 (#{extend-var-env\ 1292}#
+                   (cdr #{labels\ 1935}#)
+                   (cdr #{vars\ 1936}#)
+                   (cons (cons (car #{labels\ 1935}#)
+                               (cons (quote lexical) (car #{vars\ 1936}#)))
+                         #{r\ 1937}#)))))
+           (#{extend-env\ 1291}#
+             (lambda (#{labels\ 1938}# #{bindings\ 1939}# #{r\ 1940}#)
+               (if (null? #{labels\ 1938}#)
+                 #{r\ 1940}#
+                 (#{extend-env\ 1291}#
+                   (cdr #{labels\ 1938}#)
+                   (cdr #{bindings\ 1939}#)
+                   (cons (cons (car #{labels\ 1938}#)
+                               (car #{bindings\ 1939}#))
+                         #{r\ 1940}#)))))
+           (#{binding-value\ 1290}# cdr)
+           (#{binding-type\ 1289}# car)
+           (#{source-annotation\ 1288}#
+             (lambda (#{x\ 1941}#)
+               (if (#{syntax-object?\ 1281}# #{x\ 1941}#)
+                 (#{source-annotation\ 1288}#
+                   (#{syntax-object-expression\ 1282}# #{x\ 1941}#))
+                 (if (pair? #{x\ 1941}#)
+                   (let ((#{props\ 1942}# (source-properties #{x\ 1941}#)))
+                     (if (pair? #{props\ 1942}#) #{props\ 1942}# #f))
+                   #f))))
+           (#{set-syntax-object-module!\ 1287}#
+             (lambda (#{x\ 1943}# #{update\ 1944}#)
+               (vector-set! #{x\ 1943}# 3 #{update\ 1944}#)))
+           (#{set-syntax-object-wrap!\ 1286}#
+             (lambda (#{x\ 1945}# #{update\ 1946}#)
+               (vector-set! #{x\ 1945}# 2 #{update\ 1946}#)))
+           (#{set-syntax-object-expression!\ 1285}#
+             (lambda (#{x\ 1947}# #{update\ 1948}#)
+               (vector-set! #{x\ 1947}# 1 #{update\ 1948}#)))
+           (#{syntax-object-module\ 1284}#
+             (lambda (#{x\ 1949}#) (vector-ref #{x\ 1949}# 3)))
+           (#{syntax-object-wrap\ 1283}#
+             (lambda (#{x\ 1950}#) (vector-ref #{x\ 1950}# 2)))
+           (#{syntax-object-expression\ 1282}#
+             (lambda (#{x\ 1951}#) (vector-ref #{x\ 1951}# 1)))
+           (#{syntax-object?\ 1281}#
+             (lambda (#{x\ 1952}#)
+               (if (vector? #{x\ 1952}#)
+                 (if (= (vector-length #{x\ 1952}#) 4)
+                   (eq? (vector-ref #{x\ 1952}# 0)
+                        'syntax-object)
+                   #f)
+                 #f)))
+           (#{make-syntax-object\ 1280}#
+             (lambda (#{expression\ 1953}#
+                      #{wrap\ 1954}#
+                      #{module\ 1955}#)
+               (vector
+                 'syntax-object
+                 #{expression\ 1953}#
+                 #{wrap\ 1954}#
+                 #{module\ 1955}#)))
+           (#{build-letrec\ 1279}#
+             (lambda (#{src\ 1956}#
+                      #{ids\ 1957}#
+                      #{vars\ 1958}#
+                      #{val-exps\ 1959}#
+                      #{body-exp\ 1960}#)
+               (if (null? #{vars\ 1958}#)
+                 #{body-exp\ 1960}#
+                 (let ((#{atom-key\ 1961}# (fluid-ref #{*mode*\ 1253}#)))
+                   (if (memv #{atom-key\ 1961}# (quote (c)))
+                     (begin
+                       (for-each
+                         #{maybe-name-value!\ 1271}#
+                         #{ids\ 1957}#
+                         #{val-exps\ 1959}#)
+                       ((@ (language tree-il) make-letrec)
+                        #{src\ 1956}#
+                        #{ids\ 1957}#
+                        #{vars\ 1958}#
+                        #{val-exps\ 1959}#
+                        #{body-exp\ 1960}#))
+                     (#{decorate-source\ 1262}#
+                       (list 'letrec
+                             (map list #{vars\ 1958}# #{val-exps\ 1959}#)
+                             #{body-exp\ 1960}#)
+                       #{src\ 1956}#))))))
+           (#{build-named-let\ 1278}#
+             (lambda (#{src\ 1962}#
+                      #{ids\ 1963}#
+                      #{vars\ 1964}#
+                      #{val-exps\ 1965}#
+                      #{body-exp\ 1966}#)
+               (let ((#{f\ 1967}# (car #{vars\ 1964}#))
+                     (#{f-name\ 1968}# (car #{ids\ 1963}#))
+                     (#{vars\ 1969}# (cdr #{vars\ 1964}#))
+                     (#{ids\ 1970}# (cdr #{ids\ 1963}#)))
+                 (let ((#{atom-key\ 1971}# (fluid-ref #{*mode*\ 1253}#)))
+                   (if (memv #{atom-key\ 1971}# (quote (c)))
+                     (let ((#{proc\ 1972}#
+                             (#{build-lambda\ 1273}#
+                               #{src\ 1962}#
+                               #{ids\ 1970}#
+                               #{vars\ 1969}#
+                               #f
+                               #{body-exp\ 1966}#)))
+                       (begin
+                         (#{maybe-name-value!\ 1271}#
+                           #{f-name\ 1968}#
+                           #{proc\ 1972}#)
+                         (for-each
+                           #{maybe-name-value!\ 1271}#
+                           #{ids\ 1970}#
+                           #{val-exps\ 1965}#)
+                         ((@ (language tree-il) make-letrec)
+                          #{src\ 1962}#
+                          (list #{f-name\ 1968}#)
+                          (list #{f\ 1967}#)
+                          (list #{proc\ 1972}#)
+                          (#{build-application\ 1264}#
+                            #{src\ 1962}#
+                            (#{build-lexical-reference\ 1266}#
+                              'fun
+                              #{src\ 1962}#
+                              #{f-name\ 1968}#
+                              #{f\ 1967}#)
+                            #{val-exps\ 1965}#))))
+                     (#{decorate-source\ 1262}#
+                       (list 'let
+                             #{f\ 1967}#
+                             (map list #{vars\ 1969}# #{val-exps\ 1965}#)
+                             #{body-exp\ 1966}#)
+                       #{src\ 1962}#))))))
+           (#{build-let\ 1277}#
+             (lambda (#{src\ 1973}#
+                      #{ids\ 1974}#
+                      #{vars\ 1975}#
+                      #{val-exps\ 1976}#
+                      #{body-exp\ 1977}#)
+               (if (null? #{vars\ 1975}#)
+                 #{body-exp\ 1977}#
+                 (let ((#{atom-key\ 1978}# (fluid-ref #{*mode*\ 1253}#)))
+                   (if (memv #{atom-key\ 1978}# (quote (c)))
+                     (begin
+                       (for-each
+                         #{maybe-name-value!\ 1271}#
+                         #{ids\ 1974}#
+                         #{val-exps\ 1976}#)
+                       ((@ (language tree-il) make-let)
+                        #{src\ 1973}#
+                        #{ids\ 1974}#
+                        #{vars\ 1975}#
+                        #{val-exps\ 1976}#
+                        #{body-exp\ 1977}#))
+                     (#{decorate-source\ 1262}#
+                       (list 'let
+                             (map list #{vars\ 1975}# #{val-exps\ 1976}#)
+                             #{body-exp\ 1977}#)
+                       #{src\ 1973}#))))))
+           (#{build-sequence\ 1276}#
+             (lambda (#{src\ 1979}# #{exps\ 1980}#)
+               (if (null? (cdr #{exps\ 1980}#))
+                 (car #{exps\ 1980}#)
+                 (let ((#{atom-key\ 1981}# (fluid-ref #{*mode*\ 1253}#)))
+                   (if (memv #{atom-key\ 1981}# (quote (c)))
+                     ((@ (language tree-il) make-sequence)
+                      #{src\ 1979}#
+                      #{exps\ 1980}#)
+                     (#{decorate-source\ 1262}#
+                       (cons (quote begin) #{exps\ 1980}#)
+                       #{src\ 1979}#))))))
+           (#{build-data\ 1275}#
+             (lambda (#{src\ 1982}# #{exp\ 1983}#)
+               (let ((#{atom-key\ 1984}# (fluid-ref #{*mode*\ 1253}#)))
+                 (if (memv #{atom-key\ 1984}# (quote (c)))
+                   ((@ (language tree-il) make-const)
+                    #{src\ 1982}#
+                    #{exp\ 1983}#)
+                   (#{decorate-source\ 1262}#
+                     (if (if (self-evaluating? #{exp\ 1983}#)
+                           (not (vector? #{exp\ 1983}#))
+                           #f)
+                       #{exp\ 1983}#
+                       (list (quote quote) #{exp\ 1983}#))
+                     #{src\ 1982}#)))))
+           (#{build-primref\ 1274}#
+             (lambda (#{src\ 1985}# #{name\ 1986}#)
+               (if (equal?
+                     (module-name (current-module))
+                     '(guile))
+                 (let ((#{atom-key\ 1987}# (fluid-ref #{*mode*\ 1253}#)))
+                   (if (memv #{atom-key\ 1987}# (quote (c)))
+                     ((@ (language tree-il) make-toplevel-ref)
+                      #{src\ 1985}#
+                      #{name\ 1986}#)
+                     (#{decorate-source\ 1262}#
+                       #{name\ 1986}#
+                       #{src\ 1985}#)))
+                 (let ((#{atom-key\ 1988}# (fluid-ref #{*mode*\ 1253}#)))
+                   (if (memv #{atom-key\ 1988}# (quote (c)))
+                     ((@ (language tree-il) make-module-ref)
+                      #{src\ 1985}#
+                      '(guile)
+                      #{name\ 1986}#
+                      #f)
+                     (#{decorate-source\ 1262}#
+                       (list (quote @@) (quote (guile)) #{name\ 1986}#)
+                       #{src\ 1985}#))))))
+           (#{build-lambda\ 1273}#
+             (lambda (#{src\ 1989}#
+                      #{ids\ 1990}#
+                      #{vars\ 1991}#
+                      #{docstring\ 1992}#
+                      #{exp\ 1993}#)
+               (let ((#{atom-key\ 1994}# (fluid-ref #{*mode*\ 1253}#)))
+                 (if (memv #{atom-key\ 1994}# (quote (c)))
+                   ((@ (language tree-il) make-lambda)
+                    #{src\ 1989}#
+                    #{ids\ 1990}#
+                    #{vars\ 1991}#
+                    (if #{docstring\ 1992}#
+                      (list (cons (quote documentation) #{docstring\ 1992}#))
+                      '())
+                    #{exp\ 1993}#)
+                   (#{decorate-source\ 1262}#
+                     (cons 'lambda
+                           (cons #{vars\ 1991}#
+                                 (append
+                                   (if #{docstring\ 1992}#
+                                     (list #{docstring\ 1992}#)
+                                     '())
+                                   (list #{exp\ 1993}#))))
+                     #{src\ 1989}#)))))
+           (#{build-global-definition\ 1272}#
+             (lambda (#{source\ 1995}# #{var\ 1996}# #{exp\ 1997}#)
+               (let ((#{atom-key\ 1998}# (fluid-ref #{*mode*\ 1253}#)))
+                 (if (memv #{atom-key\ 1998}# (quote (c)))
+                   (begin
+                     (#{maybe-name-value!\ 1271}#
+                       #{var\ 1996}#
+                       #{exp\ 1997}#)
+                     ((@ (language tree-il) make-toplevel-define)
+                      #{source\ 1995}#
+                      #{var\ 1996}#
+                      #{exp\ 1997}#))
+                   (#{decorate-source\ 1262}#
+                     (list (quote define) #{var\ 1996}# #{exp\ 1997}#)
+                     #{source\ 1995}#)))))
+           (#{maybe-name-value!\ 1271}#
+             (lambda (#{name\ 1999}# #{val\ 2000}#)
+               (if ((@ (language tree-il) lambda?) #{val\ 2000}#)
+                 (let ((#{meta\ 2001}#
+                         ((@ (language tree-il) lambda-meta)
+                          #{val\ 2000}#)))
+                   (if (not (assq (quote name) #{meta\ 2001}#))
+                     ((setter (@ (language tree-il) lambda-meta))
+                      #{val\ 2000}#
+                      (acons 'name
+                             #{name\ 1999}#
+                             #{meta\ 2001}#)))))))
+           (#{build-global-assignment\ 1270}#
+             (lambda (#{source\ 2002}#
+                      #{var\ 2003}#
+                      #{exp\ 2004}#
+                      #{mod\ 2005}#)
+               (#{analyze-variable\ 1268}#
+                 #{mod\ 2005}#
+                 #{var\ 2003}#
+                 (lambda (#{mod\ 2006}# #{var\ 2007}# #{public?\ 2008}#)
+                   (let ((#{atom-key\ 2009}# (fluid-ref #{*mode*\ 1253}#)))
+                     (if (memv #{atom-key\ 2009}# (quote (c)))
+                       ((@ (language tree-il) make-module-set)
+                        #{source\ 2002}#
+                        #{mod\ 2006}#
+                        #{var\ 2007}#
+                        #{public?\ 2008}#
+                        #{exp\ 2004}#)
+                       (#{decorate-source\ 1262}#
+                         (list 'set!
+                               (list (if #{public?\ 2008}#
+                                       '@
+                                       '@@)
+                                     #{mod\ 2006}#
+                                     #{var\ 2007}#)
+                               #{exp\ 2004}#)
+                         #{source\ 2002}#))))
+                 (lambda (#{var\ 2010}#)
+                   (let ((#{atom-key\ 2011}# (fluid-ref #{*mode*\ 1253}#)))
+                     (if (memv #{atom-key\ 2011}# (quote (c)))
+                       ((@ (language tree-il) make-toplevel-set)
+                        #{source\ 2002}#
+                        #{var\ 2010}#
+                        #{exp\ 2004}#)
+                       (#{decorate-source\ 1262}#
+                         (list (quote set!) #{var\ 2010}# #{exp\ 2004}#)
+                         #{source\ 2002}#)))))))
+           (#{build-global-reference\ 1269}#
+             (lambda (#{source\ 2012}# #{var\ 2013}# #{mod\ 2014}#)
+               (#{analyze-variable\ 1268}#
+                 #{mod\ 2014}#
+                 #{var\ 2013}#
+                 (lambda (#{mod\ 2015}# #{var\ 2016}# #{public?\ 2017}#)
+                   (let ((#{atom-key\ 2018}# (fluid-ref #{*mode*\ 1253}#)))
+                     (if (memv #{atom-key\ 2018}# (quote (c)))
+                       ((@ (language tree-il) make-module-ref)
+                        #{source\ 2012}#
+                        #{mod\ 2015}#
+                        #{var\ 2016}#
+                        #{public?\ 2017}#)
+                       (#{decorate-source\ 1262}#
+                         (list (if #{public?\ 2017}# (quote @) (quote @@))
+                               #{mod\ 2015}#
+                               #{var\ 2016}#)
+                         #{source\ 2012}#))))
+                 (lambda (#{var\ 2019}#)
+                   (let ((#{atom-key\ 2020}# (fluid-ref #{*mode*\ 1253}#)))
+                     (if (memv #{atom-key\ 2020}# (quote (c)))
+                       ((@ (language tree-il) make-toplevel-ref)
+                        #{source\ 2012}#
+                        #{var\ 2019}#)
+                       (#{decorate-source\ 1262}#
+                         #{var\ 2019}#
+                         #{source\ 2012}#)))))))
+           (#{analyze-variable\ 1268}#
+             (lambda (#{mod\ 2021}#
+                      #{var\ 2022}#
+                      #{modref-cont\ 2023}#
+                      #{bare-cont\ 2024}#)
+               (if (not #{mod\ 2021}#)
+                 (#{bare-cont\ 2024}# #{var\ 2022}#)
+                 (let ((#{kind\ 2025}# (car #{mod\ 2021}#))
+                       (#{mod\ 2026}# (cdr #{mod\ 2021}#)))
+                   (if (memv #{kind\ 2025}# (quote (public)))
+                     (#{modref-cont\ 2023}#
+                       #{mod\ 2026}#
+                       #{var\ 2022}#
+                       #t)
+                     (if (memv #{kind\ 2025}# (quote (private)))
+                       (if (not (equal?
+                                  #{mod\ 2026}#
+                                  (module-name (current-module))))
+                         (#{modref-cont\ 2023}#
+                           #{mod\ 2026}#
+                           #{var\ 2022}#
+                           #f)
+                         (#{bare-cont\ 2024}# #{var\ 2022}#))
+                       (if (memv #{kind\ 2025}# (quote (bare)))
+                         (#{bare-cont\ 2024}# #{var\ 2022}#)
+                         (if (memv #{kind\ 2025}# (quote (hygiene)))
+                           (if (if (not (equal?
+                                          #{mod\ 2026}#
+                                          (module-name (current-module))))
+                                 (module-variable
+                                   (resolve-module #{mod\ 2026}#)
+                                   #{var\ 2022}#)
+                                 #f)
+                             (#{modref-cont\ 2023}#
+                               #{mod\ 2026}#
+                               #{var\ 2022}#
+                               #f)
+                             (#{bare-cont\ 2024}# #{var\ 2022}#))
+                           (syntax-violation
+                             #f
+                             "bad module kind"
+                             #{var\ 2022}#
+                             #{mod\ 2026}#)))))))))
+           (#{build-lexical-assignment\ 1267}#
+             (lambda (#{source\ 2027}#
+                      #{name\ 2028}#
+                      #{var\ 2029}#
+                      #{exp\ 2030}#)
+               (let ((#{atom-key\ 2031}# (fluid-ref #{*mode*\ 1253}#)))
+                 (if (memv #{atom-key\ 2031}# (quote (c)))
+                   ((@ (language tree-il) make-lexical-set)
+                    #{source\ 2027}#
+                    #{name\ 2028}#
+                    #{var\ 2029}#
+                    #{exp\ 2030}#)
+                   (#{decorate-source\ 1262}#
+                     (list (quote set!) #{var\ 2029}# #{exp\ 2030}#)
+                     #{source\ 2027}#)))))
+           (#{build-lexical-reference\ 1266}#
+             (lambda (#{type\ 2032}#
+                      #{source\ 2033}#
+                      #{name\ 2034}#
+                      #{var\ 2035}#)
+               (let ((#{atom-key\ 2036}# (fluid-ref #{*mode*\ 1253}#)))
+                 (if (memv #{atom-key\ 2036}# (quote (c)))
+                   ((@ (language tree-il) make-lexical-ref)
+                    #{source\ 2033}#
+                    #{name\ 2034}#
+                    #{var\ 2035}#)
+                   (#{decorate-source\ 1262}#
+                     #{var\ 2035}#
+                     #{source\ 2033}#)))))
+           (#{build-conditional\ 1265}#
+             (lambda (#{source\ 2037}#
+                      #{test-exp\ 2038}#
+                      #{then-exp\ 2039}#
+                      #{else-exp\ 2040}#)
+               (let ((#{atom-key\ 2041}# (fluid-ref #{*mode*\ 1253}#)))
+                 (if (memv #{atom-key\ 2041}# (quote (c)))
+                   ((@ (language tree-il) make-conditional)
+                    #{source\ 2037}#
+                    #{test-exp\ 2038}#
+                    #{then-exp\ 2039}#
+                    #{else-exp\ 2040}#)
+                   (#{decorate-source\ 1262}#
+                     (if (equal? #{else-exp\ 2040}# (quote (if #f #f)))
+                       (list 'if
+                             #{test-exp\ 2038}#
+                             #{then-exp\ 2039}#)
+                       (list 'if
+                             #{test-exp\ 2038}#
+                             #{then-exp\ 2039}#
+                             #{else-exp\ 2040}#))
+                     #{source\ 2037}#)))))
+           (#{build-application\ 1264}#
+             (lambda (#{source\ 2042}#
+                      #{fun-exp\ 2043}#
+                      #{arg-exps\ 2044}#)
+               (let ((#{atom-key\ 2045}# (fluid-ref #{*mode*\ 1253}#)))
+                 (if (memv #{atom-key\ 2045}# (quote (c)))
+                   ((@ (language tree-il) make-application)
+                    #{source\ 2042}#
+                    #{fun-exp\ 2043}#
+                    #{arg-exps\ 2044}#)
+                   (#{decorate-source\ 1262}#
+                     (cons #{fun-exp\ 2043}# #{arg-exps\ 2044}#)
+                     #{source\ 2042}#)))))
+           (#{build-void\ 1263}#
+             (lambda (#{source\ 2046}#)
+               (let ((#{atom-key\ 2047}# (fluid-ref #{*mode*\ 1253}#)))
+                 (if (memv #{atom-key\ 2047}# (quote (c)))
+                   ((@ (language tree-il) make-void)
+                    #{source\ 2046}#)
+                   (#{decorate-source\ 1262}#
+                     '(if #f #f)
+                     #{source\ 2046}#)))))
+           (#{decorate-source\ 1262}#
+             (lambda (#{e\ 2048}# #{s\ 2049}#)
+               (begin
+                 (if (if (pair? #{e\ 2048}#) #{s\ 2049}# #f)
+                   (set-source-properties! #{e\ 2048}# #{s\ 2049}#))
+                 #{e\ 2048}#)))
+           (#{get-global-definition-hook\ 1261}#
+             (lambda (#{symbol\ 2050}# #{module\ 2051}#)
+               (begin
+                 (if (if (not #{module\ 2051}#) (current-module) #f)
+                   (warn "module system is booted, we should have a module"
+                         #{symbol\ 2050}#))
+                 (let ((#{v\ 2052}#
+                         (module-variable
+                           (if #{module\ 2051}#
+                             (resolve-module (cdr #{module\ 2051}#))
+                             (current-module))
+                           #{symbol\ 2050}#)))
+                   (if #{v\ 2052}#
+                     (if (variable-bound? #{v\ 2052}#)
+                       (let ((#{val\ 2053}# (variable-ref #{v\ 2052}#)))
+                         (if (macro? #{val\ 2053}#)
+                           (if (syncase-macro-type #{val\ 2053}#)
+                             (cons (syncase-macro-type #{val\ 2053}#)
+                                   (syncase-macro-binding #{val\ 2053}#))
+                             #f)
+                           #f))
+                       #f)
+                     #f)))))
+           (#{put-global-definition-hook\ 1260}#
+             (lambda (#{symbol\ 2054}# #{type\ 2055}# #{val\ 2056}#)
+               (let ((#{existing\ 2057}#
+                       (let ((#{v\ 2058}#
+                               (module-variable
+                                 (current-module)
+                                 #{symbol\ 2054}#)))
+                         (if #{v\ 2058}#
+                           (if (variable-bound? #{v\ 2058}#)
+                             (let ((#{val\ 2059}# (variable-ref #{v\ 2058}#)))
+                               (if (macro? #{val\ 2059}#)
+                                 (if (not (syncase-macro-type #{val\ 2059}#))
+                                   #{val\ 2059}#
+                                   #f)
+                                 #f))
+                             #f)
+                           #f))))
+                 (module-define!
+                   (current-module)
+                   #{symbol\ 2054}#
+                   (if #{existing\ 2057}#
+                     (make-extended-syncase-macro
+                       #{existing\ 2057}#
+                       #{type\ 2055}#
+                       #{val\ 2056}#)
+                     (make-syncase-macro #{type\ 2055}# #{val\ 2056}#))))))
+           (#{local-eval-hook\ 1259}#
+             (lambda (#{x\ 2060}# #{mod\ 2061}#)
+               (primitive-eval
+                 (list #{noexpand\ 1252}#
+                       (let ((#{atom-key\ 2062}# (fluid-ref #{*mode*\ 1253}#)))
+                         (if (memv #{atom-key\ 2062}# (quote (c)))
+                           ((@ (language tree-il) tree-il->scheme)
+                            #{x\ 2060}#)
+                           #{x\ 2060}#))))))
+           (#{top-level-eval-hook\ 1258}#
+             (lambda (#{x\ 2063}# #{mod\ 2064}#)
+               (primitive-eval
+                 (list #{noexpand\ 1252}#
+                       (let ((#{atom-key\ 2065}# (fluid-ref #{*mode*\ 1253}#)))
+                         (if (memv #{atom-key\ 2065}# (quote (c)))
+                           ((@ (language tree-il) tree-il->scheme)
+                            #{x\ 2063}#)
+                           #{x\ 2063}#))))))
+           (#{fx<\ 1257}# <)
+           (#{fx=\ 1256}# =)
+           (#{fx-\ 1255}# -)
+           (#{fx+\ 1254}# +)
+           (#{*mode*\ 1253}# (make-fluid))
+           (#{noexpand\ 1252}# "noexpand"))
+    (begin
+      (#{global-extend\ 1295}#
+        'local-syntax
+        'letrec-syntax
+        #t)
+      (#{global-extend\ 1295}#
+        'local-syntax
+        'let-syntax
+        #f)
+      (#{global-extend\ 1295}#
+        'core
+        'fluid-let-syntax
+        (lambda (#{e\ 2066}#
+                 #{r\ 2067}#
+                 #{w\ 2068}#
+                 #{s\ 2069}#
+                 #{mod\ 2070}#)
+          ((lambda (#{tmp\ 2071}#)
+             ((lambda (#{tmp\ 2072}#)
+                (if (if #{tmp\ 2072}#
+                      (apply (lambda (#{_\ 2073}#
+                                      #{var\ 2074}#
+                                      #{val\ 2075}#
+                                      #{e1\ 2076}#
+                                      #{e2\ 2077}#)
+                               (#{valid-bound-ids?\ 1322}# #{var\ 2074}#))
+                             #{tmp\ 2072}#)
+                      #f)
+                  (apply (lambda (#{_\ 2079}#
+                                  #{var\ 2080}#
+                                  #{val\ 2081}#
+                                  #{e1\ 2082}#
+                                  #{e2\ 2083}#)
+                           (let ((#{names\ 2084}#
+                                   (map (lambda (#{x\ 2085}#)
+                                          (#{id-var-name\ 1319}#
+                                            #{x\ 2085}#
+                                            #{w\ 2068}#))
+                                        #{var\ 2080}#)))
+                             (begin
+                               (for-each
+                                 (lambda (#{id\ 2087}# #{n\ 2088}#)
+                                   (let ((#{atom-key\ 2089}#
+                                           (#{binding-type\ 1289}#
+                                             (#{lookup\ 1294}#
+                                               #{n\ 2088}#
+                                               #{r\ 2067}#
+                                               #{mod\ 2070}#))))
+                                     (if (memv #{atom-key\ 2089}#
+                                               '(displaced-lexical))
+                                       (syntax-violation
+                                         'fluid-let-syntax
+                                         "identifier out of context"
+                                         #{e\ 2066}#
+                                         (#{source-wrap\ 1326}#
+                                           #{id\ 2087}#
+                                           #{w\ 2068}#
+                                           #{s\ 2069}#
+                                           #{mod\ 2070}#)))))
+                                 #{var\ 2080}#
+                                 #{names\ 2084}#)
+                               (#{chi-body\ 1337}#
+                                 (cons #{e1\ 2082}# #{e2\ 2083}#)
+                                 (#{source-wrap\ 1326}#
+                                   #{e\ 2066}#
+                                   #{w\ 2068}#
+                                   #{s\ 2069}#
+                                   #{mod\ 2070}#)
+                                 (#{extend-env\ 1291}#
+                                   #{names\ 2084}#
+                                   (let ((#{trans-r\ 2092}#
+                                           (#{macros-only-env\ 1293}#
+                                             #{r\ 2067}#)))
+                                     (map (lambda (#{x\ 2093}#)
+                                            (cons 'macro
+                                                  (#{eval-local-transformer\ 1340}#
+                                                    (#{chi\ 1333}#
+                                                      #{x\ 2093}#
+                                                      #{trans-r\ 2092}#
+                                                      #{w\ 2068}#
+                                                      #{mod\ 2070}#)
+                                                    #{mod\ 2070}#)))
+                                          #{val\ 2081}#))
+                                   #{r\ 2067}#)
+                                 #{w\ 2068}#
+                                 #{mod\ 2070}#))))
+                         #{tmp\ 2072}#)
+                  ((lambda (#{_\ 2095}#)
+                     (syntax-violation
+                       'fluid-let-syntax
+                       "bad syntax"
+                       (#{source-wrap\ 1326}#
+                         #{e\ 2066}#
+                         #{w\ 2068}#
+                         #{s\ 2069}#
+                         #{mod\ 2070}#)))
+                   #{tmp\ 2071}#)))
+              ($sc-dispatch
+                #{tmp\ 2071}#
+                '(any #(each (any any)) any . each-any))))
+           #{e\ 2066}#)))
+      (#{global-extend\ 1295}#
+        'core
+        'quote
+        (lambda (#{e\ 2096}#
+                 #{r\ 2097}#
+                 #{w\ 2098}#
+                 #{s\ 2099}#
+                 #{mod\ 2100}#)
+          ((lambda (#{tmp\ 2101}#)
+             ((lambda (#{tmp\ 2102}#)
+                (if #{tmp\ 2102}#
+                  (apply (lambda (#{_\ 2103}# #{e\ 2104}#)
+                           (#{build-data\ 1275}#
+                             #{s\ 2099}#
+                             (#{strip\ 1343}# #{e\ 2104}# #{w\ 2098}#)))
+                         #{tmp\ 2102}#)
+                  ((lambda (#{_\ 2105}#)
+                     (syntax-violation
+                       'quote
+                       "bad syntax"
+                       (#{source-wrap\ 1326}#
+                         #{e\ 2096}#
+                         #{w\ 2098}#
+                         #{s\ 2099}#
+                         #{mod\ 2100}#)))
+                   #{tmp\ 2101}#)))
+              ($sc-dispatch #{tmp\ 2101}# (quote (any any)))))
+           #{e\ 2096}#)))
+      (#{global-extend\ 1295}#
+        'core
+        'syntax
+        (letrec ((#{regen\ 2113}#
+                   (lambda (#{x\ 2114}#)
+                     (let ((#{atom-key\ 2115}# (car #{x\ 2114}#)))
+                       (if (memv #{atom-key\ 2115}# (quote (ref)))
+                         (#{build-lexical-reference\ 1266}#
+                           'value
+                           #f
+                           (cadr #{x\ 2114}#)
+                           (cadr #{x\ 2114}#))
+                         (if (memv #{atom-key\ 2115}# (quote (primitive)))
+                           (#{build-primref\ 1274}# #f (cadr #{x\ 2114}#))
+                           (if (memv #{atom-key\ 2115}# (quote (quote)))
+                             (#{build-data\ 1275}# #f (cadr #{x\ 2114}#))
+                             (if (memv #{atom-key\ 2115}# (quote (lambda)))
+                               (#{build-lambda\ 1273}#
+                                 #f
+                                 (cadr #{x\ 2114}#)
+                                 (cadr #{x\ 2114}#)
+                                 #f
+                                 (#{regen\ 2113}# (caddr #{x\ 2114}#)))
+                               (#{build-application\ 1264}#
+                                 #f
+                                 (#{build-primref\ 1274}# #f (car #{x\ 2114}#))
+                                 (map #{regen\ 2113}#
+                                      (cdr #{x\ 2114}#))))))))))
+                 (#{gen-vector\ 2112}#
+                   (lambda (#{x\ 2116}#)
+                     (if (eq? (car #{x\ 2116}#) (quote list))
+                       (cons (quote vector) (cdr #{x\ 2116}#))
+                       (if (eq? (car #{x\ 2116}#) (quote quote))
+                         (list 'quote
+                               (list->vector (cadr #{x\ 2116}#)))
+                         (list (quote list->vector) #{x\ 2116}#)))))
+                 (#{gen-append\ 2111}#
+                   (lambda (#{x\ 2117}# #{y\ 2118}#)
+                     (if (equal? #{y\ 2118}# (quote (quote ())))
+                       #{x\ 2117}#
+                       (list (quote append) #{x\ 2117}# #{y\ 2118}#))))
+                 (#{gen-cons\ 2110}#
+                   (lambda (#{x\ 2119}# #{y\ 2120}#)
+                     (let ((#{atom-key\ 2121}# (car #{y\ 2120}#)))
+                       (if (memv #{atom-key\ 2121}# (quote (quote)))
+                         (if (eq? (car #{x\ 2119}#) (quote quote))
+                           (list 'quote
+                                 (cons (cadr #{x\ 2119}#) (cadr #{y\ 2120}#)))
+                           (if (eq? (cadr #{y\ 2120}#) (quote ()))
+                             (list (quote list) #{x\ 2119}#)
+                             (list (quote cons) #{x\ 2119}# #{y\ 2120}#)))
+                         (if (memv #{atom-key\ 2121}# (quote (list)))
+                           (cons 'list
+                                 (cons #{x\ 2119}# (cdr #{y\ 2120}#)))
+                           (list (quote cons) #{x\ 2119}# #{y\ 2120}#))))))
+                 (#{gen-map\ 2109}#
+                   (lambda (#{e\ 2122}# #{map-env\ 2123}#)
+                     (let ((#{formals\ 2124}# (map cdr #{map-env\ 2123}#))
+                           (#{actuals\ 2125}#
+                             (map (lambda (#{x\ 2126}#)
+                                    (list (quote ref) (car #{x\ 2126}#)))
+                                  #{map-env\ 2123}#)))
+                       (if (eq? (car #{e\ 2122}#) (quote ref))
+                         (car #{actuals\ 2125}#)
+                         (if (and-map
+                               (lambda (#{x\ 2127}#)
+                                 (if (eq? (car #{x\ 2127}#) (quote ref))
+                                   (memq (cadr #{x\ 2127}#) #{formals\ 2124}#)
+                                   #f))
+                               (cdr #{e\ 2122}#))
+                           (cons 'map
+                                 (cons (list 'primitive
+                                             (car #{e\ 2122}#))
+                                       (map (let ((#{r\ 2128}#
+                                                    (map cons
+                                                         #{formals\ 2124}#
+                                                         #{actuals\ 2125}#)))
+                                              (lambda (#{x\ 2129}#)
+                                                (cdr (assq (cadr #{x\ 2129}#)
+                                                           #{r\ 2128}#))))
+                                            (cdr #{e\ 2122}#))))
+                           (cons 'map
+                                 (cons (list 'lambda
+                                             #{formals\ 2124}#
+                                             #{e\ 2122}#)
+                                       #{actuals\ 2125}#)))))))
+                 (#{gen-mappend\ 2108}#
+                   (lambda (#{e\ 2130}# #{map-env\ 2131}#)
+                     (list 'apply
+                           '(primitive append)
+                           (#{gen-map\ 2109}# #{e\ 2130}# #{map-env\ 2131}#))))
+                 (#{gen-ref\ 2107}#
+                   (lambda (#{src\ 2132}#
+                            #{var\ 2133}#
+                            #{level\ 2134}#
+                            #{maps\ 2135}#)
+                     (if (#{fx=\ 1256}# #{level\ 2134}# 0)
+                       (values #{var\ 2133}# #{maps\ 2135}#)
+                       (if (null? #{maps\ 2135}#)
+                         (syntax-violation
+                           'syntax
+                           "missing ellipsis"
+                           #{src\ 2132}#)
+                         (call-with-values
+                           (lambda ()
+                             (#{gen-ref\ 2107}#
+                               #{src\ 2132}#
+                               #{var\ 2133}#
+                               (#{fx-\ 1255}# #{level\ 2134}# 1)
+                               (cdr #{maps\ 2135}#)))
+                           (lambda (#{outer-var\ 2136}# #{outer-maps\ 2137}#)
+                             (let ((#{b\ 2138}#
+                                     (assq #{outer-var\ 2136}#
+                                           (car #{maps\ 2135}#))))
+                               (if #{b\ 2138}#
+                                 (values (cdr #{b\ 2138}#) #{maps\ 2135}#)
+                                 (let ((#{inner-var\ 2139}#
+                                         (#{gen-var\ 1344}# (quote tmp))))
+                                   (values
+                                     #{inner-var\ 2139}#
+                                     (cons (cons (cons #{outer-var\ 2136}#
+                                                       #{inner-var\ 2139}#)
+                                                 (car #{maps\ 2135}#))
+                                           #{outer-maps\ 2137}#)))))))))))
+                 (#{gen-syntax\ 2106}#
+                   (lambda (#{src\ 2140}#
+                            #{e\ 2141}#
+                            #{r\ 2142}#
+                            #{maps\ 2143}#
+                            #{ellipsis?\ 2144}#
+                            #{mod\ 2145}#)
+                     (if (#{id?\ 1297}# #{e\ 2141}#)
+                       (let ((#{label\ 2146}#
+                               (#{id-var-name\ 1319}#
+                                 #{e\ 2141}#
+                                 '(()))))
+                         (let ((#{b\ 2147}#
+                                 (#{lookup\ 1294}#
+                                   #{label\ 2146}#
+                                   #{r\ 2142}#
+                                   #{mod\ 2145}#)))
+                           (if (eq? (#{binding-type\ 1289}# #{b\ 2147}#)
+                                    'syntax)
+                             (call-with-values
+                               (lambda ()
+                                 (let ((#{var.lev\ 2148}#
+                                         (#{binding-value\ 1290}#
+                                           #{b\ 2147}#)))
+                                   (#{gen-ref\ 2107}#
+                                     #{src\ 2140}#
+                                     (car #{var.lev\ 2148}#)
+                                     (cdr #{var.lev\ 2148}#)
+                                     #{maps\ 2143}#)))
+                               (lambda (#{var\ 2149}# #{maps\ 2150}#)
+                                 (values
+                                   (list (quote ref) #{var\ 2149}#)
+                                   #{maps\ 2150}#)))
+                             (if (#{ellipsis?\ 2144}# #{e\ 2141}#)
+                               (syntax-violation
+                                 'syntax
+                                 "misplaced ellipsis"
+                                 #{src\ 2140}#)
+                               (values
+                                 (list (quote quote) #{e\ 2141}#)
+                                 #{maps\ 2143}#)))))
+                       ((lambda (#{tmp\ 2151}#)
+                          ((lambda (#{tmp\ 2152}#)
+                             (if (if #{tmp\ 2152}#
+                                   (apply (lambda (#{dots\ 2153}# #{e\ 2154}#)
+                                            (#{ellipsis?\ 2144}#
+                                              #{dots\ 2153}#))
+                                          #{tmp\ 2152}#)
+                                   #f)
+                               (apply (lambda (#{dots\ 2155}# #{e\ 2156}#)
+                                        (#{gen-syntax\ 2106}#
+                                          #{src\ 2140}#
+                                          #{e\ 2156}#
+                                          #{r\ 2142}#
+                                          #{maps\ 2143}#
+                                          (lambda (#{x\ 2157}#) #f)
+                                          #{mod\ 2145}#))
+                                      #{tmp\ 2152}#)
+                               ((lambda (#{tmp\ 2158}#)
+                                  (if (if #{tmp\ 2158}#
+                                        (apply (lambda (#{x\ 2159}#
+                                                        #{dots\ 2160}#
+                                                        #{y\ 2161}#)
+                                                 (#{ellipsis?\ 2144}#
+                                                   #{dots\ 2160}#))
+                                               #{tmp\ 2158}#)
+                                        #f)
+                                    (apply (lambda (#{x\ 2162}#
+                                                    #{dots\ 2163}#
+                                                    #{y\ 2164}#)
+                                             (letrec ((#{f\ 2165}#
+                                                        (lambda (#{y\ 2166}#
+                                                                 #{k\ 2167}#)
+                                                          ((lambda (#{tmp\ 2171}#)
+                                                             ((lambda (#{tmp\ 2172}#)
+                                                                (if (if #{tmp\ 2172}#
+                                                                      (apply (lambda (#{dots\ 2173}#
+                                                                                      #{y\ 2174}#)
+                                                                               (#{ellipsis?\ 2144}#
+                                                                                 #{dots\ 2173}#))
+                                                                             #{tmp\ 2172}#)
+                                                                      #f)
+                                                                  (apply (lambda (#{dots\ 2175}#
+                                                                                  #{y\ 2176}#)
+                                                                           (#{f\ 2165}#
+                                                                             #{y\ 2176}#
+                                                                             (lambda (#{maps\ 2177}#)
+                                                                               (call-with-values
+                                                                                 (lambda ()
+                                                                                   (#{k\ 2167}#
+                                                                                     (cons '()
+                                                                                           #{maps\ 2177}#)))
+                                                                                 (lambda (#{x\ 2178}#
+                                                                                          #{maps\ 2179}#)
+                                                                                   (if (null? (car #{maps\ 2179}#))
+                                                                                     (syntax-violation
+                                                                                       'syntax
+                                                                                       "extra ellipsis"
+                                                                                       #{src\ 2140}#)
+                                                                                     (values
+                                                                                       (#{gen-mappend\ 2108}#
+                                                                                         #{x\ 2178}#
+                                                                                         (car #{maps\ 2179}#))
+                                                                                       (cdr #{maps\ 2179}#))))))))
+                                                                         #{tmp\ 2172}#)
+                                                                  ((lambda (#{_\ 2180}#)
+                                                                     (call-with-values
+                                                                       (lambda ()
+                                                                         (#{gen-syntax\ 2106}#
+                                                                           #{src\ 2140}#
+                                                                           #{y\ 2166}#
+                                                                           #{r\ 2142}#
+                                                                           #{maps\ 2143}#
+                                                                           #{ellipsis?\ 2144}#
+                                                                           #{mod\ 2145}#))
+                                                                       (lambda (#{y\ 2181}#
+                                                                                #{maps\ 2182}#)
+                                                                         (call-with-values
+                                                                           (lambda ()
+                                                                             (#{k\ 2167}#
+                                                                               #{maps\ 2182}#))
+                                                                           (lambda (#{x\ 2183}#
+                                                                                    #{maps\ 2184}#)
+                                                                             (values
+                                                                               (#{gen-append\ 2111}#
+                                                                                 #{x\ 2183}#
+                                                                                 #{y\ 2181}#)
+                                                                               #{maps\ 2184}#))))))
+                                                                   #{tmp\ 2171}#)))
+                                                              ($sc-dispatch
+                                                                #{tmp\ 2171}#
+                                                                '(any . any))))
+                                                           #{y\ 2166}#))))
+                                               (#{f\ 2165}#
+                                                 #{y\ 2164}#
+                                                 (lambda (#{maps\ 2168}#)
+                                                   (call-with-values
+                                                     (lambda ()
+                                                       (#{gen-syntax\ 2106}#
+                                                         #{src\ 2140}#
+                                                         #{x\ 2162}#
+                                                         #{r\ 2142}#
+                                                         (cons '()
+                                                               #{maps\ 2168}#)
+                                                         #{ellipsis?\ 2144}#
+                                                         #{mod\ 2145}#))
+                                                     (lambda (#{x\ 2169}#
+                                                              #{maps\ 2170}#)
+                                                       (if (null? (car #{maps\ 2170}#))
+                                                         (syntax-violation
+                                                           'syntax
+                                                           "extra ellipsis"
+                                                           #{src\ 2140}#)
+                                                         (values
+                                                           (#{gen-map\ 2109}#
+                                                             #{x\ 2169}#
+                                                             (car #{maps\ 2170}#))
+                                                           (cdr #{maps\ 2170}#)))))))))
+                                           #{tmp\ 2158}#)
+                                    ((lambda (#{tmp\ 2185}#)
+                                       (if #{tmp\ 2185}#
+                                         (apply (lambda (#{x\ 2186}#
+                                                         #{y\ 2187}#)
+                                                  (call-with-values
+                                                    (lambda ()
+                                                      (#{gen-syntax\ 2106}#
+                                                        #{src\ 2140}#
+                                                        #{x\ 2186}#
+                                                        #{r\ 2142}#
+                                                        #{maps\ 2143}#
+                                                        #{ellipsis?\ 2144}#
+                                                        #{mod\ 2145}#))
+                                                    (lambda (#{x\ 2188}#
+                                                             #{maps\ 2189}#)
+                                                      (call-with-values
+                                                        (lambda ()
+                                                          (#{gen-syntax\ 2106}#
+                                                            #{src\ 2140}#
+                                                            #{y\ 2187}#
+                                                            #{r\ 2142}#
+                                                            #{maps\ 2189}#
+                                                            #{ellipsis?\ 2144}#
+                                                            #{mod\ 2145}#))
+                                                        (lambda (#{y\ 2190}#
+                                                                 #{maps\ 2191}#)
+                                                          (values
+                                                            (#{gen-cons\ 2110}#
+                                                              #{x\ 2188}#
+                                                              #{y\ 2190}#)
+                                                            #{maps\ 2191}#))))))
+                                                #{tmp\ 2185}#)
+                                         ((lambda (#{tmp\ 2192}#)
+                                            (if #{tmp\ 2192}#
+                                              (apply (lambda (#{e1\ 2193}#
+                                                              #{e2\ 2194}#)
+                                                       (call-with-values
+                                                         (lambda ()
+                                                           (#{gen-syntax\ 2106}#
+                                                             #{src\ 2140}#
+                                                             (cons #{e1\ 2193}#
+                                                                   #{e2\ 2194}#)
+                                                             #{r\ 2142}#
+                                                             #{maps\ 2143}#
+                                                             #{ellipsis?\ 2144}#
+                                                             #{mod\ 2145}#))
+                                                         (lambda (#{e\ 2196}#
+                                                                  #{maps\ 2197}#)
+                                                           (values
+                                                             (#{gen-vector\ 2112}#
+                                                               #{e\ 2196}#)
+                                                             #{maps\ 2197}#))))
+                                                     #{tmp\ 2192}#)
+                                              ((lambda (#{_\ 2198}#)
+                                                 (values
+                                                   (list 'quote
+                                                         #{e\ 2141}#)
+                                                   #{maps\ 2143}#))
+                                               #{tmp\ 2151}#)))
+                                          ($sc-dispatch
+                                            #{tmp\ 2151}#
+                                            '#(vector (any . each-any))))))
+                                     ($sc-dispatch
+                                       #{tmp\ 2151}#
+                                       '(any . any)))))
+                                ($sc-dispatch
+                                  #{tmp\ 2151}#
+                                  '(any any . any)))))
+                           ($sc-dispatch #{tmp\ 2151}# (quote (any any)))))
+                        #{e\ 2141}#)))))
+          (lambda (#{e\ 2199}#
+                   #{r\ 2200}#
+                   #{w\ 2201}#
+                   #{s\ 2202}#
+                   #{mod\ 2203}#)
+            (let ((#{e\ 2204}#
+                    (#{source-wrap\ 1326}#
+                      #{e\ 2199}#
+                      #{w\ 2201}#
+                      #{s\ 2202}#
+                      #{mod\ 2203}#)))
+              ((lambda (#{tmp\ 2205}#)
+                 ((lambda (#{tmp\ 2206}#)
+                    (if #{tmp\ 2206}#
+                      (apply (lambda (#{_\ 2207}# #{x\ 2208}#)
+                               (call-with-values
+                                 (lambda ()
+                                   (#{gen-syntax\ 2106}#
+                                     #{e\ 2204}#
+                                     #{x\ 2208}#
+                                     #{r\ 2200}#
+                                     '()
+                                     #{ellipsis?\ 1342}#
+                                     #{mod\ 2203}#))
+                                 (lambda (#{e\ 2209}# #{maps\ 2210}#)
+                                   (#{regen\ 2113}# #{e\ 2209}#))))
+                             #{tmp\ 2206}#)
+                      ((lambda (#{_\ 2211}#)
+                         (syntax-violation
+                           'syntax
+                           "bad `syntax' form"
+                           #{e\ 2204}#))
+                       #{tmp\ 2205}#)))
+                  ($sc-dispatch #{tmp\ 2205}# (quote (any any)))))
+               #{e\ 2204}#)))))
+      (#{global-extend\ 1295}#
+        'core
+        'lambda
+        (lambda (#{e\ 2212}#
+                 #{r\ 2213}#
+                 #{w\ 2214}#
+                 #{s\ 2215}#
+                 #{mod\ 2216}#)
+          ((lambda (#{tmp\ 2217}#)
+             ((lambda (#{tmp\ 2218}#)
+                (if #{tmp\ 2218}#
+                  (apply (lambda (#{_\ 2219}# #{c\ 2220}#)
+                           (#{chi-lambda-clause\ 1338}#
+                             (#{source-wrap\ 1326}#
+                               #{e\ 2212}#
+                               #{w\ 2214}#
+                               #{s\ 2215}#
+                               #{mod\ 2216}#)
+                             #f
+                             #{c\ 2220}#
+                             #{r\ 2213}#
+                             #{w\ 2214}#
+                             #{mod\ 2216}#
+                             (lambda (#{names\ 2221}#
+                                      #{vars\ 2222}#
+                                      #{docstring\ 2223}#
+                                      #{body\ 2224}#)
+                               (#{build-lambda\ 1273}#
+                                 #{s\ 2215}#
+                                 #{names\ 2221}#
+                                 #{vars\ 2222}#
+                                 #{docstring\ 2223}#
+                                 #{body\ 2224}#))))
+                         #{tmp\ 2218}#)
+                  (syntax-violation
+                    #f
+                    "source expression failed to match any pattern"
+                    #{tmp\ 2217}#)))
+              ($sc-dispatch #{tmp\ 2217}# (quote (any . any)))))
+           #{e\ 2212}#)))
+      (#{global-extend\ 1295}#
+        'core
+        'let
+        (letrec ((#{chi-let\ 2225}#
+                   (lambda (#{e\ 2226}#
+                            #{r\ 2227}#
+                            #{w\ 2228}#
+                            #{s\ 2229}#
+                            #{mod\ 2230}#
+                            #{constructor\ 2231}#
+                            #{ids\ 2232}#
+                            #{vals\ 2233}#
+                            #{exps\ 2234}#)
+                     (if (not (#{valid-bound-ids?\ 1322}# #{ids\ 2232}#))
+                       (syntax-violation
+                         'let
+                         "duplicate bound variable"
+                         #{e\ 2226}#)
+                       (let ((#{labels\ 2235}#
+                               (#{gen-labels\ 1303}# #{ids\ 2232}#))
+                             (#{new-vars\ 2236}#
+                               (map #{gen-var\ 1344}# #{ids\ 2232}#)))
+                         (let ((#{nw\ 2237}#
+                                 (#{make-binding-wrap\ 1314}#
+                                   #{ids\ 2232}#
+                                   #{labels\ 2235}#
+                                   #{w\ 2228}#))
+                               (#{nr\ 2238}#
+                                 (#{extend-var-env\ 1292}#
+                                   #{labels\ 2235}#
+                                   #{new-vars\ 2236}#
+                                   #{r\ 2227}#)))
+                           (#{constructor\ 2231}#
+                             #{s\ 2229}#
+                             (map syntax->datum #{ids\ 2232}#)
+                             #{new-vars\ 2236}#
+                             (map (lambda (#{x\ 2239}#)
+                                    (#{chi\ 1333}#
+                                      #{x\ 2239}#
+                                      #{r\ 2227}#
+                                      #{w\ 2228}#
+                                      #{mod\ 2230}#))
+                                  #{vals\ 2233}#)
+                             (#{chi-body\ 1337}#
+                               #{exps\ 2234}#
+                               (#{source-wrap\ 1326}#
+                                 #{e\ 2226}#
+                                 #{nw\ 2237}#
+                                 #{s\ 2229}#
+                                 #{mod\ 2230}#)
+                               #{nr\ 2238}#
+                               #{nw\ 2237}#
+                               #{mod\ 2230}#))))))))
+          (lambda (#{e\ 2240}#
+                   #{r\ 2241}#
+                   #{w\ 2242}#
+                   #{s\ 2243}#
+                   #{mod\ 2244}#)
+            ((lambda (#{tmp\ 2245}#)
+               ((lambda (#{tmp\ 2246}#)
+                  (if (if #{tmp\ 2246}#
+                        (apply (lambda (#{_\ 2247}#
+                                        #{id\ 2248}#
+                                        #{val\ 2249}#
+                                        #{e1\ 2250}#
+                                        #{e2\ 2251}#)
+                                 (and-map #{id?\ 1297}# #{id\ 2248}#))
+                               #{tmp\ 2246}#)
+                        #f)
+                    (apply (lambda (#{_\ 2253}#
+                                    #{id\ 2254}#
+                                    #{val\ 2255}#
+                                    #{e1\ 2256}#
+                                    #{e2\ 2257}#)
+                             (#{chi-let\ 2225}#
+                               #{e\ 2240}#
+                               #{r\ 2241}#
+                               #{w\ 2242}#
+                               #{s\ 2243}#
+                               #{mod\ 2244}#
+                               #{build-let\ 1277}#
+                               #{id\ 2254}#
+                               #{val\ 2255}#
+                               (cons #{e1\ 2256}# #{e2\ 2257}#)))
+                           #{tmp\ 2246}#)
+                    ((lambda (#{tmp\ 2261}#)
+                       (if (if #{tmp\ 2261}#
+                             (apply (lambda (#{_\ 2262}#
+                                             #{f\ 2263}#
+                                             #{id\ 2264}#
+                                             #{val\ 2265}#
+                                             #{e1\ 2266}#
+                                             #{e2\ 2267}#)
+                                      (if (#{id?\ 1297}# #{f\ 2263}#)
+                                        (and-map #{id?\ 1297}# #{id\ 2264}#)
+                                        #f))
+                                    #{tmp\ 2261}#)
+                             #f)
+                         (apply (lambda (#{_\ 2269}#
+                                         #{f\ 2270}#
+                                         #{id\ 2271}#
+                                         #{val\ 2272}#
+                                         #{e1\ 2273}#
+                                         #{e2\ 2274}#)
+                                  (#{chi-let\ 2225}#
+                                    #{e\ 2240}#
+                                    #{r\ 2241}#
+                                    #{w\ 2242}#
+                                    #{s\ 2243}#
+                                    #{mod\ 2244}#
+                                    #{build-named-let\ 1278}#
+                                    (cons #{f\ 2270}# #{id\ 2271}#)
+                                    #{val\ 2272}#
+                                    (cons #{e1\ 2273}# #{e2\ 2274}#)))
+                                #{tmp\ 2261}#)
+                         ((lambda (#{_\ 2278}#)
+                            (syntax-violation
+                              'let
+                              "bad let"
+                              (#{source-wrap\ 1326}#
+                                #{e\ 2240}#
+                                #{w\ 2242}#
+                                #{s\ 2243}#
+                                #{mod\ 2244}#)))
+                          #{tmp\ 2245}#)))
+                     ($sc-dispatch
+                       #{tmp\ 2245}#
+                       '(any any #(each (any any)) any . each-any)))))
+                ($sc-dispatch
+                  #{tmp\ 2245}#
+                  '(any #(each (any any)) any . each-any))))
+             #{e\ 2240}#))))
+      (#{global-extend\ 1295}#
+        'core
+        'letrec
+        (lambda (#{e\ 2279}#
+                 #{r\ 2280}#
+                 #{w\ 2281}#
+                 #{s\ 2282}#
+                 #{mod\ 2283}#)
+          ((lambda (#{tmp\ 2284}#)
+             ((lambda (#{tmp\ 2285}#)
+                (if (if #{tmp\ 2285}#
+                      (apply (lambda (#{_\ 2286}#
+                                      #{id\ 2287}#
+                                      #{val\ 2288}#
+                                      #{e1\ 2289}#
+                                      #{e2\ 2290}#)
+                               (and-map #{id?\ 1297}# #{id\ 2287}#))
+                             #{tmp\ 2285}#)
+                      #f)
+                  (apply (lambda (#{_\ 2292}#
+                                  #{id\ 2293}#
+                                  #{val\ 2294}#
+                                  #{e1\ 2295}#
+                                  #{e2\ 2296}#)
+                           (let ((#{ids\ 2297}# #{id\ 2293}#))
+                             (if (not (#{valid-bound-ids?\ 1322}#
+                                        #{ids\ 2297}#))
+                               (syntax-violation
+                                 'letrec
+                                 "duplicate bound variable"
+                                 #{e\ 2279}#)
+                               (let ((#{labels\ 2299}#
+                                       (#{gen-labels\ 1303}# #{ids\ 2297}#))
+                                     (#{new-vars\ 2300}#
+                                       (map #{gen-var\ 1344}# #{ids\ 2297}#)))
+                                 (let ((#{w\ 2301}#
+                                         (#{make-binding-wrap\ 1314}#
+                                           #{ids\ 2297}#
+                                           #{labels\ 2299}#
+                                           #{w\ 2281}#))
+                                       (#{r\ 2302}#
+                                         (#{extend-var-env\ 1292}#
+                                           #{labels\ 2299}#
+                                           #{new-vars\ 2300}#
+                                           #{r\ 2280}#)))
+                                   (#{build-letrec\ 1279}#
+                                     #{s\ 2282}#
+                                     (map syntax->datum #{ids\ 2297}#)
+                                     #{new-vars\ 2300}#
+                                     (map (lambda (#{x\ 2303}#)
+                                            (#{chi\ 1333}#
+                                              #{x\ 2303}#
+                                              #{r\ 2302}#
+                                              #{w\ 2301}#
+                                              #{mod\ 2283}#))
+                                          #{val\ 2294}#)
+                                     (#{chi-body\ 1337}#
+                                       (cons #{e1\ 2295}# #{e2\ 2296}#)
+                                       (#{source-wrap\ 1326}#
+                                         #{e\ 2279}#
+                                         #{w\ 2301}#
+                                         #{s\ 2282}#
+                                         #{mod\ 2283}#)
+                                       #{r\ 2302}#
+                                       #{w\ 2301}#
+                                       #{mod\ 2283}#)))))))
+                         #{tmp\ 2285}#)
+                  ((lambda (#{_\ 2306}#)
+                     (syntax-violation
+                       'letrec
+                       "bad letrec"
+                       (#{source-wrap\ 1326}#
+                         #{e\ 2279}#
+                         #{w\ 2281}#
+                         #{s\ 2282}#
+                         #{mod\ 2283}#)))
+                   #{tmp\ 2284}#)))
+              ($sc-dispatch
+                #{tmp\ 2284}#
+                '(any #(each (any any)) any . each-any))))
+           #{e\ 2279}#)))
+      (#{global-extend\ 1295}#
+        'core
+        'set!
+        (lambda (#{e\ 2307}#
+                 #{r\ 2308}#
+                 #{w\ 2309}#
+                 #{s\ 2310}#
+                 #{mod\ 2311}#)
+          ((lambda (#{tmp\ 2312}#)
+             ((lambda (#{tmp\ 2313}#)
+                (if (if #{tmp\ 2313}#
+                      (apply (lambda (#{_\ 2314}# #{id\ 2315}# #{val\ 2316}#)
+                               (#{id?\ 1297}# #{id\ 2315}#))
+                             #{tmp\ 2313}#)
+                      #f)
+                  (apply (lambda (#{_\ 2317}# #{id\ 2318}# #{val\ 2319}#)
+                           (let ((#{val\ 2320}#
+                                   (#{chi\ 1333}#
+                                     #{val\ 2319}#
+                                     #{r\ 2308}#
+                                     #{w\ 2309}#
+                                     #{mod\ 2311}#))
+                                 (#{n\ 2321}#
+                                   (#{id-var-name\ 1319}#
+                                     #{id\ 2318}#
+                                     #{w\ 2309}#)))
+                             (let ((#{b\ 2322}#
+                                     (#{lookup\ 1294}#
+                                       #{n\ 2321}#
+                                       #{r\ 2308}#
+                                       #{mod\ 2311}#)))
+                               (let ((#{atom-key\ 2323}#
+                                       (#{binding-type\ 1289}# #{b\ 2322}#)))
+                                 (if (memv #{atom-key\ 2323}#
+                                           '(lexical))
+                                   (#{build-lexical-assignment\ 1267}#
+                                     #{s\ 2310}#
+                                     (syntax->datum #{id\ 2318}#)
+                                     (#{binding-value\ 1290}# #{b\ 2322}#)
+                                     #{val\ 2320}#)
+                                   (if (memv #{atom-key\ 2323}#
+                                             '(global))
+                                     (#{build-global-assignment\ 1270}#
+                                       #{s\ 2310}#
+                                       #{n\ 2321}#
+                                       #{val\ 2320}#
+                                       #{mod\ 2311}#)
+                                     (if (memv #{atom-key\ 2323}#
+                                               '(displaced-lexical))
+                                       (syntax-violation
+                                         'set!
+                                         "identifier out of context"
+                                         (#{wrap\ 1325}#
+                                           #{id\ 2318}#
+                                           #{w\ 2309}#
+                                           #{mod\ 2311}#))
+                                       (syntax-violation
+                                         'set!
+                                         "bad set!"
+                                         (#{source-wrap\ 1326}#
+                                           #{e\ 2307}#
+                                           #{w\ 2309}#
+                                           #{s\ 2310}#
+                                           #{mod\ 2311}#)))))))))
+                         #{tmp\ 2313}#)
+                  ((lambda (#{tmp\ 2324}#)
+                     (if #{tmp\ 2324}#
+                       (apply (lambda (#{_\ 2325}#
+                                       #{head\ 2326}#
+                                       #{tail\ 2327}#
+                                       #{val\ 2328}#)
+                                (call-with-values
+                                  (lambda ()
+                                    (#{syntax-type\ 1331}#
+                                      #{head\ 2326}#
+                                      #{r\ 2308}#
+                                      '(())
+                                      #f
+                                      #f
+                                      #{mod\ 2311}#
+                                      #t))
+                                  (lambda (#{type\ 2329}#
+                                           #{value\ 2330}#
+                                           #{ee\ 2331}#
+                                           #{ww\ 2332}#
+                                           #{ss\ 2333}#
+                                           #{modmod\ 2334}#)
+                                    (if (memv #{type\ 2329}#
+                                              '(module-ref))
+                                      (let ((#{val\ 2335}#
+                                              (#{chi\ 1333}#
+                                                #{val\ 2328}#
+                                                #{r\ 2308}#
+                                                #{w\ 2309}#
+                                                #{mod\ 2311}#)))
+                                        (call-with-values
+                                          (lambda ()
+                                            (#{value\ 2330}#
+                                              (cons #{head\ 2326}#
+                                                    #{tail\ 2327}#)))
+                                          (lambda (#{id\ 2337}# #{mod\ 2338}#)
+                                            (#{build-global-assignment\ 1270}#
+                                              #{s\ 2310}#
+                                              #{id\ 2337}#
+                                              #{val\ 2335}#
+                                              #{mod\ 2338}#))))
+                                      (#{build-application\ 1264}#
+                                        #{s\ 2310}#
+                                        (#{chi\ 1333}#
+                                          (list '#(syntax-object
+                                                   setter
+                                                   ((top)
+                                                    #(ribcage () () ())
+                                                    #(ribcage () () ())
+                                                    #(ribcage
+                                                      #(type
+                                                        value
+                                                        ee
+                                                        ww
+                                                        ss
+                                                        modmod)
+                                                      #((top)
+                                                        (top)
+                                                        (top)
+                                                        (top)
+                                                        (top)
+                                                        (top))
+                                                      #("i"
+                                                        "i"
+                                                        "i"
+                                                        "i"
+                                                        "i"
+                                                        "i"))
+                                                    #(ribcage
+                                                      #(_ head tail val)
+                                                      #((top)
+                                                        (top)
+                                                        (top)
+                                                        (top))
+                                                      #("i" "i" "i" "i"))
+                                                    #(ribcage () () ())
+                                                    #(ribcage
+                                                      #(e r w s mod)
+                                                      #((top)
+                                                        (top)
+                                                        (top)
+                                                        (top)
+                                                        (top))
+                                                      #("i" "i" "i" "i" "i"))
+                                                    #(ribcage
+                                                      (lambda-var-list
+                                                        gen-var
+                                                        strip
+                                                        ellipsis?
+                                                        chi-void
+                                                        eval-local-transformer
+                                                        chi-local-syntax
+                                                        chi-lambda-clause
+                                                        chi-body
+                                                        chi-macro
+                                                        chi-application
+                                                        chi-expr
+                                                        chi
+                                                        chi-top
+                                                        syntax-type
+                                                        chi-when-list
+                                                        chi-install-global
+                                                        chi-top-sequence
+                                                        chi-sequence
+                                                        source-wrap
+                                                        wrap
+                                                        bound-id-member?
+                                                        distinct-bound-ids?
+                                                        valid-bound-ids?
+                                                        bound-id=?
+                                                        free-id=?
+                                                        id-var-name
+                                                        same-marks?
+                                                        join-marks
+                                                        join-wraps
+                                                        smart-append
+                                                        make-binding-wrap
+                                                        extend-ribcage!
+                                                        make-empty-ribcage
+                                                        new-mark
+                                                        anti-mark
+                                                        the-anti-mark
+                                                        top-marked?
+                                                        top-wrap
+                                                        empty-wrap
+                                                        set-ribcage-labels!
+                                                        set-ribcage-marks!
+                                                        set-ribcage-symnames!
+                                                        ribcage-labels
+                                                        ribcage-marks
+                                                        ribcage-symnames
+                                                        ribcage?
+                                                        make-ribcage
+                                                        gen-labels
+                                                        gen-label
+                                                        make-rename
+                                                        rename-marks
+                                                        rename-new
+                                                        rename-old
+                                                        subst-rename?
+                                                        wrap-subst
+                                                        wrap-marks
+                                                        make-wrap
+                                                        id-sym-name&marks
+                                                        id-sym-name
+                                                        id?
+                                                        nonsymbol-id?
+                                                        global-extend
+                                                        lookup
+                                                        macros-only-env
+                                                        extend-var-env
+                                                        extend-env
+                                                        null-env
+                                                        binding-value
+                                                        binding-type
+                                                        make-binding
+                                                        arg-check
+                                                        source-annotation
+                                                        no-source
+                                                        set-syntax-object-module!
+                                                        set-syntax-object-wrap!
+                                                        set-syntax-object-expression!
+                                                        syntax-object-module
+                                                        syntax-object-wrap
+                                                        syntax-object-expression
+                                                        syntax-object?
+                                                        make-syntax-object
+                                                        build-lexical-var
+                                                        build-letrec
+                                                        build-named-let
+                                                        build-let
+                                                        build-sequence
+                                                        build-data
+                                                        build-primref
+                                                        build-lambda
+                                                        build-global-definition
+                                                        maybe-name-value!
+                                                        build-global-assignment
+                                                        build-global-reference
+                                                        analyze-variable
+                                                        build-lexical-assignment
+                                                        build-lexical-reference
+                                                        build-conditional
+                                                        build-application
+                                                        build-void
+                                                        decorate-source
+                                                        get-global-definition-hook
+                                                        put-global-definition-hook
+                                                        gensym-hook
+                                                        local-eval-hook
+                                                        top-level-eval-hook
+                                                        fx<
+                                                        fx=
+                                                        fx-
+                                                        fx+
+                                                        *mode*
+                                                        noexpand)
+                                                      ((top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top)
+                                                       (top))
+                                                      ("i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"))
+                                                    #(ribcage
+                                                      (define-structure
+                                                        and-map*)
+                                                      ((top) (top))
+                                                      ("i" "i")))
+                                                   (hygiene guile))
+                                                #{head\ 2326}#)
+                                          #{r\ 2308}#
+                                          #{w\ 2309}#
+                                          #{mod\ 2311}#)
+                                        (map (lambda (#{e\ 2339}#)
+                                               (#{chi\ 1333}#
+                                                 #{e\ 2339}#
+                                                 #{r\ 2308}#
+                                                 #{w\ 2309}#
+                                                 #{mod\ 2311}#))
+                                             (append
+                                               #{tail\ 2327}#
+                                               (list #{val\ 2328}#))))))))
+                              #{tmp\ 2324}#)
+                       ((lambda (#{_\ 2341}#)
+                          (syntax-violation
+                            'set!
+                            "bad set!"
+                            (#{source-wrap\ 1326}#
+                              #{e\ 2307}#
+                              #{w\ 2309}#
+                              #{s\ 2310}#
+                              #{mod\ 2311}#)))
+                        #{tmp\ 2312}#)))
+                   ($sc-dispatch
+                     #{tmp\ 2312}#
+                     '(any (any . each-any) any)))))
+              ($sc-dispatch
+                #{tmp\ 2312}#
+                '(any any any))))
+           #{e\ 2307}#)))
+      (#{global-extend\ 1295}#
+        'module-ref
+        '@
+        (lambda (#{e\ 2342}#)
+          ((lambda (#{tmp\ 2343}#)
+             ((lambda (#{tmp\ 2344}#)
+                (if (if #{tmp\ 2344}#
+                      (apply (lambda (#{_\ 2345}# #{mod\ 2346}# #{id\ 2347}#)
+                               (if (and-map #{id?\ 1297}# #{mod\ 2346}#)
+                                 (#{id?\ 1297}# #{id\ 2347}#)
+                                 #f))
+                             #{tmp\ 2344}#)
+                      #f)
+                  (apply (lambda (#{_\ 2349}# #{mod\ 2350}# #{id\ 2351}#)
+                           (values
+                             (syntax->datum #{id\ 2351}#)
+                             (syntax->datum
+                               (cons '#(syntax-object
+                                        public
+                                        ((top)
+                                         #(ribcage
+                                           #(_ mod id)
+                                           #((top) (top) (top))
+                                           #("i" "i" "i"))
+                                         #(ribcage () () ())
+                                         #(ribcage #(e) #((top)) #("i"))
+                                         #(ribcage
+                                           (lambda-var-list
+                                             gen-var
+                                             strip
+                                             ellipsis?
+                                             chi-void
+                                             eval-local-transformer
+                                             chi-local-syntax
+                                             chi-lambda-clause
+                                             chi-body
+                                             chi-macro
+                                             chi-application
+                                             chi-expr
+                                             chi
+                                             chi-top
+                                             syntax-type
+                                             chi-when-list
+                                             chi-install-global
+                                             chi-top-sequence
+                                             chi-sequence
+                                             source-wrap
+                                             wrap
+                                             bound-id-member?
+                                             distinct-bound-ids?
+                                             valid-bound-ids?
+                                             bound-id=?
+                                             free-id=?
+                                             id-var-name
+                                             same-marks?
+                                             join-marks
+                                             join-wraps
+                                             smart-append
+                                             make-binding-wrap
+                                             extend-ribcage!
+                                             make-empty-ribcage
+                                             new-mark
+                                             anti-mark
+                                             the-anti-mark
+                                             top-marked?
+                                             top-wrap
+                                             empty-wrap
+                                             set-ribcage-labels!
+                                             set-ribcage-marks!
+                                             set-ribcage-symnames!
+                                             ribcage-labels
+                                             ribcage-marks
+                                             ribcage-symnames
+                                             ribcage?
+                                             make-ribcage
+                                             gen-labels
+                                             gen-label
+                                             make-rename
+                                             rename-marks
+                                             rename-new
+                                             rename-old
+                                             subst-rename?
+                                             wrap-subst
+                                             wrap-marks
+                                             make-wrap
+                                             id-sym-name&marks
+                                             id-sym-name
+                                             id?
+                                             nonsymbol-id?
+                                             global-extend
+                                             lookup
+                                             macros-only-env
+                                             extend-var-env
+                                             extend-env
+                                             null-env
+                                             binding-value
+                                             binding-type
+                                             make-binding
+                                             arg-check
+                                             source-annotation
+                                             no-source
+                                             set-syntax-object-module!
+                                             set-syntax-object-wrap!
+                                             set-syntax-object-expression!
+                                             syntax-object-module
+                                             syntax-object-wrap
+                                             syntax-object-expression
+                                             syntax-object?
+                                             make-syntax-object
+                                             build-lexical-var
+                                             build-letrec
+                                             build-named-let
+                                             build-let
+                                             build-sequence
+                                             build-data
+                                             build-primref
+                                             build-lambda
+                                             build-global-definition
+                                             maybe-name-value!
+                                             build-global-assignment
+                                             build-global-reference
+                                             analyze-variable
+                                             build-lexical-assignment
+                                             build-lexical-reference
+                                             build-conditional
+                                             build-application
+                                             build-void
+                                             decorate-source
+                                             get-global-definition-hook
+                                             put-global-definition-hook
+                                             gensym-hook
+                                             local-eval-hook
+                                             top-level-eval-hook
+                                             fx<
+                                             fx=
+                                             fx-
+                                             fx+
+                                             *mode*
+                                             noexpand)
+                                           ((top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top))
+                                           ("i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"))
+                                         #(ribcage
+                                           (define-structure and-map*)
+                                           ((top) (top))
+                                           ("i" "i")))
+                                        (hygiene guile))
+                                     #{mod\ 2350}#))))
+                         #{tmp\ 2344}#)
+                  (syntax-violation
+                    #f
+                    "source expression failed to match any pattern"
+                    #{tmp\ 2343}#)))
+              ($sc-dispatch
+                #{tmp\ 2343}#
+                '(any each-any any))))
+           #{e\ 2342}#)))
+      (#{global-extend\ 1295}#
+        'module-ref
+        '@@
+        (lambda (#{e\ 2353}#)
+          ((lambda (#{tmp\ 2354}#)
+             ((lambda (#{tmp\ 2355}#)
+                (if (if #{tmp\ 2355}#
+                      (apply (lambda (#{_\ 2356}# #{mod\ 2357}# #{id\ 2358}#)
+                               (if (and-map #{id?\ 1297}# #{mod\ 2357}#)
+                                 (#{id?\ 1297}# #{id\ 2358}#)
+                                 #f))
+                             #{tmp\ 2355}#)
+                      #f)
+                  (apply (lambda (#{_\ 2360}# #{mod\ 2361}# #{id\ 2362}#)
+                           (values
+                             (syntax->datum #{id\ 2362}#)
+                             (syntax->datum
+                               (cons '#(syntax-object
+                                        private
+                                        ((top)
+                                         #(ribcage
+                                           #(_ mod id)
+                                           #((top) (top) (top))
+                                           #("i" "i" "i"))
+                                         #(ribcage () () ())
+                                         #(ribcage #(e) #((top)) #("i"))
+                                         #(ribcage
+                                           (lambda-var-list
+                                             gen-var
+                                             strip
+                                             ellipsis?
+                                             chi-void
+                                             eval-local-transformer
+                                             chi-local-syntax
+                                             chi-lambda-clause
+                                             chi-body
+                                             chi-macro
+                                             chi-application
+                                             chi-expr
+                                             chi
+                                             chi-top
+                                             syntax-type
+                                             chi-when-list
+                                             chi-install-global
+                                             chi-top-sequence
+                                             chi-sequence
+                                             source-wrap
+                                             wrap
+                                             bound-id-member?
+                                             distinct-bound-ids?
+                                             valid-bound-ids?
+                                             bound-id=?
+                                             free-id=?
+                                             id-var-name
+                                             same-marks?
+                                             join-marks
+                                             join-wraps
+                                             smart-append
+                                             make-binding-wrap
+                                             extend-ribcage!
+                                             make-empty-ribcage
+                                             new-mark
+                                             anti-mark
+                                             the-anti-mark
+                                             top-marked?
+                                             top-wrap
+                                             empty-wrap
+                                             set-ribcage-labels!
+                                             set-ribcage-marks!
+                                             set-ribcage-symnames!
+                                             ribcage-labels
+                                             ribcage-marks
+                                             ribcage-symnames
+                                             ribcage?
+                                             make-ribcage
+                                             gen-labels
+                                             gen-label
+                                             make-rename
+                                             rename-marks
+                                             rename-new
+                                             rename-old
+                                             subst-rename?
+                                             wrap-subst
+                                             wrap-marks
+                                             make-wrap
+                                             id-sym-name&marks
+                                             id-sym-name
+                                             id?
+                                             nonsymbol-id?
+                                             global-extend
+                                             lookup
+                                             macros-only-env
+                                             extend-var-env
+                                             extend-env
+                                             null-env
+                                             binding-value
+                                             binding-type
+                                             make-binding
+                                             arg-check
+                                             source-annotation
+                                             no-source
+                                             set-syntax-object-module!
+                                             set-syntax-object-wrap!
+                                             set-syntax-object-expression!
+                                             syntax-object-module
+                                             syntax-object-wrap
+                                             syntax-object-expression
+                                             syntax-object?
+                                             make-syntax-object
+                                             build-lexical-var
+                                             build-letrec
+                                             build-named-let
+                                             build-let
+                                             build-sequence
+                                             build-data
+                                             build-primref
+                                             build-lambda
+                                             build-global-definition
+                                             maybe-name-value!
+                                             build-global-assignment
+                                             build-global-reference
+                                             analyze-variable
+                                             build-lexical-assignment
+                                             build-lexical-reference
+                                             build-conditional
+                                             build-application
+                                             build-void
+                                             decorate-source
+                                             get-global-definition-hook
+                                             put-global-definition-hook
+                                             gensym-hook
+                                             local-eval-hook
+                                             top-level-eval-hook
+                                             fx<
+                                             fx=
+                                             fx-
+                                             fx+
+                                             *mode*
+                                             noexpand)
+                                           ((top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top))
+                                           ("i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"))
+                                         #(ribcage
+                                           (define-structure and-map*)
+                                           ((top) (top))
+                                           ("i" "i")))
+                                        (hygiene guile))
+                                     #{mod\ 2361}#))))
+                         #{tmp\ 2355}#)
+                  (syntax-violation
+                    #f
+                    "source expression failed to match any pattern"
+                    #{tmp\ 2354}#)))
+              ($sc-dispatch
+                #{tmp\ 2354}#
+                '(any each-any any))))
+           #{e\ 2353}#)))
+      (#{global-extend\ 1295}#
+        'core
+        'if
+        (lambda (#{e\ 2364}#
+                 #{r\ 2365}#
+                 #{w\ 2366}#
+                 #{s\ 2367}#
+                 #{mod\ 2368}#)
+          ((lambda (#{tmp\ 2369}#)
+             ((lambda (#{tmp\ 2370}#)
+                (if #{tmp\ 2370}#
+                  (apply (lambda (#{_\ 2371}# #{test\ 2372}# #{then\ 2373}#)
+                           (#{build-conditional\ 1265}#
+                             #{s\ 2367}#
+                             (#{chi\ 1333}#
+                               #{test\ 2372}#
+                               #{r\ 2365}#
+                               #{w\ 2366}#
+                               #{mod\ 2368}#)
+                             (#{chi\ 1333}#
+                               #{then\ 2373}#
+                               #{r\ 2365}#
+                               #{w\ 2366}#
+                               #{mod\ 2368}#)
+                             (#{build-void\ 1263}# #f)))
+                         #{tmp\ 2370}#)
+                  ((lambda (#{tmp\ 2374}#)
+                     (if #{tmp\ 2374}#
+                       (apply (lambda (#{_\ 2375}#
+                                       #{test\ 2376}#
+                                       #{then\ 2377}#
+                                       #{else\ 2378}#)
+                                (#{build-conditional\ 1265}#
+                                  #{s\ 2367}#
+                                  (#{chi\ 1333}#
+                                    #{test\ 2376}#
+                                    #{r\ 2365}#
+                                    #{w\ 2366}#
+                                    #{mod\ 2368}#)
+                                  (#{chi\ 1333}#
+                                    #{then\ 2377}#
+                                    #{r\ 2365}#
+                                    #{w\ 2366}#
+                                    #{mod\ 2368}#)
+                                  (#{chi\ 1333}#
+                                    #{else\ 2378}#
+                                    #{r\ 2365}#
+                                    #{w\ 2366}#
+                                    #{mod\ 2368}#)))
+                              #{tmp\ 2374}#)
+                       (syntax-violation
+                         #f
+                         "source expression failed to match any pattern"
+                         #{tmp\ 2369}#)))
+                   ($sc-dispatch
+                     #{tmp\ 2369}#
+                     '(any any any any)))))
+              ($sc-dispatch
+                #{tmp\ 2369}#
+                '(any any any))))
+           #{e\ 2364}#)))
+      (#{global-extend\ 1295}#
+        'begin
+        'begin
+        '())
+      (#{global-extend\ 1295}#
+        'define
+        'define
+        '())
+      (#{global-extend\ 1295}#
+        'define-syntax
+        'define-syntax
+        '())
+      (#{global-extend\ 1295}#
+        'eval-when
+        'eval-when
+        '())
+      (#{global-extend\ 1295}#
+        'core
+        'syntax-case
+        (letrec ((#{gen-syntax-case\ 2382}#
+                   (lambda (#{x\ 2383}#
+                            #{keys\ 2384}#
+                            #{clauses\ 2385}#
+                            #{r\ 2386}#
+                            #{mod\ 2387}#)
+                     (if (null? #{clauses\ 2385}#)
+                       (#{build-application\ 1264}#
+                         #f
+                         (#{build-primref\ 1274}#
+                           #f
+                           'syntax-violation)
+                         (list (#{build-data\ 1275}# #f #f)
+                               (#{build-data\ 1275}#
+                                 #f
+                                 "source expression failed to match any pattern")
+                               #{x\ 2383}#))
+                       ((lambda (#{tmp\ 2388}#)
+                          ((lambda (#{tmp\ 2389}#)
+                             (if #{tmp\ 2389}#
+                               (apply (lambda (#{pat\ 2390}# #{exp\ 2391}#)
+                                        (if (if (#{id?\ 1297}# #{pat\ 2390}#)
+                                              (and-map
+                                                (lambda (#{x\ 2392}#)
+                                                  (not (#{free-id=?\ 1320}#
+                                                         #{pat\ 2390}#
+                                                         #{x\ 2392}#)))
+                                                (cons '#(syntax-object
+                                                         ...
+                                                         ((top)
+                                                          #(ribcage
+                                                            #(pat exp)
+                                                            #((top) (top))
+                                                            #("i" "i"))
+                                                          #(ribcage () () ())
+                                                          #(ribcage
+                                                            #(x
+                                                              keys
+                                                              clauses
+                                                              r
+                                                              mod)
+                                                            #((top)
+                                                              (top)
+                                                              (top)
+                                                              (top)
+                                                              (top))
+                                                            #("i"
+                                                              "i"
+                                                              "i"
+                                                              "i"
+                                                              "i"))
+                                                          #(ribcage
+                                                            (gen-syntax-case
+                                                              gen-clause
+                                                              build-dispatch-call
+                                                              convert-pattern)
+                                                            ((top)
+                                                             (top)
+                                                             (top)
+                                                             (top))
+                                                            ("i" "i" "i" "i"))
+                                                          #(ribcage
+                                                            (lambda-var-list
+                                                              gen-var
+                                                              strip
+                                                              ellipsis?
+                                                              chi-void
+                                                              eval-local-transformer
+                                                              chi-local-syntax
+                                                              chi-lambda-clause
+                                                              chi-body
+                                                              chi-macro
+                                                              chi-application
+                                                              chi-expr
+                                                              chi
+                                                              chi-top
+                                                              syntax-type
+                                                              chi-when-list
+                                                              chi-install-global
+                                                              chi-top-sequence
+                                                              chi-sequence
+                                                              source-wrap
+                                                              wrap
+                                                              bound-id-member?
+                                                              distinct-bound-ids?
+                                                              valid-bound-ids?
+                                                              bound-id=?
+                                                              free-id=?
+                                                              id-var-name
+                                                              same-marks?
+                                                              join-marks
+                                                              join-wraps
+                                                              smart-append
+                                                              make-binding-wrap
+                                                              extend-ribcage!
+                                                              make-empty-ribcage
+                                                              new-mark
+                                                              anti-mark
+                                                              the-anti-mark
+                                                              top-marked?
+                                                              top-wrap
+                                                              empty-wrap
+                                                              set-ribcage-labels!
+                                                              set-ribcage-marks!
+                                                              set-ribcage-symnames!
+                                                              ribcage-labels
+                                                              ribcage-marks
+                                                              ribcage-symnames
+                                                              ribcage?
+                                                              make-ribcage
+                                                              gen-labels
+                                                              gen-label
+                                                              make-rename
+                                                              rename-marks
+                                                              rename-new
+                                                              rename-old
+                                                              subst-rename?
+                                                              wrap-subst
+                                                              wrap-marks
+                                                              make-wrap
+                                                              id-sym-name&marks
+                                                              id-sym-name
+                                                              id?
+                                                              nonsymbol-id?
+                                                              global-extend
+                                                              lookup
+                                                              macros-only-env
+                                                              extend-var-env
+                                                              extend-env
+                                                              null-env
+                                                              binding-value
+                                                              binding-type
+                                                              make-binding
+                                                              arg-check
+                                                              source-annotation
+                                                              no-source
+                                                              set-syntax-object-module!
+                                                              set-syntax-object-wrap!
+                                                              set-syntax-object-expression!
+                                                              syntax-object-module
+                                                              syntax-object-wrap
+                                                              syntax-object-expression
+                                                              syntax-object?
+                                                              make-syntax-object
+                                                              build-lexical-var
+                                                              build-letrec
+                                                              build-named-let
+                                                              build-let
+                                                              build-sequence
+                                                              build-data
+                                                              build-primref
+                                                              build-lambda
+                                                              build-global-definition
+                                                              maybe-name-value!
+                                                              build-global-assignment
+                                                              build-global-reference
+                                                              analyze-variable
+                                                              build-lexical-assignment
+                                                              build-lexical-reference
+                                                              build-conditional
+                                                              build-application
+                                                              build-void
+                                                              decorate-source
+                                                              get-global-definition-hook
+                                                              put-global-definition-hook
+                                                              gensym-hook
+                                                              local-eval-hook
+                                                              top-level-eval-hook
+                                                              fx<
+                                                              fx=
+                                                              fx-
+                                                              fx+
+                                                              *mode*
+                                                              noexpand)
+                                                            ((top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top))
+                                                            ("i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"))
+                                                          #(ribcage
+                                                            (define-structure
+                                                              and-map*)
+                                                            ((top) (top))
+                                                            ("i" "i")))
+                                                         (hygiene guile))
+                                                      #{keys\ 2384}#))
+                                              #f)
+                                          (let ((#{labels\ 2393}#
+                                                  (list (#{gen-label\ 1302}#)))
+                                                (#{var\ 2394}#
+                                                  (#{gen-var\ 1344}#
+                                                    #{pat\ 2390}#)))
+                                            (#{build-application\ 1264}#
+                                              #f
+                                              (#{build-lambda\ 1273}#
+                                                #f
+                                                (list (syntax->datum
+                                                        #{pat\ 2390}#))
+                                                (list #{var\ 2394}#)
+                                                #f
+                                                (#{chi\ 1333}#
+                                                  #{exp\ 2391}#
+                                                  (#{extend-env\ 1291}#
+                                                    #{labels\ 2393}#
+                                                    (list (cons 'syntax
+                                                                (cons #{var\ 2394}#
+                                                                      0)))
+                                                    #{r\ 2386}#)
+                                                  (#{make-binding-wrap\ 1314}#
+                                                    (list #{pat\ 2390}#)
+                                                    #{labels\ 2393}#
+                                                    '(()))
+                                                  #{mod\ 2387}#))
+                                              (list #{x\ 2383}#)))
+                                          (#{gen-clause\ 2381}#
+                                            #{x\ 2383}#
+                                            #{keys\ 2384}#
+                                            (cdr #{clauses\ 2385}#)
+                                            #{r\ 2386}#
+                                            #{pat\ 2390}#
+                                            #t
+                                            #{exp\ 2391}#
+                                            #{mod\ 2387}#)))
+                                      #{tmp\ 2389}#)
+                               ((lambda (#{tmp\ 2395}#)
+                                  (if #{tmp\ 2395}#
+                                    (apply (lambda (#{pat\ 2396}#
+                                                    #{fender\ 2397}#
+                                                    #{exp\ 2398}#)
+                                             (#{gen-clause\ 2381}#
+                                               #{x\ 2383}#
+                                               #{keys\ 2384}#
+                                               (cdr #{clauses\ 2385}#)
+                                               #{r\ 2386}#
+                                               #{pat\ 2396}#
+                                               #{fender\ 2397}#
+                                               #{exp\ 2398}#
+                                               #{mod\ 2387}#))
+                                           #{tmp\ 2395}#)
+                                    ((lambda (#{_\ 2399}#)
+                                       (syntax-violation
+                                         'syntax-case
+                                         "invalid clause"
+                                         (car #{clauses\ 2385}#)))
+                                     #{tmp\ 2388}#)))
+                                ($sc-dispatch
+                                  #{tmp\ 2388}#
+                                  '(any any any)))))
+                           ($sc-dispatch #{tmp\ 2388}# (quote (any any)))))
+                        (car #{clauses\ 2385}#)))))
+                 (#{gen-clause\ 2381}#
+                   (lambda (#{x\ 2400}#
+                            #{keys\ 2401}#
+                            #{clauses\ 2402}#
+                            #{r\ 2403}#
+                            #{pat\ 2404}#
+                            #{fender\ 2405}#
+                            #{exp\ 2406}#
+                            #{mod\ 2407}#)
+                     (call-with-values
+                       (lambda ()
+                         (#{convert-pattern\ 2379}#
+                           #{pat\ 2404}#
+                           #{keys\ 2401}#))
+                       (lambda (#{p\ 2408}# #{pvars\ 2409}#)
+                         (if (not (#{distinct-bound-ids?\ 1323}#
+                                    (map car #{pvars\ 2409}#)))
+                           (syntax-violation
+                             'syntax-case
+                             "duplicate pattern variable"
+                             #{pat\ 2404}#)
+                           (if (not (and-map
+                                      (lambda (#{x\ 2410}#)
+                                        (not (#{ellipsis?\ 1342}#
+                                               (car #{x\ 2410}#))))
+                                      #{pvars\ 2409}#))
+                             (syntax-violation
+                               'syntax-case
+                               "misplaced ellipsis"
+                               #{pat\ 2404}#)
+                             (let ((#{y\ 2411}#
+                                     (#{gen-var\ 1344}# (quote tmp))))
+                               (#{build-application\ 1264}#
+                                 #f
+                                 (#{build-lambda\ 1273}#
+                                   #f
+                                   (list (quote tmp))
+                                   (list #{y\ 2411}#)
+                                   #f
+                                   (let ((#{y\ 2412}#
+                                           (#{build-lexical-reference\ 1266}#
+                                             'value
+                                             #f
+                                             'tmp
+                                             #{y\ 2411}#)))
+                                     (#{build-conditional\ 1265}#
+                                       #f
+                                       ((lambda (#{tmp\ 2413}#)
+                                          ((lambda (#{tmp\ 2414}#)
+                                             (if #{tmp\ 2414}#
+                                               (apply (lambda () #{y\ 2412}#)
+                                                      #{tmp\ 2414}#)
+                                               ((lambda (#{_\ 2415}#)
+                                                  (#{build-conditional\ 1265}#
+                                                    #f
+                                                    #{y\ 2412}#
+                                                    (#{build-dispatch-call\ 2380}#
+                                                      #{pvars\ 2409}#
+                                                      #{fender\ 2405}#
+                                                      #{y\ 2412}#
+                                                      #{r\ 2403}#
+                                                      #{mod\ 2407}#)
+                                                    (#{build-data\ 1275}#
+                                                      #f
+                                                      #f)))
+                                                #{tmp\ 2413}#)))
+                                           ($sc-dispatch
+                                             #{tmp\ 2413}#
+                                             '#(atom #t))))
+                                        #{fender\ 2405}#)
+                                       (#{build-dispatch-call\ 2380}#
+                                         #{pvars\ 2409}#
+                                         #{exp\ 2406}#
+                                         #{y\ 2412}#
+                                         #{r\ 2403}#
+                                         #{mod\ 2407}#)
+                                       (#{gen-syntax-case\ 2382}#
+                                         #{x\ 2400}#
+                                         #{keys\ 2401}#
+                                         #{clauses\ 2402}#
+                                         #{r\ 2403}#
+                                         #{mod\ 2407}#))))
+                                 (list (if (eq? #{p\ 2408}# (quote any))
+                                         (#{build-application\ 1264}#
+                                           #f
+                                           (#{build-primref\ 1274}#
+                                             #f
+                                             'list)
+                                           (list #{x\ 2400}#))
+                                         (#{build-application\ 1264}#
+                                           #f
+                                           (#{build-primref\ 1274}#
+                                             #f
+                                             '$sc-dispatch)
+                                           (list #{x\ 2400}#
+                                                 (#{build-data\ 1275}#
+                                                   #f
+                                                   #{p\ 2408}#)))))))))))))
+                 (#{build-dispatch-call\ 2380}#
+                   (lambda (#{pvars\ 2416}#
+                            #{exp\ 2417}#
+                            #{y\ 2418}#
+                            #{r\ 2419}#
+                            #{mod\ 2420}#)
+                     (let ((#{ids\ 2421}# (map car #{pvars\ 2416}#))
+                           (#{levels\ 2422}# (map cdr #{pvars\ 2416}#)))
+                       (let ((#{labels\ 2423}#
+                               (#{gen-labels\ 1303}# #{ids\ 2421}#))
+                             (#{new-vars\ 2424}#
+                               (map #{gen-var\ 1344}# #{ids\ 2421}#)))
+                         (#{build-application\ 1264}#
+                           #f
+                           (#{build-primref\ 1274}# #f (quote apply))
+                           (list (#{build-lambda\ 1273}#
+                                   #f
+                                   (map syntax->datum #{ids\ 2421}#)
+                                   #{new-vars\ 2424}#
+                                   #f
+                                   (#{chi\ 1333}#
+                                     #{exp\ 2417}#
+                                     (#{extend-env\ 1291}#
+                                       #{labels\ 2423}#
+                                       (map (lambda (#{var\ 2425}#
+                                                     #{level\ 2426}#)
+                                              (cons 'syntax
+                                                    (cons #{var\ 2425}#
+                                                          #{level\ 2426}#)))
+                                            #{new-vars\ 2424}#
+                                            (map cdr #{pvars\ 2416}#))
+                                       #{r\ 2419}#)
+                                     (#{make-binding-wrap\ 1314}#
+                                       #{ids\ 2421}#
+                                       #{labels\ 2423}#
+                                       '(()))
+                                     #{mod\ 2420}#))
+                                 #{y\ 2418}#))))))
+                 (#{convert-pattern\ 2379}#
+                   (lambda (#{pattern\ 2427}# #{keys\ 2428}#)
+                     (letrec ((#{cvt\ 2429}#
+                                (lambda (#{p\ 2430}# #{n\ 2431}# #{ids\ 2432}#)
+                                  (if (#{id?\ 1297}# #{p\ 2430}#)
+                                    (if (#{bound-id-member?\ 1324}#
+                                          #{p\ 2430}#
+                                          #{keys\ 2428}#)
+                                      (values
+                                        (vector (quote free-id) #{p\ 2430}#)
+                                        #{ids\ 2432}#)
+                                      (values
+                                        'any
+                                        (cons (cons #{p\ 2430}# #{n\ 2431}#)
+                                              #{ids\ 2432}#)))
+                                    ((lambda (#{tmp\ 2433}#)
+                                       ((lambda (#{tmp\ 2434}#)
+                                          (if (if #{tmp\ 2434}#
+                                                (apply (lambda (#{x\ 2435}#
+                                                                #{dots\ 2436}#)
+                                                         (#{ellipsis?\ 1342}#
+                                                           #{dots\ 2436}#))
+                                                       #{tmp\ 2434}#)
+                                                #f)
+                                            (apply (lambda (#{x\ 2437}#
+                                                            #{dots\ 2438}#)
+                                                     (call-with-values
+                                                       (lambda ()
+                                                         (#{cvt\ 2429}#
+                                                           #{x\ 2437}#
+                                                           (#{fx+\ 1254}#
+                                                             #{n\ 2431}#
+                                                             1)
+                                                           #{ids\ 2432}#))
+                                                       (lambda (#{p\ 2439}#
+                                                                #{ids\ 2440}#)
+                                                         (values
+                                                           (if (eq? #{p\ 2439}#
+                                                                    'any)
+                                                             'each-any
+                                                             (vector
+                                                               'each
+                                                               #{p\ 2439}#))
+                                                           #{ids\ 2440}#))))
+                                                   #{tmp\ 2434}#)
+                                            ((lambda (#{tmp\ 2441}#)
+                                               (if #{tmp\ 2441}#
+                                                 (apply (lambda (#{x\ 2442}#
+                                                                 #{y\ 2443}#)
+                                                          (call-with-values
+                                                            (lambda ()
+                                                              (#{cvt\ 2429}#
+                                                                #{y\ 2443}#
+                                                                #{n\ 2431}#
+                                                                #{ids\ 2432}#))
+                                                            (lambda (#{y\ 2444}#
+                                                                     #{ids\ 2445}#)
+                                                              (call-with-values
+                                                                (lambda ()
+                                                                  (#{cvt\ 2429}#
+                                                                    #{x\ 2442}#
+                                                                    #{n\ 2431}#
+                                                                    #{ids\ 2445}#))
+                                                                (lambda (#{x\ 2446}#
+                                                                         #{ids\ 2447}#)
+                                                                  (values
+                                                                    (cons #{x\ 2446}#
+                                                                          #{y\ 2444}#)
+                                                                    #{ids\ 2447}#))))))
+                                                        #{tmp\ 2441}#)
+                                                 ((lambda (#{tmp\ 2448}#)
+                                                    (if #{tmp\ 2448}#
+                                                      (apply (lambda ()
+                                                               (values
+                                                                 '()
+                                                                 #{ids\ 2432}#))
+                                                             #{tmp\ 2448}#)
+                                                      ((lambda (#{tmp\ 2449}#)
+                                                         (if #{tmp\ 2449}#
+                                                           (apply (lambda (#{x\ 2450}#)
+                                                                    (call-with-values
+                                                                      (lambda ()
+                                                                        (#{cvt\ 2429}#
+                                                                          #{x\ 2450}#
+                                                                          #{n\ 2431}#
+                                                                          #{ids\ 2432}#))
+                                                                      (lambda (#{p\ 2452}#
+                                                                               #{ids\ 2453}#)
+                                                                        (values
+                                                                          (vector
+                                                                            'vector
+                                                                            #{p\ 2452}#)
+                                                                          #{ids\ 2453}#))))
+                                                                  #{tmp\ 2449}#)
+                                                           ((lambda (#{x\ 2454}#)
+                                                              (values
+                                                                (vector
+                                                                  'atom
+                                                                  (#{strip\ 1343}#
+                                                                    #{p\ 2430}#
+                                                                    '(())))
+                                                                #{ids\ 2432}#))
+                                                            #{tmp\ 2433}#)))
+                                                       ($sc-dispatch
+                                                         #{tmp\ 2433}#
+                                                         '#(vector
+                                                            each-any)))))
+                                                  ($sc-dispatch
+                                                    #{tmp\ 2433}#
+                                                    '()))))
+                                             ($sc-dispatch
+                                               #{tmp\ 2433}#
+                                               '(any . any)))))
+                                        ($sc-dispatch
+                                          #{tmp\ 2433}#
+                                          '(any any))))
+                                     #{p\ 2430}#)))))
+                       (#{cvt\ 2429}# #{pattern\ 2427}# 0 (quote ()))))))
+          (lambda (#{e\ 2455}#
+                   #{r\ 2456}#
+                   #{w\ 2457}#
+                   #{s\ 2458}#
+                   #{mod\ 2459}#)
+            (let ((#{e\ 2460}#
+                    (#{source-wrap\ 1326}#
+                      #{e\ 2455}#
+                      #{w\ 2457}#
+                      #{s\ 2458}#
+                      #{mod\ 2459}#)))
+              ((lambda (#{tmp\ 2461}#)
+                 ((lambda (#{tmp\ 2462}#)
+                    (if #{tmp\ 2462}#
+                      (apply (lambda (#{_\ 2463}#
+                                      #{val\ 2464}#
+                                      #{key\ 2465}#
+                                      #{m\ 2466}#)
+                               (if (and-map
+                                     (lambda (#{x\ 2467}#)
+                                       (if (#{id?\ 1297}# #{x\ 2467}#)
+                                         (not (#{ellipsis?\ 1342}#
+                                                #{x\ 2467}#))
+                                         #f))
+                                     #{key\ 2465}#)
+                                 (let ((#{x\ 2469}#
+                                         (#{gen-var\ 1344}# (quote tmp))))
+                                   (#{build-application\ 1264}#
+                                     #{s\ 2458}#
+                                     (#{build-lambda\ 1273}#
+                                       #f
+                                       (list (quote tmp))
+                                       (list #{x\ 2469}#)
+                                       #f
+                                       (#{gen-syntax-case\ 2382}#
+                                         (#{build-lexical-reference\ 1266}#
+                                           'value
+                                           #f
+                                           'tmp
+                                           #{x\ 2469}#)
+                                         #{key\ 2465}#
+                                         #{m\ 2466}#
+                                         #{r\ 2456}#
+                                         #{mod\ 2459}#))
+                                     (list (#{chi\ 1333}#
+                                             #{val\ 2464}#
+                                             #{r\ 2456}#
+                                             '(())
+                                             #{mod\ 2459}#))))
+                                 (syntax-violation
+                                   'syntax-case
+                                   "invalid literals list"
+                                   #{e\ 2460}#)))
+                             #{tmp\ 2462}#)
+                      (syntax-violation
+                        #f
+                        "source expression failed to match any pattern"
+                        #{tmp\ 2461}#)))
+                  ($sc-dispatch
+                    #{tmp\ 2461}#
+                    '(any any each-any . each-any))))
+               #{e\ 2460}#)))))
+      (set! sc-expand
+        (lambda (#{x\ 2473}# . #{rest\ 2472}#)
+          (if (if (pair? #{x\ 2473}#)
+                (equal? (car #{x\ 2473}#) #{noexpand\ 1252}#)
+                #f)
+            (cadr #{x\ 2473}#)
+            (let ((#{m\ 2474}#
+                    (if (null? #{rest\ 2472}#)
+                      'e
+                      (car #{rest\ 2472}#)))
+                  (#{esew\ 2475}#
+                    (if (let ((#{t\ 2476}# (null? #{rest\ 2472}#)))
+                          (if #{t\ 2476}#
+                            #{t\ 2476}#
+                            (null? (cdr #{rest\ 2472}#))))
+                      '(eval)
+                      (cadr #{rest\ 2472}#))))
+              (with-fluid*
+                #{*mode*\ 1253}#
+                #{m\ 2474}#
+                (lambda ()
+                  (#{chi-top\ 1332}#
+                    #{x\ 2473}#
+                    '()
+                    '((top))
+                    #{m\ 2474}#
+                    #{esew\ 2475}#
+                    (cons 'hygiene
+                          (module-name (current-module))))))))))
+      (set! identifier?
+        (lambda (#{x\ 2477}#)
+          (#{nonsymbol-id?\ 1296}# #{x\ 2477}#)))
+      (set! datum->syntax
+        (lambda (#{id\ 2478}# #{datum\ 2479}#)
+          (#{make-syntax-object\ 1280}#
+            #{datum\ 2479}#
+            (#{syntax-object-wrap\ 1283}# #{id\ 2478}#)
+            #f)))
+      (set! syntax->datum
+        (lambda (#{x\ 2480}#)
+          (#{strip\ 1343}# #{x\ 2480}# (quote (())))))
+      (set! generate-temporaries
+        (lambda (#{ls\ 2481}#)
+          (begin
+            (let ((#{x\ 2482}# #{ls\ 2481}#))
+              (if (not (list? #{x\ 2482}#))
+                (syntax-violation
+                  'generate-temporaries
+                  "invalid argument"
+                  #{x\ 2482}#)))
+            (map (lambda (#{x\ 2483}#)
+                   (#{wrap\ 1325}# (gensym) (quote ((top))) #f))
+                 #{ls\ 2481}#))))
+      (set! free-identifier=?
+        (lambda (#{x\ 2484}# #{y\ 2485}#)
+          (begin
+            (let ((#{x\ 2486}# #{x\ 2484}#))
+              (if (not (#{nonsymbol-id?\ 1296}# #{x\ 2486}#))
+                (syntax-violation
+                  'free-identifier=?
+                  "invalid argument"
+                  #{x\ 2486}#)))
+            (let ((#{x\ 2487}# #{y\ 2485}#))
+              (if (not (#{nonsymbol-id?\ 1296}# #{x\ 2487}#))
+                (syntax-violation
+                  'free-identifier=?
+                  "invalid argument"
+                  #{x\ 2487}#)))
+            (#{free-id=?\ 1320}# #{x\ 2484}# #{y\ 2485}#))))
+      (set! bound-identifier=?
+        (lambda (#{x\ 2488}# #{y\ 2489}#)
+          (begin
+            (let ((#{x\ 2490}# #{x\ 2488}#))
+              (if (not (#{nonsymbol-id?\ 1296}# #{x\ 2490}#))
+                (syntax-violation
+                  'bound-identifier=?
+                  "invalid argument"
+                  #{x\ 2490}#)))
+            (let ((#{x\ 2491}# #{y\ 2489}#))
+              (if (not (#{nonsymbol-id?\ 1296}# #{x\ 2491}#))
+                (syntax-violation
+                  'bound-identifier=?
+                  "invalid argument"
+                  #{x\ 2491}#)))
+            (#{bound-id=?\ 1321}# #{x\ 2488}# #{y\ 2489}#))))
+      (set! syntax-violation
+        (lambda (#{who\ 2495}#
+                 #{message\ 2494}#
+                 #{form\ 2493}#
+                 .
+                 #{subform\ 2492}#)
+          (begin
+            (let ((#{x\ 2496}# #{who\ 2495}#))
+              (if (not ((lambda (#{x\ 2497}#)
+                          (let ((#{t\ 2498}# (not #{x\ 2497}#)))
+                            (if #{t\ 2498}#
+                              #{t\ 2498}#
+                              (let ((#{t\ 2499}# (string? #{x\ 2497}#)))
+                                (if #{t\ 2499}#
+                                  #{t\ 2499}#
+                                  (symbol? #{x\ 2497}#))))))
+                        #{x\ 2496}#))
+                (syntax-violation
+                  'syntax-violation
+                  "invalid argument"
+                  #{x\ 2496}#)))
+            (let ((#{x\ 2500}# #{message\ 2494}#))
+              (if (not (string? #{x\ 2500}#))
+                (syntax-violation
+                  'syntax-violation
+                  "invalid argument"
+                  #{x\ 2500}#)))
+            (scm-error
+              'syntax-error
+              'sc-expand
+              (string-append
+                (if #{who\ 2495}# "~a: " "")
+                "~a "
+                (if (null? #{subform\ 2492}#)
+                  "in ~a"
+                  "in subform `~s' of `~s'"))
+              (let ((#{tail\ 2501}#
+                      (cons #{message\ 2494}#
+                            (map (lambda (#{x\ 2502}#)
+                                   (#{strip\ 1343}# #{x\ 2502}# (quote (()))))
+                                 (append
+                                   #{subform\ 2492}#
+                                   (list #{form\ 2493}#))))))
+                (if #{who\ 2495}#
+                  (cons #{who\ 2495}# #{tail\ 2501}#)
+                  #{tail\ 2501}#))
+              #f))))
+      (letrec ((#{match\ 2507}#
+                 (lambda (#{e\ 2508}#
+                          #{p\ 2509}#
+                          #{w\ 2510}#
+                          #{r\ 2511}#
+                          #{mod\ 2512}#)
+                   (if (not #{r\ 2511}#)
+                     #f
+                     (if (eq? #{p\ 2509}# (quote any))
+                       (cons (#{wrap\ 1325}#
+                               #{e\ 2508}#
+                               #{w\ 2510}#
+                               #{mod\ 2512}#)
+                             #{r\ 2511}#)
+                       (if (#{syntax-object?\ 1281}# #{e\ 2508}#)
+                         (#{match*\ 2506}#
+                           (#{syntax-object-expression\ 1282}# #{e\ 2508}#)
+                           #{p\ 2509}#
+                           (#{join-wraps\ 1316}#
+                             #{w\ 2510}#
+                             (#{syntax-object-wrap\ 1283}# #{e\ 2508}#))
+                           #{r\ 2511}#
+                           (#{syntax-object-module\ 1284}# #{e\ 2508}#))
+                         (#{match*\ 2506}#
+                           #{e\ 2508}#
+                           #{p\ 2509}#
+                           #{w\ 2510}#
+                           #{r\ 2511}#
+                           #{mod\ 2512}#))))))
+               (#{match*\ 2506}#
+                 (lambda (#{e\ 2513}#
+                          #{p\ 2514}#
+                          #{w\ 2515}#
+                          #{r\ 2516}#
+                          #{mod\ 2517}#)
+                   (if (null? #{p\ 2514}#)
+                     (if (null? #{e\ 2513}#) #{r\ 2516}# #f)
+                     (if (pair? #{p\ 2514}#)
+                       (if (pair? #{e\ 2513}#)
+                         (#{match\ 2507}#
+                           (car #{e\ 2513}#)
+                           (car #{p\ 2514}#)
+                           #{w\ 2515}#
+                           (#{match\ 2507}#
+                             (cdr #{e\ 2513}#)
+                             (cdr #{p\ 2514}#)
+                             #{w\ 2515}#
+                             #{r\ 2516}#
+                             #{mod\ 2517}#)
+                           #{mod\ 2517}#)
+                         #f)
+                       (if (eq? #{p\ 2514}# (quote each-any))
+                         (let ((#{l\ 2518}#
+                                 (#{match-each-any\ 2504}#
+                                   #{e\ 2513}#
+                                   #{w\ 2515}#
+                                   #{mod\ 2517}#)))
+                           (if #{l\ 2518}#
+                             (cons #{l\ 2518}# #{r\ 2516}#)
+                             #f))
+                         (let ((#{atom-key\ 2519}# (vector-ref #{p\ 2514}# 0)))
+                           (if (memv #{atom-key\ 2519}# (quote (each)))
+                             (if (null? #{e\ 2513}#)
+                               (#{match-empty\ 2505}#
+                                 (vector-ref #{p\ 2514}# 1)
+                                 #{r\ 2516}#)
+                               (let ((#{l\ 2520}#
+                                       (#{match-each\ 2503}#
+                                         #{e\ 2513}#
+                                         (vector-ref #{p\ 2514}# 1)
+                                         #{w\ 2515}#
+                                         #{mod\ 2517}#)))
+                                 (if #{l\ 2520}#
+                                   (letrec ((#{collect\ 2521}#
+                                              (lambda (#{l\ 2522}#)
+                                                (if (null? (car #{l\ 2522}#))
+                                                  #{r\ 2516}#
+                                                  (cons (map car #{l\ 2522}#)
+                                                        (#{collect\ 2521}#
+                                                          (map cdr
+                                                               #{l\ 2522}#)))))))
+                                     (#{collect\ 2521}# #{l\ 2520}#))
+                                   #f)))
+                             (if (memv #{atom-key\ 2519}# (quote (free-id)))
+                               (if (#{id?\ 1297}# #{e\ 2513}#)
+                                 (if (#{free-id=?\ 1320}#
+                                       (#{wrap\ 1325}#
+                                         #{e\ 2513}#
+                                         #{w\ 2515}#
+                                         #{mod\ 2517}#)
+                                       (vector-ref #{p\ 2514}# 1))
+                                   #{r\ 2516}#
+                                   #f)
+                                 #f)
+                               (if (memv #{atom-key\ 2519}# (quote (atom)))
+                                 (if (equal?
+                                       (vector-ref #{p\ 2514}# 1)
+                                       (#{strip\ 1343}#
+                                         #{e\ 2513}#
+                                         #{w\ 2515}#))
+                                   #{r\ 2516}#
+                                   #f)
+                                 (if (memv #{atom-key\ 2519}# (quote (vector)))
+                                   (if (vector? #{e\ 2513}#)
+                                     (#{match\ 2507}#
+                                       (vector->list #{e\ 2513}#)
+                                       (vector-ref #{p\ 2514}# 1)
+                                       #{w\ 2515}#
+                                       #{r\ 2516}#
+                                       #{mod\ 2517}#)
+                                     #f)))))))))))
+               (#{match-empty\ 2505}#
+                 (lambda (#{p\ 2523}# #{r\ 2524}#)
+                   (if (null? #{p\ 2523}#)
+                     #{r\ 2524}#
+                     (if (eq? #{p\ 2523}# (quote any))
+                       (cons (quote ()) #{r\ 2524}#)
+                       (if (pair? #{p\ 2523}#)
+                         (#{match-empty\ 2505}#
+                           (car #{p\ 2523}#)
+                           (#{match-empty\ 2505}#
+                             (cdr #{p\ 2523}#)
+                             #{r\ 2524}#))
+                         (if (eq? #{p\ 2523}# (quote each-any))
+                           (cons (quote ()) #{r\ 2524}#)
+                           (let ((#{atom-key\ 2525}#
+                                   (vector-ref #{p\ 2523}# 0)))
+                             (if (memv #{atom-key\ 2525}# (quote (each)))
+                               (#{match-empty\ 2505}#
+                                 (vector-ref #{p\ 2523}# 1)
+                                 #{r\ 2524}#)
+                               (if (memv #{atom-key\ 2525}#
+                                         '(free-id atom))
+                                 #{r\ 2524}#
+                                 (if (memv #{atom-key\ 2525}# (quote (vector)))
+                                   (#{match-empty\ 2505}#
+                                     (vector-ref #{p\ 2523}# 1)
+                                     #{r\ 2524}#)))))))))))
+               (#{match-each-any\ 2504}#
+                 (lambda (#{e\ 2526}# #{w\ 2527}# #{mod\ 2528}#)
+                   (if (pair? #{e\ 2526}#)
+                     (let ((#{l\ 2529}#
+                             (#{match-each-any\ 2504}#
+                               (cdr #{e\ 2526}#)
+                               #{w\ 2527}#
+                               #{mod\ 2528}#)))
+                       (if #{l\ 2529}#
+                         (cons (#{wrap\ 1325}#
+                                 (car #{e\ 2526}#)
+                                 #{w\ 2527}#
+                                 #{mod\ 2528}#)
+                               #{l\ 2529}#)
+                         #f))
+                     (if (null? #{e\ 2526}#)
+                       '()
+                       (if (#{syntax-object?\ 1281}# #{e\ 2526}#)
+                         (#{match-each-any\ 2504}#
+                           (#{syntax-object-expression\ 1282}# #{e\ 2526}#)
+                           (#{join-wraps\ 1316}#
+                             #{w\ 2527}#
+                             (#{syntax-object-wrap\ 1283}# #{e\ 2526}#))
+                           #{mod\ 2528}#)
+                         #f)))))
+               (#{match-each\ 2503}#
+                 (lambda (#{e\ 2530}#
+                          #{p\ 2531}#
+                          #{w\ 2532}#
+                          #{mod\ 2533}#)
+                   (if (pair? #{e\ 2530}#)
+                     (let ((#{first\ 2534}#
+                             (#{match\ 2507}#
+                               (car #{e\ 2530}#)
+                               #{p\ 2531}#
+                               #{w\ 2532}#
+                               '()
+                               #{mod\ 2533}#)))
+                       (if #{first\ 2534}#
+                         (let ((#{rest\ 2535}#
+                                 (#{match-each\ 2503}#
+                                   (cdr #{e\ 2530}#)
+                                   #{p\ 2531}#
+                                   #{w\ 2532}#
+                                   #{mod\ 2533}#)))
+                           (if #{rest\ 2535}#
+                             (cons #{first\ 2534}# #{rest\ 2535}#)
+                             #f))
+                         #f))
+                     (if (null? #{e\ 2530}#)
+                       '()
+                       (if (#{syntax-object?\ 1281}# #{e\ 2530}#)
+                         (#{match-each\ 2503}#
+                           (#{syntax-object-expression\ 1282}# #{e\ 2530}#)
+                           #{p\ 2531}#
+                           (#{join-wraps\ 1316}#
+                             #{w\ 2532}#
+                             (#{syntax-object-wrap\ 1283}# #{e\ 2530}#))
+                           (#{syntax-object-module\ 1284}# #{e\ 2530}#))
+                         #f))))))
+        (set! $sc-dispatch
+          (lambda (#{e\ 2536}# #{p\ 2537}#)
+            (if (eq? #{p\ 2537}# (quote any))
+              (list #{e\ 2536}#)
+              (if (#{syntax-object?\ 1281}# #{e\ 2536}#)
+                (#{match*\ 2506}#
+                  (#{syntax-object-expression\ 1282}# #{e\ 2536}#)
+                  #{p\ 2537}#
+                  (#{syntax-object-wrap\ 1283}# #{e\ 2536}#)
+                  '()
+                  (#{syntax-object-module\ 1284}# #{e\ 2536}#))
+                (#{match*\ 2506}#
+                  #{e\ 2536}#
+                  #{p\ 2537}#
+                  '(())
+                  '()
+                  #f)))))))))
+
+(define with-syntax
+  (make-syncase-macro
+    'macro
+    (lambda (#{x\ 2538}#)
+      ((lambda (#{tmp\ 2539}#)
+         ((lambda (#{tmp\ 2540}#)
+            (if #{tmp\ 2540}#
+              (apply (lambda (#{_\ 2541}# #{e1\ 2542}# #{e2\ 2543}#)
+                       (cons '#(syntax-object
+                                begin
+                                ((top)
+                                 #(ribcage
+                                   #(_ e1 e2)
+                                   #((top) (top) (top))
+                                   #("i" "i" "i"))
+                                 #(ribcage () () ())
+                                 #(ribcage #(x) #((top)) #("i")))
+                                (hygiene guile))
+                             (cons #{e1\ 2542}# #{e2\ 2543}#)))
+                     #{tmp\ 2540}#)
+              ((lambda (#{tmp\ 2545}#)
+                 (if #{tmp\ 2545}#
+                   (apply (lambda (#{_\ 2546}#
+                                   #{out\ 2547}#
+                                   #{in\ 2548}#
+                                   #{e1\ 2549}#
+                                   #{e2\ 2550}#)
+                            (list '#(syntax-object
+                                     syntax-case
+                                     ((top)
+                                      #(ribcage
+                                        #(_ out in e1 e2)
+                                        #((top) (top) (top) (top) (top))
+                                        #("i" "i" "i" "i" "i"))
+                                      #(ribcage () () ())
+                                      #(ribcage #(x) #((top)) #("i")))
+                                     (hygiene guile))
+                                  #{in\ 2548}#
+                                  '()
+                                  (list #{out\ 2547}#
+                                        (cons '#(syntax-object
+                                                 begin
+                                                 ((top)
+                                                  #(ribcage
+                                                    #(_ out in e1 e2)
+                                                    #((top)
+                                                      (top)
+                                                      (top)
+                                                      (top)
+                                                      (top))
+                                                    #("i" "i" "i" "i" "i"))
+                                                  #(ribcage () () ())
+                                                  #(ribcage
+                                                    #(x)
+                                                    #((top))
+                                                    #("i")))
+                                                 (hygiene guile))
+                                              (cons #{e1\ 2549}#
+                                                    #{e2\ 2550}#)))))
+                          #{tmp\ 2545}#)
+                   ((lambda (#{tmp\ 2552}#)
+                      (if #{tmp\ 2552}#
+                        (apply (lambda (#{_\ 2553}#
+                                        #{out\ 2554}#
+                                        #{in\ 2555}#
+                                        #{e1\ 2556}#
+                                        #{e2\ 2557}#)
+                                 (list '#(syntax-object
+                                          syntax-case
+                                          ((top)
+                                           #(ribcage
+                                             #(_ out in e1 e2)
+                                             #((top) (top) (top) (top) (top))
+                                             #("i" "i" "i" "i" "i"))
+                                           #(ribcage () () ())
+                                           #(ribcage #(x) #((top)) #("i")))
+                                          (hygiene guile))
+                                       (cons '#(syntax-object
+                                                list
+                                                ((top)
+                                                 #(ribcage
+                                                   #(_ out in e1 e2)
+                                                   #((top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top))
+                                                   #("i" "i" "i" "i" "i"))
+                                                 #(ribcage () () ())
+                                                 #(ribcage
+                                                   #(x)
+                                                   #((top))
+                                                   #("i")))
+                                                (hygiene guile))
+                                             #{in\ 2555}#)
+                                       '()
+                                       (list #{out\ 2554}#
+                                             (cons '#(syntax-object
+                                                      begin
+                                                      ((top)
+                                                       #(ribcage
+                                                         #(_ out in e1 e2)
+                                                         #((top)
+                                                           (top)
+                                                           (top)
+                                                           (top)
+                                                           (top))
+                                                         #("i"
+                                                           "i"
+                                                           "i"
+                                                           "i"
+                                                           "i"))
+                                                       #(ribcage () () ())
+                                                       #(ribcage
+                                                         #(x)
+                                                         #((top))
+                                                         #("i")))
+                                                      (hygiene guile))
+                                                   (cons #{e1\ 2556}#
+                                                         #{e2\ 2557}#)))))
+                               #{tmp\ 2552}#)
+                        (syntax-violation
+                          #f
+                          "source expression failed to match any pattern"
+                          #{tmp\ 2539}#)))
+                    ($sc-dispatch
+                      #{tmp\ 2539}#
+                      '(any #(each (any any)) any . each-any)))))
+               ($sc-dispatch
+                 #{tmp\ 2539}#
+                 '(any ((any any)) any . each-any)))))
+          ($sc-dispatch
+            #{tmp\ 2539}#
+            '(any () any . each-any))))
+       #{x\ 2538}#))))
+
+(define syntax-rules
+  (make-syncase-macro
+    'macro
+    (lambda (#{x\ 2561}#)
+      ((lambda (#{tmp\ 2562}#)
+         ((lambda (#{tmp\ 2563}#)
+            (if #{tmp\ 2563}#
+              (apply (lambda (#{_\ 2564}#
+                              #{k\ 2565}#
+                              #{keyword\ 2566}#
+                              #{pattern\ 2567}#
+                              #{template\ 2568}#)
+                       (list '#(syntax-object
+                                lambda
+                                ((top)
+                                 #(ribcage
+                                   #(_ k keyword pattern template)
+                                   #((top) (top) (top) (top) (top))
+                                   #("i" "i" "i" "i" "i"))
+                                 #(ribcage () () ())
+                                 #(ribcage #(x) #((top)) #("i")))
+                                (hygiene guile))
+                             '(#(syntax-object
+                                 x
+                                 ((top)
+                                  #(ribcage
+                                    #(_ k keyword pattern template)
+                                    #((top) (top) (top) (top) (top))
+                                    #("i" "i" "i" "i" "i"))
+                                  #(ribcage () () ())
+                                  #(ribcage #(x) #((top)) #("i")))
+                                 (hygiene guile)))
+                             (cons '#(syntax-object
+                                      syntax-case
+                                      ((top)
+                                       #(ribcage
+                                         #(_ k keyword pattern template)
+                                         #((top) (top) (top) (top) (top))
+                                         #("i" "i" "i" "i" "i"))
+                                       #(ribcage () () ())
+                                       #(ribcage #(x) #((top)) #("i")))
+                                      (hygiene guile))
+                                   (cons '#(syntax-object
+                                            x
+                                            ((top)
+                                             #(ribcage
+                                               #(_ k keyword pattern template)
+                                               #((top) (top) (top) (top) (top))
+                                               #("i" "i" "i" "i" "i"))
+                                             #(ribcage () () ())
+                                             #(ribcage #(x) #((top)) #("i")))
+                                            (hygiene guile))
+                                         (cons #{k\ 2565}#
+                                               (map (lambda (#{tmp\ 2571}#
+                                                             #{tmp\ 2570}#)
+                                                      (list (cons '#(syntax-object
+                                                                     dummy
+                                                                     ((top)
+                                                                      #(ribcage
+                                                                        #(_
+                                                                          k
+                                                                          keyword
+                                                                          pattern
+                                                                          template)
+                                                                        #((top)
+                                                                          (top)
+                                                                          (top)
+                                                                          (top)
+                                                                          (top))
+                                                                        #("i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"))
+                                                                      #(ribcage
+                                                                        ()
+                                                                        ()
+                                                                        ())
+                                                                      #(ribcage
+                                                                        #(x)
+                                                                        #((top))
+                                                                        #("i")))
+                                                                     (hygiene
+                                                                       guile))
+                                                                  #{tmp\ 2570}#)
+                                                            (list '#(syntax-object
+                                                                     syntax
+                                                                     ((top)
+                                                                      #(ribcage
+                                                                        #(_
+                                                                          k
+                                                                          keyword
+                                                                          pattern
+                                                                          template)
+                                                                        #((top)
+                                                                          (top)
+                                                                          (top)
+                                                                          (top)
+                                                                          (top))
+                                                                        #("i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"))
+                                                                      #(ribcage
+                                                                        ()
+                                                                        ()
+                                                                        ())
+                                                                      #(ribcage
+                                                                        #(x)
+                                                                        #((top))
+                                                                        #("i")))
+                                                                     (hygiene
+                                                                       guile))
+                                                                  #{tmp\ 2571}#)))
+                                                    #{template\ 2568}#
+                                                    #{pattern\ 2567}#))))))
+                     #{tmp\ 2563}#)
+              (syntax-violation
+                #f
+                "source expression failed to match any pattern"
+                #{tmp\ 2562}#)))
+          ($sc-dispatch
+            #{tmp\ 2562}#
+            '(any each-any . #(each ((any . any) any))))))
+       #{x\ 2561}#))))
+
+(define let*
+  (make-extended-syncase-macro
+    (module-ref (current-module) (quote let*))
+    'macro
+    (lambda (#{x\ 2572}#)
+      ((lambda (#{tmp\ 2573}#)
+         ((lambda (#{tmp\ 2574}#)
+            (if (if #{tmp\ 2574}#
+                  (apply (lambda (#{let*\ 2575}#
+                                  #{x\ 2576}#
+                                  #{v\ 2577}#
+                                  #{e1\ 2578}#
+                                  #{e2\ 2579}#)
+                           (and-map identifier? #{x\ 2576}#))
+                         #{tmp\ 2574}#)
+                  #f)
+              (apply (lambda (#{let*\ 2581}#
+                              #{x\ 2582}#
+                              #{v\ 2583}#
+                              #{e1\ 2584}#
+                              #{e2\ 2585}#)
+                       (letrec ((#{f\ 2586}#
+                                  (lambda (#{bindings\ 2587}#)
+                                    (if (null? #{bindings\ 2587}#)
+                                      (cons '#(syntax-object
+                                               let
+                                               ((top)
+                                                #(ribcage () () ())
+                                                #(ribcage
+                                                  #(f bindings)
+                                                  #((top) (top))
+                                                  #("i" "i"))
+                                                #(ribcage
+                                                  #(let* x v e1 e2)
+                                                  #((top)
+                                                    (top)
+                                                    (top)
+                                                    (top)
+                                                    (top))
+                                                  #("i" "i" "i" "i" "i"))
+                                                #(ribcage () () ())
+                                                #(ribcage
+                                                  #(x)
+                                                  #((top))
+                                                  #("i")))
+                                               (hygiene guile))
+                                            (cons '()
+                                                  (cons #{e1\ 2584}#
+                                                        #{e2\ 2585}#)))
+                                      ((lambda (#{tmp\ 2591}#)
+                                         ((lambda (#{tmp\ 2592}#)
+                                            (if #{tmp\ 2592}#
+                                              (apply (lambda (#{body\ 2593}#
+                                                              #{binding\ 2594}#)
+                                                       (list '#(syntax-object
+                                                                let
+                                                                ((top)
+                                                                 #(ribcage
+                                                                   #(body
+                                                                     binding)
+                                                                   #((top)
+                                                                     (top))
+                                                                   #("i" "i"))
+                                                                 #(ribcage
+                                                                   ()
+                                                                   ()
+                                                                   ())
+                                                                 #(ribcage
+                                                                   #(f
+                                                                     bindings)
+                                                                   #((top)
+                                                                     (top))
+                                                                   #("i" "i"))
+                                                                 #(ribcage
+                                                                   #(let*
+                                                                     x
+                                                                     v
+                                                                     e1
+                                                                     e2)
+                                                                   #((top)
+                                                                     (top)
+                                                                     (top)
+                                                                     (top)
+                                                                     (top))
+                                                                   #("i"
+                                                                     "i"
+                                                                     "i"
+                                                                     "i"
+                                                                     "i"))
+                                                                 #(ribcage
+                                                                   ()
+                                                                   ()
+                                                                   ())
+                                                                 #(ribcage
+                                                                   #(x)
+                                                                   #((top))
+                                                                   #("i")))
+                                                                (hygiene
+                                                                  guile))
+                                                             (list #{binding\ 2594}#)
+                                                             #{body\ 2593}#))
+                                                     #{tmp\ 2592}#)
+                                              (syntax-violation
+                                                #f
+                                                "source expression failed to match any pattern"
+                                                #{tmp\ 2591}#)))
+                                          ($sc-dispatch
+                                            #{tmp\ 2591}#
+                                            '(any any))))
+                                       (list (#{f\ 2586}#
+                                               (cdr #{bindings\ 2587}#))
+                                             (car #{bindings\ 2587}#)))))))
+                         (#{f\ 2586}# (map list #{x\ 2582}# #{v\ 2583}#))))
+                     #{tmp\ 2574}#)
+              (syntax-violation
+                #f
+                "source expression failed to match any pattern"
+                #{tmp\ 2573}#)))
+          ($sc-dispatch
+            #{tmp\ 2573}#
+            '(any #(each (any any)) any . each-any))))
+       #{x\ 2572}#))))
+
+(define do
+  (make-extended-syncase-macro
+    (module-ref (current-module) (quote do))
+    'macro
+    (lambda (#{orig-x\ 2595}#)
+      ((lambda (#{tmp\ 2596}#)
+         ((lambda (#{tmp\ 2597}#)
+            (if #{tmp\ 2597}#
+              (apply (lambda (#{_\ 2598}#
+                              #{var\ 2599}#
+                              #{init\ 2600}#
+                              #{step\ 2601}#
+                              #{e0\ 2602}#
+                              #{e1\ 2603}#
+                              #{c\ 2604}#)
+                       ((lambda (#{tmp\ 2605}#)
+                          ((lambda (#{tmp\ 2606}#)
+                             (if #{tmp\ 2606}#
+                               (apply (lambda (#{step\ 2607}#)
+                                        ((lambda (#{tmp\ 2608}#)
+                                           ((lambda (#{tmp\ 2609}#)
+                                              (if #{tmp\ 2609}#
+                                                (apply (lambda ()
+                                                         (list '#(syntax-object
+                                                                  let
+                                                                  ((top)
+                                                                   #(ribcage
+                                                                     #(step)
+                                                                     #((top))
+                                                                     #("i"))
+                                                                   #(ribcage
+                                                                     #(_
+                                                                       var
+                                                                       init
+                                                                       step
+                                                                       e0
+                                                                       e1
+                                                                       c)
+                                                                     #((top)
+                                                                       (top)
+                                                                       (top)
+                                                                       (top)
+                                                                       (top)
+                                                                       (top)
+                                                                       (top))
+                                                                     #("i"
+                                                                       "i"
+                                                                       "i"
+                                                                       "i"
+                                                                       "i"
+                                                                       "i"
+                                                                       "i"))
+                                                                   #(ribcage
+                                                                     ()
+                                                                     ()
+                                                                     ())
+                                                                   #(ribcage
+                                                                     #(orig-x)
+                                                                     #((top))
+                                                                     #("i")))
+                                                                  (hygiene
+                                                                    guile))
+                                                               '#(syntax-object
+                                                                  doloop
+                                                                  ((top)
+                                                                   #(ribcage
+                                                                     #(step)
+                                                                     #((top))
+                                                                     #("i"))
+                                                                   #(ribcage
+                                                                     #(_
+                                                                       var
+                                                                       init
+                                                                       step
+                                                                       e0
+                                                                       e1
+                                                                       c)
+                                                                     #((top)
+                                                                       (top)
+                                                                       (top)
+                                                                       (top)
+                                                                       (top)
+                                                                       (top)
+                                                                       (top))
+                                                                     #("i"
+                                                                       "i"
+                                                                       "i"
+                                                                       "i"
+                                                                       "i"
+                                                                       "i"
+                                                                       "i"))
+                                                                   #(ribcage
+                                                                     ()
+                                                                     ()
+                                                                     ())
+                                                                   #(ribcage
+                                                                     #(orig-x)
+                                                                     #((top))
+                                                                     #("i")))
+                                                                  (hygiene
+                                                                    guile))
+                                                               (map list
+                                                                    #{var\ 2599}#
+                                                                    #{init\ 2600}#)
+                                                               (list '#(syntax-object
+                                                                        if
+                                                                        ((top)
+                                                                         #(ribcage
+                                                                           #(step)
+                                                                           #((top))
+                                                                           #("i"))
+                                                                         #(ribcage
+                                                                           #(_
+                                                                             var
+                                                                             init
+                                                                             step
+                                                                             e0
+                                                                             e1
+                                                                             c)
+                                                                           #((top)
+                                                                             (top)
+                                                                             (top)
+                                                                             (top)
+                                                                             (top)
+                                                                             (top)
+                                                                             (top))
+                                                                           #("i"
+                                                                             "i"
+                                                                             "i"
+                                                                             "i"
+                                                                             "i"
+                                                                             "i"
+                                                                             "i"))
+                                                                         #(ribcage
+                                                                           ()
+                                                                           ()
+                                                                           ())
+                                                                         #(ribcage
+                                                                           #(orig-x)
+                                                                           #((top))
+                                                                           #("i")))
+                                                                        (hygiene
+                                                                          guile))
+                                                                     (list '#(syntax-object
+                                                                              not
+                                                                              ((top)
+                                                                               #(ribcage
+                                                                                 #(step)
+                                                                                 #((top))
+                                                                                 #("i"))
+                                                                               #(ribcage
+                                                                                 #(_
+                                                                                   var
+                                                                                   init
+                                                                                   step
+                                                                                   e0
+                                                                                   e1
+                                                                                   c)
+                                                                                 #((top)
+                                                                                   (top)
+                                                                                   (top)
+                                                                                   (top)
+                                                                                   (top)
+                                                                                   (top)
+                                                                                   (top))
+                                                                                 #("i"
+                                                                                   "i"
+                                                                                   "i"
+                                                                                   "i"
+                                                                                   "i"
+                                                                                   "i"
+                                                                                   "i"))
+                                                                               #(ribcage
+                                                                                 ()
+                                                                                 ()
+                                                                                 ())
+                                                                               #(ribcage
+                                                                                 #(orig-x)
+                                                                                 #((top))
+                                                                                 #("i")))
+                                                                              (hygiene
+                                                                                guile))
+                                                                           #{e0\ 2602}#)
+                                                                     (cons '#(syntax-object
+                                                                              begin
+                                                                              ((top)
+                                                                               #(ribcage
+                                                                                 #(step)
+                                                                                 #((top))
+                                                                                 #("i"))
+                                                                               #(ribcage
+                                                                                 #(_
+                                                                                   var
+                                                                                   init
+                                                                                   step
+                                                                                   e0
+                                                                                   e1
+                                                                                   c)
+                                                                                 #((top)
+                                                                                   (top)
+                                                                                   (top)
+                                                                                   (top)
+                                                                                   (top)
+                                                                                   (top)
+                                                                                   (top))
+                                                                                 #("i"
+                                                                                   "i"
+                                                                                   "i"
+                                                                                   "i"
+                                                                                   "i"
+                                                                                   "i"
+                                                                                   "i"))
+                                                                               #(ribcage
+                                                                                 ()
+                                                                                 ()
+                                                                                 ())
+                                                                               #(ribcage
+                                                                                 #(orig-x)
+                                                                                 #((top))
+                                                                                 #("i")))
+                                                                              (hygiene
+                                                                                guile))
+                                                                           (append
+                                                                             #{c\ 2604}#
+                                                                             (list (cons '#(syntax-object
+                                                                                            doloop
+                                                                                            ((top)
+                                                                                             #(ribcage
+                                                                                               #(step)
+                                                                                               #((top))
+                                                                                               #("i"))
+                                                                                             #(ribcage
+                                                                                               #(_
+                                                                                                 var
+                                                                                                 init
+                                                                                                 step
+                                                                                                 e0
+                                                                                                 e1
+                                                                                                 c)
+                                                                                               #((top)
+                                                                                                 (top)
+                                                                                                 (top)
+                                                                                                 (top)
+                                                                                                 (top)
+                                                                                                 (top)
+                                                                                                 (top))
+                                                                                               #("i"
+                                                                                                 "i"
+                                                                                                 "i"
+                                                                                                 "i"
+                                                                                                 "i"
+                                                                                                 "i"
+                                                                                                 "i"))
+                                                                                             #(ribcage
+                                                                                               ()
+                                                                                               ()
+                                                                                               ())
+                                                                                             #(ribcage
+                                                                                               #(orig-x)
+                                                                                               #((top))
+                                                                                               #("i")))
+                                                                                            (hygiene
+                                                                                              guile))
+                                                                                         #{step\ 2607}#)))))))
+                                                       #{tmp\ 2609}#)
+                                                ((lambda (#{tmp\ 2614}#)
+                                                   (if #{tmp\ 2614}#
+                                                     (apply (lambda (#{e1\ 2615}#
+                                                                     #{e2\ 2616}#)
+                                                              (list '#(syntax-object
+                                                                       let
+                                                                       ((top)
+                                                                        #(ribcage
+                                                                          #(e1
+                                                                            e2)
+                                                                          #((top)
+                                                                            (top))
+                                                                          #("i"
+                                                                            "i"))
+                                                                        #(ribcage
+                                                                          #(step)
+                                                                          #((top))
+                                                                          #("i"))
+                                                                        #(ribcage
+                                                                          #(_
+                                                                            var
+                                                                            init
+                                                                            step
+                                                                            e0
+                                                                            e1
+                                                                            c)
+                                                                          #((top)
+                                                                            (top)
+                                                                            (top)
+                                                                            (top)
+                                                                            (top)
+                                                                            (top)
+                                                                            (top))
+                                                                          #("i"
+                                                                            "i"
+                                                                            "i"
+                                                                            "i"
+                                                                            "i"
+                                                                            "i"
+                                                                            "i"))
+                                                                        #(ribcage
+                                                                          ()
+                                                                          ()
+                                                                          ())
+                                                                        #(ribcage
+                                                                          #(orig-x)
+                                                                          #((top))
+                                                                          #("i")))
+                                                                       (hygiene
+                                                                         guile))
+                                                                    '#(syntax-object
+                                                                       doloop
+                                                                       ((top)
+                                                                        #(ribcage
+                                                                          #(e1
+                                                                            e2)
+                                                                          #((top)
+                                                                            (top))
+                                                                          #("i"
+                                                                            "i"))
+                                                                        #(ribcage
+                                                                          #(step)
+                                                                          #((top))
+                                                                          #("i"))
+                                                                        #(ribcage
+                                                                          #(_
+                                                                            var
+                                                                            init
+                                                                            step
+                                                                            e0
+                                                                            e1
+                                                                            c)
+                                                                          #((top)
+                                                                            (top)
+                                                                            (top)
+                                                                            (top)
+                                                                            (top)
+                                                                            (top)
+                                                                            (top))
+                                                                          #("i"
+                                                                            "i"
+                                                                            "i"
+                                                                            "i"
+                                                                            "i"
+                                                                            "i"
+                                                                            "i"))
+                                                                        #(ribcage
+                                                                          ()
+                                                                          ()
+                                                                          ())
+                                                                        #(ribcage
+                                                                          #(orig-x)
+                                                                          #((top))
+                                                                          #("i")))
+                                                                       (hygiene
+                                                                         guile))
+                                                                    (map list
+                                                                         #{var\ 2599}#
+                                                                         #{init\ 2600}#)
+                                                                    (list '#(syntax-object
+                                                                             if
+                                                                             ((top)
+                                                                              #(ribcage
+                                                                                #(e1
+                                                                                  e2)
+                                                                                #((top)
+                                                                                  (top))
+                                                                                #("i"
+                                                                                  "i"))
+                                                                              #(ribcage
+                                                                                #(step)
+                                                                                #((top))
+                                                                                #("i"))
+                                                                              #(ribcage
+                                                                                #(_
+                                                                                  var
+                                                                                  init
+                                                                                  step
+                                                                                  e0
+                                                                                  e1
+                                                                                  c)
+                                                                                #((top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top))
+                                                                                #("i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"))
+                                                                              #(ribcage
+                                                                                ()
+                                                                                ()
+                                                                                ())
+                                                                              #(ribcage
+                                                                                #(orig-x)
+                                                                                #((top))
+                                                                                #("i")))
+                                                                             (hygiene
+                                                                               guile))
+                                                                          #{e0\ 2602}#
+                                                                          (cons '#(syntax-object
+                                                                                   begin
+                                                                                   ((top)
+                                                                                    #(ribcage
+                                                                                      #(e1
+                                                                                        e2)
+                                                                                      #((top)
+                                                                                        (top))
+                                                                                      #("i"
+                                                                                        "i"))
+                                                                                    #(ribcage
+                                                                                      #(step)
+                                                                                      #((top))
+                                                                                      #("i"))
+                                                                                    #(ribcage
+                                                                                      #(_
+                                                                                        var
+                                                                                        init
+                                                                                        step
+                                                                                        e0
+                                                                                        e1
+                                                                                        c)
+                                                                                      #((top)
+                                                                                        (top)
+                                                                                        (top)
+                                                                                        (top)
+                                                                                        (top)
+                                                                                        (top)
+                                                                                        (top))
+                                                                                      #("i"
+                                                                                        "i"
+                                                                                        "i"
+                                                                                        "i"
+                                                                                        "i"
+                                                                                        "i"
+                                                                                        "i"))
+                                                                                    #(ribcage
+                                                                                      ()
+                                                                                      ()
+                                                                                      ())
+                                                                                    #(ribcage
+                                                                                      #(orig-x)
+                                                                                      #((top))
+                                                                                      #("i")))
+                                                                                   (hygiene
+                                                                                     guile))
+                                                                                (cons #{e1\ 2615}#
+                                                                                      #{e2\ 2616}#))
+                                                                          (cons '#(syntax-object
+                                                                                   begin
+                                                                                   ((top)
+                                                                                    #(ribcage
+                                                                                      #(e1
+                                                                                        e2)
+                                                                                      #((top)
+                                                                                        (top))
+                                                                                      #("i"
+                                                                                        "i"))
+                                                                                    #(ribcage
+                                                                                      #(step)
+                                                                                      #((top))
+                                                                                      #("i"))
+                                                                                    #(ribcage
+                                                                                      #(_
+                                                                                        var
+                                                                                        init
+                                                                                        step
+                                                                                        e0
+                                                                                        e1
+                                                                                        c)
+                                                                                      #((top)
+                                                                                        (top)
+                                                                                        (top)
+                                                                                        (top)
+                                                                                        (top)
+                                                                                        (top)
+                                                                                        (top))
+                                                                                      #("i"
+                                                                                        "i"
+                                                                                        "i"
+                                                                                        "i"
+                                                                                        "i"
+                                                                                        "i"
+                                                                                        "i"))
+                                                                                    #(ribcage
+                                                                                      ()
+                                                                                      ()
+                                                                                      ())
+                                                                                    #(ribcage
+                                                                                      #(orig-x)
+                                                                                      #((top))
+                                                                                      #("i")))
+                                                                                   (hygiene
+                                                                                     guile))
+                                                                                (append
+                                                                                  #{c\ 2604}#
+                                                                                  (list (cons '#(syntax-object
+                                                                                                 doloop
+                                                                                                 ((top)
+                                                                                                  #(ribcage
+                                                                                                    #(e1
+                                                                                                      e2)
+                                                                                                    #((top)
+                                                                                                      (top))
+                                                                                                    #("i"
+                                                                                                      "i"))
+                                                                                                  #(ribcage
+                                                                                                    #(step)
+                                                                                                    #((top))
+                                                                                                    #("i"))
+                                                                                                  #(ribcage
+                                                                                                    #(_
+                                                                                                      var
+                                                                                                      init
+                                                                                                      step
+                                                                                                      e0
+                                                                                                      e1
+                                                                                                      c)
+                                                                                                    #((top)
+                                                                                                      (top)
+                                                                                                      (top)
+                                                                                                      (top)
+                                                                                                      (top)
+                                                                                                      (top)
+                                                                                                      (top))
+                                                                                                    #("i"
+                                                                                                      "i"
+                                                                                                      "i"
+                                                                                                      "i"
+                                                                                                      "i"
+                                                                                                      "i"
+                                                                                                      "i"))
+                                                                                                  #(ribcage
+                                                                                                    ()
+                                                                                                    ()
+                                                                                                    ())
+                                                                                                  #(ribcage
+                                                                                                    #(orig-x)
+                                                                                                    #((top))
+                                                                                                    #("i")))
+                                                                                                 (hygiene
+                                                                                                   guile))
+                                                                                              #{step\ 2607}#)))))))
+                                                            #{tmp\ 2614}#)
+                                                     (syntax-violation
+                                                       #f
+                                                       "source expression failed to match any pattern"
+                                                       #{tmp\ 2608}#)))
+                                                 ($sc-dispatch
+                                                   #{tmp\ 2608}#
+                                                   '(any . each-any)))))
+                                            ($sc-dispatch
+                                              #{tmp\ 2608}#
+                                              '())))
+                                         #{e1\ 2603}#))
+                                      #{tmp\ 2606}#)
+                               (syntax-violation
+                                 #f
+                                 "source expression failed to match any pattern"
+                                 #{tmp\ 2605}#)))
+                           ($sc-dispatch #{tmp\ 2605}# (quote each-any))))
+                        (map (lambda (#{v\ 2623}# #{s\ 2624}#)
+                               ((lambda (#{tmp\ 2625}#)
+                                  ((lambda (#{tmp\ 2626}#)
+                                     (if #{tmp\ 2626}#
+                                       (apply (lambda () #{v\ 2623}#)
+                                              #{tmp\ 2626}#)
+                                       ((lambda (#{tmp\ 2627}#)
+                                          (if #{tmp\ 2627}#
+                                            (apply (lambda (#{e\ 2628}#)
+                                                     #{e\ 2628}#)
+                                                   #{tmp\ 2627}#)
+                                            ((lambda (#{_\ 2629}#)
+                                               (syntax-violation
+                                                 'do
+                                                 "bad step expression"
+                                                 #{orig-x\ 2595}#
+                                                 #{s\ 2624}#))
+                                             #{tmp\ 2625}#)))
+                                        ($sc-dispatch
+                                          #{tmp\ 2625}#
+                                          '(any)))))
+                                   ($sc-dispatch #{tmp\ 2625}# (quote ()))))
+                                #{s\ 2624}#))
+                             #{var\ 2599}#
+                             #{step\ 2601}#)))
+                     #{tmp\ 2597}#)
+              (syntax-violation
+                #f
+                "source expression failed to match any pattern"
+                #{tmp\ 2596}#)))
+          ($sc-dispatch
+            #{tmp\ 2596}#
+            '(any #(each (any any . any))
+                  (any . each-any)
+                  .
+                  each-any))))
+       #{orig-x\ 2595}#))))
+
+(define quasiquote
+  (make-extended-syncase-macro
+    (module-ref (current-module) (quote quasiquote))
+    'macro
+    (letrec ((#{quasicons\ 2632}#
+               (lambda (#{x\ 2636}# #{y\ 2637}#)
+                 ((lambda (#{tmp\ 2638}#)
+                    ((lambda (#{tmp\ 2639}#)
+                       (if #{tmp\ 2639}#
+                         (apply (lambda (#{x\ 2640}# #{y\ 2641}#)
+                                  ((lambda (#{tmp\ 2642}#)
+                                     ((lambda (#{tmp\ 2643}#)
+                                        (if #{tmp\ 2643}#
+                                          (apply (lambda (#{dy\ 2644}#)
+                                                   ((lambda (#{tmp\ 2645}#)
+                                                      ((lambda (#{tmp\ 2646}#)
+                                                         (if #{tmp\ 2646}#
+                                                           (apply (lambda (#{dx\ 2647}#)
+                                                                    (list '#(syntax-object
+                                                                             quote
+                                                                             ((top)
+                                                                              #(ribcage
+                                                                                #(dx)
+                                                                                #((top))
+                                                                                #("i"))
+                                                                              #(ribcage
+                                                                                #(dy)
+                                                                                #((top))
+                                                                                #("i"))
+                                                                              #(ribcage
+                                                                                #(x
+                                                                                  y)
+                                                                                #((top)
+                                                                                  (top))
+                                                                                #("i"
+                                                                                  "i"))
+                                                                              #(ribcage
+                                                                                ()
+                                                                                ()
+                                                                                ())
+                                                                              #(ribcage
+                                                                                ()
+                                                                                ()
+                                                                                ())
+                                                                              #(ribcage
+                                                                                #(x
+                                                                                  y)
+                                                                                #((top)
+                                                                                  (top))
+                                                                                #("i"
+                                                                                  "i"))
+                                                                              #(ribcage
+                                                                                #(quasicons
+                                                                                  quasiappend
+                                                                                  quasivector
+                                                                                  quasi)
+                                                                                #((top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top))
+                                                                                #("i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i")))
+                                                                             (hygiene
+                                                                               guile))
+                                                                          (cons #{dx\ 2647}#
+                                                                                #{dy\ 2644}#)))
+                                                                  #{tmp\ 2646}#)
+                                                           ((lambda (#{_\ 2648}#)
+                                                              (if (null? #{dy\ 2644}#)
+                                                                (list '#(syntax-object
+                                                                         list
+                                                                         ((top)
+                                                                          #(ribcage
+                                                                            #(_)
+                                                                            #((top))
+                                                                            #("i"))
+                                                                          #(ribcage
+                                                                            #(dy)
+                                                                            #((top))
+                                                                            #("i"))
+                                                                          #(ribcage
+                                                                            #(x
+                                                                              y)
+                                                                            #((top)
+                                                                              (top))
+                                                                            #("i"
+                                                                              "i"))
+                                                                          #(ribcage
+                                                                            ()
+                                                                            ()
+                                                                            ())
+                                                                          #(ribcage
+                                                                            ()
+                                                                            ()
+                                                                            ())
+                                                                          #(ribcage
+                                                                            #(x
+                                                                              y)
+                                                                            #((top)
+                                                                              (top))
+                                                                            #("i"
+                                                                              "i"))
+                                                                          #(ribcage
+                                                                            #(quasicons
+                                                                              quasiappend
+                                                                              quasivector
+                                                                              quasi)
+                                                                            #((top)
+                                                                              (top)
+                                                                              (top)
+                                                                              (top))
+                                                                            #("i"
+                                                                              "i"
+                                                                              "i"
+                                                                              "i")))
+                                                                         (hygiene
+                                                                           guile))
+                                                                      #{x\ 2640}#)
+                                                                (list '#(syntax-object
+                                                                         cons
+                                                                         ((top)
+                                                                          #(ribcage
+                                                                            #(_)
+                                                                            #((top))
+                                                                            #("i"))
+                                                                          #(ribcage
+                                                                            #(dy)
+                                                                            #((top))
+                                                                            #("i"))
+                                                                          #(ribcage
+                                                                            #(x
+                                                                              y)
+                                                                            #((top)
+                                                                              (top))
+                                                                            #("i"
+                                                                              "i"))
+                                                                          #(ribcage
+                                                                            ()
+                                                                            ()
+                                                                            ())
+                                                                          #(ribcage
+                                                                            ()
+                                                                            ()
+                                                                            ())
+                                                                          #(ribcage
+                                                                            #(x
+                                                                              y)
+                                                                            #((top)
+                                                                              (top))
+                                                                            #("i"
+                                                                              "i"))
+                                                                          #(ribcage
+                                                                            #(quasicons
+                                                                              quasiappend
+                                                                              quasivector
+                                                                              quasi)
+                                                                            #((top)
+                                                                              (top)
+                                                                              (top)
+                                                                              (top))
+                                                                            #("i"
+                                                                              "i"
+                                                                              "i"
+                                                                              "i")))
+                                                                         (hygiene
+                                                                           guile))
+                                                                      #{x\ 2640}#
+                                                                      #{y\ 2641}#)))
+                                                            #{tmp\ 2645}#)))
+                                                       ($sc-dispatch
+                                                         #{tmp\ 2645}#
+                                                         '(#(free-id
+                                                             #(syntax-object
+                                                               quote
+                                                               ((top)
+                                                                #(ribcage
+                                                                  #(dy)
+                                                                  #((top))
+                                                                  #("i"))
+                                                                #(ribcage
+                                                                  #(x y)
+                                                                  #((top)
+                                                                    (top))
+                                                                  #("i" "i"))
+                                                                #(ribcage
+                                                                  ()
+                                                                  ()
+                                                                  ())
+                                                                #(ribcage
+                                                                  ()
+                                                                  ()
+                                                                  ())
+                                                                #(ribcage
+                                                                  #(x y)
+                                                                  #((top)
+                                                                    (top))
+                                                                  #("i" "i"))
+                                                                #(ribcage
+                                                                  #(quasicons
+                                                                    quasiappend
+                                                                    quasivector
+                                                                    quasi)
+                                                                  #((top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top))
+                                                                  #("i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i")))
+                                                               (hygiene
+                                                                 guile)))
+                                                           any))))
+                                                    #{x\ 2640}#))
+                                                 #{tmp\ 2643}#)
+                                          ((lambda (#{tmp\ 2649}#)
+                                             (if #{tmp\ 2649}#
+                                               (apply (lambda (#{stuff\ 2650}#)
+                                                        (cons '#(syntax-object
+                                                                 list
+                                                                 ((top)
+                                                                  #(ribcage
+                                                                    #(stuff)
+                                                                    #((top))
+                                                                    #("i"))
+                                                                  #(ribcage
+                                                                    #(x y)
+                                                                    #((top)
+                                                                      (top))
+                                                                    #("i" "i"))
+                                                                  #(ribcage
+                                                                    ()
+                                                                    ()
+                                                                    ())
+                                                                  #(ribcage
+                                                                    ()
+                                                                    ()
+                                                                    ())
+                                                                  #(ribcage
+                                                                    #(x y)
+                                                                    #((top)
+                                                                      (top))
+                                                                    #("i" "i"))
+                                                                  #(ribcage
+                                                                    #(quasicons
+                                                                      quasiappend
+                                                                      quasivector
+                                                                      quasi)
+                                                                    #((top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top))
+                                                                    #("i"
+                                                                      "i"
+                                                                      "i"
+                                                                      "i")))
+                                                                 (hygiene
+                                                                   guile))
+                                                              (cons #{x\ 2640}#
+                                                                    #{stuff\ 2650}#)))
+                                                      #{tmp\ 2649}#)
+                                               ((lambda (#{else\ 2651}#)
+                                                  (list '#(syntax-object
+                                                           cons
+                                                           ((top)
+                                                            #(ribcage
+                                                              #(else)
+                                                              #((top))
+                                                              #("i"))
+                                                            #(ribcage
+                                                              #(x y)
+                                                              #((top) (top))
+                                                              #("i" "i"))
+                                                            #(ribcage () () ())
+                                                            #(ribcage () () ())
+                                                            #(ribcage
+                                                              #(x y)
+                                                              #((top) (top))
+                                                              #("i" "i"))
+                                                            #(ribcage
+                                                              #(quasicons
+                                                                quasiappend
+                                                                quasivector
+                                                                quasi)
+                                                              #((top)
+                                                                (top)
+                                                                (top)
+                                                                (top))
+                                                              #("i"
+                                                                "i"
+                                                                "i"
+                                                                "i")))
+                                                           (hygiene guile))
+                                                        #{x\ 2640}#
+                                                        #{y\ 2641}#))
+                                                #{tmp\ 2642}#)))
+                                           ($sc-dispatch
+                                             #{tmp\ 2642}#
+                                             '(#(free-id
+                                                 #(syntax-object
+                                                   list
+                                                   ((top)
+                                                    #(ribcage
+                                                      #(x y)
+                                                      #((top) (top))
+                                                      #("i" "i"))
+                                                    #(ribcage () () ())
+                                                    #(ribcage () () ())
+                                                    #(ribcage
+                                                      #(x y)
+                                                      #((top) (top))
+                                                      #("i" "i"))
+                                                    #(ribcage
+                                                      #(quasicons
+                                                        quasiappend
+                                                        quasivector
+                                                        quasi)
+                                                      #((top)
+                                                        (top)
+                                                        (top)
+                                                        (top))
+                                                      #("i" "i" "i" "i")))
+                                                   (hygiene guile)))
+                                               .
+                                               any)))))
+                                      ($sc-dispatch
+                                        #{tmp\ 2642}#
+                                        '(#(free-id
+                                            #(syntax-object
+                                              quote
+                                              ((top)
+                                               #(ribcage
+                                                 #(x y)
+                                                 #((top) (top))
+                                                 #("i" "i"))
+                                               #(ribcage () () ())
+                                               #(ribcage () () ())
+                                               #(ribcage
+                                                 #(x y)
+                                                 #((top) (top))
+                                                 #("i" "i"))
+                                               #(ribcage
+                                                 #(quasicons
+                                                   quasiappend
+                                                   quasivector
+                                                   quasi)
+                                                 #((top) (top) (top) (top))
+                                                 #("i" "i" "i" "i")))
+                                              (hygiene guile)))
+                                          any))))
+                                   #{y\ 2641}#))
+                                #{tmp\ 2639}#)
+                         (syntax-violation
+                           #f
+                           "source expression failed to match any pattern"
+                           #{tmp\ 2638}#)))
+                     ($sc-dispatch #{tmp\ 2638}# (quote (any any)))))
+                  (list #{x\ 2636}# #{y\ 2637}#))))
+             (#{quasiappend\ 2633}#
+               (lambda (#{x\ 2652}# #{y\ 2653}#)
+                 ((lambda (#{tmp\ 2654}#)
+                    ((lambda (#{tmp\ 2655}#)
+                       (if #{tmp\ 2655}#
+                         (apply (lambda (#{x\ 2656}# #{y\ 2657}#)
+                                  ((lambda (#{tmp\ 2658}#)
+                                     ((lambda (#{tmp\ 2659}#)
+                                        (if #{tmp\ 2659}#
+                                          (apply (lambda () #{x\ 2656}#)
+                                                 #{tmp\ 2659}#)
+                                          ((lambda (#{_\ 2660}#)
+                                             (list '#(syntax-object
+                                                      append
+                                                      ((top)
+                                                       #(ribcage
+                                                         #(_)
+                                                         #((top))
+                                                         #("i"))
+                                                       #(ribcage
+                                                         #(x y)
+                                                         #((top) (top))
+                                                         #("i" "i"))
+                                                       #(ribcage () () ())
+                                                       #(ribcage () () ())
+                                                       #(ribcage
+                                                         #(x y)
+                                                         #((top) (top))
+                                                         #("i" "i"))
+                                                       #(ribcage
+                                                         #(quasicons
+                                                           quasiappend
+                                                           quasivector
+                                                           quasi)
+                                                         #((top)
+                                                           (top)
+                                                           (top)
+                                                           (top))
+                                                         #("i" "i" "i" "i")))
+                                                      (hygiene guile))
+                                                   #{x\ 2656}#
+                                                   #{y\ 2657}#))
+                                           #{tmp\ 2658}#)))
+                                      ($sc-dispatch
+                                        #{tmp\ 2658}#
+                                        '(#(free-id
+                                            #(syntax-object
+                                              quote
+                                              ((top)
+                                               #(ribcage
+                                                 #(x y)
+                                                 #((top) (top))
+                                                 #("i" "i"))
+                                               #(ribcage () () ())
+                                               #(ribcage () () ())
+                                               #(ribcage
+                                                 #(x y)
+                                                 #((top) (top))
+                                                 #("i" "i"))
+                                               #(ribcage
+                                                 #(quasicons
+                                                   quasiappend
+                                                   quasivector
+                                                   quasi)
+                                                 #((top) (top) (top) (top))
+                                                 #("i" "i" "i" "i")))
+                                              (hygiene guile)))
+                                          ()))))
+                                   #{y\ 2657}#))
+                                #{tmp\ 2655}#)
+                         (syntax-violation
+                           #f
+                           "source expression failed to match any pattern"
+                           #{tmp\ 2654}#)))
+                     ($sc-dispatch #{tmp\ 2654}# (quote (any any)))))
+                  (list #{x\ 2652}# #{y\ 2653}#))))
+             (#{quasivector\ 2634}#
+               (lambda (#{x\ 2661}#)
+                 ((lambda (#{tmp\ 2662}#)
+                    ((lambda (#{x\ 2663}#)
+                       ((lambda (#{tmp\ 2664}#)
+                          ((lambda (#{tmp\ 2665}#)
+                             (if #{tmp\ 2665}#
+                               (apply (lambda (#{x\ 2666}#)
+                                        (list '#(syntax-object
+                                                 quote
+                                                 ((top)
+                                                  #(ribcage
+                                                    #(x)
+                                                    #((top))
+                                                    #("i"))
+                                                  #(ribcage
+                                                    #(x)
+                                                    #((top))
+                                                    #("i"))
+                                                  #(ribcage () () ())
+                                                  #(ribcage () () ())
+                                                  #(ribcage
+                                                    #(x)
+                                                    #((top))
+                                                    #("i"))
+                                                  #(ribcage
+                                                    #(quasicons
+                                                      quasiappend
+                                                      quasivector
+                                                      quasi)
+                                                    #((top) (top) (top) (top))
+                                                    #("i" "i" "i" "i")))
+                                                 (hygiene guile))
+                                              (list->vector #{x\ 2666}#)))
+                                      #{tmp\ 2665}#)
+                               ((lambda (#{tmp\ 2668}#)
+                                  (if #{tmp\ 2668}#
+                                    (apply (lambda (#{x\ 2669}#)
+                                             (cons '#(syntax-object
+                                                      vector
+                                                      ((top)
+                                                       #(ribcage
+                                                         #(x)
+                                                         #((top))
+                                                         #("i"))
+                                                       #(ribcage
+                                                         #(x)
+                                                         #((top))
+                                                         #("i"))
+                                                       #(ribcage () () ())
+                                                       #(ribcage () () ())
+                                                       #(ribcage
+                                                         #(x)
+                                                         #((top))
+                                                         #("i"))
+                                                       #(ribcage
+                                                         #(quasicons
+                                                           quasiappend
+                                                           quasivector
+                                                           quasi)
+                                                         #((top)
+                                                           (top)
+                                                           (top)
+                                                           (top))
+                                                         #("i" "i" "i" "i")))
+                                                      (hygiene guile))
+                                                   #{x\ 2669}#))
+                                           #{tmp\ 2668}#)
+                                    ((lambda (#{_\ 2671}#)
+                                       (list '#(syntax-object
+                                                list->vector
+                                                ((top)
+                                                 #(ribcage
+                                                   #(_)
+                                                   #((top))
+                                                   #("i"))
+                                                 #(ribcage
+                                                   #(x)
+                                                   #((top))
+                                                   #("i"))
+                                                 #(ribcage () () ())
+                                                 #(ribcage () () ())
+                                                 #(ribcage
+                                                   #(x)
+                                                   #((top))
+                                                   #("i"))
+                                                 #(ribcage
+                                                   #(quasicons
+                                                     quasiappend
+                                                     quasivector
+                                                     quasi)
+                                                   #((top) (top) (top) (top))
+                                                   #("i" "i" "i" "i")))
+                                                (hygiene guile))
+                                             #{x\ 2663}#))
+                                     #{tmp\ 2664}#)))
+                                ($sc-dispatch
+                                  #{tmp\ 2664}#
+                                  '(#(free-id
+                                      #(syntax-object
+                                        list
+                                        ((top)
+                                         #(ribcage #(x) #((top)) #("i"))
+                                         #(ribcage () () ())
+                                         #(ribcage () () ())
+                                         #(ribcage #(x) #((top)) #("i"))
+                                         #(ribcage
+                                           #(quasicons
+                                             quasiappend
+                                             quasivector
+                                             quasi)
+                                           #((top) (top) (top) (top))
+                                           #("i" "i" "i" "i")))
+                                        (hygiene guile)))
+                                    .
+                                    each-any)))))
+                           ($sc-dispatch
+                             #{tmp\ 2664}#
+                             '(#(free-id
+                                 #(syntax-object
+                                   quote
+                                   ((top)
+                                    #(ribcage #(x) #((top)) #("i"))
+                                    #(ribcage () () ())
+                                    #(ribcage () () ())
+                                    #(ribcage #(x) #((top)) #("i"))
+                                    #(ribcage
+                                      #(quasicons
+                                        quasiappend
+                                        quasivector
+                                        quasi)
+                                      #((top) (top) (top) (top))
+                                      #("i" "i" "i" "i")))
+                                   (hygiene guile)))
+                               each-any))))
+                        #{x\ 2663}#))
+                     #{tmp\ 2662}#))
+                  #{x\ 2661}#)))
+             (#{quasi\ 2635}#
+               (lambda (#{p\ 2672}# #{lev\ 2673}#)
+                 ((lambda (#{tmp\ 2674}#)
+                    ((lambda (#{tmp\ 2675}#)
+                       (if #{tmp\ 2675}#
+                         (apply (lambda (#{p\ 2676}#)
+                                  (if (= #{lev\ 2673}# 0)
+                                    #{p\ 2676}#
+                                    (#{quasicons\ 2632}#
+                                      '(#(syntax-object
+                                          quote
+                                          ((top)
+                                           #(ribcage #(p) #((top)) #("i"))
+                                           #(ribcage () () ())
+                                           #(ribcage
+                                             #(p lev)
+                                             #((top) (top))
+                                             #("i" "i"))
+                                           #(ribcage
+                                             #(quasicons
+                                               quasiappend
+                                               quasivector
+                                               quasi)
+                                             #((top) (top) (top) (top))
+                                             #("i" "i" "i" "i")))
+                                          (hygiene guile))
+                                        #(syntax-object
+                                          unquote
+                                          ((top)
+                                           #(ribcage #(p) #((top)) #("i"))
+                                           #(ribcage () () ())
+                                           #(ribcage
+                                             #(p lev)
+                                             #((top) (top))
+                                             #("i" "i"))
+                                           #(ribcage
+                                             #(quasicons
+                                               quasiappend
+                                               quasivector
+                                               quasi)
+                                             #((top) (top) (top) (top))
+                                             #("i" "i" "i" "i")))
+                                          (hygiene guile)))
+                                      (#{quasi\ 2635}#
+                                        (list #{p\ 2676}#)
+                                        (- #{lev\ 2673}# 1)))))
+                                #{tmp\ 2675}#)
+                         ((lambda (#{tmp\ 2677}#)
+                            (if (if #{tmp\ 2677}#
+                                  (apply (lambda (#{args\ 2678}#)
+                                           (= #{lev\ 2673}# 0))
+                                         #{tmp\ 2677}#)
+                                  #f)
+                              (apply (lambda (#{args\ 2679}#)
+                                       (syntax-violation
+                                         'unquote
+                                         "unquote takes exactly one argument"
+                                         #{p\ 2672}#
+                                         (cons '#(syntax-object
+                                                  unquote
+                                                  ((top)
+                                                   #(ribcage
+                                                     #(args)
+                                                     #((top))
+                                                     #("i"))
+                                                   #(ribcage () () ())
+                                                   #(ribcage
+                                                     #(p lev)
+                                                     #((top) (top))
+                                                     #("i" "i"))
+                                                   #(ribcage
+                                                     #(quasicons
+                                                       quasiappend
+                                                       quasivector
+                                                       quasi)
+                                                     #((top) (top) (top) (top))
+                                                     #("i" "i" "i" "i")))
+                                                  (hygiene guile))
+                                               #{args\ 2679}#)))
+                                     #{tmp\ 2677}#)
+                              ((lambda (#{tmp\ 2680}#)
+                                 (if #{tmp\ 2680}#
+                                   (apply (lambda (#{p\ 2681}# #{q\ 2682}#)
+                                            (if (= #{lev\ 2673}# 0)
+                                              (#{quasiappend\ 2633}#
+                                                #{p\ 2681}#
+                                                (#{quasi\ 2635}#
+                                                  #{q\ 2682}#
+                                                  #{lev\ 2673}#))
+                                              (#{quasicons\ 2632}#
+                                                (#{quasicons\ 2632}#
+                                                  '(#(syntax-object
+                                                      quote
+                                                      ((top)
+                                                       #(ribcage
+                                                         #(p q)
+                                                         #((top) (top))
+                                                         #("i" "i"))
+                                                       #(ribcage () () ())
+                                                       #(ribcage
+                                                         #(p lev)
+                                                         #((top) (top))
+                                                         #("i" "i"))
+                                                       #(ribcage
+                                                         #(quasicons
+                                                           quasiappend
+                                                           quasivector
+                                                           quasi)
+                                                         #((top)
+                                                           (top)
+                                                           (top)
+                                                           (top))
+                                                         #("i" "i" "i" "i")))
+                                                      (hygiene guile))
+                                                    #(syntax-object
+                                                      unquote-splicing
+                                                      ((top)
+                                                       #(ribcage
+                                                         #(p q)
+                                                         #((top) (top))
+                                                         #("i" "i"))
+                                                       #(ribcage () () ())
+                                                       #(ribcage
+                                                         #(p lev)
+                                                         #((top) (top))
+                                                         #("i" "i"))
+                                                       #(ribcage
+                                                         #(quasicons
+                                                           quasiappend
+                                                           quasivector
+                                                           quasi)
+                                                         #((top)
+                                                           (top)
+                                                           (top)
+                                                           (top))
+                                                         #("i" "i" "i" "i")))
+                                                      (hygiene guile)))
+                                                  (#{quasi\ 2635}#
+                                                    (list #{p\ 2681}#)
+                                                    (- #{lev\ 2673}# 1)))
+                                                (#{quasi\ 2635}#
+                                                  #{q\ 2682}#
+                                                  #{lev\ 2673}#))))
+                                          #{tmp\ 2680}#)
+                                   ((lambda (#{tmp\ 2683}#)
+                                      (if (if #{tmp\ 2683}#
+                                            (apply (lambda (#{args\ 2684}#
+                                                            #{q\ 2685}#)
+                                                     (= #{lev\ 2673}# 0))
+                                                   #{tmp\ 2683}#)
+                                            #f)
+                                        (apply (lambda (#{args\ 2686}#
+                                                        #{q\ 2687}#)
+                                                 (syntax-violation
+                                                   'unquote-splicing
+                                                   "unquote-splicing takes exactly one argument"
+                                                   #{p\ 2672}#
+                                                   (cons '#(syntax-object
+                                                            unquote-splicing
+                                                            ((top)
+                                                             #(ribcage
+                                                               #(args q)
+                                                               #((top) (top))
+                                                               #("i" "i"))
+                                                             #(ribcage
+                                                               ()
+                                                               ()
+                                                               ())
+                                                             #(ribcage
+                                                               #(p lev)
+                                                               #((top) (top))
+                                                               #("i" "i"))
+                                                             #(ribcage
+                                                               #(quasicons
+                                                                 quasiappend
+                                                                 quasivector
+                                                                 quasi)
+                                                               #((top)
+                                                                 (top)
+                                                                 (top)
+                                                                 (top))
+                                                               #("i"
+                                                                 "i"
+                                                                 "i"
+                                                                 "i")))
+                                                            (hygiene guile))
+                                                         #{args\ 2686}#)))
+                                               #{tmp\ 2683}#)
+                                        ((lambda (#{tmp\ 2688}#)
+                                           (if #{tmp\ 2688}#
+                                             (apply (lambda (#{p\ 2689}#)
+                                                      (#{quasicons\ 2632}#
+                                                        '(#(syntax-object
+                                                            quote
+                                                            ((top)
+                                                             #(ribcage
+                                                               #(p)
+                                                               #((top))
+                                                               #("i"))
+                                                             #(ribcage
+                                                               ()
+                                                               ()
+                                                               ())
+                                                             #(ribcage
+                                                               #(p lev)
+                                                               #((top) (top))
+                                                               #("i" "i"))
+                                                             #(ribcage
+                                                               #(quasicons
+                                                                 quasiappend
+                                                                 quasivector
+                                                                 quasi)
+                                                               #((top)
+                                                                 (top)
+                                                                 (top)
+                                                                 (top))
+                                                               #("i"
+                                                                 "i"
+                                                                 "i"
+                                                                 "i")))
+                                                            (hygiene guile))
+                                                          #(syntax-object
+                                                            quasiquote
+                                                            ((top)
+                                                             #(ribcage
+                                                               #(p)
+                                                               #((top))
+                                                               #("i"))
+                                                             #(ribcage
+                                                               ()
+                                                               ()
+                                                               ())
+                                                             #(ribcage
+                                                               #(p lev)
+                                                               #((top) (top))
+                                                               #("i" "i"))
+                                                             #(ribcage
+                                                               #(quasicons
+                                                                 quasiappend
+                                                                 quasivector
+                                                                 quasi)
+                                                               #((top)
+                                                                 (top)
+                                                                 (top)
+                                                                 (top))
+                                                               #("i"
+                                                                 "i"
+                                                                 "i"
+                                                                 "i")))
+                                                            (hygiene guile)))
+                                                        (#{quasi\ 2635}#
+                                                          (list #{p\ 2689}#)
+                                                          (+ #{lev\ 2673}#
+                                                             1))))
+                                                    #{tmp\ 2688}#)
+                                             ((lambda (#{tmp\ 2690}#)
+                                                (if #{tmp\ 2690}#
+                                                  (apply (lambda (#{p\ 2691}#
+                                                                  #{q\ 2692}#)
+                                                           (#{quasicons\ 2632}#
+                                                             (#{quasi\ 2635}#
+                                                               #{p\ 2691}#
+                                                               #{lev\ 2673}#)
+                                                             (#{quasi\ 2635}#
+                                                               #{q\ 2692}#
+                                                               #{lev\ 2673}#)))
+                                                         #{tmp\ 2690}#)
+                                                  ((lambda (#{tmp\ 2693}#)
+                                                     (if #{tmp\ 2693}#
+                                                       (apply (lambda (#{x\ 2694}#)
+                                                                (#{quasivector\ 2634}#
+                                                                  (#{quasi\ 2635}#
+                                                                    #{x\ 2694}#
+                                                                    #{lev\ 2673}#)))
+                                                              #{tmp\ 2693}#)
+                                                       ((lambda (#{p\ 2696}#)
+                                                          (list '#(syntax-object
+                                                                   quote
+                                                                   ((top)
+                                                                    #(ribcage
+                                                                      #(p)
+                                                                      #((top))
+                                                                      #("i"))
+                                                                    #(ribcage
+                                                                      ()
+                                                                      ()
+                                                                      ())
+                                                                    #(ribcage
+                                                                      #(p lev)
+                                                                      #((top)
+                                                                        (top))
+                                                                      #("i"
+                                                                        "i"))
+                                                                    #(ribcage
+                                                                      #(quasicons
+                                                                        quasiappend
+                                                                        quasivector
+                                                                        quasi)
+                                                                      #((top)
+                                                                        (top)
+                                                                        (top)
+                                                                        (top))
+                                                                      #("i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i")))
+                                                                   (hygiene
+                                                                     guile))
+                                                                #{p\ 2696}#))
+                                                        #{tmp\ 2674}#)))
+                                                   ($sc-dispatch
+                                                     #{tmp\ 2674}#
+                                                     '#(vector each-any)))))
+                                              ($sc-dispatch
+                                                #{tmp\ 2674}#
+                                                '(any . any)))))
+                                         ($sc-dispatch
+                                           #{tmp\ 2674}#
+                                           '(#(free-id
+                                               #(syntax-object
+                                                 quasiquote
+                                                 ((top)
+                                                  #(ribcage () () ())
+                                                  #(ribcage
+                                                    #(p lev)
+                                                    #((top) (top))
+                                                    #("i" "i"))
+                                                  #(ribcage
+                                                    #(quasicons
+                                                      quasiappend
+                                                      quasivector
+                                                      quasi)
+                                                    #((top) (top) (top) (top))
+                                                    #("i" "i" "i" "i")))
+                                                 (hygiene guile)))
+                                             any)))))
+                                    ($sc-dispatch
+                                      #{tmp\ 2674}#
+                                      '((#(free-id
+                                           #(syntax-object
+                                             unquote-splicing
+                                             ((top)
+                                              #(ribcage () () ())
+                                              #(ribcage
+                                                #(p lev)
+                                                #((top) (top))
+                                                #("i" "i"))
+                                              #(ribcage
+                                                #(quasicons
+                                                  quasiappend
+                                                  quasivector
+                                                  quasi)
+                                                #((top) (top) (top) (top))
+                                                #("i" "i" "i" "i")))
+                                             (hygiene guile)))
+                                         .
+                                         any)
+                                        .
+                                        any)))))
+                               ($sc-dispatch
+                                 #{tmp\ 2674}#
+                                 '((#(free-id
+                                      #(syntax-object
+                                        unquote-splicing
+                                        ((top)
+                                         #(ribcage () () ())
+                                         #(ribcage
+                                           #(p lev)
+                                           #((top) (top))
+                                           #("i" "i"))
+                                         #(ribcage
+                                           #(quasicons
+                                             quasiappend
+                                             quasivector
+                                             quasi)
+                                           #((top) (top) (top) (top))
+                                           #("i" "i" "i" "i")))
+                                        (hygiene guile)))
+                                    any)
+                                   .
+                                   any)))))
+                          ($sc-dispatch
+                            #{tmp\ 2674}#
+                            '(#(free-id
+                                #(syntax-object
+                                  unquote
+                                  ((top)
+                                   #(ribcage () () ())
+                                   #(ribcage
+                                     #(p lev)
+                                     #((top) (top))
+                                     #("i" "i"))
+                                   #(ribcage
+                                     #(quasicons quasiappend quasivector quasi)
+                                     #((top) (top) (top) (top))
+                                     #("i" "i" "i" "i")))
+                                  (hygiene guile)))
+                              .
+                              any)))))
+                     ($sc-dispatch
+                       #{tmp\ 2674}#
+                       '(#(free-id
+                           #(syntax-object
+                             unquote
+                             ((top)
+                              #(ribcage () () ())
+                              #(ribcage #(p lev) #((top) (top)) #("i" "i"))
+                              #(ribcage
+                                #(quasicons quasiappend quasivector quasi)
+                                #((top) (top) (top) (top))
+                                #("i" "i" "i" "i")))
+                             (hygiene guile)))
+                         any))))
+                  #{p\ 2672}#))))
+      (lambda (#{x\ 2697}#)
+        ((lambda (#{tmp\ 2698}#)
+           ((lambda (#{tmp\ 2699}#)
+              (if #{tmp\ 2699}#
+                (apply (lambda (#{_\ 2700}# #{e\ 2701}#)
+                         (#{quasi\ 2635}# #{e\ 2701}# 0))
+                       #{tmp\ 2699}#)
+                (syntax-violation
+                  #f
+                  "source expression failed to match any pattern"
+                  #{tmp\ 2698}#)))
+            ($sc-dispatch #{tmp\ 2698}# (quote (any any)))))
+         #{x\ 2697}#)))))
+
+(define include
+  (make-syncase-macro
+    'macro
+    (lambda (#{x\ 2702}#)
+      (letrec ((#{read-file\ 2703}#
+                 (lambda (#{fn\ 2704}# #{k\ 2705}#)
+                   (let ((#{p\ 2706}# (open-input-file #{fn\ 2704}#)))
+                     (letrec ((#{f\ 2707}#
+                                (lambda (#{x\ 2708}#)
+                                  (if (eof-object? #{x\ 2708}#)
+                                    (begin
+                                      (close-input-port #{p\ 2706}#)
+                                      '())
+                                    (cons (datum->syntax
+                                            #{k\ 2705}#
+                                            #{x\ 2708}#)
+                                          (#{f\ 2707}# (read #{p\ 2706}#)))))))
+                       (#{f\ 2707}# (read #{p\ 2706}#)))))))
+        ((lambda (#{tmp\ 2709}#)
+           ((lambda (#{tmp\ 2710}#)
+              (if #{tmp\ 2710}#
+                (apply (lambda (#{k\ 2711}# #{filename\ 2712}#)
+                         (let ((#{fn\ 2713}#
+                                 (syntax->datum #{filename\ 2712}#)))
+                           ((lambda (#{tmp\ 2714}#)
+                              ((lambda (#{tmp\ 2715}#)
+                                 (if #{tmp\ 2715}#
+                                   (apply (lambda (#{exp\ 2716}#)
+                                            (cons '#(syntax-object
+                                                     begin
+                                                     ((top)
+                                                      #(ribcage
+                                                        #(exp)
+                                                        #((top))
+                                                        #("i"))
+                                                      #(ribcage () () ())
+                                                      #(ribcage () () ())
+                                                      #(ribcage
+                                                        #(fn)
+                                                        #((top))
+                                                        #("i"))
+                                                      #(ribcage
+                                                        #(k filename)
+                                                        #((top) (top))
+                                                        #("i" "i"))
+                                                      #(ribcage
+                                                        (read-file)
+                                                        ((top))
+                                                        ("i"))
+                                                      #(ribcage
+                                                        #(x)
+                                                        #((top))
+                                                        #("i")))
+                                                     (hygiene guile))
+                                                  #{exp\ 2716}#))
+                                          #{tmp\ 2715}#)
+                                   (syntax-violation
+                                     #f
+                                     "source expression failed to match any pattern"
+                                     #{tmp\ 2714}#)))
+                               ($sc-dispatch #{tmp\ 2714}# (quote each-any))))
+                            (#{read-file\ 2703}# #{fn\ 2713}# #{k\ 2711}#))))
+                       #{tmp\ 2710}#)
+                (syntax-violation
+                  #f
+                  "source expression failed to match any pattern"
+                  #{tmp\ 2709}#)))
+            ($sc-dispatch #{tmp\ 2709}# (quote (any any)))))
+         #{x\ 2702}#)))))
+
+(define unquote
+  (make-syncase-macro
+    'macro
+    (lambda (#{x\ 2718}#)
+      ((lambda (#{tmp\ 2719}#)
+         ((lambda (#{tmp\ 2720}#)
+            (if #{tmp\ 2720}#
+              (apply (lambda (#{_\ 2721}# #{e\ 2722}#)
+                       (syntax-violation
+                         'unquote
+                         "expression not valid outside of quasiquote"
+                         #{x\ 2718}#))
+                     #{tmp\ 2720}#)
+              (syntax-violation
+                #f
+                "source expression failed to match any pattern"
+                #{tmp\ 2719}#)))
+          ($sc-dispatch #{tmp\ 2719}# (quote (any any)))))
+       #{x\ 2718}#))))
+
+(define unquote-splicing
+  (make-syncase-macro
+    'macro
+    (lambda (#{x\ 2723}#)
+      ((lambda (#{tmp\ 2724}#)
+         ((lambda (#{tmp\ 2725}#)
+            (if #{tmp\ 2725}#
+              (apply (lambda (#{_\ 2726}# #{e\ 2727}#)
+                       (syntax-violation
+                         'unquote-splicing
+                         "expression not valid outside of quasiquote"
+                         #{x\ 2723}#))
+                     #{tmp\ 2725}#)
+              (syntax-violation
+                #f
+                "source expression failed to match any pattern"
+                #{tmp\ 2724}#)))
+          ($sc-dispatch #{tmp\ 2724}# (quote (any any)))))
+       #{x\ 2723}#))))
+
+(define case
+  (make-extended-syncase-macro
+    (module-ref (current-module) (quote case))
+    'macro
+    (lambda (#{x\ 2728}#)
+      ((lambda (#{tmp\ 2729}#)
+         ((lambda (#{tmp\ 2730}#)
+            (if #{tmp\ 2730}#
+              (apply (lambda (#{_\ 2731}#
+                              #{e\ 2732}#
+                              #{m1\ 2733}#
+                              #{m2\ 2734}#)
+                       ((lambda (#{tmp\ 2735}#)
+                          ((lambda (#{body\ 2736}#)
+                             (list '#(syntax-object
+                                      let
+                                      ((top)
+                                       #(ribcage #(body) #((top)) #("i"))
+                                       #(ribcage
+                                         #(_ e m1 m2)
+                                         #((top) (top) (top) (top))
+                                         #("i" "i" "i" "i"))
+                                       #(ribcage () () ())
+                                       #(ribcage #(x) #((top)) #("i")))
+                                      (hygiene guile))
+                                   (list (list '#(syntax-object
+                                                  t
+                                                  ((top)
+                                                   #(ribcage
+                                                     #(body)
+                                                     #((top))
+                                                     #("i"))
+                                                   #(ribcage
+                                                     #(_ e m1 m2)
+                                                     #((top) (top) (top) (top))
+                                                     #("i" "i" "i" "i"))
+                                                   #(ribcage () () ())
+                                                   #(ribcage
+                                                     #(x)
+                                                     #((top))
+                                                     #("i")))
+                                                  (hygiene guile))
+                                               #{e\ 2732}#))
+                                   #{body\ 2736}#))
+                           #{tmp\ 2735}#))
+                        (letrec ((#{f\ 2737}#
+                                   (lambda (#{clause\ 2738}# #{clauses\ 2739}#)
+                                     (if (null? #{clauses\ 2739}#)
+                                       ((lambda (#{tmp\ 2741}#)
+                                          ((lambda (#{tmp\ 2742}#)
+                                             (if #{tmp\ 2742}#
+                                               (apply (lambda (#{e1\ 2743}#
+                                                               #{e2\ 2744}#)
+                                                        (cons '#(syntax-object
+                                                                 begin
+                                                                 ((top)
+                                                                  #(ribcage
+                                                                    #(e1 e2)
+                                                                    #((top)
+                                                                      (top))
+                                                                    #("i" "i"))
+                                                                  #(ribcage
+                                                                    ()
+                                                                    ()
+                                                                    ())
+                                                                  #(ribcage
+                                                                    #(f
+                                                                      clause
+                                                                      clauses)
+                                                                    #((top)
+                                                                      (top)
+                                                                      (top))
+                                                                    #("i"
+                                                                      "i"
+                                                                      "i"))
+                                                                  #(ribcage
+                                                                    #(_
+                                                                      e
+                                                                      m1
+                                                                      m2)
+                                                                    #((top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top))
+                                                                    #("i"
+                                                                      "i"
+                                                                      "i"
+                                                                      "i"))
+                                                                  #(ribcage
+                                                                    ()
+                                                                    ()
+                                                                    ())
+                                                                  #(ribcage
+                                                                    #(x)
+                                                                    #((top))
+                                                                    #("i")))
+                                                                 (hygiene
+                                                                   guile))
+                                                              (cons #{e1\ 2743}#
+                                                                    #{e2\ 2744}#)))
+                                                      #{tmp\ 2742}#)
+                                               ((lambda (#{tmp\ 2746}#)
+                                                  (if #{tmp\ 2746}#
+                                                    (apply (lambda (#{k\ 2747}#
+                                                                    #{e1\ 2748}#
+                                                                    #{e2\ 2749}#)
+                                                             (list '#(syntax-object
+                                                                      if
+                                                                      ((top)
+                                                                       #(ribcage
+                                                                         #(k
+                                                                           e1
+                                                                           e2)
+                                                                         #((top)
+                                                                           (top)
+                                                                           (top))
+                                                                         #("i"
+                                                                           "i"
+                                                                           "i"))
+                                                                       #(ribcage
+                                                                         ()
+                                                                         ()
+                                                                         ())
+                                                                       #(ribcage
+                                                                         #(f
+                                                                           clause
+                                                                           clauses)
+                                                                         #((top)
+                                                                           (top)
+                                                                           (top))
+                                                                         #("i"
+                                                                           "i"
+                                                                           "i"))
+                                                                       #(ribcage
+                                                                         #(_
+                                                                           e
+                                                                           m1
+                                                                           m2)
+                                                                         #((top)
+                                                                           (top)
+                                                                           (top)
+                                                                           (top))
+                                                                         #("i"
+                                                                           "i"
+                                                                           "i"
+                                                                           "i"))
+                                                                       #(ribcage
+                                                                         ()
+                                                                         ()
+                                                                         ())
+                                                                       #(ribcage
+                                                                         #(x)
+                                                                         #((top))
+                                                                         #("i")))
+                                                                      (hygiene
+                                                                        guile))
+                                                                   (list '#(syntax-object
+                                                                            memv
+                                                                            ((top)
+                                                                             #(ribcage
+                                                                               #(k
+                                                                                 e1
+                                                                                 e2)
+                                                                               #((top)
+                                                                                 (top)
+                                                                                 (top))
+                                                                               #("i"
+                                                                                 "i"
+                                                                                 "i"))
+                                                                             #(ribcage
+                                                                               ()
+                                                                               ()
+                                                                               ())
+                                                                             #(ribcage
+                                                                               #(f
+                                                                                 clause
+                                                                                 clauses)
+                                                                               #((top)
+                                                                                 (top)
+                                                                                 (top))
+                                                                               #("i"
+                                                                                 "i"
+                                                                                 "i"))
+                                                                             #(ribcage
+                                                                               #(_
+                                                                                 e
+                                                                                 m1
+                                                                                 m2)
+                                                                               #((top)
+                                                                                 (top)
+                                                                                 (top)
+                                                                                 (top))
+                                                                               #("i"
+                                                                                 "i"
+                                                                                 "i"
+                                                                                 "i"))
+                                                                             #(ribcage
+                                                                               ()
+                                                                               ()
+                                                                               ())
+                                                                             #(ribcage
+                                                                               #(x)
+                                                                               #((top))
+                                                                               #("i")))
+                                                                            (hygiene
+                                                                              guile))
+                                                                         '#(syntax-object
+                                                                            t
+                                                                            ((top)
+                                                                             #(ribcage
+                                                                               #(k
+                                                                                 e1
+                                                                                 e2)
+                                                                               #((top)
+                                                                                 (top)
+                                                                                 (top))
+                                                                               #("i"
+                                                                                 "i"
+                                                                                 "i"))
+                                                                             #(ribcage
+                                                                               ()
+                                                                               ()
+                                                                               ())
+                                                                             #(ribcage
+                                                                               #(f
+                                                                                 clause
+                                                                                 clauses)
+                                                                               #((top)
+                                                                                 (top)
+                                                                                 (top))
+                                                                               #("i"
+                                                                                 "i"
+                                                                                 "i"))
+                                                                             #(ribcage
+                                                                               #(_
+                                                                                 e
+                                                                                 m1
+                                                                                 m2)
+                                                                               #((top)
+                                                                                 (top)
+                                                                                 (top)
+                                                                                 (top))
+                                                                               #("i"
+                                                                                 "i"
+                                                                                 "i"
+                                                                                 "i"))
+                                                                             #(ribcage
+                                                                               ()
+                                                                               ()
+                                                                               ())
+                                                                             #(ribcage
+                                                                               #(x)
+                                                                               #((top))
+                                                                               #("i")))
+                                                                            (hygiene
+                                                                              guile))
+                                                                         (list '#(syntax-object
+                                                                                  quote
+                                                                                  ((top)
+                                                                                   #(ribcage
+                                                                                     #(k
+                                                                                       e1
+                                                                                       e2)
+                                                                                     #((top)
+                                                                                       (top)
+                                                                                       (top))
+                                                                                     #("i"
+                                                                                       "i"
+                                                                                       "i"))
+                                                                                   #(ribcage
+                                                                                     ()
+                                                                                     ()
+                                                                                     ())
+                                                                                   #(ribcage
+                                                                                     #(f
+                                                                                       clause
+                                                                                       clauses)
+                                                                                     #((top)
+                                                                                       (top)
+                                                                                       (top))
+                                                                                     #("i"
+                                                                                       "i"
+                                                                                       "i"))
+                                                                                   #(ribcage
+                                                                                     #(_
+                                                                                       e
+                                                                                       m1
+                                                                                       m2)
+                                                                                     #((top)
+                                                                                       (top)
+                                                                                       (top)
+                                                                                       (top))
+                                                                                     #("i"
+                                                                                       "i"
+                                                                                       "i"
+                                                                                       "i"))
+                                                                                   #(ribcage
+                                                                                     ()
+                                                                                     ()
+                                                                                     ())
+                                                                                   #(ribcage
+                                                                                     #(x)
+                                                                                     #((top))
+                                                                                     #("i")))
+                                                                                  (hygiene
+                                                                                    guile))
+                                                                               #{k\ 2747}#))
+                                                                   (cons '#(syntax-object
+                                                                            begin
+                                                                            ((top)
+                                                                             #(ribcage
+                                                                               #(k
+                                                                                 e1
+                                                                                 e2)
+                                                                               #((top)
+                                                                                 (top)
+                                                                                 (top))
+                                                                               #("i"
+                                                                                 "i"
+                                                                                 "i"))
+                                                                             #(ribcage
+                                                                               ()
+                                                                               ()
+                                                                               ())
+                                                                             #(ribcage
+                                                                               #(f
+                                                                                 clause
+                                                                                 clauses)
+                                                                               #((top)
+                                                                                 (top)
+                                                                                 (top))
+                                                                               #("i"
+                                                                                 "i"
+                                                                                 "i"))
+                                                                             #(ribcage
+                                                                               #(_
+                                                                                 e
+                                                                                 m1
+                                                                                 m2)
+                                                                               #((top)
+                                                                                 (top)
+                                                                                 (top)
+                                                                                 (top))
+                                                                               #("i"
+                                                                                 "i"
+                                                                                 "i"
+                                                                                 "i"))
+                                                                             #(ribcage
+                                                                               ()
+                                                                               ()
+                                                                               ())
+                                                                             #(ribcage
+                                                                               #(x)
+                                                                               #((top))
+                                                                               #("i")))
+                                                                            (hygiene
+                                                                              guile))
+                                                                         (cons #{e1\ 2748}#
+                                                                               #{e2\ 2749}#))))
+                                                           #{tmp\ 2746}#)
+                                                    ((lambda (#{_\ 2752}#)
+                                                       (syntax-violation
+                                                         'case
+                                                         "bad clause"
+                                                         #{x\ 2728}#
+                                                         #{clause\ 2738}#))
+                                                     #{tmp\ 2741}#)))
+                                                ($sc-dispatch
+                                                  #{tmp\ 2741}#
+                                                  '(each-any
+                                                     any
+                                                     .
+                                                     each-any)))))
+                                           ($sc-dispatch
+                                             #{tmp\ 2741}#
+                                             '(#(free-id
+                                                 #(syntax-object
+                                                   else
+                                                   ((top)
+                                                    #(ribcage () () ())
+                                                    #(ribcage
+                                                      #(f clause clauses)
+                                                      #((top) (top) (top))
+                                                      #("i" "i" "i"))
+                                                    #(ribcage
+                                                      #(_ e m1 m2)
+                                                      #((top)
+                                                        (top)
+                                                        (top)
+                                                        (top))
+                                                      #("i" "i" "i" "i"))
+                                                    #(ribcage () () ())
+                                                    #(ribcage
+                                                      #(x)
+                                                      #((top))
+                                                      #("i")))
+                                                   (hygiene guile)))
+                                               any
+                                               .
+                                               each-any))))
+                                        #{clause\ 2738}#)
+                                       ((lambda (#{tmp\ 2753}#)
+                                          ((lambda (#{rest\ 2754}#)
+                                             ((lambda (#{tmp\ 2755}#)
+                                                ((lambda (#{tmp\ 2756}#)
+                                                   (if #{tmp\ 2756}#
+                                                     (apply (lambda (#{k\ 2757}#
+                                                                     #{e1\ 2758}#
+                                                                     #{e2\ 2759}#)
+                                                              (list '#(syntax-object
+                                                                       if
+                                                                       ((top)
+                                                                        #(ribcage
+                                                                          #(k
+                                                                            e1
+                                                                            e2)
+                                                                          #((top)
+                                                                            (top)
+                                                                            (top))
+                                                                          #("i"
+                                                                            "i"
+                                                                            "i"))
+                                                                        #(ribcage
+                                                                          #(rest)
+                                                                          #((top))
+                                                                          #("i"))
+                                                                        #(ribcage
+                                                                          ()
+                                                                          ()
+                                                                          ())
+                                                                        #(ribcage
+                                                                          #(f
+                                                                            clause
+                                                                            clauses)
+                                                                          #((top)
+                                                                            (top)
+                                                                            (top))
+                                                                          #("i"
+                                                                            "i"
+                                                                            "i"))
+                                                                        #(ribcage
+                                                                          #(_
+                                                                            e
+                                                                            m1
+                                                                            m2)
+                                                                          #((top)
+                                                                            (top)
+                                                                            (top)
+                                                                            (top))
+                                                                          #("i"
+                                                                            "i"
+                                                                            "i"
+                                                                            "i"))
+                                                                        #(ribcage
+                                                                          ()
+                                                                          ()
+                                                                          ())
+                                                                        #(ribcage
+                                                                          #(x)
+                                                                          #((top))
+                                                                          #("i")))
+                                                                       (hygiene
+                                                                         guile))
+                                                                    (list '#(syntax-object
+                                                                             memv
+                                                                             ((top)
+                                                                              #(ribcage
+                                                                                #(k
+                                                                                  e1
+                                                                                  e2)
+                                                                                #((top)
+                                                                                  (top)
+                                                                                  (top))
+                                                                                #("i"
+                                                                                  "i"
+                                                                                  "i"))
+                                                                              #(ribcage
+                                                                                #(rest)
+                                                                                #((top))
+                                                                                #("i"))
+                                                                              #(ribcage
+                                                                                ()
+                                                                                ()
+                                                                                ())
+                                                                              #(ribcage
+                                                                                #(f
+                                                                                  clause
+                                                                                  clauses)
+                                                                                #((top)
+                                                                                  (top)
+                                                                                  (top))
+                                                                                #("i"
+                                                                                  "i"
+                                                                                  "i"))
+                                                                              #(ribcage
+                                                                                #(_
+                                                                                  e
+                                                                                  m1
+                                                                                  m2)
+                                                                                #((top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top))
+                                                                                #("i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"))
+                                                                              #(ribcage
+                                                                                ()
+                                                                                ()
+                                                                                ())
+                                                                              #(ribcage
+                                                                                #(x)
+                                                                                #((top))
+                                                                                #("i")))
+                                                                             (hygiene
+                                                                               guile))
+                                                                          '#(syntax-object
+                                                                             t
+                                                                             ((top)
+                                                                              #(ribcage
+                                                                                #(k
+                                                                                  e1
+                                                                                  e2)
+                                                                                #((top)
+                                                                                  (top)
+                                                                                  (top))
+                                                                                #("i"
+                                                                                  "i"
+                                                                                  "i"))
+                                                                              #(ribcage
+                                                                                #(rest)
+                                                                                #((top))
+                                                                                #("i"))
+                                                                              #(ribcage
+                                                                                ()
+                                                                                ()
+                                                                                ())
+                                                                              #(ribcage
+                                                                                #(f
+                                                                                  clause
+                                                                                  clauses)
+                                                                                #((top)
+                                                                                  (top)
+                                                                                  (top))
+                                                                                #("i"
+                                                                                  "i"
+                                                                                  "i"))
+                                                                              #(ribcage
+                                                                                #(_
+                                                                                  e
+                                                                                  m1
+                                                                                  m2)
+                                                                                #((top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top))
+                                                                                #("i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"))
+                                                                              #(ribcage
+                                                                                ()
+                                                                                ()
+                                                                                ())
+                                                                              #(ribcage
+                                                                                #(x)
+                                                                                #((top))
+                                                                                #("i")))
+                                                                             (hygiene
+                                                                               guile))
+                                                                          (list '#(syntax-object
+                                                                                   quote
+                                                                                   ((top)
+                                                                                    #(ribcage
+                                                                                      #(k
+                                                                                        e1
+                                                                                        e2)
+                                                                                      #((top)
+                                                                                        (top)
+                                                                                        (top))
+                                                                                      #("i"
+                                                                                        "i"
+                                                                                        "i"))
+                                                                                    #(ribcage
+                                                                                      #(rest)
+                                                                                      #((top))
+                                                                                      #("i"))
+                                                                                    #(ribcage
+                                                                                      ()
+                                                                                      ()
+                                                                                      ())
+                                                                                    #(ribcage
+                                                                                      #(f
+                                                                                        clause
+                                                                                        clauses)
+                                                                                      #((top)
+                                                                                        (top)
+                                                                                        (top))
+                                                                                      #("i"
+                                                                                        "i"
+                                                                                        "i"))
+                                                                                    #(ribcage
+                                                                                      #(_
+                                                                                        e
+                                                                                        m1
+                                                                                        m2)
+                                                                                      #((top)
+                                                                                        (top)
+                                                                                        (top)
+                                                                                        (top))
+                                                                                      #("i"
+                                                                                        "i"
+                                                                                        "i"
+                                                                                        "i"))
+                                                                                    #(ribcage
+                                                                                      ()
+                                                                                      ()
+                                                                                      ())
+                                                                                    #(ribcage
+                                                                                      #(x)
+                                                                                      #((top))
+                                                                                      #("i")))
+                                                                                   (hygiene
+                                                                                     guile))
+                                                                                #{k\ 2757}#))
+                                                                    (cons '#(syntax-object
+                                                                             begin
+                                                                             ((top)
+                                                                              #(ribcage
+                                                                                #(k
+                                                                                  e1
+                                                                                  e2)
+                                                                                #((top)
+                                                                                  (top)
+                                                                                  (top))
+                                                                                #("i"
+                                                                                  "i"
+                                                                                  "i"))
+                                                                              #(ribcage
+                                                                                #(rest)
+                                                                                #((top))
+                                                                                #("i"))
+                                                                              #(ribcage
+                                                                                ()
+                                                                                ()
+                                                                                ())
+                                                                              #(ribcage
+                                                                                #(f
+                                                                                  clause
+                                                                                  clauses)
+                                                                                #((top)
+                                                                                  (top)
+                                                                                  (top))
+                                                                                #("i"
+                                                                                  "i"
+                                                                                  "i"))
+                                                                              #(ribcage
+                                                                                #(_
+                                                                                  e
+                                                                                  m1
+                                                                                  m2)
+                                                                                #((top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top))
+                                                                                #("i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"))
+                                                                              #(ribcage
+                                                                                ()
+                                                                                ()
+                                                                                ())
+                                                                              #(ribcage
+                                                                                #(x)
+                                                                                #((top))
+                                                                                #("i")))
+                                                                             (hygiene
+                                                                               guile))
+                                                                          (cons #{e1\ 2758}#
+                                                                                #{e2\ 2759}#))
+                                                                    #{rest\ 2754}#))
+                                                            #{tmp\ 2756}#)
+                                                     ((lambda (#{_\ 2762}#)
+                                                        (syntax-violation
+                                                          'case
+                                                          "bad clause"
+                                                          #{x\ 2728}#
+                                                          #{clause\ 2738}#))
+                                                      #{tmp\ 2755}#)))
+                                                 ($sc-dispatch
+                                                   #{tmp\ 2755}#
+                                                   '(each-any
+                                                      any
+                                                      .
+                                                      each-any))))
+                                              #{clause\ 2738}#))
+                                           #{tmp\ 2753}#))
+                                        (#{f\ 2737}#
+                                          (car #{clauses\ 2739}#)
+                                          (cdr #{clauses\ 2739}#)))))))
+                          (#{f\ 2737}# #{m1\ 2733}# #{m2\ 2734}#))))
+                     #{tmp\ 2730}#)
+              (syntax-violation
+                #f
+                "source expression failed to match any pattern"
+                #{tmp\ 2729}#)))
+          ($sc-dispatch
+            #{tmp\ 2729}#
+            '(any any any . each-any))))
+       #{x\ 2728}#))))
+
+(define identifier-syntax
+  (make-syncase-macro
+    'macro
+    (lambda (#{x\ 2763}#)
+      ((lambda (#{tmp\ 2764}#)
+         ((lambda (#{tmp\ 2765}#)
+            (if #{tmp\ 2765}#
+              (apply (lambda (#{_\ 2766}# #{e\ 2767}#)
+                       (list '#(syntax-object
+                                lambda
+                                ((top)
+                                 #(ribcage #(_ e) #((top) (top)) #("i" "i"))
+                                 #(ribcage () () ())
+                                 #(ribcage #(x) #((top)) #("i")))
+                                (hygiene guile))
+                             '(#(syntax-object
+                                 x
+                                 ((top)
+                                  #(ribcage #(_ e) #((top) (top)) #("i" "i"))
+                                  #(ribcage () () ())
+                                  #(ribcage #(x) #((top)) #("i")))
+                                 (hygiene guile)))
+                             (list '#(syntax-object
+                                      syntax-case
+                                      ((top)
+                                       #(ribcage
+                                         #(_ e)
+                                         #((top) (top))
+                                         #("i" "i"))
+                                       #(ribcage () () ())
+                                       #(ribcage #(x) #((top)) #("i")))
+                                      (hygiene guile))
+                                   '#(syntax-object
+                                      x
+                                      ((top)
+                                       #(ribcage
+                                         #(_ e)
+                                         #((top) (top))
+                                         #("i" "i"))
+                                       #(ribcage () () ())
+                                       #(ribcage #(x) #((top)) #("i")))
+                                      (hygiene guile))
+                                   '()
+                                   (list '#(syntax-object
+                                            id
+                                            ((top)
+                                             #(ribcage
+                                               #(_ e)
+                                               #((top) (top))
+                                               #("i" "i"))
+                                             #(ribcage () () ())
+                                             #(ribcage #(x) #((top)) #("i")))
+                                            (hygiene guile))
+                                         '(#(syntax-object
+                                             identifier?
+                                             ((top)
+                                              #(ribcage
+                                                #(_ e)
+                                                #((top) (top))
+                                                #("i" "i"))
+                                              #(ribcage () () ())
+                                              #(ribcage #(x) #((top)) #("i")))
+                                             (hygiene guile))
+                                           (#(syntax-object
+                                              syntax
+                                              ((top)
+                                               #(ribcage
+                                                 #(_ e)
+                                                 #((top) (top))
+                                                 #("i" "i"))
+                                               #(ribcage () () ())
+                                               #(ribcage #(x) #((top)) #("i")))
+                                              (hygiene guile))
+                                            #(syntax-object
+                                              id
+                                              ((top)
+                                               #(ribcage
+                                                 #(_ e)
+                                                 #((top) (top))
+                                                 #("i" "i"))
+                                               #(ribcage () () ())
+                                               #(ribcage #(x) #((top)) #("i")))
+                                              (hygiene guile))))
+                                         (list '#(syntax-object
+                                                  syntax
+                                                  ((top)
+                                                   #(ribcage
+                                                     #(_ e)
+                                                     #((top) (top))
+                                                     #("i" "i"))
+                                                   #(ribcage () () ())
+                                                   #(ribcage
+                                                     #(x)
+                                                     #((top))
+                                                     #("i")))
+                                                  (hygiene guile))
+                                               #{e\ 2767}#))
+                                   (list (cons #{_\ 2766}#
+                                               '(#(syntax-object
+                                                   x
+                                                   ((top)
+                                                    #(ribcage
+                                                      #(_ e)
+                                                      #((top) (top))
+                                                      #("i" "i"))
+                                                    #(ribcage () () ())
+                                                    #(ribcage
+                                                      #(x)
+                                                      #((top))
+                                                      #("i")))
+                                                   (hygiene guile))
+                                                 #(syntax-object
+                                                   ...
+                                                   ((top)
+                                                    #(ribcage
+                                                      #(_ e)
+                                                      #((top) (top))
+                                                      #("i" "i"))
+                                                    #(ribcage () () ())
+                                                    #(ribcage
+                                                      #(x)
+                                                      #((top))
+                                                      #("i")))
+                                                   (hygiene guile))))
+                                         (list '#(syntax-object
+                                                  syntax
+                                                  ((top)
+                                                   #(ribcage
+                                                     #(_ e)
+                                                     #((top) (top))
+                                                     #("i" "i"))
+                                                   #(ribcage () () ())
+                                                   #(ribcage
+                                                     #(x)
+                                                     #((top))
+                                                     #("i")))
+                                                  (hygiene guile))
+                                               (cons #{e\ 2767}#
+                                                     '(#(syntax-object
+                                                         x
+                                                         ((top)
+                                                          #(ribcage
+                                                            #(_ e)
+                                                            #((top) (top))
+                                                            #("i" "i"))
+                                                          #(ribcage () () ())
+                                                          #(ribcage
+                                                            #(x)
+                                                            #((top))
+                                                            #("i")))
+                                                         (hygiene guile))
+                                                       #(syntax-object
+                                                         ...
+                                                         ((top)
+                                                          #(ribcage
+                                                            #(_ e)
+                                                            #((top) (top))
+                                                            #("i" "i"))
+                                                          #(ribcage () () ())
+                                                          #(ribcage
+                                                            #(x)
+                                                            #((top))
+                                                            #("i")))
+                                                         (hygiene
+                                                           guile)))))))))
+                     #{tmp\ 2765}#)
+              (syntax-violation
+                #f
+                "source expression failed to match any pattern"
+                #{tmp\ 2764}#)))
+          ($sc-dispatch #{tmp\ 2764}# (quote (any any)))))
+       #{x\ 2763}#))))
+
diff --git a/ice-9/psyntax.ss b/module/ice-9/psyntax.scm
index 22e409d3e..cb90fcc17 100644
--- a/ice-9/psyntax.ss
+++ b/module/ice-9/psyntax.scm
@@ -1,11 +1,11 @@
 ;;;; -*-scheme-*-
 ;;;;
-;;;; 	Copyright (C) 2001, 2003, 2006 Free Software Foundation, Inc.
+;;;; 	Copyright (C) 2001, 2003, 2006, 2009 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -22,6 +22,9 @@
 ;;; Extracted from Chez Scheme Version 5.9f
 ;;; Authors: R. Kent Dybvig, Oscar Waddell, Bob Hieb, Carl Bruggeman
 
+;;; Modified by Andy Wingo <wingo@pobox.com> according to the Git
+;;; revision control logs corresponding to this file: 2009.
+
 ;;; Modified by Mikael Djurfeldt <djurfeldt@nada.kth.se> according
 ;;; to the ChangeLog distributed in the same directory as this file:
 ;;; 1997-08-19, 1997-09-03, 1997-09-10, 2000-08-13, 2000-08-24,
@@ -49,7 +52,7 @@
 ;;; also documented in the R4RS and draft R5RS.
 ;;;
 ;;;   bound-identifier=?
-;;;   datum->syntax-object
+;;;   datum->syntax
 ;;;   define-syntax
 ;;;   fluid-let-syntax
 ;;;   free-identifier=?
@@ -60,7 +63,7 @@
 ;;;   letrec-syntax
 ;;;   syntax
 ;;;   syntax-case
-;;;   syntax-object->datum
+;;;   syntax->datum
 ;;;   syntax-rules
 ;;;   with-syntax
 ;;;
@@ -79,46 +82,14 @@
 ;;;      conditionally evaluates expr ... at compile-time or run-time
 ;;;      depending upon situations (see the Chez Scheme System Manual,
 ;;;      Revision 3, for a complete description)
-;;;   (syntax-error object message)
+;;;   (syntax-violation who message form [subform])
 ;;;      used to report errors found during expansion
-;;;   (install-global-transformer symbol value)
-;;;      used by expanded code to install top-level syntactic abstractions
-;;;   (syntax-dispatch e p)
+;;;   ($sc-dispatch e p)
 ;;;      used by expanded code to handle syntax-case matching
 
 ;;; The following nonstandard procedures must be provided by the
-;;; implementation for this code to run.
-;;;
-;;; (void)
-;;; returns the implementation's cannonical "unspecified value".  This
-;;; usually works: (define void (lambda () (if #f #f))).
-;;;
-;;; (andmap proc list1 list2 ...)
-;;; returns true if proc returns true when applied to each element of list1
-;;; along with the corresponding elements of list2 ....
-;;; The following definition works but does no error checking:
-;;;
-;;; (define andmap
-;;;   (lambda (f first . rest)
-;;;     (or (null? first)
-;;;         (if (null? rest)
-;;;             (let andmap ((first first))
-;;;               (let ((x (car first)) (first (cdr first)))
-;;;                 (if (null? first)
-;;;                     (f x)
-;;;                     (and (f x) (andmap first)))))
-;;;             (let andmap ((first first) (rest rest))
-;;;               (let ((x (car first))
-;;;                     (xr (map car rest))
-;;;                     (first (cdr first))
-;;;                     (rest (map cdr rest)))
-;;;                 (if (null? first)
-;;;                     (apply f (cons x xr))
-;;;                     (and (apply f (cons x xr)) (andmap first rest)))))))))
-;;;
-;;; The following nonstandard procedures must also be provided by the
 ;;; implementation for this code to run using the standard portable
-;;; hooks and output constructors.  They are not used by expanded code,
+;;; hooks and output constructors. They are not used by expanded code,
 ;;; and so need be present only at expansion time.
 ;;;
 ;;; (eval x)
@@ -134,21 +105,8 @@
 ;;; by eval, and eval accepts one argument, nothing special must be done
 ;;; to support the "noexpand" flag, since it is handled by sc-expand.
 ;;;
-;;; (error who format-string why what)
-;;; where who is either a symbol or #f, format-string is always "~a ~s",
-;;; why is always a string, and what may be any object.  error should
-;;; signal an error with a message something like
-;;;
-;;;    "error in <who>: <why> <what>"
-;;;
 ;;; (gensym)
 ;;; returns a unique symbol each time it's called
-;;;
-;;; (putprop symbol key value)
-;;; (getprop symbol key)
-;;; key is always the symbol *sc-expander*; value may be any object.
-;;; putprop should associate the given value with the given symbol in
-;;; some way that it can be retrieved later with getprop.
 
 ;;; When porting to a new Scheme implementation, you should define the
 ;;; procedures listed above, load the expanded version of psyntax.ss
@@ -209,7 +167,7 @@
 
 ;;; Objects with no standard print syntax, including objects containing
 ;;; cycles and syntax object, are allowed in quoted data as long as they
-;;; are contained within a syntax form or produced by datum->syntax-object.
+;;; are contained within a syntax form or produced by datum->syntax.
 ;;; Such objects are never copied.
 
 ;;; All identifiers that don't have macro definitions and are not bound
@@ -233,19 +191,6 @@
 ;;; The implementation of generate-temporaries assumes that it is possible
 ;;; to generate globally unique symbols (gensyms).
 
-;;; The input to sc-expand may contain "annotations" describing, e.g., the
-;;; source file and character position from where each object was read if
-;;; it was read from a file.  These annotations are handled properly by
-;;; sc-expand only if the annotation? hook (see hooks below) is implemented
-;;; properly and the operators make-annotation, annotation-expression,
-;;; annotation-source, annotation-stripped, and set-annotation-stripped!
-;;; are supplied.  If annotations are supplied, the proper annotation
-;;; source is passed to the various output constructors, allowing
-;;; implementations to accurately correlate source and expanded code.
-;;; Contact one of the authors for details if you wish to make use of
-;;; this feature.
-
-
 
 ;;; Bootstrapping:
 
@@ -256,23 +201,45 @@
 
 
 
+(eval-when (compile)
+  (set-current-module (resolve-module '(guile))))
+
 (let ()
+;;; Private version of and-map that handles multiple lists.
+(define and-map*
+  (lambda (f first . rest)
+    (or (null? first)
+        (if (null? rest)
+            (let andmap ((first first))
+              (let ((x (car first)) (first (cdr first)))
+                (if (null? first)
+                    (f x)
+                    (and (f x) (andmap first)))))
+            (let andmap ((first first) (rest rest))
+              (let ((x (car first))
+                    (xr (map car rest))
+                    (first (cdr first))
+                    (rest (map cdr rest)))
+                (if (null? first)
+                    (apply f (cons x xr))
+                    (and (apply f (cons x xr)) (andmap first rest)))))))))
+
 (define-syntax define-structure
   (lambda (x)
     (define construct-name
       (lambda (template-identifier . args)
-        (datum->syntax-object
+        (datum->syntax
           template-identifier
           (string->symbol
             (apply string-append
                    (map (lambda (x)
                           (if (string? x)
                               x
-                              (symbol->string (syntax-object->datum x))))
+                              (symbol->string (syntax->datum x))))
                         args))))))
     (syntax-case x ()
       ((_ (name id1 ...))
-       (andmap identifier? (syntax (name id1 ...)))
+       (and-map identifier? (syntax (name id1 ...)))
        (with-syntax
          ((constructor (construct-name (syntax name) "make-" (syntax name)))
           (predicate (construct-name (syntax name) (syntax name) "?"))
@@ -310,6 +277,7 @@
 
 (let ()
 (define noexpand "noexpand")
+(define *mode* (make-fluid))
 
 ;;; hooks to nonportable run-time helpers
 (begin
@@ -318,140 +286,274 @@
 (define fx= =)
 (define fx< <)
 
-(define annotation? (lambda (x) #f))
-
 (define top-level-eval-hook
-  (lambda (x)
-    (eval `(,noexpand ,x) (interaction-environment))))
+  (lambda (x mod)
+    (primitive-eval
+     `(,noexpand
+       ,(case (fluid-ref *mode*)
+          ((c) ((@ (language tree-il) tree-il->scheme) x))
+          (else x))))))
 
 (define local-eval-hook
-  (lambda (x)
-    (eval `(,noexpand ,x) (interaction-environment))))
-
-(define error-hook
-  (lambda (who why what)
-    (error who "~a ~s" why what)))
+  (lambda (x mod)
+    (primitive-eval
+     `(,noexpand
+       ,(case (fluid-ref *mode*)
+          ((c) ((@ (language tree-il) tree-il->scheme) x))
+          (else x))))))
 
 (define-syntax gensym-hook
   (syntax-rules ()
     ((_) (gensym))))
 
 (define put-global-definition-hook
-  (lambda (symbol binding)
-     (putprop symbol '*sc-expander* binding)))
+  (lambda (symbol type val)
+    (let ((existing (let ((v (module-variable (current-module) symbol)))
+                      (and v (variable-bound? v)
+                           (let ((val (variable-ref v)))
+                             (and (macro? val)
+                                  (not (syncase-macro-type val))
+                                  val))))))
+      (module-define! (current-module)
+                      symbol
+                      (if existing
+                          (make-extended-syncase-macro existing type val)
+                          (make-syncase-macro type val))))))
 
 (define get-global-definition-hook
-  (lambda (symbol)
-     (getprop symbol '*sc-expander*)))
-)
+  (lambda (symbol module)
+    (if (and (not module) (current-module))
+        (warn "module system is booted, we should have a module" symbol))
+    (let ((v (module-variable (if module
+                                  (resolve-module (cdr module))
+                                  (current-module))
+                              symbol)))
+      (and v (variable-bound? v)
+           (let ((val (variable-ref v)))
+             (and (macro? val) (syncase-macro-type val)
+                  (cons (syncase-macro-type val)
+                        (syncase-macro-binding val))))))))
 
+)
 
-;;; output constructors
-(begin
-(define-syntax build-application
-  (syntax-rules ()
-    ((_ source fun-exp arg-exps)
-     `(,fun-exp . ,arg-exps))))
-
-(define-syntax build-conditional
-  (syntax-rules ()
-    ((_ source test-exp then-exp else-exp)
-     `(if ,test-exp ,then-exp ,else-exp))))
-
-(define-syntax build-lexical-reference
-  (syntax-rules ()
-    ((_ type source var)
-     var)))
-
-(define-syntax build-lexical-assignment
-  (syntax-rules ()
-    ((_ source var exp)
-     `(set! ,var ,exp))))
-
-(define-syntax build-global-reference
-  (syntax-rules ()
-    ((_ source var)
-     var)))
-
-(define-syntax build-global-assignment
-  (syntax-rules ()
-    ((_ source var exp)
-     `(set! ,var ,exp))))
 
-(define-syntax build-global-definition
-  (syntax-rules ()
-    ((_ source var exp)
-     `(define ,var ,exp))))
+(define (decorate-source e s)
+  (if (and (pair? e) s)
+      (set-source-properties! e s))
+  e)
 
-(define-syntax build-lambda
-  (syntax-rules ()
-    ((_ src vars exp)
-     `(lambda ,vars ,exp))))
-
-(define-syntax build-primref
-  (syntax-rules ()
-    ((_ src name) name)
-    ((_ src level name) name)))
+;;; output constructors
+(define build-void
+  (lambda (source)
+    (case (fluid-ref *mode*)
+      ((c) ((@ (language tree-il) make-void) source))
+      (else (decorate-source '(if #f #f) source)))))
+
+(define build-application
+  (lambda (source fun-exp arg-exps)
+    (case (fluid-ref *mode*)
+      ((c) ((@ (language tree-il) make-application) source fun-exp arg-exps))
+      (else (decorate-source `(,fun-exp . ,arg-exps) source)))))
+
+(define build-conditional
+  (lambda (source test-exp then-exp else-exp)
+    (case (fluid-ref *mode*)
+      ((c) ((@ (language tree-il) make-conditional)
+            source test-exp then-exp else-exp))
+      (else (decorate-source
+             (if (equal? else-exp '(if #f #f))
+                 `(if ,test-exp ,then-exp)
+                 `(if ,test-exp ,then-exp ,else-exp))
+             source)))))
+
+(define build-lexical-reference
+  (lambda (type source name var)
+    (case (fluid-ref *mode*)
+      ((c) ((@ (language tree-il) make-lexical-ref) source name var))
+      (else (decorate-source var source)))))
+
+(define build-lexical-assignment
+  (lambda (source name var exp)
+    (case (fluid-ref *mode*)
+      ((c) ((@ (language tree-il) make-lexical-set) source name var exp))
+      (else (decorate-source `(set! ,var ,exp) source)))))
+
+;; Before modules are booted, we can't expand into data structures from
+;; (language tree-il) -- we need to give the evaluator the
+;; s-expressions that it understands natively. Actually the real truth
+;; of the matter is that the evaluator doesn't understand tree-il
+;; structures at all. So until we fix the evaluator, if ever, the
+;; conflation that we should use tree-il iff we are compiling
+;; holds true.
+;;
+(define (analyze-variable mod var modref-cont bare-cont)
+  (if (not mod)
+      (bare-cont var)
+      (let ((kind (car mod))
+            (mod (cdr mod)))
+        (case kind
+          ((public) (modref-cont mod var #t))
+          ((private) (if (not (equal? mod (module-name (current-module))))
+                         (modref-cont mod var #f)
+                         (bare-cont var)))
+          ((bare) (bare-cont var))
+          ((hygiene) (if (and (not (equal? mod (module-name (current-module))))
+                              (module-variable (resolve-module mod) var))
+                         (modref-cont mod var #f)
+                         (bare-cont var)))
+          (else (syntax-violation #f "bad module kind" var mod))))))
+
+(define build-global-reference
+  (lambda (source var mod)
+    (analyze-variable
+     mod var
+     (lambda (mod var public?) 
+       (case (fluid-ref *mode*)
+         ((c) ((@ (language tree-il) make-module-ref) source mod var public?))
+         (else (decorate-source (list (if public? '@ '@@) mod var) source))))
+     (lambda (var)
+       (case (fluid-ref *mode*)
+         ((c) ((@ (language tree-il) make-toplevel-ref) source var))
+         (else (decorate-source var source)))))))
+
+(define build-global-assignment
+  (lambda (source var exp mod)
+    (analyze-variable
+     mod var
+     (lambda (mod var public?) 
+       (case (fluid-ref *mode*)
+         ((c) ((@ (language tree-il) make-module-set) source mod var public? exp))
+         (else (decorate-source `(set! ,(list (if public? '@ '@@) mod var) ,exp) source))))
+     (lambda (var)
+       (case (fluid-ref *mode*)
+         ((c) ((@ (language tree-il) make-toplevel-set) source var exp))
+         (else (decorate-source `(set! ,var ,exp) source)))))))
+
+;; FIXME: there is a bug that prevents (set! ((@ (foo) bar) baz) quz)
+;; from working. Hack around it.
+(define (maybe-name-value! name val)
+  (cond
+   (((@ (language tree-il) lambda?) val)
+    (let ((meta ((@ (language tree-il) lambda-meta) val)))
+      (if (not (assq 'name meta))
+          ((setter (@ (language tree-il) lambda-meta))
+           val
+           (acons 'name name meta)))))))
+
+(define build-global-definition
+  (lambda (source var exp)
+    (case (fluid-ref *mode*)
+      ((c)
+       (maybe-name-value! var exp)
+       ((@ (language tree-il) make-toplevel-define) source var exp))
+      (else (decorate-source `(define ,var ,exp) source)))))
+
+(define build-lambda
+  (lambda (src ids vars docstring exp)
+    (case (fluid-ref *mode*)
+      ((c) ((@ (language tree-il) make-lambda) src ids vars
+            (if docstring `((documentation . ,docstring)) '())
+            exp))
+      (else (decorate-source
+             `(lambda ,vars ,@(if docstring (list docstring) '())
+                      ,exp)
+             src)))))
+
+(define build-primref
+  (lambda (src name)
+    (if (equal? (module-name (current-module)) '(guile))
+        (case (fluid-ref *mode*)
+          ((c) ((@ (language tree-il) make-toplevel-ref) src name))
+          (else (decorate-source name src)))
+        (case (fluid-ref *mode*)
+          ((c) ((@ (language tree-il) make-module-ref) src '(guile) name #f))
+          (else (decorate-source `(@@ (guile) ,name) src))))))
 
 (define (build-data src exp)
-  (if (and (self-evaluating? exp)
-	   (not (vector? exp)))
-      exp
-      (list 'quote exp)))
+  (case (fluid-ref *mode*)
+    ((c) ((@ (language tree-il) make-const) src exp))
+    (else (decorate-source
+           (if (and (self-evaluating? exp) (not (vector? exp)))
+               exp
+               (list 'quote exp))
+           src))))
 
 (define build-sequence
   (lambda (src exps)
     (if (null? (cdr exps))
         (car exps)
-        `(begin ,@exps))))
+        (case (fluid-ref *mode*)
+          ((c) ((@ (language tree-il) make-sequence) src exps))
+          (else (decorate-source `(begin ,@exps) src))))))
 
 (define build-let
-  (lambda (src vars val-exps body-exp)
+  (lambda (src ids vars val-exps body-exp)
     (if (null? vars)
 	body-exp
-	`(let ,(map list vars val-exps) ,body-exp))))
+        (case (fluid-ref *mode*)
+          ((c)
+           (for-each maybe-name-value! ids val-exps)
+           ((@ (language tree-il) make-let) src ids vars val-exps body-exp))
+          (else (decorate-source
+                 `(let ,(map list vars val-exps) ,body-exp)
+                 src))))))
 
 (define build-named-let
-  (lambda (src vars val-exps body-exp)
-    (if (null? vars)
-	body-exp
-	`(let ,(car vars) ,(map list (cdr vars) val-exps) ,body-exp))))
+  (lambda (src ids vars val-exps body-exp)
+    (let ((f (car vars))
+          (f-name (car ids))
+          (vars (cdr vars))
+          (ids (cdr ids)))
+      (case (fluid-ref *mode*)
+        ((c)
+         (let ((proc (build-lambda src ids vars #f body-exp)))
+           (maybe-name-value! f-name proc)
+           (for-each maybe-name-value! ids val-exps)
+           ((@ (language tree-il) make-letrec) src
+            (list f-name) (list f) (list proc)
+            (build-application src (build-lexical-reference 'fun src f-name f)
+                               val-exps))))
+        (else (decorate-source
+               `(let ,f ,(map list vars val-exps) ,body-exp)
+               src))))))
 
 (define build-letrec
-  (lambda (src vars val-exps body-exp)
+  (lambda (src ids vars val-exps body-exp)
     (if (null? vars)
         body-exp
-        `(letrec ,(map list vars val-exps) ,body-exp))))
-
+        (case (fluid-ref *mode*)
+          ((c)
+           (for-each maybe-name-value! ids val-exps)
+           ((@ (language tree-il) make-letrec) src ids vars val-exps body-exp))
+          (else (decorate-source
+                 `(letrec ,(map list vars val-exps) ,body-exp)
+                 src))))))
+
+;; FIXME: use a faster gensym
 (define-syntax build-lexical-var
   (syntax-rules ()
-    ((_ src id) (gensym (symbol->string id)))))
-)
+    ((_ src id) (gensym (string-append (symbol->string id) " ")))))
 
-(define-structure (syntax-object expression wrap))
-
-(define-syntax unannotate
-  (syntax-rules ()
-    ((_ x)
-     (let ((e x))
-       (if (annotation? e)
-           (annotation-expression e)
-           e)))))
+(define-structure (syntax-object expression wrap module))
 
 (define-syntax no-source (identifier-syntax #f))
 
 (define source-annotation
   (lambda (x)
      (cond
-       ((annotation? x) (annotation-source x))
-       ((syntax-object? x) (source-annotation (syntax-object-expression x)))
-       (else no-source))))
+      ((syntax-object? x)
+       (source-annotation (syntax-object-expression x)))
+      ((pair? x) (let ((props (source-properties x)))
+                   (if (pair? props)
+                       props
+                       #f)))
+      (else #f))))
 
 (define-syntax arg-check
   (syntax-rules ()
     ((_ pred? e who)
      (let ((x e))
-       (if (not (pred? x)) (error-hook who "invalid argument" x))))))
+       (if (not (pred? x)) (syntax-violation who "invalid argument" x))))))
 
 ;;; compile-time environments
 
@@ -475,7 +577,7 @@
 
 ;;; <binding> ::= (macro . <procedure>)           macros
 ;;;               (core . <procedure>)            core forms
-;;;               (external-macro . <procedure>)  external-macro
+;;;               (module-ref . <procedure>)      @ or @@
 ;;;               (begin)                         begin
 ;;;               (define)                        define
 ;;;               (define-syntax)                 define-syntax
@@ -551,16 +653,16 @@
   ; although symbols are usually global, we check the environment first
   ; anyway because a temporary binding may have been established by
   ; fluid-let-syntax
-  (lambda (x r)
+  (lambda (x r mod)
     (cond
       ((assq x r) => cdr)
       ((symbol? x)
-       (or (get-global-definition-hook x) (make-binding 'global)))
+       (or (get-global-definition-hook x mod) (make-binding 'global)))
       (else (make-binding 'displaced-lexical)))))
 
 (define global-extend
   (lambda (type sym val)
-    (put-global-definition-hook sym (make-binding type val))))
+    (put-global-definition-hook sym type val)))
 
 
 ;;; Conceptually, identifiers are always syntax objects.  Internally,
@@ -571,29 +673,30 @@
 (define nonsymbol-id?
   (lambda (x)
     (and (syntax-object? x)
-         (symbol? (unannotate (syntax-object-expression x))))))
+         (symbol? (syntax-object-expression x)))))
 
 (define id?
   (lambda (x)
     (cond
       ((symbol? x) #t)
-      ((syntax-object? x) (symbol? (unannotate (syntax-object-expression x))))
-      ((annotation? x) (symbol? (annotation-expression x)))
+      ((syntax-object? x) (symbol? (syntax-object-expression x)))
       (else #f))))
 
 (define-syntax id-sym-name
   (syntax-rules ()
     ((_ e)
      (let ((x e))
-       (unannotate (if (syntax-object? x) (syntax-object-expression x) x))))))
+       (if (syntax-object? x)
+           (syntax-object-expression x)
+           x)))))
 
 (define id-sym-name&marks
   (lambda (x w)
     (if (syntax-object? x)
         (values
-          (unannotate (syntax-object-expression x))
-          (join-marks (wrap-marks w) (wrap-marks (syntax-object-wrap x))))
-        (values (unannotate x) (wrap-marks w)))))
+         (syntax-object-expression x)
+         (join-marks (wrap-marks w) (wrap-marks (syntax-object-wrap x))))
+        (values x (wrap-marks w)))))
 
 ;;; syntax object wraps
 
@@ -659,7 +762,7 @@
   ; must receive ids with complete wraps
   (lambda (ribcage id label)
     (set-ribcage-symnames! ribcage
-      (cons (unannotate (syntax-object-expression id))
+      (cons (syntax-object-expression id)
             (ribcage-symnames ribcage)))
     (set-ribcage-marks! ribcage
       (cons (wrap-marks (syntax-object-wrap id))
@@ -759,7 +862,7 @@
       ((symbol? id)
        (or (first (search id (wrap-subst w) (wrap-marks w))) id))
       ((syntax-object? id)
-        (let ((id (unannotate (syntax-object-expression id)))
+        (let ((id (syntax-object-expression id))
               (w1 (syntax-object-wrap id)))
           (let ((marks (join-marks (wrap-marks w) (wrap-marks w1))))
             (call-with-values (lambda () (search id (wrap-subst w) marks))
@@ -767,10 +870,7 @@
                 (or new-id
                     (first (search id (wrap-subst w1) marks))
                     id))))))
-      ((annotation? id)
-       (let ((id (unannotate id)))
-         (or (first (search id (wrap-subst w) (wrap-marks w))) id)))
-      (else (error-hook 'id-var-name "invalid id" id)))))
+      (else (syntax-violation 'id-var-name "invalid id" id)))))
 
 ;;; free-id=? must be passed fully wrapped ids since (free-id=? x y)
 ;;; may be true even if (free-id=? (wrap x w) (wrap y w)) is not.
@@ -787,11 +887,11 @@
 (define bound-id=?
   (lambda (i j)
     (if (and (syntax-object? i) (syntax-object? j))
-        (and (eq? (unannotate (syntax-object-expression i))
-                  (unannotate (syntax-object-expression j)))
+        (and (eq? (syntax-object-expression i)
+                  (syntax-object-expression j))
              (same-marks? (wrap-marks (syntax-object-wrap i))
                   (wrap-marks (syntax-object-wrap j))))
-        (eq? (unannotate i) (unannotate j)))))
+        (eq? i j))))
 
 ;;; "valid-bound-ids?" returns #t if it receives a list of distinct ids.
 ;;; valid-bound-ids? may be passed unwrapped (or partially wrapped) ids
@@ -828,45 +928,68 @@
 ;;; wrapping expressions and identifiers
 
 (define wrap
-  (lambda (x w)
+  (lambda (x w defmod)
     (cond
       ((and (null? (wrap-marks w)) (null? (wrap-subst w))) x)
       ((syntax-object? x)
        (make-syntax-object
          (syntax-object-expression x)
-         (join-wraps w (syntax-object-wrap x))))
+         (join-wraps w (syntax-object-wrap x))
+         (syntax-object-module x)))
       ((null? x) x)
-      (else (make-syntax-object x w)))))
+      (else (make-syntax-object x w defmod)))))
 
 (define source-wrap
-  (lambda (x w s)
-    (wrap (if s (make-annotation x s #f) x) w)))
+  (lambda (x w s defmod)
+    (wrap (decorate-source x s) w defmod)))
 
 ;;; expanding
 
 (define chi-sequence
-  (lambda (body r w s)
+  (lambda (body r w s mod)
     (build-sequence s
-      (let dobody ((body body) (r r) (w w))
+      (let dobody ((body body) (r r) (w w) (mod mod))
         (if (null? body)
             '()
-            (let ((first (chi (car body) r w)))
-              (cons first (dobody (cdr body) r w))))))))
+            (let ((first (chi (car body) r w mod)))
+              (cons first (dobody (cdr body) r w mod))))))))
 
 (define chi-top-sequence
-  (lambda (body r w s m esew)
+  (lambda (body r w s m esew mod)
     (build-sequence s
-      (let dobody ((body body) (r r) (w w) (m m) (esew esew))
+      (let dobody ((body body) (r r) (w w) (m m) (esew esew) (mod mod))
         (if (null? body)
             '()
-            (let ((first (chi-top (car body) r w m esew)))
-              (cons first (dobody (cdr body) r w m esew))))))))
+            (let ((first (chi-top (car body) r w m esew mod)))
+              (cons first (dobody (cdr body) r w m esew mod))))))))
 
 (define chi-install-global
   (lambda (name e)
-    (build-application no-source
-      (build-primref no-source 'install-global-transformer)
-      (list (build-data no-source name) e))))
+    (build-global-definition
+     no-source
+     name
+     ;; FIXME: seems nasty to call current-module here
+     (if (let ((v (module-variable (current-module) name)))
+           ;; FIXME use primitive-macro?
+           (and v (variable-bound? v) (macro? (variable-ref v))
+                (not (eq? (macro-type (variable-ref v)) 'syncase-macro))))
+         (build-application
+          no-source
+          (build-primref no-source 'make-extended-syncase-macro)
+          (list (build-application
+                 no-source
+                 (build-primref no-source 'module-ref)
+                 (list (build-application 
+                        no-source
+                        (build-primref no-source 'current-module)
+                        '())
+                       (build-data no-source name)))
+                (build-data no-source 'macro)
+                e))
+         (build-application
+          no-source
+          (build-primref no-source 'make-syncase-macro)
+          (list (build-data no-source 'macro) e))))))
 
 (define chi-when-list
   (lambda (e when-list w)
@@ -880,17 +1003,19 @@
                        ((free-id=? x (syntax compile)) 'compile)
                        ((free-id=? x (syntax load)) 'load)
                        ((free-id=? x (syntax eval)) 'eval)
-                       (else (syntax-error (wrap x w)
-                               "invalid eval-when situation"))))
+                       (else (syntax-violation 'eval-when
+                                               "invalid situation"
+                                               e (wrap x w #f)))))
                    situations))))))
 
-;;; syntax-type returns five values: type, value, e, w, and s.  The first
-;;; two are described in the table below.
+;;; syntax-type returns six values: type, value, e, w, s, and mod. The
+;;; first two are described in the table below.
 ;;;
 ;;;    type                   value         explanation
 ;;;    -------------------------------------------------------------------
-;;;    core                   procedure     core form (including singleton)
-;;;    external-macro         procedure     external macro
+;;;    core                   procedure     core singleton
+;;;    core-form              procedure     core form
+;;;    module-ref             procedure     @ or @@ singleton
 ;;;    lexical                name          lexical variable reference
 ;;;    global                 name          global variable reference
 ;;;    begin                  none          begin keyword
@@ -913,99 +1038,113 @@
 ;;;
 ;;; For define-form and define-syntax-form, e is the rhs expression.
 ;;; For all others, e is the entire form.  w is the wrap for e.
-;;; s is the source for the entire form.
+;;; s is the source for the entire form. mod is the module for e.
 ;;;
 ;;; syntax-type expands macros and unwraps as necessary to get to
 ;;; one of the forms above.  It also parses define and define-syntax
 ;;; forms, although perhaps this should be done by the consumer.
 
 (define syntax-type
-  (lambda (e r w s rib)
+  (lambda (e r w s rib mod for-car?)
     (cond
       ((symbol? e)
        (let* ((n (id-var-name e w))
-              (b (lookup n r))
+              (b (lookup n r mod))
               (type (binding-type b)))
          (case type
-           ((lexical) (values type (binding-value b) e w s))
-           ((global) (values type n e w s))
+           ((lexical) (values type (binding-value b) e w s mod))
+           ((global) (values type n e w s mod))
            ((macro)
-            (syntax-type (chi-macro (binding-value b) e r w rib) r empty-wrap s rib))
-           (else (values type (binding-value b) e w s)))))
+            (if for-car?
+                (values type (binding-value b) e w s mod)
+                (syntax-type (chi-macro (binding-value b) e r w rib mod)
+                             r empty-wrap s rib mod #f)))
+           (else (values type (binding-value b) e w s mod)))))
       ((pair? e)
        (let ((first (car e)))
-         (if (id? first)
-             (let* ((n (id-var-name first w))
-                    (b (lookup n r))
-                    (type (binding-type b)))
-               (case type
-                 ((lexical) (values 'lexical-call (binding-value b) e w s))
-                 ((global) (values 'global-call n e w s))
-                 ((macro)
-                  (syntax-type (chi-macro (binding-value b) e r w rib)
-                    r empty-wrap s rib))
-                 ((core external-macro) (values type (binding-value b) e w s))
-                 ((local-syntax)
-                  (values 'local-syntax-form (binding-value b) e w s))
-                 ((begin) (values 'begin-form #f e w s))
-                 ((eval-when) (values 'eval-when-form #f e w s))
-                 ((define)
-                  (syntax-case e ()
-                    ((_ name val)
-                     (id? (syntax name))
-                     (values 'define-form (syntax name) (syntax val) w s))
-                    ((_ (name . args) e1 e2 ...)
-                     (and (id? (syntax name))
-                          (valid-bound-ids? (lambda-var-list (syntax args))))
-                     ; need lambda here...
-                     (values 'define-form (wrap (syntax name) w)
-                       (cons (syntax lambda) (wrap (syntax (args e1 e2 ...)) w))
-                       empty-wrap s))
-                    ((_ name)
-                     (id? (syntax name))
-                     (values 'define-form (wrap (syntax name) w)
-                       (syntax (void))
-                       empty-wrap s))))
-                 ((define-syntax)
-                  (syntax-case e ()
-                    ((_ name val)
-                     (id? (syntax name))
-                     (values 'define-syntax-form (syntax name)
-                       (syntax val) w s))))
-                 (else (values 'call #f e w s))))
-             (values 'call #f e w s))))
+         (call-with-values
+             (lambda () (syntax-type first r w s rib mod #t))
+           (lambda (ftype fval fe fw fs fmod)
+             (case ftype
+               ((lexical)
+                (values 'lexical-call fval e w s mod))
+               ((global)
+                ;; If we got here via an (@@ ...) expansion, we need to
+                ;; make sure the fmod information is propagated back
+                ;; correctly -- hence this consing.
+                (values 'global-call (make-syntax-object fval w fmod)
+                        e w s mod))
+               ((macro)
+                (syntax-type (chi-macro fval e r w rib mod)
+                             r empty-wrap s rib mod for-car?))
+               ((module-ref)
+                (call-with-values (lambda () (fval e))
+                  (lambda (sym mod)
+                    (syntax-type sym r w s rib mod for-car?))))
+               ((core)
+                (values 'core-form fval e w s mod))
+               ((local-syntax)
+                (values 'local-syntax-form fval e w s mod))
+               ((begin)
+                (values 'begin-form #f e w s mod))
+               ((eval-when)
+                (values 'eval-when-form #f e w s mod))
+               ((define)
+                (syntax-case e ()
+                  ((_ name val)
+                   (id? (syntax name))
+                   (values 'define-form (syntax name) (syntax val) w s mod))
+                  ((_ (name . args) e1 e2 ...)
+                   (and (id? (syntax name))
+                        (valid-bound-ids? (lambda-var-list (syntax args))))
+                                        ; need lambda here...
+                   (values 'define-form (wrap (syntax name) w mod)
+                           (decorate-source
+                            (cons (syntax lambda) (wrap (syntax (args e1 e2 ...)) w mod))
+                            s)
+                           empty-wrap s mod))
+                  ((_ name)
+                   (id? (syntax name))
+                   (values 'define-form (wrap (syntax name) w mod)
+                           (syntax (if #f #f))
+                           empty-wrap s mod))))
+               ((define-syntax)
+                (syntax-case e ()
+                  ((_ name val)
+                   (id? (syntax name))
+                   (values 'define-syntax-form (syntax name)
+                           (syntax val) w s mod))))
+               (else
+                (values 'call #f e w s mod)))))))
       ((syntax-object? e)
-       ;; s can't be valid source if we've unwrapped
        (syntax-type (syntax-object-expression e)
                     r
                     (join-wraps w (syntax-object-wrap e))
-                    no-source rib))
-      ((annotation? e)
-       (syntax-type (annotation-expression e) r w (annotation-source e) rib))
-      ((self-evaluating? e) (values 'constant #f e w s))
-      (else (values 'other #f e w s)))))
+                    s rib (or (syntax-object-module e) mod) for-car?))
+      ((self-evaluating? e) (values 'constant #f e w s mod))
+      (else (values 'other #f e w s mod)))))
 
 (define chi-top
-  (lambda (e r w m esew)
+  (lambda (e r w m esew mod)
     (define-syntax eval-if-c&e
       (syntax-rules ()
-        ((_ m e)
+        ((_ m e mod)
          (let ((x e))
-           (if (eq? m 'c&e) (top-level-eval-hook x))
+           (if (eq? m 'c&e) (top-level-eval-hook x mod))
            x))))
     (call-with-values
-      (lambda () (syntax-type e r w no-source #f))
-      (lambda (type value e w s)
+      (lambda () (syntax-type e r w (source-annotation e) #f mod #f))
+      (lambda (type value e w s mod)
         (case type
           ((begin-form)
            (syntax-case e ()
              ((_) (chi-void))
              ((_ e1 e2 ...)
-              (chi-top-sequence (syntax (e1 e2 ...)) r w s m esew))))
+              (chi-top-sequence (syntax (e1 e2 ...)) r w s m esew mod))))
           ((local-syntax-form)
-           (chi-local-syntax value e r w s
-             (lambda (body r w s)
-               (chi-top-sequence body r w s m esew))))
+           (chi-local-syntax value e r w s mod
+             (lambda (body r w s mod)
+               (chi-top-sequence body r w s m esew mod))))
           ((eval-when-form)
            (syntax-case e ()
              ((_ (x ...) e1 e2 ...)
@@ -1014,19 +1153,20 @@
                 (cond
                   ((eq? m 'e)
                    (if (memq 'eval when-list)
-                       (chi-top-sequence body r w s 'e '(eval))
+                       (chi-top-sequence body r w s 'e '(eval) mod)
                        (chi-void)))
                   ((memq 'load when-list)
                    (if (or (memq 'compile when-list)
                            (and (eq? m 'c&e) (memq 'eval when-list)))
-                       (chi-top-sequence body r w s 'c&e '(compile load))
+                       (chi-top-sequence body r w s 'c&e '(compile load) mod)
                        (if (memq m '(c c&e))
-                           (chi-top-sequence body r w s 'c '(load))
+                           (chi-top-sequence body r w s 'c '(load) mod)
                            (chi-void))))
                   ((or (memq 'compile when-list)
                        (and (eq? m 'c&e) (memq 'eval when-list)))
                    (top-level-eval-hook
-                     (chi-top-sequence body r w s 'e '(eval)))
+                     (chi-top-sequence body r w s 'e '(eval) mod)
+                     mod)
                    (chi-void))
                   (else (chi-void)))))))
           ((define-syntax-form)
@@ -1034,93 +1174,118 @@
              (case m
                ((c)
                 (if (memq 'compile esew)
-                    (let ((e (chi-install-global n (chi e r w))))
-                      (top-level-eval-hook e)
+                    (let ((e (chi-install-global n (chi e r w mod))))
+                      (top-level-eval-hook e mod)
                       (if (memq 'load esew) e (chi-void)))
                     (if (memq 'load esew)
-                        (chi-install-global n (chi e r w))
+                        (chi-install-global n (chi e r w mod))
                         (chi-void))))
                ((c&e)
-                (let ((e (chi-install-global n (chi e r w))))
-                  (top-level-eval-hook e)
+                (let ((e (chi-install-global n (chi e r w mod))))
+                  (top-level-eval-hook e mod)
                   e))
                (else
                 (if (memq 'eval esew)
                     (top-level-eval-hook
-                      (chi-install-global n (chi e r w))))
+                      (chi-install-global n (chi e r w mod))
+                      mod))
                 (chi-void)))))
           ((define-form)
            (let* ((n (id-var-name value w))
-		  (type (binding-type (lookup n r))))
+		  (type (binding-type (lookup n r mod))))
              (case type
-               ((global)
+               ((global core macro module-ref)
+                ;; affect compile-time environment (once we have booted)
+                (if (and (not (module-local-variable (current-module) n))
+                         (current-module))
+                    (let ((old (module-variable (current-module) n)))
+                      ;; use value of the same-named imported variable, if
+                      ;; any
+                      (module-define! (current-module) n
+                                      (if (variable? old)
+                                          (variable-ref old)
+                                          #f))))
                 (eval-if-c&e m
-                  (build-global-definition s n (chi e r w))))
+                  (build-global-definition s n (chi e r w mod))
+                  mod))
                ((displaced-lexical)
-                (syntax-error (wrap value w) "identifier out of context"))
+                (syntax-violation #f "identifier out of context"
+                                  e (wrap value w mod)))
                (else
-		(if (eq? type 'external-macro)
-		    (eval-if-c&e m
-				 (build-global-definition s n (chi e r w)))
-		    (syntax-error (wrap value w)
-				  "cannot define keyword at top level"))))))
-          (else (eval-if-c&e m (chi-expr type value e r w s))))))))
+                (syntax-violation #f "cannot define keyword at top level"
+                                  e (wrap value w mod))))))
+          (else (eval-if-c&e m (chi-expr type value e r w s mod) mod)))))))
 
 (define chi
-  (lambda (e r w)
+  (lambda (e r w mod)
     (call-with-values
-      (lambda () (syntax-type e r w no-source #f))
-      (lambda (type value e w s)
-        (chi-expr type value e r w s)))))
+      (lambda () (syntax-type e r w (source-annotation e) #f mod #f))
+      (lambda (type value e w s mod)
+        (chi-expr type value e r w s mod)))))
 
 (define chi-expr
-  (lambda (type value e r w s)
+  (lambda (type value e r w s mod)
     (case type
       ((lexical)
-       (build-lexical-reference 'value s value))
-      ((core external-macro) (value e r w s))
+       (build-lexical-reference 'value s e value))
+      ((core core-form)
+       ;; apply transformer
+       (value e r w s mod))
+      ((module-ref)
+       (call-with-values (lambda () (value e))
+         ;; we could add a public? arg here
+         (lambda (id mod) (build-global-reference s id mod))))
       ((lexical-call)
        (chi-application
-         (build-lexical-reference 'fun (source-annotation (car e)) value)
-         e r w s))
+         (build-lexical-reference 'fun (source-annotation (car e))
+                                  (car e) value)
+         e r w s mod))
       ((global-call)
        (chi-application
-         (build-global-reference (source-annotation (car e)) value)
-         e r w s))
-      ((constant) (build-data s (strip (source-wrap e w s) empty-wrap)))
-      ((global) (build-global-reference s value))
-      ((call) (chi-application (chi (car e) r w) e r w s))
+         (build-global-reference (source-annotation (car e))
+                                 (if (syntax-object? value)
+                                     (syntax-object-expression value)
+                                     value)
+                                 (if (syntax-object? value)
+                                     (syntax-object-module value)
+                                     mod))
+         e r w s mod))
+      ((constant) (build-data s (strip (source-wrap e w s mod) empty-wrap)))
+      ((global) (build-global-reference s value mod))
+      ((call) (chi-application (chi (car e) r w mod) e r w s mod))
       ((begin-form)
        (syntax-case e ()
-         ((_ e1 e2 ...) (chi-sequence (syntax (e1 e2 ...)) r w s))))
+         ((_ e1 e2 ...) (chi-sequence (syntax (e1 e2 ...)) r w s mod))))
       ((local-syntax-form)
-       (chi-local-syntax value e r w s chi-sequence))
+       (chi-local-syntax value e r w s mod chi-sequence))
       ((eval-when-form)
        (syntax-case e ()
          ((_ (x ...) e1 e2 ...)
           (let ((when-list (chi-when-list e (syntax (x ...)) w)))
             (if (memq 'eval when-list)
-                (chi-sequence (syntax (e1 e2 ...)) r w s)
+                (chi-sequence (syntax (e1 e2 ...)) r w s mod)
                 (chi-void))))))
       ((define-form define-syntax-form)
-       (syntax-error (wrap value w) "invalid context for definition of"))
+       (syntax-violation #f "definition in expression context"
+                         e (wrap value w mod)))
       ((syntax)
-       (syntax-error (source-wrap e w s)
-         "reference to pattern variable outside syntax form"))
+       (syntax-violation #f "reference to pattern variable outside syntax form"
+                         (source-wrap e w s mod)))
       ((displaced-lexical)
-       (syntax-error (source-wrap e w s)
-         "reference to identifier outside its scope"))
-      (else (syntax-error (source-wrap e w s))))))
+       (syntax-violation #f "reference to identifier outside its scope"
+                          (source-wrap e w s mod)))
+      (else (syntax-violation #f "unexpected syntax"
+                              (source-wrap e w s mod))))))
 
 (define chi-application
-  (lambda (x e r w s)
+  (lambda (x e r w s mod)
     (syntax-case e ()
       ((e0 e1 ...)
        (build-application s x
-         (map (lambda (e) (chi e r w)) (syntax (e1 ...))))))))
+         (map (lambda (e) (chi e r w mod)) (syntax (e1 ...))))))))
 
 (define chi-macro
-  (lambda (p e r w rib)
+  (lambda (p e r w rib mod)
     (define rebuild-macro-output
       (lambda (x m)
         (cond ((pair? x)
@@ -1129,14 +1294,27 @@
               ((syntax-object? x)
                (let ((w (syntax-object-wrap x)))
                  (let ((ms (wrap-marks w)) (s (wrap-subst w)))
-                   (make-syntax-object (syntax-object-expression x)
-                     (if (and (pair? ms) (eq? (car ms) the-anti-mark))
-                         (make-wrap (cdr ms)
-                           (if rib (cons rib (cdr s)) (cdr s)))
-                         (make-wrap (cons m ms)
-                           (if rib
-                               (cons rib (cons 'shift s))
-                               (cons 'shift s))))))))
+                   (if (and (pair? ms) (eq? (car ms) the-anti-mark))
+                       ;; output is from original text
+                       (make-syntax-object
+                        (syntax-object-expression x)
+                        (make-wrap (cdr ms) (if rib (cons rib (cdr s)) (cdr s)))
+                        (syntax-object-module x))
+                       ;; output introduced by macro
+                       (make-syntax-object
+                        (syntax-object-expression x)
+                        (make-wrap (cons m ms)
+                                   (if rib
+                                       (cons rib (cons 'shift s))
+                                       (cons 'shift s)))
+                        (let ((pmod (procedure-module p)))
+                          (if pmod
+                              ;; hither the hygiene
+                              (cons 'hygiene (module-name pmod))
+                              ;; but it's possible for the proc to have
+                              ;; no mod, if it was made before modules
+                              ;; were booted
+                              '(hygiene guile))))))))
               ((vector? x)
                (let* ((n (vector-length x)) (v (make-vector n)))
                  (do ((i 0 (fx+ i 1)))
@@ -1144,9 +1322,10 @@
                      (vector-set! v i
                        (rebuild-macro-output (vector-ref x i) m)))))
               ((symbol? x)
-               (syntax-error x "encountered raw symbol in macro output"))
+               (syntax-violation #f "encountered raw symbol in macro output"
+                                 (source-wrap e w s mod) x))
               (else x))))
-    (rebuild-macro-output (p (wrap e (anti-mark w))) (new-mark))))
+    (rebuild-macro-output (p (wrap e (anti-mark w) mod)) (new-mark))))
 
 (define chi-body
   ;; In processing the forms of the body, we create a new, empty wrap.
@@ -1187,34 +1366,36 @@
   ;; into the body.
   ;;
   ;; outer-form is fully wrapped w/source
-  (lambda (body outer-form r w)
+  (lambda (body outer-form r w mod)
     (let* ((r (cons '("placeholder" . (placeholder)) r))
            (ribcage (make-empty-ribcage))
            (w (make-wrap (wrap-marks w) (cons ribcage (wrap-subst w)))))
-      (let parse ((body (map (lambda (x) (cons r (wrap x w))) body))
-                  (ids '()) (labels '()) (vars '()) (vals '()) (bindings '()))
+      (let parse ((body (map (lambda (x) (cons r (wrap x w mod))) body))
+                  (ids '()) (labels '())
+                  (var-ids '()) (vars '()) (vals '()) (bindings '()))
         (if (null? body)
-            (syntax-error outer-form "no expressions in body")
+            (syntax-violation #f "no expressions in body" outer-form)
             (let ((e (cdar body)) (er (caar body)))
               (call-with-values
-                (lambda () (syntax-type e er empty-wrap no-source ribcage))
-                (lambda (type value e w s)
+                (lambda () (syntax-type e er empty-wrap (source-annotation er) ribcage mod #f))
+                (lambda (type value e w s mod)
                   (case type
                     ((define-form)
-                     (let ((id (wrap value w)) (label (gen-label)))
+                     (let ((id (wrap value w mod)) (label (gen-label)))
                        (let ((var (gen-var id)))
                          (extend-ribcage! ribcage id label)
                          (parse (cdr body)
                            (cons id ids) (cons label labels)
-                           (cons var vars) (cons (cons er (wrap e w)) vals)
+                           (cons id var-ids)
+                           (cons var vars) (cons (cons er (wrap e w mod)) vals)
                            (cons (make-binding 'lexical var) bindings)))))
                     ((define-syntax-form)
-                     (let ((id (wrap value w)) (label (gen-label)))
+                     (let ((id (wrap value w mod)) (label (gen-label)))
                        (extend-ribcage! ribcage id label)
                        (parse (cdr body)
                          (cons id ids) (cons label labels)
-                         vars vals
-                         (cons (make-binding 'macro (cons er (wrap e w)))
+                         var-ids vars vals
+                         (cons (make-binding 'macro (cons er (wrap e w mod)))
                                bindings))))
                     ((begin-form)
                      (syntax-case e ()
@@ -1222,29 +1403,30 @@
                         (parse (let f ((forms (syntax (e1 ...))))
                                  (if (null? forms)
                                      (cdr body)
-                                     (cons (cons er (wrap (car forms) w))
+                                     (cons (cons er (wrap (car forms) w mod))
                                            (f (cdr forms)))))
-                          ids labels vars vals bindings))))
+                          ids labels var-ids vars vals bindings))))
                     ((local-syntax-form)
-                     (chi-local-syntax value e er w s
-                       (lambda (forms er w s)
+                     (chi-local-syntax value e er w s mod
+                       (lambda (forms er w s mod)
                          (parse (let f ((forms forms))
                                   (if (null? forms)
                                       (cdr body)
-                                      (cons (cons er (wrap (car forms) w))
+                                      (cons (cons er (wrap (car forms) w mod))
                                             (f (cdr forms)))))
-                           ids labels vars vals bindings))))
+                           ids labels var-ids vars vals bindings))))
                     (else ; found a non-definition
                      (if (null? ids)
                          (build-sequence no-source
                            (map (lambda (x)
-                                  (chi (cdr x) (car x) empty-wrap))
-                                (cons (cons er (source-wrap e w s))
+                                  (chi (cdr x) (car x) empty-wrap mod))
+                                (cons (cons er (source-wrap e w s mod))
                                       (cdr body))))
                          (begin
                            (if (not (valid-bound-ids? ids))
-                               (syntax-error outer-form
-                                 "invalid or duplicate identifier in definition"))
+                               (syntax-violation
+                                #f "invalid or duplicate identifier in definition"
+                                outer-form))
                            (let loop ((bs bindings) (er-cache #f) (r-cache #f))
                              (if (not (null? bs))
                                  (let* ((b (car bs)))
@@ -1256,58 +1438,72 @@
                                                     (macros-only-env er))))
                                          (set-cdr! b
                                            (eval-local-transformer
-                                             (chi (cddr b) r-cache empty-wrap)))
+                                             (chi (cddr b) r-cache empty-wrap mod)
+                                             mod))
                                          (loop (cdr bs) er r-cache))
                                        (loop (cdr bs) er-cache r-cache)))))
                            (set-cdr! r (extend-env labels bindings (cdr r)))
                            (build-letrec no-source
+                             (map syntax->datum var-ids)
                              vars
                              (map (lambda (x)
-                                    (chi (cdr x) (car x) empty-wrap))
+                                    (chi (cdr x) (car x) empty-wrap mod))
                                   vals)
                              (build-sequence no-source
                                (map (lambda (x)
-                                      (chi (cdr x) (car x) empty-wrap))
-                                    (cons (cons er (source-wrap e w s))
+                                      (chi (cdr x) (car x) empty-wrap mod))
+                                    (cons (cons er (source-wrap e w s mod))
                                           (cdr body)))))))))))))))))
 
 (define chi-lambda-clause
-  (lambda (e c r w k)
+  (lambda (e docstring c r w mod k)
     (syntax-case c ()
+      ((args doc e1 e2 ...)
+       (and (string? (syntax->datum (syntax doc))) (not docstring))
+       (chi-lambda-clause e (syntax doc) (syntax (args e1 e2 ...)) r w mod k))
       (((id ...) e1 e2 ...)
        (let ((ids (syntax (id ...))))
          (if (not (valid-bound-ids? ids))
-             (syntax-error e "invalid parameter list in")
+             (syntax-violation 'lambda "invalid parameter list" e)
              (let ((labels (gen-labels ids))
                    (new-vars (map gen-var ids)))
-               (k new-vars
+               (k (map syntax->datum ids)
+                  new-vars
+                  (and docstring (syntax->datum docstring))
                   (chi-body (syntax (e1 e2 ...))
                             e
                             (extend-var-env labels new-vars r)
-                            (make-binding-wrap ids labels w)))))))
+                            (make-binding-wrap ids labels w)
+                            mod))))))
       ((ids e1 e2 ...)
        (let ((old-ids (lambda-var-list (syntax ids))))
          (if (not (valid-bound-ids? old-ids))
-             (syntax-error e "invalid parameter list in")
+             (syntax-violation 'lambda "invalid parameter list" e)
              (let ((labels (gen-labels old-ids))
                    (new-vars (map gen-var old-ids)))
-               (k (let f ((ls1 (cdr new-vars)) (ls2 (car new-vars)))
+               (k (let f ((ls1 (cdr old-ids)) (ls2 (car old-ids)))
+                    (if (null? ls1)
+                        (syntax->datum ls2)
+                        (f (cdr ls1) (cons (syntax->datum (car ls1)) ls2))))
+                  (let f ((ls1 (cdr new-vars)) (ls2 (car new-vars)))
                     (if (null? ls1)
                         ls2
                         (f (cdr ls1) (cons (car ls1) ls2))))
+                  (and docstring (syntax->datum docstring))
                   (chi-body (syntax (e1 e2 ...))
                             e
                             (extend-var-env labels new-vars r)
-                            (make-binding-wrap old-ids labels w)))))))
-      (_ (syntax-error e)))))
+                            (make-binding-wrap old-ids labels w)
+                            mod))))))
+      (_ (syntax-violation 'lambda "bad lambda" e)))))
 
 (define chi-local-syntax
-  (lambda (rec? e r w s k)
+  (lambda (rec? e r w s mod k)
     (syntax-case e ()
       ((_ ((id val) ...) e1 e2 ...)
        (let ((ids (syntax (id ...))))
          (if (not (valid-bound-ids? ids))
-             (syntax-error e "duplicate bound keyword in")
+             (syntax-violation #f "duplicate bound keyword" e)
              (let ((labels (gen-labels ids)))
                (let ((new-w (make-binding-wrap ids labels w)))
                  (k (syntax (e1 e2 ...))
@@ -1317,23 +1513,27 @@
                             (trans-r (macros-only-env r)))
                         (map (lambda (x)
                                (make-binding 'macro
-                                 (eval-local-transformer (chi x trans-r w))))
+                                 (eval-local-transformer
+                                  (chi x trans-r w mod)
+                                  mod)))
                              (syntax (val ...))))
                       r)
                     new-w
-                    s))))))
-      (_ (syntax-error (source-wrap e w s))))))
+                    s
+                    mod))))))
+      (_ (syntax-violation #f "bad local syntax definition"
+                           (source-wrap e w s mod))))))
 
 (define eval-local-transformer
-  (lambda (expanded)
-    (let ((p (local-eval-hook expanded)))
+  (lambda (expanded mod)
+    (let ((p (local-eval-hook expanded mod)))
       (if (procedure? p)
           p
-          (syntax-error p "nonprocedure transformer")))))
+          (syntax-violation #f "nonprocedure transformer" p)))))
 
 (define chi-void
   (lambda ()
-    (build-application no-source (build-primref no-source 'void) '())))
+    (build-void no-source)))
 
 (define ellipsis?
   (lambda (x)
@@ -1342,32 +1542,8 @@
 
 ;;; data
 
-;;; strips all annotations from potentially circular reader output
-
-(define strip-annotation
-  (lambda (x parent)
-    (cond
-      ((pair? x)
-       (let ((new (cons #f #f)))
-         (when parent (set-annotation-stripped! parent new))
-         (set-car! new (strip-annotation (car x) #f))
-         (set-cdr! new (strip-annotation (cdr x) #f))
-         new))
-      ((annotation? x)
-       (or (annotation-stripped x)
-           (strip-annotation (annotation-expression x) x)))
-      ((vector? x)
-       (let ((new (make-vector (vector-length x))))
-         (when parent (set-annotation-stripped! parent new))
-         (let loop ((i (- (vector-length x) 1)))
-           (unless (fx< i 0)
-             (vector-set! new i (strip-annotation (vector-ref x i) #f))
-             (loop (fx- i 1))))
-         new))
-      (else x))))
-
-;;; strips syntax-objects down to top-wrap; if top-wrap is layered directly
-;;; on an annotation, strips the annotation as well.
+;;; strips syntax-objects down to top-wrap
+;;;
 ;;; since only the head of a list is annotated by the reader, not each pair
 ;;; in the spine, we also check for pairs whose cars are annotated in case
 ;;; we've been passed the cdr of an annotated list
@@ -1375,46 +1551,40 @@
 (define strip
   (lambda (x w)
     (if (top-marked? w)
-        (if (or (annotation? x) (and (pair? x) (annotation? (car x))))
-            (strip-annotation x #f)
-            x)
+        x
         (let f ((x x))
           (cond
-            ((syntax-object? x)
-             (strip (syntax-object-expression x) (syntax-object-wrap x)))
-            ((pair? x)
-             (let ((a (f (car x))) (d (f (cdr x))))
-               (if (and (eq? a (car x)) (eq? d (cdr x)))
-                   x
-                   (cons a d))))
-            ((vector? x)
-             (let ((old (vector->list x)))
-                (let ((new (map f old)))
-                   (if (andmap eq? old new) x (list->vector new)))))
-            (else x))))))
+           ((syntax-object? x)
+            (strip (syntax-object-expression x) (syntax-object-wrap x)))
+           ((pair? x)
+            (let ((a (f (car x))) (d (f (cdr x))))
+              (if (and (eq? a (car x)) (eq? d (cdr x)))
+                  x
+                  (cons a d))))
+           ((vector? x)
+            (let ((old (vector->list x)))
+              (let ((new (map f old)))
+                (if (and-map* eq? old new) x (list->vector new)))))
+           (else x))))))
 
 ;;; lexical variables
 
 (define gen-var
   (lambda (id)
     (let ((id (if (syntax-object? id) (syntax-object-expression id) id)))
-      (if (annotation? id)
-          (build-lexical-var (annotation-source id) (annotation-expression id))
-          (build-lexical-var no-source id)))))
+      (build-lexical-var no-source id))))
 
 (define lambda-var-list
   (lambda (vars)
     (let lvl ((vars vars) (ls '()) (w empty-wrap))
        (cond
-         ((pair? vars) (lvl (cdr vars) (cons (wrap (car vars) w) ls) w))
-         ((id? vars) (cons (wrap vars w) ls))
+         ((pair? vars) (lvl (cdr vars) (cons (wrap (car vars) w #f) ls) w))
+         ((id? vars) (cons (wrap vars w #f) ls))
          ((null? vars) ls)
          ((syntax-object? vars)
           (lvl (syntax-object-expression vars)
                ls
                (join-wraps w (syntax-object-wrap vars))))
-         ((annotation? vars)
-          (lvl (annotation-expression vars) ls w))
        ; include anything else to be caught by subsequent error
        ; checking
          (else (cons vars ls))))))
@@ -1425,46 +1595,52 @@
 (global-extend 'local-syntax 'let-syntax #f)
 
 (global-extend 'core 'fluid-let-syntax
-  (lambda (e r w s)
+  (lambda (e r w s mod)
     (syntax-case e ()
       ((_ ((var val) ...) e1 e2 ...)
        (valid-bound-ids? (syntax (var ...)))
        (let ((names (map (lambda (x) (id-var-name x w)) (syntax (var ...)))))
          (for-each
            (lambda (id n)
-             (case (binding-type (lookup n r))
+             (case (binding-type (lookup n r mod))
                ((displaced-lexical)
-                (syntax-error (source-wrap id w s)
-                  "identifier out of context"))))
+                (syntax-violation 'fluid-let-syntax
+                                  "identifier out of context"
+                                  e
+                                  (source-wrap id w s mod)))))
            (syntax (var ...))
            names)
          (chi-body
            (syntax (e1 e2 ...))
-           (source-wrap e w s)
+           (source-wrap e w s mod)
            (extend-env
              names
              (let ((trans-r (macros-only-env r)))
                (map (lambda (x)
                       (make-binding 'macro
-                        (eval-local-transformer (chi x trans-r w))))
+                        (eval-local-transformer (chi x trans-r w mod)
+                                                mod)))
                     (syntax (val ...))))
              r)
-           w)))
-      (_ (syntax-error (source-wrap e w s))))))
+           w
+           mod)))
+      (_ (syntax-violation 'fluid-let-syntax "bad syntax"
+                           (source-wrap e w s mod))))))
 
 (global-extend 'core 'quote
-   (lambda (e r w s)
+   (lambda (e r w s mod)
       (syntax-case e ()
          ((_ e) (build-data s (strip (syntax e) w)))
-         (_ (syntax-error (source-wrap e w s))))))
+         (_ (syntax-violation 'quote "bad syntax"
+                              (source-wrap e w s mod))))))
 
 (global-extend 'core 'syntax
   (let ()
     (define gen-syntax
-      (lambda (src e r maps ellipsis?)
+      (lambda (src e r maps ellipsis? mod)
         (if (id? e)
             (let ((label (id-var-name e empty-wrap)))
-              (let ((b (lookup label r)))
+              (let ((b (lookup label r mod)))
                 (if (eq? (binding-type b) 'syntax)
                     (call-with-values
                       (lambda ()
@@ -1472,12 +1648,12 @@
                           (gen-ref src (car var.lev) (cdr var.lev) maps)))
                       (lambda (var maps) (values `(ref ,var) maps)))
                     (if (ellipsis? e)
-                        (syntax-error src "misplaced ellipsis in syntax form")
+                        (syntax-violation 'syntax "misplaced ellipsis" src)
                         (values `(quote ,e) maps)))))
             (syntax-case e ()
               ((dots e)
                (ellipsis? (syntax dots))
-               (gen-syntax src (syntax e) r maps (lambda (x) #f)))
+               (gen-syntax src (syntax e) r maps (lambda (x) #f) mod))
               ((x dots . y)
                ; this could be about a dozen lines of code, except that we
                ; choose to handle (syntax (x ... ...)) forms
@@ -1487,11 +1663,11 @@
                             (call-with-values
                               (lambda ()
                                 (gen-syntax src (syntax x) r
-                                  (cons '() maps) ellipsis?))
+                                  (cons '() maps) ellipsis? mod))
                               (lambda (x maps)
                                 (if (null? (car maps))
-                                    (syntax-error src
-                                      "extra ellipsis in syntax form")
+                                    (syntax-violation 'syntax "extra ellipsis"
+                                                      src)
                                     (values (gen-map x (car maps))
                                             (cdr maps))))))))
                  (syntax-case y ()
@@ -1503,12 +1679,11 @@
                            (lambda () (k (cons '() maps)))
                            (lambda (x maps)
                              (if (null? (car maps))
-                                 (syntax-error src
-                                   "extra ellipsis in syntax form")
+                                 (syntax-violation 'syntax "extra ellipsis" src)
                                  (values (gen-mappend x (car maps))
                                          (cdr maps))))))))
                    (_ (call-with-values
-                        (lambda () (gen-syntax src y r maps ellipsis?))
+                        (lambda () (gen-syntax src y r maps ellipsis? mod))
                         (lambda (y maps)
                           (call-with-values
                             (lambda () (k maps))
@@ -1516,15 +1691,15 @@
                               (values (gen-append x y) maps)))))))))
               ((x . y)
                (call-with-values
-                 (lambda () (gen-syntax src (syntax x) r maps ellipsis?))
+                 (lambda () (gen-syntax src (syntax x) r maps ellipsis? mod))
                  (lambda (x maps)
                    (call-with-values
-                     (lambda () (gen-syntax src (syntax y) r maps ellipsis?))
+                     (lambda () (gen-syntax src (syntax y) r maps ellipsis? mod))
                      (lambda (y maps) (values (gen-cons x y) maps))))))
               (#(e1 e2 ...)
                (call-with-values
                  (lambda ()
-                   (gen-syntax src (syntax (e1 e2 ...)) r maps ellipsis?))
+                   (gen-syntax src (syntax (e1 e2 ...)) r maps ellipsis? mod))
                  (lambda (e maps) (values (gen-vector e) maps))))
               (_ (values `(quote ,e) maps))))))
 
@@ -1533,7 +1708,7 @@
         (if (fx= level 0)
             (values var maps)
             (if (null? maps)
-                (syntax-error src "missing ellipsis in syntax form")
+                (syntax-violation 'syntax "missing ellipsis" src)
                 (call-with-values
                   (lambda () (gen-ref src var (fx- level 1) (cdr maps)))
                   (lambda (outer-var outer-maps)
@@ -1559,7 +1734,7 @@
              ; identity map equivalence:
              ; (map (lambda (x) x) y) == y
              (car actuals))
-            ((andmap
+            ((and-map
                 (lambda (x) (and (eq? (car x) 'ref) (memq (cadr x) formals)))
                 (cdr e))
              ; eta map equivalence:
@@ -1599,110 +1774,158 @@
     (define regen
       (lambda (x)
         (case (car x)
-          ((ref) (build-lexical-reference 'value no-source (cadr x)))
+          ((ref) (build-lexical-reference 'value no-source (cadr x) (cadr x)))
           ((primitive) (build-primref no-source (cadr x)))
           ((quote) (build-data no-source (cadr x)))
-          ((lambda) (build-lambda no-source (cadr x) (regen (caddr x))))
-          ((map) (let ((ls (map regen (cdr x))))
-                   (build-application no-source
-                     (if (fx= (length ls) 2)
-                         (build-primref no-source 'map)
-                        ; really need to do our own checking here
-                         (build-primref no-source 2 'map)) ; require error check
-                     ls)))
+          ((lambda) (build-lambda no-source (cadr x) (cadr x) #f (regen (caddr x))))
           (else (build-application no-source
                   (build-primref no-source (car x))
                   (map regen (cdr x)))))))
 
-    (lambda (e r w s)
-      (let ((e (source-wrap e w s)))
+    (lambda (e r w s mod)
+      (let ((e (source-wrap e w s mod)))
         (syntax-case e ()
           ((_ x)
            (call-with-values
-             (lambda () (gen-syntax e (syntax x) r '() ellipsis?))
+             (lambda () (gen-syntax e (syntax x) r '() ellipsis? mod))
              (lambda (e maps) (regen e))))
-          (_ (syntax-error e)))))))
+          (_ (syntax-violation 'syntax "bad `syntax' form" e)))))))
 
 
 (global-extend 'core 'lambda
-   (lambda (e r w s)
+   (lambda (e r w s mod)
       (syntax-case e ()
          ((_ . c)
-          (chi-lambda-clause (source-wrap e w s) (syntax c) r w
-            (lambda (vars body) (build-lambda s vars body)))))))
+          (chi-lambda-clause (source-wrap e w s mod) #f (syntax c) r w mod
+            (lambda (names vars docstring body)
+              (build-lambda s names vars docstring body)))))))
 
 
 (global-extend 'core 'let
   (let ()
-    (define (chi-let e r w s constructor ids vals exps)
+    (define (chi-let e r w s mod constructor ids vals exps)
       (if (not (valid-bound-ids? ids))
-	  (syntax-error e "duplicate bound variable in")
+	  (syntax-violation 'let "duplicate bound variable" e)
 	  (let ((labels (gen-labels ids))
 		(new-vars (map gen-var ids)))
 	    (let ((nw (make-binding-wrap ids labels w))
 		  (nr (extend-var-env labels new-vars r)))
 	      (constructor s
+                           (map syntax->datum ids)
 			   new-vars
-			   (map (lambda (x) (chi x r w)) vals)
-			   (chi-body exps (source-wrap e nw s) nr nw))))))
-    (lambda (e r w s)
+			   (map (lambda (x) (chi x r w mod)) vals)
+			   (chi-body exps (source-wrap e nw s mod)
+                                     nr nw mod))))))
+    (lambda (e r w s mod)
       (syntax-case e ()
 	((_ ((id val) ...) e1 e2 ...)
-	 (chi-let e r w s
+         (and-map id? (syntax (id ...)))
+	 (chi-let e r w s mod
 		  build-let
 		  (syntax (id ...))
 		  (syntax (val ...))
 		  (syntax (e1 e2 ...))))
 	((_ f ((id val) ...) e1 e2 ...)
-	 (id? (syntax f))
-	 (chi-let e r w s
+	 (and (id? (syntax f)) (and-map id? (syntax (id ...))))
+	 (chi-let e r w s mod
 		  build-named-let
 		  (syntax (f id ...))
 		  (syntax (val ...))
 		  (syntax (e1 e2 ...))))
-	(_ (syntax-error (source-wrap e w s)))))))
+	(_ (syntax-violation 'let "bad let" (source-wrap e w s mod)))))))
 
 
 (global-extend 'core 'letrec
-  (lambda (e r w s)
+  (lambda (e r w s mod)
     (syntax-case e ()
       ((_ ((id val) ...) e1 e2 ...)
+       (and-map id? (syntax (id ...)))
        (let ((ids (syntax (id ...))))
          (if (not (valid-bound-ids? ids))
-             (syntax-error e "duplicate bound variable in")
+             (syntax-violation 'letrec "duplicate bound variable" e)
              (let ((labels (gen-labels ids))
                    (new-vars (map gen-var ids)))
                (let ((w (make-binding-wrap ids labels w))
                     (r (extend-var-env labels new-vars r)))
                  (build-letrec s
+                   (map syntax->datum ids)
                    new-vars
-                   (map (lambda (x) (chi x r w)) (syntax (val ...)))
-                   (chi-body (syntax (e1 e2 ...)) (source-wrap e w s) r w)))))))
-      (_ (syntax-error (source-wrap e w s))))))
+                   (map (lambda (x) (chi x r w mod)) (syntax (val ...)))
+                   (chi-body (syntax (e1 e2 ...)) 
+                             (source-wrap e w s mod) r w mod)))))))
+      (_ (syntax-violation 'letrec "bad letrec" (source-wrap e w s mod))))))
 
 
 (global-extend 'core 'set!
-  (lambda (e r w s)
+  (lambda (e r w s mod)
     (syntax-case e ()
       ((_ id val)
        (id? (syntax id))
-       (let ((val (chi (syntax val) r w))
+       (let ((val (chi (syntax val) r w mod))
              (n (id-var-name (syntax id) w)))
-         (let ((b (lookup n r)))
+         (let ((b (lookup n r mod)))
            (case (binding-type b)
              ((lexical)
-              (build-lexical-assignment s (binding-value b) val))
-             ((global) (build-global-assignment s n val))
+              (build-lexical-assignment s
+                                        (syntax->datum (syntax id))
+                                        (binding-value b)
+                                        val))
+             ((global) (build-global-assignment s n val mod))
              ((displaced-lexical)
-              (syntax-error (wrap (syntax id) w)
-                "identifier out of context"))
-             (else (syntax-error (source-wrap e w s)))))))
-      ((_ (getter arg ...) val)
-       (build-application s
-			  (chi (syntax (setter getter)) r w)
-			  (map (lambda (e) (chi e r w))
-			       (syntax (arg ... val)))))
-      (_ (syntax-error (source-wrap e w s))))))
+              (syntax-violation 'set! "identifier out of context"
+                                (wrap (syntax id) w mod)))
+             (else (syntax-violation 'set! "bad set!"
+                                     (source-wrap e w s mod)))))))
+      ((_ (head tail ...) val)
+       (call-with-values
+           (lambda () (syntax-type (syntax head) r empty-wrap no-source #f mod #t))
+         (lambda (type value ee ww ss modmod)
+           (case type
+             ((module-ref)
+              (let ((val (chi (syntax val) r w mod)))
+                (call-with-values (lambda () (value (syntax (head tail ...))))
+                  (lambda (id mod)
+                    (build-global-assignment s id val mod)))))
+             (else
+              (build-application s
+                                 (chi (syntax (setter head)) r w mod)
+                                 (map (lambda (e) (chi e r w mod))
+                                      (syntax (tail ... val)))))))))
+      (_ (syntax-violation 'set! "bad set!" (source-wrap e w s mod))))))
+
+(global-extend 'module-ref '@
+   (lambda (e)
+     (syntax-case e ()
+        ((_ (mod ...) id)
+         (and (and-map id? (syntax (mod ...))) (id? (syntax id)))
+         (values (syntax->datum (syntax id))
+                 (syntax->datum
+                  (syntax (public mod ...))))))))
+
+(global-extend 'module-ref '@@
+   (lambda (e)
+     (syntax-case e ()
+        ((_ (mod ...) id)
+         (and (and-map id? (syntax (mod ...))) (id? (syntax id)))
+         (values (syntax->datum (syntax id))
+                 (syntax->datum
+                  (syntax (private mod ...))))))))
+
+(global-extend 'core 'if
+  (lambda (e r w s mod)
+    (syntax-case e ()
+      ((_ test then)
+       (build-conditional
+        s
+        (chi (syntax test) r w mod)
+        (chi (syntax then) r w mod)
+        (build-void no-source)))
+      ((_ test then else)
+       (build-conditional
+        s
+        (chi (syntax test) r w mod)
+        (chi (syntax then) r w mod)
+        (chi (syntax else) r w mod))))))
 
 (global-extend 'begin 'begin '())
 
@@ -1716,7 +1939,7 @@
   (let ()
     (define convert-pattern
       ; accepts pattern & keys
-      ; returns syntax-dispatch pattern & ids
+      ; returns $sc-dispatch pattern & ids
       (lambda (pattern keys)
         (let cvt ((p pattern) (n 0) (ids '()))
           (if (id? p)
@@ -1747,102 +1970,111 @@
                 (x (values (vector 'atom (strip p empty-wrap)) ids)))))))
 
     (define build-dispatch-call
-      (lambda (pvars exp y r)
+      (lambda (pvars exp y r mod)
         (let ((ids (map car pvars)) (levels (map cdr pvars)))
           (let ((labels (gen-labels ids)) (new-vars (map gen-var ids)))
             (build-application no-source
               (build-primref no-source 'apply)
-              (list (build-lambda no-source new-vars
+              (list (build-lambda no-source (map syntax->datum ids) new-vars #f
                       (chi exp
-                         (extend-env
-                             labels
-                             (map (lambda (var level)
-                                    (make-binding 'syntax `(,var . ,level)))
-                                  new-vars
-                                  (map cdr pvars))
-                             r)
-                           (make-binding-wrap ids labels empty-wrap)))
+                           (extend-env
+                            labels
+                            (map (lambda (var level)
+                                   (make-binding 'syntax `(,var . ,level)))
+                                 new-vars
+                                 (map cdr pvars))
+                            r)
+                           (make-binding-wrap ids labels empty-wrap)
+                           mod))
                     y))))))
 
     (define gen-clause
-      (lambda (x keys clauses r pat fender exp)
+      (lambda (x keys clauses r pat fender exp mod)
         (call-with-values
           (lambda () (convert-pattern pat keys))
           (lambda (p pvars)
             (cond
               ((not (distinct-bound-ids? (map car pvars)))
-               (syntax-error pat
-                 "duplicate pattern variable in syntax-case pattern"))
-              ((not (andmap (lambda (x) (not (ellipsis? (car x)))) pvars))
-               (syntax-error pat
-                 "misplaced ellipsis in syntax-case pattern"))
+               (syntax-violation 'syntax-case "duplicate pattern variable" pat))
+              ((not (and-map (lambda (x) (not (ellipsis? (car x)))) pvars))
+               (syntax-violation 'syntax-case "misplaced ellipsis" pat))
               (else
                (let ((y (gen-var 'tmp)))
                  ; fat finger binding and references to temp variable y
                  (build-application no-source
-                   (build-lambda no-source (list y)
-                     (let ((y (build-lexical-reference 'value no-source y)))
+                   (build-lambda no-source (list 'tmp) (list y) #f
+                     (let ((y (build-lexical-reference 'value no-source
+                                                       'tmp y)))
                        (build-conditional no-source
                          (syntax-case fender ()
                            (#t y)
                            (_ (build-conditional no-source
                                 y
-                                (build-dispatch-call pvars fender y r)
+                                (build-dispatch-call pvars fender y r mod)
                                 (build-data no-source #f))))
-                         (build-dispatch-call pvars exp y r)
-                         (gen-syntax-case x keys clauses r))))
+                         (build-dispatch-call pvars exp y r mod)
+                         (gen-syntax-case x keys clauses r mod))))
                    (list (if (eq? p 'any)
                              (build-application no-source
                                (build-primref no-source 'list)
                                (list x))
                              (build-application no-source
-                               (build-primref no-source 'syntax-dispatch)
+                               (build-primref no-source '$sc-dispatch)
                                (list x (build-data no-source p)))))))))))))
 
     (define gen-syntax-case
-      (lambda (x keys clauses r)
+      (lambda (x keys clauses r mod)
         (if (null? clauses)
             (build-application no-source
-              (build-primref no-source 'syntax-error)
-              (list x))
+              (build-primref no-source 'syntax-violation)
+              (list (build-data no-source #f)
+                    (build-data no-source
+                                "source expression failed to match any pattern")
+                    x))
             (syntax-case (car clauses) ()
               ((pat exp)
                (if (and (id? (syntax pat))
-                        (andmap (lambda (x) (not (free-id=? (syntax pat) x)))
-                          (cons (syntax (... ...)) keys)))
+                        (and-map (lambda (x) (not (free-id=? (syntax pat) x)))
+                                 (cons (syntax (... ...)) keys)))
                    (let ((labels (list (gen-label)))
                          (var (gen-var (syntax pat))))
                      (build-application no-source
-                       (build-lambda no-source (list var)
+                       (build-lambda no-source
+                                     (list (syntax->datum (syntax pat))) (list var)
+                                     #f
                          (chi (syntax exp)
                               (extend-env labels
                                 (list (make-binding 'syntax `(,var . 0)))
                                 r)
                               (make-binding-wrap (syntax (pat))
-                                labels empty-wrap)))
+                                labels empty-wrap)
+                              mod))
                        (list x)))
                    (gen-clause x keys (cdr clauses) r
-                     (syntax pat) #t (syntax exp))))
+                     (syntax pat) #t (syntax exp) mod)))
               ((pat fender exp)
                (gen-clause x keys (cdr clauses) r
-                 (syntax pat) (syntax fender) (syntax exp)))
-              (_ (syntax-error (car clauses) "invalid syntax-case clause"))))))
+                 (syntax pat) (syntax fender) (syntax exp) mod))
+              (_ (syntax-violation 'syntax-case "invalid clause"
+                                   (car clauses)))))))
 
-    (lambda (e r w s)
-      (let ((e (source-wrap e w s)))
+    (lambda (e r w s mod)
+      (let ((e (source-wrap e w s mod)))
         (syntax-case e ()
           ((_ val (key ...) m ...)
-           (if (andmap (lambda (x) (and (id? x) (not (ellipsis? x))))
-                       (syntax (key ...)))
+           (if (and-map (lambda (x) (and (id? x) (not (ellipsis? x))))
+                        (syntax (key ...)))
                (let ((x (gen-var 'tmp)))
                  ; fat finger binding and references to temp variable x
                  (build-application s
-                   (build-lambda no-source (list x)
-                     (gen-syntax-case (build-lexical-reference 'value no-source x)
+                   (build-lambda no-source (list 'tmp) (list x) #f
+                     (gen-syntax-case (build-lexical-reference 'value no-source
+                                                               'tmp x)
                        (syntax (key ...)) (syntax (m ...))
-                       r))
-                   (list (chi (syntax val) r empty-wrap))))
-               (syntax-error e "invalid literals list in"))))))))
+                       r
+                       mod))
+                   (list (chi (syntax val) r empty-wrap mod))))
+               (syntax-violation 'syntax-case "invalid literals list" e))))))))
 
 ;;; The portable sc-expand seeds chi-top's mode m with 'e (for
 ;;; evaluating) and esew (which stands for "eval syntax expanders
@@ -1854,34 +2086,27 @@
 ;;; expanded, and the expanded definitions are also residualized into
 ;;; the object file if we are compiling a file.
 (set! sc-expand
-  (let ((m 'e) (esew '(eval)))
-    (lambda (x)
-      (if (and (pair? x) (equal? (car x) noexpand))
-          (cadr x)
-          (chi-top x null-env top-wrap m esew)))))
-
-(set! sc-expand3
-  (let ((m 'e) (esew '(eval)))
-    (lambda (x . rest)
-      (if (and (pair? x) (equal? (car x) noexpand))
-          (cadr x)
-          (chi-top x
-		   null-env
-		   top-wrap
-		   (if (null? rest) m (car rest))
-		   (if (or (null? rest) (null? (cdr rest)))
-		       esew
-		       (cadr rest)))))))
+      (lambda (x . rest)
+        (if (and (pair? x) (equal? (car x) noexpand))
+            (cadr x)
+            (let ((m (if (null? rest) 'e (car rest)))
+                  (esew (if (or (null? rest) (null? (cdr rest)))
+                            '(eval)
+                            (cadr rest))))
+              (with-fluid* *mode* m
+                (lambda ()
+                  (chi-top x null-env top-wrap m esew
+                           (cons 'hygiene (module-name (current-module))))))))))
 
 (set! identifier?
   (lambda (x)
     (nonsymbol-id? x)))
 
-(set! datum->syntax-object
+(set! datum->syntax
   (lambda (id datum)
-    (make-syntax-object datum (syntax-object-wrap id))))
+    (make-syntax-object datum (syntax-object-wrap id) #f)))
 
-(set! syntax-object->datum
+(set! syntax->datum
   ; accepts any object, since syntax objects may consist partially
   ; or entirely of unwrapped, nonsymbolic data
   (lambda (x)
@@ -1890,7 +2115,7 @@
 (set! generate-temporaries
   (lambda (ls)
     (arg-check list? ls 'generate-temporaries)
-    (map (lambda (x) (wrap (gensym-hook) top-wrap)) ls)))
+    (map (lambda (x) (wrap (gensym-hook) top-wrap #f)) ls)))
 
 (set! free-identifier=?
    (lambda (x y)
@@ -1904,21 +2129,23 @@
       (arg-check nonsymbol-id? y 'bound-identifier=?)
       (bound-id=? x y)))
 
-(set! syntax-error
-  (lambda (object . messages)
-    (for-each (lambda (x) (arg-check string? x 'syntax-error)) messages)
-    (let ((message (if (null? messages)
-                       "invalid syntax"
-                       (apply string-append messages))))
-      (error-hook #f message (strip object empty-wrap)))))
-
-(set! install-global-transformer
-  (lambda (sym v)
-    (arg-check symbol? sym 'define-syntax)
-    (arg-check procedure? v 'define-syntax)
-    (global-extend 'macro sym v)))
-
-;;; syntax-dispatch expects an expression and a pattern.  If the expression
+(set! syntax-violation
+  (lambda (who message form . subform)
+    (arg-check (lambda (x) (or (not x) (string? x) (symbol? x)))
+               who 'syntax-violation)
+    (arg-check string? message 'syntax-violation)
+    (scm-error 'syntax-error 'sc-expand
+               (string-append
+                (if who "~a: " "")
+                "~a "
+                (if (null? subform) "in ~a" "in subform `~s' of `~s'"))
+               (let ((tail (cons message
+                                 (map (lambda (x) (strip x empty-wrap))
+                                      (append subform (list form))))))
+                 (if who (cons who tail) tail))
+               #f)))
+
+;;; $sc-dispatch expects an expression and a pattern.  If the expression
 ;;; matches the pattern a list of the matching expressions for each
 ;;; "any" is returned.  Otherwise, #f is returned.  (This use of #f will
 ;;; not work on r4rs implementations that violate the ieee requirement
@@ -1943,35 +2170,33 @@
 (let ()
 
 (define match-each
-  (lambda (e p w)
+  (lambda (e p w mod)
     (cond
-      ((annotation? e)
-       (match-each (annotation-expression e) p w))
-      ((pair? e)
-       (let ((first (match (car e) p w '())))
-         (and first
-              (let ((rest (match-each (cdr e) p w)))
-                 (and rest (cons first rest))))))
-      ((null? e) '())
-      ((syntax-object? e)
-       (match-each (syntax-object-expression e)
-                   p
-                   (join-wraps w (syntax-object-wrap e))))
-      (else #f))))
+     ((pair? e)
+      (let ((first (match (car e) p w '() mod)))
+        (and first
+             (let ((rest (match-each (cdr e) p w mod)))
+               (and rest (cons first rest))))))
+     ((null? e) '())
+     ((syntax-object? e)
+      (match-each (syntax-object-expression e)
+                  p
+                  (join-wraps w (syntax-object-wrap e))
+                  (syntax-object-module e)))
+     (else #f))))
 
 (define match-each-any
-  (lambda (e w)
+  (lambda (e w mod)
     (cond
-      ((annotation? e)
-       (match-each-any (annotation-expression e) w))
-      ((pair? e)
-       (let ((l (match-each-any (cdr e) w)))
-         (and l (cons (wrap (car e) w) l))))
-      ((null? e) '())
-      ((syntax-object? e)
-       (match-each-any (syntax-object-expression e)
-                       (join-wraps w (syntax-object-wrap e))))
-      (else #f))))
+     ((pair? e)
+      (let ((l (match-each-any (cdr e) w mod)))
+        (and l (cons (wrap (car e) w mod) l))))
+     ((null? e) '())
+     ((syntax-object? e)
+      (match-each-any (syntax-object-expression e)
+                      (join-wraps w (syntax-object-wrap e))
+                      mod))
+     (else #f))))
 
 (define match-empty
   (lambda (p r)
@@ -1987,54 +2212,55 @@
          ((vector) (match-empty (vector-ref p 1) r)))))))
 
 (define match*
-  (lambda (e p w r)
+  (lambda (e p w r mod)
     (cond
       ((null? p) (and (null? e) r))
       ((pair? p)
        (and (pair? e) (match (car e) (car p) w
-                        (match (cdr e) (cdr p) w r))))
+                        (match (cdr e) (cdr p) w r mod)
+                        mod)))
       ((eq? p 'each-any)
-       (let ((l (match-each-any e w))) (and l (cons l r))))
+       (let ((l (match-each-any e w mod))) (and l (cons l r))))
       (else
        (case (vector-ref p 0)
          ((each)
           (if (null? e)
               (match-empty (vector-ref p 1) r)
-              (let ((l (match-each e (vector-ref p 1) w)))
+              (let ((l (match-each e (vector-ref p 1) w mod)))
                 (and l
                      (let collect ((l l))
                        (if (null? (car l))
                            r
                            (cons (map car l) (collect (map cdr l)))))))))
-         ((free-id) (and (id? e) (free-id=? (wrap e w) (vector-ref p 1)) r))
+         ((free-id) (and (id? e) (free-id=? (wrap e w mod) (vector-ref p 1)) r))
          ((atom) (and (equal? (vector-ref p 1) (strip e w)) r))
          ((vector)
           (and (vector? e)
-               (match (vector->list e) (vector-ref p 1) w r))))))))
+               (match (vector->list e) (vector-ref p 1) w r mod))))))))
 
 (define match
-  (lambda (e p w r)
+  (lambda (e p w r mod)
     (cond
       ((not r) #f)
-      ((eq? p 'any) (cons (wrap e w) r))
+      ((eq? p 'any) (cons (wrap e w mod) r))
       ((syntax-object? e)
        (match*
-         (unannotate (syntax-object-expression e))
-         p
-         (join-wraps w (syntax-object-wrap e))
-         r))
-      (else (match* (unannotate e) p w r)))))
+        (syntax-object-expression e)
+        p
+        (join-wraps w (syntax-object-wrap e))
+        r
+        (syntax-object-module e)))
+      (else (match* e p w r mod)))))
 
-(set! syntax-dispatch
+(set! $sc-dispatch
   (lambda (e p)
     (cond
       ((eq? p 'any) (list e))
       ((syntax-object? e)
-       (match* (unannotate (syntax-object-expression e))
-         p (syntax-object-wrap e) '()))
-      (else (match* (unannotate e) p empty-wrap '())))))
+       (match* (syntax-object-expression e)
+               p (syntax-object-wrap e) '() (syntax-object-module e)))
+      (else (match* e p empty-wrap '() #f)))))
 
-(set! sc-chi chi)
 ))
 )
 
@@ -2062,7 +2288,7 @@
   (lambda (x)
     (syntax-case x ()
       ((let* ((x v) ...) e1 e2 ...)
-       (andmap identifier? (syntax (x ...)))
+       (and-map identifier? (syntax (x ...)))
        (let f ((bindings (syntax ((x v)  ...))))
          (if (null? bindings)
              (syntax (let () e1 e2 ...))
@@ -2079,7 +2305,9 @@
                                  (syntax-case s ()
                                     (() v)
                                     ((e) (syntax e))
-                                    (_ (syntax-error orig-x))))
+                                    (_ (syntax-violation
+                                        'do "bad step expression" 
+                                        orig-x s))))
                               (syntax (var ...))
                               (syntax (step ...)))))
              (syntax-case (syntax (e1 ...)) ()
@@ -2127,12 +2355,22 @@
                    (syntax p)
                    (quasicons (syntax (quote unquote))
                               (quasi (syntax (p)) (- lev 1)))))
+              ((unquote . args)
+               (= lev 0)
+               (syntax-violation 'unquote
+                                 "unquote takes exactly one argument"
+                                 p (syntax (unquote . args))))
               (((unquote-splicing p) . q)
                (if (= lev 0)
                    (quasiappend (syntax p) (quasi (syntax q) lev))
                    (quasicons (quasicons (syntax (quote unquote-splicing))
                                          (quasi (syntax (p)) (- lev 1)))
                               (quasi (syntax q) lev))))
+              (((unquote-splicing . args) . q)
+               (= lev 0)
+               (syntax-violation 'unquote-splicing
+                                 "unquote-splicing takes exactly one argument"
+                                 p (syntax (unquote-splicing . args))))
               ((quasiquote p)
                (quasicons (syntax (quote quasiquote))
                           (quasi (syntax (p)) (+ lev 1))))
@@ -2152,29 +2390,29 @@
           (let f ((x (read p)))
             (if (eof-object? x)
                 (begin (close-input-port p) '())
-                (cons (datum->syntax-object k x)
+                (cons (datum->syntax k x)
                       (f (read p))))))))
     (syntax-case x ()
       ((k filename)
-       (let ((fn (syntax-object->datum (syntax filename))))
+       (let ((fn (syntax->datum (syntax filename))))
          (with-syntax (((exp ...) (read-file fn (syntax k))))
            (syntax (begin exp ...))))))))
 
 (define-syntax unquote
-   (lambda (x)
-      (syntax-case x ()
-         ((_ e)
-          (error 'unquote
-		 "expression ,~s not valid outside of quasiquote"
-		 (syntax-object->datum (syntax e)))))))
+  (lambda (x)
+    (syntax-case x ()
+      ((_ e)
+       (syntax-violation 'unquote
+                         "expression not valid outside of quasiquote"
+                         x)))))
 
 (define-syntax unquote-splicing
-   (lambda (x)
-      (syntax-case x ()
-         ((_ e)
-          (error 'unquote-splicing
-		 "expression ,@~s not valid outside of quasiquote"
-		 (syntax-object->datum (syntax e)))))))
+  (lambda (x)
+    (syntax-case x ()
+      ((_ e)
+       (syntax-violation 'unquote-splicing
+                         "expression not valid outside of quasiquote"
+                         x)))))
 
 (define-syntax case
   (lambda (x)
@@ -2187,14 +2425,15 @@
                         ((else e1 e2 ...) (syntax (begin e1 e2 ...)))
                         (((k ...) e1 e2 ...)
                          (syntax (if (memv t '(k ...)) (begin e1 e2 ...))))
-                        (_ (syntax-error x)))
+                        (_ (syntax-violation 'case "bad clause" x clause)))
                       (with-syntax ((rest (f (car clauses) (cdr clauses))))
                         (syntax-case clause (else)
                           (((k ...) e1 e2 ...)
                            (syntax (if (memv t '(k ...))
                                        (begin e1 e2 ...)
                                        rest)))
-                          (_ (syntax-error x))))))))
+                          (_ (syntax-violation 'case "bad clause" x
+                                               clause))))))))
          (syntax (let ((t e)) body)))))))
 
 (define-syntax identifier-syntax
@@ -2209,4 +2448,3 @@
               (syntax e))
              ((_ x (... ...))
               (syntax (e x (... ...)))))))))))
-
diff --git a/ice-9/q.scm b/module/ice-9/q.scm
index 0c12d7f40..4dc5d4953 100644
--- a/ice-9/q.scm
+++ b/module/ice-9/q.scm
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/ice-9/r4rs.scm b/module/ice-9/r4rs.scm
index de2aeb2de..c23f31af1 100644
--- a/ice-9/r4rs.scm
+++ b/module/ice-9/r4rs.scm
@@ -6,7 +6,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -17,6 +17,9 @@
 ;;;; License along with this library; if not, write to the Free Software
 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
+(eval-when (compile)
+  (set-current-module (resolve-module '(guile))))
+
 
 ;;;; apply and call-with-current-continuation
 
@@ -186,28 +189,3 @@ procedures, their behavior is implementation dependent."
    (lambda (p) (with-error-to-port p thunk))))
 
 (define the-eof-object (call-with-input-string "" (lambda (p) (read-char p))))
-
-
-;;;; Loading
-
-(if (not (defined? '%load-verbosely))
-    (define %load-verbosely #f))
-(define (assert-load-verbosity v) (set! %load-verbosely v))
-
-(define (%load-announce file)
-  (if %load-verbosely
-      (with-output-to-port (current-error-port)
-	(lambda ()
-	  (display ";;; ")
-	  (display "loading ")
-	  (display file)
-	  (newline)
-	  (force-output)))))
-
-(set! %load-hook %load-announce)
-
-(define (load name . reader)
-  (with-fluid* current-reader (and (pair? reader) (car reader))
-    (lambda ()
-      (start-stack 'load-stack
-		   (primitive-load name)))))
diff --git a/ice-9/r5rs.scm b/module/ice-9/r5rs.scm
index 2b40515d3..c867f9a3c 100644
--- a/ice-9/r5rs.scm
+++ b/module/ice-9/r5rs.scm
@@ -3,7 +3,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/ice-9/rdelim.scm b/module/ice-9/rdelim.scm
index d21d45c38..71aae3c8b 100644
--- a/ice-9/rdelim.scm
+++ b/module/ice-9/rdelim.scm
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/module/ice-9/receive.scm b/module/ice-9/receive.scm
new file mode 100644
index 000000000..d550c6f36
--- /dev/null
+++ b/module/ice-9/receive.scm
@@ -0,0 +1,28 @@
+;;;; SRFI-8
+
+;;; Copyright (C) 2000, 2001, 2004, 2006 Free Software Foundation, Inc.
+;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (ice-9 receive)
+  :export (receive)
+  :no-backtrace
+  )
+
+(define-macro (receive vars vals . body)
+  `(call-with-values (lambda () ,vals)
+     (lambda ,vars ,@body)))
+
+(cond-expand-provide (current-module) '(srfi-8))
diff --git a/ice-9/regex.scm b/module/ice-9/regex.scm
index 61937d04f..2327bfe17 100644
--- a/ice-9/regex.scm
+++ b/module/ice-9/regex.scm
@@ -3,7 +3,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/ice-9/runq.scm b/module/ice-9/runq.scm
index 6ac4e5783..c14eb8967 100644
--- a/ice-9/runq.scm
+++ b/module/ice-9/runq.scm
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -216,13 +216,14 @@
 ;;;
 ;;; 		Returns a new strip which is the concatenation of the argument strips.
 ;;;
-(define ((strip-sequence . strips))
-  (let loop ((st (let ((a strips)) (set! strips #f) a)))
-    (and (not (null? st))
-	 (let ((then ((car st))))
-	   (if then
-	       (lambda () (loop (cons then (cdr st))))
-	       (lambda () (loop (cdr st))))))))
+(define (strip-sequence . strips)
+  (lambda ()
+    (let loop ((st (let ((a strips)) (set! strips #f) a)))
+      (and (not (null? st))
+           (let ((then ((car st))))
+             (if then
+                 (lambda () (loop (cons then (cdr st))))
+                 (lambda () (loop (cdr st)))))))))
 
 
 ;;;;
diff --git a/ice-9/rw.scm b/module/ice-9/rw.scm
index 2731e889a..b76282a47 100644
--- a/ice-9/rw.scm
+++ b/module/ice-9/rw.scm
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/ice-9/safe-r5rs.scm b/module/ice-9/safe-r5rs.scm
index 13a44d23d..f728533cb 100644
--- a/ice-9/safe-r5rs.scm
+++ b/module/ice-9/safe-r5rs.scm
@@ -3,7 +3,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/ice-9/safe.scm b/module/ice-9/safe.scm
index 15b77990a..1ce8f9ed9 100644
--- a/ice-9/safe.scm
+++ b/module/ice-9/safe.scm
@@ -3,7 +3,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/ice-9/serialize.scm b/module/ice-9/serialize.scm
index 3c70f4421..008a70a9e 100644
--- a/ice-9/serialize.scm
+++ b/module/ice-9/serialize.scm
@@ -3,7 +3,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/ice-9/session.scm b/module/ice-9/session.scm
index c1bbab206..1f3ec2795 100644
--- a/ice-9/session.scm
+++ b/module/ice-9/session.scm
@@ -3,7 +3,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -25,7 +25,8 @@
            add-name-help-handler! remove-name-help-handler!
            apropos apropos-internal apropos-fold apropos-fold-accessible
            apropos-fold-exported apropos-fold-all source arity
-           system-module module-commentary))
+           procedure-arguments
+           module-commentary))
 
 
 
@@ -74,72 +75,72 @@ handlers, potentially falling back on the normal behavior for `help'."
 
 ;;; Documentation
 ;;;
-(define help
-  (procedure->syntax
-    (lambda (exp env)
-      "(help [NAME])
+(define-macro (help . exp)
+  "(help [NAME])
 Prints useful information.  Try `(help)'."
-      (cond ((not (= (length exp) 2))
-             (help-usage))
-            ((not (provided? 'regex))
-             (display "`help' depends on the `regex' feature.
-You don't seem to have regular expressions installed.\n"))
+  (cond ((not (= (length exp) 1))
+         (help-usage)
+         '(begin))
+        ((not (provided? 'regex))
+         (display "`help' depends on the `regex' feature.
+You don't seem to have regular expressions installed.\n")
+         '(begin))
+        (else
+         (let ((name (car exp))
+               (not-found (lambda (type x)
+                            (simple-format #t "No ~A found for ~A\n"
+                                           type x))))
+           (cond
+            
+            ;; User-specified
+            ((try-name-help name)
+             => (lambda (x) (if (not (eq? x #t)) (display x))))
+
+            ;; SYMBOL
+            ((symbol? name)
+             (help-doc name
+                       (simple-format
+                        #f "^~A$"
+                        (regexp-quote (symbol->string name)))))
+            
+            ;; "STRING"
+            ((string? name)
+             (help-doc name name))
+
+            ;; (unquote SYMBOL)
+            ((and (list? name)
+                  (= (length name) 2)
+                  (eq? (car name) 'unquote))
+             (let ((doc (try-value-help (cadr name)
+                                        (local-eval (cadr name) env))))
+               (cond ((not doc) (not-found 'documentation (cadr name)))
+                     ((eq? doc #t)) ;; pass
+                     (else (write-line doc)))))
+
+            ;; (quote SYMBOL)
+            ((and (list? name)
+                  (= (length name) 2)
+                  (eq? (car name) 'quote)
+                  (symbol? (cadr name)))
+             (cond ((search-documentation-files (cadr name))
+                    => write-line)
+                   (else (not-found 'documentation (cadr name)))))
+
+            ;; (SYM1 SYM2 ...)
+            ((and (list? name)
+                  (and-map symbol? name)
+                  (not (null? name))
+                  (not (eq? (car name) 'quote)))
+             (cond ((module-commentary name)
+                    => (lambda (doc)
+                         (display name) (write-line " commentary:")
+                         (write-line doc)))
+                   (else (not-found 'commentary name))))
+
+            ;; unrecognized
             (else
-             (let ((name (cadr exp))
-                   (not-found (lambda (type x)
-                                (simple-format #t "No ~A found for ~A\n"
-                                               type x))))
-               (cond
-
-                ;; User-specified
-                ((try-name-help name)
-                 => (lambda (x) (if (not (eq? x #t)) (display x))))
-
-                ;; SYMBOL
-                ((symbol? name)
-                 (help-doc name
-                           (simple-format
-                            #f "^~A$"
-                            (regexp-quote (symbol->string name)))))
-
-                ;; "STRING"
-                ((string? name)
-                 (help-doc name name))
-
-                ;; (unquote SYMBOL)
-                ((and (list? name)
-                      (= (length name) 2)
-                      (eq? (car name) 'unquote))
-                 (let ((doc (try-value-help (cadr name)
-                                            (local-eval (cadr name) env))))
-                   (cond ((not doc) (not-found 'documentation (cadr name)))
-                         ((eq? doc #t)) ;; pass
-                         (else (write-line doc)))))
-
-                ;; (quote SYMBOL)
-                ((and (list? name)
-                      (= (length name) 2)
-                      (eq? (car name) 'quote)
-                      (symbol? (cadr name)))
-                 (cond ((search-documentation-files (cadr name))
-                        => write-line)
-                       (else (not-found 'documentation (cadr name)))))
-
-                ;; (SYM1 SYM2 ...)
-                ((and (list? name)
-                      (and-map symbol? name)
-                      (not (null? name))
-                      (not (eq? (car name) 'quote)))
-                 (cond ((module-commentary name)
-                        => (lambda (doc)
-                             (display name) (write-line " commentary:")
-                             (write-line doc)))
-                       (else (not-found 'commentary name))))
-
-                ;; unrecognized
-                (else
-                 (help-usage)))
-               *unspecified*))))))
+             (help-usage)))
+           '(begin)))))
 
 (define (module-filename name)          ; fixme: better way? / done elsewhere?
   (let* ((name (map symbol->string name))
@@ -509,17 +510,25 @@ It is an image under the mapping EXTRACT."
 	      (display #\'))))))))
   (display ".\n"))
 
-(define system-module
-  (procedure->syntax
-   (lambda (exp env)
-     (let* ((m (nested-ref the-root-module
-			   (append '(app modules) (cadr exp)))))
-       (if (not m)
-	   (error "Couldn't find any module named" (cadr exp)))
-       (let ((s (not (procedure-property (module-eval-closure m)
-					 'system-module))))
-	 (set-system-module! m s)
-	 (string-append "Module " (symbol->string (module-name m))
-			" is now a " (if s "system" "user") " module."))))))
+
+(define (procedure-arguments proc)
+  "Return an alist describing the arguments that `proc' accepts, or `#f'
+if the information cannot be obtained.
+
+The alist keys that are currently defined are `required', `optional',
+`keyword', and `rest'."
+  (cond
+   ((procedure-property proc 'arglist)
+    => (lambda (arglist)
+         `((required . ,(car arglist))
+           (optional . ,(cadr arglist))
+           (keyword . ,(caddr arglist))
+           (rest . ,(car (cddddr arglist))))))
+   ((procedure-source proc)
+    => cadr)
+   (((@ (system vm program) program?) proc)
+    ((@ (system vm program) program-arguments) proc))
+   (else #f)))
+
 
 ;;; session.scm ends here
diff --git a/ice-9/slib.scm b/module/ice-9/slib.scm
index a2b526562..78c734e2a 100644
--- a/ice-9/slib.scm
+++ b/module/ice-9/slib.scm
@@ -5,13 +5,13 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
-;;;;
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 ;;;; Lesser General Public License for more details.
-;;;;
+;;;; 
 ;;;; You should have received a copy of the GNU Lesser General Public
 ;;;; License along with this library; if not, write to the Free Software
 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
diff --git a/ice-9/stack-catch.scm b/module/ice-9/stack-catch.scm
index 81faca063..f7b207535 100644
--- a/ice-9/stack-catch.scm
+++ b/module/ice-9/stack-catch.scm
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -40,4 +40,4 @@ this call to @code{catch}."
   (catch key
 	 thunk
 	 handler
-	 lazy-handler-dispatch))
+	 default-pre-unwind-handler))
diff --git a/ice-9/streams.scm b/module/ice-9/streams.scm
index 317d47245..e0a17d488 100644
--- a/ice-9/streams.scm
+++ b/module/ice-9/streams.scm
@@ -6,7 +6,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/ice-9/string-fun.scm b/module/ice-9/string-fun.scm
index 590a7d2a4..c27ff847f 100644
--- a/ice-9/string-fun.scm
+++ b/module/ice-9/string-fun.scm
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -197,9 +197,10 @@
 ;;; (define-public string-prefix=? (string-prefix-predicate string=?))
 ;;;
 
-(define ((string-prefix-predicate pred?) prefix str)
-  (and (<= (string-length prefix) (string-length str))
-       (pred? prefix (substring str 0 (string-length prefix)))))
+(define (string-prefix-predicate pred?)
+  (lambda (prefix str)
+    (and (<= (string-length prefix) (string-length str))
+         (pred? prefix (substring str 0 (string-length prefix))))))
 
 (define string-prefix=? (string-prefix-predicate string=?))
 
diff --git a/module/ice-9/syncase.scm b/module/ice-9/syncase.scm
new file mode 100644
index 000000000..210a23280
--- /dev/null
+++ b/module/ice-9/syncase.scm
@@ -0,0 +1,31 @@
+;;;; 	Copyright (C) 1997, 2000, 2001, 2002, 2003, 2006 Free Software Foundation, Inc.
+;;;; 
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+;;;; 
+
+
+(define-module (ice-9 syncase)
+  )
+
+(issue-deprecation-warning
+ "Syntax-case macros are now a part of Guile core; importing (ice-9 syncase) is no longer necessary.")
+
+;;; Hack to make syncase macros work in the slib module
+;; FIXME wingo is this still necessary?
+;; (let ((m (nested-ref the-root-module '(%app modules ice-9 slib))))
+;;   (if m
+;;       (set-object-property! (module-local-variable m 'define)
+;; 			    '*sc-expander*
+;; 			    '(define))))
diff --git a/ice-9/test.scm b/module/ice-9/test.scm
index bed39b621..f6080e4cf 100644
--- a/ice-9/test.scm
+++ b/module/ice-9/test.scm
@@ -1,18 +1,18 @@
 ;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 2006 Free Software Foundation, Inc.
 ;; 
-;; This library is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU Lesser General Public
-;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
-;; 
-;; This library is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;; Lesser General Public License for more details.
-;; 
-;; You should have received a copy of the GNU Lesser General Public
-;; License along with this library; if not, write to the Free Software
-;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 ;;;; "test.scm" Test correctness of scheme implementations.
 ;;; Author: Aubrey Jaffer
diff --git a/ice-9/threads.scm b/module/ice-9/threads.scm
index cdabb2417..292d3c27a 100644
--- a/ice-9/threads.scm
+++ b/module/ice-9/threads.scm
@@ -3,7 +3,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -32,27 +32,78 @@
 ;;; Code:
 
 (define-module (ice-9 threads)
-  :export (par-map
+  :export (begin-thread
+           parallel
+           letpar
+           make-thread
+           with-mutex
+           monitor
+
+           par-map
 	   par-for-each
 	   n-par-map
 	   n-par-for-each
 	   n-for-each-par-map
-	   %thread-handler)
-  :export-syntax (begin-thread
-		  parallel
-		  letpar
-		  make-thread
-		  with-mutex
-		  monitor))
+	   %thread-handler))
 
 
 
-(define ((par-mapper mapper)  proc . arglists)
-  (mapper join-thread
-	  (apply map
-		 (lambda args
-		   (begin-thread (apply proc args)))
-		 arglists)))
+;;; Macros first, so that the procedures expand correctly.
+
+(define-syntax begin-thread
+  (syntax-rules ()
+    ((_ e0 e1 ...)
+     (call-with-new-thread
+      (lambda () e0 e1 ...)
+      %thread-handler))))
+
+(define-syntax parallel
+  (lambda (x)
+    (syntax-case x ()
+      ((_ e0 ...)
+       (with-syntax (((tmp0 ...) (generate-temporaries (syntax (e0 ...)))))
+         (syntax
+          (let ((tmp0 (begin-thread e0))
+                ...)
+            (values (join-thread tmp0) ...))))))))
+
+(define-syntax letpar
+  (syntax-rules ()
+    ((_ ((v e) ...) b0 b1 ...)
+     (call-with-values
+         (lambda () (parallel e ...))
+       (lambda (v ...)
+         b0 b1 ...)))))
+
+(define-syntax make-thread
+  (syntax-rules ()
+    ((_ proc arg ...)
+     (call-with-new-thread
+      (lambda () (proc arg ...))
+      %thread-handler))))
+
+(define-syntax with-mutex
+  (syntax-rules ()
+    ((_ m e0 e1 ...)
+     (let ((x m))
+       (dynamic-wind
+         (lambda () (lock-mutex x))
+         (lambda () (begin e0 e1 ...))
+         (lambda () (unlock-mutex x)))))))
+
+(define-syntax monitor
+  (syntax-rules ()
+    ((_ first rest ...)
+     (with-mutex (make-mutex)
+       first rest ...))))
+
+(define (par-mapper mapper)
+  (lambda (proc . arglists)
+    (mapper join-thread
+            (apply map
+                   (lambda args
+                     (begin-thread (apply proc args)))
+                   arglists))))
 
 (define par-map (par-mapper map))
 (define par-for-each (par-mapper for-each))
@@ -170,52 +221,4 @@ of applying P-PROC on ARGLISTS."
 ;;; Set system thread handler
 (define %thread-handler thread-handler)
 
-; --- MACROS -------------------------------------------------------
-
-(define-macro (begin-thread . forms)
-  (if (null? forms)
-      '(begin)
-      `(call-with-new-thread
-	(lambda ()
-	  ,@forms)
-	%thread-handler)))
-
-(define-macro (parallel . forms)
-  (cond ((null? forms) '(values))
-	((null? (cdr forms)) (car forms))
-	(else
-	 (let ((vars (map (lambda (f)
-			    (make-symbol "f"))
-			  forms)))
-	   `((lambda ,vars
-	       (values ,@(map (lambda (v) `(join-thread ,v)) vars)))
-	     ,@(map (lambda (form) `(begin-thread ,form)) forms))))))
-
-(define-macro (letpar bindings . body)
-  (cond ((or (null? bindings) (null? (cdr bindings)))
-	 `(let ,bindings ,@body))
-	(else
-	 (let ((vars (map car bindings)))
-	   `((lambda ,vars
-	       ((lambda ,vars ,@body)
-		,@(map (lambda (v) `(join-thread ,v)) vars)))
-	     ,@(map (lambda (b) `(begin-thread ,(cadr b))) bindings))))))
-
-(define-macro (make-thread proc . args)
-  `(call-with-new-thread
-    (lambda ()
-      (,proc ,@args))
-    %thread-handler))
-
-(define-macro (with-mutex m . body)
-  `(dynamic-wind
-       (lambda () (lock-mutex ,m))
-       (lambda () (begin ,@body))
-       (lambda () (unlock-mutex ,m))))
-
-(define-macro (monitor first . rest)
-  `(with-mutex ,(make-mutex)
-     (begin
-       ,first ,@rest)))
-
 ;;; threads.scm ends here
diff --git a/ice-9/time.scm b/module/ice-9/time.scm
index a7045969f..0fad8dfca 100644
--- a/ice-9/time.scm
+++ b/module/ice-9/time.scm
@@ -3,7 +3,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -53,6 +53,6 @@
     result))
 
 (define-macro (time exp)
-  `(,time-proc (lambda () ,exp)))
+  `((@@ (ice-9 time) time-proc) (lambda () ,exp)))
 
 ;;; time.scm ends here
diff --git a/ice-9/weak-vector.scm b/module/ice-9/weak-vector.scm
index 92d40d840..09e2e0a8d 100644
--- a/ice-9/weak-vector.scm
+++ b/module/ice-9/weak-vector.scm
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/module/language/assembly.scm b/module/language/assembly.scm
new file mode 100644
index 000000000..683da6cc1
--- /dev/null
+++ b/module/language/assembly.scm
@@ -0,0 +1,165 @@
+;;; Guile Virtual Machine Assembly
+
+;; Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (language assembly)
+  #:use-module (rnrs bytevector)
+  #:use-module (system base pmatch)
+  #:use-module (system vm instruction)
+  #:use-module ((srfi srfi-1) #:select (fold))
+  #:export (byte-length
+            addr+ align-program align-code align-block
+            assembly-pack assembly-unpack
+            object->assembly assembly->object))
+
+;; nargs, nrest, nlocs, len, metalen, padding
+(define *program-header-len* (+ 1 1 2 4 4 4))
+
+;; lengths are encoded in 3 bytes
+(define *len-len* 3)
+
+
+(define (byte-length assembly)
+  (pmatch assembly
+    (,label (guard (not (pair? label)))
+     0)
+    ((load-number ,str)
+     (+ 1 *len-len* (string-length str)))
+    ((load-string ,str)
+     (+ 1 *len-len* (string-length str)))
+    ((load-wide-string ,str)
+     (+ 1 *len-len* (* 4 (string-length str))))
+    ((load-symbol ,str)
+     (+ 1 *len-len* (string-length str)))
+    ((load-array ,bv)
+     (+ 1 *len-len* (bytevector-length bv)))
+    ((load-program ,nargs ,nrest ,nlocs ,labels ,len ,meta . ,code)
+     (+ 1 *program-header-len* len (if meta (1- (byte-length meta)) 0)))
+    ((,inst . _) (guard (>= (instruction-length inst) 0))
+     (+ 1 (instruction-length inst)))
+    (else (error "unknown instruction" assembly))))
+
+
+(define *program-alignment* 8)
+
+(define *block-alignment* 8)
+
+(define (addr+ addr code)
+  (fold (lambda (x len) (+ (byte-length x) len))
+        addr
+        code))
+
+(define (code-alignment addr alignment header-len)
+  (make-list (modulo (- alignment
+                        (modulo (+ addr header-len) alignment))
+                     alignment)
+             '(nop)))
+
+(define (align-block addr)
+  (code-alignment addr *block-alignment* 0))
+
+(define (align-code code addr alignment header-len)
+  `(,@(code-alignment addr alignment header-len)
+    ,code))
+
+(define (align-program prog addr)
+  (align-code prog addr *program-alignment* 1))
+
+;;;
+;;; Code compress/decompression
+;;;
+
+(define *abbreviations*
+  '(((make-int8 0) . (make-int8:0))
+    ((make-int8 1) . (make-int8:1))))
+  
+(define *expansions*
+  (map (lambda (x) (cons (cdr x) (car x))) *abbreviations*))
+
+(define (assembly-pack code)
+  (or (assoc-ref *abbreviations* code)
+      code))
+
+(define (assembly-unpack code)
+  (or (assoc-ref *expansions* code)
+      code))
+
+
+;;;
+;;; Encoder/decoder
+;;;
+
+(define (object->assembly x)
+  (cond ((eq? x #t) `(make-true))
+	((eq? x #f) `(make-false))
+	((null? x) `(make-eol))
+	((and (integer? x) (exact? x))
+	 (cond ((and (<= -128 x) (< x 128))
+		(assembly-pack `(make-int8 ,(modulo x 256))))
+	       ((and (<= -32768 x) (< x 32768))
+		(let ((n (if (< x 0) (+ x 65536) x)))
+		  `(make-int16 ,(quotient n 256) ,(modulo n 256))))
+               ((and (<= 0 x #xffffffffffffffff))
+                `(make-uint64 ,@(bytevector->u8-list
+                                 (let ((bv (make-bytevector 8)))
+                                   (bytevector-u64-set! bv 0 x (endianness big))
+                                   bv))))
+	       ((and (<= 0 (+ x #x8000000000000000) #x7fffffffffffffff))
+                `(make-int64 ,@(bytevector->u8-list
+                                (let ((bv (make-bytevector 8)))
+                                  (bytevector-s64-set! bv 0 x (endianness big))
+                                  bv))))
+	       (else #f)))
+	((char? x)
+         (cond ((<= (char->integer x) #xff)
+                `(make-char8 ,(char->integer x)))
+               (else
+                `(make-char32 ,(char->integer x)))))
+	(else #f)))
+
+(define (assembly->object code)
+  (pmatch code
+    ((make-true) #t)
+    ((make-false) #f) ;; FIXME: Same as the `else' case!
+    ((make-eol) '())
+    ((make-int8 ,n)
+     (if (< n 128) n (- n 256)))
+    ((make-int16 ,n1 ,n2)
+     (let ((n (+ (* n1 256) n2)))
+       (if (< n 32768) n (- n 65536))))
+    ((make-uint64 ,n1 ,n2 ,n3 ,n4 ,n5 ,n6 ,n7 ,n8)
+     (bytevector-u64-ref
+      (u8-list->bytevector (list n1 n2 n3 n4 n5 n6 n7 n8))
+      0
+      (endianness big)))
+    ((make-int64 ,n1 ,n2 ,n3 ,n4 ,n5 ,n6 ,n7 ,n8)
+     (bytevector-s64-ref
+      (u8-list->bytevector (list n1 n2 n3 n4 n5 n6 n7 n8))
+      0
+      (endianness big)))
+    ((make-char8 ,n)
+     (integer->char n))
+    ((make-char32 ,n1 ,n2 ,n3 ,n4)
+     (integer->char (+ (* n1 #x1000000)
+                       (* n2 #x10000)
+                       (* n3 #x100)
+                       n4)))
+    ((load-string ,s) s)
+    ((load-symbol ,s) (string->symbol s))
+    (else #f)))
diff --git a/module/language/assembly/compile-bytecode.scm b/module/language/assembly/compile-bytecode.scm
new file mode 100644
index 000000000..688cb6b31
--- /dev/null
+++ b/module/language/assembly/compile-bytecode.scm
@@ -0,0 +1,158 @@
+;;; Guile VM assembler
+
+;; Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (language assembly compile-bytecode)
+  #:use-module (system base pmatch)
+  #:use-module (language assembly)
+  #:use-module (system vm instruction)
+  #:use-module (srfi srfi-4)
+  #:use-module (rnrs bytevector)
+  #:use-module ((srfi srfi-1) #:select (fold))
+  #:use-module ((system vm objcode) #:select (byte-order))
+  #:export (compile-bytecode write-bytecode))
+
+(define (compile-bytecode assembly env . opts)
+  (pmatch assembly
+    ((load-program . _)
+     ;; the 1- and -1 are so that we drop the load-program byte
+     (letrec ((v (make-u8vector (1- (byte-length assembly))))
+              (i -1)
+              (write-byte (lambda (b)
+                            (if (>= i 0) (u8vector-set! v i b))
+                            (set! i (1+ i))))
+              (get-addr (lambda () i)))
+       (write-bytecode assembly write-byte get-addr '())
+       (if (= i (u8vector-length v))
+           (values v env env)
+           (error "incorrect length in assembly" i (u8vector-length v)))))
+    (else (error "bad assembly" assembly))))
+
+(define (write-bytecode asm write-byte get-addr labels)
+  (define (write-char c)
+    (write-byte (char->integer c)))
+  (define (write-string s)
+    (string-for-each write-char s))
+  (define (write-uint16-be x)
+    (write-byte (logand (ash x -8) 255))
+    (write-byte (logand x 255)))
+  (define (write-uint16-le x)
+    (write-byte (logand x 255))
+    (write-byte (logand (ash x -8) 255)))
+  (define (write-uint32-be x)
+    (write-byte (logand (ash x -24) 255))
+    (write-byte (logand (ash x -16) 255))
+    (write-byte (logand (ash x -8) 255))
+    (write-byte (logand x 255)))
+  (define (write-uint32-le x)
+    (write-byte (logand x 255))
+    (write-byte (logand (ash x -8) 255))
+    (write-byte (logand (ash x -16) 255))
+    (write-byte (logand (ash x -24) 255)))
+  (define (write-uint32 x)
+    (case byte-order
+      ((1234) (write-uint32-le x))
+      ((4321) (write-uint32-be x))
+      (else (error "unknown endianness" byte-order))))
+  (define (write-wide-string s)
+    (write-loader-len (* 4 (string-length s)))
+    (string-for-each (lambda (c) (write-uint32 (char->integer c))) s))
+  (define (write-loader-len len)
+    (write-byte (ash len -16))
+    (write-byte (logand (ash len -8) 255))
+    (write-byte (logand len 255)))
+  (define (write-loader str)
+    (write-loader-len (string-length str))
+    (write-string str))
+  (define (write-sized-loader str)
+    (let ((len (string-length str))
+          (wid (string-bytes-per-char str)))
+      (write-loader-len len)
+      (write-byte wid)
+      (if (= wid 4)
+          (write-wide-string str)
+          (write-string str))))
+  (define (write-bytevector bv)
+    (write-loader-len (bytevector-length bv))
+    ;; Ew!
+    (for-each write-byte (bytevector->u8-list bv)))
+  (define (write-break label)
+    (let ((offset (- (assq-ref labels label)
+                     (logand (+ (get-addr) 2) (lognot #x7)))))
+      (cond ((not (= 0 (modulo offset 8))) (error "unaligned jump" offset))
+            ((>= offset (ash 1 18)) (error "jump too far forward" offset))
+            ((< offset (- (ash 1 18))) (error "jump too far backwards" offset))
+            (else (write-uint16-be (ash offset -3))))))
+  
+  (let ((inst (car asm))
+        (args (cdr asm))
+        (write-uint16 (case byte-order
+                        ((1234) write-uint16-le)
+                        ((4321) write-uint16-be)
+                        (else (error "unknown endianness" byte-order)))))
+    (let ((opcode (instruction->opcode inst))
+          (len (instruction-length inst)))
+      (write-byte opcode)
+      (pmatch asm
+        ((load-program ,nargs ,nrest ,nlocs ,labels ,length ,meta . ,code)
+         (write-byte nargs)
+         (write-byte nrest)
+         (write-uint16 nlocs)
+         (write-uint32 length)
+         (write-uint32 (if meta (1- (byte-length meta)) 0))
+         (write-uint32 0) ; padding
+         (letrec ((i 0)
+                  (write (lambda (x) (set! i (1+ i)) (write-byte x)))
+                  (get-addr (lambda () i)))
+           (for-each (lambda (asm)
+                       (write-bytecode asm write get-addr labels))
+                     code))
+         (if meta
+             ;; don't write the load-program byte for metadata
+             (letrec ((i -1)
+                      (write (lambda (x)
+                               (set! i (1+ i))
+                               (if (> i 0) (write-byte x))))
+                      (get-addr (lambda () i)))
+               ;; META's bytecode meets the alignment requirements of
+               ;; `scm_objcode', thanks to the alignment computed in
+               ;; `(language assembly)'.
+               (write-bytecode meta write get-addr '()))))
+        ((make-char32 ,x) (write-uint32-be x))
+        ((load-number ,str) (write-loader str))
+        ((load-string ,str) (write-loader str))
+        ((load-wide-string ,str) (write-wide-string str))
+        ((load-symbol ,str) (write-loader str))
+        ((load-array ,bv) (write-bytevector bv))
+        ((br ,l) (write-break l))
+        ((br-if ,l) (write-break l))
+        ((br-if-not ,l) (write-break l))
+        ((br-if-eq ,l) (write-break l))
+        ((br-if-not-eq ,l) (write-break l))
+        ((br-if-null ,l) (write-break l))
+        ((br-if-not-null ,l) (write-break l))
+        ((mv-call ,n ,l) (write-byte n) (write-break l))
+        (else
+         (cond
+          ((< (instruction-length inst) 0)
+           (error "unhanded variable-length instruction" asm))
+          ((not (= (length args) len))
+           (error "bad number of args to instruction" asm len))
+          (else
+           (for-each write-byte args))))))))
diff --git a/module/language/assembly/decompile-bytecode.scm b/module/language/assembly/decompile-bytecode.scm
new file mode 100644
index 000000000..8cdebcfd0
--- /dev/null
+++ b/module/language/assembly/decompile-bytecode.scm
@@ -0,0 +1,134 @@
+;;; Guile VM code converters
+
+;; Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (language assembly decompile-bytecode)
+  #:use-module (system vm instruction)
+  #:use-module (system base pmatch)
+  #:use-module (srfi srfi-4)
+  #:use-module (rnrs bytevector)
+  #:use-module (language assembly)
+  #:use-module ((system vm objcode) #:select (byte-order))
+  #:export (decompile-bytecode))
+
+(define (decompile-bytecode x env opts)
+  (let ((i 0) (size (u8vector-length x)))
+    (define (pop)
+      (let ((b (cond ((< i size) (u8vector-ref x i))
+                     ((= i size) #f)
+                     (else (error "tried to decode too many bytes")))))
+        (if b (set! i (1+ i)))
+        b))
+    (let ((ret (decode-load-program pop)))
+      (if (= i size)
+          (values ret env)
+          (error "bad bytecode: only decoded ~a out of ~a bytes" i size)))))
+
+(define (br-instruction? x)
+  (memq x '(br br-if br-if-not br-if-eq br-if-not-eq br-if-null br-if-not-null)))
+
+(define (bytes->s16 a b)
+  (let ((x (+ (ash a 8) b)))
+    (if (zero? (logand (ash 1 15) x))
+        x
+        (- x (ash 1 16)))))
+
+;; FIXME: this is a little-endian disassembly!!!
+(define (decode-load-program pop)
+  (let* ((nargs (pop)) (nrest (pop)) (nlocs0 (pop)) (nlocs1 (pop))
+         (nlocs (+ nlocs0 (ash nlocs1 8)))
+         (a (pop)) (b (pop)) (c (pop)) (d (pop))
+         (e (pop)) (f (pop)) (g (pop)) (h (pop))
+         (len (+ a (ash b 8) (ash c 16) (ash d 24)))
+         (metalen (+ e (ash f 8) (ash g 16) (ash h 24)))
+         (totlen (+ len metalen))
+         (pad0 (pop)) (pad1 (pop)) (pad2 (pop)) (pad3 (pop))
+         (labels '())
+         (i 0))
+    (define (ensure-label rel1 rel2)
+      (let ((where (+ (logand i (lognot #x7))
+                      (* (bytes->s16 rel1 rel2) 8))))
+        (or (assv-ref labels where)
+            (begin
+              (let ((l (gensym ":L")))
+                (set! labels (acons where l labels))
+                l)))))
+    (define (sub-pop) ;; ...records. ha. ha.
+      (let ((b (cond ((< i len) (pop))
+                     ((= i len) #f)
+                     (else (error "tried to decode too many bytes")))))
+        (if b (set! i (1+ i)))
+        b))
+    (let lp ((out '()))
+      (cond ((> i len)
+             (error "error decoding program -- read too many bytes" out))
+            ((= i len)
+             `(load-program ,nargs ,nrest ,nlocs 
+                            ,(map (lambda (x) (cons (cdr x) (car x)))
+                                  (reverse labels))
+                            ,len
+                            ,(if (zero? metalen) #f (decode-load-program pop))
+                            ,@(reverse! out)))
+            (else
+             (let ((exp (decode-bytecode sub-pop)))
+               (pmatch exp
+                 ((,br ,rel1 ,rel2) (guard (br-instruction? br))
+                  (lp (cons `(,br ,(ensure-label rel1 rel2)) out)))
+                 ((mv-call ,n ,rel1 ,rel2)
+                  (lp (cons `(mv-call ,n ,(ensure-label rel1 rel2)) out)))
+                 (else 
+                  (lp (cons exp out))))))))))
+
+(define (decode-bytecode pop)
+  (and=> (pop)
+         (lambda (opcode)
+           (let ((inst (opcode->instruction opcode)))
+             (cond
+              ((eq? inst 'load-program)
+               (decode-load-program pop))
+
+              ((< (instruction-length inst) 0)
+               ;; the negative length indicates a variable length
+               ;; instruction
+               (let* ((make-sequence
+                       (if (or (memq inst '(load-array load-wide-string)))
+                           make-bytevector
+                           make-string))
+                      (sequence-set!
+                       (if (or (memq inst '(load-array load-wide-string)))
+                           bytevector-u8-set!
+                           (lambda (str pos value)
+                             (string-set! str pos (integer->char value)))))
+                      (len (let* ((a (pop)) (b (pop)) (c (pop)))
+                             (+ (ash a 16) (ash b 8) c)))
+                      (seq (make-sequence len)))
+                 (let lp ((i 0))
+                   (if (= i len)
+                       `(,inst ,(if (eq? inst 'load-wide-string)
+                                    (utf32->string seq)
+                                    seq))
+                       (begin
+                         (sequence-set! seq i (pop))
+                         (lp (1+ i)))))))
+              (else
+               ;; fixed length
+               (let lp ((n (instruction-length inst)) (out (list inst)))
+                 (if (zero? n)
+                     (reverse! out)
+                     (lp (1- n) (cons (pop) out))))))))))
diff --git a/module/language/assembly/disassemble.scm b/module/language/assembly/disassemble.scm
new file mode 100644
index 000000000..492acb7e5
--- /dev/null
+++ b/module/language/assembly/disassemble.scm
@@ -0,0 +1,172 @@
+;;; Guile VM code converters
+
+;; Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (language assembly disassemble)
+  #:use-module (ice-9 format)
+  #:use-module (system vm instruction)
+  #:use-module (system vm program)
+  #:use-module (system base pmatch)
+  #:use-module (language assembly)
+  #:use-module (system base compile)
+  #:export (disassemble))
+
+(define (disassemble x)
+  (format #t "Disassembly of ~A:\n\n" x)
+  (call-with-values
+      (lambda () (decompile x #:from 'value #:to 'assembly))
+    disassemble-load-program))
+
+(define (disassemble-load-program asm env)
+  (pmatch asm
+    ((load-program ,nargs ,nrest ,nlocs ,labels ,len ,meta . ,code)
+     (let ((objs  (and env (assq-ref env 'objects)))
+           (free-vars (and env (assq-ref env 'free-vars)))
+           (meta  (and env (assq-ref env 'meta)))
+           (blocs (and env (assq-ref env 'blocs)))
+           (srcs  (and env (assq-ref env 'sources))))
+       (let lp ((pos 0) (code code) (programs '()))
+         (cond
+          ((null? code)
+           (newline)
+           (for-each
+            (lambda (sym+asm)
+              (format #t "Embedded program ~A:\n\n" (car sym+asm))
+              (disassemble-load-program (cdr sym+asm) '()))
+            (reverse! programs)))
+          (else
+           (let* ((asm (car code))
+                  (len (byte-length asm))
+                  (end (+ pos len)))
+             (pmatch asm
+               ((load-program . _)
+                (let ((sym (gensym "")))
+                  (print-info pos `(load-program ,sym) #f #f)
+                  (lp (+ pos (byte-length asm)) (cdr code)
+                      (acons sym asm programs))))
+               ((nop)
+                (lp (+ pos (byte-length asm)) (cdr code) programs))
+               (else
+                (print-info pos asm
+                            (code-annotation end asm objs nargs blocs
+                                             labels)
+                            (and=> (and srcs (assq end srcs)) source->string))
+                (lp (+ pos (byte-length asm)) (cdr code) programs)))))))
+                 
+       (if (pair? free-vars)
+           (disassemble-free-vars free-vars))
+       (if meta
+           (disassemble-meta meta))
+
+       ;; Disassemble other bytecode in it
+       ;; FIXME: something about the module.
+       (if objs
+           (for-each
+            (lambda (x)
+              (if (program? x)
+                  (begin (display "----------------------------------------\n")
+                         (disassemble x))))
+            (cdr (vector->list objs))))))
+    (else
+     (error "bad load-program form" asm))))
+
+(define (disassemble-objects objs)
+  (display "Objects:\n\n")
+  (let ((len (vector-length objs)))
+    (do ((n 0 (1+ n)))
+	((= n len) (newline))
+      (print-info n (vector-ref objs n) #f #f))))
+
+(define (disassemble-free-vars free-vars)
+  (display "Free variables:\n\n")
+  (let ((i 0))
+    (cond ((< i (vector-length free-vars))
+           (print-info i (vector-ref free-vars i) #f #f)
+           (lp (1+ i))))))
+
+(define-macro (unless test . body)
+  `(if (not ,test) (begin ,@body)))
+
+(define *uninteresting-props* '(name))
+
+(define (disassemble-meta meta)
+  (let ((sources (cadr meta))
+        (props (filter (lambda (x)
+                         (not (memq (car x) *uninteresting-props*)))
+                       (cddr meta))))
+    (unless (null? props)
+      (display "Properties:\n\n")
+      (for-each (lambda (x) (print-info #f x #f #f)) props)
+      (newline))))
+
+(define (source->string src)
+  (format #f "~a:~a:~a" (or (source:file src) "(unknown file)")
+          (source:line src) (source:column src)))
+
+(define (make-int16 byte1 byte2)
+  (+ (* byte1 256) byte2))
+
+(define (code-annotation end-addr code objs nargs blocs labels)
+  (let* ((code (assembly-unpack code))
+         (inst (car code))
+         (args (cdr code)))
+    (case inst
+      ((list vector) 
+       (list "~a element~:p" (apply make-int16 args)))
+      ((br br-if br-if-eq br-if-not br-if-not-eq br-if-not-null br-if-null)
+       (list "-> ~A" (assq-ref labels (car args))))
+      ((object-ref)
+       (and objs (list "~s" (vector-ref objs (car args)))))
+      ((local-ref local-boxed-ref local-set local-boxed-set)
+       (and blocs
+            (let lp ((bindings (list-ref blocs (car args))))
+              (and (pair? bindings)
+                   (let ((b (car bindings)))
+                     (if (and (< (binding:start (car bindings)) end-addr)
+                              (>= (binding:end (car bindings)) end-addr))
+                         (list "`~a'~@[ (arg)~]"
+                               (binding:name b) (< (binding:index b) nargs))
+                         (lp (cdr bindings))))))))
+      ((free-ref free-boxed-ref free-boxed-set)
+       ;; FIXME: we can do better than this
+       (list "(closure variable)"))
+      ((toplevel-ref toplevel-set)
+       (and objs
+            (let ((v (vector-ref objs (car args))))
+              (if (and (variable? v) (variable-bound? v))
+                  (list "~s" (variable-ref v))
+                  (list "`~s'" v)))))
+      ((mv-call)
+       (list "MV -> ~A" (assq-ref labels (cadr args))))
+      (else
+       (and=> (assembly->object code)
+              (lambda (obj) (list "~s" obj)))))))
+
+;; i am format's daddy.
+(define (print-info addr info extra src)
+  (format #t "~4@S    ~32S~@[;; ~1{~@?~}~]~@[~61t at ~a~]\n" addr info extra src))
+
+(define (simplify x)
+  (cond ((string? x)
+	 (cond ((string-index x #\newline) =>
+		(lambda (i) (set! x (substring x 0 i)))))
+	 (cond ((> (string-length x) 16)
+		(set! x (string-append (substring x 0 13) "..."))))))
+  x)
+
diff --git a/module/language/assembly/spec.scm b/module/language/assembly/spec.scm
new file mode 100644
index 000000000..286c80511
--- /dev/null
+++ b/module/language/assembly/spec.scm
@@ -0,0 +1,35 @@
+;;; Guile Virtual Machine Assembly
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (language assembly spec)
+  #:use-module (system base language)
+  #:use-module (language assembly compile-bytecode)
+  #:use-module (language assembly decompile-bytecode)
+  #:export (assembly))
+
+(define-language assembly
+  #:title	"Guile Virtual Machine Assembly Language"
+  #:version	"2.0"
+  #:reader	read
+  #:printer	write
+  #:parser      read ;; fixme: make a verifier?
+  #:compilers   `((bytecode . ,compile-bytecode))
+  #:decompilers `((bytecode . ,decompile-bytecode))
+  )
diff --git a/module/language/brainfuck/compile-scheme.scm b/module/language/brainfuck/compile-scheme.scm
new file mode 100644
index 000000000..86bc35fdd
--- /dev/null
+++ b/module/language/brainfuck/compile-scheme.scm
@@ -0,0 +1,126 @@
+;;; Brainfuck for GNU Guile
+
+;; Copyright (C) 2009 Free Software Foundation, Inc.
+
+;; This library is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public
+;; License as published by the Free Software Foundation; either
+;; version 3 of the License, or (at your option) any later version.
+;; 
+;; This library is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; Lesser General Public License for more details.
+;; 
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (language brainfuck compile-scheme)
+  #:export (compile-scheme))
+
+;; Compilation of Brainfuck to Scheme is pretty straight-forward.  For all of
+;; brainfuck's instructions, there are basic representations in Scheme we
+;; only have to generate.
+;;
+;; Brainfuck's pointer and data-tape are stored in the variables pointer and
+;; tape, where tape is a vector of integer values initially set to zero.  Pointer
+;; starts out at position 0.
+;; Our tape is thus of finite length, with an address range of 0..n for
+;; some defined upper bound n depending on the length of our tape.
+
+
+;; Define the length to use for the tape.
+
+(define tape-size 30000)
+
+
+;; This compiles a whole brainfuck program.  This constructs a Scheme code like:
+;; (let ((pointer 0)
+;;       (tape (make-vector tape-size 0)))
+;;   (begin
+;;     <body>
+;;     (write-char #\newline)))
+;;
+;; So first the pointer and tape variables are set up correctly, then the
+;; program's body is executed in this context, and finally we output an
+;; additional newline character in case the program does not output one.
+;;
+;; TODO: Find out and explain the details about env, the three return values and
+;; how to use the options.  Implement options to set the tape-size, maybe.
+
+(define (compile-scheme exp env opts)
+  (values
+    `(let ((pointer 0)
+           (tape (make-vector ,tape-size 0)))
+       ,@(if (not (eq? '<brainfuck> (car exp)))
+           (error "expected brainfuck program")
+           `(begin
+              ,@(compile-body (cdr exp))
+              (write-char #\newline))))
+    env
+    env))
+
+
+;; Compile a list of instructions to get a list of Scheme codes.  As we always
+;; strip off the car of the instructions-list and cons the result onto the
+;; result-list, it will get out in reversed order first; so we have to (reverse)
+;; it on return.
+
+(define (compile-body instructions)
+  (let iterate ((cur instructions)
+                (result '()))
+    (if (null? cur)
+      (reverse result)
+      (let ((compiled (compile-instruction (car cur))))
+        (iterate (cdr cur) (cons compiled result))))))
+
+
+;; Compile a single instruction to Scheme, using the direct representations
+;; all of Brainfuck's instructions have.
+
+(define (compile-instruction ins)
+  (case (car ins)
+
+    ;; Pointer moval >< is done simply by something like:
+    ;; (set! pointer (+ pointer +-1))
+    ((<bf-move>)
+     (let ((dir (cadr ins)))
+       `(set! pointer (+ pointer ,dir))))
+
+    ;; Cell increment +- is done as:
+    ;; (vector-set! tape pointer (+ (vector-ref tape pointer) +-1))
+    ((<bf-increment>)
+     (let ((inc (cadr ins)))
+       `(vector-set! tape pointer (+ (vector-ref tape pointer) ,inc))))
+
+    ;; Output . is done by converting the cell's integer value to a character
+    ;; first and then printing out this character:
+    ;; (write-char (integer->char (vector-ref tape pointer)))
+    ((<bf-print>)
+     '(write-char (integer->char (vector-ref tape pointer))))
+
+    ;; Input , is done similarly, read in a character, get its ASCII code and
+    ;; store it into the current cell:
+    ;; (vector-set! tape pointer (char->integer (read-char)))
+    ((<bf-read>)
+     '(vector-set! tape pointer (char->integer (read-char))))
+
+    ;; For loops [...] we use a named let construction to execute the body until
+    ;; the current cell gets zero.  The body is compiled via a recursive call
+    ;; back to (compile-body).
+    ;; (let iterate ()
+    ;;   (if (not (= (vector-ref! tape pointer) 0))
+    ;;     (begin
+    ;;       <body>
+    ;;       (iterate))))
+    ((<bf-loop>)
+     `(let iterate ()
+        (if (not (= (vector-ref tape pointer) 0))
+          (begin
+            ,@(compile-body (cdr ins))
+            (iterate)))))
+
+    (else (error "unknown brainfuck instruction " (car ins)))))
diff --git a/module/language/brainfuck/compile-tree-il.scm b/module/language/brainfuck/compile-tree-il.scm
new file mode 100644
index 000000000..0aaa11274
--- /dev/null
+++ b/module/language/brainfuck/compile-tree-il.scm
@@ -0,0 +1,181 @@
+;;; Brainfuck for GNU Guile
+
+;; Copyright (C) 2009 Free Software Foundation, Inc.
+
+;; This library is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public
+;; License as published by the Free Software Foundation; either
+;; version 3 of the License, or (at your option) any later version.
+;; 
+;; This library is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; Lesser General Public License for more details.
+;; 
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+;; 02110-1301 USA
+
+;;; Commentary:
+
+;; Brainfuck is a simple language that mostly mimics the operations of a
+;; Turing machine. This file implements a compiler from Brainfuck to
+;; Guile's Tree-IL.
+
+;;; Code:
+
+(define-module (language brainfuck compile-tree-il)
+  #:use-module (system base pmatch)
+  #:use-module (language tree-il)
+  #:export (compile-tree-il))
+
+;; Compilation of Brainfuck is pretty straight-forward. For all of
+;; brainfuck's instructions, there are basic representations in Tree-IL
+;; we only have to generate.
+;;
+;; Brainfuck's pointer and data-tape are stored in the variables pointer and
+;; tape, where tape is a vector of integer values initially set to zero.  Pointer
+;; starts out at position 0.
+;; Our tape is thus of finite length, with an address range of 0..n for
+;; some defined upper bound n depending on the length of our tape.
+
+
+;; Define the length to use for the tape.
+
+(define tape-size 30000)
+
+
+;; This compiles a whole brainfuck program. This constructs a Tree-IL
+;; code equivalent to Scheme code like this:
+;;
+;;    (let ((pointer 0)
+;;          (tape (make-vector tape-size 0)))
+;;      (begin
+;;       <body>
+;;       (write-char #\newline)))
+;;
+;; So first the pointer and tape variables are set up correctly, then the
+;; program's body is executed in this context, and finally we output an
+;; additional newline character in case the program does not output one.
+;;
+;; The fact that we are compiling to Guile primitives gives this
+;; implementation a number of interesting characteristics. First, the
+;; values of the tape cells do not underflow or overflow. We could make
+;; them do otherwise via compiling calls to "modulo" at certain points.
+;;
+;; In addition, tape overruns or underruns will be detected, and will
+;; throw an error, whereas a number of Brainfuck compilers do not detect
+;; this.
+;;
+;; Note that we're generating the S-expression representation of
+;; Tree-IL, then using parse-tree-il to turn it into the actual Tree-IL
+;; data structures. This makes the compiler more pleasant to look at,
+;; but we do lose is the ability to propagate source information. Since
+;; Brainfuck is so obtuse anyway, this shouldn't matter ;-)
+;;
+;; `compile-tree-il' takes as its input the read expression, the
+;; environment, and some compile options. It returns the compiled
+;; expression, the environment appropriate for the next pass of the
+;; compiler -- in our case, just the environment unchanged -- and the
+;; continuation environment.
+;;
+;; The normal use of a continuation environment is if compiling one
+;; expression changes the environment, and that changed environment
+;; should be passed to the next compiled expression -- for example,
+;; changing the current module. But Brainfuck is incapable of that, so
+;; for us, the continuation environment is just the same environment we
+;; got in.
+;;
+;; FIXME: perhaps use options or the env to set the tape-size?
+
+(define (compile-tree-il exp env opts)
+  (values
+   (parse-tree-il
+    `(let (pointer tape) (pointer tape)
+          ((const 0)
+           (apply (primitive make-vector) (const ,tape-size) (const 0)))
+          ,(compile-body exp)))
+   env
+   env))
+
+
+;; Compile a list of instructions to a Tree-IL expression.
+
+(define (compile-body instructions)
+  (let lp ((in instructions) (out '()))
+    (define (emit x)
+      (lp (cdr in) (cons x out)))
+    (cond
+     ((null? in)
+      ;; No more input, build our output.
+       (cond
+        ((null? out) '(void)) ; no output
+        ((null? (cdr out)) (car out)) ; single expression
+        (else `(begin ,@(reverse out))))  ; sequence
+       )
+     (else
+      (pmatch (car in)
+
+        ;; Pointer moves >< are done simply by something like:
+        ;;   (set! pointer (+ pointer +-1))
+        ((<bf-move> ,dir)
+         (emit `(set! (lexical pointer)
+                      (apply (primitive +) (lexical pointer) (const ,dir)))))
+
+        ;; Cell increment +- is done as:
+        ;;   (vector-set! tape pointer (+ (vector-ref tape pointer) +-1))
+        ((<bf-increment> ,inc) 
+         (emit `(apply (primitive vector-set!) (lexical tape) (lexical pointer)
+                       (apply (primitive +)
+                              (apply (primitive vector-ref)
+                                     (lexical tape) (lexical pointer))
+                              (const ,inc)))))
+
+        ;; Output . is done by converting the cell's integer value to a
+        ;; character first and then printing out this character:
+        ;;   (write-char (integer->char (vector-ref tape pointer)))
+        ((<bf-print>) 
+         (emit `(apply (primitive write-char)
+                       (apply (primitive integer->char)
+                              (apply (primitive vector-ref)
+                                     (lexical tape) (lexical pointer))))))
+
+        ;; Input , is done similarly, read in a character, get its ASCII
+        ;; code and store it into the current cell:
+        ;;   (vector-set! tape pointer (char->integer (read-char)))
+        ((<bf-read>) 
+         (emit `(apply (primitive vector-set!)
+                       (lexical tape) (lexical pointer)
+                       (apply (primitive char->integer)
+                              (apply (primitive read-char))))))
+
+        ;; For loops [...] we use a letrec construction to execute the body until
+        ;; the current cell gets zero.  The body is compiled via a recursive call
+        ;; back to (compile-body).
+        ;;   (let iterate ()
+        ;;     (if (not (= (vector-ref! tape pointer) 0))
+        ;;         (begin
+        ;;          <body>
+        ;;          (iterate))))
+        ;;
+        ;; Indeed, letrec is the only way we have to loop in Tree-IL.
+        ;; Note that this does not mean that the closure must actually
+        ;; be created; later passes can compile tail-recursive letrec
+        ;; calls into inline code with gotos. Admittedly, that part of
+        ;; the compiler is not yet in place, but it will be, and in the
+        ;; meantime the code is still reasonably efficient.
+        ((<bf-loop> . ,body)
+         (let ((iterate (gensym)))
+           (emit `(letrec (iterate) (,iterate)
+                          ((lambda () () 
+                             (if (apply (primitive =)
+                                        (apply (primitive vector-ref)
+                                               (lexical tape) (lexical pointer))
+                                        (const 0))
+                                 (void)
+                                 (begin ,(compile-body body)
+                                        (apply (lexical ,iterate))))))
+                     (apply (lexical ,iterate))))))
+
+        (else (error "unknown brainfuck instruction" (car in))))))))
diff --git a/module/language/brainfuck/parse.scm b/module/language/brainfuck/parse.scm
new file mode 100644
index 000000000..0a71638d8
--- /dev/null
+++ b/module/language/brainfuck/parse.scm
@@ -0,0 +1,91 @@
+;;; Brainfuck for GNU Guile.
+
+;; Copyright (C) 2009 Free Software Foundation, Inc.
+
+;; This library is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public
+;; License as published by the Free Software Foundation; either
+;; version 3 of the License, or (at your option) any later version.
+;; 
+;; This library is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; Lesser General Public License for more details.
+;; 
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+;; 02110-1301 USA
+
+;;; Code:
+
+(define-module (language brainfuck parse)
+  #:export (read-brainfuck))
+
+; Purpose of the parse module is to read in brainfuck in text form and produce
+; the corresponding tree representing the brainfuck code.
+;
+; Each object (representing basically a single instruction) is structured like:
+; (<instruction> [arguments])
+; where <instruction> is a symbolic name representing the type of instruction
+; and the optional arguments represent further data (for instance, the body of
+; a [...] loop as a number of nested instructions).
+;
+; A full brainfuck program is represented by the (<brainfuck> instructions)
+; object.
+
+
+; While reading a number of instructions in sequence, all of them are cons'ed
+; onto a list of instructions; thus this list gets out in reverse order.
+; Additionally, for "comment characters" (everything not an instruction) we
+; generate <bf-nop> NOP instructions.
+;
+; This routine reverses a list of instructions and removes all <bf-nop>'s on the
+; way to fix these two issues for a read-in list.
+
+(define (reverse-without-nops lst)
+  (let iterate ((cur lst)
+                (result '()))
+    (if (null? cur)
+      result
+      (let ((head (car cur))
+            (tail (cdr cur)))
+        (if (eq? (car head) '<bf-nop>)
+          (iterate tail result)
+          (iterate tail (cons head result)))))))
+
+
+; Read in a set of instructions until a terminating ] character is found (or
+; end of file is reached).  This is used both for loop bodies and whole
+; programs, so that a program has to be either terminated by EOF or an
+; additional ], too.
+;
+; For instance, the basic program so just echo one character would be:
+; ,.]
+
+(define (read-brainfuck p)
+  (let iterate ((parsed '()))
+    (let ((chr (read-char p)))
+      (if (or (eof-object? chr) (eq? #\] chr))
+        (reverse-without-nops parsed)
+        (iterate (cons (process-input-char chr p) parsed))))))
+
+
+; This routine processes a single character of input and builds the
+; corresponding instruction.  Loop bodies are read by recursively calling
+; back (read-brainfuck).
+;
+; For the poiner movement commands >< and the cell increment/decrement +-
+; commands, we only use one instruction form each and specify the direction of
+; the pointer/value increment using an argument to the instruction form.
+
+(define (process-input-char chr p)
+  (case chr
+    ((#\>) '(<bf-move> 1))
+    ((#\<) '(<bf-move> -1))
+    ((#\+) '(<bf-increment> 1))
+    ((#\-) '(<bf-increment> -1))
+    ((#\.) '(<bf-print>))
+    ((#\,) '(<bf-read>))
+    ((#\[) `(<bf-loop> ,@(read-brainfuck p)))
+    (else '(<bf-nop>))))
diff --git a/module/language/brainfuck/spec.scm b/module/language/brainfuck/spec.scm
new file mode 100644
index 000000000..a4ba60f82
--- /dev/null
+++ b/module/language/brainfuck/spec.scm
@@ -0,0 +1,44 @@
+;;; Brainfuck for GNU Guile.
+
+;; Copyright (C) 2009 Free Software Foundation, Inc.
+
+;; This library is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public
+;; License as published by the Free Software Foundation; either
+;; version 3 of the License, or (at your option) any later version.
+;; 
+;; This library is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; Lesser General Public License for more details.
+;; 
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+;; 02110-1301 USA
+
+;;; Code:
+
+(define-module (language brainfuck spec)
+  #:use-module (language brainfuck compile-tree-il)
+  #:use-module (language brainfuck compile-scheme)
+  #:use-module (language brainfuck parse)
+  #:use-module (system base language)
+  #:export (brainfuck))
+
+
+; The new language is integrated into Guile via this (define-language)
+; specification in the special module (language [lang] spec).
+; Provided is a parser-routine in #:reader, a output routine in #:printer
+; and one or more compiler routines (as target-language - routine pairs)
+; in #:compilers.  This is the basic set of fields needed to specify a new
+; language.
+
+(define-language brainfuck
+  #:title	"Guile Brainfuck"
+  #:version	"1.0"
+  #:reader	(lambda () (read-brainfuck (current-input-port)))
+  #:compilers	`((tree-il . ,compile-tree-il)
+                  (scheme . ,compile-scheme))
+  #:printer	write
+  )
diff --git a/module/language/bytecode/spec.scm b/module/language/bytecode/spec.scm
new file mode 100644
index 000000000..184565b04
--- /dev/null
+++ b/module/language/bytecode/spec.scm
@@ -0,0 +1,39 @@
+;;; Guile Lowlevel Intermediate Language
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (language bytecode spec)
+  #:use-module (system base language)
+  #:use-module (system vm objcode)
+  #:export (bytecode))
+
+(define (compile-objcode x e opts)
+  (values (bytecode->objcode x) e e))
+
+(define (decompile-objcode x e opts)
+  (values (objcode->bytecode x) e))
+
+(define-language bytecode
+  #:title	"Guile Bytecode Vectors"
+  #:version	"0.3"
+  #:reader	read
+  #:printer	write
+  #:compilers   `((objcode . ,compile-objcode))
+  #:decompilers `((objcode . ,decompile-objcode))
+  )
diff --git a/module/language/ecmascript/array.scm b/module/language/ecmascript/array.scm
new file mode 100644
index 000000000..e9fc3c6f4
--- /dev/null
+++ b/module/language/ecmascript/array.scm
@@ -0,0 +1,121 @@
+;;; ECMAScript for Guile
+
+;; Copyright (C) 2009 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (language ecmascript array)
+  #:use-module (oop goops)
+  #:use-module (language ecmascript base)
+  #:use-module (language ecmascript function)
+  #:export (*array-prototype* new-array))
+
+
+(define-class <js-array-object> (<js-object>)
+  (vector #:init-value #() #:accessor js-array-vector #:init-keyword #:vector))
+
+(define (new-array . vals)
+  (let ((o (make <js-array-object> #:class "Array"
+                 #:prototype *array-prototype*)))
+    (pput o 'length (length vals))
+    (let ((vect (js-array-vector o)))
+      (let lp ((i 0) (vals vals))
+        (cond ((not (null? vals))
+               (vector-set! vect i (car vals))
+               (lp (1+ i) (cdr vals)))
+              (else o))))))
+
+(define *array-prototype* (make <js-object> #:class "Array"
+                                #:value new-array
+                                #:constructor new-array))
+
+(hashq-set! *program-wrappers* new-array *array-prototype*)
+
+(pput *array-prototype* 'prototype *array-prototype*)
+(pput *array-prototype* 'constructor new-array)
+
+(define-method (pget (o <js-array-object>) p)
+  (cond ((and (integer? p) (exact? p) (>= p 0))
+         (let ((v (js-array-vector o)))
+           (if (< p (vector-length v))
+               (vector-ref v p)
+               (next-method))))
+        ((or (and (symbol? p) (eq? p 'length))
+             (and (string? p) (string=? p "length")))
+         (vector-length (js-array-vector o)))
+        (else (next-method))))
+
+(define-method (pput (o <js-array-object>) p v)
+  (cond ((and (integer? p) (exact? p) (>= 0 p))
+         (let ((vect (js-array-vector o)))
+           (if (< p (vector-length vect))
+               (vector-set! vect p)
+               ;; Fixme: round up to powers of 2?
+               (let ((new (make-vector (1+ p) 0)))
+                 (vector-move-left! vect 0 (vector-length vect) new 0)
+                 (set! (js-array-vector o) new)
+                 (vector-set! new p)))))
+        ((or (and (symbol? p) (eq? p 'length))
+             (and (string? p) (string=? p "length")))
+         (let ((vect (js-array-vector o)))
+           (let ((new (make-vector (->uint32 v) 0)))
+             (vector-move-left! vect 0 (min (vector-length vect) (->uint32 v))
+                                new 0)
+             (set! (js-array-vector o) new))))
+        (else (next-method))))
+
+(define-js-method *array-prototype* (toString)
+  (format #f "~A" (js-array-vector this)))
+
+(define-js-method *array-prototype* (concat . rest)
+  (let* ((len (apply + (->uint32 (pget this 'length))
+                     (map (lambda (x) (->uint32 (pget x 'length)))
+                          rest)))
+         (rv (make-vector len 0)))
+    (let lp ((objs (cons this rest)) (i 0))
+      (cond ((null? objs) (make <js-array-object> #:class "Array"
+                                #:prototype *array-prototype*
+                                #:vector rv))
+            ((is-a? (car objs) <js-array-object>)
+             (let ((v (js-array-vector (car objs))))
+               (vector-move-left! v 0 (vector-length v)
+                                  rv i (+ i (vector-length v)))
+               (lp (cdr objs) (+ i (vector-length v)))))
+            (else
+             (error "generic array concats not yet implemented"))))))
+
+(define-js-method *array-prototype* (join . separator)
+  (let lp ((i (1- (->uint32 (pget this 'length)))) (l '()))
+    (if (< i 0)
+        (string-join l (if separator (->string (car separator)) ","))
+        (lp (1+ i)
+            (cons (->string (pget this i)) l)))))
+
+(define-js-method *array-prototype* (pop)
+  (let ((len (->uint32 (pget this 'length))))
+    (if (zero? len)
+        *undefined*
+        (let ((ret (pget this (1- len))))
+          (pput this 'length (1- len))
+          ret))))
+
+(define-js-method *array-prototype* (push . args)
+  (let lp ((args args))
+    (if (null? args)
+        (->uint32 (pget this 'length))
+        (begin (pput this (->uint32 (pget this 'length)) (car args))
+               (lp (cdr args))))))
diff --git a/module/language/ecmascript/base.scm b/module/language/ecmascript/base.scm
new file mode 100644
index 000000000..1d031fcde
--- /dev/null
+++ b/module/language/ecmascript/base.scm
@@ -0,0 +1,250 @@
+;;; ECMAScript for Guile
+
+;; Copyright (C) 2009 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (language ecmascript base)
+  #:use-module (oop goops)
+  #:export (*undefined* *this*
+            <js-object> *object-prototype*
+            js-prototype js-props js-prop-attrs js-value js-constructor js-class
+            pget prop-keys prop-attrs prop-has-attr? pput has-property? pdel
+
+            object->string object->number object->value/string
+            object->value/number object->value
+
+            ->primitive ->boolean ->number ->integer ->int32 ->uint32
+            ->uint16 ->string ->object
+
+            call/this* call/this lambda/this define-js-method
+
+            new-object new))
+
+(define *undefined* ((@@ (oop goops) make-unbound)))
+(define *this* (make-fluid))
+
+(define-class <js-object> ()
+  (prototype #:getter js-prototype #:init-keyword #:prototype
+             #:init-thunk (lambda () *object-prototype*))
+  (props #:getter js-props #:init-form (make-hash-table 7))
+  (prop-attrs #:getter js-prop-attrs #:init-value #f)
+  (value #:getter js-value #:init-value #f #:init-keyword #:value)
+  (constructor #:getter js-constructor #:init-value #f #:init-keyword #:constructor)
+  (class #:getter js-class #:init-value "Object" #:init-keyword #:class))
+
+(define-method (prop-keys (o <js-object>))
+  (hash-map->list (lambda (k v) k) (js-props o)))
+
+(define-method (pget (o <js-object>) (p <string>))
+  (pget o (string->symbol p)))
+
+(define-method (pget (o <js-object>) p)
+  (let ((h (hashq-get-handle (js-props o) p)))
+    (if h
+        (cdr h)
+        (let ((proto (js-prototype o)))
+          (if proto
+              (pget proto p)
+              *undefined*)))))
+
+(define-method (prop-attrs (o <js-object>) p)
+  (or (let ((attrs (js-prop-attrs o)))
+        (and attrs (hashq-ref (js-prop-attrs o) p)))
+      (let ((proto (js-prototype o)))
+        (if proto
+            (prop-attrs proto p)
+            '()))))
+
+(define-method (prop-has-attr? (o <js-object>) p attr)
+  (memq attr (prop-attrs o p)))
+
+(define-method (pput (o <js-object>) p v)
+  (if (prop-has-attr? o p 'ReadOnly)
+      (throw 'ReferenceError o p)
+      (hashq-set! (js-props o) p v)))
+
+(define-method (pput (o <js-object>) (p <string>) v)
+  (pput o (string->symbol p) v))
+
+(define-method (pdel (o <js-object>) p)
+  (if (prop-has-attr? o p 'DontDelete)
+      #f
+      (begin
+        (pput o p *undefined*)
+        #t)))
+
+(define-method (pdel (o <js-object>) (p <string>) v)
+  (pdel o (string->symbol p)))
+
+(define-method (has-property? (o <js-object>) p)
+  (if (hashq-get-handle (js-props o) v)
+      #t
+      (let ((proto (js-prototype o)))
+        (if proto
+            (has-property? proto p)
+            #f))))
+
+(define (call/this* this f)
+  (with-fluid* *this* this f))
+
+(define-macro (call/this this f . args)
+  `(with-fluid* *this* ,this (lambda () (,f . ,args))))
+(define-macro (lambda/this formals . body)
+  `(lambda ,formals (let ((this (fluid-ref *this*))) . ,body)))
+(define-macro (define-js-method object name-and-args . body)
+  `(pput ,object ',(car name-and-args) (lambda/this ,(cdr name-and-args) . ,body)))
+
+(define *object-prototype* #f)
+(set! *object-prototype* (make <js-object>))
+
+(define-js-method *object-prototype* (toString)
+  (format #f "[object ~A]" (js-class this)))
+(define-js-method *object-prototype* (toLocaleString . args)
+  ((pget *object-prototype* 'toString)))
+(define-js-method *object-prototype* (valueOf)
+  this)
+(define-js-method *object-prototype* (hasOwnProperty p)
+  (and (hashq-get-handle (js-props this) p) #t))
+(define-js-method *object-prototype* (isPrototypeOf v)
+  (eq? this (js-prototype v)))
+(define-js-method *object-prototype* (propertyIsEnumerable p)
+  (and (hashq-get-handle (js-props this) p)
+       (not (prop-has-attr? this p 'DontEnum))))
+
+(define (object->string o error?)
+  (let ((toString (pget o 'toString)))
+    (if (procedure? toString)
+        (let ((x (call/this o toString)))
+          (if (and error? (is-a? x <js-object>))
+              (throw 'TypeError o 'default-value)
+              x))
+        (if error?
+            (throw 'TypeError o 'default-value)
+            o))))
+              
+(define (object->number o error?)
+  (let ((valueOf (pget o 'valueOf)))
+    (if (procedure? valueOf)
+        (let ((x (call/this o valueOf)))
+          (if (and error? (is-a? x <js-object>))
+              (throw 'TypeError o 'default-value)
+              x))
+        (if error?
+            (throw 'TypeError o 'default-value)
+            o))))
+              
+(define (object->value/string o)
+  (let ((v (object->string o #f)))
+    (if (is-a? x <js-object>)
+        (object->number o #t)
+        x)))
+              
+(define (object->value/number o)
+  (let ((v (object->number o #f)))
+    (if (is-a? x <js-object>)
+        (object->string o #t)
+        x)))
+              
+(define (object->value o)
+  ;; FIXME: if it's a date, we should try numbers first
+  (object->value/string o))
+              
+(define (->primitive x)
+  (if (is-a? x <js-object>)
+      (object->value x)
+      x))
+
+(define (->boolean x)
+  (not (or (not x) (null? x) (eq? x *undefined*) (zero? x) (nan? x)
+           (and (string? x) (= (string-length x) 0)))))
+
+(define (->number x)
+  (cond ((number? x) x)
+        ((boolean? x) (if x 1 0))
+        ((null? x) 0)
+        ((eq? x *undefined*) +nan.0)
+        ((is-a? x <js-object>) (object->number o))
+        ((string? x) (string->number x))
+        (else (throw 'TypeError o '->number))))
+
+(define (->integer x)
+  (let ((n (->number x)))
+    (cond ((nan? n) 0)
+          ((zero? n) n)
+          ((inf? n) n)
+          (else (inexact->exact (round n))))))
+
+(define (->int32 x)
+  (let ((n (->number x)))
+    (if (or (nan? n) (zero? n) (inf? n))
+        0
+        (let ((m (logand (1- (ash 1 32)) (inexact->exact (round n)))))
+          (if (negative? n)
+              (- m (ash 1 32))
+              m)))))
+
+(define (->uint32 x)
+  (let ((n (->number x)))
+    (if (or (nan? n) (zero? n) (inf? n))
+        0
+        (logand (1- (ash 1 32)) (inexact->exact (round n))))))
+
+(define (->uint16 x)
+  (let ((n (->number x)))
+    (if (or (nan? n) (zero? n) (inf? n))
+        0
+        (logand (1- (ash 1 16)) (inexact->exact (round n))))))
+
+(define (->string x)
+  (cond ((eq? x *undefined*) "undefined")
+        ((null? x) "null")
+        ((boolean? x) (if x "true" "false"))
+        ((string? x) x)
+        ((number? x)
+         (cond ((nan? x) "NaN")
+               ((zero? x) "0")
+               ((inf? x) "Infinity")
+               (else (number->string x))))
+        (else (->string (object->value/string x)))))
+
+(define (->object x)
+  (cond ((eq? x *undefined*) (throw 'TypeError x '->object))
+        ((null? x) (throw 'TypeError x '->object))
+        ((boolean? x) (make <js-object> #:prototype Boolean #:value x))
+        ((number? x) (make <js-object> #:prototype String #:value x))
+        ((string? x) (make <js-object> #:prototype Number #:value x))
+        (else x)))
+
+(define (new-object . pairs)
+  (let ((o (make <js-object>)))
+    (map (lambda (pair)
+           (pput o (car pair) (cdr pair)))
+         pairs)
+    o))
+(slot-set! *object-prototype* 'constructor new-object)
+
+(define-method (new o . initargs)
+  (let ((ctor (js-constructor o)))
+    (if (not ctor)
+        (throw 'TypeError 'new o)
+        (let ((o (make <js-object>
+                   #:prototype (or (js-prototype o) *object-prototype*))))
+          (let ((new-o (call/this o apply ctor initargs)))
+            (if (is-a? new-o <js-object>)
+                new-o
+                o))))))
diff --git a/module/language/ecmascript/compile-tree-il.scm b/module/language/ecmascript/compile-tree-il.scm
new file mode 100644
index 000000000..88f3db76f
--- /dev/null
+++ b/module/language/ecmascript/compile-tree-il.scm
@@ -0,0 +1,549 @@
+;;; ECMAScript for Guile
+
+;; Copyright (C) 2009 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (language ecmascript compile-tree-il)
+  #:use-module (language tree-il)
+  #:use-module (ice-9 receive)
+  #:use-module (system base pmatch)
+  #:use-module (srfi srfi-1)
+  #:export (compile-tree-il))
+
+(define-syntax ->
+  (syntax-rules ()
+    ((_ (type arg ...))
+     `(type ,arg ...))))
+
+(define-syntax @implv
+  (syntax-rules ()
+    ((_ sym)
+     (-> (module-ref '(language ecmascript impl) 'sym #t)))))
+
+(define-syntax @impl
+  (syntax-rules ()
+    ((_ sym arg ...)
+     (-> (apply (@implv sym) arg ...)))))
+
+(define (empty-lexical-environment)
+  '())
+
+(define (econs name gensym env)
+  (acons name gensym env))
+
+(define (lookup name env)
+  (or (assq-ref env name)
+      (-> (toplevel name))))
+
+(define (compile-tree-il exp env opts)
+  (values
+   (parse-tree-il (comp exp (empty-lexical-environment)))
+   env
+   env))
+
+(define (location x)
+  (and (pair? x)
+       (let ((props (source-properties x)))
+	 (and (not (null? props))
+              props))))
+
+;; for emacs:
+;; (put 'pmatch/source 'scheme-indent-function 1)
+
+(define-syntax pmatch/source
+  (syntax-rules ()
+    ((_ x clause ...)
+     (let ((x x))
+       (let ((res (pmatch x
+                    clause ...)))
+         (let ((loc (location x)))
+           (if loc
+               (set-source-properties! res (location x))))
+         res)))))
+
+(define (comp x e)
+  (let ((l (location x)))
+    (define (let1 what proc)
+      (let ((sym (gensym))) 
+        (-> (let (list sym) (list sym) (list what)
+                 (proc sym)))))
+    (define (begin1 what proc)
+      (let1 what (lambda (v)
+                   (-> (begin (proc v)
+                              (-> (lexical v v)))))))
+    (pmatch/source x
+      (null
+       ;; FIXME, null doesn't have much relation to EOL...
+       (-> (const '())))
+      (true
+       (-> (const #t)))
+      (false
+       (-> (const #f)))
+      ((number ,num)
+       (-> (const num)))
+      ((string ,str)
+       (-> (const str)))
+      (this
+       (@impl get-this '()))
+      ((+ ,a)
+       (-> (apply (-> (primitive '+))
+                  (@impl ->number (comp a e))
+                  (-> (const 0)))))
+      ((- ,a)
+       (-> (apply (-> (primitive '-)) (-> (const 0)) (comp a e))))
+      ((~ ,a)
+       (@impl bitwise-not (comp a e)))
+      ((! ,a)
+       (@impl logical-not (comp a e)))
+      ((+ ,a ,b)
+       (-> (apply (-> (primitive '+)) (comp a e) (comp b e))))
+      ((- ,a ,b)
+       (-> (apply (-> (primitive '-)) (comp a e) (comp b e))))
+      ((/ ,a ,b)
+       (-> (apply (-> (primitive '/)) (comp a e) (comp b e))))
+      ((* ,a ,b)
+       (-> (apply (-> (primitive '*)) (comp a e) (comp b e))))
+      ((% ,a ,b)
+       (@impl mod (comp a e) (comp b e)))
+      ((<< ,a ,b)
+       (@impl shift (comp a e) (comp b e)))
+      ((>> ,a ,b)
+       (@impl shift (comp a e) (comp `(- ,b) e)))
+      ((< ,a ,b)
+       (-> (apply (-> (primitive '<)) (comp a e) (comp b e))))
+      ((<= ,a ,b)
+       (-> (apply (-> (primitive '<=)) (comp a e) (comp b e))))
+      ((> ,a ,b)
+       (-> (apply (-> (primitive '>)) (comp a e) (comp b e))))
+      ((>= ,a ,b)
+       (-> (apply (-> (primitive '>=)) (comp a e) (comp b e))))
+      ((in ,a ,b)
+       (@impl has-property? (comp a e) (comp b e)))
+      ((== ,a ,b)
+       (-> (apply (-> (primitive 'equal?)) (comp a e) (comp b e))))
+      ((!= ,a ,b)
+       (-> (apply (-> (primitive 'not))
+                  (-> (apply (-> (primitive 'equal?))
+                             (comp a e) (comp b e))))))
+      ((=== ,a ,b)
+       (-> (apply (-> (primitive 'eqv?)) (comp a e) (comp b e))))
+      ((!== ,a ,b)
+       (-> (apply (-> (primitive 'not))
+                  (-> (apply (-> (primitive 'eqv?))
+                             (comp a e) (comp b e))))))
+      ((& ,a ,b)
+       (@impl band (comp a e) (comp b e)))
+      ((^ ,a ,b)
+       (@impl bxor (comp a e) (comp b e)))
+      ((bor ,a ,b)
+       (@impl bior (comp a e) (comp b e)))
+      ((and ,a ,b)
+       (-> (if (@impl ->boolean (comp a e))
+               (comp b e)
+               (-> (const #f)))))
+      ((or ,a ,b)
+       (let1 (comp a e)
+             (lambda (v)
+               (-> (if (@impl ->boolean (-> (lexical v v)))
+                       (-> (lexical v v))
+                       (comp b e))))))
+      ((if ,test ,then ,else)
+       (-> (if (@impl ->boolean (comp test e))
+               (comp then e)
+               (comp else e))))
+      ((if ,test ,then ,else)
+       (-> (if (@impl ->boolean (comp test e))
+               (comp then e)
+               (@implv *undefined*))))
+      ((postinc (ref ,foo))
+       (begin1 (comp `(ref ,foo) e)
+               (lambda (var)
+                 (-> (set! (lookup foo e)
+                           (-> (apply (-> (primitive '+))
+                                      (-> (lexical var var))
+                                      (-> (const 1)))))))))
+      ((postinc (pref ,obj ,prop))
+       (let1 (comp obj e)
+             (lambda (objvar)
+               (begin1 (@impl pget
+                              (-> (lexical objvar objvar))
+                              (-> (const prop)))
+                       (lambda (tmpvar)
+                         (@impl pput
+                                (-> (lexical objvar objvar))
+                                (-> (const prop))
+                                (-> (apply (-> (primitive '+))
+                                           (-> (lexical tmpvar tmpvar))
+                                           (-> (const 1))))))))))
+      ((postinc (aref ,obj ,prop))
+       (let1 (comp obj e)
+             (lambda (objvar)
+               (let1 (comp prop e)
+                     (lambda (propvar)
+                       (begin1 (@impl pget
+                                      (-> (lexical objvar objvar))
+                                      (-> (lexical propvar propvar)))
+                               (lambda (tmpvar)
+                                 (@impl pput
+                                        (-> (lexical objvar objvar))
+                                        (-> (lexical propvar propvar))
+                                        (-> (apply (-> (primitive '+))
+                                                   (-> (lexical tmpvar tmpvar))
+                                                   (-> (const 1))))))))))))
+      ((postdec (ref ,foo))
+       (begin1 (comp `(ref ,foo) e)
+               (lambda (var)
+                 (-> (set (lookup foo e)
+                          (-> (apply (-> (primitive '-))
+                                     (-> (lexical var var))
+                                     (-> (const 1)))))))))
+      ((postdec (pref ,obj ,prop))
+       (let1 (comp obj e)
+             (lambda (objvar)
+               (begin1 (@impl pget
+                              (-> (lexical objvar objvar))
+                              (-> (const prop)))
+                       (lambda (tmpvar)
+                         (@impl pput
+                                (-> (lexical objvar objvar))
+                                (-> (const prop))
+                                (-> (apply (-> (primitive '-))
+                                           (-> (lexical tmpvar tmpvar))
+                                           (-> (const 1))))))))))
+      ((postdec (aref ,obj ,prop))
+       (let1 (comp obj e)
+             (lambda (objvar)
+               (let1 (comp prop e)
+                     (lambda (propvar)
+                       (begin1 (@impl pget
+                                      (-> (lexical objvar objvar))
+                                      (-> (lexical propvar propvar)))
+                               (lambda (tmpvar)
+                                 (@impl pput
+                                        (-> (lexical objvar objvar))
+                                        (-> (lexical propvar propvar))
+                                        (-> (inline
+                                             '- (-> (lexical tmpvar tmpvar))
+                                             (-> (const 1))))))))))))
+      ((preinc (ref ,foo))
+       (let ((v (lookup foo e)))
+         (-> (begin
+               (-> (set! v
+                         (-> (apply (-> (primitive '+))
+                                    v
+                                    (-> (const 1))))))
+               v))))
+      ((preinc (pref ,obj ,prop))
+       (let1 (comp obj e)
+             (lambda (objvar)
+               (begin1 (-> (apply (-> (primitive '+))
+                                  (@impl pget
+                                         (-> (lexical objvar objvar))
+                                         (-> (const prop)))
+                                  (-> (const 1))))
+                       (lambda (tmpvar)
+                         (@impl pput (-> (lexical objvar objvar))
+                                (-> (const prop))
+                                (-> (lexical tmpvar tmpvar))))))))
+      ((preinc (aref ,obj ,prop))
+       (let1 (comp obj e)
+             (lambda (objvar)
+               (let1 (comp prop e)
+                     (lambda (propvar)
+                       (begin1 (-> (apply (-> (primitive '+))
+                                          (@impl pget
+                                                 (-> (lexical objvar objvar))
+                                                 (-> (lexical propvar propvar)))
+                                          (-> (const 1))))
+                               (lambda (tmpvar)
+                                 (@impl pput
+                                        (-> (lexical objvar objvar))
+                                        (-> (lexical propvar propvar))
+                                        (-> (lexical tmpvar tmpvar))))))))))
+      ((predec (ref ,foo))
+       (let ((v (lookup foo e)))
+         (-> (begin
+               (-> (set! v
+                        (-> (apply (-> (primitive '-))
+                                   v
+                                   (-> (const 1))))))
+               v))))
+      ((predec (pref ,obj ,prop))
+       (let1 (comp obj e)
+             (lambda (objvar)
+               (begin1 (-> (apply (-> (primitive '-))
+                                  (@impl pget
+                                         (-> (lexical objvar objvar))
+                                         (-> (const prop)))
+                                  (-> (const 1))))
+                       (lambda (tmpvar)
+                         (@impl pput
+                                (-> (lexical objvar objvar))
+                                (-> (const prop))
+                                (-> (lexical tmpvar tmpvar))))))))
+      ((predec (aref ,obj ,prop))
+       (let1 (comp obj e)
+             (lambda (objvar)
+               (let1 (comp prop e)
+                     (lambda (propvar)
+                       (begin1 (-> (apply (-> (primitive '-))
+                                          (@impl pget
+                                                 (-> (lexical objvar objvar))
+                                                 (-> (lexical propvar propvar)))
+                                          (-> (const 1))))
+                               (lambda (tmpvar)
+                                 (@impl pput
+                                        (-> (lexical objvar objvar))
+                                        (-> (lexical propvar propvar))
+                                        (-> (lexical tmpvar tmpvar))))))))))
+      ((ref ,id)
+       (lookup id e))
+      ((var . ,forms)
+       (-> (begin
+             (map (lambda (form)
+                    (pmatch form
+                      ((,x ,y)
+                       (-> (define x (comp y e))))
+                      ((,x)
+                       (-> (define x (@implv *undefined*))))
+                      (else (error "bad var form" form))))
+                  forms))))
+      ((begin . ,forms)
+       `(begin ,@(map (lambda (x) (comp x e)) forms)))
+      ((lambda ,formals ,body)
+       (let ((%args (gensym "%args ")))
+         (-> (lambda '%args %args '()
+                     (comp-body (econs '%args %args e) body formals '%args)))))
+      ((call/this ,obj ,prop . ,args)
+       (@impl call/this*
+              obj
+              (-> (lambda '() '() '()
+                          `(apply ,(@impl pget obj prop) ,@args)))))
+      ((call (pref ,obj ,prop) ,args)
+       (comp `(call/this ,(comp obj e)
+                         ,(-> (const prop))
+                         ,@(map (lambda (x) (comp x e)) args))
+             e))
+      ((call (aref ,obj ,prop) ,args)
+       (comp `(call/this ,(comp obj e)
+                         ,(comp prop e)
+                         ,@(map (lambda (x) (comp x e)) args))
+             e))
+      ((call ,proc ,args)
+       `(apply ,(comp proc e)                
+               ,@(map (lambda (x) (comp x e)) args)))
+      ((return ,expr)
+       (-> (apply (-> (primitive 'return))
+                  (comp expr e))))
+      ((array . ,args)
+       `(apply ,(@implv new-array)
+               ,@(map (lambda (x) (comp x e)) args)))
+      ((object . ,args)
+       (@impl new-object
+              (map (lambda (x)
+                     (pmatch x
+                       ((,prop ,val)
+                        (-> (apply (-> (primitive 'cons))
+                                   (-> (const prop))
+                                   (comp val e))))
+                       (else
+                        (error "bad prop-val pair" x))))
+                   args)))
+      ((pref ,obj ,prop)
+       (@impl pget
+              (comp obj e)
+              (-> (const prop))))
+      ((aref ,obj ,index)
+       (@impl pget
+              (comp obj e)
+              (comp index e)))
+      ((= (ref ,name) ,val)
+       (let ((v (lookup name e)))
+         (-> (begin
+               (-> (set! v (comp val e)))
+               v))))
+      ((= (pref ,obj ,prop) ,val)
+       (@impl pput
+              (comp obj e)
+              (-> (const prop))
+              (comp val e)))
+      ((= (aref ,obj ,prop) ,val)
+       (@impl pput
+              (comp obj e)
+              (comp prop e)
+              (comp val e)))
+      ((+= ,what ,val)
+       (comp `(= ,what (+ ,what ,val)) e))
+      ((-= ,what ,val)
+       (comp `(= ,what (- ,what ,val)) e))
+      ((/= ,what ,val)
+       (comp `(= ,what (/ ,what ,val)) e))
+      ((*= ,what ,val)
+       (comp `(= ,what (* ,what ,val)) e))
+      ((%= ,what ,val)
+       (comp `(= ,what (% ,what ,val)) e))
+      ((>>= ,what ,val)
+       (comp `(= ,what (>> ,what ,val)) e))
+      ((<<= ,what ,val)
+       (comp `(= ,what (<< ,what ,val)) e))
+      ((>>>= ,what ,val)
+       (comp `(= ,what (>>> ,what ,val)) e))
+      ((&= ,what ,val)
+       (comp `(= ,what (& ,what ,val)) e))
+      ((bor= ,what ,val)
+       (comp `(= ,what (bor ,what ,val)) e))
+      ((^= ,what ,val)
+       (comp `(= ,what (^ ,what ,val)) e))
+      ((new ,what ,args)
+       (@impl new
+              (map (lambda (x) (comp x e))
+                   (cons what args))))
+      ((delete (pref ,obj ,prop))
+       (@impl pdel
+              (comp obj e)
+              (-> (const prop))))
+      ((delete (aref ,obj ,prop))
+       (@impl pdel
+              (comp obj e)
+              (comp prop e)))
+      ((void ,expr)
+       (-> (begin
+             (comp expr e)
+             (@implv *undefined*))))
+      ((typeof ,expr)
+       (@impl typeof
+              (comp expr e)))
+      ((do ,statement ,test)
+       (let ((%loop (gensym "%loop "))
+             (%continue (gensym "%continue ")))
+         (let ((e (econs '%loop %loop (econs '%continue %continue e))))
+           (-> (letrec '(%loop %continue) (list %loop %continue)
+                       (list (-> (lambda '() '() '()
+                                         (-> (begin
+                                               (comp statement e)
+                                               (-> (apply (-> (lexical '%continue %continue)))
+                                                   )))))
+                             
+                             (-> (lambda '() '() '()
+                                         (-> (if (@impl ->boolean (comp test e))
+                                                 (-> (apply (-> (lexical '%loop %loop))))
+                                                 (@implv *undefined*))))))
+                       (-> (apply (-> (lexical '%loop %loop)))))))))
+      ((while ,test ,statement)
+       (let ((%continue (gensym "%continue ")))
+         (let ((e (econs '%continue %continue e)))
+           (-> (letrec '(%continue) (list %continue)
+                       (list (-> (lambda '() '() '()
+                                         (-> (if (@impl ->boolean (comp test e))
+                                                 (-> (begin (comp statement e)
+                                                            (-> (apply (-> (lexical '%continue %continue))))))
+                                                 (@implv *undefined*))))))
+                       (-> (apply (-> (lexical '%continue %continue)))))))))
+      
+      ((for ,init ,test ,inc ,statement)
+       (let ((%continue (gensym "%continue ")))
+         (let ((e (econs '%continue %continue e)))
+           (-> (letrec '(%continue) (list %continue)
+                       (list (-> (lambda '() '() '()
+                                         (-> (if (if test
+                                                     (@impl ->boolean (comp test e))
+                                                     (comp 'true e))
+                                                 (-> (begin (comp statement e)
+                                                            (comp (or inc '(begin)) e)
+                                                            (-> (apply (-> (lexical '%continue %continue))))))
+                                                 (@implv *undefined*))))))
+                       (-> (begin (comp (or init '(begin)) e)
+                                  (-> (apply (-> (lexical '%continue %continue)))))))))))
+      
+      ((for-in ,var ,object ,statement)
+       (let ((%enum (gensym "%enum "))
+             (%continue (gensym "%continue ")))
+         (let ((e (econs '%enum %enum (econs '%continue %continue e))))
+           (-> (letrec '(%enum %continue) (list %enum %continue)
+                       (list (@impl make-enumerator (comp object e))
+                             (-> (lambda '() '() '()
+                                         (-> (if (@impl ->boolean
+                                                        (@impl pget
+                                                               (-> (lexical '%enum %enum))
+                                                               (-> (const 'length))))
+                                                 (-> (begin
+                                                       (comp `(= ,var (call/this ,(-> (lexical '%enum %enum))
+                                                                                 ,(-> (const 'pop))))
+                                                             e)
+                                                       (comp statement e)
+                                                       (-> (apply (-> (lexical '%continue %continue))))))
+                                                 (@implv *undefined*))))))
+                       (-> (apply (-> (lexical '%continue %continue)))))))))
+      
+      ((block ,x)
+       (comp x e))
+      (else
+       (error "compilation not yet implemented:" x)))))
+
+(define (comp-body e body formals %args)
+  (define (process)
+    (let lp ((in body) (out '()) (rvars (reverse formals)))
+      (pmatch in
+        (((var (,x) . ,morevars) . ,rest)
+         (lp `((var . ,morevars) . ,rest)
+             out
+             (if (memq x rvars) rvars (cons x rvars))))
+        (((var (,x ,y) . ,morevars) . ,rest)
+         (lp `((var . ,morevars) . ,rest)
+             `((= (ref ,x) ,y) . ,out)
+             (if (memq x rvars) rvars (cons x rvars))))
+        (((var) . ,rest)
+         (lp rest out rvars))
+        ((,x . ,rest) (guard (and (pair? x) (eq? (car x) 'lambda)))
+         (lp rest
+             (cons x out)
+             rvars))
+        ((,x . ,rest) (guard (pair? x))
+         (receive (sub-out rvars)
+             (lp x '() rvars)
+           (lp rest
+               (cons sub-out out)
+               rvars)))
+        ((,x . ,rest)
+         (lp rest
+             (cons x out)
+             rvars))
+        (()
+         (values (reverse! out)
+                 rvars)))))
+  (receive (out rvars)
+      (process)
+    (let* ((names (reverse rvars))
+           (syms (map (lambda (x)
+                        (gensym (string-append (symbol->string x) " ")))
+                      names))
+           (e (fold acons e names syms)))
+      (let ((%argv (lookup %args e)))
+        (let lp ((names names) (syms syms))
+          (if (null? names)
+              ;; fixme: here check for too many args
+              (comp out e)
+              (-> (let (list (car names)) (list (car syms))
+                       (list (-> (if (-> (apply (-> (primitive 'null?)) %argv))
+                                     (-> (@implv *undefined*))
+                                     (-> (let1 (-> (apply (-> (primitive 'car)) %argv))
+                                               (lambda (v)
+                                                 (-> (set! %argv
+                                                     (-> (apply (-> (primitive 'cdr)) %argv))))
+                                                 (-> (lexical v v))))))))
+                       (lp (cdr names) (cdr syms))))))))))
diff --git a/module/language/ecmascript/function.scm b/module/language/ecmascript/function.scm
new file mode 100644
index 000000000..710c5cb1c
--- /dev/null
+++ b/module/language/ecmascript/function.scm
@@ -0,0 +1,78 @@
+;;; ECMAScript for Guile
+
+;; Copyright (C) 2009 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (language ecmascript function)
+  #:use-module (oop goops)
+  #:use-module (language ecmascript base)
+  #:export (*function-prototype* *program-wrappers*))
+
+
+(define-class <js-program-wrapper> (<js-object>))
+
+(define *program-wrappers* (make-doubly-weak-hash-table 31))
+
+(define *function-prototype* (make <js-object> #:class "Function"
+                                   #:value (lambda args *undefined*)))
+
+(define-js-method *function-prototype* (toString)
+  (format #f "~A" (js-value this)))
+
+(define-js-method *function-prototype* (apply this-arg array)
+  (cond ((or (null? array) (eq? array *undefined*))
+         (call/this this-arg (js-value this)))
+        ((is-a? array <js-array-object>)
+         (call/this this-arg
+                    (lambda ()
+                      (apply (js-value this)
+                             (vector->list (js-array-vector array))))))
+        (else
+         (throw 'TypeError 'apply array))))
+
+(define-js-method *function-prototype* (call this-arg . args)
+  (call/this this-arg
+             (lambda ()
+               (apply (js-value this) args))))
+
+(define-method (pget (o <applicable>) p)
+  (let ((wrapper (hashq-ref *program-wrappers* o)))
+    (if wrapper
+        (pget wrapper p)
+        (pget *function-prototype* p))))
+
+(define-method (pput (o <applicable>) p v)
+  (let ((wrapper (hashq-ref *program-wrappers* o)))
+    (if wrapper
+        (pput wrapper p v)
+        (let ((wrapper (make <js-program-wrapper> #:value o #:class "Function"
+                             #:prototype *function-prototype*)))
+          (hashq-set! *program-wrappers* o wrapper)
+          (pput wrapper p v)))))
+
+(define-method (js-prototype (o <applicable>))
+  (let ((wrapper (hashq-ref *program-wrappers* o)))
+    (if wrapper
+        (js-prototype wrapper)
+        #f)))
+
+(define-method (js-constructor (o <applicable>))
+  (let ((wrapper (hashq-ref *program-wrappers* o)))
+    (if wrapper
+        (js-constructor wrapper)
+        #f)))
diff --git a/module/language/ecmascript/impl.scm b/module/language/ecmascript/impl.scm
new file mode 100644
index 000000000..27c077aed
--- /dev/null
+++ b/module/language/ecmascript/impl.scm
@@ -0,0 +1,169 @@
+;;; ECMAScript for Guile
+
+;; Copyright (C) 2009 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (language ecmascript impl)
+  #:use-module (oop goops)
+  #:use-module (language ecmascript base)
+  #:use-module (language ecmascript function)
+  #:use-module (language ecmascript array)
+  #:re-export (*undefined* *this* call/this*
+               pget pput pdel has-property?
+               ->boolean ->number
+               new-object new new-array)
+  #:export (js-init get-this
+            typeof
+            bitwise-not logical-not
+            shift
+            mod
+            band bxor bior
+            make-enumerator))
+
+
+(define-class <js-module-object> (<js-object>)
+  (module #:init-form (current-module) #:init-keyword #:module
+          #:getter js-module))
+(define-method (pget (o <js-module-object>) (p <string>))
+  (pget o (string->symbol p)))
+(define-method (pget (o <js-module-object>) (p <symbol>))
+  (let ((v (module-variable (js-module o) p)))
+    (if v
+        (variable-ref v)
+        (next-method))))
+(define-method (pput (o <js-module-object>) (p <string>) v)
+  (pput o (string->symbol p) v))
+(define-method (pput (o <js-module-object>) (p <symbol>) v)
+  (module-define! (js-module o) p v))
+(define-method (prop-attrs (o <js-module-object>) (p <symbol>))
+  (cond ((module-local-variable (js-module o) p) '())
+        ((module-variable (js-module o) p) '(DontDelete ReadOnly))
+        (else (next-method))))
+(define-method (prop-attrs (o <js-module-object>) (p <string>))
+  (prop-attrs o (string->symbol p)))
+(define-method (prop-keys (o <js-module-object>))
+  (append (hash-map->list (lambda (k v) k) (module-obarray (js-module o)))
+          (next-method)))
+
+;; we could make a renamer, but having obj['foo-bar'] should be enough
+(define (js-require modstr)
+  (make <js-module-object> #:module
+        (resolve-interface (map string->symbol (string-split modstr #\.)))))
+      
+(define-class <js-global-object> (<js-module-object>))
+(define-method (js-module (o <js-global-object>))
+  (current-module))
+
+(define (init-js-bindings! mod)
+  (module-define! mod 'NaN +nan.0)
+  (module-define! mod 'Infinity +inf.0)
+  (module-define! mod 'undefined *undefined*)
+  (module-define! mod 'require js-require)
+  ;; isNAN, isFinite, parseFloat, parseInt, eval
+  ;; decodeURI, decodeURIComponent, encodeURI, encodeURIComponent
+  ;; Object Function Array String Boolean Number Date RegExp Error EvalError
+  ;; RangeError ReferenceError SyntaxError TypeError URIError
+  (module-define! mod 'Object *object-prototype*)
+  (module-define! mod 'Array *array-prototype*))
+
+(define (js-init)
+  (cond ((get-this))
+        (else
+         (fluid-set! *this* (make <js-global-object>))
+         (init-js-bindings! (current-module)))))
+
+(define (get-this)
+  (fluid-ref *this*))
+
+(define (typeof x)
+  (cond ((eq? x *undefined*) "undefined")
+        ((null? x) "object")
+        ((boolean? x) "boolean")
+        ((number? x) "number")
+        ((string? x) "string")
+        ((procedure? x) "function")
+        ((is-a? x <js-object>) "object")
+        (else "scm")))
+
+(define bitwise-not lognot)
+(define (logical-not x)
+  (not (->boolean (->primitive x))))
+
+(define shift ash)
+
+(define band logand)
+(define bxor logxor)
+(define bior logior)
+
+(define mod modulo)
+
+(define-method (+ (a <string>) (b <string>))
+  (string-append a b))
+
+(define-method (+ (a <string>) b)
+  (string-append a (->string b)))
+
+(define-method (+ a (b <string>))
+  (string-append (->string a) b))
+
+(define-method (+ a b)
+  (+ (->number a) (->number b)))
+
+(define-method (- a b)
+  (- (->number a) (->number b)))
+
+(define-method (* a b)
+  (* (->number a) (->number b)))
+
+(define-method (/ a b)
+  (/ (->number a) (->number b)))
+
+(define-method (< a b)
+  (< (->number a) (->number b)))
+(define-method (< (a <string>) (b <string>))
+  (string< a b))
+
+(define-method (<= a b)
+  (<= (->number a) (->number b)))
+(define-method (<= (a <string>) (b <string>))
+  (string<= a b))
+
+(define-method (>= a b)
+  (>= (->number a) (->number b)))
+(define-method (>= (a <string>) (b <string>))
+  (string>= a b))
+
+(define-method (> a b)
+  (> (->number a) (->number b)))
+(define-method (> (a <string>) (b <string>))
+  (string> a b))
+
+(define (obj-and-prototypes o)
+  (if o
+      (cons o (obj-and-prototypes (js-prototype o)))
+      '()))
+              
+(define (make-enumerator obj)
+  (let ((props (make-hash-table 23)))
+    (for-each (lambda (o)
+                (for-each (lambda (k) (hashq-set! props k #t))
+                          (prop-keys o)))
+              (obj-and-prototypes obj))
+    (apply new-array (filter (lambda (p)
+                               (not (prop-has-attr? obj p 'DontEnum)))
+                             (hash-map->list (lambda (k v) k) props)))))
diff --git a/module/language/ecmascript/parse-lalr.scm b/module/language/ecmascript/parse-lalr.scm
new file mode 100644
index 000000000..b702511ca
--- /dev/null
+++ b/module/language/ecmascript/parse-lalr.scm
@@ -0,0 +1,1731 @@
+;; (language ecmascript parse-lalr) -- yacc's parser generator, in Guile
+;; Copyright (C) 1984,1989,1990  Free Software Foundation, Inc.
+;; Copyright (C) 1996-2002  Dominique Boucher
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+
+;; ---------------------------------------------------------------------- ;;
+#!
+;;; Commentary:
+This file contains yet another LALR(1) parser generator written in     
+Scheme. In contrast to other such parser generators, this one          
+implements a more efficient algorithm for computing the lookahead sets.
+The algorithm is the same as used in Bison (GNU yacc) and is described 
+in the following paper:                                                
+
+"Efficient Computation of LALR(1) Look-Ahead Set", F. DeRemer and   
+T. Pennello, TOPLAS, vol. 4, no. 4, october 1982.                      
+
+As a consequence, it is not written in a fully functional style.       
+In fact, much of the code is a direct translation from C to Scheme     
+of the Bison sources.                                                  
+                                                                       
+@section Defining a parser                                    
+                                                                       
+The module @code{(language ecmascript parse-lalr)} declares a macro
+called @code{lalr-parser}:
+
+@lisp
+   (lalr-parser tokens rules ...)                                      
+@end lisp
+                                                                       
+This macro, when given appropriate arguments, generates an LALR(1)     
+syntax analyzer.  The macro accepts at least two arguments. The first  
+is a list of symbols which represent the terminal symbols of the       
+grammar. The remaining arguments are the grammar production rules.
+                                                                       
+@section Running the parser
+                                                                       
+The parser generated by the @code{lalr-parser} macro is a function that 
+takes two parameters. The first parameter is a lexical analyzer while  
+the second is an error procedure.                                      
+                                                                       
+The lexical analyzer is zero-argument function (a thunk)               
+invoked each time the parser needs to look-ahead in the token stream.  
+A token is usually a pair whose @code{car} is the symbol corresponding to  
+the token (the same symbol as used in the grammar definition). The     
+@code{cdr} of the pair is the semantic value associated with the token. For
+example, a string token would have the @code{car} set to @code{'string}
+while the @code{cdr} is set to the string value @code{"hello"}.      
+                                                                       
+Once the end of file is encountered, the lexical analyzer must always  
+return the symbol @code{'*eoi*} each time it is invoked.                 
+                                                                       
+The error procedure must be a function that accepts at least two        
+parameters.                                                            
+
+@section The grammar format                                 
+                                                                       
+The grammar is specified by first giving the list of terminals and the 
+list of non-terminal definitions. Each non-terminal definition         
+is a list where the first element is the non-terminal and the other    
+elements are the right-hand sides (lists of grammar symbols). In       
+addition to this, each rhs can be followed by a semantic action.       
+                                                                       
+For example, consider the following (yacc) grammar for a very simple   
+expression language:                                                   
+@example                                                              
+  e : e '+' t                                                          
+    | e '-' t                                                          
+    | t                                                                
+    ;                                                                  
+  t : t '*' f                                                          
+    : t '/' f                                                          
+    | f                                                                
+    ;                                                                  
+  f : ID                                                               
+    ;                                                                  
+@end example                                                           
+The same grammar, written for the scheme parser generator, would look  
+like this (with semantic actions)                                      
+@lisp                                                              
+(define expr-parser                                                    
+  (lalr-parser                                                         
+   ; Terminal symbols                                                  
+   (ID + - * /)                                                        
+   ; Productions                                                       
+   (e (e + t)    -> (+ $1 $3)                                           
+      (e - t)    -> (- $1 $3)                                           
+      (t)        -> $1)                                                 
+   (t (t * f)    -> (* $1 $3)                                           
+      (t / f)    -> (/ $1 $3)                                           
+      (f)        -> $1)                                                 
+   (f (ID)       -> $1)))                                               
+@end lisp                                                           
+In semantic actions, the symbol @code{$n} refers to the synthesized        
+attribute value of the nth symbol in the production. The value         
+associated with the non-terminal on the left is the result of          
+evaluating the semantic action (it defaults to @code{#f}).    
+                                                                       
+The above grammar implicitly handles operator precedences. It is also  
+possible to explicitly assign precedences and associativity to         
+terminal symbols and productions a la Yacc. Here is a modified    
+(and augmented) version of the grammar:                                
+@lisp                                                              
+(define expr-parser                                                    
+ (lalr-parser                                                          
+  ; Terminal symbols                                                   
+  (ID                                                                  
+   (left: + -)                                                         
+   (left: * /)                                                         
+   (nonassoc: uminus))                                                 
+  (e (e + e)              -> (+ $1 $3)                                  
+     (e - e)              -> (- $1 $3)                                  
+     (e * e)              -> (* $1 $3)                                  
+     (e / e)              -> (/ $1 $3)                                  
+     (- e (prec: uminus)) -> (- $2)                                     
+     (ID)                 -> $1)))                                      
+@end lisp                                                           
+The @code{left:} directive is used to specify a set of left-associative    
+operators of the same precedence level, the @code{right:} directive for    
+right-associative operators, and @code{nonassoc:} for operators that       
+are not associative. Note the use of the (apparently) useless          
+terminal @code{uminus}. It is only defined in order to assign to the       
+penultimate rule a precedence level higher than that of @code{*} and  
+@code{/}. The @code{prec:} directive can only appear as the last element of a  
+rule. Finally, note that precedence levels are incremented from        
+left to right, i.e. the precedence level of @code{+} and @code{-} is less     
+than the precedence level of @code{*} and @code{/} since the formers appear    
+first in the list of terminal symbols (token definitions).             
+                                                                       
+@section A final note on conflict resolution
+                                                                       
+Conflicts in the grammar are handled in a conventional way.            
+In the absence of precedence directives,                               
+Shift/Reduce conflicts are resolved by shifting, and Reduce/Reduce     
+conflicts are resolved by choosing the rule listed first in the        
+grammar definition.                                                    
+                                                                       
+You can print the states of the generated parser by evaluating         
+@code{(print-states)}. The format of the output is similar to the one      
+produced by bison when given the -v command-line option.               
+;;; Code:
+!#
+
+;;; ---------- SYSTEM DEPENDENT SECTION -----------------
+;; put in a module by Richard Todd
+(define-module (language ecmascript parse-lalr)
+     #:export (lalr-parser
+               print-states))
+
+;; this code is by Thien-Thi Nguyen, found in a google search
+(begin
+  (defmacro def-macro (form . body)
+    `(defmacro ,(car form) ,(cdr form) ,@body))
+  (def-macro (BITS-PER-WORD) 28)
+  (def-macro (lalr-error msg obj) `(throw 'lalr-error ,msg ,obj))
+  (def-macro (logical-or x . y) `(logior ,x ,@y)))
+
+;;; ---------- END OF SYSTEM DEPENDENT SECTION ------------
+
+;; - Macros pour la gestion des vecteurs de bits
+
+(def-macro (set-bit v b)
+  `(let ((x (quotient ,b (BITS-PER-WORD)))
+	 (y (expt 2 (remainder ,b (BITS-PER-WORD)))))
+     (vector-set! ,v x (logical-or (vector-ref ,v x) y))))
+
+(def-macro (bit-union v1 v2 n)
+  `(do ((i 0 (+ i 1)))
+       ((= i ,n))
+     (vector-set! ,v1 i (logical-or (vector-ref ,v1 i) 
+				    (vector-ref ,v2 i)))))
+
+;; - Macro pour les structures de donnees
+
+(def-macro (new-core)              `(make-vector 4 0))
+(def-macro (set-core-number! c n)  `(vector-set! ,c 0 ,n))
+(def-macro (set-core-acc-sym! c s) `(vector-set! ,c 1 ,s))
+(def-macro (set-core-nitems! c n)  `(vector-set! ,c 2 ,n))
+(def-macro (set-core-items! c i)   `(vector-set! ,c 3 ,i))
+(def-macro (core-number c)         `(vector-ref ,c 0))
+(def-macro (core-acc-sym c)        `(vector-ref ,c 1))
+(def-macro (core-nitems c)         `(vector-ref ,c 2))
+(def-macro (core-items c)          `(vector-ref ,c 3))
+
+(def-macro (new-shift)              `(make-vector 3 0))
+(def-macro (set-shift-number! c x)  `(vector-set! ,c 0 ,x))
+(def-macro (set-shift-nshifts! c x) `(vector-set! ,c 1 ,x))
+(def-macro (set-shift-shifts! c x)  `(vector-set! ,c 2 ,x))
+(def-macro (shift-number s)         `(vector-ref ,s 0))
+(def-macro (shift-nshifts s)        `(vector-ref ,s 1))
+(def-macro (shift-shifts s)         `(vector-ref ,s 2))
+
+(def-macro (new-red)                `(make-vector 3 0))
+(def-macro (set-red-number! c x)    `(vector-set! ,c 0 ,x))
+(def-macro (set-red-nreds! c x)     `(vector-set! ,c 1 ,x))
+(def-macro (set-red-rules! c x)     `(vector-set! ,c 2 ,x))
+(def-macro (red-number c)           `(vector-ref ,c 0))
+(def-macro (red-nreds c)            `(vector-ref ,c 1))
+(def-macro (red-rules c)            `(vector-ref ,c 2))
+
+
+
+(def-macro (new-set nelem)
+  `(make-vector ,nelem 0))
+
+
+(def-macro (vector-map f v)
+  `(let ((vm-n (- (vector-length ,v) 1)))
+    (let loop ((vm-low 0) (vm-high vm-n))
+      (if (= vm-low vm-high)
+	  (vector-set! ,v vm-low (,f (vector-ref ,v vm-low) vm-low))
+	  (let ((vm-middle (quotient (+ vm-low vm-high) 2)))
+	    (loop vm-low vm-middle)
+	    (loop (+ vm-middle 1) vm-high))))))
+
+
+;; - Constantes
+(define STATE-TABLE-SIZE 1009)
+
+
+;; - Tableaux 
+(define rrhs         #f)
+(define rlhs         #f)
+(define ritem        #f)
+(define nullable     #f)
+(define derives      #f)
+(define fderives     #f)
+(define firsts       #f)
+(define kernel-base  #f)
+(define kernel-end   #f)
+(define shift-symbol #f)
+(define shift-set    #f)
+(define red-set      #f)
+(define state-table  #f)
+(define acces-symbol #f)
+(define reduction-table #f)
+(define shift-table  #f)
+(define consistent   #f)
+(define lookaheads   #f)
+(define LA           #f)
+(define LAruleno     #f)
+(define lookback     #f)
+(define goto-map     #f)
+(define from-state   #f)
+(define to-state     #f)
+(define includes     #f)
+(define F            #f)
+(define action-table #f)
+
+;; - Variables
+(define nitems          #f)
+(define nrules          #f)
+(define nvars           #f)
+(define nterms          #f)
+(define nsyms           #f)
+(define nstates         #f)
+(define first-state     #f)
+(define last-state      #f)
+(define final-state     #f)
+(define first-shift     #f)
+(define last-shift      #f)
+(define first-reduction #f)
+(define last-reduction  #f)
+(define nshifts         #f)
+(define maxrhs          #f)
+(define ngotos          #f)
+(define token-set-size  #f)
+
+(define (gen-tables! tokens gram)
+  (initialize-all)
+  (rewrite-grammar 
+   tokens
+   gram
+   (lambda (terms terms/prec vars gram gram/actions)
+     (set! the-terminals/prec (list->vector terms/prec))
+     (set! the-terminals (list->vector terms))
+     (set! the-nonterminals (list->vector vars))
+     (set! nterms (length terms))
+     (set! nvars  (length vars))
+     (set! nsyms  (+ nterms nvars))
+     (let ((no-of-rules (length gram/actions))
+	   (no-of-items (let loop ((l gram/actions) (count 0))
+			  (if (null? l) 
+			      count
+			      (loop (cdr l) (+ count (length (caar l))))))))
+       (pack-grammar no-of-rules no-of-items gram)
+       (set-derives)
+       (set-nullable)
+       (generate-states)
+       (lalr)
+       (build-tables)
+       (compact-action-table terms)
+       gram/actions))))
+
+
+(define (initialize-all)
+  (set! rrhs         #f)
+  (set! rlhs         #f)
+  (set! ritem        #f)
+  (set! nullable     #f)
+  (set! derives      #f)
+  (set! fderives     #f)
+  (set! firsts       #f)
+  (set! kernel-base  #f)
+  (set! kernel-end   #f)
+  (set! shift-symbol #f)
+  (set! shift-set    #f)
+  (set! red-set      #f)
+  (set! state-table  (make-vector STATE-TABLE-SIZE '()))
+  (set! acces-symbol #f)
+  (set! reduction-table #f)
+  (set! shift-table  #f)
+  (set! consistent   #f)
+  (set! lookaheads   #f)
+  (set! LA           #f)
+  (set! LAruleno     #f)
+  (set! lookback     #f)
+  (set! goto-map     #f)
+  (set! from-state   #f)
+  (set! to-state     #f)
+  (set! includes     #f)
+  (set! F            #f)
+  (set! action-table #f)
+  (set! nstates         #f)
+  (set! first-state     #f)
+  (set! last-state      #f)
+  (set! final-state     #f)
+  (set! first-shift     #f)
+  (set! last-shift      #f)
+  (set! first-reduction #f)
+  (set! last-reduction  #f)
+  (set! nshifts         #f)
+  (set! maxrhs          #f)
+  (set! ngotos          #f)
+  (set! token-set-size  #f)
+  (set! rule-precedences '()))
+
+
+(define (pack-grammar no-of-rules no-of-items gram)
+  (set! nrules (+  no-of-rules 1))
+  (set! nitems no-of-items)
+  (set! rlhs (make-vector nrules #f))
+  (set! rrhs (make-vector nrules #f))
+  (set! ritem (make-vector (+ 1 nitems) #f))
+
+  (let loop ((p gram) (item-no 0) (rule-no 1))
+	(if (not (null? p))
+	(let ((nt (caar p)))
+	  (let loop2 ((prods (cdar p)) (it-no2 item-no) (rl-no2 rule-no))
+		(if (null? prods)
+		(loop (cdr p) it-no2 rl-no2)
+		(begin
+		  (vector-set! rlhs rl-no2 nt)
+		  (vector-set! rrhs rl-no2 it-no2)
+		  (let loop3 ((rhs (car prods)) (it-no3 it-no2))
+			(if (null? rhs)
+			(begin
+			  (vector-set! ritem it-no3 (- rl-no2))
+			  (loop2 (cdr prods) (+ it-no3 1) (+ rl-no2 1)))
+			(begin
+			  (vector-set! ritem it-no3 (car rhs))
+			  (loop3 (cdr rhs) (+ it-no3 1))))))))))))
+
+
+;; Fonction set-derives
+;; --------------------
+(define (set-derives)
+  (define delts (make-vector (+ nrules 1) 0))
+  (define dset  (make-vector nvars -1))
+
+  (let loop ((i 1) (j 0))		; i = 0
+    (if (< i nrules)
+	(let ((lhs (vector-ref rlhs i)))
+	  (if (>= lhs 0)
+	      (begin
+		(vector-set! delts j (cons i (vector-ref dset lhs)))
+		(vector-set! dset lhs j)
+		(loop (+ i 1) (+ j 1)))
+	      (loop (+ i 1) j)))))
+  
+  (set! derives (make-vector nvars 0))
+  
+  (let loop ((i 0))
+    (if (< i nvars)
+	(let ((q (let loop2 ((j (vector-ref dset i)) (s '()))
+		   (if (< j 0)
+		       s
+		       (let ((x (vector-ref delts j)))
+			 (loop2 (cdr x) (cons (car x) s)))))))
+	  (vector-set! derives i q)
+	  (loop (+ i 1))))))
+
+
+
+(define (set-nullable)
+  (set! nullable (make-vector nvars #f))
+  (let ((squeue (make-vector nvars #f))
+	(rcount (make-vector (+ nrules 1) 0))
+	(rsets  (make-vector nvars #f))
+	(relts  (make-vector (+ nitems nvars 1) #f)))
+    (let loop ((r 0) (s2 0) (p 0))
+      (let ((*r (vector-ref ritem r)))
+	(if *r
+	    (if (< *r 0)
+		(let ((symbol (vector-ref rlhs (- *r))))
+		  (if (and (>= symbol 0)
+			   (not (vector-ref nullable symbol)))
+		      (begin
+			(vector-set! nullable symbol #t)
+			(vector-set! squeue s2 symbol)
+			(loop (+ r 1) (+ s2 1) p))))
+		(let loop2 ((r1 r) (any-tokens #f))
+		  (let* ((symbol (vector-ref ritem r1)))
+		    (if (> symbol 0)
+			(loop2 (+ r1 1) (or any-tokens (>= symbol nvars)))
+			(if (not any-tokens)
+			    (let ((ruleno (- symbol)))
+			      (let loop3 ((r2 r) (p2 p))
+				(let ((symbol (vector-ref ritem r2)))
+				  (if (> symbol 0)
+				      (begin
+					(vector-set! rcount ruleno
+						     (+ (vector-ref rcount ruleno) 1))
+					(vector-set! relts p2
+						     (cons (vector-ref rsets symbol)
+							   ruleno))
+					(vector-set! rsets symbol p2)
+					(loop3 (+ r2 1) (+ p2 1)))
+				      (loop (+ r2 1) s2 p2)))))
+			    (loop (+ r1 1) s2 p))))))
+	    (let loop ((s1 0) (s3 s2))
+	      (if (< s1 s3)
+		  (let loop2 ((p (vector-ref rsets (vector-ref squeue s1))) (s4 s3))
+		    (if p 
+			(let* ((x (vector-ref relts p))
+			       (ruleno (cdr x))
+			       (y (- (vector-ref rcount ruleno) 1)))
+			  (vector-set! rcount ruleno y)
+			  (if (= y 0)
+			      (let ((symbol (vector-ref rlhs ruleno)))
+				(if (and (>= symbol 0)
+					 (not (vector-ref nullable symbol)))
+				    (begin
+				      (vector-set! nullable symbol #t)
+				      (vector-set! squeue s4 symbol)
+				      (loop2 (car x) (+ s4 1)))
+				    (loop2 (car x) s4)))
+			      (loop2 (car x) s4))))
+		    (loop (+ s1 1) s4)))))))))
+		  
+
+
+; Fonction set-firsts qui calcule un tableau de taille
+; nvars et qui donne, pour chaque non-terminal X, une liste des
+; non-terminaux pouvant apparaitre au debut d'une derivation a
+; partir de X.
+
+(define (set-firsts)
+  (set! firsts (make-vector nvars '()))
+  
+  ;; -- initialization
+  (let loop ((i 0))
+    (if (< i nvars)
+	(let loop2 ((sp (vector-ref derives i)))
+	  (if (null? sp)
+	      (loop (+ i 1))
+	      (let ((sym (vector-ref ritem (vector-ref rrhs (car sp)))))
+		(if (< -1 sym nvars)
+		    (vector-set! firsts i (sinsert sym (vector-ref firsts i))))
+		(loop2 (cdr sp)))))))
+
+  ;; -- reflexive and transitive closure
+  (let loop ((continue #t))
+    (if continue
+	(let loop2 ((i 0) (cont #f))
+	  (if (>= i nvars)
+	      (loop cont)
+	      (let* ((x (vector-ref firsts i))
+		     (y (let loop3 ((l x) (z x))
+			  (if (null? l)
+			      z
+			      (loop3 (cdr l)
+				     (sunion (vector-ref firsts (car l)) z))))))
+		(if (equal? x y)
+		    (loop2 (+ i 1) cont)
+		    (begin
+		      (vector-set! firsts i y)
+		      (loop2 (+ i 1) #t))))))))
+  
+  (let loop ((i 0))
+    (if (< i nvars)
+	(begin
+	  (vector-set! firsts i (sinsert i (vector-ref firsts i)))
+	  (loop (+ i 1))))))
+
+
+
+
+; Fonction set-fderives qui calcule un tableau de taille
+; nvars et qui donne, pour chaque non-terminal, une liste des regles pouvant
+; etre derivees a partir de ce non-terminal. (se sert de firsts)
+
+(define (set-fderives)
+  (set! fderives (make-vector nvars #f))
+
+  (set-firsts)
+
+  (let loop ((i 0))
+    (if (< i nvars)
+	(let ((x (let loop2 ((l (vector-ref firsts i)) (fd '()))
+		   (if (null? l) 
+		       fd
+		       (loop2 (cdr l) 
+			      (sunion (vector-ref derives (car l)) fd))))))
+	  (vector-set! fderives i x)
+	  (loop (+ i 1))))))
+
+
+; Fonction calculant la fermeture d'un ensemble d'items LR0
+; ou core est une liste d'items
+
+(define (closure core)
+  ;; Initialization
+  (define ruleset (make-vector nrules #f))
+
+  (let loop ((csp core))
+    (if (not (null? csp))
+	(let ((sym (vector-ref ritem (car csp))))
+	  (if (< -1 sym nvars)
+	      (let loop2 ((dsp (vector-ref fderives sym)))
+		(if (not (null? dsp))
+		    (begin
+		      (vector-set! ruleset (car dsp) #t)
+		      (loop2 (cdr dsp))))))
+	  (loop (cdr csp)))))
+
+  (let loop ((ruleno 1) (csp core) (itemsetv '())) ; ruleno = 0
+    (if (< ruleno nrules)
+	(if (vector-ref ruleset ruleno)
+	    (let ((itemno (vector-ref rrhs ruleno)))
+	      (let loop2 ((c csp) (itemsetv2 itemsetv))
+		(if (and (pair? c)
+			 (< (car c) itemno))
+		    (loop2 (cdr c) (cons (car c) itemsetv2))
+		    (loop (+ ruleno 1) c (cons itemno itemsetv2)))))
+	    (loop (+ ruleno 1) csp itemsetv))
+	(let loop2 ((c csp) (itemsetv2 itemsetv))
+	  (if (pair? c)
+	      (loop2 (cdr c) (cons (car c) itemsetv2))
+	      (reverse itemsetv2))))))
+
+
+
+(define (allocate-item-sets)
+  (set! kernel-base (make-vector nsyms 0))
+  (set! kernel-end  (make-vector nsyms #f)))
+
+
+(define (allocate-storage)
+  (allocate-item-sets)
+  (set! red-set (make-vector (+ nrules 1) 0)))
+
+;; --
+
+
+(define (initialize-states)
+  (let ((p (new-core)))
+    (set-core-number! p 0)
+    (set-core-acc-sym! p #f)
+    (set-core-nitems! p 1)
+    (set-core-items! p '(0))
+
+    (set! first-state (list p))
+    (set! last-state first-state)
+    (set! nstates 1)))
+
+
+
+(define (generate-states)
+  (allocate-storage)
+  (set-fderives)
+  (initialize-states)
+  (let loop ((this-state first-state))
+    (if (pair? this-state)
+	(let* ((x (car this-state))
+	       (is (closure (core-items x))))
+	  (save-reductions x is)
+	  (new-itemsets is)
+	  (append-states)
+	  (if (> nshifts 0)
+	      (save-shifts x))
+	  (loop (cdr this-state))))))
+
+
+;; Fonction calculant les symboles sur lesquels il faut "shifter" 
+;; et regroupe les items en fonction de ces symboles
+
+(define (new-itemsets itemset)
+  ;; - Initialization
+  (set! shift-symbol '())
+  (let loop ((i 0))
+    (if (< i nsyms)
+	(begin
+	  (vector-set! kernel-end i '())
+	  (loop (+ i 1)))))
+
+  (let loop ((isp itemset))
+    (if (pair? isp)
+	(let* ((i (car isp))
+	       (sym (vector-ref ritem i)))
+	  (if (>= sym 0)
+	      (begin
+		(set! shift-symbol (sinsert sym shift-symbol))
+		(let ((x (vector-ref kernel-end sym)))
+		  (if (null? x)
+		      (begin
+			(vector-set! kernel-base sym (cons (+ i 1) x))
+			(vector-set! kernel-end sym (vector-ref kernel-base sym)))
+		      (begin
+			(set-cdr! x (list (+ i 1)))
+			(vector-set! kernel-end sym (cdr x)))))))
+	  (loop (cdr isp)))))
+
+  (set! nshifts (length shift-symbol)))
+
+
+
+(define (get-state sym)
+  (let* ((isp  (vector-ref kernel-base sym))
+	 (n    (length isp))
+	 (key  (let loop ((isp1 isp) (k 0))
+		 (if (null? isp1)
+		     (modulo k STATE-TABLE-SIZE)
+		     (loop (cdr isp1) (+ k (car isp1))))))
+	 (sp   (vector-ref state-table key)))
+    (if (null? sp)
+	(let ((x (new-state sym)))
+	  (vector-set! state-table key (list x))
+	  (core-number x))
+	(let loop ((sp1 sp))
+	  (if (and (= n (core-nitems (car sp1)))
+		   (let loop2 ((i1 isp) (t (core-items (car sp1)))) 
+		     (if (and (pair? i1) 
+			      (= (car i1)
+				 (car t)))
+			 (loop2 (cdr i1) (cdr t))
+			 (null? i1))))
+	      (core-number (car sp1))
+	      (if (null? (cdr sp1))
+		  (let ((x (new-state sym)))
+		    (set-cdr! sp1 (list x))
+		    (core-number x))
+		  (loop (cdr sp1))))))))
+
+
+(define (new-state sym)
+  (let* ((isp  (vector-ref kernel-base sym))
+	 (n    (length isp))
+	 (p    (new-core)))
+    (set-core-number! p nstates)
+    (set-core-acc-sym! p sym)
+    (if (= sym nvars) (set! final-state nstates))
+    (set-core-nitems! p n)
+    (set-core-items! p isp)
+    (set-cdr! last-state (list p))
+    (set! last-state (cdr last-state))
+    (set! nstates (+ nstates 1))
+    p))
+
+
+;; --
+
+(define (append-states)
+  (set! shift-set
+	(let loop ((l (reverse shift-symbol)))
+	  (if (null? l)
+	      '()
+	      (cons (get-state (car l)) (loop (cdr l)))))))
+
+;; --
+
+(define (save-shifts core)
+  (let ((p (new-shift)))
+	(set-shift-number! p (core-number core))
+	(set-shift-nshifts! p nshifts)
+	(set-shift-shifts! p shift-set)
+	(if last-shift
+	(begin
+	  (set-cdr! last-shift (list p))
+	  (set! last-shift (cdr last-shift)))
+	(begin
+	  (set! first-shift (list p))
+	  (set! last-shift first-shift)))))
+
+(define (save-reductions core itemset)
+  (let ((rs (let loop ((l itemset))
+	      (if (null? l)
+		  '()
+		  (let ((item (vector-ref ritem (car l))))
+		    (if (< item 0)
+			(cons (- item) (loop (cdr l)))
+			(loop (cdr l))))))))
+    (if (pair? rs)
+	(let ((p (new-red)))
+	  (set-red-number! p (core-number core))
+	  (set-red-nreds!  p (length rs))
+	  (set-red-rules!  p rs)
+	  (if last-reduction
+	      (begin
+		(set-cdr! last-reduction (list p))
+		(set! last-reduction (cdr last-reduction)))
+	      (begin
+		(set! first-reduction (list p))
+		(set! last-reduction first-reduction)))))))
+
+
+;; --
+
+(define (lalr)
+  (set! token-set-size (+ 1 (quotient nterms (BITS-PER-WORD))))
+  (set-accessing-symbol)
+  (set-shift-table)
+  (set-reduction-table)
+  (set-max-rhs)
+  (initialize-LA)
+  (set-goto-map)
+  (initialize-F)
+  (build-relations)
+  (digraph includes)
+  (compute-lookaheads))
+
+(define (set-accessing-symbol)
+  (set! acces-symbol (make-vector nstates #f))
+  (let loop ((l first-state))
+    (if (pair? l)
+	(let ((x (car l)))
+	  (vector-set! acces-symbol (core-number x) (core-acc-sym x))
+	  (loop (cdr l))))))
+
+(define (set-shift-table)
+  (set! shift-table (make-vector nstates #f))
+  (let loop ((l first-shift))
+    (if (pair? l)
+	(let ((x (car l)))
+	  (vector-set! shift-table (shift-number x) x)
+	  (loop (cdr l))))))
+
+(define (set-reduction-table)
+  (set! reduction-table (make-vector nstates #f))
+  (let loop ((l first-reduction))
+    (if (pair? l)
+	(let ((x (car l)))
+	  (vector-set! reduction-table (red-number x) x)
+	  (loop (cdr l))))))
+
+(define (set-max-rhs)
+  (let loop ((p 0) (curmax 0) (length 0))
+    (let ((x (vector-ref ritem p)))
+      (if x
+	  (if (>= x 0)
+	      (loop (+ p 1) curmax (+ length 1))
+	      (loop (+ p 1) (max curmax length) 0))
+	  (set! maxrhs curmax)))))
+
+(define (initialize-LA)
+  (define (last l)
+    (if (null? (cdr l))
+	(car l)
+	(last (cdr l))))
+
+  (set! consistent (make-vector nstates #f))
+  (set! lookaheads (make-vector (+ nstates 1) #f))
+
+  (let loop ((count 0) (i 0))
+    (if (< i nstates)
+	(begin
+	  (vector-set! lookaheads i count)
+	  (let ((rp (vector-ref reduction-table i))
+		(sp (vector-ref shift-table i)))
+	    (if (and rp
+		     (or (> (red-nreds rp) 1)
+			 (and sp
+			      (not
+			       (< (vector-ref acces-symbol
+					      (last (shift-shifts sp)))
+				  nvars)))))
+		(loop (+ count (red-nreds rp)) (+ i 1))
+		(begin
+		  (vector-set! consistent i #t)
+		  (loop count (+ i 1))))))
+
+	(begin
+	  (vector-set! lookaheads nstates count)
+	  (let ((c (max count 1)))
+	    (set! LA (make-vector c #f))
+	    (do ((j 0 (+ j 1))) ((= j c)) (vector-set! LA j (new-set token-set-size)))
+	    (set! LAruleno (make-vector c -1))
+	    (set! lookback (make-vector c #f)))
+	  (let loop ((i 0) (np 0))
+	    (if (< i nstates)
+		(if (vector-ref consistent i)
+		    (loop (+ i 1) np)
+		    (let ((rp (vector-ref reduction-table i)))
+		      (if rp
+			  (let loop2 ((j (red-rules rp)) (np2 np))
+			    (if (null? j)
+				(loop (+ i 1) np2)
+				(begin
+				  (vector-set! LAruleno np2 (car j))
+				  (loop2 (cdr j) (+ np2 1)))))
+			  (loop (+ i 1) np))))))))))
+
+
+(define (set-goto-map)
+  (set! goto-map (make-vector (+ nvars 1) 0))
+  (let ((temp-map (make-vector (+ nvars 1) 0)))
+    (let loop ((ng 0) (sp first-shift))
+      (if (pair? sp)
+	  (let loop2 ((i (reverse (shift-shifts (car sp)))) (ng2 ng))
+	    (if (pair? i)
+		(let ((symbol (vector-ref acces-symbol (car i))))
+		  (if (< symbol nvars)
+		      (begin
+			(vector-set! goto-map symbol 
+				     (+ 1 (vector-ref goto-map symbol)))
+			(loop2 (cdr i) (+ ng2 1)))
+		      (loop2 (cdr i) ng2)))
+		(loop ng2 (cdr sp))))
+
+	  (let loop ((k 0) (i 0))
+	    (if (< i nvars)
+		(begin
+		  (vector-set! temp-map i k)
+		  (loop (+ k (vector-ref goto-map i)) (+ i 1)))
+
+		(begin
+		  (do ((i 0 (+ i 1)))
+		      ((>= i nvars))
+		    (vector-set! goto-map i (vector-ref temp-map i)))
+
+		  (set! ngotos ng)
+		  (vector-set! goto-map nvars ngotos)
+		  (vector-set! temp-map nvars ngotos)
+		  (set! from-state (make-vector ngotos #f))
+		  (set! to-state (make-vector ngotos #f))
+		  
+		  (do ((sp first-shift (cdr sp)))
+		      ((null? sp))
+		    (let* ((x (car sp))
+			   (state1 (shift-number x)))
+		      (do ((i (shift-shifts x) (cdr i)))
+			  ((null? i))
+			(let* ((state2 (car i))
+			       (symbol (vector-ref acces-symbol state2)))
+			  (if (< symbol nvars)
+			      (let ((k (vector-ref temp-map symbol)))
+				(vector-set! temp-map symbol (+ k 1))
+				(vector-set! from-state k state1)
+				(vector-set! to-state k state2))))))))))))))
+
+
+(define (map-goto state symbol)
+  (let loop ((low (vector-ref goto-map symbol))
+	     (high (- (vector-ref goto-map (+ symbol 1)) 1)))
+    (if (> low high)
+	(begin
+	  (display (list "Error in map-goto" state symbol) (current-error-port))
+          (newline (current-error-port))
+	  0)
+	(let* ((middle (quotient (+ low high) 2))
+	       (s (vector-ref from-state middle)))
+	  (cond
+	   ((= s state)
+	    middle)
+	   ((< s state)
+	    (loop (+ middle 1) high))
+	   (else
+	    (loop low (- middle 1))))))))
+
+
+(define (initialize-F)
+  (set! F (make-vector ngotos #f))
+  (do ((i 0 (+ i 1))) ((= i ngotos)) (vector-set! F i (new-set token-set-size)))
+
+  (let ((reads (make-vector ngotos #f)))
+
+    (let loop ((i 0) (rowp 0))
+      (if (< i ngotos)
+	  (let* ((rowf (vector-ref F rowp))
+		 (stateno (vector-ref to-state i))
+		 (sp (vector-ref shift-table stateno)))
+	    (if sp
+		(let loop2 ((j (shift-shifts sp)) (edges '()))
+		  (if (pair? j)
+		      (let ((symbol (vector-ref acces-symbol (car j))))
+			(if (< symbol nvars)
+			    (if (vector-ref nullable symbol)
+				(loop2 (cdr j) (cons (map-goto stateno symbol) 
+						     edges))
+				(loop2 (cdr j) edges))
+			    (begin
+			      (set-bit rowf (- symbol nvars))
+			      (loop2 (cdr j) edges))))
+		      (if (pair? edges)
+			  (vector-set! reads i (reverse edges))))))
+	      (loop (+ i 1) (+ rowp 1)))))
+    (digraph reads)))
+
+(define (add-lookback-edge stateno ruleno gotono)
+  (let ((k (vector-ref lookaheads (+ stateno 1))))
+    (let loop ((found #f) (i (vector-ref lookaheads stateno)))
+      (if (and (not found) (< i k))
+	  (if (= (vector-ref LAruleno i) ruleno)
+	      (loop #t i)
+	      (loop found (+ i 1)))
+
+	  (if (not found)
+	      (begin (display "Error in add-lookback-edge : " (current-error-port))
+		     (display (list stateno ruleno gotono) (current-error-port))
+                     (newline (current-error-port)))
+	      (vector-set! lookback i
+			   (cons gotono (vector-ref lookback i))))))))
+
+
+(define (transpose r-arg n)
+  (let ((new-end (make-vector n #f))
+	(new-R  (make-vector n #f)))
+    (do ((i 0 (+ i 1))) 
+	((= i n))
+      (let ((x (list 'bidon)))
+	(vector-set! new-R i x)
+	(vector-set! new-end i x)))
+    (do ((i 0 (+ i 1)))
+	((= i n))
+      (let ((sp (vector-ref r-arg i)))
+	(if (pair? sp)
+	    (let loop ((sp2 sp))
+	      (if (pair? sp2)
+		  (let* ((x (car sp2))
+			 (y (vector-ref new-end x)))
+		    (set-cdr! y (cons i (cdr y)))
+		    (vector-set! new-end x (cdr y))
+		    (loop (cdr sp2))))))))
+    (do ((i 0 (+ i 1)))
+	((= i n))
+      (vector-set! new-R i (cdr (vector-ref new-R i))))
+    
+    new-R))
+
+
+
+(define (build-relations)
+
+  (define (get-state stateno symbol)
+    (let loop ((j (shift-shifts (vector-ref shift-table stateno)))
+	       (stno stateno))
+      (if (null? j)
+	  stno
+	  (let ((st2 (car j)))
+	    (if (= (vector-ref acces-symbol st2) symbol)
+		st2
+		(loop (cdr j) st2))))))
+
+  (set! includes (make-vector ngotos #f))
+  (do ((i 0 (+ i 1)))
+      ((= i ngotos))
+    (let ((state1 (vector-ref from-state i))
+	  (symbol1 (vector-ref acces-symbol (vector-ref to-state i))))
+      (let loop ((rulep (vector-ref derives symbol1))
+		 (edges '()))
+	(if (pair? rulep)
+	    (let ((*rulep (car rulep)))
+	      (let loop2 ((rp (vector-ref rrhs *rulep))
+			  (stateno state1)
+			  (states (list state1)))
+		(let ((*rp (vector-ref ritem rp)))
+		  (if (> *rp 0)
+		      (let ((st (get-state stateno *rp)))
+			(loop2 (+ rp 1) st (cons st states)))
+		      (begin
+
+			(if (not (vector-ref consistent stateno))
+			    (add-lookback-edge stateno *rulep i))
+			
+			(let loop2 ((done #f) 
+				    (stp (cdr states))
+				    (rp2 (- rp 1))
+				    (edgp edges))
+			  (if (not done)
+			      (let ((*rp (vector-ref ritem rp2)))
+				(if (< -1 *rp nvars)
+				  (loop2 (not (vector-ref nullable *rp))
+					 (cdr stp)
+					 (- rp2 1)
+					 (cons (map-goto (car stp) *rp) edgp))
+				  (loop2 #t stp rp2 edgp)))
+
+			      (loop (cdr rulep) edgp))))))))
+	    (vector-set! includes i edges)))))
+  (set! includes (transpose includes ngotos)))
+			
+
+
+(define (compute-lookaheads)
+  (let ((n (vector-ref lookaheads nstates)))
+    (let loop ((i 0))
+      (if (< i n)
+	  (let loop2 ((sp (vector-ref lookback i)))
+	    (if (pair? sp)
+		(let ((LA-i (vector-ref LA i))
+		      (F-j  (vector-ref F (car sp))))
+		  (bit-union LA-i F-j token-set-size)
+		  (loop2 (cdr sp)))
+		(loop (+ i 1))))))))
+
+
+
+(define (digraph relation)
+  (define infinity (+ ngotos 2))
+  (define INDEX (make-vector (+ ngotos 1) 0))
+  (define VERTICES (make-vector (+ ngotos 1) 0))
+  (define top 0)
+  (define R relation)
+
+  (define (traverse i)
+    (set! top (+ 1 top))
+    (vector-set! VERTICES top i)
+    (let ((height top))
+      (vector-set! INDEX i height)
+      (let ((rp (vector-ref R i)))
+	(if (pair? rp)
+	    (let loop ((rp2 rp))
+	      (if (pair? rp2)
+		  (let ((j (car rp2)))
+		    (if (= 0 (vector-ref INDEX j))
+			(traverse j))
+		    (if (> (vector-ref INDEX i) 
+			   (vector-ref INDEX j))
+			(vector-set! INDEX i (vector-ref INDEX j)))
+		    (let ((F-i (vector-ref F i))
+			  (F-j (vector-ref F j)))
+		      (bit-union F-i F-j token-set-size))
+		    (loop (cdr rp2))))))
+	(if (= (vector-ref INDEX i) height)
+	    (let loop ()
+	      (let ((j (vector-ref VERTICES top)))
+		(set! top (- top 1))
+		(vector-set! INDEX j infinity)
+		(if (not (= i j))
+		    (begin
+		      (bit-union (vector-ref F i) 
+				 (vector-ref F j)
+				 token-set-size)
+		      (loop)))))))))
+
+  (let loop ((i 0))
+    (if (< i ngotos)
+	(begin
+	  (if (and (= 0 (vector-ref INDEX i))
+		   (pair? (vector-ref R i)))
+	      (traverse i))
+	  (loop (+ i 1))))))
+
+
+;; ---------------------------------------------------------------------- ;;
+;; operator precedence management                                         ;;
+;; ---------------------------------------------------------------------- ;;
+
+; a vector of precedence descriptors where each element
+; is of the form (terminal type precedence)
+(define the-terminals/prec #f)		; terminal symbols with precedence 
+; the precedence is an integer >= 0
+(define (get-symbol-precedence sym)
+  (caddr (vector-ref the-terminals/prec sym)))
+; the operator type is either 'none, 'left, 'right, or 'nonassoc
+(define (get-symbol-assoc sym)
+  (cadr (vector-ref the-terminals/prec sym)))
+
+(define rule-precedences '())
+(define (add-rule-precedence! rule sym)
+  (set! rule-precedences
+	(cons (cons rule sym) rule-precedences)))
+
+(define (get-rule-precedence ruleno)
+  (cond
+   ((assq ruleno rule-precedences) 
+    => (lambda (p) 
+	 (get-symbol-precedence (cdr p))))
+   (else
+    ;; process the rule symbols from left to right
+    (let loop ((i    (vector-ref rrhs ruleno))
+	       (prec 0))
+      (let ((item (vector-ref ritem i)))
+	;; end of rule
+	(if (< item 0)
+	    prec
+	    (let ((i1 (+ i 1)))
+	      (if (>= item nvars)
+		  ;; it's a terminal symbol
+		  (loop i1 (get-symbol-precedence (- item nvars)))
+		  (loop i1 prec)))))))))
+
+;; ---------------------------------------------------------------------- ;;
+;; Build the various tables                                               ;;
+;; ---------------------------------------------------------------------- ;;
+(define (build-tables)
+  
+  (define (resolve-conflict sym rule)
+    (let ((sym-prec   (get-symbol-precedence sym))
+	  (sym-assoc  (get-symbol-assoc sym))
+	  (rule-prec  (get-rule-precedence rule)))
+      (cond
+       ((> sym-prec rule-prec)     'shift)
+       ((< sym-prec rule-prec)     'reduce)
+       ((eq? sym-assoc 'left)      'reduce)
+       ((eq? sym-assoc 'right)     'shift)
+       (else                       'shift))))
+	
+  ;; --- Add an action to the action table ------------------------------ ;;
+  (define (add-action St Sym Act)
+    (let* ((x (vector-ref action-table St))
+	   (y (assv Sym x)))
+      (if y
+	  (if (not (= Act (cdr y)))
+	      ;; -- there is a conflict 
+	      (begin
+		(if (and (<= (cdr y) 0)
+			 (<= Act 0))
+		    ;; --- reduce/reduce conflict ----------------------- ;;
+		    (begin
+		      (display "%% Reduce/Reduce conflict " (current-error-port))
+		      (display "(reduce "  (current-error-port))
+                      (display (- Act) (current-error-port))
+		      (display ", reduce " (current-error-port))
+                      (display (- (cdr y)) (current-error-port))
+		      (display ") on " (current-error-port))
+                      (print-symbol (+ Sym nvars) (current-error-port))
+		      (display " in state "  (current-error-port))
+                      (display St (current-error-port))
+		      (newline (current-error-port))
+		      (set-cdr! y (max (cdr y) Act)))
+		    ;; --- shift/reduce conflict ------------------------ ;;
+		    ;; can we resolve the conflict using precedences?
+		    (case (resolve-conflict Sym (- (cdr y)))
+		      ;; -- shift
+		      ((shift)
+		       (set-cdr! y Act))
+		      ;; -- reduce
+		      ((reduce)
+		       #f)		; well, nothing to do...
+		      ;; -- signal a conflict!
+		      (else
+		       (display "%% Shift/Reduce conflict " (current-error-port))
+		       (display "(shift " (current-error-port))
+                       (display Act (current-error-port))
+		       (display ", reduce " (current-error-port))
+                       (display (- (cdr y)) (current-error-port))
+		       (display ") on " (current-error-port))
+                       (print-symbol (+ Sym nvars) (current-error-port))
+		       (display " in state " (current-error-port))
+                       (display St (current-error-port))
+		       (newline (current-error-port))
+		       (set-cdr! y Act))))))
+	  
+	  (vector-set! action-table St (cons (cons Sym Act) x)))))
+	
+  (set! action-table (make-vector nstates '()))
+
+  (do ((i 0 (+ i 1)))  ; i = state
+      ((= i nstates))
+    (let ((red (vector-ref reduction-table i)))
+      (if (and red (>= (red-nreds red) 1))
+	  (if (and (= (red-nreds red) 1) (vector-ref consistent i))
+	      (add-action i 'default (- (car (red-rules red))))
+	      (let ((k (vector-ref lookaheads (+ i 1))))
+		(let loop ((j (vector-ref lookaheads i)))
+		  (if (< j k)
+		      (let ((rule (- (vector-ref LAruleno j)))
+			    (lav  (vector-ref LA j)))
+			(let loop2 ((token 0) (x (vector-ref lav 0)) (y 1) (z 0))
+			  (if (< token nterms)
+			      (begin
+				(let ((in-la-set? (modulo x 2)))
+				  (if (= in-la-set? 1)
+				      (add-action i token rule)))
+				(if (= y (BITS-PER-WORD))
+				    (loop2 (+ token 1) 
+					   (vector-ref lav (+ z 1))
+					   1
+					   (+ z 1))
+				    (loop2 (+ token 1) (quotient x 2) (+ y 1) z)))))
+			(loop (+ j 1)))))))))
+
+    (let ((shiftp (vector-ref shift-table i)))
+      (if shiftp
+	  (let loop ((k (shift-shifts shiftp)))
+	    (if (pair? k)
+		(let* ((state (car k))
+		       (symbol (vector-ref acces-symbol state)))
+		  (if (>= symbol nvars)
+		      (add-action i (- symbol nvars) state))
+		  (loop (cdr k))))))))
+
+  (add-action final-state 0 'accept))
+
+(define (compact-action-table terms)
+  (define (most-common-action acts)
+    (let ((accums '()))
+      (let loop ((l acts))
+	(if (pair? l)
+	    (let* ((x (cdar l))
+		   (y (assv x accums)))
+	      (if (and (number? x) (< x 0))
+		  (if y
+		      (set-cdr! y (+ 1 (cdr y)))
+		      (set! accums (cons `(,x . 1) accums))))
+	      (loop (cdr l)))))
+
+      (let loop ((l accums) (max 0) (sym #f))
+	(if (null? l)
+	    sym
+	    (let ((x (car l)))
+	      (if (> (cdr x) max)
+		  (loop (cdr l) (cdr x) (car x))
+		  (loop (cdr l) max sym)))))))
+  
+  (define (translate-terms acts)
+    (map (lambda (act) 
+	   (cons (list-ref terms (car act))
+		 (cdr act)))
+	 acts))
+
+  (do ((i 0 (+ i 1)))
+      ((= i nstates))
+    (let ((acts (vector-ref action-table i)))
+      (if (vector? (vector-ref reduction-table i))
+	  (let ((act (most-common-action acts)))
+	    (vector-set! action-table i
+			 (cons `(*default* . ,(if act act 'error))
+			       (translate-terms
+				(lalr-filter (lambda (x) 
+					  (not (eq? (cdr x) act)))
+					acts)))))
+	  (vector-set! action-table i 
+		       (cons `(*default* . *error*) 
+			     (translate-terms acts)))))))
+
+
+
+;; --
+
+(define (rewrite-grammar tokens grammar k) 
+
+  (define eoi '*eoi*)
+  
+  (define (check-terminal term terms)
+    (cond 
+     ((not (valid-terminal? term))
+      (lalr-error "invalid terminal: " term))
+     ((member term terms)
+      (lalr-error "duplicate definition of terminal: " term))))
+  
+  (define (prec->type prec)
+    (cdr (assq prec '((left:     . left) 
+		      (right:    . right)
+		      (nonassoc: . nonassoc)))))
+
+  (cond
+   ;; --- a few error conditions ---------------------------------------- ;;
+   ((not (list? tokens))
+    (lalr-error "Invalid token list: " tokens))
+   ((not (pair? grammar))
+    (lalr-error "Grammar definition must have a non-empty list of productions" '()))
+   
+   (else
+    ;; --- check the terminals ---------------------------------------- ;;
+    (let loop1 ((lst            tokens)
+		(rev-terms      '())
+		(rev-terms/prec '())
+		(prec-level     0))
+      (if (pair? lst)
+	  (let ((term (car lst)))
+	    (cond
+	     ((pair? term)
+	      (if (and (memq (car term) '(left: right: nonassoc:))
+		       (not (null? (cdr term))))
+		  (let ((prec    (+ prec-level 1))
+			(optype  (prec->type (car term))))
+		    (let loop-toks ((l             (cdr term))
+				    (rev-terms      rev-terms)
+				    (rev-terms/prec rev-terms/prec))
+		      (if (null? l)
+			  (loop1 (cdr lst) rev-terms rev-terms/prec prec)
+			  (let ((term (car l)))
+			    (check-terminal term rev-terms)
+			    (loop-toks 
+			     (cdr l)
+			     (cons term rev-terms)
+			     (cons (list term optype prec) rev-terms/prec))))))
+		  
+		  (lalr-error "invalid operator precedence specification: " term)))
+	      
+	     (else
+	      (check-terminal term rev-terms)
+	      (loop1 (cdr lst) 
+		     (cons term rev-terms)
+		     (cons (list term 'none 0) rev-terms/prec)
+		     prec-level))))
+	  
+	  ;; --- check the grammar rules ------------------------------ ;;
+	  (let loop2 ((lst grammar) (rev-nonterm-defs '()))
+	    (if (pair? lst)
+		(let ((def (car lst)))
+		  (if (not (pair? def))
+		      (lalr-error "Nonterminal definition must be a non-empty list" '())
+		      (let ((nonterm (car def)))
+			(cond ((not (valid-nonterminal? nonterm))
+			       (lalr-error "Invalid nonterminal:" nonterm))
+			      ((or (member nonterm rev-terms)
+				   (assoc nonterm rev-nonterm-defs))
+			       (lalr-error "Nonterminal previously defined:" nonterm))
+			      (else
+			       (loop2 (cdr lst)
+				      (cons def rev-nonterm-defs)))))))
+		(let* ((terms        (cons eoi (reverse rev-terms)))
+		       (terms/prec   (cons '(eoi none 0) (reverse rev-terms/prec)))
+		       (nonterm-defs (reverse rev-nonterm-defs))
+		       (nonterms     (cons '*start* (map car nonterm-defs))))
+		  (if (= (length nonterms) 1)
+		      (lalr-error "Grammar must contain at least one nonterminal" '())
+		      (let loop-defs ((defs      (cons `(*start* (,(cadr nonterms) ,eoi) -> $1)
+						       nonterm-defs))
+				      (ruleno    0)
+				      (comp-defs '()))
+			(if (pair? defs)
+			    (let* ((nonterm-def  (car defs))
+				   (compiled-def (rewrite-nonterm-def 
+						  nonterm-def 
+						  ruleno
+						  terms nonterms)))
+			      (loop-defs (cdr defs)
+					 (+ ruleno (length compiled-def))
+					 (cons compiled-def comp-defs)))
+
+			    (let ((compiled-nonterm-defs (reverse comp-defs)))
+			      (k terms
+				 terms/prec
+				 nonterms
+				 (map (lambda (x) (cons (caaar x) (map cdar x)))
+				      compiled-nonterm-defs)
+				 (apply append compiled-nonterm-defs))))))))))))))
+
+
+(define *arrow* '->)
+
+(define (rewrite-nonterm-def nonterm-def ruleno terms nonterms)
+
+  (define No-NT (length nonterms))
+
+  (define (encode x) 
+    (let ((PosInNT (pos-in-list x nonterms)))
+      (if PosInNT
+	  PosInNT
+	  (let ((PosInT (pos-in-list x terms)))
+	    (if PosInT
+		(+ No-NT PosInT)
+		(lalr-error "undefined symbol : " x))))))
+  
+  (define (process-prec-directive rhs ruleno)
+    (let loop ((l rhs))
+      (if (null? l) 
+	  '()
+	  (let ((first (car l))
+		(rest  (cdr l)))
+	    (cond
+	     ((or (member first terms) (member first nonterms))
+	      (cons first (loop rest)))
+	     ((and (pair? first)
+		   (eq? (car first) 'prec:))
+		   (pair? (cdr first))
+	      (if (and (pair? (cdr first))
+		       (member (cadr first) terms))
+		  (if (null? (cddr first))
+		      (begin
+			(add-rule-precedence! ruleno (pos-in-list (cadr first) terms))
+			(loop rest))
+		      (lalr-error "prec: directive should be at end of rule: " rhs))
+		  (lalr-error "Invalid prec: directive: " first)))
+	     (else
+	      (lalr-error "Invalid terminal or nonterminal: " first)))))))
+	
+
+  (if (not (pair? (cdr nonterm-def)))
+      (lalr-error "At least one production needed for nonterminal" (car nonterm-def))
+      (let ((name (symbol->string (car nonterm-def))))
+	(let loop1 ((lst (cdr nonterm-def))
+		    (i 1)
+		    (rev-productions-and-actions '()))
+	  (if (not (pair? lst))
+	      (reverse rev-productions-and-actions)
+	      (let* ((rhs  (process-prec-directive (car lst) (+ ruleno i -1)))
+		     (rest (cdr lst))
+		     (prod (map encode (cons (car nonterm-def) rhs))))
+		(for-each (lambda (x)
+			    (if (not (or (member x terms) (member x nonterms)))
+				(lalr-error "Invalid terminal or nonterminal" x)))
+			  rhs)
+		(if (and (pair? rest)
+			 (eq? (car rest) *arrow*)
+			 (pair? (cdr rest)))
+		    (loop1 (cddr rest)
+			   (+ i 1)
+			   (cons (cons prod (cadr rest)) 
+				 rev-productions-and-actions))
+		    (let* ((rhs-length (length rhs))
+			   (action
+			    (cons 'vector
+				 (cons (list 'quote (string->symbol
+						     (string-append
+						      name
+						      "-"
+						      (number->string i))))
+				       (let loop-j ((j 1))
+					 (if (> j rhs-length)
+					     '()
+					     (cons (string->symbol
+						    (string-append
+						     "$"
+						     (number->string j)))
+						   (loop-j (+ j 1)))))))))
+		      (loop1 rest
+			     (+ i 1)
+			     (cons (cons prod action) 
+				   rev-productions-and-actions))))))))))
+
+(define (valid-nonterminal? x)
+  (symbol? x))
+
+(define (valid-terminal? x)
+  (symbol? x))              ; DB 
+
+;; ---------------------------------------------------------------------- ;;
+;; Miscellaneous                                                          ;;
+;; ---------------------------------------------------------------------- ;;
+(define (pos-in-list x lst)
+  (let loop ((lst lst) (i 0))
+    (cond ((not (pair? lst))    #f)
+	  ((equal? (car lst) x) i)
+	  (else                 (loop (cdr lst) (+ i 1))))))
+
+(define (sunion lst1 lst2)		; union of sorted lists
+  (let loop ((L1 lst1)
+	     (L2 lst2))
+    (cond ((null? L1)    L2)
+	  ((null? L2)    L1)
+	  (else 
+	   (let ((x (car L1)) (y (car L2)))
+	     (cond
+	      ((> x y)
+	       (cons y (loop L1 (cdr L2))))
+	      ((< x y)
+	       (cons x (loop (cdr L1) L2)))
+	      (else
+	       (loop (cdr L1) L2))
+	      ))))))
+
+(define (sinsert elem lst)
+  (let loop ((l1 lst))
+    (if (null? l1) 
+	(cons elem l1)
+	(let ((x (car l1)))
+	  (cond ((< elem x)
+		 (cons elem l1))
+		((> elem x)
+		 (cons x (loop (cdr l1))))
+		(else 
+		 l1))))))
+
+(define (lalr-filter p lst)
+  (let loop ((l lst))
+    (if (null? l)
+	'()
+	(let ((x (car l)) (y (cdr l)))
+	(if (p x)
+	    (cons x (loop y))
+	    (loop y))))))
+
+;; ---------------------------------------------------------------------- ;;
+;; Debugging tools ...                                                    ;;
+;; ---------------------------------------------------------------------- ;;
+(define the-terminals #f)		; names of terminal symbols
+(define the-nonterminals #f)		; non-terminals
+
+(define (print-item item-no)
+  (let loop ((i item-no))
+    (let ((v (vector-ref ritem i)))
+      (if (>= v 0)
+	  (loop (+ i 1))
+	  (let* ((rlno    (- v))
+		 (nt      (vector-ref rlhs rlno)))
+	    (display (vector-ref the-nonterminals nt)) (display " --> ")
+	    (let loop ((i (vector-ref rrhs rlno)))
+	      (let ((v (vector-ref ritem i)))
+		(if (= i item-no)
+		    (display ". "))
+		(if (>= v 0)
+		    (begin
+		      (print-symbol v)
+		      (display " ")
+		      (loop (+ i 1)))
+		    (begin 
+		      (display "   (rule ")
+		      (display (- v))
+		      (display ")")
+		      (newline))))))))))
+  
+(define (print-symbol n . port)
+  (display (if (>= n nvars)
+	       (vector-ref the-terminals (- n nvars))
+	       (vector-ref the-nonterminals n))
+           (if (null? port)
+               (current-output-port)
+               (car port))))
+  
+(define (print-states)
+"Print the states of a generated parser."
+  (define (print-action act)
+    (cond
+     ((eq? act '*error*)
+      (display " : Error"))
+     ((eq? act 'accept)
+      (display " : Accept input"))
+     ((< act 0)
+      (display " : reduce using rule ")
+      (display (- act)))
+     (else
+      (display " : shift and goto state ")
+      (display act)))
+    (newline)
+    #t)
+  
+  (define (print-actions acts)
+    (let loop ((l acts))
+      (if (null? l)
+	  #t
+	  (let ((sym (caar l))
+		(act (cdar l)))
+	    (display "   ")
+	    (cond
+	     ((eq? sym 'default)
+	      (display "default action"))
+	     (else
+	      (if (number? sym)
+		  (print-symbol (+ sym nvars))
+		  (display sym))))
+	    (print-action act)
+	    (loop (cdr l))))))
+  
+  (if (not action-table)
+      (begin
+	(display "No generated parser available!")
+	(newline)
+	#f)
+      (begin
+	(display "State table") (newline)
+	(display "-----------") (newline) (newline)
+  
+	(let loop ((l first-state))
+	  (if (null? l)
+	      #t
+	      (let* ((core  (car l))
+		     (i     (core-number core))
+		     (items (core-items core))
+		     (actions (vector-ref action-table i)))
+		(display "state ") (display i) (newline)
+		(newline)
+		(for-each (lambda (x) (display "   ") (print-item x))
+			  items)
+		(newline)
+		(print-actions actions)
+		(newline)
+		(loop (cdr l))))))))
+
+
+	  
+;; ---------------------------------------------------------------------- ;;
+
+(define build-goto-table
+  (lambda ()
+    `(vector
+      ,@(map
+	 (lambda (shifts)
+	   (list 'quote
+		 (if shifts
+		     (let loop ((l (shift-shifts shifts)))
+		       (if (null? l)
+			   '()
+			   (let* ((state  (car l))
+				  (symbol (vector-ref acces-symbol state)))
+			     (if (< symbol nvars)
+				 (cons `(,symbol . ,state)
+				       (loop (cdr l)))
+				 (loop (cdr l))))))
+		     '())))
+	 (vector->list shift-table)))))
+
+
+(define build-reduction-table
+  (lambda (gram/actions)
+    `(vector
+      '()
+      ,@(map
+	 (lambda (p)
+	   (let ((act (cdr p)))
+	     `(lambda (___stack ___sp ___goto-table ___k)
+		,(let* ((nt (caar p)) (rhs (cdar p)) (n (length rhs)))
+		   `(let* (,@(if act
+				 (let loop ((i 1) (l rhs))
+				   (if (pair? l)
+				       (let ((rest (cdr l)))
+					 (cons 
+					  `(,(string->symbol
+					      (string-append
+					       "$"
+					       (number->string 
+						(+ (- n i) 1))))
+					    (vector-ref ___stack (- ___sp ,(- (* i 2) 1))))
+					  (loop (+ i 1) rest)))
+				       '()))
+				 '()))
+		      ,(if (= nt 0)
+			   '$1
+			   `(___push ___stack (- ___sp ,(* 2 n)) 
+				  ,nt ___goto-table ,(cdr p) ___k)))))))
+
+	 gram/actions))))
+	 
+
+;; @section (api "API")                                                   
+
+(define-macro (lalr-parser tokens . rules)
+  (let* ((gram/actions (gen-tables! tokens rules))
+	 (code
+	  `(letrec ((___max-stack-size 500)
+
+		    (___atable         ',action-table)
+		    (___gtable         ,(build-goto-table))
+		    (___grow-stack     (lambda (stack)
+					 ;; make a new stack twice as big as the original
+					 (let ((new-stack (make-vector (* 2 (vector-length stack)) #f)))
+					   ;; then copy the elements...
+					   (let loop ((i (- (vector-length stack) 1)))
+					     (if (< i 0)
+						 new-stack
+						 (begin
+						   (vector-set! new-stack i (vector-ref stack i))
+						   (loop (- i 1))))))))
+	      
+		    (___push           (lambda (stack sp new-cat goto-table lval k)
+					 (let* ((state     (vector-ref stack sp))
+						(new-state (cdr (assq new-cat (vector-ref goto-table state))))
+						(new-sp    (+ sp 2))
+						(stack     (if (< new-sp (vector-length stack))
+							       stack
+							       (___grow-stack stack))))
+					   (vector-set! stack new-sp new-state)
+					   (vector-set! stack (- new-sp 1) lval)
+					   (k stack new-sp))))
+
+		    (___action         (lambda (x l)
+					 (let ((y (assq x l)))
+					   (if y (cdr y) (cdar l)))))
+	      
+		    (___rtable         ,(build-reduction-table gram/actions)))
+
+	     (lambda (lexerp errorp)
+
+	       (let ((stack (make-vector ___max-stack-size 0)))
+		 (let loop ((stack stack) (sp 0) (input (lexerp)))
+		   (let* ((state (vector-ref stack sp))
+			  (i     (if (pair? input) (car input) input))
+			  (attr  (if (pair? input) (cdr input) #f))
+			  (act   (___action i (vector-ref ___atable state))))
+
+		     (if (not (symbol? i))
+			 (errorp "PARSE ERROR: invalid token: " input))
+		 
+		     (cond
+		  
+		      ;; Input succesfully parsed
+		      ((eq? act 'accept)
+		       (vector-ref stack 1))
+		  
+		      ;; Syntax error in input
+		      ((eq? act '*error*)
+		       (if (eq? i '*eoi*)
+			   (errorp "PARSE ERROR : unexpected end of input ")
+			   (errorp "PARSE ERROR : unexpected token : " input)))
+		  
+		      ;; Shift current token on top of the stack
+		      ((>= act 0)
+		       (let ((stack (if (< (+ sp 2) (vector-length stack))
+					stack
+					(___grow-stack stack))))
+			 (vector-set! stack (+ sp 1) attr)
+			 (vector-set! stack (+ sp 2) act)
+			 (loop stack (+ sp 2) (lexerp))))
+
+		      ;; Reduce by rule (- act)
+		      (else 
+		       ((vector-ref ___rtable (- act))
+			stack sp ___gtable
+			(lambda (stack sp)
+			  (loop stack sp input))))))))))))
+    code))
+
+;; arch-tag: 4FE771DE-F56D-11D8-8B77-000A95B4C7DC
diff --git a/module/language/ecmascript/parse.scm b/module/language/ecmascript/parse.scm
new file mode 100644
index 000000000..ce731a736
--- /dev/null
+++ b/module/language/ecmascript/parse.scm
@@ -0,0 +1,337 @@
+;;; ECMAScript for Guile
+
+;; Copyright (C) 2009 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (language ecmascript parse)
+  #:use-module (language ecmascript parse-lalr)
+  #:use-module (language ecmascript tokenize)
+  #:export (read-ecmascript read-ecmascript/1 parse-ecmascript))
+
+(define (syntax-error message . args)
+  (apply throw 'SyntaxError message args))
+
+(define (read-ecmascript port)
+  (parse-ecmascript (make-tokenizer port) syntax-error))
+
+(define (read-ecmascript/1 port)
+  (parse-ecmascript (make-tokenizer/1 port) syntax-error))
+
+(define *eof-object*
+  (call-with-input-string "" read-char))
+
+(define parse-ecmascript
+  (lalr-parser
+   ;; terminal (i.e. input) token types
+   (lbrace rbrace lparen rparen lbracket rbracket dot semicolon comma <
+    > <= >= == != === !== + - * % ++ -- << >> >>> & bor ^ ! ~ && or ? 
+    colon = += -= *= %= <<= >>= >>>= &= bor= ^= / /=
+
+    break else new var case finally return void catch for switch while
+    continue function this with default if throw delete in try do
+    instanceof typeof null true false
+
+    Identifier StringLiteral NumericLiteral RegexpLiteral)
+
+
+   (Program (SourceElements) -> $1
+            (*eoi*) -> *eof-object*)
+
+   ;;
+   ;; Verily, here we define statements. Expressions are defined
+   ;; afterwards.
+   ;;
+
+   (SourceElement (Statement) -> $1
+                  (FunctionDeclaration) -> $1)
+
+   (FunctionDeclaration (function Identifier lparen rparen lbrace FunctionBody rbrace) -> `(var (,$2 (lambda () ,$6)))
+                        (function Identifier lparen FormalParameterList rparen lbrace FunctionBody rbrace) -> `(var (,$2 (lambda ,$4 ,$7))))
+   (FunctionExpression (function lparen rparen lbrace FunctionBody rbrace) -> `(lambda () ,$5)
+                       (function Identifier lparen rparen lbrace FunctionBody rbrace) -> `(lambda () ,$6)
+                       (function lparen FormalParameterList rparen lbrace FunctionBody rbrace) -> `(lambda ,$3 ,$6)
+                       (function Identifier lparen FormalParameterList rparen lbrace FunctionBody rbrace) -> `(lambda ,$4 ,$7))
+   (FormalParameterList (Identifier) -> `(,$1)
+                        (FormalParameterList comma Identifier) -> `(,@$1 ,$3))
+   (SourceElements (SourceElement) -> $1
+                   (SourceElements SourceElement) -> (if (and (pair? $1) (eq? (car $1) 'begin))
+                                                         `(begin ,@(cdr $1) ,$2)
+                                                         `(begin ,$1 ,$2)))
+   (FunctionBody (SourceElements) -> $1)
+
+   (Statement (Block) -> $1
+              (VariableStatement) -> $1
+              (EmptyStatement) -> $1
+              (ExpressionStatement) -> $1
+              (IfStatement) -> $1
+              (IterationStatement) -> $1
+              (ContinueStatement) -> $1
+              (BreakStatement) -> $1
+              (ReturnStatement) -> $1
+              (WithStatement) -> $1
+              (LabelledStatement) -> $1
+              (SwitchStatement) -> $1
+              (ThrowStatement) -> $1
+              (TryStatement) -> $1)
+
+   (Block (lbrace StatementList rbrace) -> `(block ,$2))
+   (StatementList (Statement) -> $1
+                  (StatementList Statement) -> (if (and (pair? $1) (eq? (car $1) 'begin))
+                                                   `(begin ,@(cdr $1) ,$2)
+                                                   `(begin ,$1 ,$2)))
+
+   (VariableStatement (var VariableDeclarationList) -> `(var ,@$2))
+   (VariableDeclarationList (VariableDeclaration) -> `(,$1)
+                            (VariableDeclarationList comma VariableDeclaration) -> `(,@$1 ,$2))
+   (VariableDeclarationListNoIn (VariableDeclarationNoIn) -> `(,$1)
+                                (VariableDeclarationListNoIn comma VariableDeclarationNoIn) -> `(,@$1 ,$2))
+   (VariableDeclaration (Identifier) -> `(,$1)
+                        (Identifier Initialiser) -> `(,$1 ,$2))
+   (VariableDeclarationNoIn (Identifier) -> `(,$1)
+                            (Identifier Initialiser) -> `(,$1 ,$2))
+   (Initialiser (= AssignmentExpression) -> $2)
+   (InitialiserNoIn (= AssignmentExpressionNoIn) -> $2)
+
+   (EmptyStatement (semicolon) -> '(begin))
+
+   (ExpressionStatement (Expression semicolon) -> $1)
+
+   (IfStatement (if lparen Expression rparen Statement else Statement) -> `(if ,$3 ,$5 ,$7)
+                (if lparen Expression rparen Statement) -> `(if ,$3 ,$5))
+   
+   (IterationStatement (do Statement while lparen Expression rparen semicolon) -> `(do ,$2 ,$5)
+
+                       (while lparen Expression rparen Statement) -> `(while ,$3 ,$5)
+
+                       (for lparen semicolon semicolon rparen Statement) -> `(for #f #f #f ,$6)
+                       (for lparen semicolon semicolon Expression rparen Statement) -> `(for #f #f ,$5 ,$7)
+                       (for lparen semicolon Expression semicolon rparen Statement) -> `(for #f ,$4 #f ,$7)
+                       (for lparen semicolon Expression semicolon Expression rparen Statement) -> `(for #f ,$4 ,$6 ,$8)
+
+                       (for lparen ExpressionNoIn semicolon semicolon rparen Statement) -> `(for ,$3 #f #f ,$7)
+                       (for lparen ExpressionNoIn semicolon semicolon Expression rparen Statement) -> `(for ,$3 #f ,$6 ,$8)
+                       (for lparen ExpressionNoIn semicolon Expression semicolon rparen Statement) -> `(for ,$3 ,$5 #f ,$8)
+                       (for lparen ExpressionNoIn semicolon Expression semicolon Expression rparen Statement) -> `(for ,$3 ,$5 ,$7 ,$9)
+
+                       (for lparen var VariableDeclarationListNoIn semicolon semicolon rparen Statement) -> `(for (var ,@$4) #f #f ,$8)
+                       (for lparen var VariableDeclarationListNoIn semicolon semicolon Expression rparen Statement) -> `(for (var ,@$4) #f ,$7 ,$9)
+                       (for lparen var VariableDeclarationListNoIn semicolon Expression semicolon rparen Statement) -> `(for (var ,@$4) ,$6 #f ,$9)
+                       (for lparen var VariableDeclarationListNoIn semicolon Expression semicolon Expression rparen Statement) -> `(for (var ,@$4) ,$6 ,$8 ,$10)
+
+                       (for lparen LeftHandSideExpression in Expression rparen Statement) -> `(for-in ,$3 ,$5 ,$7)
+                       (for lparen var VariableDeclarationNoIn in Expression rparen Statement) -> `(begin (var ,$4) (for-in (ref ,@$4) ,$6 ,$8)))
+
+   (ContinueStatement (continue Identifier semicolon) -> `(continue ,$2)
+                      (continue semicolon) -> `(continue))
+
+   (BreakStatement (break Identifier semicolon) -> `(break ,$2)
+                   (break semicolon) -> `(break))
+
+   (ReturnStatement (return Expression semicolon) -> `(return ,$2)
+                    (return semicolon) -> `(return))
+
+   (WithStatement (with lparen Expression rparen Statement) -> `(with ,$3 ,$5))
+
+   (SwitchStatement (switch lparen Expression rparen CaseBlock) -> `(switch ,$3 ,@$5))
+   (CaseBlock (lbrace rbrace) -> '()
+              (lbrace CaseClauses rbrace) -> $2
+              (lbrace CaseClauses DefaultClause rbrace) -> `(,@$2 ,@$3)
+              (lbrace DefaultClause rbrace) -> `(,$2)
+              (lbrace DefaultClause CaseClauses rbrace) -> `(,@$2 ,@$3))
+   (CaseClauses (CaseClause) -> `(,$1)
+                (CaseClauses CaseClause) -> `(,@$1 ,$2))
+   (CaseClause (case Expression colon) -> `(case ,$2)
+               (case Expression colon StatementList) -> `(case ,$2 ,$4))
+   (DefaultClause (default colon) -> `(default)
+                  (default colon StatementList) -> `(default ,$3))
+
+   (LabelledStatement (Identifier colon Statement) -> `(label ,$1 ,$3))
+
+   (ThrowStatement (throw Expression semicolon) -> `(throw ,$2))
+
+   (TryStatement (try Block Catch) -> `(try ,$2 ,$3 #f)
+                 (try Block Finally) -> `(try ,$2 #f ,$3)
+                 (try Block Catch Finally) -> `(try ,$2 ,$3 ,$4))
+   (Catch (catch lparen Identifier rparen Block) -> `(catch ,$3 ,$5))
+   (Finally (finally Block) -> `(finally ,$2))
+
+   ;;
+   ;; As promised, expressions. We build up to Expression bottom-up, so
+   ;; as to get operator precedence right.
+   ;;
+
+   (PrimaryExpression (this) -> 'this
+                      (null) -> 'null
+                      (true) -> 'true
+                      (false) -> 'false
+                      (Identifier) -> `(ref ,$1)
+                      (StringLiteral) -> `(string ,$1)
+                      (RegexpLiteral) -> `(regexp ,$1)
+                      (NumericLiteral) -> `(number ,$1)
+                      (ArrayLiteral) -> $1
+                      (ObjectLiteral) -> $1
+                      (lparen Expression rparen) -> $2)
+
+   (ArrayLiteral (lbracket rbracket) -> '(array)
+                 (lbracket Elision rbracket) -> '(array ,@$2)
+                 (lbracket ElementList rbracket) -> `(array ,@$2)
+                 (lbracket ElementList comma rbracket) -> `(array ,@$2)
+                 (lbracket ElementList comma Elision rbracket) -> `(array ,@$2))
+   (ElementList (AssignmentExpression) -> `(,$1)
+                (Elision AssignmentExpression) -> `(,@$1 ,$2)
+                (ElementList comma AssignmentExpression) -> `(,@$1 ,$3)
+                (ElementList comma Elision AssignmentExpression) -> `(,@$1 ,@$3 ,$4))
+   (Elision (comma) -> '((number 0))
+            (Elision comma) -> `(,@$1 (number 0)))
+
+   (ObjectLiteral (lbrace rbrace) -> `(object)
+                  (lbrace PropertyNameAndValueList rbrace) -> `(object ,@$2))
+   (PropertyNameAndValueList (PropertyName colon AssignmentExpression) -> `((,$1 ,$3))
+                             (PropertyNameAndValueList comma PropertyName colon AssignmentExpression) -> `(,@$1 (,$3 ,$5)))
+   (PropertyName (Identifier) -> $1
+                 (StringLiteral) -> (string->symbol $1)
+                 (NumericLiteral) -> $1)
+
+   (MemberExpression (PrimaryExpression) -> $1
+                     (FunctionExpression) -> $1
+                     (MemberExpression lbracket Expression rbracket) -> `(aref ,$1 ,$3)
+                     (MemberExpression dot Identifier) -> `(pref ,$1 ,$3)
+                     (new MemberExpression Arguments) -> `(new ,$2 ,$3))
+
+   (NewExpression (MemberExpression) -> $1
+                  (new NewExpression) -> `(new ,$2 ()))
+
+   (CallExpression (MemberExpression Arguments) -> `(call ,$1 ,$2)
+                   (CallExpression Arguments) -> `(call ,$1 ,$2)
+                   (CallExpression lbracket Expression rbracket) -> `(aref ,$1 ,$3)
+                   (CallExpression dot Identifier) -> `(pref ,$1 ,$3))
+   (Arguments (lparen rparen) -> '()
+              (lparen ArgumentList rparen) -> $2)
+   (ArgumentList (AssignmentExpression) -> `(,$1)
+                 (ArgumentList comma AssignmentExpression) -> `(,@$1 ,$3))
+
+   (LeftHandSideExpression (NewExpression) -> $1
+                           (CallExpression) -> $1)
+
+   (PostfixExpression (LeftHandSideExpression) -> $1
+                      (LeftHandSideExpression ++) -> `(postinc ,$1)
+                      (LeftHandSideExpression --) -> `(postdec ,$1))
+
+   (UnaryExpression (PostfixExpression) -> $1
+                    (delete UnaryExpression) -> `(delete ,$2)
+                    (void UnaryExpression) -> `(void ,$2)
+                    (typeof UnaryExpression) -> `(typeof ,$2)
+                    (++ UnaryExpression) -> `(preinc ,$2)
+                    (-- UnaryExpression) -> `(predec ,$2)
+                    (+ UnaryExpression) -> `(+ ,$2)
+                    (- UnaryExpression) -> `(- ,$2)
+                    (~ UnaryExpression) -> `(~ ,$2)
+                    (! UnaryExpression) -> `(! ,$2))
+
+   (MultiplicativeExpression (UnaryExpression) -> $1
+                             (MultiplicativeExpression * UnaryExpression) -> `(* ,$1 ,$3)
+                             (MultiplicativeExpression / UnaryExpression) -> `(/ ,$1 ,$3)
+                             (MultiplicativeExpression % UnaryExpression) -> `(% ,$1 ,$3))
+
+   (AdditiveExpression (MultiplicativeExpression) -> $1
+                       (AdditiveExpression + MultiplicativeExpression) -> `(+ ,$1 ,$3)
+                       (AdditiveExpression - MultiplicativeExpression) -> `(- ,$1 ,$3))
+
+   (ShiftExpression (AdditiveExpression) -> $1
+                    (ShiftExpression << MultiplicativeExpression) -> `(<< ,$1 ,$3)
+                    (ShiftExpression >> MultiplicativeExpression) -> `(>> ,$1 ,$3)
+                    (ShiftExpression >>> MultiplicativeExpression) -> `(>>> ,$1 ,$3))
+
+   (RelationalExpression (ShiftExpression) -> $1
+                         (RelationalExpression < ShiftExpression) -> `(< ,$1 ,$3)
+                         (RelationalExpression > ShiftExpression) -> `(> ,$1 ,$3)
+                         (RelationalExpression <= ShiftExpression) -> `(<= ,$1 ,$3)
+                         (RelationalExpression >= ShiftExpression) -> `(>= ,$1 ,$3)
+                         (RelationalExpression instanceof ShiftExpression) -> `(instanceof ,$1 ,$3)
+                         (RelationalExpression in ShiftExpression) -> `(in ,$1 ,$3))
+
+   (RelationalExpressionNoIn (ShiftExpression) -> $1
+                             (RelationalExpressionNoIn < ShiftExpression) -> `(< ,$1 ,$3)
+                             (RelationalExpressionNoIn > ShiftExpression) -> `(> ,$1 ,$3)
+                             (RelationalExpressionNoIn <= ShiftExpression) -> `(<= ,$1 ,$3)
+                             (RelationalExpressionNoIn >= ShiftExpression) -> `(>= ,$1 ,$3)
+                             (RelationalExpressionNoIn instanceof ShiftExpression) -> `(instanceof ,$1 ,$3))
+
+   (EqualityExpression (RelationalExpression) -> $1
+                       (EqualityExpression == RelationalExpression) -> `(== ,$1 ,$3)
+                       (EqualityExpression != RelationalExpression) -> `(!= ,$1 ,$3)
+                       (EqualityExpression === RelationalExpression) -> `(=== ,$1 ,$3)
+                       (EqualityExpression !== RelationalExpression) -> `(!== ,$1 ,$3))
+
+   (EqualityExpressionNoIn (RelationalExpressionNoIn) -> $1
+                           (EqualityExpressionNoIn == RelationalExpressionNoIn) -> `(== ,$1 ,$3)
+                           (EqualityExpressionNoIn != RelationalExpressionNoIn) -> `(!= ,$1 ,$3)
+                           (EqualityExpressionNoIn === RelationalExpressionNoIn) -> `(=== ,$1 ,$3)
+                           (EqualityExpressionNoIn !== RelationalExpressionNoIn) -> `(!== ,$1 ,$3))
+
+   (BitwiseANDExpression (EqualityExpression) -> $1
+                         (BitwiseANDExpression & EqualityExpression) -> `(& ,$1 ,$3))
+   (BitwiseANDExpressionNoIn (EqualityExpressionNoIn) -> $1
+                             (BitwiseANDExpressionNoIn & EqualityExpressionNoIn) -> `(& ,$1 ,$3))
+
+   (BitwiseXORExpression (BitwiseANDExpression) -> $1
+                         (BitwiseXORExpression ^ BitwiseANDExpression) -> `(^ ,$1 ,$3))
+   (BitwiseXORExpressionNoIn (BitwiseANDExpressionNoIn) -> $1
+                             (BitwiseXORExpressionNoIn ^ BitwiseANDExpressionNoIn) -> `(^ ,$1 ,$3))
+
+   (BitwiseORExpression (BitwiseXORExpression) -> $1
+                        (BitwiseORExpression bor BitwiseXORExpression) -> `(bor ,$1 ,$3))
+   (BitwiseORExpressionNoIn (BitwiseXORExpressionNoIn) -> $1
+                            (BitwiseORExpressionNoIn bor BitwiseXORExpressionNoIn) -> `(bor ,$1 ,$3))
+
+   (LogicalANDExpression (BitwiseORExpression) -> $1
+                         (LogicalANDExpression && BitwiseORExpression) -> `(and ,$1 ,$3))
+   (LogicalANDExpressionNoIn (BitwiseORExpressionNoIn) -> $1
+                             (LogicalANDExpressionNoIn && BitwiseORExpressionNoIn) -> `(and ,$1 ,$3))
+
+   (LogicalORExpression (LogicalANDExpression) -> $1
+                        (LogicalORExpression or LogicalANDExpression) -> `(or ,$1 ,$3))
+   (LogicalORExpressionNoIn (LogicalANDExpressionNoIn) -> $1
+                            (LogicalORExpressionNoIn or LogicalANDExpressionNoIn) -> `(or ,$1 ,$3))
+
+   (ConditionalExpression (LogicalORExpression) -> $1
+                          (LogicalORExpression ? AssignmentExpression colon AssignmentExpression) -> `(if ,$1 ,$3 ,$5))
+   (ConditionalExpressionNoIn (LogicalORExpressionNoIn) -> $1
+                              (LogicalORExpressionNoIn ? AssignmentExpressionNoIn colon AssignmentExpressionNoIn) -> `(if ,$1 ,$3 ,$5))
+
+   (AssignmentExpression (ConditionalExpression) -> $1
+                         (LeftHandSideExpression AssignmentOperator AssignmentExpression) -> `(,$2 ,$1 ,$3))
+   (AssignmentExpressionNoIn (ConditionalExpressionNoIn) -> $1
+                             (LeftHandSideExpression AssignmentOperator AssignmentExpressionNoIn) -> `(,$2 ,$1 ,$3))
+   (AssignmentOperator (=) -> '=
+                       (*=) -> '*=
+                       (/=) -> '/=
+                       (%=) -> '%=
+                       (+=) -> '+=
+                       (-=) -> '-=
+                       (<<=) -> '<<=
+                       (>>=) -> '>>=
+                       (>>>=) -> '>>>=
+                       (&=) -> '&=
+                       (^=) -> '^=
+                       (bor=) -> 'bor=)
+
+   (Expression (AssignmentExpression) -> $1
+               (Expression comma AssignmentExpression) -> `(begin ,$1 ,$3))
+   (ExpressionNoIn (AssignmentExpressionNoIn) -> $1
+                   (ExpressionNoIn comma AssignmentExpressionNoIn) -> `(begin ,$1 ,$3))))
diff --git a/module/language/ecmascript/spec.scm b/module/language/ecmascript/spec.scm
new file mode 100644
index 000000000..7a1ea465c
--- /dev/null
+++ b/module/language/ecmascript/spec.scm
@@ -0,0 +1,38 @@
+;;; ECMAScript specification for Guile
+
+;; Copyright (C) 2009 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (language ecmascript spec)
+  #:use-module (system base language)
+  #:use-module (language ecmascript parse)
+  #:use-module (language ecmascript compile-tree-il)
+  #:export (ecmascript))
+
+;;;
+;;; Language definition
+;;;
+
+(define-language ecmascript
+  #:title	"Guile ECMAScript"
+  #:version	"3.0"
+  #:reader	(lambda () (read-ecmascript/1 (current-input-port)))
+  #:compilers   `((tree-il . ,compile-tree-il))
+  ;; a pretty-printer would be interesting.
+  #:printer	write
+  )
diff --git a/module/language/ecmascript/tokenize.scm b/module/language/ecmascript/tokenize.scm
new file mode 100644
index 000000000..1b6a7eeaf
--- /dev/null
+++ b/module/language/ecmascript/tokenize.scm
@@ -0,0 +1,479 @@
+;;; ECMAScript for Guile
+
+;; Copyright (C) 2009 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (language ecmascript tokenize)
+  #:use-module (ice-9 rdelim)
+  #:use-module ((srfi srfi-1) #:select (unfold-right))
+  #:export (next-token make-tokenizer make-tokenizer/1 tokenize tokenize/1))
+
+(define (syntax-error message . args)
+  (apply throw 'SyntaxError message args))
+
+;; taken from SSAX, sorta
+(define (read-until delims port)
+  (if (eof-object? (peek-char port))
+      (syntax-error "EOF while reading a token")
+      (let ((token (read-delimited delims port 'peek)))
+        (if (eof-object? (peek-char port))
+            (syntax-error "EOF while reading a token")
+            token))))
+
+(define (char-hex? c)
+  (and (not (eof-object? c))
+       (or (char-numeric? c)
+           (memv c '(#\a #\b #\c #\d #\e #\f))
+           (memv c '(#\A #\B #\C #\D #\E #\F)))))
+
+(define (digit->number c)
+  (- (char->integer c) (char->integer #\0)))
+
+(define (hex->number c)
+  (if (char-numeric? c)
+      (digit->number c)
+      (+ 10 (- (char->integer (char-downcase c)) (char->integer #\a)))))
+
+(define (read-slash port div?)
+  (let* ((c0 (read-char port))
+         (c1 (peek-char port)))
+    (cond
+     ((eof-object? c1)
+      ;; hmm. error if we're not looking for a div? ?
+      '(/ . #f))
+     ((char=? c1 #\/)
+      (read-line port)
+      (next-token port div?))
+     ((char=? c1 #\*)
+      (read-char port)
+      (let lp ((c (read-char port)))
+        (cond
+         ((eof-object? c) (syntax-error "EOF while in multi-line comment"))
+         ((char=? c #\*)
+          (if (eqv? (peek-char port) #\/)
+              (begin
+                (read-char port)
+                (next-token port div?))
+              (lp (read-char port))))
+         (else
+          (lp (read-char port))))))
+     (div?
+      (case c1
+        ((#\=) (read-char port) `(/= . #f))
+        (else `(/ . #f))))
+     (else
+      (read-regexp port)))))
+
+(define (read-regexp port)
+  ;; first slash already read
+  (let ((terms (string #\/ #\\ #\nl #\cr)))
+    (let lp ((str (read-until terms port)) (head ""))
+      (let ((terminator (peek-char port)))
+        (cond
+         ((char=? terminator #\/)
+          (read-char port)
+          ;; flags
+          (let lp ((c (peek-char port)) (flags '()))
+            (if (or (eof-object? c)
+                    (not (or (char-alphabetic? c)
+                             (char-numeric? c)
+                             (char=? c #\$)
+                             (char=? c #\_))))
+                `(RegexpLiteral . (,(string-append head str) . ,(reverse flags)))
+                (begin (read-char port)
+                       (lp (peek-char port) (cons c flags))))))
+         ((char=? terminator #\\)
+          (read-char port)
+          (let ((echar (read-char port)))
+            (lp (read-until terms port)
+                (string-append head str (string #\\ echar)))))
+         (else
+          (syntax-error "regexp literals may not contain newlines" str)))))))
+
+(define (read-string port)
+  (let ((c (read-char port)))
+    (let ((terms (string c #\\ #\nl #\cr)))
+      (define (read-escape port)
+        (let ((c (read-char port)))
+          (case c
+            ((#\' #\" #\\) c)
+            ((#\b) #\bs)
+            ((#\f) #\np)
+            ((#\n) #\nl)
+            ((#\r) #\cr)
+            ((#\t) #\tab)
+            ((#\v) #\vt)
+            ((#\0)
+             (let ((next (peek-char port)))
+               (cond ((eof-object? next) #\nul)
+                     ((char-numeric? next)
+                      (syntax-error "octal escape sequences are not supported"))
+                     (else #\nul))))
+            ((#\x)
+             (let* ((a (read-char port))
+                    (b (read-char port)))
+               (cond
+                ((and (char-hex? a) (char-hex? b))
+                 (integer->char (+ (* 16 (hex->number a)) (hex->number b))))
+                (else
+                 (syntax-error "bad hex character escape" a b)))))
+            ((#\u)
+             (syntax-error "unicode not supported"))
+            (else
+             c))))
+      (let lp ((str (read-until terms port)))
+        (let ((terminator (peek-char port)))
+          (cond
+           ((char=? terminator c)
+            (read-char port)
+            str)
+           ((char=? terminator #\\)
+            (read-char port)
+            (let ((echar (read-escape port)))
+              (lp (string-append str (string echar)
+                                 (read-until terms port)))))
+           (else
+            (syntax-error "string literals may not contain newlines" str))))))))
+
+(define *keywords*
+  '(("break" . break)
+    ("else" . else)
+    ("new" . new)
+    ("var" . var)
+    ("case" . case)
+    ("finally" . finally)
+    ("return" . return)
+    ("void" . void)
+    ("catch" . catch)
+    ("for" . for)
+    ("switch" . switch)
+    ("while" . while)
+    ("continue" . continue)
+    ("function" . function)
+    ("this" . this)
+    ("with" . with)
+    ("default" . default)
+    ("if" . if)
+    ("throw" . throw)
+    ("delete" . delete)
+    ("in" . in)
+    ("try" . try)
+    ("do" . do)
+    ("instanceof" . instanceof)
+    ("typeof" . typeof)
+
+    ;; these aren't exactly keywords, but hey
+    ("null" . null)
+    ("true" . true)
+    ("false" . false)))
+
+(define *future-reserved-words*
+  '(("abstract" . abstract)
+    ("enum" . enum)
+    ("int" . int)
+    ("short" . short)
+    ("boolean" . boolean)
+    ("export" . export)
+    ("interface" . interface)
+    ("static" . static)
+    ("byte" . byte)
+    ("extends" . extends)
+    ("long" . long)
+    ("super" . super)
+    ("char" . char)
+    ("final" . final)
+    ("native" . native)
+    ("synchronized" . synchronized)
+    ("class" . class)
+    ("float" . float)
+    ("package" . package)
+    ("throws" . throws)
+    ("const" . const)
+    ("goto" . goto)
+    ("private" . private)
+    ("transient" . transient)
+    ("debugger" . debugger)
+    ("implements" . implements)
+    ("protected" . protected)
+    ("volatile" . volatile)
+    ("double" . double)
+    ("import" . import)
+    ("public" . public)))
+
+(define (read-identifier port)
+  (let lp ((c (peek-char port)) (chars '()))
+    (if (or (eof-object? c)
+            (not (or (char-alphabetic? c)
+                     (char-numeric? c)
+                     (char=? c #\$)
+                     (char=? c #\_))))
+        (let ((word (list->string (reverse chars))))
+          (cond ((assoc-ref *keywords* word)
+                 => (lambda (x) `(,x . #f)))
+                ((assoc-ref *future-reserved-words* word)
+                 (syntax-error "word is reserved for the future, dude." word))
+                (else `(Identifier . ,(string->symbol word)))))
+        (begin (read-char port)
+               (lp (peek-char port) (cons c chars))))))
+
+(define (read-numeric port)
+  (let* ((c0 (if (char=? (peek-char port) #\.)
+                 #\0
+                 (read-char port)))
+         (c1 (peek-char port)))
+    (cond
+     ((eof-object? c1) (digit->number c0))
+     ((and (char=? c0 #\0) (char=? c1 #\x))
+      (read-char port)
+      (let ((c (peek-char port)))
+        (if (not (char-hex? c))
+            (syntax-error "bad digit reading hexadecimal number" c))
+        (let lp ((c c) (acc 0))
+          (cond ((char-hex? c)
+                 (read-char port)
+                 (lp (peek-char port)
+                     (+ (* 16 acc) (hex->number c))))
+                (else
+                 acc)))))
+     ((and (char=? c0 #\0) (char-numeric? c1))
+      (let lp ((c c1) (acc 0))
+        (cond ((eof-object? c) acc)
+              ((char-numeric? c)
+               (if (or (char=? c #\8) (char=? c #\9))
+                   (syntax-error "invalid digit in octal sequence" c))
+               (read-char port)
+               (lp (peek-char port)
+                   (+ (* 8 acc) (digit->number c))))
+              (else
+               acc))))
+     (else
+      (let lp ((c1 c1) (acc (digit->number c0)))
+        (cond
+         ((eof-object? c1) acc)
+         ((char-numeric? c1)
+          (read-char port)
+          (lp (peek-char port)
+              (+ (* 10 acc) (digit->number c1))))
+         ((or (char=? c1 #\e) (char=? c1 #\E))
+          (read-char port)
+          (let ((add (let ((c (peek-char port)))
+                       (cond ((eof-object? c) (syntax-error "error reading exponent: EOF"))
+                             ((char=? c #\+) (read-char port) +)
+                             ((char=? c #\-) (read-char port) -)
+                             ((char-numeric? c) +)
+                             (else (syntax-error "error reading exponent: non-digit"
+                                                 c))))))
+            (let lp ((c (peek-char port)) (e 0))
+              (cond ((and (not (eof-object? c)) (char-numeric? c))
+                     (read-char port)
+                     (lp (peek-char port) (add (* 10 e) (digit->number c))))
+                    (else
+                     (* (if (negative? e) (* acc 1.0) acc) (expt 10 e)))))))
+         ((char=? c1 #\.)
+          (read-char port)
+          (let lp2 ((c (peek-char port)) (dec 0.0) (n -1))
+            (cond ((and (not (eof-object? c)) (char-numeric? c))
+                   (read-char port)
+                   (lp2 (peek-char port)
+                        (+ dec (* (digit->number c) (expt 10 n)))
+                        (1- n)))
+                  (else
+                   ;; loop back to catch an exponential part
+                   (lp c (+ acc dec))))))
+         (else
+          acc)))))))
+           
+(define *punctuation*
+  '(("{" . lbrace)
+    ("}" . rbrace)
+    ("(" . lparen)
+    (")" . rparen)
+    ("[" . lbracket)
+    ("]" . rbracket)
+    ("." . dot)
+    (";" . semicolon)
+    ("," . comma)
+    ("<" . <)
+    (">" . >)
+    ("<=" . <=)
+    (">=" . >=)
+    ("==" . ==)
+    ("!=" . !=)
+    ("===" . ===)
+    ("!==" . !==)
+    ("+" . +)
+    ("-" . -)
+    ("*" . *)
+    ("%" . %)
+    ("++" . ++)
+    ("--" . --)
+    ("<<" . <<)
+    (">>" . >>)
+    (">>>" . >>>)
+    ("&" . &)
+    ("|" . bor)
+    ("^" . ^)
+    ("!" . !)
+    ("~" . ~)
+    ("&&" . &&)
+    ("||" . or)
+    ("?" . ?)
+    (":" . colon)
+    ("=" . =)
+    ("+=" . +=)
+    ("-=" . -=)
+    ("*=" . *=)
+    ("%=" . %=)
+    ("<<=" . <<=)
+    (">>=" . >>=)
+    (">>>=" . >>>=)
+    ("&=" . &=)
+    ("|=" . bor=)
+    ("^=" . ^=)))
+
+(define *div-punctuation*
+  '(("/" . /)
+    ("/=" . /=)))
+
+;; node ::= (char (symbol | #f) node*)
+(define read-punctuation
+  (let ((punc-tree (let lp ((nodes '()) (puncs *punctuation*))
+                     (cond ((null? puncs)
+                            nodes)
+                           ((assv-ref nodes (string-ref (caar puncs) 0))
+                            => (lambda (node-tail)
+                                 (if (= (string-length (caar puncs)) 1)
+                                     (set-car! node-tail (cdar puncs))
+                                     (set-cdr! node-tail
+                                               (lp (cdr node-tail)
+                                                   `((,(substring (caar puncs) 1)
+                                                      . ,(cdar puncs))))))
+                                 (lp nodes (cdr puncs))))
+                           (else
+                            (lp (cons (list (string-ref (caar puncs) 0) #f) nodes)
+                                puncs))))))
+    (lambda (port)
+      (let lp ((c (peek-char port)) (tree punc-tree) (candidate #f))
+        (cond
+         ((assv-ref tree c)
+          => (lambda (node-tail)
+               (read-char port)
+               (lp (peek-char port) (cdr node-tail) (car node-tail))))
+         (candidate
+          `(,candidate . #f))
+         (else
+          (syntax-error "bad syntax: character not allowed" c)))))))
+
+(define (next-token port div?)
+  (let ((c (peek-char port))
+        (props `((filename . ,(port-filename port))
+                 (line . ,(port-line port))
+                 (column . ,(port-column port)))))
+    (let ((tok 
+           (case c
+             ((#\ht #\vt #\np #\space)
+                                        ; whitespace
+              (read-char port)
+              (next-token port div?))
+             ((#\newline #\cr)
+                                        ; line break
+              (read-char port)
+              (next-token port div?))
+             ((#\/)
+              ;; division, single comment, double comment, or regexp
+              (read-slash port div?))
+             ((#\" #\')
+                                        ; string literal
+              `(StringLiteral . ,(read-string port)))
+             (else
+              (cond
+               ((eof-object? c)
+                '*eoi*)
+               ((or (char-alphabetic? c)
+                    (char=? c #\$)
+                    (char=? c #\_))
+                ;; reserved word or identifier
+                (read-identifier port))
+               ((char-numeric? c)
+                ;; numeric -- also accept . FIXME, requires lookahead
+                `(NumericLiteral . ,(read-numeric port)))
+               (else
+                ;; punctuation
+                (read-punctuation port)))))))
+      (if (pair? tok)
+          (set-source-properties! tok props))
+      tok)))
+
+(define (make-tokenizer port)
+  (let ((div? #f))
+    (lambda ()
+      (let ((tok (next-token port div?)))
+        (set! div? (and (pair? tok) (eq? (car tok) 'identifier)))
+        tok))))
+
+(define (make-tokenizer/1 port)
+  (let ((div? #f)
+        (eoi? #f)
+        (stack '()))
+    (lambda ()
+      (if eoi?
+          '*eoi*
+          (let ((tok (next-token port div?)))
+            (case (if (pair? tok) (car tok) tok)
+              ((lparen)
+               (set! stack (cons 'lparen stack)))
+              ((rparen)
+               (if (and (pair? stack) (eq? (car stack) 'lparen))
+                   (set! stack (cdr stack))
+                   (syntax-error "unexpected right parenthesis")))
+              ((lbracket)
+               (set! stack (cons 'lbracket stack)))
+              ((rbracket)
+               (if (and (pair? stack) (eq? (car stack) 'lbracket))
+                   (set! stack (cdr stack))
+                   (syntax-error "unexpected right bracket" stack)))
+              ((lbrace)
+               (set! stack (cons 'lbrace stack)))
+              ((rbrace)
+               (if (and (pair? stack) (eq? (car stack) 'lbrace))
+                   (set! stack (cdr stack))
+                   (syntax-error "unexpected right brace" stack)))
+              ((semicolon)
+               (set! eoi? (null? stack))))
+            (set! div? (and (pair? tok)
+                            (or (eq? (car tok) 'Identifier)
+                                (eq? (car tok) 'NumericLiteral)
+                                (eq? (car tok) 'StringLiteral))))
+            tok)))))
+
+(define (tokenize port)
+  (let ((next (make-tokenizer port)))
+    (let lp ((out '()))
+      (let ((tok (next)))
+        (if (eq? tok '*eoi*)
+            (reverse! out)
+            (lp (cons tok out)))))))
+
+(define (tokenize/1 port)
+  (let ((next (make-tokenizer/1 port)))
+    (let lp ((out '()))
+      (let ((tok (next)))
+        (if (eq? tok '*eoi*)
+            (reverse! out)
+            (lp (cons tok out)))))))
+
diff --git a/module/language/elisp/spec.scm b/module/language/elisp/spec.scm
new file mode 100644
index 000000000..617e4e3c5
--- /dev/null
+++ b/module/language/elisp/spec.scm
@@ -0,0 +1,62 @@
+;;; Guile Emac Lisp
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (lang elisp spec)
+  #:use-module (system lang language)
+  #:export (elisp))
+
+
+;;;
+;;; Translator
+;;;
+
+(define (translate x)
+  (if (pair? x)
+      (translate-pair x)
+      x))
+
+(define (translate-pair x)
+  (let ((name (car x)) (args (cdr x)))
+    (case name
+      ((quote) `(@quote ,@args))
+      ((defvar) `(@define ,@(map translate args)))
+      ((setq) `(@set! ,@(map translate args)))
+      ((if) `(@if ,(translate (car args))
+		  (@begin ,@(map translate (cdr args)))))
+      ((and) `(@and ,@(map translate args)))
+      ((or) `(@or ,@(map translate args)))
+      ((progn) `(@begin ,@(map translate args)))
+      ((defun) `(@define ,(car args)
+			 (@lambda ,(cadr args) ,@(map translate (cddr args)))))
+      ((lambda) `(@lambda ,(car args) ,@(map translate (cdr args))))
+      (else x))))
+
+
+;;;
+;;; Language definition
+;;;
+
+(define-language elisp
+  #:title	"Emacs Lisp"
+  #:version	"0.0"
+  #:reader	read
+  #:expander	id
+  #:translator	translate
+  )
diff --git a/module/language/ghil.scm b/module/language/ghil.scm
new file mode 100644
index 000000000..84cc83de5
--- /dev/null
+++ b/module/language/ghil.scm
@@ -0,0 +1,478 @@
+;;; Guile High Intermediate Language
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (language ghil)
+  #:use-module (system base syntax)
+  #:use-module (system base pmatch)
+  #:use-module (ice-9 regex)
+  #:export
+  (ghil-env ghil-loc
+
+   <ghil-void> make-ghil-void ghil-void?
+   ghil-void-env ghil-void-loc
+
+   <ghil-quote> make-ghil-quote ghil-quote?
+   ghil-quote-env ghil-quote-loc ghil-quote-obj
+
+   <ghil-quasiquote> make-ghil-quasiquote ghil-quasiquote?
+   ghil-quasiquote-env ghil-quasiquote-loc ghil-quasiquote-exp
+
+   <ghil-unquote> make-ghil-unquote ghil-unquote?
+   ghil-unquote-env ghil-unquote-loc ghil-unquote-exp
+
+   <ghil-unquote-splicing> make-ghil-unquote-splicing ghil-unquote-splicing?
+   ghil-unquote-splicing-env ghil-unquote-splicing-loc ghil-unquote-splicing-exp
+
+   <ghil-ref> make-ghil-ref ghil-ref?
+   ghil-ref-env ghil-ref-loc ghil-ref-var
+
+   <ghil-set> make-ghil-set ghil-set?
+   ghil-set-env ghil-set-loc ghil-set-var ghil-set-val
+
+   <ghil-define> make-ghil-define ghil-define?
+   ghil-define-env ghil-define-loc ghil-define-var ghil-define-val
+
+   <ghil-if> make-ghil-if ghil-if?
+   ghil-if-env ghil-if-loc ghil-if-test ghil-if-then ghil-if-else
+
+   <ghil-and> make-ghil-and ghil-and?
+   ghil-and-env ghil-and-loc ghil-and-exps
+
+   <ghil-or> make-ghil-or ghil-or?
+   ghil-or-env ghil-or-loc ghil-or-exps
+
+   <ghil-begin> make-ghil-begin ghil-begin?
+   ghil-begin-env ghil-begin-loc ghil-begin-exps
+
+   <ghil-bind> make-ghil-bind ghil-bind?
+   ghil-bind-env ghil-bind-loc ghil-bind-vars ghil-bind-vals ghil-bind-body
+
+   <ghil-mv-bind> make-ghil-mv-bind ghil-mv-bind?
+   ghil-mv-bind-env ghil-mv-bind-loc ghil-mv-bind-producer ghil-mv-bind-vars ghil-mv-bind-rest ghil-mv-bind-body
+
+   <ghil-lambda> make-ghil-lambda ghil-lambda?
+   ghil-lambda-env ghil-lambda-loc ghil-lambda-vars ghil-lambda-rest
+   ghil-lambda-meta ghil-lambda-body
+
+   <ghil-inline> make-ghil-inline ghil-inline?
+   ghil-inline-env ghil-inline-loc ghil-inline-inline ghil-inline-args
+
+   <ghil-call> make-ghil-call ghil-call?
+   ghil-call-env ghil-call-loc ghil-call-proc ghil-call-args
+
+   <ghil-mv-call> make-ghil-mv-call ghil-mv-call?
+   ghil-mv-call-env ghil-mv-call-loc ghil-mv-call-producer ghil-mv-call-consumer
+
+   <ghil-values> make-ghil-values ghil-values?
+   ghil-values-env ghil-values-loc ghil-values-values
+
+   <ghil-values*> make-ghil-values* ghil-values*?
+   ghil-values*-env ghil-values*-loc ghil-values*-values
+
+   <ghil-var> make-ghil-var ghil-var?
+   ghil-var-env ghil-var-name ghil-var-kind ghil-var-index
+
+   <ghil-toplevel-env> make-ghil-toplevel-env ghil-toplevel-env?
+   ghil-toplevel-env-table
+
+   <ghil-env> make-ghil-env ghil-env?
+   ghil-env-parent ghil-env-table ghil-env-variables
+
+   <ghil-reified-env> make-ghil-reified-env ghil-reified-env?
+   ghil-reified-env-env ghil-reified-env-loc
+
+   ghil-env-add!
+   ghil-env-reify ghil-env-dereify
+   ghil-var-is-bound? ghil-var-for-ref! ghil-var-for-set! ghil-var-define!
+   ghil-var-at-module!
+   call-with-ghil-environment call-with-ghil-bindings
+
+   parse-ghil unparse-ghil))
+
+
+;;;
+;;; Parse tree
+;;;
+
+(define (print-ghil x port)
+  (format port "#<ghil ~s>" (unparse-ghil x)))
+
+(define-type (<ghil> #:printer print-ghil
+                     #:common-slots (env loc))
+  ;; Objects
+  (<ghil-void>)
+  (<ghil-quote> obj)
+  (<ghil-quasiquote> exp)
+  (<ghil-unquote> exp)
+  (<ghil-unquote-splicing> exp)
+  ;; Variables
+  (<ghil-ref> var)
+  (<ghil-set> var val)
+  (<ghil-define> var val)
+  ;; Controls
+  (<ghil-if> test then else)
+  (<ghil-and> exps)
+  (<ghil-or> exps)
+  (<ghil-begin> exps)
+  (<ghil-bind> vars vals body)
+  (<ghil-mv-bind> producer vars rest body)
+  (<ghil-lambda> vars rest meta body)
+  (<ghil-call> proc args)
+  (<ghil-mv-call> producer consumer)
+  (<ghil-inline> inline args)
+  (<ghil-values> values)
+  (<ghil-values*> values)
+  (<ghil-reified-env>))
+
+
+
+;;;
+;;; Variables
+;;;
+
+(define-record <ghil-var> env name kind (index #f))
+
+
+;;;
+;;; Modules
+;;;
+
+
+;;;
+;;; Environments
+;;;
+
+(define-record <ghil-env> parent (table '()) (variables '()))
+(define-record <ghil-toplevel-env> (table '()))
+
+(define (ghil-env-ref env sym)
+  (assq-ref (ghil-env-table env) sym))
+
+(define-macro (push! item loc)
+  `(set! ,loc (cons ,item ,loc)))
+(define-macro (apush! k v loc)
+  `(set! ,loc (acons ,k ,v ,loc)))
+(define-macro (apopq! k loc)
+  `(set! ,loc (assq-remove! ,loc ,k)))
+
+(define (ghil-env-add! env var)
+  (apush! (ghil-var-name var) var (ghil-env-table env))
+  (push! var (ghil-env-variables env)))
+
+(define (ghil-env-remove! env var)
+  (apopq! (ghil-var-name var) (ghil-env-table env)))
+
+(define (force-heap-allocation! var)
+  (set! (ghil-var-kind var) 'external))
+  
+
+
+;;;
+;;; Public interface
+;;;
+
+;; The following four functions used to be one, in ghil-lookup. Now they
+;; are four, to reflect the different intents. A bit of duplication, but
+;; that's OK. The common current is to find out where a variable will be
+;; stored at runtime.
+;;
+;; These functions first search the lexical environments. If the
+;; variable is not in the innermost environment, make sure the variable
+;; is marked as being "external" so that it goes on the heap. If the
+;; variable is being modified (via a set!), also make sure it's on the
+;; heap, so that other continuations see the changes to the var.
+;;
+;; If the variable is not found lexically, it is a toplevel variable,
+;; which will be looked up at runtime with respect to the module that
+;; was current when the lambda was bound, at runtime. The variable will
+;; be resolved when it is first used.
+(define (ghil-var-is-bound? env sym)
+  (let loop ((e env))
+    (record-case e
+      ((<ghil-toplevel-env> table)
+       (let ((key (cons (module-name (current-module)) sym)))
+         (assoc-ref table key)))
+      ((<ghil-env> parent table variables)
+       (and (not (assq-ref table sym))
+            (loop parent))))))
+
+(define (ghil-var-for-ref! env sym)
+  (let loop ((e env))
+    (record-case e
+      ((<ghil-toplevel-env> table)
+       (let ((key (cons (module-name (current-module)) sym)))
+         (or (assoc-ref table key)
+             (let ((var (make-ghil-var (car key) (cdr key) 'toplevel)))
+               (apush! key var (ghil-toplevel-env-table e))
+               var))))
+      ((<ghil-env> parent table variables)
+       (cond
+        ((assq-ref table sym)
+         => (lambda (var)
+              (or (eq? e env)
+                  (force-heap-allocation! var))
+              var))
+        (else
+         (loop parent)))))))
+
+(define (ghil-var-for-set! env sym)
+  (let loop ((e env))
+    (record-case e
+      ((<ghil-toplevel-env> table)
+       (let ((key (cons (module-name (current-module)) sym)))
+         (or (assoc-ref table key)
+             (let ((var (make-ghil-var (car key) (cdr key) 'toplevel)))
+               (apush! key var (ghil-toplevel-env-table e))
+               var))))
+      ((<ghil-env> parent table variables)
+       (cond
+        ((assq-ref table sym)
+         => (lambda (var)
+              (force-heap-allocation! var)
+              var))
+        (else
+         (loop parent)))))))
+
+(define (ghil-var-at-module! env modname sym interface?)
+  (let loop ((e env))
+    (record-case e
+      ((<ghil-toplevel-env> table)
+       (let ((key (list modname sym interface?)))
+         (or (assoc-ref table key)
+             (let ((var (make-ghil-var modname sym
+                                       (if interface? 'public 'private))))
+               (apush! key var (ghil-toplevel-env-table e))
+               var))))
+      ((<ghil-env> parent table variables)
+       (loop parent)))))
+
+(define (ghil-var-define! toplevel sym)
+  (let ((key (cons (module-name (current-module)) sym)))
+    (or (assoc-ref (ghil-toplevel-env-table toplevel) key)
+        (let ((var (make-ghil-var (car key) (cdr key) 'toplevel)))
+          (apush! key var (ghil-toplevel-env-table toplevel))
+          var))))
+          
+(define (call-with-ghil-environment e syms func)
+  (let* ((e (make-ghil-env e))
+         (vars (map (lambda (s)
+                      (let ((v (make-ghil-var e s 'argument)))
+                        (ghil-env-add! e v) v))
+                    syms)))
+    (func e vars)))
+
+(define (call-with-ghil-bindings e syms func)
+  (let* ((vars (map (lambda (s)
+		      (let ((v (make-ghil-var e s 'local)))
+			(ghil-env-add! e v) v))
+		    syms))
+	 (ret (func vars)))
+    (for-each (lambda (v) (ghil-env-remove! e v)) vars)
+    ret))
+
+(define (ghil-env-reify env)
+  (let loop ((e env) (out '()))
+    (record-case e
+      ((<ghil-toplevel-env> table)
+       (map (lambda (v)
+              (cons (ghil-var-name v)
+                    (or (ghil-var-index v)
+                        (error "reify called before indices finalized"))))
+            out))
+      ((<ghil-env> parent table variables)
+       (loop parent
+             (append out
+                     (filter (lambda (v) (eq? (ghil-var-kind v) 'external))
+                             variables)))))))
+
+(define (ghil-env-dereify name-index-alist)
+  (let* ((e (make-ghil-env (make-ghil-toplevel-env)))
+         (vars (map (lambda (pair)
+                      (make-ghil-var e (car pair) 'external (cdr pair)))
+                    name-index-alist)))
+    (set! (ghil-env-table e)
+          (map (lambda (v) (cons (ghil-var-name v) v)) vars))
+    (set! (ghil-env-variables e) vars)
+    e))
+
+
+;;;
+;;; Parser
+;;;
+
+(define (location x)
+  (and (pair? x)
+       (let ((props (source-properties x)))
+	 (and (not (null? props))
+	      (vector (assq-ref props 'line)
+                      (assq-ref props 'column)
+                      (assq-ref props 'filename))))))
+
+(define (parse-quasiquote e x level)
+  (cond ((not (pair? x)) x)
+	((memq (car x) '(unquote unquote-splicing))
+	 (let ((l (location x)))
+	   (pmatch (cdr x)
+	     ((,obj)
+              (cond
+               ((zero? level) 
+                (if (eq? (car x) 'unquote)
+                    (make-ghil-unquote e l (parse-ghil e obj))
+                    (make-ghil-unquote-splicing e l (parse-ghil e obj))))
+               (else
+                (list (car x) (parse-quasiquote e obj (1- level))))))
+	     (else (syntax-error l (format #f "bad ~A" (car x)) x)))))
+        ((eq? (car x) 'quasiquote)
+	 (let ((l (location x)))
+	   (pmatch (cdr x)
+	     ((,obj) (list 'quasiquote (parse-quasiquote e obj (1+ level))))
+             (else (syntax-error l (format #f "bad ~A" (car x)) x)))))
+	(else (cons (parse-quasiquote e (car x) level)
+		    (parse-quasiquote e (cdr x) level)))))
+
+(define (parse-ghil env exp)
+  (let ((loc (location exp))
+        (retrans (lambda (x) (parse-ghil env x))))
+    (pmatch exp
+     ((ref ,sym) (guard (symbol? sym))
+      (make-ghil-ref env #f (ghil-var-for-ref! env sym)))
+
+     (('quote ,exp) (make-ghil-quote env loc exp))
+
+     ((void) (make-ghil-void env loc))
+
+     ((lambda ,syms ,rest ,meta . ,body)
+      (call-with-ghil-environment env syms
+        (lambda (env vars)
+          (make-ghil-lambda env loc vars rest meta
+                            (parse-ghil env `(begin ,@body))))))
+
+     ((begin . ,body)
+      (make-ghil-begin env loc (map retrans body)))
+
+     ((bind ,syms ,exprs . ,body)
+      (let ((vals (map retrans exprs)))
+        (call-with-ghil-bindings env syms
+          (lambda (vars)
+            (make-ghil-bind env loc vars vals (retrans `(begin ,@body)))))))
+
+     ((bindrec ,syms ,exprs . ,body)
+      (call-with-ghil-bindings env syms
+        (lambda (vars)
+          (let ((vals (map (lambda (exp) (parse-ghil env exp)) exprs)))
+            (make-ghil-bind env loc vars vals (retrans `(begin ,@body)))))))
+
+     ((set ,sym ,val)
+      (make-ghil-set env loc (ghil-var-for-set! env sym) (retrans val)))
+
+     ((define ,sym ,val)
+      (make-ghil-define env loc (ghil-var-define! env sym) (retrans val)))
+
+     ((if ,test ,then ,else)
+      (make-ghil-if env loc (retrans test) (retrans then) (retrans else)))
+
+     ((and . ,exps)
+      (make-ghil-and env loc (map retrans exps)))
+
+     ((or . ,exps)
+      (make-ghil-or env loc (map retrans exps)))
+
+     ((mv-bind ,syms ,rest ,producer . ,body)
+      (call-with-ghil-bindings env syms
+        (lambda (vars)
+          (make-ghil-mv-bind env loc (retrans producer) vars rest
+                             (map retrans body)))))
+
+     ((call ,proc . ,args)
+      (make-ghil-call env loc (retrans proc) (map retrans args)))
+
+     ((mv-call ,producer ,consumer)
+      (make-ghil-mv-call env loc (retrans producer) (retrans consumer)))
+
+     ((inline ,op . ,args)
+      (make-ghil-inline env loc op (map retrans args)))
+
+     ((values . ,values)
+      (make-ghil-values env loc (map retrans values)))
+
+     ((values* . ,values)
+      (make-ghil-values* env loc (map retrans values)))
+
+     ((compile-time-environment)
+      (make-ghil-reified-env env loc))
+
+     ((quasiquote ,exp)
+      (make-ghil-quasiquote env loc (parse-quasiquote env exp 0)))
+
+     (else
+      (error "unrecognized GHIL" exp)))))
+
+(define (unparse-ghil ghil)
+  (record-case ghil
+    ((<ghil-void> env loc)
+     '(void))
+    ((<ghil-quote> env loc obj)
+     `(,'quote ,obj))
+    ((<ghil-quasiquote> env loc exp)
+     `(,'quasiquote ,(let lp ((x exp))
+                       (cond ((struct? x) (unparse-ghil x))
+                             ((pair? x) (cons (lp (car x)) (lp (cdr x))))
+                             (else x)))))
+    ((<ghil-unquote> env loc exp)
+     `(,'unquote ,(unparse-ghil exp)))
+    ((<ghil-unquote-splicing> env loc exp)
+     `(,'unquote-splicing ,(unparse-ghil exp)))
+  ;; Variables
+    ((<ghil-ref> env loc var)
+     `(ref ,(ghil-var-name var)))
+    ((<ghil-set> env loc var val)
+     `(set ,(ghil-var-name var) ,(unparse-ghil val)))
+    ((<ghil-define> env loc var val)
+     `(define ,(ghil-var-name var) ,(unparse-ghil val)))
+  ;; Controls
+    ((<ghil-if> env loc test then else)
+     `(if ,(unparse-ghil test) ,(unparse-ghil then) ,(unparse-ghil else)))
+    ((<ghil-and> env loc exps)
+     `(and ,@(map unparse-ghil exps)))
+    ((<ghil-or> env loc exps)
+     `(or ,@(map unparse-ghil exps)))
+    ((<ghil-begin> env loc exps)
+     `(begin ,@(map unparse-ghil exps)))
+    ((<ghil-bind> env loc vars vals body)
+     `(bind ,(map ghil-var-name vars) ,(map unparse-ghil vals)
+            ,(unparse-ghil body)))
+    ((<ghil-mv-bind> env loc producer vars rest body)
+     `(mv-bind ,(map ghil-var-name vars) ,rest
+               ,(unparse-ghil producer) ,(unparse-ghil body)))
+    ((<ghil-lambda> env loc vars rest meta body)
+     `(lambda ,(map ghil-var-name vars) ,rest ,meta
+              ,(unparse-ghil body)))
+    ((<ghil-call> env loc proc args)
+     `(call ,(unparse-ghil proc) ,@(map unparse-ghil args)))
+    ((<ghil-mv-call> env loc producer consumer)
+     `(mv-call ,(unparse-ghil producer) ,(unparse-ghil consumer)))
+    ((<ghil-inline> env loc inline args)
+     `(inline ,inline ,@(map unparse-ghil args)))
+    ((<ghil-values> env loc values)
+     `(values ,@(map unparse-ghil values)))
+    ((<ghil-values*> env loc values)
+     `(values* ,@(map unparse-ghil values)))
+    ((<ghil-reified-env> env loc)
+     `(compile-time-environment))))
diff --git a/module/language/ghil/compile-glil.scm b/module/language/ghil/compile-glil.scm
new file mode 100644
index 000000000..47e15c797
--- /dev/null
+++ b/module/language/ghil/compile-glil.scm
@@ -0,0 +1,592 @@
+;;; GHIL -> GLIL compiler
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (language ghil compile-glil)
+  #:use-module (system base syntax)
+  #:use-module (language glil)
+  #:use-module (language ghil)
+  #:use-module (ice-9 common-list)
+  #:export (compile-glil))
+
+(define (compile-glil x e opts)
+  (if (memq #:O opts) (set! x (optimize x)))
+  (values (codegen x)
+          (and e (cons (car e) (cddr e)))
+          e))
+
+
+;;;
+;;; Stage 2: Optimization
+;;;
+
+(define (lift-variables! env)
+  (let ((parent-env (ghil-env-parent env)))
+    (for-each (lambda (v)
+                (case (ghil-var-kind v)
+                  ((argument) (set! (ghil-var-kind v) 'local)))
+                (set! (ghil-var-env v) parent-env)
+                (ghil-env-add! parent-env v))
+              (ghil-env-variables env))))
+
+;; The premise of this, unused, approach to optimization is that you can
+;; determine the environment of a variable lexically, because they have
+;; been alpha-renamed. It makes the transformations *much* easier.
+;; Unfortunately it doesn't work yet.
+(define (optimize* x)
+  (transform-record (<ghil> env loc) x
+    ((quasiquote exp)
+     (define (optimize-qq x)
+       (cond ((list? x) (map optimize-qq x))
+             ((pair? x) (cons (optimize-qq (car x)) (optimize-qq (cdr x))))
+             ((record? x) (optimize x))
+             (else x)))
+     (-> (quasiquote (optimize-qq x))))
+
+    ((unquote exp)
+     (-> (unquote (optimize exp))))
+
+    ((unquote-splicing exp)
+     (-> (unquote-splicing (optimize exp))))
+
+    ((set var val)
+     (-> (set var (optimize val))))
+
+    ((define var val)
+     (-> (define var (optimize val))))
+
+    ((if test then else)
+     (-> (if (optimize test) (optimize then) (optimize else))))
+
+    ((and exps)
+     (-> (and (map optimize exps))))
+
+    ((or exps)
+     (-> (or (map optimize exps))))
+
+    ((begin exps)
+     (-> (begin (map optimize exps))))
+
+    ((bind vars vals body)
+     (-> (bind vars (map optimize vals) (optimize body))))
+
+    ((mv-bind producer vars rest body)
+     (-> (mv-bind (optimize producer) vars rest (optimize body))))
+
+    ((inline inst args)
+     (-> (inline inst (map optimize args))))
+
+    ((call (proc (lambda vars (rest #f) meta body)) args)
+     (-> (bind vars (optimize args) (optimize body))))
+
+    ((call proc args)
+     (-> (call (optimize proc) (map optimize args))))
+
+    ((lambda vars rest meta body)
+     (-> (lambda vars rest meta (optimize body))))
+
+    ((mv-call producer (consumer (lambda vars rest meta body)))
+     (-> (mv-bind (optimize producer) vars rest (optimize body))))
+
+    ((mv-call producer consumer)
+     (-> (mv-call (optimize producer) (optimize consumer))))
+
+    ((values values)
+     (-> (values (map optimize values))))
+
+    ((values* values)
+     (-> (values* (map optimize values))))
+
+    (else
+     (error "unrecognized GHIL" x))))
+
+(define (optimize x)
+  (record-case x
+    ((<ghil-set> env loc var val)
+     (make-ghil-set env var (optimize val)))
+
+    ((<ghil-define> env loc var val)
+     (make-ghil-define env var (optimize val)))
+
+    ((<ghil-if> env loc test then else)
+     (make-ghil-if env loc (optimize test) (optimize then) (optimize else)))
+
+    ((<ghil-and> env loc exps)
+     (make-ghil-and env loc (map optimize exps)))
+
+    ((<ghil-or> env loc exps)
+     (make-ghil-or env loc (map optimize exps)))
+
+    ((<ghil-begin> env loc exps)
+     (make-ghil-begin env loc (map optimize exps)))
+
+    ((<ghil-bind> env loc vars vals body)
+     (make-ghil-bind env loc vars (map optimize vals) (optimize body)))
+
+    ((<ghil-lambda> env loc vars rest meta body)
+     (make-ghil-lambda env loc vars rest meta (optimize body)))
+
+    ((<ghil-inline> env loc instruction args)
+     (make-ghil-inline env loc instruction (map optimize args)))
+
+    ((<ghil-call> env loc proc args)
+     (let ((parent-env env))
+       (record-case proc
+         ;; ((@lambda (VAR...) BODY...) ARG...) =>
+         ;;   (@let ((VAR ARG) ...) BODY...)
+         ((<ghil-lambda> env loc vars rest meta body)
+          (cond
+           ((not rest)
+            (lift-variables! env)
+            (make-ghil-bind parent-env loc (map optimize args)))
+           (else
+            (make-ghil-call parent-env loc (optimize proc) (map optimize args)))))
+         (else
+          (make-ghil-call parent-env loc (optimize proc) (map optimize args))))))
+
+    ((<ghil-mv-call> env loc producer consumer)
+     (record-case consumer
+      ;; (mv-call PRODUCER (lambda ARGS BODY...)) =>
+      ;;   (mv-let PRODUCER ARGS BODY...)
+      ((<ghil-lambda> env loc vars rest meta body)
+       (lift-variables! env)
+       (make-ghil-mv-bind producer vars rest body))
+      (else
+       (make-ghil-mv-call env loc (optimize producer) (optimize consumer)))))
+
+    (else x)))
+
+
+;;;
+;;; Stage 3: Code generation
+;;;
+
+(define *ia-void* (make-glil-void))
+(define *ia-drop* (make-glil-call 'drop 1))
+(define *ia-return* (make-glil-call 'return 1))
+
+(define (make-label) (gensym ":L"))
+
+(define (make-glil-var op env var)
+  (case (ghil-var-kind var)
+    ((argument)
+     (make-glil-local op (ghil-var-index var)))
+    ((local)
+     (make-glil-local op (ghil-var-index var)))
+    ((external)
+     (do ((depth 0 (1+ depth))
+	  (e env (ghil-env-parent e)))
+	 ((eq? e (ghil-var-env var))
+	  (make-glil-external op depth (ghil-var-index var)))))
+    ((toplevel)
+     (make-glil-toplevel op (ghil-var-name var)))
+    ((public private)
+     (make-glil-module op (ghil-var-env var) (ghil-var-name var)
+                       (eq? (ghil-var-kind var) 'public)))
+    (else (error "Unknown kind of variable:" var))))
+
+(define (constant? x)
+  (cond ((or (number? x) (string? x) (symbol? x) (keyword? x) (boolean? x)) #t)
+        ((pair? x) (and (constant? (car x))
+                        (constant? (cdr x))))
+        ((vector? x) (let lp ((i (vector-length x)))
+                       (or (zero? i)
+                           (and (constant? (vector-ref x (1- i)))
+                                (lp (1- i))))))))
+
+(define (codegen ghil)
+  (let ((stack '()))
+    (define (push-code! loc code)
+      (set! stack (cons code stack))
+      (if loc (set! stack (cons (make-glil-source loc) stack))))
+    (define (var->binding var)
+      (list (ghil-var-name var) (let ((kind (ghil-var-kind var)))
+                                  (case kind ((argument) 'local) (else kind)))
+            (ghil-var-index var)))
+    (define (push-bindings! loc vars)
+      (if (not (null? vars))
+          (push-code! loc (make-glil-bind (map var->binding vars)))))
+    (define (comp tree tail drop)
+      (define (push-label! label)
+	(push-code! #f (make-glil-label label)))
+      (define (push-branch! loc inst label)
+	(push-code! loc (make-glil-branch inst label)))
+      (define (push-call! loc inst args)
+	(for-each comp-push args)
+	(push-code! loc (make-glil-call inst (length args))))
+      ;; possible tail position
+      (define (comp-tail tree) (comp tree tail drop))
+      ;; push the result
+      (define (comp-push tree) (comp tree #f #f))
+      ;; drop the result
+      (define (comp-drop tree) (comp tree #f #t))
+      ;; drop the result if unnecessary
+      (define (maybe-drop)
+	(if drop (push-code! #f *ia-drop*)))
+      ;; return here if necessary
+      (define (maybe-return)
+	(if tail (push-code! #f *ia-return*)))
+      ;; return this code if necessary
+      (define (return-code! loc code)
+	(if (not drop) (push-code! loc code))
+	(maybe-return))
+      ;; return void if necessary
+      (define (return-void!)
+	(return-code! #f *ia-void*))
+      ;; return object if necessary
+      (define (return-object! loc obj)
+	(return-code! loc (make-glil-const obj)))
+      ;;
+      ;; dispatch
+      (record-case tree
+	((<ghil-void>)
+	 (return-void!))
+
+	((<ghil-quote> env loc obj)
+	 (return-object! loc obj))
+
+	((<ghil-quasiquote> env loc exp)
+	 (let loop ((x exp) (in-car? #f))
+           (cond
+            ((list? x)
+             (push-call! #f 'mark '())
+             (for-each (lambda (x) (loop x #t)) x)
+             (push-call! #f 'list-mark '()))
+            ((pair? x)
+             (push-call! #f 'mark '())
+             (loop (car x) #t)
+             (loop (cdr x) #f)
+             (push-call! #f 'cons-mark '()))
+            ((record? x)
+             (record-case x
+              ((<ghil-unquote> env loc exp)
+               (comp-push exp))
+              ((<ghil-unquote-splicing> env loc exp)
+               (if (not in-car?)
+                   (error "unquote-splicing in the cdr of a pair" exp))
+               (comp-push exp)
+               (push-call! #f 'list-break '()))))
+            ((constant? x)
+             (push-code! #f (make-glil-const x)))
+            (else
+             (error "element of quasiquote can't be compiled" x))))
+	 (maybe-drop)
+	 (maybe-return))
+
+	((<ghil-unquote> env loc exp)
+         (error "unquote outside of quasiquote" exp))
+
+	((<ghil-unquote-splicing> env loc exp)
+         (error "unquote-splicing outside of quasiquote" exp))
+
+	((<ghil-ref> env loc var)
+	 (return-code! loc (make-glil-var 'ref env var)))
+
+	((<ghil-set> env loc var val)
+	 (comp-push val)
+	 (push-code! loc (make-glil-var 'set env var))
+	 (return-void!))
+
+	((<ghil-define> env loc var val)
+	 (comp-push val)
+	 (push-code! loc (make-glil-var 'define env var))
+	 (return-void!))
+
+	((<ghil-if> env loc test then else)
+	 ;;     TEST
+	 ;;     (br-if-not L1)
+	 ;;     THEN
+	 ;;     (br L2)
+	 ;; L1: ELSE
+	 ;; L2:
+	 (let ((L1 (make-label)) (L2 (make-label)))
+	   (comp-push test)
+	   (push-branch! loc 'br-if-not L1)
+	   (comp-tail then)
+	   (if (not tail) (push-branch! #f 'br L2))
+	   (push-label! L1)
+	   (comp-tail else)
+	   (if (not tail) (push-label! L2))))
+
+	((<ghil-and> env loc exps)
+	 ;;     EXP
+	 ;;     (br-if-not L1)
+	 ;;     ...
+	 ;;     TAIL
+	 ;;     (br L2)
+	 ;; L1: (const #f)
+	 ;; L2:
+         (cond ((null? exps) (return-object! loc #t))
+               ((null? (cdr exps)) (comp-tail (car exps)))
+               (else
+                (let ((L1 (make-label)) (L2 (make-label)))
+                  (let lp ((exps exps))
+                    (cond ((null? (cdr exps))
+                           (comp-tail (car exps))
+                           (push-branch! #f 'br L2)
+                           (push-label! L1)
+                           (return-object! #f #f)
+                           (push-label! L2)
+                           (maybe-return))
+                          (else
+                           (comp-push (car exps))
+                           (push-branch! #f 'br-if-not L1)
+                           (lp (cdr exps)))))))))
+
+	((<ghil-or> env loc exps)
+	 ;;     EXP
+	 ;;     (dup)
+	 ;;     (br-if L1)
+	 ;;     (drop)
+	 ;;     ...
+	 ;;     TAIL
+	 ;; L1:
+         (cond ((null? exps) (return-object! loc #f))
+               ((null? (cdr exps)) (comp-tail (car exps)))
+               (else
+                (let ((L1 (make-label)))
+                  (let lp ((exps exps))
+                    (cond ((null? (cdr exps))
+                           (comp-tail (car exps))
+                           (push-label! L1)
+                           (maybe-return))
+                          (else
+                           (comp-push (car exps))
+                           (if (not drop)
+                               (push-call! #f 'dup '()))
+                           (push-branch! #f 'br-if L1)
+                           (if (not drop)
+                               (push-code! loc (make-glil-call 'drop 1)))
+                           (lp (cdr exps)))))))))
+
+	((<ghil-begin> env loc exps)
+	 ;; EXPS...
+	 ;; TAIL
+	 (if (null? exps)
+	     (return-void!)
+	     (do ((exps exps (cdr exps)))
+		 ((null? (cdr exps))
+		  (comp-tail (car exps)))
+	       (comp-drop (car exps)))))
+
+	((<ghil-bind> env loc vars vals body)
+	 ;; VALS...
+	 ;; (set VARS)...
+	 ;; BODY
+	 (for-each comp-push vals)
+         (push-bindings! loc vars)
+	 (for-each (lambda (var) (push-code! #f (make-glil-var 'set env var)))
+		   (reverse vars))
+	 (comp-tail body)
+	 (push-code! #f (make-glil-unbind)))
+
+	((<ghil-mv-bind> env loc producer vars rest body)
+	 ;; VALS...
+	 ;; (set VARS)...
+	 ;; BODY
+         (let ((MV (make-label)))
+           (comp-push producer)
+           (push-code! loc (make-glil-mv-call 0 MV))
+           (push-code! #f (make-glil-const 1))
+           (push-label! MV)
+           (push-code! #f (make-glil-mv-bind (map var->binding vars) rest))
+           (for-each (lambda (var) (push-code! #f (make-glil-var 'set env var)))
+                     (reverse vars)))
+         (comp-tail body)
+         (push-code! #f (make-glil-unbind)))
+
+	((<ghil-lambda> env loc vars rest meta body)
+	 (return-code! loc (codegen tree)))
+
+	((<ghil-inline> env loc inline args)
+	 ;; ARGS...
+	 ;; (INST NARGS)
+         (let ((tail-table '((call . goto/args)
+                             (apply . goto/apply)
+                             (call/cc . goto/cc))))
+           (cond ((and tail (assq-ref tail-table inline))
+                  => (lambda (tail-inst)
+                       (push-call! loc tail-inst args)))
+                 (else
+                  (push-call! loc inline args)
+                  (maybe-drop)
+                  (maybe-return)))))
+
+        ((<ghil-values> env loc values)
+         (cond (tail ;; (lambda () (values 1 2))
+                (push-call! loc 'return/values values))
+               (drop ;; (lambda () (values 1 2) 3)
+                (for-each comp-drop values))
+               (else ;; (lambda () (list (values 10 12) 1))
+                (push-code! #f (make-glil-const 'values))
+                (push-code! #f (make-glil-call 'link-now 1))
+                (push-code! #f (make-glil-call 'variable-ref 0))
+                (push-call! loc 'call values))))
+                
+        ((<ghil-values*> env loc values)
+         (cond (tail ;; (lambda () (apply values '(1 2)))
+                (push-call! loc 'return/values* values))
+               (drop ;; (lambda () (apply values '(1 2)) 3)
+                (for-each comp-drop values))
+               (else ;; (lambda () (list (apply values '(10 12)) 1))
+                (push-code! #f (make-glil-const 'values))
+                (push-code! #f (make-glil-call 'link-now 1))
+                (push-code! #f (make-glil-call 'variable-ref 0))
+                (push-call! loc 'apply values))))
+                
+	((<ghil-call> env loc proc args)
+	 ;; PROC
+	 ;; ARGS...
+	 ;; ([tail-]call NARGS)
+	 (comp-push proc)
+         (let ((nargs (length args)))
+           (cond ((< nargs 255)
+                  (push-call! loc (if tail 'goto/args 'call) args))
+                 (else
+                  (push-call! loc 'mark '())
+                  (for-each comp-push args)
+                  (push-call! loc 'list-mark '())
+                  (push-code! loc (make-glil-call (if tail 'goto/apply 'apply) 2)))))
+	 (maybe-drop))
+
+	((<ghil-mv-call> env loc producer consumer)
+	 ;; CONSUMER
+         ;; PRODUCER
+         ;; (mv-call MV)
+         ;; ([tail]-call 1)
+         ;; goto POST
+         ;; MV: [tail-]call/nargs
+         ;; POST: (maybe-drop)
+         (let ((MV (make-label)) (POST (make-label)))
+           (comp-push consumer)
+           (comp-push producer)
+           (push-code! loc (make-glil-mv-call 0 MV))
+           (push-code! loc (make-glil-call (if tail 'goto/args 'call) 1))
+           (cond ((not tail)
+                  (push-branch! #f 'br POST)))
+           (push-label! MV)
+           (push-code! loc (make-glil-call (if tail 'goto/nargs 'call/nargs) 0))
+           (cond ((not tail)
+                  (push-label! POST)
+                  (maybe-drop)))))
+
+        ((<ghil-reified-env> env loc)
+         (return-object! loc (ghil-env-reify env)))))
+
+    ;;
+    ;; main
+    (record-case ghil
+      ((<ghil-lambda> env loc vars rest meta body)
+       (let* ((evars (ghil-env-variables env))
+	      (locs (pick (lambda (v) (eq? (ghil-var-kind v) 'local)) evars))
+	      (exts (pick (lambda (v) (eq? (ghil-var-kind v) 'external)) evars))
+              (nargs (allocate-indices-linearly! vars))
+              (nlocs (allocate-locals! locs body nargs))
+              (nexts (allocate-indices-linearly! exts)))
+	 ;; meta bindings
+         (push-bindings! #f vars)
+         ;; push on definition source location
+         (if loc (set! stack (cons (make-glil-source loc) stack)))
+	 ;; copy args to the heap if they're marked as external
+	 (do ((n 0 (1+ n))
+	      (l vars (cdr l)))
+	     ((null? l))
+	   (let ((v (car l)))
+	     (case (ghil-var-kind v)
+               ((external)
+                (push-code! #f (make-glil-local 'ref n))
+                (push-code! #f (make-glil-external 'set 0 (ghil-var-index v)))))))
+	 ;; compile body
+	 (comp body #t #f)
+	 ;; create GLIL
+         (make-glil-program nargs (if rest 1 0) nlocs nexts meta
+                            (reverse! stack)))))))
+
+(define (allocate-indices-linearly! vars)
+  (do ((n 0 (1+ n))
+       (l vars (cdr l)))
+      ((null? l) n)
+    (let ((v (car l))) (set! (ghil-var-index v) n))))
+
+(define (allocate-locals! vars body nargs)
+  (let ((free '()) (nlocs nargs))
+    (define (allocate! var)
+      (cond
+       ((pair? free)
+        (set! (ghil-var-index var) (car free))
+        (set! free (cdr free)))
+       (else
+        (set! (ghil-var-index var) nlocs)
+        (set! nlocs (1+ nlocs)))))
+    (define (deallocate! var)
+      (set! free (cons (ghil-var-index var) free)))
+    (let lp ((x body))
+      (record-case x
+        ((<ghil-void>))
+        ((<ghil-quote>))
+	((<ghil-quasiquote> exp)
+	 (let qlp ((x exp))
+           (cond ((list? x) (for-each qlp x))
+                 ((pair? x) (qlp (car x)) (qlp (cdr x)))
+                 ((record? x)
+                  (record-case x
+                   ((<ghil-unquote> exp) (lp exp))
+                   ((<ghil-unquote-splicing> exp) (lp exp)))))))
+        ((<ghil-unquote> exp)
+         (lp exp))
+        ((<ghil-unquote-splicing> exp)
+         (lp exp))
+        ((<ghil-reified-env>))
+        ((<ghil-set> val)
+         (lp val))
+        ((<ghil-ref>))
+        ((<ghil-define> val)
+         (lp val))
+        ((<ghil-if> test then else)
+         (lp test) (lp then) (lp else))
+        ((<ghil-and> exps)
+         (for-each lp exps))
+        ((<ghil-or> exps)
+         (for-each lp exps))
+        ((<ghil-begin> exps)
+         (for-each lp exps))
+        ((<ghil-bind> vars vals body)
+         (for-each allocate! vars)
+         (for-each lp vals)
+         (lp body)
+         (for-each deallocate! vars))
+        ((<ghil-mv-bind> vars producer body)
+         (lp producer)
+         (for-each allocate! vars)
+         (lp body)
+         (for-each deallocate! vars))
+        ((<ghil-inline> args)
+         (for-each lp args))
+        ((<ghil-call> proc args)
+         (lp proc)
+         (for-each lp args))
+        ((<ghil-lambda>))
+        ((<ghil-mv-call> producer consumer)
+         (lp producer)
+         (lp consumer))
+        ((<ghil-values> values)
+         (for-each lp values))
+        ((<ghil-values*> values)
+         (for-each lp values))))
+    nlocs))
diff --git a/module/language/ghil/spec.scm b/module/language/ghil/spec.scm
new file mode 100644
index 000000000..f2bc19b61
--- /dev/null
+++ b/module/language/ghil/spec.scm
@@ -0,0 +1,62 @@
+;;; Guile High Intermediate Language
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (language ghil spec)
+  #:use-module (system base language)
+  #:use-module (language glil)
+  #:use-module (language ghil)
+  #:use-module (language ghil compile-glil)
+  #:export (ghil))
+
+(define (write-ghil exp . port)
+  (apply write (unparse-ghil exp) port))
+
+(define (parse x)
+  (call-with-ghil-environment (make-ghil-toplevel-env (current-module)) '()
+    (lambda (env vars)
+      (make-ghil-lambda env #f vars #f '() (parse-ghil env x)))))
+
+(define (join exps env)
+  (if (or-map (lambda (x)
+                (or (not (ghil-lambda? x))
+                    (ghil-lambda-rest x)
+                    (memq 'argument
+                          (map ghil-var-kind
+                               (ghil-env-variables (ghil-lambda-env x))))))
+              exps)
+      (error "GHIL expressions to join must be thunks"))
+
+  (let ((env (make-ghil-env env '()
+                            (apply append
+                                   (map ghil-env-variables
+                                        (map ghil-lambda-env exps))))))
+    (make-ghil-lambda env #f '() #f '()
+                      (make-ghil-begin env #f
+                                       (map ghil-lambda-body exps)))))
+
+(define-language ghil
+  #:title	"Guile High Intermediate Language (GHIL)"
+  #:version	"0.3"
+  #:reader	read
+  #:printer	write-ghil
+  #:parser      parse
+  #:joiner      join
+  #:compilers   `((glil . ,compile-glil))
+  )
diff --git a/module/language/glil.scm b/module/language/glil.scm
new file mode 100644
index 000000000..0777073f6
--- /dev/null
+++ b/module/language/glil.scm
@@ -0,0 +1,137 @@
+;;; Guile Low Intermediate Language
+
+;; Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (language glil)
+  #:use-module (system base syntax)
+  #:use-module (system base pmatch)
+  #:use-module ((srfi srfi-1) #:select (fold))
+  #:export
+  (<glil-program> make-glil-program glil-program?
+   glil-program-nargs glil-program-nrest glil-program-nlocs
+   glil-program-meta glil-program-body
+   
+   <glil-bind> make-glil-bind glil-bind?
+   glil-bind-vars
+
+   <glil-mv-bind> make-glil-mv-bind glil-mv-bind?
+   glil-mv-bind-vars glil-mv-bind-rest
+
+   <glil-unbind> make-glil-unbind glil-unbind?
+
+   <glil-source> make-glil-source glil-source?
+   glil-source-props
+
+   <glil-void> make-glil-void glil-void?
+
+   <glil-const> make-glil-const glil-const?
+   glil-const-obj
+
+   <glil-lexical> make-glil-lexical glil-lexical?
+   glil-lexical-local? glil-lexical-boxed? glil-lexical-op glil-lexical-index
+
+   <glil-toplevel> make-glil-toplevel glil-toplevel?
+   glil-toplevel-op glil-toplevel-name
+
+   <glil-module> make-glil-module glil-module?
+   glil-module-op glil-module-mod glil-module-name glil-module-public?
+
+   <glil-label> make-glil-label glil-label?
+   glil-label-label
+
+   <glil-branch> make-glil-branch glil-branch?
+   glil-branch-inst glil-branch-label
+
+   <glil-call> make-glil-call glil-call?
+   glil-call-inst glil-call-nargs
+
+   <glil-mv-call> make-glil-mv-call glil-mv-call?
+   glil-mv-call-nargs glil-mv-call-ra
+
+   parse-glil unparse-glil))
+
+(define (print-glil x port)
+  (format port "#<glil ~s>" (unparse-glil x)))
+
+(define-type (<glil> #:printer print-glil)
+  ;; Meta operations
+  (<glil-program> nargs nrest nlocs meta body)
+  (<glil-bind> vars)
+  (<glil-mv-bind> vars rest)
+  (<glil-unbind>)
+  (<glil-source> props)
+  ;; Objects
+  (<glil-void>)
+  (<glil-const> obj)
+  ;; Variables
+  (<glil-lexical> local? boxed? op index)
+  (<glil-toplevel> op name)
+  (<glil-module> op mod name public?)
+  ;; Controls
+  (<glil-label> label)
+  (<glil-branch> inst label)
+  (<glil-call> inst nargs)
+  (<glil-mv-call> nargs ra))
+
+
+
+(define (parse-glil x)
+  (pmatch x
+    ((program ,nargs ,nrest ,nlocs ,meta . ,body)
+     (make-glil-program nargs nrest nlocs meta (map parse-glil body)))
+    ((bind . ,vars) (make-glil-bind vars))
+    ((mv-bind ,vars ,rest) (make-glil-mv-bind vars rest))
+    ((unbind) (make-glil-unbind))
+    ((source ,props) (make-glil-source props))
+    ((void) (make-glil-void))
+    ((const ,obj) (make-glil-const obj))
+    ((lexical ,local? ,boxed? ,op ,index) (make-glil-lexical local? boxed? op index))
+    ((toplevel ,op ,name) (make-glil-toplevel op name))
+    ((module public ,op ,mod ,name) (make-glil-module op mod name #t))
+    ((module private ,op ,mod ,name) (make-glil-module op mod name #f))
+    ((label ,label) (make-label label))
+    ((branch ,inst ,label) (make-glil-branch inst label))
+    ((call ,inst ,nargs) (make-glil-call inst nargs))
+    ((mv-call ,nargs ,ra) (make-glil-mv-call nargs ra))
+    (else (error "invalid glil" x))))
+
+(define (unparse-glil glil)
+  (record-case glil
+    ;; meta
+    ((<glil-program> nargs nrest nlocs meta body)
+     `(program ,nargs ,nrest ,nlocs ,meta ,@(map unparse-glil body)))
+    ((<glil-bind> vars) `(bind ,@vars))
+    ((<glil-mv-bind> vars rest) `(mv-bind ,vars ,rest))
+    ((<glil-unbind>) `(unbind))
+    ((<glil-source> props) `(source ,props))
+    ;; constants
+    ((<glil-void>) `(void))
+    ((<glil-const> obj) `(const ,obj))
+    ;; variables
+    ((<glil-lexical> local? boxed? op index)
+     `(lexical ,local? ,boxed? ,op ,index))
+    ((<glil-toplevel> op name)
+     `(toplevel ,op ,name))
+    ((<glil-module> op mod name public?)
+     `(module ,(if public? 'public 'private) ,op ,mod ,name))
+    ;; controls
+    ((<glil-label> label) `(label ,label))
+    ((<glil-branch> inst label) `(branch ,inst ,label))
+    ((<glil-call> inst nargs) `(call ,inst ,nargs))
+    ((<glil-mv-call> nargs ra) `(mv-call ,nargs ,ra))))
diff --git a/module/language/glil/compile-assembly.scm b/module/language/glil/compile-assembly.scm
new file mode 100644
index 000000000..121d9db9f
--- /dev/null
+++ b/module/language/glil/compile-assembly.scm
@@ -0,0 +1,446 @@
+;;; Guile VM assembler
+
+;; Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (language glil compile-assembly)
+  #:use-module (system base syntax)
+  #:use-module (system base pmatch)
+  #:use-module (language glil)
+  #:use-module (language assembly)
+  #:use-module (system vm instruction)
+  #:use-module ((system vm program) #:select (make-binding))
+  #:use-module (ice-9 receive)
+  #:use-module ((srfi srfi-1) #:select (fold))
+  #:use-module (rnrs bytevector)
+  #:export (compile-assembly))
+
+;; Variable cache cells go in the object table, and serialize as their
+;; keys. The reason we wrap the keys in these records is so they don't
+;; compare as `equal?' to other objects in the object table.
+;;
+;; `key' is either a symbol or the list (MODNAME SYM PUBLIC?)
+
+(define-record <variable-cache-cell> key)
+
+;; Subprograms can be loaded into an object table as well. We need a
+;; disjoint type here too. (Subprograms have their own object tables --
+;; though probably we should just make one table per compilation unit.)
+
+(define-record <subprogram> table prog)
+
+
+(define (limn-sources sources)
+  (let lp ((in sources) (out '()) (filename #f))
+    (if (null? in)
+        (reverse! out)
+        (let ((addr (caar in))
+              (new-filename (assq-ref (cdar in ) 'filename))
+              (line (assq-ref (cdar in) 'line))
+              (column (assq-ref (cdar in) 'column)))
+          (cond
+           ((not (equal? new-filename filename))
+            (lp (cdr in)
+                `((,addr . (,line . ,column))
+                  (filename . ,new-filename)
+                  . ,out)
+                new-filename))
+           ((or (null? out) (not (equal? (cdar out) `(,line . ,column))))
+            (lp (cdr in)
+                `((,addr . (,line . ,column))
+                  . ,out)
+                filename))
+           (else
+            (lp (cdr in) out filename)))))))
+
+(define (make-meta bindings sources tail)
+  (if (and (null? bindings) (null? sources) (null? tail))
+      #f
+      (compile-assembly
+       (make-glil-program 0 0 0 '()
+                          (list
+                           (make-glil-const `(,bindings ,sources ,@tail))
+                           (make-glil-call 'return 1))))))
+
+;; A functional stack of names of live variables.
+(define (make-open-binding name boxed? index)
+  (list name boxed? index))
+(define (make-closed-binding open-binding start end)
+  (make-binding (car open-binding) (cadr open-binding)
+                (caddr open-binding) start end))
+(define (open-binding bindings vars start)
+  (cons
+   (acons start
+          (map
+           (lambda (v)
+             (pmatch v
+               ((,name ,boxed? ,i)
+                (make-open-binding name boxed? i))
+               (else (error "unknown binding type" v))))
+           vars)
+          (car bindings))
+   (cdr bindings)))
+(define (close-binding bindings end)
+  (pmatch bindings
+    ((((,start . ,closing) . ,open) . ,closed)
+     (cons open
+           (fold (lambda (o tail)
+                   ;; the cons is for dsu sort
+                   (acons start (make-closed-binding o start end)
+                          tail))
+                 closed
+                 closing)))
+    (else (error "broken bindings" bindings))))
+(define (close-all-bindings bindings end)
+  (if (null? (car bindings))
+      (map cdr
+           (stable-sort (reverse (cdr bindings))
+                        (lambda (x y) (< (car x) (car y)))))
+      (close-all-bindings (close-binding bindings end) end)))
+
+;; A functional object table.
+(define *module* 1)
+(define (assoc-ref-or-acons alist x make-y)
+  (cond ((assoc-ref alist x)
+         => (lambda (y) (values y alist)))
+        (else
+         (let ((y (make-y x alist)))
+           (values y (acons x y alist))))))
+(define (object-index-and-alist x alist)
+  (assoc-ref-or-acons alist x
+                      (lambda (x alist)
+                        (+ (length alist) *module*))))
+
+(define (compile-assembly glil)
+  (receive (code . _)
+      (glil->assembly glil #t '(()) '() '() #f -1)
+    (car code)))
+(define (make-object-table objects)
+  (and (not (null? objects))
+       (list->vector (cons #f objects))))
+
+(define (glil->assembly glil toplevel? bindings
+                        source-alist label-alist object-alist addr)
+  (define (emit-code x)
+    (values x bindings source-alist label-alist object-alist))
+  (define (emit-code/object x object-alist)
+    (values x bindings source-alist label-alist object-alist))
+
+  (record-case glil
+    ((<glil-program> nargs nrest nlocs meta body)
+     (define (process-body)
+       (let lp ((body body) (code '()) (bindings '(())) (source-alist '())
+                (label-alist '()) (object-alist (if toplevel? #f '())) (addr 0))
+         (cond
+          ((null? body)
+           (values (reverse code)
+                   (close-all-bindings bindings addr)
+                   (limn-sources (reverse! source-alist))
+                   (reverse label-alist)
+                   (and object-alist (map car (reverse object-alist)))
+                   addr))
+          (else
+           (receive (subcode bindings source-alist label-alist object-alist)
+               (glil->assembly (car body) #f bindings
+                               source-alist label-alist object-alist addr)
+             (lp (cdr body) (append (reverse subcode) code)
+                 bindings source-alist label-alist object-alist
+                 (addr+ addr subcode)))))))
+
+     (receive (code bindings sources labels objects len)
+         (process-body)
+       (let* ((meta (make-meta bindings sources meta))
+              (meta-pad (if meta (modulo (- 8 (modulo len 8)) 8) 0))
+              (prog `(load-program ,nargs ,nrest ,nlocs ,labels
+                                  ,(+ len meta-pad)
+                                  ,meta
+                                  ,@code
+                                  ,@(if meta
+                                        (make-list meta-pad '(nop))
+                                        '()))))
+         (cond
+          (toplevel?
+           ;; toplevel bytecode isn't loaded by the vm, no way to do
+           ;; object table or closure capture (not in the bytecode,
+           ;; anyway)
+           (emit-code (align-program prog addr)))
+          (else
+           (let ((table (make-object-table objects)))
+             (cond
+              (object-alist
+               ;; if we are being compiled from something with an object
+               ;; table, cache the program there
+               (receive (i object-alist)
+                   (object-index-and-alist (make-subprogram table prog)
+                                           object-alist)
+                 (emit-code/object `(,(if (< i 256)
+                                          `(object-ref ,i)
+                                          `(long-object-ref ,(quotient i 256)
+                                                            ,(modulo i 256))))
+                                   object-alist)))
+              (else
+               ;; otherwise emit a load directly
+               (let ((table-code (dump-object table addr)))
+                 (emit-code
+                  `(,@table-code
+                    ,@(align-program prog (addr+ addr table-code)))))))))))))
+    
+    ((<glil-bind> vars)
+     (values '()
+             (open-binding bindings vars addr)
+             source-alist
+             label-alist
+             object-alist))
+
+    ((<glil-mv-bind> vars rest)
+     (values `((truncate-values ,(length vars) ,(if rest 1 0)))
+             (open-binding bindings vars addr)
+             source-alist
+             label-alist
+             object-alist))
+
+    ((<glil-unbind>)
+     (values '()
+             (close-binding bindings addr)
+             source-alist
+             label-alist
+             object-alist))
+             
+    ((<glil-source> props)
+     (values '()
+             bindings
+             (acons addr props source-alist)
+             label-alist
+             object-alist))
+
+    ((<glil-void>)
+     (emit-code '((void))))
+
+    ((<glil-const> obj)
+     (cond
+      ((object->assembly obj)
+       => (lambda (code)
+            (emit-code (list code))))
+      ((not object-alist)
+       (emit-code (dump-object obj addr)))
+      (else
+       (receive (i object-alist)
+           (object-index-and-alist obj object-alist)
+         (emit-code/object (if (< i 256)
+                               `((object-ref ,i))
+                               `((long-object-ref ,(quotient i 256)
+                                                  ,(modulo i 256))))
+                           object-alist)))))
+
+    ((<glil-lexical> local? boxed? op index)
+     (emit-code
+      (if local?
+          (if (< index 256)
+              (case op
+                ((ref) (if boxed?
+                           `((local-boxed-ref ,index))
+                           `((local-ref ,index))))
+                ((set) (if boxed?
+                           `((local-boxed-set ,index))
+                           `((local-set ,index))))
+                ((box) `((box ,index)))
+                ((empty-box) `((empty-box ,index)))
+                ((fix) `((fix-closure 0 ,index)))
+                (else (error "what" op)))
+              (let ((a (quotient i 256))
+                    (b (modulo i 256)))
+                `((,(case op
+                      ((ref)
+                       (if boxed?
+                           `((long-local-ref ,a ,b)
+                             (variable-ref))
+                           `((long-local-ref ,a ,b))))
+                      ((set)
+                       (if boxed?
+                           `((long-local-ref ,a ,b)
+                             (variable-set))
+                           `((long-local-set ,a ,b))))
+                      ((box)
+                       `((make-variable)
+                         (variable-set)
+                         (long-local-set ,a ,b)))
+                      ((empty-box)
+                       `((make-variable)
+                         (long-local-set ,a ,b)))
+                      ((fix)
+                       `((fix-closure ,a ,b)))
+                      (else (error "what" op)))
+                   ,index))))
+          `((,(case op
+                ((ref) (if boxed? 'free-boxed-ref 'free-ref))
+                ((set) (if boxed? 'free-boxed-set (error "what." glil)))
+                (else (error "what" op)))
+             ,index)))))
+    
+    ((<glil-toplevel> op name)
+     (case op
+       ((ref set)
+        (cond
+         ((not object-alist)
+          (emit-code `(,@(dump-object name addr)
+                       (link-now)
+                       ,(case op 
+                          ((ref) '(variable-ref))
+                          ((set) '(variable-set))))))
+         (else
+          (receive (i object-alist)
+              (object-index-and-alist (make-variable-cache-cell name)
+                                      object-alist)
+            (emit-code/object (if (< i 256)
+                                  `((,(case op
+                                        ((ref) 'toplevel-ref)
+                                        ((set) 'toplevel-set))
+                                     ,i))
+                                  `((,(case op
+                                        ((ref) 'long-toplevel-ref)
+                                        ((set) 'long-toplevel-set))
+                                     ,(quotient i 256)
+                                     ,(modulo i 256))))
+                              object-alist)))))
+       ((define)
+        (emit-code `(,@(dump-object name addr)
+                     (define))))
+       (else
+        (error "unknown toplevel var kind" op name))))
+
+    ((<glil-module> op mod name public?)
+     (let ((key (list mod name public?)))
+       (case op
+         ((ref set)
+          (cond
+           ((not object-alist)
+            (emit-code `(,@(dump-object key addr)
+                         (link-now)
+                         ,(case op 
+                            ((ref) '(variable-ref))
+                            ((set) '(variable-set))))))
+           (else
+            (receive (i object-alist)
+                (object-index-and-alist (make-variable-cache-cell key)
+                                        object-alist)
+              (emit-code/object (case op
+                                  ((ref) `((toplevel-ref ,i)))
+                                  ((set) `((toplevel-set ,i))))
+                                object-alist)))))
+         (else
+          (error "unknown module var kind" op key)))))
+
+    ((<glil-label> label)
+     (let ((code (align-block addr)))
+       (values code
+               bindings
+               source-alist
+               (acons label (addr+ addr code) label-alist)
+               object-alist)))
+
+    ((<glil-branch> inst label)
+     (emit-code `((,inst ,label))))
+
+    ;; nargs is number of stack args to insn. probably should rename.
+    ((<glil-call> inst nargs)
+     (if (not (instruction? inst))
+         (error "Unknown instruction:" inst))
+     (let ((pops (instruction-pops inst)))
+       (cond ((< pops 0)
+              (case (instruction-length inst)
+                ((1) (emit-code `((,inst ,nargs))))
+                ((2) (emit-code `((,inst ,(quotient nargs 256)
+                                         ,(modulo nargs 256)))))
+                (else (error "Unknown length for variable-arg instruction:"
+                             inst (instruction-length inst)))))
+             ((= pops nargs)
+              (emit-code `((,inst))))
+             (else
+              (error "Wrong number of stack arguments to instruction:" inst nargs)))))
+
+    ((<glil-mv-call> nargs ra)
+     (emit-code `((mv-call ,nargs ,ra))))))
+
+(define (dump-object x addr)
+  (define (too-long x)
+    (error (string-append x " too long")))
+
+  (cond
+   ((object->assembly x) => list)
+   ((variable-cache-cell? x) (dump-object (variable-cache-cell-key x) addr))
+   ((subprogram? x)
+    (let ((table-code (dump-object (subprogram-table x) addr)))
+      `(,@table-code
+        ,@(align-program (subprogram-prog x)
+                         (addr+ addr table-code)))))
+   ((number? x)
+    `((load-number ,(number->string x))))
+   ((string? x)
+    (case (string-bytes-per-char x)
+      ((1) `((load-string ,x)))
+      ((4) (align-code `(load-wide-string ,x) addr 4 4))
+      (else (error "bad string bytes per char" x))))
+   ((symbol? x)
+    (let ((str (symbol->string x)))
+      (case (string-bytes-per-char str)
+        ((1) `((load-symbol ,str)))
+        ((4) `(,@(dump-object str addr)
+               (make-symbol)))
+        (else (error "bad string bytes per char" str)))))
+   ((keyword? x)
+    `(,@(dump-object (keyword->symbol x) addr)
+      (make-keyword)))
+   ((list? x)
+    (let ((tail (let ((len (length x)))
+                  (if (>= len 65536) (too-long "list"))
+                  `((list ,(quotient len 256) ,(modulo len 256))))))
+      (let dump-objects ((objects x) (codes '()) (addr addr))
+        (if (null? objects)
+            (fold append tail codes)
+            (let ((code (dump-object (car objects) addr)))
+              (dump-objects (cdr objects) (cons code codes)
+                            (addr+ addr code)))))))
+   ((pair? x)
+    (let ((kar (dump-object (car x) addr)))
+      `(,@kar
+        ,@(dump-object (cdr x) (addr+ addr kar))
+        (cons))))
+   ((vector? x)
+    (let* ((len (vector-length x))
+           (tail (if (>= len 65536)
+                     (too-long "vector")
+                     `((vector ,(quotient len 256) ,(modulo len 256))))))
+      (let dump-objects ((i 0) (codes '()) (addr addr))
+        (if (>= i len)
+            (fold append tail codes)
+            (let ((code (dump-object (vector-ref x i) addr)))
+              (dump-objects (1+ i) (cons code codes)
+                            (addr+ addr code)))))))
+   ((and (array? x) (symbol? (array-type x)))
+    (let* ((type (dump-object (array-type x) addr))
+           (shape (dump-object (array-shape x) (addr+ addr type))))
+      `(,@type
+        ,@shape
+        ,@(align-code
+           `(load-array ,(uniform-array->bytevector x))
+           (addr+ (addr+ addr type) shape)
+           8
+           4))))
+   (else
+    (error "assemble: unrecognized object" x))))
+
diff --git a/module/language/glil/decompile-assembly.scm b/module/language/glil/decompile-assembly.scm
new file mode 100644
index 000000000..3cb887d44
--- /dev/null
+++ b/module/language/glil/decompile-assembly.scm
@@ -0,0 +1,190 @@
+;;; Guile VM code converters
+
+;; Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (language glil decompile-assembly)
+  #:use-module (system base pmatch)
+  #:use-module (system vm program)
+  #:use-module (language assembly)
+  #:use-module (language glil)
+  #:export (decompile-assembly))
+
+(define (decompile-assembly x env opts)
+  (values (decompile-toplevel x)
+          env))
+
+(define (decompile-toplevel x)
+  (pmatch x
+    ((load-program ,nargs ,nrest ,nlocs ,labels ,len ,meta . ,body)
+     (decompile-load-program nargs nrest nlocs
+                             (decompile-meta meta)
+                             body labels #f))
+    (else
+     (error "invalid assembly" x))))
+
+(define (decompile-meta meta)
+  (and meta
+      (let ((prog (decompile-toplevel meta)))
+        (if (and (glil-program? prog)
+                 (= (length (glil-program-body prog)) 2)
+                 (glil-const? (car (glil-program-body prog))))
+            (glil-const-obj (car (glil-program-body prog)))
+            (error "metadata not a thunk returning a const" prog)))))
+
+(define *placeholder* (list 'placeholder))
+
+(define (emit-constants l out)
+  (let lp ((in (reverse l)) (out out))
+    (cond ((null? in) out)
+          ((eq? (car in) *placeholder*) (lp (cdr in) out))
+          ((glil-program? (car in)) (lp (cdr in) (cons (car in) out)))
+          (else (lp (cdr in) (cons (make-glil-const (car l)) out))))))
+
+(define (decompile-load-program nargs nrest nlocs meta body labels
+                                objects)
+  (let ((glil-labels (sort (map (lambda (x)
+                                  (cons (cdr x) (make-glil-label (car x))))
+                                labels)
+                           (lambda (x y) (< (car x) (car y)))))
+        (bindings (sort (if meta (car meta) '())
+                        (lambda (x y) (< (binding:start x) (binding:start y)))))
+        (unbindings (sort (if meta (car meta) '())
+                          (lambda (x y) (< (binding:end x) (binding:end y)))))
+        (sources (if meta (cadr meta) '()))
+        (filename #f)
+        (props (if meta (cddr meta) '())))
+    (define (pop-bindings! addr)
+      (let lp ((in bindings) (out '()))
+        (if (or (null? in) (> (binding:start (car in)) addr))
+            (begin
+              (set! bindings in)
+              (if (null? out) #f (reverse out)))
+            (lp (cdr in) (cons (car in) out)))))
+    (define (pop-unbindings! addr)
+      (let lp ((in unbindings) (out '()))
+        (if (or (null? in) (> (binding:end (car in)) addr))
+            (begin
+              (set! unbindings in)
+              (if (null? out) #f (reverse out)))
+            (lp (cdr in) (cons (car in) out)))))
+    (define (pop-source! addr)
+      ;; a fragile algorithm.
+      (cond ((null? sources) #f)
+            ((eq? (caar sources) 'filename)
+             (set! filename (cdar sources))
+             (pop-source! addr))
+            ((eqv? (caar sources) addr)
+             (let ((x (car sources)))
+               (set! sources (cdr sources))
+               `((filename . ,filename)
+                 (line . ,(cadr x))
+                 (column . ,(cddr x)))))
+            (else #f)))
+    (let lp ((in body) (stack '()) (out '()) (pos 0))
+      (cond
+       ((null? in)
+        (or (null? stack) (error "leftover stack insts" stack body))
+        (make-glil-program nargs nrest nlocs props (reverse out) #f))
+       ((pop-bindings! pos)
+        => (lambda (bindings)
+             (lp in stack
+                 (cons (make-glil-bind bindings)
+                       out)
+                 pos)))
+       ((pop-unbindings! pos)
+        => (lambda (bindings)
+             (lp in stack (cons (make-glil-unbind) out) pos)))
+       ((pop-source! pos)
+        => (lambda (s)
+             (lp in stack (cons (make-glil-source s) out) pos)))
+       ((and (or (null? out) (not (glil-label? (car out))))
+             (assv-ref glil-labels pos))
+        => (lambda (label)
+             (lp in stack (cons label out) pos)))
+       (else
+        (pmatch (car in)
+          ((nop)
+           (lp (cdr in) stack out (1+ pos)))
+          ((make-false)
+           (lp (cdr in) (cons #f stack) out (1+ pos)))
+          ((load-program ,a ,b ,c ,d ,labels ,sublen ,meta . ,body)
+           (lp (cdr in)
+               (cons (decompile-load-program a b c d (decompile-meta meta)
+                                             body labels (car stack))
+                     (cdr stack))
+               out
+               (+ pos (byte-length (car in)))))
+          ((load-symbol ,str)
+           (lp (cdr in) (cons (string->symbol str) stack) out
+               (+ pos 1 (string-length str))))
+          ((make-int8:0)
+           (lp (cdr in) (cons 0 stack) out (1+ pos)))
+          ((make-int8:1)
+           (lp (cdr in) (cons 1 stack) out (1+ pos)))
+          ((make-int8 ,n)
+           (lp (cdr in) (cons n stack) out (+ pos 2)))
+          ((cons)
+           (let ((head (list-head stack 2))
+                 (stack (list-tail stack 2)))
+             (if (memq *placeholder* head)
+                 (lp (cdr in) (cons *placeholder* stack)
+                     (cons (make-glil-call 'cons 2) (emit-constants head out))
+                     (+ pos 1))
+                 (lp (cdr in) (cons (cons (cadr head) (car head)) stack)
+                     out (+ pos 3)))))
+          ((list ,a ,b)
+           (let* ((len (+ (ash a 8) b))
+                  (head (list-head stack len))
+                  (stack (list-tail stack len)))
+             (if (memq *placeholder* head)
+                 (lp (cdr in) (cons *placeholder* stack)
+                     (cons (make-glil-call 'list len) (emit-constants head out))
+                     (+ pos 3))
+                 (lp (cdr in) (cons (reverse head) stack) out (+ pos 3)))))
+          ((make-eol)
+           (lp (cdr in) (cons '() stack) out (1+ pos)))
+          ((return)
+           (lp (cdr in) (cdr stack)
+               (cons (make-glil-call 'return 1)
+                     (emit-constants (list-head stack 1) out))
+               (1+ pos)))
+          ((local-ref ,n)
+           (lp (cdr in) (cons *placeholder* stack)
+               (cons (make-glil-local 'ref n)
+                     out) (+ pos 2)))
+          ((local-set ,n)
+           (lp (cdr in) (cdr stack)
+               (cons (make-glil-local 'set n)
+                     (emit-constants (list-head stack 1) out))
+               (+ pos 2)))
+          ((br-if-not ,l)
+           (lp (cdr in) (cdr stack)
+               (cons (make-glil-branch 'br-if-not l) out)
+               (+ pos 3)))
+          ((mul)
+           (lp (cdr in) (cons *placeholder* (cddr stack))
+               (cons (make-glil-call 'mul 2)
+                     (emit-constants (list-head stack 2) out))
+               (+ pos 1)))
+          ((goto/args ,n)
+           (lp (cdr in) (list-tail stack (1+ n))
+               (cons (make-glil-call 'goto/args n)
+                     (emit-constants (list-head stack (1+ n)) out))
+               (+ pos 2)))
+          (else (error "unsupported decompilation" (car in)))))))))
diff --git a/module/language/glil/spec.scm b/module/language/glil/spec.scm
new file mode 100644
index 000000000..d5291a211
--- /dev/null
+++ b/module/language/glil/spec.scm
@@ -0,0 +1,41 @@
+;;; Guile Lowlevel Intermediate Language
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (language glil spec)
+  #:use-module (system base language)
+  #:use-module (language glil)
+  #:use-module (language glil compile-assembly)
+  #:use-module (language glil decompile-assembly)
+  #:export (glil))
+
+(define (write-glil exp . port)
+  (apply write (unparse-glil exp) port))
+
+(define (compile-asm x e opts)
+  (values (compile-assembly x) e e))
+
+(define-language glil
+  #:title	"Guile Lowlevel Intermediate Language (GLIL)"
+  #:version	"0.3"
+  #:reader	read
+  #:printer	write-glil
+  #:parser      parse-glil
+  #:compilers   `((assembly . ,compile-asm))
+  #:decompilers `((assembly . ,decompile-assembly)))
diff --git a/module/language/objcode.scm b/module/language/objcode.scm
new file mode 100644
index 000000000..d8bcda879
--- /dev/null
+++ b/module/language/objcode.scm
@@ -0,0 +1,51 @@
+;;; Guile Virtual Machine Object Code
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (language objcode)
+  #:export (encode-length decode-length))
+
+
+;;;
+;;; Variable-length interface
+;;;
+
+;; NOTE: decoded in vm_fetch_length in vm.c as well.
+
+(define (encode-length len)
+  (cond ((< len 254) (u8vector len))
+	((< len (* 256 256))
+	 (u8vector 254 (quotient len 256) (modulo len 256)))
+	((< len most-positive-fixnum)
+	 (u8vector 255
+		   (quotient len (* 256 256 256))
+		   (modulo (quotient len (* 256 256)) 256)
+		   (modulo (quotient len 256) 256)
+		   (modulo len 256)))
+	(else (error "Too long code length:" len))))
+
+(define (decode-length pop)
+  (let ((x (pop)))
+    (cond ((< x 254) x)
+	  ((= x 254) (+ (ash x 8) (pop)))
+	  (else
+           (let* ((b2 (pop))
+                  (b3 (pop))
+                  (b4 (pop)))
+             (+ (ash x 24) (ash b2 16) (ash b3 8) b4))))))
diff --git a/module/language/objcode/spec.scm b/module/language/objcode/spec.scm
new file mode 100644
index 000000000..4cb600f1d
--- /dev/null
+++ b/module/language/objcode/spec.scm
@@ -0,0 +1,92 @@
+;;; Guile Lowlevel Intermediate Language
+
+;; Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (language objcode spec)
+  #:use-module (system base language)
+  #:use-module (system vm objcode)
+  #:use-module (system vm program)
+  #:export (objcode make-objcode-env))
+
+(define (make-objcode-env module externals)
+  (cons module externals))
+
+(define (objcode-env-module env)
+  (if env (car env) (current-module)))
+
+(define (objcode-env-externals env)
+  (and env (vector? (cdr env)) (cdr env)))
+
+(define (objcode->value x e opts)
+  (let ((thunk (make-program x #f (objcode-env-externals e))))
+    (if e
+        (save-module-excursion
+         (lambda ()
+           (set-current-module (objcode-env-module e))
+           (values (thunk) #f e)))
+        (values (thunk) #f e))))
+
+;; since locals are allocated on the stack and can have limited scope,
+;; in many cases we use one local for more than one lexical variable. so
+;; the returned locals set is a list, where element N of the list is
+;; itself a list of bindings for local variable N.
+(define (collapse-locals locs)
+  (let lp ((ret '()) (locs locs))
+    (if (null? locs)
+        (map cdr (sort! ret 
+                        (lambda (x y) (< (car x) (car y)))))
+        (let ((b (car locs)))
+          (cond
+           ((assv-ref ret (binding:index b))
+            => (lambda (bindings)
+                 (append! bindings (list b))
+                 (lp ret (cdr locs))))
+           (else
+            (lp (acons (binding:index b) (list b) ret)
+                (cdr locs))))))))
+
+(define (decompile-value x env opts)
+  (cond
+   ((program? x)
+    (let ((objs  (program-objects x))
+          (meta  (program-meta x))
+          (free-vars  (program-free-variables x))
+          (binds (program-bindings x))
+          (srcs  (program-sources x))
+          (nargs (arity:nargs (program-arity x))))
+      (let ((blocs (and binds (collapse-locals binds))))
+        (values (program-objcode x)
+                `((objects . ,objs)
+                  (meta    . ,(and meta (meta)))
+                  (free-vars . ,free-vars)
+                  (blocs   . ,blocs)
+                  (sources . ,srcs))))))
+   ((objcode? x)
+    (values x #f))
+   (else
+    (error "can't decompile ~A: not a program or objcode" x))))
+
+(define-language objcode
+  #:title	"Guile Object Code"
+  #:version	"0.3"
+  #:reader	#f
+  #:printer	write-objcode
+  #:compilers   `((value . ,objcode->value))
+  #:decompilers `((value . ,decompile-value))
+  )
diff --git a/module/language/r5rs/core.il b/module/language/r5rs/core.il
new file mode 100644
index 000000000..c614a6fe2
--- /dev/null
+++ b/module/language/r5rs/core.il
@@ -0,0 +1,324 @@
+;;; R5RS core environment
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+;; Non standard procedures
+
+(@define void (@lambda () (@void)))
+
+;; 6. Standard procedures
+
+;;; 6.1 Equivalence predicates
+
+(@define eq? (@lambda (x y) (@eq? x y)))
+(@define eqv? (@ Core::eqv?))
+(@define equal? (@ Core::equal?))
+
+;;; 6.2 Numbers
+
+(@define number? (@ Core::number?))
+(@define complex? (@ Core::complex?))
+(@define real? (@ Core::real?))
+(@define rational? (@ Core::rational?))
+(@define integer? (@ Core::integer?))
+
+(@define exact? (@ Core::exact?))
+(@define inexact? (@ Core::inexact?))
+
+(@define = (@ Core::=))
+(@define < (@ Core::<))
+(@define > (@ Core::>))
+(@define <= (@ Core::<=))
+(@define >= (@ Core::>=))
+
+(@define zero? (@ Core::zero?))
+(@define positive? (@ Core::positive?))
+(@define negative? (@ Core::negative?))
+(@define odd? (@ Core::odd?))
+(@define even? (@ Core::even?))
+
+(@define max (@ Core::max))
+(@define min (@ Core::min))
+
+(@define + (@ Core::+))
+(@define * (@ Core::*))
+(@define - (@ Core::-))
+(@define / (@ Core::/))
+
+(@define abs (@ Core::abs))
+
+(@define quotient (@ Core::quotient))
+(@define remainder (@ Core::remainder))
+(@define modulo (@ Core::modulo))
+
+(@define gcd (@ Core::gcd))
+(@define lcm (@ Core::lcm))
+
+;; (@define numerator (@ Core::numerator))
+;; (@define denominator (@ Core::denominator))
+
+(@define floor (@ Core::floor))
+(@define ceiling (@ Core::ceiling))
+(@define truncate (@ Core::truncate))
+(@define round (@ Core::round))
+
+;; (@define rationalize (@ Core::rationalize))
+
+(@define exp (@ Core::exp))
+(@define log (@ Core::log))
+(@define sin (@ Core::sin))
+(@define cos (@ Core::cos))
+(@define tan (@ Core::tan))
+(@define asin (@ Core::asin))
+(@define acos (@ Core::acos))
+(@define atan (@ Core::atan))
+
+(@define sqrt (@ Core::sqrt))
+(@define expt (@ Core::expt))
+
+(@define make-rectangular (@ Core::make-rectangular))
+(@define make-polar (@ Core::make-polar))
+(@define real-part (@ Core::real-part))
+(@define imag-part (@ Core::imag-part))
+(@define magnitude (@ Core::magnitude))
+(@define angle (@ Core::angle))
+
+(@define exact->inexact (@ Core::exact->inexact))
+(@define inexact->exact (@ Core::inexact->exact))
+
+(@define number->string (@ Core::number->string))
+(@define string->number (@ Core::string->number))
+
+;;; 6.3 Other data types
+
+;;;; 6.3.1 Booleans
+
+(@define not (@lambda (x) (@not x)))
+(@define boolean? (@ Core::boolean?))
+
+;;;; 6.3.2 Pairs and lists
+
+(@define pair? (@lambda (x) (@pair? x)))
+(@define cons (@lambda (x y) (@cons x y)))
+
+(@define car (@lambda (x) (@car x)))
+(@define cdr (@lambda (x) (@cdr x)))
+(@define set-car! (@ Core::set-car!))
+(@define set-cdr! (@ Core::set-cdr!))
+
+(@define caar (@lambda (x) (@caar x)))
+(@define cadr (@lambda (x) (@cadr x)))
+(@define cdar (@lambda (x) (@cdar x)))
+(@define cddr (@lambda (x) (@cddr x)))
+(@define caaar (@lambda (x) (@caaar x)))
+(@define caadr (@lambda (x) (@caadr x)))
+(@define cadar (@lambda (x) (@cadar x)))
+(@define caddr (@lambda (x) (@caddr x)))
+(@define cdaar (@lambda (x) (@cdaar x)))
+(@define cdadr (@lambda (x) (@cdadr x)))
+(@define cddar (@lambda (x) (@cddar x)))
+(@define cdddr (@lambda (x) (@cdddr x)))
+(@define caaaar (@lambda (x) (@caaaar x)))
+(@define caaadr (@lambda (x) (@caaadr x)))
+(@define caadar (@lambda (x) (@caadar x)))
+(@define caaddr (@lambda (x) (@caaddr x)))
+(@define cadaar (@lambda (x) (@cadaar x)))
+(@define cadadr (@lambda (x) (@cadadr x)))
+(@define caddar (@lambda (x) (@caddar x)))
+(@define cadddr (@lambda (x) (@cadddr x)))
+(@define cdaaar (@lambda (x) (@cdaaar x)))
+(@define cdaadr (@lambda (x) (@cdaadr x)))
+(@define cdadar (@lambda (x) (@cdadar x)))
+(@define cdaddr (@lambda (x) (@cdaddr x)))
+(@define cddaar (@lambda (x) (@cddaar x)))
+(@define cddadr (@lambda (x) (@cddadr x)))
+(@define cdddar (@lambda (x) (@cdddar x)))
+(@define cddddr (@lambda (x) (@cddddr x)))
+
+(@define null? (@lambda (x) (@null? x)))
+(@define list? (@lambda (x) (@list? x)))
+
+(@define list (@lambda x x))
+
+(@define length (@ Core::length))
+(@define append (@ Core::append))
+(@define reverse (@ Core::reverse))
+(@define list-tail (@ Core::list-tail))
+(@define list-ref (@ Core::list-ref))
+
+(@define memq (@ Core::memq))
+(@define memv (@ Core::memv))
+(@define member (@ Core::member))
+
+(@define assq (@ Core::assq))
+(@define assv (@ Core::assv))
+(@define assoc (@ Core::assoc))
+
+;;;; 6.3.3 Symbols
+
+(@define symbol? (@ Core::symbol?))
+(@define symbol->string (@ Core::symbol->string))
+(@define string->symbol (@ Core::string->symbol))
+
+;;;; 6.3.4 Characters
+
+(@define char? (@ Core::char?))
+(@define char=? (@ Core::char=?))
+(@define char<? (@ Core::char<?))
+(@define char>? (@ Core::char>?))
+(@define char<=? (@ Core::char<=?))
+(@define char>=? (@ Core::char>=?))
+(@define char-ci=? (@ Core::char-ci=?))
+(@define char-ci<? (@ Core::char-ci<?))
+(@define char-ci>? (@ Core::char-ci>?))
+(@define char-ci<=? (@ Core::char-ci<=?))
+(@define char-ci>=? (@ Core::char-ci>=?))
+(@define char-alphabetic? (@ Core::char-alphabetic?))
+(@define char-numeric? (@ Core::char-numeric?))
+(@define char-whitespace? (@ Core::char-whitespace?))
+(@define char-upper-case? (@ Core::char-upper-case?))
+(@define char-lower-case? (@ Core::char-lower-case?))
+(@define char->integer (@ Core::char->integer))
+(@define integer->char (@ Core::integer->char))
+(@define char-upcase (@ Core::char-upcase))
+(@define char-downcase (@ Core::char-downcase))
+
+;;;; 6.3.5 Strings
+
+(@define string? (@ Core::string?))
+(@define make-string (@ Core::make-string))
+(@define string (@ Core::string))
+(@define string-length (@ Core::string-length))
+(@define string-ref (@ Core::string-ref))
+(@define string-set! (@ Core::string-set!))
+
+(@define string=? (@ Core::string=?))
+(@define string-ci=? (@ Core::string-ci=?))
+(@define string<? (@ Core::string<?))
+(@define string>? (@ Core::string>?))
+(@define string<=? (@ Core::string<=?))
+(@define string>=? (@ Core::string>=?))
+(@define string-ci<? (@ Core::string-ci<?))
+(@define string-ci>? (@ Core::string-ci>?))
+(@define string-ci<=? (@ Core::string-ci<=?))
+(@define string-ci>=? (@ Core::string-ci>=?))
+
+(@define substring (@ Core::substring))
+(@define string-append (@ Core::string-append))
+(@define string->list (@ Core::string->list))
+(@define list->string (@ Core::list->string))
+(@define string-copy (@ Core::string-copy))
+(@define string-fill! (@ Core::string-fill!))
+
+;;;; 6.3.6 Vectors
+
+(@define vector? (@ Core::vector?))
+(@define make-vector (@ Core::make-vector))
+(@define vector (@ Core::vector))
+(@define vector-length (@ Core::vector-length))
+(@define vector-ref (@ Core::vector-ref))
+(@define vector-set! (@ Core::vector-set!))
+(@define vector->list (@ Core::vector->list))
+(@define list->vector (@ Core::list->vector))
+(@define vector-fill! (@ Core::vector-fill!))
+
+;;; 6.4 Control features
+
+(@define procedure? (@ Core::procedure?))
+(@define apply (@ Core::apply))
+(@define map (@ Core::map))
+(@define for-each (@ Core::for-each))
+(@define force (@ Core::force))
+
+(@define call-with-current-continuation (@ Core::call-with-current-continuation))
+(@define values (@ Core::values))
+(@define call-with-values (@ Core::call-with-values))
+(@define dynamic-wind (@ Core::dynamic-wind))
+
+;;; 6.5 Eval
+
+(@define eval
+  (@let ((l (@ Language::r5rs::spec::r5rs)))
+    (@lambda (x e)
+      (((@ System::Base::language::compile-in) x e l)))))
+
+;; (@define scheme-report-environment
+;;   (@lambda (version)
+;;     (@if (@= version 5)
+;; 	 (@ Language::R5RS::Core)
+;; 	 (@error "Unsupported environment version" version))))
+;; 
+;; (@define null-environment
+;;   (@lambda (version)
+;;     (@if (@= version 5)
+;; 	 (@ Language::R5RS::Null)
+;; 	 (@error "Unsupported environment version" version))))
+
+(@define interaction-environment (@lambda () (@current-module)))
+
+;;; 6.6 Input and output
+
+;;;; 6.6.1 Ports
+
+(@define call-with-input-file (@ Core::call-with-input-file))
+(@define call-with-output-file (@ Core::call-with-output-file))
+
+(@define input-port? (@ Core::input-port?))
+(@define output-port? (@ Core::output-port?))
+(@define current-input-port (@ Core::current-input-port))
+(@define current-output-port (@ Core::current-output-port))
+
+(@define with-input-from-file (@ Core::with-input-from-file))
+(@define with-output-to-file (@ Core::with-output-to-file))
+
+(@define open-input-file (@ Core::open-input-file))
+(@define open-output-file (@ Core::open-output-file))
+(@define close-input-port (@ Core::close-input-port))
+(@define close-output-port (@ Core::close-output-port))
+
+;;;; 6.6.2 Input
+
+(@define read (@ Core::read))
+(@define read-char (@ Core::read-char))
+(@define peek-char (@ Core::peek-char))
+(@define eof-object? (@ Core::eof-object?))
+(@define char-ready? (@ Core::char-ready?))
+
+;;;; 6.6.3 Output
+
+(@define write (@ Core::write))
+(@define display (@ Core::display))
+(@define newline (@ Core::newline))
+(@define write-char (@ Core::write-char))
+
+;;;; 6.6.4 System interface
+
+(@define load
+  (@lambda (file)
+    (call-with-input-file file
+      (@lambda (port)
+	(@let ((loop (@lambda (x)
+		       (@if (@not (eof-object? x))
+			    (@begin
+			      (eval x (interaction-environment))
+			      (loop (read port)))))))
+	  (loop (read port)))))))
+
+;; transcript-on
+;; transcript-off
diff --git a/module/language/r5rs/expand.scm b/module/language/r5rs/expand.scm
new file mode 100644
index 000000000..e8910ae1b
--- /dev/null
+++ b/module/language/r5rs/expand.scm
@@ -0,0 +1,80 @@
+;;; R5RS syntax expander
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (language r5rs expand)
+  #:export (expand void
+	   identifier? free-identifier=? bound-identifier=?
+	   generate-temporaries datum->syntax-object syntax-object->datum))
+
+(define sc-expand #f)
+(define $sc-put-cte #f)
+(define $syntax-dispatch #f)
+(define syntax-rules #f)
+(define syntax-error #f)
+(define identifier? #f)
+(define free-identifier=? #f)
+(define bound-identifier=? #f)
+(define generate-temporaries #f)
+(define datum->syntax-object #f)
+(define syntax-object->datum #f)
+
+(define void (lambda () (if #f #f)))
+
+(define andmap
+  (lambda (f first . rest)
+    (or (null? first)
+	(if (null? rest)
+	    (let andmap ((first first))
+	      (let ((x (car first)) (first (cdr first)))
+		(if (null? first)
+		    (f x)
+		    (and (f x) (andmap first)))))
+	    (let andmap ((first first) (rest rest))
+	      (let ((x (car first))
+		    (xr (map car rest))
+		    (first (cdr first))
+		    (rest (map cdr rest)))
+		(if (null? first)
+		    (apply f (cons x xr))
+		    (and (apply f (cons x xr)) (andmap first rest)))))))))
+
+(define ormap
+  (lambda (proc list1)
+    (and (not (null? list1))
+	 (or (proc (car list1)) (ormap proc (cdr list1))))))
+
+(define putprop set-symbol-property!)
+(define getprop symbol-property)
+(define remprop symbol-property-remove!)
+
+(define syncase-module (current-module))
+(define guile-eval eval)
+(define (eval x)
+  (if (and (pair? x) (equal? (car x) "noexpand"))
+      (cdr x)
+      (guile-eval x syncase-module)))
+
+(define guile-error error)
+(define (error who format-string why what)
+  (guile-error why what))
+
+(load "psyntax.pp")
+
+(define expand sc-expand)
diff --git a/module/language/r5rs/null.il b/module/language/r5rs/null.il
new file mode 100644
index 000000000..a290025de
--- /dev/null
+++ b/module/language/r5rs/null.il
@@ -0,0 +1,19 @@
+;;; R5RS null environment
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
diff --git a/module/language/r5rs/psyntax.pp b/module/language/r5rs/psyntax.pp
new file mode 100644
index 000000000..ef9ca0aa9
--- /dev/null
+++ b/module/language/r5rs/psyntax.pp
@@ -0,0 +1,14552 @@
+;;; psyntax.pp
+;;; automatically generated from psyntax.ss
+;;; Wed Aug 30 12:24:52 EST 2000
+;;; see copyright notice in psyntax.ss
+
+((lambda ()
+   (letrec ((g452
+             (lambda (g1823)
+               ((letrec ((g1824
+                          (lambda (g1827 g1825 g1826)
+                            (if (pair? g1827)
+                                (g1824
+                                  (cdr g1827)
+                                  (cons (g393 (car g1827) g1826) g1825)
+                                  g1826)
+                                (if (g256 g1827)
+                                    (cons (g393 g1827 g1826) g1825)
+                                    (if (null? g1827)
+                                        g1825
+                                        (if (g204 g1827)
+                                            (g1824
+                                              (g205 g1827)
+                                              g1825
+                                              (g371 g1826 (g206 g1827)))
+                                            (if (g90 g1827)
+                                                (g1824
+                                                  (annotation-expression
+                                                    g1827)
+                                                  g1825
+                                                  g1826)
+                                                (cons g1827 g1825)))))))))
+                  g1824)
+                g1823
+                '()
+                '(()))))
+            (g451
+             (lambda (g833)
+               ((lambda (g834) (if (g90 g834) (gensym) (gensym)))
+                (if (g204 g833) (g205 g833) g833))))
+            (g450
+             (lambda (g1820 g1819)
+               (g449 g1820
+                     g1819
+                     (lambda (g1821)
+                       (if ((lambda (g1822)
+                              (if g1822
+                                  g1822
+                                  (if (pair? g1821)
+                                      (g90 (car g1821))
+                                      '#f)))
+                            (g90 g1821))
+                           (g448 g1821 '#f)
+                           g1821)))))
+            (g449
+             (lambda (g837 g835 g836)
+               (if (memq 'top (g264 g835))
+                   (g836 g837)
+                   ((letrec ((g838
+                              (lambda (g839)
+                                (if (g204 g839)
+                                    (g449 (g205 g839) (g206 g839) g836)
+                                    (if (pair? g839)
+                                        ((lambda (g841 g840)
+                                           (if (if (eq? g841 (car g839))
+                                                   (eq? g840 (cdr g839))
+                                                   '#f)
+                                               g839
+                                               (cons g841 g840)))
+                                         (g838 (car g839))
+                                         (g838 (cdr g839)))
+                                        (if (vector? g839)
+                                            ((lambda (g842)
+                                               ((lambda (g843)
+                                                  (if (andmap
+                                                        eq?
+                                                        g842
+                                                        g843)
+                                                      g839
+                                                      (list->vector g843)))
+                                                (map g838 g842)))
+                                             (vector->list g839))
+                                            g839))))))
+                      g838)
+                    g837))))
+            (g448
+             (lambda (g1813 g1812)
+               (if (pair? g1813)
+                   ((lambda (g1814)
+                      (begin (if g1812
+                                 (set-annotation-stripped! g1812 g1814)
+                                 (void))
+                             (set-car! g1814 (g448 (car g1813) '#f))
+                             (set-cdr! g1814 (g448 (cdr g1813) '#f))
+                             g1814))
+                    (cons '#f '#f))
+                   (if (g90 g1813)
+                       ((lambda (g1815)
+                          (if g1815
+                              g1815
+                              (g448 (annotation-expression g1813) g1813)))
+                        (annotation-stripped g1813))
+                       (if (vector? g1813)
+                           ((lambda (g1816)
+                              (begin (if g1812
+                                         (set-annotation-stripped!
+                                           g1812
+                                           g1816)
+                                         (void))
+                                     ((letrec ((g1817
+                                                (lambda (g1818)
+                                                  (if (not (< g1818 '0))
+                                                      (begin (vector-set!
+                                                               g1816
+                                                               g1818
+                                                               (g448 (vector-ref
+                                                                       g1813
+                                                                       g1818)
+                                                                     '#f))
+                                                             (g1817
+                                                               (- g1818
+                                                                  '1)))
+                                                      (void)))))
+                                        g1817)
+                                      (- (vector-length g1813) '1))
+                                     g1816))
+                            (make-vector (vector-length g1813)))
+                           g1813)))))
+            (g447
+             (lambda (g844)
+               (if (g255 g844)
+                   (g378 g844
+                         '#(syntax-object
+                            ...
+                            ((top)
+                             #(ribcage () () ())
+                             #(ribcage () () ())
+                             #(ribcage #(x) #((top)) #("i"))
+                             #(ribcage
+                               (lambda-var-list
+                                 gen-var
+                                 strip
+                                 strip*
+                                 strip-annotation
+                                 ellipsis?
+                                 chi-void
+                                 chi-local-syntax
+                                 chi-lambda-clause
+                                 parse-define-syntax
+                                 parse-define
+                                 parse-import
+                                 parse-module
+                                 do-import!
+                                 chi-internal
+                                 chi-body
+                                 chi-macro
+                                 chi-set!
+                                 chi-application
+                                 chi-expr
+                                 chi
+                                 ct-eval/residualize
+                                 do-top-import
+                                 vfor-each
+                                 vmap
+                                 chi-external
+                                 check-defined-ids
+                                 check-module-exports
+                                 extend-store!
+                                 id-set-diff
+                                 chi-top-module
+                                 set-module-binding-val!
+                                 set-module-binding-imps!
+                                 set-module-binding-label!
+                                 set-module-binding-id!
+                                 set-module-binding-type!
+                                 module-binding-val
+                                 module-binding-imps
+                                 module-binding-label
+                                 module-binding-id
+                                 module-binding-type
+                                 module-binding?
+                                 make-module-binding
+                                 make-resolved-interface
+                                 make-trimmed-interface
+                                 set-interface-token!
+                                 set-interface-exports!
+                                 interface-token
+                                 interface-exports
+                                 interface?
+                                 make-interface
+                                 flatten-exports
+                                 chi-top
+                                 chi-top-expr
+                                 syntax-type
+                                 chi-when-list
+                                 chi-top-sequence
+                                 chi-sequence
+                                 source-wrap
+                                 wrap
+                                 bound-id-member?
+                                 invalid-ids-error
+                                 distinct-bound-ids?
+                                 valid-bound-ids?
+                                 bound-id=?
+                                 literal-id=?
+                                 free-id=?
+                                 id-var-name
+                                 id-var-name-loc
+                                 id-var-name&marks
+                                 id-var-name-loc&marks
+                                 same-marks?
+                                 join-marks
+                                 join-wraps
+                                 smart-append
+                                 make-trimmed-syntax-object
+                                 make-binding-wrap
+                                 lookup-import-binding-name
+                                 extend-ribcage-subst!
+                                 extend-ribcage-barrier-help!
+                                 extend-ribcage-barrier!
+                                 extend-ribcage!
+                                 make-empty-ribcage
+                                 import-token-key
+                                 import-token?
+                                 make-import-token
+                                 barrier-marker
+                                 new-mark
+                                 anti-mark
+                                 the-anti-mark
+                                 only-top-marked?
+                                 top-marked?
+                                 top-wrap
+                                 empty-wrap
+                                 set-ribcage-labels!
+                                 set-ribcage-marks!
+                                 set-ribcage-symnames!
+                                 ribcage-labels
+                                 ribcage-marks
+                                 ribcage-symnames
+                                 ribcage?
+                                 make-ribcage
+                                 set-indirect-label!
+                                 get-indirect-label
+                                 indirect-label?
+                                 gen-indirect-label
+                                 gen-labels
+                                 label?
+                                 gen-label
+                                 make-rename
+                                 rename-marks
+                                 rename-new
+                                 rename-old
+                                 subst-rename?
+                                 wrap-subst
+                                 wrap-marks
+                                 make-wrap
+                                 id-sym-name&marks
+                                 id-sym-name
+                                 id?
+                                 nonsymbol-id?
+                                 global-extend
+                                 lookup
+                                 sanitize-binding
+                                 lookup*
+                                 displaced-lexical-error
+                                 transformer-env
+                                 extend-var-env*
+                                 extend-env*
+                                 extend-env
+                                 null-env
+                                 binding?
+                                 set-binding-value!
+                                 set-binding-type!
+                                 binding-value
+                                 binding-type
+                                 make-binding
+                                 arg-check
+                                 source-annotation
+                                 no-source
+                                 unannotate
+                                 set-syntax-object-wrap!
+                                 set-syntax-object-expression!
+                                 syntax-object-wrap
+                                 syntax-object-expression
+                                 syntax-object?
+                                 make-syntax-object
+                                 self-evaluating?
+                                 build-lexical-var
+                                 build-letrec
+                                 build-sequence
+                                 build-data
+                                 build-primref
+                                 build-lambda
+                                 build-cte-install
+                                 build-module-definition
+                                 build-global-definition
+                                 build-global-assignment
+                                 build-global-reference
+                                 build-lexical-assignment
+                                 build-lexical-reference
+                                 build-conditional
+                                 build-application
+                                 generate-id
+                                 get-import-binding
+                                 get-global-definition-hook
+                                 put-global-definition-hook
+                                 gensym-hook
+                                 error-hook
+                                 local-eval-hook
+                                 top-level-eval-hook
+                                 annotation?
+                                 fx<
+                                 fx=
+                                 fx-
+                                 fx+
+                                 noexpand
+                                 define-structure
+                                 unless
+                                 when)
+                               ((top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top)
+                                (top))
+                               ("i" "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"
+                                    "i"))
+                             #(ribcage ((import-token . *top*)) () ())
+                             #(ribcage ((import-token . *top*)) () ()))))
+                   '#f)))
+            (g446 (lambda () (list 'void)))
+            (g445
+             (lambda (g850 g845 g849 g846 g848 g847)
+               ((lambda (g851)
+                  ((lambda (g852)
+                     (if g852
+                         (apply
+                           (lambda (g857 g853 g856 g854 g855)
+                             ((lambda (g858)
+                                (if (not (g389 g858))
+                                    (g391 (map (lambda (g859)
+                                                 (g393 g859 g846))
+                                               g858)
+                                          (g394 g845 g846 g848)
+                                          '"keyword")
+                                    ((lambda (g860)
+                                       ((lambda (g861)
+                                          (g847 (cons g854 g855)
+                                                (g247 g860
+                                                      ((lambda (g863 g862)
+                                                         (map (lambda (g865)
+                                                                (g231 'deferred
+                                                                      (g432 g865
+                                                                            g862
+                                                                            g863)))
+                                                              g856))
+                                                       (if g850 g861 g846)
+                                                       (g249 g849))
+                                                      g849)
+                                                g861
+                                                g848))
+                                        (g368 g858 g860 g846)))
+                                     (g299 g858))))
+                              g853))
+                           g852)
+                         ((lambda (g868)
+                            (syntax-error (g394 g845 g846 g848)))
+                          g851)))
+                   ($syntax-dispatch
+                     g851
+                     '(any #(each (any any)) any . each-any))))
+                g845)))
+            (g444
+             (lambda (g1789 g1785 g1788 g1786 g1787)
+               ((lambda (g1790)
+                  ((lambda (g1791)
+                     (if g1791
+                         (apply
+                           (lambda (g1794 g1792 g1793)
+                             ((lambda (g1795)
+                                (if (not (g389 g1795))
+                                    (syntax-error
+                                      g1789
+                                      '"invalid parameter list in")
+                                    ((lambda (g1797 g1796)
+                                       (g1787
+                                         g1796
+                                         (g437 (cons g1792 g1793)
+                                               g1789
+                                               (g248 g1797 g1796 g1788)
+                                               (g368 g1795 g1797 g1786))))
+                                     (g299 g1795)
+                                     (map g451 g1795))))
+                              g1794))
+                           g1791)
+                         ((lambda (g1800)
+                            (if g1800
+                                (apply
+                                  (lambda (g1803 g1801 g1802)
+                                    ((lambda (g1804)
+                                       (if (not (g389 g1804))
+                                           (syntax-error
+                                             g1789
+                                             '"invalid parameter list in")
+                                           ((lambda (g1806 g1805)
+                                              (g1787
+                                                ((letrec ((g1808
+                                                           (lambda (g1810
+                                                                    g1809)
+                                                             (if (null?
+                                                                   g1810)
+                                                                 g1809
+                                                                 (g1808
+                                                                   (cdr g1810)
+                                                                   (cons (car g1810)
+                                                                         g1809))))))
+                                                   g1808)
+                                                 (cdr g1805)
+                                                 (car g1805))
+                                                (g437 (cons g1801 g1802)
+                                                      g1789
+                                                      (g248 g1806
+                                                            g1805
+                                                            g1788)
+                                                      (g368 g1804
+                                                            g1806
+                                                            g1786))))
+                                            (g299 g1804)
+                                            (map g451 g1804))))
+                                     (g452 g1803)))
+                                  g1800)
+                                ((lambda (g1811) (syntax-error g1789))
+                                 g1790)))
+                          ($syntax-dispatch g1790 '(any any . each-any)))))
+                   ($syntax-dispatch g1790 '(each-any any . each-any))))
+                g1785)))
+            (g443
+             (lambda (g872 g869 g871 g870)
+               ((lambda (g873)
+                  ((lambda (g874)
+                     (if (if g874
+                             (apply
+                               (lambda (g877 g875 g876) (g256 g875))
+                               g874)
+                             '#f)
+                         (apply
+                           (lambda (g880 g878 g879) (g870 g878 g879 g869))
+                           g874)
+                         ((lambda (g881)
+                            (syntax-error (g394 g872 g869 g871)))
+                          g873)))
+                   ($syntax-dispatch g873 '(any any any))))
+                g872)))
+            (g442
+             (lambda (g1758 g1755 g1757 g1756)
+               ((lambda (g1759)
+                  ((lambda (g1760)
+                     (if (if g1760
+                             (apply
+                               (lambda (g1763 g1761 g1762) (g256 g1761))
+                               g1760)
+                             '#f)
+                         (apply
+                           (lambda (g1766 g1764 g1765)
+                             (g1756 g1764 g1765 g1755))
+                           g1760)
+                         ((lambda (g1767)
+                            (if (if g1767
+                                    (apply
+                                      (lambda (g1772
+                                               g1768
+                                               g1771
+                                               g1769
+                                               g1770)
+                                        (if (g256 g1768)
+                                            (g389 (g452 g1771))
+                                            '#f))
+                                      g1767)
+                                    '#f)
+                                (apply
+                                  (lambda (g1777 g1773 g1776 g1774 g1775)
+                                    (g1756
+                                      (g393 g1773 g1755)
+                                      (cons '#(syntax-object
+                                               lambda
+                                               ((top)
+                                                #(ribcage
+                                                  #(_ name args e1 e2)
+                                                  #((top)
+                                                    (top)
+                                                    (top)
+                                                    (top)
+                                                    (top))
+                                                  #("i" "i" "i" "i" "i"))
+                                                #(ribcage () () ())
+                                                #(ribcage
+                                                  #(e w s k)
+                                                  #((top)
+                                                    (top)
+                                                    (top)
+                                                    (top))
+                                                  #("i" "i" "i" "i"))
+                                                #(ribcage
+                                                  (lambda-var-list
+                                                    gen-var
+                                                    strip
+                                                    strip*
+                                                    strip-annotation
+                                                    ellipsis?
+                                                    chi-void
+                                                    chi-local-syntax
+                                                    chi-lambda-clause
+                                                    parse-define-syntax
+                                                    parse-define
+                                                    parse-import
+                                                    parse-module
+                                                    do-import!
+                                                    chi-internal
+                                                    chi-body
+                                                    chi-macro
+                                                    chi-set!
+                                                    chi-application
+                                                    chi-expr
+                                                    chi
+                                                    ct-eval/residualize
+                                                    do-top-import
+                                                    vfor-each
+                                                    vmap
+                                                    chi-external
+                                                    check-defined-ids
+                                                    check-module-exports
+                                                    extend-store!
+                                                    id-set-diff
+                                                    chi-top-module
+                                                    set-module-binding-val!
+                                                    set-module-binding-imps!
+                                                    set-module-binding-label!
+                                                    set-module-binding-id!
+                                                    set-module-binding-type!
+                                                    module-binding-val
+                                                    module-binding-imps
+                                                    module-binding-label
+                                                    module-binding-id
+                                                    module-binding-type
+                                                    module-binding?
+                                                    make-module-binding
+                                                    make-resolved-interface
+                                                    make-trimmed-interface
+                                                    set-interface-token!
+                                                    set-interface-exports!
+                                                    interface-token
+                                                    interface-exports
+                                                    interface?
+                                                    make-interface
+                                                    flatten-exports
+                                                    chi-top
+                                                    chi-top-expr
+                                                    syntax-type
+                                                    chi-when-list
+                                                    chi-top-sequence
+                                                    chi-sequence
+                                                    source-wrap
+                                                    wrap
+                                                    bound-id-member?
+                                                    invalid-ids-error
+                                                    distinct-bound-ids?
+                                                    valid-bound-ids?
+                                                    bound-id=?
+                                                    literal-id=?
+                                                    free-id=?
+                                                    id-var-name
+                                                    id-var-name-loc
+                                                    id-var-name&marks
+                                                    id-var-name-loc&marks
+                                                    same-marks?
+                                                    join-marks
+                                                    join-wraps
+                                                    smart-append
+                                                    make-trimmed-syntax-object
+                                                    make-binding-wrap
+                                                    lookup-import-binding-name
+                                                    extend-ribcage-subst!
+                                                    extend-ribcage-barrier-help!
+                                                    extend-ribcage-barrier!
+                                                    extend-ribcage!
+                                                    make-empty-ribcage
+                                                    import-token-key
+                                                    import-token?
+                                                    make-import-token
+                                                    barrier-marker
+                                                    new-mark
+                                                    anti-mark
+                                                    the-anti-mark
+                                                    only-top-marked?
+                                                    top-marked?
+                                                    top-wrap
+                                                    empty-wrap
+                                                    set-ribcage-labels!
+                                                    set-ribcage-marks!
+                                                    set-ribcage-symnames!
+                                                    ribcage-labels
+                                                    ribcage-marks
+                                                    ribcage-symnames
+                                                    ribcage?
+                                                    make-ribcage
+                                                    set-indirect-label!
+                                                    get-indirect-label
+                                                    indirect-label?
+                                                    gen-indirect-label
+                                                    gen-labels
+                                                    label?
+                                                    gen-label
+                                                    make-rename
+                                                    rename-marks
+                                                    rename-new
+                                                    rename-old
+                                                    subst-rename?
+                                                    wrap-subst
+                                                    wrap-marks
+                                                    make-wrap
+                                                    id-sym-name&marks
+                                                    id-sym-name
+                                                    id?
+                                                    nonsymbol-id?
+                                                    global-extend
+                                                    lookup
+                                                    sanitize-binding
+                                                    lookup*
+                                                    displaced-lexical-error
+                                                    transformer-env
+                                                    extend-var-env*
+                                                    extend-env*
+                                                    extend-env
+                                                    null-env
+                                                    binding?
+                                                    set-binding-value!
+                                                    set-binding-type!
+                                                    binding-value
+                                                    binding-type
+                                                    make-binding
+                                                    arg-check
+                                                    source-annotation
+                                                    no-source
+                                                    unannotate
+                                                    set-syntax-object-wrap!
+                                                    set-syntax-object-expression!
+                                                    syntax-object-wrap
+                                                    syntax-object-expression
+                                                    syntax-object?
+                                                    make-syntax-object
+                                                    self-evaluating?
+                                                    build-lexical-var
+                                                    build-letrec
+                                                    build-sequence
+                                                    build-data
+                                                    build-primref
+                                                    build-lambda
+                                                    build-cte-install
+                                                    build-module-definition
+                                                    build-global-definition
+                                                    build-global-assignment
+                                                    build-global-reference
+                                                    build-lexical-assignment
+                                                    build-lexical-reference
+                                                    build-conditional
+                                                    build-application
+                                                    generate-id
+                                                    get-import-binding
+                                                    get-global-definition-hook
+                                                    put-global-definition-hook
+                                                    gensym-hook
+                                                    error-hook
+                                                    local-eval-hook
+                                                    top-level-eval-hook
+                                                    annotation?
+                                                    fx<
+                                                    fx=
+                                                    fx-
+                                                    fx+
+                                                    noexpand
+                                                    define-structure
+                                                    unless
+                                                    when)
+                                                  ((top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top))
+                                                  ("i" "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"
+                                                       "i"))
+                                                #(ribcage
+                                                  ((import-token . *top*))
+                                                  ()
+                                                  ())
+                                                #(ribcage
+                                                  ((import-token . *top*))
+                                                  ()
+                                                  ())))
+                                            (g393 (cons g1776
+                                                        (cons g1774 g1775))
+                                                  g1755))
+                                      '(())))
+                                  g1767)
+                                ((lambda (g1779)
+                                   (if (if g1779
+                                           (apply
+                                             (lambda (g1781 g1780)
+                                               (g256 g1780))
+                                             g1779)
+                                           '#f)
+                                       (apply
+                                         (lambda (g1783 g1782)
+                                           (g1756
+                                             (g393 g1782 g1755)
+                                             '(#(syntax-object
+                                                 void
+                                                 ((top)
+                                                  #(ribcage
+                                                    #(_ name)
+                                                    #((top) (top))
+                                                    #("i" "i"))
+                                                  #(ribcage () () ())
+                                                  #(ribcage
+                                                    #(e w s k)
+                                                    #((top)
+                                                      (top)
+                                                      (top)
+                                                      (top))
+                                                    #("i" "i" "i" "i"))
+                                                  #(ribcage
+                                                    (lambda-var-list
+                                                      gen-var
+                                                      strip
+                                                      strip*
+                                                      strip-annotation
+                                                      ellipsis?
+                                                      chi-void
+                                                      chi-local-syntax
+                                                      chi-lambda-clause
+                                                      parse-define-syntax
+                                                      parse-define
+                                                      parse-import
+                                                      parse-module
+                                                      do-import!
+                                                      chi-internal
+                                                      chi-body
+                                                      chi-macro
+                                                      chi-set!
+                                                      chi-application
+                                                      chi-expr
+                                                      chi
+                                                      ct-eval/residualize
+                                                      do-top-import
+                                                      vfor-each
+                                                      vmap
+                                                      chi-external
+                                                      check-defined-ids
+                                                      check-module-exports
+                                                      extend-store!
+                                                      id-set-diff
+                                                      chi-top-module
+                                                      set-module-binding-val!
+                                                      set-module-binding-imps!
+                                                      set-module-binding-label!
+                                                      set-module-binding-id!
+                                                      set-module-binding-type!
+                                                      module-binding-val
+                                                      module-binding-imps
+                                                      module-binding-label
+                                                      module-binding-id
+                                                      module-binding-type
+                                                      module-binding?
+                                                      make-module-binding
+                                                      make-resolved-interface
+                                                      make-trimmed-interface
+                                                      set-interface-token!
+                                                      set-interface-exports!
+                                                      interface-token
+                                                      interface-exports
+                                                      interface?
+                                                      make-interface
+                                                      flatten-exports
+                                                      chi-top
+                                                      chi-top-expr
+                                                      syntax-type
+                                                      chi-when-list
+                                                      chi-top-sequence
+                                                      chi-sequence
+                                                      source-wrap
+                                                      wrap
+                                                      bound-id-member?
+                                                      invalid-ids-error
+                                                      distinct-bound-ids?
+                                                      valid-bound-ids?
+                                                      bound-id=?
+                                                      literal-id=?
+                                                      free-id=?
+                                                      id-var-name
+                                                      id-var-name-loc
+                                                      id-var-name&marks
+                                                      id-var-name-loc&marks
+                                                      same-marks?
+                                                      join-marks
+                                                      join-wraps
+                                                      smart-append
+                                                      make-trimmed-syntax-object
+                                                      make-binding-wrap
+                                                      lookup-import-binding-name
+                                                      extend-ribcage-subst!
+                                                      extend-ribcage-barrier-help!
+                                                      extend-ribcage-barrier!
+                                                      extend-ribcage!
+                                                      make-empty-ribcage
+                                                      import-token-key
+                                                      import-token?
+                                                      make-import-token
+                                                      barrier-marker
+                                                      new-mark
+                                                      anti-mark
+                                                      the-anti-mark
+                                                      only-top-marked?
+                                                      top-marked?
+                                                      top-wrap
+                                                      empty-wrap
+                                                      set-ribcage-labels!
+                                                      set-ribcage-marks!
+                                                      set-ribcage-symnames!
+                                                      ribcage-labels
+                                                      ribcage-marks
+                                                      ribcage-symnames
+                                                      ribcage?
+                                                      make-ribcage
+                                                      set-indirect-label!
+                                                      get-indirect-label
+                                                      indirect-label?
+                                                      gen-indirect-label
+                                                      gen-labels
+                                                      label?
+                                                      gen-label
+                                                      make-rename
+                                                      rename-marks
+                                                      rename-new
+                                                      rename-old
+                                                      subst-rename?
+                                                      wrap-subst
+                                                      wrap-marks
+                                                      make-wrap
+                                                      id-sym-name&marks
+                                                      id-sym-name
+                                                      id?
+                                                      nonsymbol-id?
+                                                      global-extend
+                                                      lookup
+                                                      sanitize-binding
+                                                      lookup*
+                                                      displaced-lexical-error
+                                                      transformer-env
+                                                      extend-var-env*
+                                                      extend-env*
+                                                      extend-env
+                                                      null-env
+                                                      binding?
+                                                      set-binding-value!
+                                                      set-binding-type!
+                                                      binding-value
+                                                      binding-type
+                                                      make-binding
+                                                      arg-check
+                                                      source-annotation
+                                                      no-source
+                                                      unannotate
+                                                      set-syntax-object-wrap!
+                                                      set-syntax-object-expression!
+                                                      syntax-object-wrap
+                                                      syntax-object-expression
+                                                      syntax-object?
+                                                      make-syntax-object
+                                                      self-evaluating?
+                                                      build-lexical-var
+                                                      build-letrec
+                                                      build-sequence
+                                                      build-data
+                                                      build-primref
+                                                      build-lambda
+                                                      build-cte-install
+                                                      build-module-definition
+                                                      build-global-definition
+                                                      build-global-assignment
+                                                      build-global-reference
+                                                      build-lexical-assignment
+                                                      build-lexical-reference
+                                                      build-conditional
+                                                      build-application
+                                                      generate-id
+                                                      get-import-binding
+                                                      get-global-definition-hook
+                                                      put-global-definition-hook
+                                                      gensym-hook
+                                                      error-hook
+                                                      local-eval-hook
+                                                      top-level-eval-hook
+                                                      annotation?
+                                                      fx<
+                                                      fx=
+                                                      fx-
+                                                      fx+
+                                                      noexpand
+                                                      define-structure
+                                                      unless
+                                                      when)
+                                                    ((top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top))
+                                                    ("i" "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"
+                                                         "i"))
+                                                  #(ribcage
+                                                    ((import-token
+                                                       .
+                                                       *top*))
+                                                    ()
+                                                    ())
+                                                  #(ribcage
+                                                    ((import-token
+                                                       .
+                                                       *top*))
+                                                    ()
+                                                    ()))))
+                                             '(())))
+                                         g1779)
+                                       ((lambda (g1784)
+                                          (syntax-error
+                                            (g394 g1758 g1755 g1757)))
+                                        g1759)))
+                                 ($syntax-dispatch g1759 '(any any)))))
+                          ($syntax-dispatch
+                            g1759
+                            '(any (any . any) any . each-any)))))
+                   ($syntax-dispatch g1759 '(any any any))))
+                g1758)))
+            (g441
+             (lambda (g885 g882 g884 g883)
+               ((lambda (g886)
+                  ((lambda (g887)
+                     (if (if g887
+                             (apply (lambda (g889 g888) (g256 g888)) g887)
+                             '#f)
+                         (apply
+                           (lambda (g891 g890) (g883 (g393 g890 g882)))
+                           g887)
+                         ((lambda (g892)
+                            (syntax-error (g394 g885 g882 g884)))
+                          g886)))
+                   ($syntax-dispatch g886 '(any any))))
+                g885)))
+            (g440
+             (lambda (g1723 g1719 g1722 g1720 g1721)
+               (letrec ((g1725
+                         (lambda (g1753 g1751 g1752)
+                           (g1721
+                             g1753
+                             (g1724 g1751)
+                             (map (lambda (g1754) (g393 g1754 g1720))
+                                  g1752))))
+                        (g1724
+                         (lambda (g1745)
+                           (if (null? g1745)
+                               '()
+                               (cons ((lambda (g1746)
+                                        ((lambda (g1747)
+                                           (if g1747
+                                               (apply
+                                                 (lambda (g1748)
+                                                   (g1724 g1748))
+                                                 g1747)
+                                               ((lambda (g1750)
+                                                  (if (g256 g1750)
+                                                      (g393 g1750 g1720)
+                                                      (syntax-error
+                                                        (g394 g1723
+                                                              g1719
+                                                              g1722)
+                                                        '"invalid exports list in")))
+                                                g1746)))
+                                         ($syntax-dispatch
+                                           g1746
+                                           'each-any)))
+                                      (car g1745))
+                                     (g1724 (cdr g1745)))))))
+                 ((lambda (g1726)
+                    ((lambda (g1727)
+                       (if g1727
+                           (apply
+                             (lambda (g1730 g1728 g1729)
+                               (g1725 '#f g1728 g1729))
+                             g1727)
+                           ((lambda (g1733)
+                              (if (if g1733
+                                      (apply
+                                        (lambda (g1737 g1734 g1736 g1735)
+                                          (g256 g1734))
+                                        g1733)
+                                      '#f)
+                                  (apply
+                                    (lambda (g1741 g1738 g1740 g1739)
+                                      (g1725
+                                        (g393 g1738 g1719)
+                                        g1740
+                                        g1739))
+                                    g1733)
+                                  ((lambda (g1744)
+                                     (syntax-error
+                                       (g394 g1723 g1719 g1722)))
+                                   g1726)))
+                            ($syntax-dispatch
+                              g1726
+                              '(any any each-any . each-any)))))
+                     ($syntax-dispatch g1726 '(any each-any . each-any))))
+                  g1723))))
+            (g439
+             (lambda (g894 g893)
+               ((lambda (g895)
+                  (if g895
+                      (g366 g893 g895)
+                      (g429 (lambda (g896)
+                              ((lambda (g897)
+                                 (begin (if (not g897)
+                                            (syntax-error
+                                              g896
+                                              '"exported identifier not visible")
+                                            (void))
+                                        (g363 g893 g896 g897)))
+                               (g376 g896 '(()))))
+                            (g404 g894))))
+                (g405 g894))))
+            (g438
+             (lambda (g1652 g1648 g1651 g1649 g1650)
+               (letrec ((g1653
+                         (lambda (g1718 g1714 g1717 g1715 g1716)
+                           (begin (g426 g1648 g1714)
+                                  (g1650 g1718 g1714 g1717 g1715 g1716)))))
+                 ((letrec ((g1654
+                            (lambda (g1659 g1655 g1658 g1656 g1657)
+                              (if (null? g1659)
+                                  (g1653 g1659 g1655 g1658 g1656 g1657)
+                                  ((lambda (g1661 g1660)
+                                     (call-with-values
+                                       (lambda ()
+                                         (g398 g1661
+                                               g1660
+                                               '(())
+                                               '#f
+                                               g1652))
+                                       (lambda (g1666
+                                                g1662
+                                                g1665
+                                                g1663
+                                                g1664)
+                                         ((lambda (g1667)
+                                            (if (memv g1667 '(define-form))
+                                                (g442 g1665
+                                                      g1663
+                                                      g1664
+                                                      (lambda (g1670
+                                                               g1668
+                                                               g1669)
+                                                        ((lambda (g1672
+                                                                  g1671)
+                                                           ((lambda (g1673)
+                                                              (begin (g363 g1652
+                                                                           g1672
+                                                                           g1671)
+                                                                     (g424 g1649
+                                                                           g1671
+                                                                           (g231 'lexical
+                                                                                 g1673))
+                                                                     (g1654
+                                                                       (cdr g1659)
+                                                                       (cons g1672
+                                                                             g1655)
+                                                                       (cons g1673
+                                                                             g1658)
+                                                                       (cons (cons g1660
+                                                                                   (g393 g1668
+                                                                                         g1669))
+                                                                             g1656)
+                                                                       g1657)))
+                                                            (g451 g1672)))
+                                                         (g393 g1670 g1669)
+                                                         (g297))))
+                                                (if (memv g1667
+                                                          '(define-syntax-form))
+                                                    (g443 g1665
+                                                          g1663
+                                                          g1664
+                                                          (lambda (g1676
+                                                                   g1674
+                                                                   g1675)
+                                                            ((lambda (g1679
+                                                                      g1677
+                                                                      g1678)
+                                                               (begin (g363 g1652
+                                                                            g1679
+                                                                            g1677)
+                                                                      (g424 g1649
+                                                                            g1677
+                                                                            (g231 'deferred
+                                                                                  g1678))
+                                                                      (g1654
+                                                                        (cdr g1659)
+                                                                        (cons g1679
+                                                                              g1655)
+                                                                        g1658
+                                                                        g1656
+                                                                        g1657)))
+                                                             (g393 g1676
+                                                                   g1675)
+                                                             (g297)
+                                                             (g432 g1674
+                                                                   (g249 g1660)
+                                                                   g1675))))
+                                                    (if (memv g1667
+                                                              '(module-form))
+                                                        ((lambda (g1680)
+                                                           ((lambda (g1681)
+                                                              ((lambda ()
+                                                                 (g440 g1665
+                                                                       g1663
+                                                                       g1664
+                                                                       g1681
+                                                                       (lambda (g1684
+                                                                                g1682
+                                                                                g1683)
+                                                                         (g438 g1680
+                                                                               (g394 g1665
+                                                                                     g1663
+                                                                                     g1664)
+                                                                               (map (lambda (g1695)
+                                                                                      (cons g1660
+                                                                                            g1695))
+                                                                                    g1683)
+                                                                               g1649
+                                                                               (lambda (g1689
+                                                                                        g1685
+                                                                                        g1688
+                                                                                        g1686
+                                                                                        g1687)
+                                                                                 (begin (g425 g1648
+                                                                                              (g401 g1682)
+                                                                                              g1685)
+                                                                                        ((lambda (g1693
+                                                                                                  g1690
+                                                                                                  g1692
+                                                                                                  g1691)
+                                                                                           (if g1684
+                                                                                               ((lambda (g1694)
+                                                                                                  (begin (g363 g1652
+                                                                                                               g1684
+                                                                                                               g1694)
+                                                                                                         (g424 g1649
+                                                                                                               g1694
+                                                                                                               (g231 'module
+                                                                                                                     g1693))
+                                                                                                         (g1654
+                                                                                                           (cdr g1659)
+                                                                                                           (cons g1684
+                                                                                                                 g1655)
+                                                                                                           g1690
+                                                                                                           g1692
+                                                                                                           g1691)))
+                                                                                                (g297))
+                                                                                               ((lambda ()
+                                                                                                  (begin (g439 g1693
+                                                                                                               g1652)
+                                                                                                         (g1654
+                                                                                                           (cdr g1659)
+                                                                                                           (cons g1693
+                                                                                                                 g1655)
+                                                                                                           g1690
+                                                                                                           g1692
+                                                                                                           g1691))))))
+                                                                                         (g408 g1682)
+                                                                                         (append
+                                                                                           g1688
+                                                                                           g1658)
+                                                                                         (append
+                                                                                           g1686
+                                                                                           g1656)
+                                                                                         (append
+                                                                                           g1657
+                                                                                           g1687
+                                                                                           g1689))))))))))
+                                                            (g263 (g264 g1663)
+                                                                  (cons g1680
+                                                                        (g265 g1663)))))
+                                                         (g304 '()
+                                                               '()
+                                                               '()))
+                                                        (if (memv g1667
+                                                                  '(import-form))
+                                                            (g441 g1665
+                                                                  g1663
+                                                                  g1664
+                                                                  (lambda (g1696)
+                                                                    ((lambda (g1697)
+                                                                       ((lambda (g1698)
+                                                                          ((lambda (g1699)
+                                                                             (if (memv g1699
+                                                                                       '(module))
+                                                                                 ((lambda (g1700)
+                                                                                    (begin (if g1662
+                                                                                               (g364 g1652
+                                                                                                     g1662)
+                                                                                               (void))
+                                                                                           (g439 g1700
+                                                                                                 g1652)
+                                                                                           (g1654
+                                                                                             (cdr g1659)
+                                                                                             (cons g1700
+                                                                                                   g1655)
+                                                                                             g1658
+                                                                                             g1656
+                                                                                             g1657)))
+                                                                                  (cdr g1698))
+                                                                                 (if (memv g1699
+                                                                                           '(displaced-lexical))
+                                                                                     (g250 g1696)
+                                                                                     (syntax-error
+                                                                                       g1696
+                                                                                       '"import from unknown module"))))
+                                                                           (car g1698)))
+                                                                        (g253 g1697
+                                                                              g1649)))
+                                                                     (g377 g1696
+                                                                           '(())))))
+                                                            (if (memv g1667
+                                                                      '(begin-form))
+                                                                ((lambda (g1701)
+                                                                   ((lambda (g1702)
+                                                                      (if g1702
+                                                                          (apply
+                                                                            (lambda (g1704
+                                                                                     g1703)
+                                                                              (g1654
+                                                                                ((letrec ((g1705
+                                                                                           (lambda (g1706)
+                                                                                             (if (null?
+                                                                                                   g1706)
+                                                                                                 (cdr g1659)
+                                                                                                 (cons (cons g1660
+                                                                                                             (g393 (car g1706)
+                                                                                                                   g1663))
+                                                                                                       (g1705
+                                                                                                         (cdr g1706)))))))
+                                                                                   g1705)
+                                                                                 g1703)
+                                                                                g1655
+                                                                                g1658
+                                                                                g1656
+                                                                                g1657))
+                                                                            g1702)
+                                                                          (syntax-error
+                                                                            g1701)))
+                                                                    ($syntax-dispatch
+                                                                      g1701
+                                                                      '(any .
+                                                                            each-any))))
+                                                                 g1665)
+                                                                (if (memv g1667
+                                                                          '(local-syntax-form))
+                                                                    (g445 g1662
+                                                                          g1665
+                                                                          g1660
+                                                                          g1663
+                                                                          g1664
+                                                                          (lambda (g1711
+                                                                                   g1708
+                                                                                   g1710
+                                                                                   g1709)
+                                                                            (g1654
+                                                                              ((letrec ((g1712
+                                                                                         (lambda (g1713)
+                                                                                           (if (null?
+                                                                                                 g1713)
+                                                                                               (cdr g1659)
+                                                                                               (cons (cons g1708
+                                                                                                           (g393 (car g1713)
+                                                                                                                 g1710))
+                                                                                                     (g1712
+                                                                                                       (cdr g1713)))))))
+                                                                                 g1712)
+                                                                               g1711)
+                                                                              g1655
+                                                                              g1658
+                                                                              g1656
+                                                                              g1657)))
+                                                                    (g1653
+                                                                      (cons (cons g1660
+                                                                                  (g394 g1665
+                                                                                        g1663
+                                                                                        g1664))
+                                                                            (cdr g1659))
+                                                                      g1655
+                                                                      g1658
+                                                                      g1656
+                                                                      g1657))))))))
+                                          g1666))))
+                                   (cdar g1659)
+                                   (caar g1659))))))
+                    g1654)
+                  g1651
+                  '()
+                  '()
+                  '()
+                  '()))))
+            (g437
+             (lambda (g901 g898 g900 g899)
+               ((lambda (g902)
+                  ((lambda (g903)
+                     ((lambda (g904)
+                        ((lambda (g905)
+                           ((lambda ()
+                              (g438 g903
+                                    g898
+                                    g905
+                                    g902
+                                    (lambda (g910 g906 g909 g907 g908)
+                                      (begin (if (null? g910)
+                                                 (syntax-error
+                                                   g898
+                                                   '"no expressions in body")
+                                                 (void))
+                                             (g191 '#f
+                                                   g909
+                                                   (map (lambda (g912)
+                                                          (g432 (cdr g912)
+                                                                (car g912)
+                                                                '(())))
+                                                        g907)
+                                                   (g190 '#f
+                                                         (map (lambda (g911)
+                                                                (g432 (cdr g911)
+                                                                      (car g911)
+                                                                      '(())))
+                                                              (append
+                                                                g908
+                                                                g910))))))))))
+                         (map (lambda (g913) (cons g902 (g393 g913 g904)))
+                              g901)))
+                      (g263 (g264 g899) (cons g903 (g265 g899)))))
+                   (g304 '() '() '())))
+                (cons '("placeholder" placeholder) g900))))
+            (g436
+             (lambda (g1635 g1630 g1634 g1631 g1633 g1632)
+               (letrec ((g1636
+                         (lambda (g1640 g1639)
+                           (if (pair? g1640)
+                               (cons (g1636 (car g1640) g1639)
+                                     (g1636 (cdr g1640) g1639))
+                               (if (g204 g1640)
+                                   ((lambda (g1641)
+                                      ((lambda (g1643 g1642)
+                                         (g203 (g205 g1640)
+                                               (if (if (pair? g1643)
+                                                       (eq? (car g1643)
+                                                            '#f)
+                                                       '#f)
+                                                   (g263 (cdr g1643)
+                                                         (if g1632
+                                                             (cons g1632
+                                                                   (cdr g1642))
+                                                             (cdr g1642)))
+                                                   (g263 (cons g1639 g1643)
+                                                         (if g1632
+                                                             (cons g1632
+                                                                   (cons 'shift
+                                                                         g1642))
+                                                             (cons 'shift
+                                                                   g1642))))))
+                                       (g264 g1641)
+                                       (g265 g1641)))
+                                    (g206 g1640))
+                                   (if (vector? g1640)
+                                       ((lambda (g1644)
+                                          ((lambda (g1645)
+                                             ((lambda ()
+                                                ((letrec ((g1646
+                                                           (lambda (g1647)
+                                                             (if (= g1647
+                                                                    g1644)
+                                                                 g1645
+                                                                 (begin (vector-set!
+                                                                          g1645
+                                                                          g1647
+                                                                          (g1636
+                                                                            (vector-ref
+                                                                              g1640
+                                                                              g1647)
+                                                                            g1639))
+                                                                        (g1646
+                                                                          (+ g1647
+                                                                             '1)))))))
+                                                   g1646)
+                                                 '0))))
+                                           (make-vector g1644)))
+                                        (vector-length g1640))
+                                       (if (symbol? g1640)
+                                           (syntax-error
+                                             (g394 g1630 g1631 g1633)
+                                             '"encountered raw symbol "
+                                             (format '"~s" g1640)
+                                             '" in output of macro")
+                                           g1640)))))))
+                 (g1636
+                   ((lambda (g1637)
+                      (if (procedure? g1637)
+                          (g1637
+                            (lambda (g1638)
+                              (begin (if (not (identifier? g1638))
+                                         (syntax-error
+                                           g1638
+                                           '"environment argument is not an identifier")
+                                         (void))
+                                     (g253 (g377 g1638 '(())) g1634))))
+                          g1637))
+                    (g1635 (g394 g1630 (g349 g1631) g1633)))
+                   (string '#\m)))))
+            (g435
+             (lambda (g918 g914 g917 g915 g916)
+               ((lambda (g919)
+                  ((lambda (g920)
+                     (if (if g920
+                             (apply
+                               (lambda (g923 g921 g922) (g256 g921))
+                               g920)
+                             '#f)
+                         (apply
+                           (lambda (g926 g924 g925)
+                             ((lambda (g927)
+                                ((lambda (g928)
+                                   ((lambda (g929)
+                                      (if (memv g929 '(macro!))
+                                          ((lambda (g931 g930)
+                                             (g398 (g436 (g233 g928)
+                                                         (list '#(syntax-object
+                                                                  set!
+                                                                  ((top)
+                                                                   #(ribcage
+                                                                     ()
+                                                                     ()
+                                                                     ())
+                                                                   #(ribcage
+                                                                     #(id
+                                                                       val)
+                                                                     #((top)
+                                                                       (top))
+                                                                     #("i"
+                                                                       "i"))
+                                                                   #(ribcage
+                                                                     ()
+                                                                     ()
+                                                                     ())
+                                                                   #(ribcage
+                                                                     #(t)
+                                                                     #(("m" top))
+                                                                     #("i"))
+                                                                   #(ribcage
+                                                                     ()
+                                                                     ()
+                                                                     ())
+                                                                   #(ribcage
+                                                                     ()
+                                                                     ()
+                                                                     ())
+                                                                   #(ribcage
+                                                                     ()
+                                                                     ()
+                                                                     ())
+                                                                   #(ribcage
+                                                                     #(b)
+                                                                     #((top))
+                                                                     #("i"))
+                                                                   #(ribcage
+                                                                     ()
+                                                                     ()
+                                                                     ())
+                                                                   #(ribcage
+                                                                     ()
+                                                                     ()
+                                                                     ())
+                                                                   #(ribcage
+                                                                     #(n)
+                                                                     #((top))
+                                                                     #("i"))
+                                                                   #(ribcage
+                                                                     #(_
+                                                                       id
+                                                                       val)
+                                                                     #((top)
+                                                                       (top)
+                                                                       (top))
+                                                                     #("i"
+                                                                       "i"
+                                                                       "i"))
+                                                                   #(ribcage
+                                                                     ()
+                                                                     ()
+                                                                     ())
+                                                                   #(ribcage
+                                                                     #(e
+                                                                       r
+                                                                       w
+                                                                       s
+                                                                       rib)
+                                                                     #((top)
+                                                                       (top)
+                                                                       (top)
+                                                                       (top)
+                                                                       (top))
+                                                                     #("i"
+                                                                       "i"
+                                                                       "i"
+                                                                       "i"
+                                                                       "i"))
+                                                                   #(ribcage
+                                                                     (lambda-var-list
+                                                                       gen-var
+                                                                       strip
+                                                                       strip*
+                                                                       strip-annotation
+                                                                       ellipsis?
+                                                                       chi-void
+                                                                       chi-local-syntax
+                                                                       chi-lambda-clause
+                                                                       parse-define-syntax
+                                                                       parse-define
+                                                                       parse-import
+                                                                       parse-module
+                                                                       do-import!
+                                                                       chi-internal
+                                                                       chi-body
+                                                                       chi-macro
+                                                                       chi-set!
+                                                                       chi-application
+                                                                       chi-expr
+                                                                       chi
+                                                                       ct-eval/residualize
+                                                                       do-top-import
+                                                                       vfor-each
+                                                                       vmap
+                                                                       chi-external
+                                                                       check-defined-ids
+                                                                       check-module-exports
+                                                                       extend-store!
+                                                                       id-set-diff
+                                                                       chi-top-module
+                                                                       set-module-binding-val!
+                                                                       set-module-binding-imps!
+                                                                       set-module-binding-label!
+                                                                       set-module-binding-id!
+                                                                       set-module-binding-type!
+                                                                       module-binding-val
+                                                                       module-binding-imps
+                                                                       module-binding-label
+                                                                       module-binding-id
+                                                                       module-binding-type
+                                                                       module-binding?
+                                                                       make-module-binding
+                                                                       make-resolved-interface
+                                                                       make-trimmed-interface
+                                                                       set-interface-token!
+                                                                       set-interface-exports!
+                                                                       interface-token
+                                                                       interface-exports
+                                                                       interface?
+                                                                       make-interface
+                                                                       flatten-exports
+                                                                       chi-top
+                                                                       chi-top-expr
+                                                                       syntax-type
+                                                                       chi-when-list
+                                                                       chi-top-sequence
+                                                                       chi-sequence
+                                                                       source-wrap
+                                                                       wrap
+                                                                       bound-id-member?
+                                                                       invalid-ids-error
+                                                                       distinct-bound-ids?
+                                                                       valid-bound-ids?
+                                                                       bound-id=?
+                                                                       literal-id=?
+                                                                       free-id=?
+                                                                       id-var-name
+                                                                       id-var-name-loc
+                                                                       id-var-name&marks
+                                                                       id-var-name-loc&marks
+                                                                       same-marks?
+                                                                       join-marks
+                                                                       join-wraps
+                                                                       smart-append
+                                                                       make-trimmed-syntax-object
+                                                                       make-binding-wrap
+                                                                       lookup-import-binding-name
+                                                                       extend-ribcage-subst!
+                                                                       extend-ribcage-barrier-help!
+                                                                       extend-ribcage-barrier!
+                                                                       extend-ribcage!
+                                                                       make-empty-ribcage
+                                                                       import-token-key
+                                                                       import-token?
+                                                                       make-import-token
+                                                                       barrier-marker
+                                                                       new-mark
+                                                                       anti-mark
+                                                                       the-anti-mark
+                                                                       only-top-marked?
+                                                                       top-marked?
+                                                                       top-wrap
+                                                                       empty-wrap
+                                                                       set-ribcage-labels!
+                                                                       set-ribcage-marks!
+                                                                       set-ribcage-symnames!
+                                                                       ribcage-labels
+                                                                       ribcage-marks
+                                                                       ribcage-symnames
+                                                                       ribcage?
+                                                                       make-ribcage
+                                                                       set-indirect-label!
+                                                                       get-indirect-label
+                                                                       indirect-label?
+                                                                       gen-indirect-label
+                                                                       gen-labels
+                                                                       label?
+                                                                       gen-label
+                                                                       make-rename
+                                                                       rename-marks
+                                                                       rename-new
+                                                                       rename-old
+                                                                       subst-rename?
+                                                                       wrap-subst
+                                                                       wrap-marks
+                                                                       make-wrap
+                                                                       id-sym-name&marks
+                                                                       id-sym-name
+                                                                       id?
+                                                                       nonsymbol-id?
+                                                                       global-extend
+                                                                       lookup
+                                                                       sanitize-binding
+                                                                       lookup*
+                                                                       displaced-lexical-error
+                                                                       transformer-env
+                                                                       extend-var-env*
+                                                                       extend-env*
+                                                                       extend-env
+                                                                       null-env
+                                                                       binding?
+                                                                       set-binding-value!
+                                                                       set-binding-type!
+                                                                       binding-value
+                                                                       binding-type
+                                                                       make-binding
+                                                                       arg-check
+                                                                       source-annotation
+                                                                       no-source
+                                                                       unannotate
+                                                                       set-syntax-object-wrap!
+                                                                       set-syntax-object-expression!
+                                                                       syntax-object-wrap
+                                                                       syntax-object-expression
+                                                                       syntax-object?
+                                                                       make-syntax-object
+                                                                       self-evaluating?
+                                                                       build-lexical-var
+                                                                       build-letrec
+                                                                       build-sequence
+                                                                       build-data
+                                                                       build-primref
+                                                                       build-lambda
+                                                                       build-cte-install
+                                                                       build-module-definition
+                                                                       build-global-definition
+                                                                       build-global-assignment
+                                                                       build-global-reference
+                                                                       build-lexical-assignment
+                                                                       build-lexical-reference
+                                                                       build-conditional
+                                                                       build-application
+                                                                       generate-id
+                                                                       get-import-binding
+                                                                       get-global-definition-hook
+                                                                       put-global-definition-hook
+                                                                       gensym-hook
+                                                                       error-hook
+                                                                       local-eval-hook
+                                                                       top-level-eval-hook
+                                                                       annotation?
+                                                                       fx<
+                                                                       fx=
+                                                                       fx-
+                                                                       fx+
+                                                                       noexpand
+                                                                       define-structure
+                                                                       unless
+                                                                       when)
+                                                                     ((top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top))
+                                                                     ("i" "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"
+                                                                          "i"))
+                                                                   #(ribcage
+                                                                     ((import-token
+                                                                        .
+                                                                        *top*))
+                                                                     ()
+                                                                     ())
+                                                                   #(ribcage
+                                                                     ((import-token
+                                                                        .
+                                                                        *top*))
+                                                                     ()
+                                                                     ())))
+                                                               g931
+                                                               g930)
+                                                         g914
+                                                         '(())
+                                                         g915
+                                                         g916)
+                                                   g914
+                                                   '(())
+                                                   g915
+                                                   g916))
+                                           (g393 g924 g917)
+                                           (g393 g925 g917))
+                                          (values
+                                            'core
+                                            (lambda (g935 g932 g934 g933)
+                                              ((lambda (g937 g936)
+                                                 ((lambda (g938)
+                                                    ((lambda (g939)
+                                                       (if (memv g939
+                                                                 '(lexical))
+                                                           (list 'set!
+                                                                 (g233 g938)
+                                                                 g937)
+                                                           (if (memv g939
+                                                                     '(global))
+                                                               (list 'set!
+                                                                     (g233 g938)
+                                                                     g937)
+                                                               (if (memv g939
+                                                                         '(displaced-lexical))
+                                                                   (syntax-error
+                                                                     (g393 g924
+                                                                           g934)
+                                                                     '"identifier out of context")
+                                                                   (syntax-error
+                                                                     (g394 g935
+                                                                           g934
+                                                                           g933))))))
+                                                     (g232 g938)))
+                                                  (g253 g936 g932)))
+                                               (g432 g925 g932 g934)
+                                               (g377 g924 g934)))
+                                            g918
+                                            g917
+                                            g915)))
+                                    (g232 g928)))
+                                 (g253 g927 g914)))
+                              (g377 g924 g917)))
+                           g920)
+                         ((lambda (g940)
+                            (syntax-error (g394 g918 g917 g915)))
+                          g919)))
+                   ($syntax-dispatch g919 '(any any any))))
+                g918)))
+            (g434
+             (lambda (g1622 g1618 g1621 g1619 g1620)
+               ((lambda (g1623)
+                  ((lambda (g1624)
+                     (if g1624
+                         (apply
+                           (lambda (g1626 g1625)
+                             (cons g1622
+                                   (map (lambda (g1628)
+                                          (g432 g1628 g1621 g1619))
+                                        g1625)))
+                           g1624)
+                         ((lambda (g1629)
+                            (syntax-error (g394 g1618 g1619 g1620)))
+                          g1623)))
+                   ($syntax-dispatch g1623 '(any . each-any))))
+                g1618)))
+            (g433
+             (lambda (g946 g941 g945 g942 g944 g943)
+               ((lambda (g947)
+                  (if (memv g947 '(lexical))
+                      g941
+                      (if (memv g947 '(core))
+                          (g941 g945 g942 g944 g943)
+                          (if (memv g947 '(lexical-call))
+                              (g434 g941 g945 g942 g944 g943)
+                              (if (memv g947 '(constant))
+                                  (list 'quote
+                                        (g450 (g394 g945 g944 g943) '(())))
+                                  (if (memv g947 '(global))
+                                      g941
+                                      (if (memv g947 '(call))
+                                          (g434 (g432 (car g945) g942 g944)
+                                                g945
+                                                g942
+                                                g944
+                                                g943)
+                                          (if (memv g947 '(begin-form))
+                                              ((lambda (g948)
+                                                 ((lambda (g949)
+                                                    (if g949
+                                                        (apply
+                                                          (lambda (g952
+                                                                   g950
+                                                                   g951)
+                                                            (g395 (cons g950
+                                                                        g951)
+                                                                  g942
+                                                                  g944
+                                                                  g943))
+                                                          g949)
+                                                        (syntax-error
+                                                          g948)))
+                                                  ($syntax-dispatch
+                                                    g948
+                                                    '(any any
+                                                          .
+                                                          each-any))))
+                                               g945)
+                                              (if (memv g947
+                                                        '(local-syntax-form))
+                                                  (g445 g941
+                                                        g945
+                                                        g942
+                                                        g944
+                                                        g943
+                                                        g395)
+                                                  (if (memv g947
+                                                            '(eval-when-form))
+                                                      ((lambda (g954)
+                                                         ((lambda (g955)
+                                                            (if g955
+                                                                (apply
+                                                                  (lambda (g959
+                                                                           g956
+                                                                           g958
+                                                                           g957)
+                                                                    ((lambda (g960)
+                                                                       (if (memq 'eval
+                                                                                 g960)
+                                                                           (g395 (cons g958
+                                                                                       g957)
+                                                                                 g942
+                                                                                 g944
+                                                                                 g943)
+                                                                           (g446)))
+                                                                     (g397 g945
+                                                                           g956
+                                                                           g944)))
+                                                                  g955)
+                                                                (syntax-error
+                                                                  g954)))
+                                                          ($syntax-dispatch
+                                                            g954
+                                                            '(any each-any
+                                                                  any
+                                                                  .
+                                                                  each-any))))
+                                                       g945)
+                                                      (if (memv g947
+                                                                '(define-form
+                                                                   define-syntax-form
+                                                                   module-form
+                                                                   import-form))
+                                                          (syntax-error
+                                                            (g394 g945
+                                                                  g944
+                                                                  g943)
+                                                            '"invalid context for definition")
+                                                          (if (memv g947
+                                                                    '(syntax))
+                                                              (syntax-error
+                                                                (g394 g945
+                                                                      g944
+                                                                      g943)
+                                                                '"reference to pattern variable outside syntax form")
+                                                              (if (memv g947
+                                                                        '(displaced-lexical))
+                                                                  (g250 (g394 g945
+                                                                              g944
+                                                                              g943))
+                                                                  (syntax-error
+                                                                    (g394 g945
+                                                                          g944
+                                                                          g943)))))))))))))))
+                g946)))
+            (g432
+             (lambda (g1612 g1610 g1611)
+               (call-with-values
+                 (lambda () (g398 g1612 g1610 g1611 '#f '#f))
+                 (lambda (g1617 g1613 g1616 g1614 g1615)
+                   (g433 g1617 g1613 g1616 g1610 g1614 g1615)))))
+            (g431
+             (lambda (g965 g963 g964)
+               ((lambda (g966)
+                  (if (memv g966 '(c))
+                      (if (memq 'compile g963)
+                          ((lambda (g967)
+                             (begin (g91 g967)
+                                    (if (memq 'load g963) g967 (g446))))
+                           (g964))
+                          (if (memq 'load g963) (g964) (g446)))
+                      (if (memv g966 '(c&e))
+                          ((lambda (g968) (begin (g91 g968) g968)) (g964))
+                          (begin (if (memq 'eval g963) (g91 (g964)) (void))
+                                 (g446)))))
+                g965)))
+            (g430
+             (lambda (g1609 g1608)
+               (list '$sc-put-cte
+                     (list 'quote g1609)
+                     (list 'quote (g231 'do-import g1608)))))
+            (g429
+             (lambda (g970 g969)
+               ((lambda (g971)
+                  ((letrec ((g972
+                             (lambda (g973)
+                               (if (not (= g973 g971))
+                                   (begin (g970 (vector-ref g969 g973))
+                                          (g972 (+ g973 '1)))
+                                   (void)))))
+                     g972)
+                   '0))
+                (vector-length g969))))
+            (g428
+             (lambda (g1604 g1603)
+               ((letrec ((g1605
+                          (lambda (g1607 g1606)
+                            (if (< g1607 '0)
+                                g1606
+                                (g1605
+                                  (- g1607 '1)
+                                  (cons (g1604 (vector-ref g1603 g1607))
+                                        g1606))))))
+                  g1605)
+                (- (vector-length g1603) '1)
+                '())))
+            (g427
+             (lambda (g982 g974 g981 g975 g980 g976 g979 g977 g978)
+               (letrec ((g985
+                         (lambda (g1050 g1049)
+                           ((lambda (g1051)
+                              (map (lambda (g1052)
+                                     ((lambda (g1053)
+                                        (if (not (g392 g1053 g1051))
+                                            g1052
+                                            (g410 (g412 g1052)
+                                                  g1053
+                                                  (g414 g1052)
+                                                  (append
+                                                    (g984 g1053)
+                                                    (g415 g1052))
+                                                  (g416 g1052))))
+                                      (g413 g1052)))
+                                   g1050))
+                            (map (lambda (g1054)
+                                   (if (pair? g1054) (car g1054) g1054))
+                                 g1049))))
+                        (g984
+                         (lambda (g1043)
+                           ((letrec ((g1044
+                                      (lambda (g1045)
+                                        (if (null? g1045)
+                                            '()
+                                            (if (if (pair? (car g1045))
+                                                    (g388 g1043
+                                                          (caar g1045))
+                                                    '#f)
+                                                (g401 (cdar g1045))
+                                                (g1044 (cdr g1045)))))))
+                              g1044)
+                            g980)))
+                        (g983
+                         (lambda (g1048 g1046 g1047)
+                           (begin (g426 g974 g1046)
+                                  (g425 g974 g976 g1046)
+                                  (g978 g1048 g1047)))))
+                 ((letrec ((g986
+                            (lambda (g990 g987 g989 g988)
+                              (if (null? g990)
+                                  (g983 g989 g987 g988)
+                                  ((lambda (g992 g991)
+                                     (call-with-values
+                                       (lambda ()
+                                         (g398 g992 g991 '(()) '#f g982))
+                                       (lambda (g997 g993 g996 g994 g995)
+                                         ((lambda (g998)
+                                            (if (memv g998 '(define-form))
+                                                (g442 g996
+                                                      g994
+                                                      g995
+                                                      (lambda (g1001
+                                                               g999
+                                                               g1000)
+                                                        ((lambda (g1002)
+                                                           ((lambda (g1003)
+                                                              ((lambda (g1004)
+                                                                 ((lambda ()
+                                                                    (begin (g363 g982
+                                                                                 g1002
+                                                                                 g1003)
+                                                                           (g986 (cdr g990)
+                                                                                 (cons g1002
+                                                                                       g987)
+                                                                                 (cons (g410 g997
+                                                                                             g1002
+                                                                                             g1003
+                                                                                             g1004
+                                                                                             (cons g991
+                                                                                                   (g393 g999
+                                                                                                         g1000)))
+                                                                                       g989)
+                                                                                 g988)))))
+                                                               (g984 g1002)))
+                                                            (g300)))
+                                                         (g393 g1001
+                                                               g1000))))
+                                                (if (memv g998
+                                                          '(define-syntax-form))
+                                                    (g443 g996
+                                                          g994
+                                                          g995
+                                                          (lambda (g1007
+                                                                   g1005
+                                                                   g1006)
+                                                            ((lambda (g1008)
+                                                               ((lambda (g1009)
+                                                                  ((lambda (g1010)
+                                                                     ((lambda (g1011)
+                                                                        ((lambda ()
+                                                                           (begin (g424 g975
+                                                                                        (g302 g1009)
+                                                                                        (cons 'deferred
+                                                                                              g1011))
+                                                                                  (g363 g982
+                                                                                        g1008
+                                                                                        g1009)
+                                                                                  (g986 (cdr g990)
+                                                                                        (cons g1008
+                                                                                              g987)
+                                                                                        (cons (g410 g997
+                                                                                                    g1008
+                                                                                                    g1009
+                                                                                                    g1010
+                                                                                                    g1011)
+                                                                                              g989)
+                                                                                        g988)))))
+                                                                      (g432 g1005
+                                                                            (g249 g991)
+                                                                            g1006)))
+                                                                   (g984 g1008)))
+                                                                (g300)))
+                                                             (g393 g1007
+                                                                   g1006))))
+                                                    (if (memv g998
+                                                              '(module-form))
+                                                        ((lambda (g1012)
+                                                           ((lambda (g1013)
+                                                              ((lambda ()
+                                                                 (g440 g996
+                                                                       g994
+                                                                       g995
+                                                                       g1013
+                                                                       (lambda (g1016
+                                                                                g1014
+                                                                                g1015)
+                                                                         (g427 g1012
+                                                                               (g394 g996
+                                                                                     g994
+                                                                                     g995)
+                                                                               (map (lambda (g1024)
+                                                                                      (cons g991
+                                                                                            g1024))
+                                                                                    g1015)
+                                                                               g975
+                                                                               g1014
+                                                                               (g401 g1014)
+                                                                               g979
+                                                                               g977
+                                                                               (lambda (g1018
+                                                                                        g1017)
+                                                                                 ((lambda (g1019)
+                                                                                    ((lambda (g1020)
+                                                                                       ((lambda (g1021)
+                                                                                          ((lambda ()
+                                                                                             (if g1016
+                                                                                                 ((lambda (g1023
+                                                                                                           g1022)
+                                                                                                    (begin (g424 g975
+                                                                                                                 (g302 g1023)
+                                                                                                                 (g231 'module
+                                                                                                                       g1019))
+                                                                                                           (g363 g982
+                                                                                                                 g1016
+                                                                                                                 g1023)
+                                                                                                           (g986 (cdr g990)
+                                                                                                                 (cons g1016
+                                                                                                                       g987)
+                                                                                                                 (cons (g410 g997
+                                                                                                                             g1016
+                                                                                                                             g1023
+                                                                                                                             g1022
+                                                                                                                             g1014)
+                                                                                                                       g1020)
+                                                                                                                 g1021)))
+                                                                                                  (g300)
+                                                                                                  (g984 g1016))
+                                                                                                 ((lambda ()
+                                                                                                    (begin (g439 g1019
+                                                                                                                 g982)
+                                                                                                           (g986 (cdr g990)
+                                                                                                                 (cons g1019
+                                                                                                                       g987)
+                                                                                                                 g1020
+                                                                                                                 g1021))))))))
+                                                                                        (append
+                                                                                          g988
+                                                                                          g1017)))
+                                                                                     (append
+                                                                                       (if g1016
+                                                                                           g1018
+                                                                                           (g985 g1018
+                                                                                                 g1014))
+                                                                                       g989)))
+                                                                                  (g408 g1014)))))))))
+                                                            (g263 (g264 g994)
+                                                                  (cons g1012
+                                                                        (g265 g994)))))
+                                                         (g304 '()
+                                                               '()
+                                                               '()))
+                                                        (if (memv g998
+                                                                  '(import-form))
+                                                            (g441 g996
+                                                                  g994
+                                                                  g995
+                                                                  (lambda (g1025)
+                                                                    ((lambda (g1026)
+                                                                       ((lambda (g1027)
+                                                                          ((lambda (g1028)
+                                                                             (if (memv g1028
+                                                                                       '(module))
+                                                                                 ((lambda (g1029)
+                                                                                    (begin (if g993
+                                                                                               (g364 g982
+                                                                                                     g993)
+                                                                                               (void))
+                                                                                           (g439 g1029
+                                                                                                 g982)
+                                                                                           (g986 (cdr g990)
+                                                                                                 (cons g1029
+                                                                                                       g987)
+                                                                                                 (g985 g989
+                                                                                                       (vector->list
+                                                                                                         (g404 g1029)))
+                                                                                                 g988)))
+                                                                                  (g233 g1027))
+                                                                                 (if (memv g1028
+                                                                                           '(displaced-lexical))
+                                                                                     (g250 g1025)
+                                                                                     (syntax-error
+                                                                                       g1025
+                                                                                       '"import from unknown module"))))
+                                                                           (g232 g1027)))
+                                                                        (g253 g1026
+                                                                              g975)))
+                                                                     (g377 g1025
+                                                                           '(())))))
+                                                            (if (memv g998
+                                                                      '(begin-form))
+                                                                ((lambda (g1030)
+                                                                   ((lambda (g1031)
+                                                                      (if g1031
+                                                                          (apply
+                                                                            (lambda (g1033
+                                                                                     g1032)
+                                                                              (g986 ((letrec ((g1034
+                                                                                               (lambda (g1035)
+                                                                                                 (if (null?
+                                                                                                       g1035)
+                                                                                                     (cdr g990)
+                                                                                                     (cons (cons g991
+                                                                                                                 (g393 (car g1035)
+                                                                                                                       g994))
+                                                                                                           (g1034
+                                                                                                             (cdr g1035)))))))
+                                                                                       g1034)
+                                                                                     g1032)
+                                                                                    g987
+                                                                                    g989
+                                                                                    g988))
+                                                                            g1031)
+                                                                          (syntax-error
+                                                                            g1030)))
+                                                                    ($syntax-dispatch
+                                                                      g1030
+                                                                      '(any .
+                                                                            each-any))))
+                                                                 g996)
+                                                                (if (memv g998
+                                                                          '(local-syntax-form))
+                                                                    (g445 g993
+                                                                          g996
+                                                                          g991
+                                                                          g994
+                                                                          g995
+                                                                          (lambda (g1040
+                                                                                   g1037
+                                                                                   g1039
+                                                                                   g1038)
+                                                                            (g986 ((letrec ((g1041
+                                                                                             (lambda (g1042)
+                                                                                               (if (null?
+                                                                                                     g1042)
+                                                                                                   (cdr g990)
+                                                                                                   (cons (cons g1037
+                                                                                                               (g393 (car g1042)
+                                                                                                                     g1039))
+                                                                                                         (g1041
+                                                                                                           (cdr g1042)))))))
+                                                                                     g1041)
+                                                                                   g1040)
+                                                                                  g987
+                                                                                  g989
+                                                                                  g988)))
+                                                                    (g983 g989
+                                                                          g987
+                                                                          (append
+                                                                            g988
+                                                                            (cons (cons g991
+                                                                                        (g394 g996
+                                                                                              g994
+                                                                                              g995))
+                                                                                  (cdr g990)))))))))))
+                                          g997))))
+                                   (cdar g990)
+                                   (caar g990))))))
+                    g986)
+                  g981
+                  '()
+                  '()
+                  '()))))
+            (g426
+             (lambda (g1560 g1559)
+               (letrec ((g1564
+                         (lambda (g1597 g1595 g1596)
+                           ((lambda (g1598)
+                              (if g1598
+                                  (if (g367 ((lambda (g1599)
+                                               ((lambda (g1600)
+                                                  (if (g90 g1600)
+                                                      (annotation-expression
+                                                        g1600)
+                                                      g1600))
+                                                (if (g204 g1599)
+                                                    (g205 g1599)
+                                                    g1599)))
+                                             g1597)
+                                            g1598
+                                            (if (symbol? g1597)
+                                                (g264 '((top)))
+                                                (g264 (g206 g1597))))
+                                      (cons g1597 g1596)
+                                      g1596)
+                                  (g1562
+                                    (g404 g1595)
+                                    (lambda (g1602 g1601)
+                                      (if (g1561 g1602 g1597)
+                                          (cons g1602 g1601)
+                                          g1601))
+                                    g1596)))
+                            (g405 g1595))))
+                        (g1563
+                         (lambda (g1575 g1573 g1574)
+                           (if (g403 g1575)
+                               (if (g403 g1573)
+                                   (call-with-values
+                                     (lambda ()
+                                       ((lambda (g1581 g1580)
+                                          (if (fx> (vector-length g1581)
+                                                   (vector-length g1580))
+                                              (values g1575 g1580)
+                                              (values g1573 g1581)))
+                                        (g404 g1575)
+                                        (g404 g1573)))
+                                     (lambda (g1577 g1576)
+                                       (g1562
+                                         g1576
+                                         (lambda (g1579 g1578)
+                                           (g1564 g1579 g1577 g1578))
+                                         g1574)))
+                                   (g1564 g1573 g1575 g1574))
+                               (if (g403 g1573)
+                                   (g1564 g1575 g1573 g1574)
+                                   (if (g1561 g1575 g1573)
+                                       (cons g1575 g1574)
+                                       g1574)))))
+                        (g1562
+                         (lambda (g1590 g1588 g1589)
+                           ((lambda (g1591)
+                              ((letrec ((g1592
+                                         (lambda (g1594 g1593)
+                                           (if (= g1594 g1591)
+                                               g1593
+                                               (g1592
+                                                 (+ g1594 '1)
+                                                 (g1588
+                                                   (vector-ref g1590 g1594)
+                                                   g1593))))))
+                                 g1592)
+                               '0
+                               g1589))
+                            (vector-length g1590))))
+                        (g1561
+                         (lambda (g1583 g1582)
+                           (if (symbol? g1583)
+                               (if (symbol? g1582)
+                                   (eq? g1583 g1582)
+                                   (if (eq? g1583
+                                            ((lambda (g1584)
+                                               ((lambda (g1585)
+                                                  (if (g90 g1585)
+                                                      (annotation-expression
+                                                        g1585)
+                                                      g1585))
+                                                (if (g204 g1584)
+                                                    (g205 g1584)
+                                                    g1584)))
+                                             g1582))
+                                       (g373 (g264 (g206 g1582))
+                                             (g264 '((top))))
+                                       '#f))
+                               (if (symbol? g1582)
+                                   (if (eq? g1582
+                                            ((lambda (g1586)
+                                               ((lambda (g1587)
+                                                  (if (g90 g1587)
+                                                      (annotation-expression
+                                                        g1587)
+                                                      g1587))
+                                                (if (g204 g1586)
+                                                    (g205 g1586)
+                                                    g1586)))
+                                             g1583))
+                                       (g373 (g264 (g206 g1583))
+                                             (g264 '((top))))
+                                       '#f)
+                                   (g388 g1583 g1582))))))
+                 (if (not (null? g1559))
+                     ((letrec ((g1565
+                                (lambda (g1568 g1566 g1567)
+                                  (if (null? g1566)
+                                      (if (not (null? g1567))
+                                          ((lambda (g1569)
+                                             (syntax-error
+                                               g1560
+                                               '"duplicate definition for "
+                                               (symbol->string (car g1569))
+                                               '" in"))
+                                           (syntax-object->datum g1567))
+                                          (void))
+                                      ((letrec ((g1570
+                                                 (lambda (g1572 g1571)
+                                                   (if (null? g1572)
+                                                       (g1565
+                                                         (car g1566)
+                                                         (cdr g1566)
+                                                         g1571)
+                                                       (g1570
+                                                         (cdr g1572)
+                                                         (g1563
+                                                           g1568
+                                                           (car g1572)
+                                                           g1571))))))
+                                         g1570)
+                                       g1566
+                                       g1567)))))
+                        g1565)
+                      (car g1559)
+                      (cdr g1559)
+                      '())
+                     (void)))))
+            (g425
+             (lambda (g1057 g1055 g1056)
+               (letrec ((g1058
+                         (lambda (g1065 g1064)
+                           (ormap
+                             (lambda (g1066)
+                               (if (g403 g1066)
+                                   ((lambda (g1067)
+                                      (if g1067
+                                          (g367 ((lambda (g1068)
+                                                   ((lambda (g1069)
+                                                      (if (g90 g1069)
+                                                          (annotation-expression
+                                                            g1069)
+                                                          g1069))
+                                                    (if (g204 g1068)
+                                                        (g205 g1068)
+                                                        g1068)))
+                                                 g1065)
+                                                g1067
+                                                (g264 (g206 g1065)))
+                                          ((lambda (g1070)
+                                             ((letrec ((g1071
+                                                        (lambda (g1072)
+                                                          (if (fx>= g1072
+                                                                    '0)
+                                                              ((lambda (g1073)
+                                                                 (if g1073
+                                                                     g1073
+                                                                     (g1071
+                                                                       (- g1072
+                                                                          '1))))
+                                                               (g388 g1065
+                                                                     (vector-ref
+                                                                       g1070
+                                                                       g1072)))
+                                                              '#f))))
+                                                g1071)
+                                              (- (vector-length g1070)
+                                                 '1)))
+                                           (g404 g1066))))
+                                    (g405 g1066))
+                                   (g388 g1065 g1066)))
+                             g1064))))
+                 ((letrec ((g1059
+                            (lambda (g1061 g1060)
+                              (if (null? g1061)
+                                  (if (not (null? g1060))
+                                      (syntax-error
+                                        g1060
+                                        '"missing definition for export(s)")
+                                      (void))
+                                  ((lambda (g1063 g1062)
+                                     (if (g1058 g1063 g1056)
+                                         (g1059 g1062 g1060)
+                                         (g1059 g1062 (cons g1063 g1060))))
+                                   (car g1061)
+                                   (cdr g1061))))))
+                    g1059)
+                  g1055
+                  '()))))
+            (g424
+             (lambda (g1558 g1556 g1557)
+               (set-cdr! g1558 (g246 g1556 g1557 (cdr g1558)))))
+            (g423
+             (lambda (g1075 g1074)
+               (if (null? g1075)
+                   '()
+                   (if (g392 (car g1075) g1074)
+                       (g423 (cdr g1075) g1074)
+                       (cons (car g1075) (g423 (cdr g1075) g1074))))))
+            (g422
+             (lambda (g1491
+                      g1482
+                      g1490
+                      g1483
+                      g1489
+                      g1484
+                      g1488
+                      g1485
+                      g1487
+                      g1486)
+               ((lambda (g1492)
+                  (g427 g1490
+                        (g394 g1491 g1483 g1489)
+                        (map (lambda (g1555) (cons g1482 g1555)) g1486)
+                        g1482
+                        g1487
+                        g1492
+                        g1484
+                        g1488
+                        (lambda (g1494 g1493)
+                          ((letrec ((g1495
+                                     (lambda (g1500
+                                              g1496
+                                              g1499
+                                              g1497
+                                              g1498)
+                                       (if (null? g1500)
+                                           ((letrec ((g1501
+                                                      (lambda (g1504
+                                                               g1502
+                                                               g1503)
+                                                        (if (null? g1504)
+                                                            ((lambda (g1507
+                                                                      g1505
+                                                                      g1506)
+                                                               (begin (for-each
+                                                                        (lambda (g1523)
+                                                                          (apply
+                                                                            (lambda (g1527
+                                                                                     g1524
+                                                                                     g1526
+                                                                                     g1525)
+                                                                              (if g1524
+                                                                                  (g303 g1524
+                                                                                        g1526)
+                                                                                  (void)))
+                                                                            g1523))
+                                                                        g1498)
+                                                                      (g190 '#f
+                                                                            (list (g431 g1484
+                                                                                        g1488
+                                                                                        (lambda ()
+                                                                                          (if (null?
+                                                                                                g1498)
+                                                                                              (g446)
+                                                                                              (g190 '#f
+                                                                                                    (map (lambda (g1518)
+                                                                                                           (apply
+                                                                                                             (lambda (g1522
+                                                                                                                      g1519
+                                                                                                                      g1521
+                                                                                                                      g1520)
+                                                                                                               (list '$sc-put-cte
+                                                                                                                     (list 'quote
+                                                                                                                           g1521)
+                                                                                                                     (if (eq? g1522
+                                                                                                                              'define-syntax-form)
+                                                                                                                         g1520
+                                                                                                                         (list 'quote
+                                                                                                                               (g231 'module
+                                                                                                                                     (g409 g1520
+                                                                                                                                           g1521))))))
+                                                                                                             g1518))
+                                                                                                         g1498)))))
+                                                                                  (g431 g1484
+                                                                                        g1488
+                                                                                        (lambda ()
+                                                                                          ((lambda (g1508)
+                                                                                             ((lambda (g1509)
+                                                                                                ((lambda (g1510)
+                                                                                                   ((lambda ()
+                                                                                                      (if g1508
+                                                                                                          (list '$sc-put-cte
+                                                                                                                (list 'quote
+                                                                                                                      (if (g373 (g264 (g206 g1485))
+                                                                                                                                (g264 '((top))))
+                                                                                                                          g1508
+                                                                                                                          ((lambda (g1511)
+                                                                                                                             (g203 g1508
+                                                                                                                                   (g263 g1511
+                                                                                                                                         (list (g304 (vector
+                                                                                                                                                       g1508)
+                                                                                                                                                     (vector
+                                                                                                                                                       g1511)
+                                                                                                                                                     (vector
+                                                                                                                                                       (g101 g1508)))))))
+                                                                                                                           (g264 (g206 g1485)))))
+                                                                                                                g1510)
+                                                                                                          ((lambda (g1512)
+                                                                                                             (g190 '#f
+                                                                                                                   (list (list '$sc-put-cte
+                                                                                                                               (list 'quote
+                                                                                                                                     g1512)
+                                                                                                                               g1510)
+                                                                                                                         (g430 g1512
+                                                                                                                               g1509))))
+                                                                                                           (g101 'tmp))))))
+                                                                                                 (list 'quote
+                                                                                                       (g231 'module
+                                                                                                             (g409 g1487
+                                                                                                                   g1509)))))
+                                                                                              (g101 g1508)))
+                                                                                           (if g1485
+                                                                                               ((lambda (g1513)
+                                                                                                  ((lambda (g1514)
+                                                                                                     (if (g90 g1514)
+                                                                                                         (annotation-expression
+                                                                                                           g1514)
+                                                                                                         g1514))
+                                                                                                   (if (g204 g1513)
+                                                                                                       (g205 g1513)
+                                                                                                       g1513)))
+                                                                                                g1485)
+                                                                                               '#f))))
+                                                                                  (g190 '#f
+                                                                                        (map (lambda (g1517)
+                                                                                               (list 'define
+                                                                                                     g1517
+                                                                                                     (g446)))
+                                                                                             g1499))
+                                                                                  (g191 '#f
+                                                                                        g1502
+                                                                                        g1505
+                                                                                        (g190 '#f
+                                                                                              (list (if (null?
+                                                                                                          g1499)
+                                                                                                        (g446)
+                                                                                                        (g190 '#f
+                                                                                                              (map (lambda (g1516
+                                                                                                                            g1515)
+                                                                                                                     (list 'set!
+                                                                                                                           g1516
+                                                                                                                           g1515))
+                                                                                                                   g1499
+                                                                                                                   g1507)))
+                                                                                                    (if (null?
+                                                                                                          g1506)
+                                                                                                        (g446)
+                                                                                                        (g190 '#f
+                                                                                                              g1506)))))
+                                                                                  (g446)))))
+                                                             (map (lambda (g1530)
+                                                                    (g432 (cdr g1530)
+                                                                          (car g1530)
+                                                                          '(())))
+                                                                  g1497)
+                                                             (map (lambda (g1528)
+                                                                    (g432 (cdr g1528)
+                                                                          (car g1528)
+                                                                          '(())))
+                                                                  g1503)
+                                                             (map (lambda (g1529)
+                                                                    (g432 (cdr g1529)
+                                                                          (car g1529)
+                                                                          '(())))
+                                                                  g1493))
+                                                            ((lambda (g1531)
+                                                               ((lambda (g1532)
+                                                                  (if (memv g1532
+                                                                            '(define-form))
+                                                                      ((lambda (g1533)
+                                                                         (begin (g424 g1482
+                                                                                      (g302 (g414 g1531))
+                                                                                      (g231 'lexical
+                                                                                            g1533))
+                                                                                (g1501
+                                                                                  (cdr g1504)
+                                                                                  (cons g1533
+                                                                                        g1502)
+                                                                                  (cons (g416 g1531)
+                                                                                        g1503))))
+                                                                       (g451 (g413 g1531)))
+                                                                      (if (memv g1532
+                                                                                '(define-syntax-form
+                                                                                   module-form))
+                                                                          (g1501
+                                                                            (cdr g1504)
+                                                                            g1502
+                                                                            g1503)
+                                                                          (error 'sc-expand-internal
+                                                                            '"unexpected module binding type"))))
+                                                                (g412 g1531)))
+                                                             (car g1504))))))
+                                              g1501)
+                                            g1496
+                                            '()
+                                            '())
+                                           ((lambda (g1535 g1534)
+                                              (letrec ((g1536
+                                                        (lambda (g1551
+                                                                 g1548
+                                                                 g1550
+                                                                 g1549)
+                                                          ((letrec ((g1552
+                                                                     (lambda (g1554
+                                                                              g1553)
+                                                                       (if (null?
+                                                                             g1554)
+                                                                           (g1549)
+                                                                           (if (g388 (g413 (car g1554))
+                                                                                     g1551)
+                                                                               (g1550
+                                                                                 (car g1554)
+                                                                                 (g370 (reverse
+                                                                                         g1553)
+                                                                                       (cdr g1554)))
+                                                                               (g1552
+                                                                                 (cdr g1554)
+                                                                                 (cons (car g1554)
+                                                                                       g1553)))))))
+                                                             g1552)
+                                                           g1548
+                                                           '()))))
+                                                (g1536
+                                                  g1535
+                                                  g1496
+                                                  (lambda (g1538 g1537)
+                                                    ((lambda (g1541
+                                                              g1539
+                                                              g1540)
+                                                       ((lambda (g1543
+                                                                 g1542)
+                                                          ((lambda (g1544)
+                                                             (if (memv g1544
+                                                                       '(define-form))
+                                                                 (begin (g303 g1539
+                                                                              g1542)
+                                                                        (g1495
+                                                                          g1543
+                                                                          g1537
+                                                                          (cons g1542
+                                                                                g1499)
+                                                                          (cons (g416 g1538)
+                                                                                g1497)
+                                                                          g1498))
+                                                                 (if (memv g1544
+                                                                           '(define-syntax-form))
+                                                                     (g1495
+                                                                       g1543
+                                                                       g1537
+                                                                       g1499
+                                                                       g1497
+                                                                       (cons (list g1541
+                                                                                   g1539
+                                                                                   g1542
+                                                                                   (g416 g1538))
+                                                                             g1498))
+                                                                     (if (memv g1544
+                                                                               '(module-form))
+                                                                         ((lambda (g1545)
+                                                                            (g1495
+                                                                              (append
+                                                                                (g401 g1545)
+                                                                                g1543)
+                                                                              g1537
+                                                                              g1499
+                                                                              g1497
+                                                                              (cons (list g1541
+                                                                                          g1539
+                                                                                          g1542
+                                                                                          g1545)
+                                                                                    g1498)))
+                                                                          (g416 g1538))
+                                                                         (error 'sc-expand-internal
+                                                                           '"unexpected module binding type")))))
+                                                           g1541))
+                                                        (append
+                                                          g1540
+                                                          g1534)
+                                                        (g101 ((lambda (g1546)
+                                                                 ((lambda (g1547)
+                                                                    (if (g90 g1547)
+                                                                        (annotation-expression
+                                                                          g1547)
+                                                                        g1547))
+                                                                  (if (g204 g1546)
+                                                                      (g205 g1546)
+                                                                      g1546)))
+                                                               g1535))))
+                                                     (g412 g1538)
+                                                     (g414 g1538)
+                                                     (g415 g1538)))
+                                                  (lambda ()
+                                                    (g1495
+                                                      g1534
+                                                      g1496
+                                                      g1499
+                                                      g1497
+                                                      g1498)))))
+                                            (car g1500)
+                                            (cdr g1500))))))
+                             g1495)
+                           g1492
+                           g1494
+                           '()
+                           '()
+                           '()))))
+                (g401 g1487))))
+            (g421 (lambda (g1077 g1076) (vector-set! g1077 '5 g1076)))
+            (g420 (lambda (g1481 g1480) (vector-set! g1481 '4 g1480)))
+            (g419 (lambda (g1079 g1078) (vector-set! g1079 '3 g1078)))
+            (g418 (lambda (g1479 g1478) (vector-set! g1479 '2 g1478)))
+            (g417 (lambda (g1081 g1080) (vector-set! g1081 '1 g1080)))
+            (g416 (lambda (g1477) (vector-ref g1477 '5)))
+            (g415 (lambda (g1082) (vector-ref g1082 '4)))
+            (g414 (lambda (g1476) (vector-ref g1476 '3)))
+            (g413 (lambda (g1083) (vector-ref g1083 '2)))
+            (g412 (lambda (g1475) (vector-ref g1475 '1)))
+            (g411
+             (lambda (g1084)
+               (if (vector? g1084)
+                   (if (= (vector-length g1084) '6)
+                       (eq? (vector-ref g1084 '0) 'module-binding)
+                       '#f)
+                   '#f)))
+            (g410
+             (lambda (g1474 g1470 g1473 g1471 g1472)
+               (vector 'module-binding g1474 g1470 g1473 g1471 g1472)))
+            (g409
+             (lambda (g1086 g1085)
+               (g402 (list->vector
+                       (map (lambda (g1087)
+                              (g369 (if (pair? g1087) (car g1087) g1087)))
+                            g1086))
+                     g1085)))
+            (g408
+             (lambda (g1468)
+               (g402 (list->vector
+                       (map (lambda (g1469)
+                              (if (pair? g1469) (car g1469) g1469))
+                            g1468))
+                     '#f)))
+            (g407 (lambda (g1089 g1088) (vector-set! g1089 '2 g1088)))
+            (g406 (lambda (g1467 g1466) (vector-set! g1467 '1 g1466)))
+            (g405 (lambda (g1090) (vector-ref g1090 '2)))
+            (g404 (lambda (g1465) (vector-ref g1465 '1)))
+            (g403
+             (lambda (g1091)
+               (if (vector? g1091)
+                   (if (= (vector-length g1091) '3)
+                       (eq? (vector-ref g1091 '0) 'interface)
+                       '#f)
+                   '#f)))
+            (g402
+             (lambda (g1464 g1463) (vector 'interface g1464 g1463)))
+            (g401
+             (lambda (g1092)
+               ((letrec ((g1093
+                          (lambda (g1095 g1094)
+                            (if (null? g1095)
+                                g1094
+                                (g1093
+                                  (cdr g1095)
+                                  (if (pair? (car g1095))
+                                      (g1093 (car g1095) g1094)
+                                      (cons (car g1095) g1094)))))))
+                  g1093)
+                g1092
+                '())))
+            (g400
+             (lambda (g1390 g1385 g1389 g1386 g1388 g1387)
+               (call-with-values
+                 (lambda () (g398 g1390 g1385 g1389 '#f g1387))
+                 (lambda (g1401 g1397 g1400 g1398 g1399)
+                   ((lambda (g1402)
+                      (if (memv g1402 '(begin-form))
+                          ((lambda (g1403)
+                             ((lambda (g1404)
+                                (if g1404
+                                    (apply (lambda (g1405) (g446)) g1404)
+                                    ((lambda (g1406)
+                                       (if g1406
+                                           (apply
+                                             (lambda (g1409 g1407 g1408)
+                                               (g396 (cons g1407 g1408)
+                                                     g1385
+                                                     g1398
+                                                     g1399
+                                                     g1386
+                                                     g1388
+                                                     g1387))
+                                             g1406)
+                                           (syntax-error g1403)))
+                                     ($syntax-dispatch
+                                       g1403
+                                       '(any any . each-any)))))
+                              ($syntax-dispatch g1403 '(any))))
+                           g1400)
+                          (if (memv g1402 '(local-syntax-form))
+                              (g445 g1397
+                                    g1400
+                                    g1385
+                                    g1398
+                                    g1399
+                                    (lambda (g1414 g1411 g1413 g1412)
+                                      (g396 g1414
+                                            g1411
+                                            g1413
+                                            g1412
+                                            g1386
+                                            g1388
+                                            g1387)))
+                              (if (memv g1402 '(eval-when-form))
+                                  ((lambda (g1415)
+                                     ((lambda (g1416)
+                                        (if g1416
+                                            (apply
+                                              (lambda (g1420
+                                                       g1417
+                                                       g1419
+                                                       g1418)
+                                                ((lambda (g1422 g1421)
+                                                   (if (eq? g1386 'e)
+                                                       (if (memq 'eval
+                                                                 g1422)
+                                                           (g396 g1421
+                                                                 g1385
+                                                                 g1398
+                                                                 g1399
+                                                                 'e
+                                                                 '(eval)
+                                                                 g1387)
+                                                           (g446))
+                                                       (if (memq 'load
+                                                                 g1422)
+                                                           (if ((lambda (g1423)
+                                                                  (if g1423
+                                                                      g1423
+                                                                      (if (eq? g1386
+                                                                               'c&e)
+                                                                          (memq 'eval
+                                                                                g1422)
+                                                                          '#f)))
+                                                                (memq 'compile
+                                                                      g1422))
+                                                               (g396 g1421
+                                                                     g1385
+                                                                     g1398
+                                                                     g1399
+                                                                     'c&e
+                                                                     '(compile
+                                                                        load)
+                                                                     g1387)
+                                                               (if (memq g1386
+                                                                         '(c c&e))
+                                                                   (g396 g1421
+                                                                         g1385
+                                                                         g1398
+                                                                         g1399
+                                                                         'c
+                                                                         '(load)
+                                                                         g1387)
+                                                                   (g446)))
+                                                           (if ((lambda (g1424)
+                                                                  (if g1424
+                                                                      g1424
+                                                                      (if (eq? g1386
+                                                                               'c&e)
+                                                                          (memq 'eval
+                                                                                g1422)
+                                                                          '#f)))
+                                                                (memq 'compile
+                                                                      g1422))
+                                                               (begin (g91 (g396 g1421
+                                                                                 g1385
+                                                                                 g1398
+                                                                                 g1399
+                                                                                 'e
+                                                                                 '(eval)
+                                                                                 g1387))
+                                                                      (g446))
+                                                               (g446)))))
+                                                 (g397 g1400 g1417 g1398)
+                                                 (cons g1419 g1418)))
+                                              g1416)
+                                            (syntax-error g1415)))
+                                      ($syntax-dispatch
+                                        g1415
+                                        '(any each-any any . each-any))))
+                                   g1400)
+                                  (if (memv g1402 '(define-syntax-form))
+                                      (g443 g1400
+                                            g1398
+                                            g1399
+                                            (lambda (g1429 g1427 g1428)
+                                              ((lambda (g1430)
+                                                 (begin ((lambda (g1435)
+                                                           ((lambda (g1436)
+                                                              ((lambda (g1437)
+                                                                 (if (memv g1437
+                                                                           '(displaced-lexical))
+                                                                     (g250 g1430)
+                                                                     (void)))
+                                                               (g232 g1436)))
+                                                            (g253 g1435
+                                                                  g1385)))
+                                                         (g377 g1430
+                                                               '(())))
+                                                        (g431 g1386
+                                                              g1388
+                                                              (lambda ()
+                                                                (list '$sc-put-cte
+                                                                      (list 'quote
+                                                                            ((lambda (g1431)
+                                                                               (if (g373 (g264 (g206 g1430))
+                                                                                         (g264 '((top))))
+                                                                                   g1431
+                                                                                   ((lambda (g1432)
+                                                                                      (g203 g1431
+                                                                                            (g263 g1432
+                                                                                                  (list (g304 (vector
+                                                                                                                g1431)
+                                                                                                              (vector
+                                                                                                                g1432)
+                                                                                                              (vector
+                                                                                                                (g101 g1431)))))))
+                                                                                    (g264 (g206 g1430)))))
+                                                                             ((lambda (g1433)
+                                                                                ((lambda (g1434)
+                                                                                   (if (g90 g1434)
+                                                                                       (annotation-expression
+                                                                                         g1434)
+                                                                                       g1434))
+                                                                                 (if (g204 g1433)
+                                                                                     (g205 g1433)
+                                                                                     g1433)))
+                                                                              g1430)))
+                                                                      (g432 g1427
+                                                                            (g249 g1385)
+                                                                            g1428))))))
+                                               (g393 g1429 g1428))))
+                                      (if (memv g1402 '(define-form))
+                                          (g442 g1400
+                                                g1398
+                                                g1399
+                                                (lambda (g1440 g1438 g1439)
+                                                  ((lambda (g1441)
+                                                     (begin ((lambda (g1448)
+                                                               ((lambda (g1449)
+                                                                  ((lambda (g1450)
+                                                                     (if (memv g1450
+                                                                               '(displaced-lexical))
+                                                                         (g250 g1441)
+                                                                         (void)))
+                                                                   (g232 g1449)))
+                                                                (g253 g1448
+                                                                      g1385)))
+                                                             (g377 g1441
+                                                                   '(())))
+                                                            ((lambda (g1442)
+                                                               ((lambda (g1443)
+                                                                  (g190 '#f
+                                                                        (list (g431 g1386
+                                                                                    g1388
+                                                                                    (lambda ()
+                                                                                      (list '$sc-put-cte
+                                                                                            (list 'quote
+                                                                                                  (if (eq? g1442
+                                                                                                           g1443)
+                                                                                                      g1442
+                                                                                                      ((lambda (g1445)
+                                                                                                         (g203 g1442
+                                                                                                               (g263 g1445
+                                                                                                                     (list (g304 (vector
+                                                                                                                                   g1442)
+                                                                                                                                 (vector
+                                                                                                                                   g1445)
+                                                                                                                                 (vector
+                                                                                                                                   g1443))))))
+                                                                                                       (g264 (g206 g1441)))))
+                                                                                            (list 'quote
+                                                                                                  (g231 'global
+                                                                                                        g1443)))))
+                                                                              ((lambda (g1444)
+                                                                                 (begin (if (eq? g1386
+                                                                                                 'c&e)
+                                                                                            (g91 g1444)
+                                                                                            (void))
+                                                                                        g1444))
+                                                                               (list 'define
+                                                                                     g1443
+                                                                                     (g432 g1438
+                                                                                           g1385
+                                                                                           g1439))))))
+                                                                (if (g373 (g264 (g206 g1441))
+                                                                          (g264 '((top))))
+                                                                    g1442
+                                                                    (g101 g1442))))
+                                                             ((lambda (g1446)
+                                                                ((lambda (g1447)
+                                                                   (if (g90 g1447)
+                                                                       (annotation-expression
+                                                                         g1447)
+                                                                       g1447))
+                                                                 (if (g204 g1446)
+                                                                     (g205 g1446)
+                                                                     g1446)))
+                                                              g1441))))
+                                                   (g393 g1440 g1439))))
+                                          (if (memv g1402 '(module-form))
+                                              ((lambda (g1452 g1451)
+                                                 (g440 g1400
+                                                       g1398
+                                                       g1399
+                                                       (g263 (g264 g1398)
+                                                             (cons g1451
+                                                                   (g265 g1398)))
+                                                       (lambda (g1455
+                                                                g1453
+                                                                g1454)
+                                                         (if g1455
+                                                             (begin ((lambda (g1456)
+                                                                       ((lambda (g1457)
+                                                                          ((lambda (g1458)
+                                                                             (if (memv g1458
+                                                                                       '(displaced-lexical))
+                                                                                 (g250 (g393 g1455
+                                                                                             g1398))
+                                                                                 (void)))
+                                                                           (g232 g1457)))
+                                                                        (g253 g1456
+                                                                              g1452)))
+                                                                     (g377 g1455
+                                                                           '(())))
+                                                                    (g422 g1400
+                                                                          g1452
+                                                                          g1451
+                                                                          g1398
+                                                                          g1399
+                                                                          g1386
+                                                                          g1388
+                                                                          g1455
+                                                                          g1453
+                                                                          g1454))
+                                                             (g422 g1400
+                                                                   g1452
+                                                                   g1451
+                                                                   g1398
+                                                                   g1399
+                                                                   g1386
+                                                                   g1388
+                                                                   '#f
+                                                                   g1453
+                                                                   g1454)))))
+                                               (cons '("top-level module placeholder"
+                                                        placeholder)
+                                                     g1385)
+                                               (g304 '() '() '()))
+                                              (if (memv g1402
+                                                        '(import-form))
+                                                  (g441 g1400
+                                                        g1398
+                                                        g1399
+                                                        (lambda (g1459)
+                                                          (g431 g1386
+                                                                g1388
+                                                                (lambda ()
+                                                                  (begin (if g1397
+                                                                             (syntax-error
+                                                                               (g394 g1400
+                                                                                     g1398
+                                                                                     g1399)
+                                                                               '"not valid at top-level")
+                                                                             (void))
+                                                                         ((lambda (g1460)
+                                                                            ((lambda (g1461)
+                                                                               (if (memv g1461
+                                                                                         '(module))
+                                                                                   (g430 g1459
+                                                                                         (g405 (g233 g1460)))
+                                                                                   (if (memv g1461
+                                                                                             '(displaced-lexical))
+                                                                                       (g250 g1459)
+                                                                                       (syntax-error
+                                                                                         g1459
+                                                                                         '"import from unknown module"))))
+                                                                             (g232 g1460)))
+                                                                          (g253 (g377 g1459
+                                                                                      '(()))
+                                                                                '())))))))
+                                                  ((lambda (g1462)
+                                                     (begin (if (eq? g1386
+                                                                     'c&e)
+                                                                (g91 g1462)
+                                                                (void))
+                                                            g1462))
+                                                   (g433 g1401
+                                                         g1397
+                                                         g1400
+                                                         g1385
+                                                         g1398
+                                                         g1399))))))))))
+                    g1401)))))
+            (g399
+             (lambda (g1099 g1096 g1098 g1097)
+               (call-with-values
+                 (lambda () (g398 g1099 g1096 g1098 '#f g1097))
+                 (lambda (g1104 g1100 g1103 g1101 g1102)
+                   (g433 g1104 g1100 g1103 g1096 g1101 g1102)))))
+            (g398
+             (lambda (g1370 g1366 g1369 g1367 g1368)
+               (if (symbol? g1370)
+                   ((lambda (g1371)
+                      ((lambda (g1372)
+                         ((lambda (g1373)
+                            ((lambda ()
+                               ((lambda (g1374)
+                                  (if (memv g1374 '(lexical))
+                                      (values
+                                        g1373
+                                        (g233 g1372)
+                                        g1370
+                                        g1369
+                                        g1367)
+                                      (if (memv g1374 '(global))
+                                          (values
+                                            g1373
+                                            (g233 g1372)
+                                            g1370
+                                            g1369
+                                            g1367)
+                                          (if (memv g1374 '(macro macro!))
+                                              (g398 (g436 (g233 g1372)
+                                                          g1370
+                                                          g1366
+                                                          g1369
+                                                          g1367
+                                                          g1368)
+                                                    g1366
+                                                    '(())
+                                                    '#f
+                                                    g1368)
+                                              (values
+                                                g1373
+                                                (g233 g1372)
+                                                g1370
+                                                g1369
+                                                g1367)))))
+                                g1373))))
+                          (g232 g1372)))
+                       (g253 g1371 g1366)))
+                    (g377 g1370 g1369))
+                   (if (pair? g1370)
+                       ((lambda (g1375)
+                          (if (g256 g1375)
+                              ((lambda (g1376)
+                                 ((lambda (g1377)
+                                    ((lambda (g1378)
+                                       ((lambda ()
+                                          ((lambda (g1379)
+                                             (if (memv g1379 '(lexical))
+                                                 (values
+                                                   'lexical-call
+                                                   (g233 g1377)
+                                                   g1370
+                                                   g1369
+                                                   g1367)
+                                                 (if (memv g1379
+                                                           '(macro macro!))
+                                                     (g398 (g436 (g233 g1377)
+                                                                 g1370
+                                                                 g1366
+                                                                 g1369
+                                                                 g1367
+                                                                 g1368)
+                                                           g1366
+                                                           '(())
+                                                           '#f
+                                                           g1368)
+                                                     (if (memv g1379
+                                                               '(core))
+                                                         (values
+                                                           g1378
+                                                           (g233 g1377)
+                                                           g1370
+                                                           g1369
+                                                           g1367)
+                                                         (if (memv g1379
+                                                                   '(local-syntax))
+                                                             (values
+                                                               'local-syntax-form
+                                                               (g233 g1377)
+                                                               g1370
+                                                               g1369
+                                                               g1367)
+                                                             (if (memv g1379
+                                                                       '(begin))
+                                                                 (values
+                                                                   'begin-form
+                                                                   '#f
+                                                                   g1370
+                                                                   g1369
+                                                                   g1367)
+                                                                 (if (memv g1379
+                                                                           '(eval-when))
+                                                                     (values
+                                                                       'eval-when-form
+                                                                       '#f
+                                                                       g1370
+                                                                       g1369
+                                                                       g1367)
+                                                                     (if (memv g1379
+                                                                               '(define))
+                                                                         (values
+                                                                           'define-form
+                                                                           '#f
+                                                                           g1370
+                                                                           g1369
+                                                                           g1367)
+                                                                         (if (memv g1379
+                                                                                   '(define-syntax))
+                                                                             (values
+                                                                               'define-syntax-form
+                                                                               '#f
+                                                                               g1370
+                                                                               g1369
+                                                                               g1367)
+                                                                             (if (memv g1379
+                                                                                       '(module-key))
+                                                                                 (values
+                                                                                   'module-form
+                                                                                   '#f
+                                                                                   g1370
+                                                                                   g1369
+                                                                                   g1367)
+                                                                                 (if (memv g1379
+                                                                                           '(import))
+                                                                                     (values
+                                                                                       'import-form
+                                                                                       (if (g233 g1377)
+                                                                                           (g393 g1375
+                                                                                                 g1369)
+                                                                                           '#f)
+                                                                                       g1370
+                                                                                       g1369
+                                                                                       g1367)
+                                                                                     (if (memv g1379
+                                                                                               '(set!))
+                                                                                         (g435 g1370
+                                                                                               g1366
+                                                                                               g1369
+                                                                                               g1367
+                                                                                               g1368)
+                                                                                         (values
+                                                                                           'call
+                                                                                           '#f
+                                                                                           g1370
+                                                                                           g1369
+                                                                                           g1367)))))))))))))
+                                           g1378))))
+                                     (g232 g1377)))
+                                  (g253 g1376 g1366)))
+                               (g377 g1375 g1369))
+                              (values 'call '#f g1370 g1369 g1367)))
+                        (car g1370))
+                       (if (g204 g1370)
+                           (g398 (g205 g1370)
+                                 g1366
+                                 (g371 g1369 (g206 g1370))
+                                 '#f
+                                 g1368)
+                           (if (g90 g1370)
+                               (g398 (annotation-expression g1370)
+                                     g1366
+                                     g1369
+                                     (annotation-source g1370)
+                                     g1368)
+                               (if ((lambda (g1380)
+                                      ((lambda (g1381)
+                                         (if g1381
+                                             g1381
+                                             ((lambda (g1382)
+                                                (if g1382
+                                                    g1382
+                                                    ((lambda (g1383)
+                                                       (if g1383
+                                                           g1383
+                                                           ((lambda (g1384)
+                                                              (if g1384
+                                                                  g1384
+                                                                  (null?
+                                                                    g1380)))
+                                                            (char?
+                                                              g1380))))
+                                                     (string? g1380))))
+                                              (number? g1380))))
+                                       (boolean? g1380)))
+                                    g1370)
+                                   (values 'constant '#f g1370 g1369 g1367)
+                                   (values
+                                     'other
+                                     '#f
+                                     g1370
+                                     g1369
+                                     g1367))))))))
+            (g397
+             (lambda (g1107 g1105 g1106)
+               ((letrec ((g1108
+                          (lambda (g1110 g1109)
+                            (if (null? g1110)
+                                g1109
+                                (g1108
+                                  (cdr g1110)
+                                  (cons ((lambda (g1111)
+                                           (if (g378 g1111
+                                                     '#(syntax-object
+                                                        compile
+                                                        ((top)
+                                                         #(ribcage
+                                                           ()
+                                                           ()
+                                                           ())
+                                                         #(ribcage
+                                                           ()
+                                                           ()
+                                                           ())
+                                                         #(ribcage
+                                                           #(x)
+                                                           #((top))
+                                                           #("i"))
+                                                         #(ribcage
+                                                           ()
+                                                           ()
+                                                           ())
+                                                         #(ribcage
+                                                           #(when-list
+                                                             situations)
+                                                           #((top) (top))
+                                                           #("i" "i"))
+                                                         #(ribcage
+                                                           #(f)
+                                                           #((top))
+                                                           #("i"))
+                                                         #(ribcage
+                                                           ()
+                                                           ()
+                                                           ())
+                                                         #(ribcage
+                                                           ()
+                                                           ()
+                                                           ())
+                                                         #(ribcage
+                                                           #(e when-list w)
+                                                           #((top)
+                                                             (top)
+                                                             (top))
+                                                           #("i" "i" "i"))
+                                                         #(ribcage
+                                                           (lambda-var-list
+                                                             gen-var
+                                                             strip
+                                                             strip*
+                                                             strip-annotation
+                                                             ellipsis?
+                                                             chi-void
+                                                             chi-local-syntax
+                                                             chi-lambda-clause
+                                                             parse-define-syntax
+                                                             parse-define
+                                                             parse-import
+                                                             parse-module
+                                                             do-import!
+                                                             chi-internal
+                                                             chi-body
+                                                             chi-macro
+                                                             chi-set!
+                                                             chi-application
+                                                             chi-expr
+                                                             chi
+                                                             ct-eval/residualize
+                                                             do-top-import
+                                                             vfor-each
+                                                             vmap
+                                                             chi-external
+                                                             check-defined-ids
+                                                             check-module-exports
+                                                             extend-store!
+                                                             id-set-diff
+                                                             chi-top-module
+                                                             set-module-binding-val!
+                                                             set-module-binding-imps!
+                                                             set-module-binding-label!
+                                                             set-module-binding-id!
+                                                             set-module-binding-type!
+                                                             module-binding-val
+                                                             module-binding-imps
+                                                             module-binding-label
+                                                             module-binding-id
+                                                             module-binding-type
+                                                             module-binding?
+                                                             make-module-binding
+                                                             make-resolved-interface
+                                                             make-trimmed-interface
+                                                             set-interface-token!
+                                                             set-interface-exports!
+                                                             interface-token
+                                                             interface-exports
+                                                             interface?
+                                                             make-interface
+                                                             flatten-exports
+                                                             chi-top
+                                                             chi-top-expr
+                                                             syntax-type
+                                                             chi-when-list
+                                                             chi-top-sequence
+                                                             chi-sequence
+                                                             source-wrap
+                                                             wrap
+                                                             bound-id-member?
+                                                             invalid-ids-error
+                                                             distinct-bound-ids?
+                                                             valid-bound-ids?
+                                                             bound-id=?
+                                                             literal-id=?
+                                                             free-id=?
+                                                             id-var-name
+                                                             id-var-name-loc
+                                                             id-var-name&marks
+                                                             id-var-name-loc&marks
+                                                             same-marks?
+                                                             join-marks
+                                                             join-wraps
+                                                             smart-append
+                                                             make-trimmed-syntax-object
+                                                             make-binding-wrap
+                                                             lookup-import-binding-name
+                                                             extend-ribcage-subst!
+                                                             extend-ribcage-barrier-help!
+                                                             extend-ribcage-barrier!
+                                                             extend-ribcage!
+                                                             make-empty-ribcage
+                                                             import-token-key
+                                                             import-token?
+                                                             make-import-token
+                                                             barrier-marker
+                                                             new-mark
+                                                             anti-mark
+                                                             the-anti-mark
+                                                             only-top-marked?
+                                                             top-marked?
+                                                             top-wrap
+                                                             empty-wrap
+                                                             set-ribcage-labels!
+                                                             set-ribcage-marks!
+                                                             set-ribcage-symnames!
+                                                             ribcage-labels
+                                                             ribcage-marks
+                                                             ribcage-symnames
+                                                             ribcage?
+                                                             make-ribcage
+                                                             set-indirect-label!
+                                                             get-indirect-label
+                                                             indirect-label?
+                                                             gen-indirect-label
+                                                             gen-labels
+                                                             label?
+                                                             gen-label
+                                                             make-rename
+                                                             rename-marks
+                                                             rename-new
+                                                             rename-old
+                                                             subst-rename?
+                                                             wrap-subst
+                                                             wrap-marks
+                                                             make-wrap
+                                                             id-sym-name&marks
+                                                             id-sym-name
+                                                             id?
+                                                             nonsymbol-id?
+                                                             global-extend
+                                                             lookup
+                                                             sanitize-binding
+                                                             lookup*
+                                                             displaced-lexical-error
+                                                             transformer-env
+                                                             extend-var-env*
+                                                             extend-env*
+                                                             extend-env
+                                                             null-env
+                                                             binding?
+                                                             set-binding-value!
+                                                             set-binding-type!
+                                                             binding-value
+                                                             binding-type
+                                                             make-binding
+                                                             arg-check
+                                                             source-annotation
+                                                             no-source
+                                                             unannotate
+                                                             set-syntax-object-wrap!
+                                                             set-syntax-object-expression!
+                                                             syntax-object-wrap
+                                                             syntax-object-expression
+                                                             syntax-object?
+                                                             make-syntax-object
+                                                             self-evaluating?
+                                                             build-lexical-var
+                                                             build-letrec
+                                                             build-sequence
+                                                             build-data
+                                                             build-primref
+                                                             build-lambda
+                                                             build-cte-install
+                                                             build-module-definition
+                                                             build-global-definition
+                                                             build-global-assignment
+                                                             build-global-reference
+                                                             build-lexical-assignment
+                                                             build-lexical-reference
+                                                             build-conditional
+                                                             build-application
+                                                             generate-id
+                                                             get-import-binding
+                                                             get-global-definition-hook
+                                                             put-global-definition-hook
+                                                             gensym-hook
+                                                             error-hook
+                                                             local-eval-hook
+                                                             top-level-eval-hook
+                                                             annotation?
+                                                             fx<
+                                                             fx=
+                                                             fx-
+                                                             fx+
+                                                             noexpand
+                                                             define-structure
+                                                             unless
+                                                             when)
+                                                           ((top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top))
+                                                           ("i" "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"))
+                                                         #(ribcage
+                                                           ((import-token
+                                                              .
+                                                              *top*))
+                                                           ()
+                                                           ())
+                                                         #(ribcage
+                                                           ((import-token
+                                                              .
+                                                              *top*))
+                                                           ()
+                                                           ()))))
+                                               'compile
+                                               (if (g378 g1111
+                                                         '#(syntax-object
+                                                            load
+                                                            ((top)
+                                                             #(ribcage
+                                                               ()
+                                                               ()
+                                                               ())
+                                                             #(ribcage
+                                                               ()
+                                                               ()
+                                                               ())
+                                                             #(ribcage
+                                                               #(x)
+                                                               #((top))
+                                                               #("i"))
+                                                             #(ribcage
+                                                               ()
+                                                               ()
+                                                               ())
+                                                             #(ribcage
+                                                               #(when-list
+                                                                 situations)
+                                                               #((top)
+                                                                 (top))
+                                                               #("i" "i"))
+                                                             #(ribcage
+                                                               #(f)
+                                                               #((top))
+                                                               #("i"))
+                                                             #(ribcage
+                                                               ()
+                                                               ()
+                                                               ())
+                                                             #(ribcage
+                                                               ()
+                                                               ()
+                                                               ())
+                                                             #(ribcage
+                                                               #(e
+                                                                 when-list
+                                                                 w)
+                                                               #((top)
+                                                                 (top)
+                                                                 (top))
+                                                               #("i"
+                                                                 "i"
+                                                                 "i"))
+                                                             #(ribcage
+                                                               (lambda-var-list
+                                                                 gen-var
+                                                                 strip
+                                                                 strip*
+                                                                 strip-annotation
+                                                                 ellipsis?
+                                                                 chi-void
+                                                                 chi-local-syntax
+                                                                 chi-lambda-clause
+                                                                 parse-define-syntax
+                                                                 parse-define
+                                                                 parse-import
+                                                                 parse-module
+                                                                 do-import!
+                                                                 chi-internal
+                                                                 chi-body
+                                                                 chi-macro
+                                                                 chi-set!
+                                                                 chi-application
+                                                                 chi-expr
+                                                                 chi
+                                                                 ct-eval/residualize
+                                                                 do-top-import
+                                                                 vfor-each
+                                                                 vmap
+                                                                 chi-external
+                                                                 check-defined-ids
+                                                                 check-module-exports
+                                                                 extend-store!
+                                                                 id-set-diff
+                                                                 chi-top-module
+                                                                 set-module-binding-val!
+                                                                 set-module-binding-imps!
+                                                                 set-module-binding-label!
+                                                                 set-module-binding-id!
+                                                                 set-module-binding-type!
+                                                                 module-binding-val
+                                                                 module-binding-imps
+                                                                 module-binding-label
+                                                                 module-binding-id
+                                                                 module-binding-type
+                                                                 module-binding?
+                                                                 make-module-binding
+                                                                 make-resolved-interface
+                                                                 make-trimmed-interface
+                                                                 set-interface-token!
+                                                                 set-interface-exports!
+                                                                 interface-token
+                                                                 interface-exports
+                                                                 interface?
+                                                                 make-interface
+                                                                 flatten-exports
+                                                                 chi-top
+                                                                 chi-top-expr
+                                                                 syntax-type
+                                                                 chi-when-list
+                                                                 chi-top-sequence
+                                                                 chi-sequence
+                                                                 source-wrap
+                                                                 wrap
+                                                                 bound-id-member?
+                                                                 invalid-ids-error
+                                                                 distinct-bound-ids?
+                                                                 valid-bound-ids?
+                                                                 bound-id=?
+                                                                 literal-id=?
+                                                                 free-id=?
+                                                                 id-var-name
+                                                                 id-var-name-loc
+                                                                 id-var-name&marks
+                                                                 id-var-name-loc&marks
+                                                                 same-marks?
+                                                                 join-marks
+                                                                 join-wraps
+                                                                 smart-append
+                                                                 make-trimmed-syntax-object
+                                                                 make-binding-wrap
+                                                                 lookup-import-binding-name
+                                                                 extend-ribcage-subst!
+                                                                 extend-ribcage-barrier-help!
+                                                                 extend-ribcage-barrier!
+                                                                 extend-ribcage!
+                                                                 make-empty-ribcage
+                                                                 import-token-key
+                                                                 import-token?
+                                                                 make-import-token
+                                                                 barrier-marker
+                                                                 new-mark
+                                                                 anti-mark
+                                                                 the-anti-mark
+                                                                 only-top-marked?
+                                                                 top-marked?
+                                                                 top-wrap
+                                                                 empty-wrap
+                                                                 set-ribcage-labels!
+                                                                 set-ribcage-marks!
+                                                                 set-ribcage-symnames!
+                                                                 ribcage-labels
+                                                                 ribcage-marks
+                                                                 ribcage-symnames
+                                                                 ribcage?
+                                                                 make-ribcage
+                                                                 set-indirect-label!
+                                                                 get-indirect-label
+                                                                 indirect-label?
+                                                                 gen-indirect-label
+                                                                 gen-labels
+                                                                 label?
+                                                                 gen-label
+                                                                 make-rename
+                                                                 rename-marks
+                                                                 rename-new
+                                                                 rename-old
+                                                                 subst-rename?
+                                                                 wrap-subst
+                                                                 wrap-marks
+                                                                 make-wrap
+                                                                 id-sym-name&marks
+                                                                 id-sym-name
+                                                                 id?
+                                                                 nonsymbol-id?
+                                                                 global-extend
+                                                                 lookup
+                                                                 sanitize-binding
+                                                                 lookup*
+                                                                 displaced-lexical-error
+                                                                 transformer-env
+                                                                 extend-var-env*
+                                                                 extend-env*
+                                                                 extend-env
+                                                                 null-env
+                                                                 binding?
+                                                                 set-binding-value!
+                                                                 set-binding-type!
+                                                                 binding-value
+                                                                 binding-type
+                                                                 make-binding
+                                                                 arg-check
+                                                                 source-annotation
+                                                                 no-source
+                                                                 unannotate
+                                                                 set-syntax-object-wrap!
+                                                                 set-syntax-object-expression!
+                                                                 syntax-object-wrap
+                                                                 syntax-object-expression
+                                                                 syntax-object?
+                                                                 make-syntax-object
+                                                                 self-evaluating?
+                                                                 build-lexical-var
+                                                                 build-letrec
+                                                                 build-sequence
+                                                                 build-data
+                                                                 build-primref
+                                                                 build-lambda
+                                                                 build-cte-install
+                                                                 build-module-definition
+                                                                 build-global-definition
+                                                                 build-global-assignment
+                                                                 build-global-reference
+                                                                 build-lexical-assignment
+                                                                 build-lexical-reference
+                                                                 build-conditional
+                                                                 build-application
+                                                                 generate-id
+                                                                 get-import-binding
+                                                                 get-global-definition-hook
+                                                                 put-global-definition-hook
+                                                                 gensym-hook
+                                                                 error-hook
+                                                                 local-eval-hook
+                                                                 top-level-eval-hook
+                                                                 annotation?
+                                                                 fx<
+                                                                 fx=
+                                                                 fx-
+                                                                 fx+
+                                                                 noexpand
+                                                                 define-structure
+                                                                 unless
+                                                                 when)
+                                                               ((top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top))
+                                                               ("i" "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"
+                                                                    "i"))
+                                                             #(ribcage
+                                                               ((import-token
+                                                                  .
+                                                                  *top*))
+                                                               ()
+                                                               ())
+                                                             #(ribcage
+                                                               ((import-token
+                                                                  .
+                                                                  *top*))
+                                                               ()
+                                                               ()))))
+                                                   'load
+                                                   (if (g378 g1111
+                                                             '#(syntax-object
+                                                                eval
+                                                                ((top)
+                                                                 #(ribcage
+                                                                   ()
+                                                                   ()
+                                                                   ())
+                                                                 #(ribcage
+                                                                   ()
+                                                                   ()
+                                                                   ())
+                                                                 #(ribcage
+                                                                   #(x)
+                                                                   #((top))
+                                                                   #("i"))
+                                                                 #(ribcage
+                                                                   ()
+                                                                   ()
+                                                                   ())
+                                                                 #(ribcage
+                                                                   #(when-list
+                                                                     situations)
+                                                                   #((top)
+                                                                     (top))
+                                                                   #("i"
+                                                                     "i"))
+                                                                 #(ribcage
+                                                                   #(f)
+                                                                   #((top))
+                                                                   #("i"))
+                                                                 #(ribcage
+                                                                   ()
+                                                                   ()
+                                                                   ())
+                                                                 #(ribcage
+                                                                   ()
+                                                                   ()
+                                                                   ())
+                                                                 #(ribcage
+                                                                   #(e
+                                                                     when-list
+                                                                     w)
+                                                                   #((top)
+                                                                     (top)
+                                                                     (top))
+                                                                   #("i"
+                                                                     "i"
+                                                                     "i"))
+                                                                 #(ribcage
+                                                                   (lambda-var-list
+                                                                     gen-var
+                                                                     strip
+                                                                     strip*
+                                                                     strip-annotation
+                                                                     ellipsis?
+                                                                     chi-void
+                                                                     chi-local-syntax
+                                                                     chi-lambda-clause
+                                                                     parse-define-syntax
+                                                                     parse-define
+                                                                     parse-import
+                                                                     parse-module
+                                                                     do-import!
+                                                                     chi-internal
+                                                                     chi-body
+                                                                     chi-macro
+                                                                     chi-set!
+                                                                     chi-application
+                                                                     chi-expr
+                                                                     chi
+                                                                     ct-eval/residualize
+                                                                     do-top-import
+                                                                     vfor-each
+                                                                     vmap
+                                                                     chi-external
+                                                                     check-defined-ids
+                                                                     check-module-exports
+                                                                     extend-store!
+                                                                     id-set-diff
+                                                                     chi-top-module
+                                                                     set-module-binding-val!
+                                                                     set-module-binding-imps!
+                                                                     set-module-binding-label!
+                                                                     set-module-binding-id!
+                                                                     set-module-binding-type!
+                                                                     module-binding-val
+                                                                     module-binding-imps
+                                                                     module-binding-label
+                                                                     module-binding-id
+                                                                     module-binding-type
+                                                                     module-binding?
+                                                                     make-module-binding
+                                                                     make-resolved-interface
+                                                                     make-trimmed-interface
+                                                                     set-interface-token!
+                                                                     set-interface-exports!
+                                                                     interface-token
+                                                                     interface-exports
+                                                                     interface?
+                                                                     make-interface
+                                                                     flatten-exports
+                                                                     chi-top
+                                                                     chi-top-expr
+                                                                     syntax-type
+                                                                     chi-when-list
+                                                                     chi-top-sequence
+                                                                     chi-sequence
+                                                                     source-wrap
+                                                                     wrap
+                                                                     bound-id-member?
+                                                                     invalid-ids-error
+                                                                     distinct-bound-ids?
+                                                                     valid-bound-ids?
+                                                                     bound-id=?
+                                                                     literal-id=?
+                                                                     free-id=?
+                                                                     id-var-name
+                                                                     id-var-name-loc
+                                                                     id-var-name&marks
+                                                                     id-var-name-loc&marks
+                                                                     same-marks?
+                                                                     join-marks
+                                                                     join-wraps
+                                                                     smart-append
+                                                                     make-trimmed-syntax-object
+                                                                     make-binding-wrap
+                                                                     lookup-import-binding-name
+                                                                     extend-ribcage-subst!
+                                                                     extend-ribcage-barrier-help!
+                                                                     extend-ribcage-barrier!
+                                                                     extend-ribcage!
+                                                                     make-empty-ribcage
+                                                                     import-token-key
+                                                                     import-token?
+                                                                     make-import-token
+                                                                     barrier-marker
+                                                                     new-mark
+                                                                     anti-mark
+                                                                     the-anti-mark
+                                                                     only-top-marked?
+                                                                     top-marked?
+                                                                     top-wrap
+                                                                     empty-wrap
+                                                                     set-ribcage-labels!
+                                                                     set-ribcage-marks!
+                                                                     set-ribcage-symnames!
+                                                                     ribcage-labels
+                                                                     ribcage-marks
+                                                                     ribcage-symnames
+                                                                     ribcage?
+                                                                     make-ribcage
+                                                                     set-indirect-label!
+                                                                     get-indirect-label
+                                                                     indirect-label?
+                                                                     gen-indirect-label
+                                                                     gen-labels
+                                                                     label?
+                                                                     gen-label
+                                                                     make-rename
+                                                                     rename-marks
+                                                                     rename-new
+                                                                     rename-old
+                                                                     subst-rename?
+                                                                     wrap-subst
+                                                                     wrap-marks
+                                                                     make-wrap
+                                                                     id-sym-name&marks
+                                                                     id-sym-name
+                                                                     id?
+                                                                     nonsymbol-id?
+                                                                     global-extend
+                                                                     lookup
+                                                                     sanitize-binding
+                                                                     lookup*
+                                                                     displaced-lexical-error
+                                                                     transformer-env
+                                                                     extend-var-env*
+                                                                     extend-env*
+                                                                     extend-env
+                                                                     null-env
+                                                                     binding?
+                                                                     set-binding-value!
+                                                                     set-binding-type!
+                                                                     binding-value
+                                                                     binding-type
+                                                                     make-binding
+                                                                     arg-check
+                                                                     source-annotation
+                                                                     no-source
+                                                                     unannotate
+                                                                     set-syntax-object-wrap!
+                                                                     set-syntax-object-expression!
+                                                                     syntax-object-wrap
+                                                                     syntax-object-expression
+                                                                     syntax-object?
+                                                                     make-syntax-object
+                                                                     self-evaluating?
+                                                                     build-lexical-var
+                                                                     build-letrec
+                                                                     build-sequence
+                                                                     build-data
+                                                                     build-primref
+                                                                     build-lambda
+                                                                     build-cte-install
+                                                                     build-module-definition
+                                                                     build-global-definition
+                                                                     build-global-assignment
+                                                                     build-global-reference
+                                                                     build-lexical-assignment
+                                                                     build-lexical-reference
+                                                                     build-conditional
+                                                                     build-application
+                                                                     generate-id
+                                                                     get-import-binding
+                                                                     get-global-definition-hook
+                                                                     put-global-definition-hook
+                                                                     gensym-hook
+                                                                     error-hook
+                                                                     local-eval-hook
+                                                                     top-level-eval-hook
+                                                                     annotation?
+                                                                     fx<
+                                                                     fx=
+                                                                     fx-
+                                                                     fx+
+                                                                     noexpand
+                                                                     define-structure
+                                                                     unless
+                                                                     when)
+                                                                   ((top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top)
+                                                                    (top))
+                                                                   ("i" "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"))
+                                                                 #(ribcage
+                                                                   ((import-token
+                                                                      .
+                                                                      *top*))
+                                                                   ()
+                                                                   ())
+                                                                 #(ribcage
+                                                                   ((import-token
+                                                                      .
+                                                                      *top*))
+                                                                   ()
+                                                                   ()))))
+                                                       'eval
+                                                       (syntax-error
+                                                         (g393 g1111 g1106)
+                                                         '"invalid eval-when situation")))))
+                                         (car g1110))
+                                        g1109))))))
+                  g1108)
+                g1105
+                '())))
+            (g396
+             (lambda (g1358 g1352 g1357 g1353 g1356 g1354 g1355)
+               (g190 g1353
+                     ((letrec ((g1359
+                                (lambda (g1364 g1360 g1363 g1361 g1362)
+                                  (if (null? g1364)
+                                      '()
+                                      ((lambda (g1365)
+                                         (cons g1365
+                                               (g1359
+                                                 (cdr g1364)
+                                                 g1360
+                                                 g1363
+                                                 g1361
+                                                 g1362)))
+                                       (g400 (car g1364)
+                                             g1360
+                                             g1363
+                                             g1361
+                                             g1362
+                                             g1355))))))
+                        g1359)
+                      g1358
+                      g1352
+                      g1357
+                      g1356
+                      g1354))))
+            (g395
+             (lambda (g1115 g1112 g1114 g1113)
+               (g190 g1113
+                     ((letrec ((g1116
+                                (lambda (g1119 g1117 g1118)
+                                  (if (null? g1119)
+                                      '()
+                                      ((lambda (g1120)
+                                         (cons g1120
+                                               (g1116
+                                                 (cdr g1119)
+                                                 g1117
+                                                 g1118)))
+                                       (g432 (car g1119) g1117 g1118))))))
+                        g1116)
+                      g1115
+                      g1112
+                      g1114))))
+            (g394
+             (lambda (g1351 g1349 g1350)
+               (g393 (if g1350 (make-annotation g1351 g1350 '#f) g1351)
+                     g1349)))
+            (g393
+             (lambda (g1122 g1121)
+               (if (if (null? (g264 g1121)) (null? (g265 g1121)) '#f)
+                   g1122
+                   (if (g204 g1122)
+                       (g203 (g205 g1122) (g371 g1121 (g206 g1122)))
+                       (if (null? g1122) g1122 (g203 g1122 g1121))))))
+            (g392
+             (lambda (g1347 g1346)
+               (if (not (null? g1346))
+                   ((lambda (g1348)
+                      (if g1348 g1348 (g392 g1347 (cdr g1346))))
+                    (g388 g1347 (car g1346)))
+                   '#f)))
+            (g391
+             (lambda (g1125 g1123 g1124)
+               ((letrec ((g1126
+                          (lambda (g1128 g1127)
+                            (if (null? g1128)
+                                (syntax-error g1123)
+                                (if (g256 (car g1128))
+                                    (if (g392 (car g1128) g1127)
+                                        (syntax-error
+                                          (car g1128)
+                                          '"duplicate "
+                                          g1124)
+                                        (g1126
+                                          (cdr g1128)
+                                          (cons (car g1128) g1127)))
+                                    (syntax-error
+                                      (car g1128)
+                                      '"invalid "
+                                      g1124))))))
+                  g1126)
+                g1125
+                '())))
+            (g390
+             (lambda (g1342)
+               ((letrec ((g1343
+                          (lambda (g1344)
+                            ((lambda (g1345)
+                               (if g1345
+                                   g1345
+                                   (if (not (g392 (car g1344) (cdr g1344)))
+                                       (g1343 (cdr g1344))
+                                       '#f)))
+                             (null? g1344)))))
+                  g1343)
+                g1342)))
+            (g389
+             (lambda (g1129)
+               (if ((letrec ((g1130
+                              (lambda (g1131)
+                                ((lambda (g1132)
+                                   (if g1132
+                                       g1132
+                                       (if (g256 (car g1131))
+                                           (g1130 (cdr g1131))
+                                           '#f)))
+                                 (null? g1131)))))
+                      g1130)
+                    g1129)
+                   (g390 g1129)
+                   '#f)))
+            (g388
+             (lambda (g1337 g1336)
+               (if (if (g204 g1337) (g204 g1336) '#f)
+                   (if (eq? ((lambda (g1339)
+                               (if (g90 g1339)
+                                   (annotation-expression g1339)
+                                   g1339))
+                             (g205 g1337))
+                            ((lambda (g1338)
+                               (if (g90 g1338)
+                                   (annotation-expression g1338)
+                                   g1338))
+                             (g205 g1336)))
+                       (g373 (g264 (g206 g1337)) (g264 (g206 g1336)))
+                       '#f)
+                   (eq? ((lambda (g1341)
+                           (if (g90 g1341)
+                               (annotation-expression g1341)
+                               g1341))
+                         g1337)
+                        ((lambda (g1340)
+                           (if (g90 g1340)
+                               (annotation-expression g1340)
+                               g1340))
+                         g1336)))))
+            (g378
+             (lambda (g1134 g1133)
+               (if (eq? ((lambda (g1137)
+                           ((lambda (g1138)
+                              (if (g90 g1138)
+                                  (annotation-expression g1138)
+                                  g1138))
+                            (if (g204 g1137) (g205 g1137) g1137)))
+                         g1134)
+                        ((lambda (g1135)
+                           ((lambda (g1136)
+                              (if (g90 g1136)
+                                  (annotation-expression g1136)
+                                  g1136))
+                            (if (g204 g1135) (g205 g1135) g1135)))
+                         g1133))
+                   (eq? (g377 g1134 '(())) (g377 g1133 '(())))
+                   '#f)))
+            (g377
+             (lambda (g1333 g1332)
+               (call-with-values
+                 (lambda () (g374 g1333 g1332))
+                 (lambda (g1335 g1334)
+                   (if (g301 g1335) (g302 g1335) g1335)))))
+            (g376
+             (lambda (g1140 g1139)
+               (call-with-values
+                 (lambda () (g374 g1140 g1139))
+                 (lambda (g1142 g1141) g1142))))
+            (g375
+             (lambda (g1329 g1328)
+               (call-with-values
+                 (lambda () (g374 g1329 g1328))
+                 (lambda (g1331 g1330)
+                   (values (if (g301 g1331) (g302 g1331) g1331) g1330)))))
+            (g374
+             (lambda (g1144 g1143)
+               (letrec ((g1147
+                         (lambda (g1174 g1170 g1173 g1171 g1172)
+                           ((lambda (g1175)
+                              ((letrec ((g1176
+                                         (lambda (g1177)
+                                           (if (= g1177 g1175)
+                                               (g1145
+                                                 g1174
+                                                 (cdr g1170)
+                                                 g1173)
+                                               (if (if (eq? (vector-ref
+                                                              g1171
+                                                              g1177)
+                                                            g1174)
+                                                       (g373 g1173
+                                                             (vector-ref
+                                                               (g307 g1172)
+                                                               g1177))
+                                                       '#f)
+                                                   (values
+                                                     (vector-ref
+                                                       (g308 g1172)
+                                                       g1177)
+                                                     g1173)
+                                                   (g1176 (+ g1177 '1)))))))
+                                 g1176)
+                               '0))
+                            (vector-length g1171))))
+                        (g1146
+                         (lambda (g1159 g1155 g1158 g1156 g1157)
+                           ((letrec ((g1160
+                                      (lambda (g1162 g1161)
+                                        (if (null? g1162)
+                                            (g1145 g1159 (cdr g1155) g1158)
+                                            (if (if (eq? (car g1162) g1159)
+                                                    (g373 g1158
+                                                          (list-ref
+                                                            (g307 g1157)
+                                                            g1161))
+                                                    '#f)
+                                                (values
+                                                  (list-ref
+                                                    (g308 g1157)
+                                                    g1161)
+                                                  g1158)
+                                                (if (g357 (car g1162))
+                                                    ((lambda (g1163)
+                                                       (if g1163
+                                                           ((lambda (g1164)
+                                                              (if (symbol?
+                                                                    g1164)
+                                                                  (values
+                                                                    g1164
+                                                                    g1158)
+                                                                  (g375 g1164
+                                                                        '(()))))
+                                                            g1163)
+                                                           (g1160
+                                                             (cdr g1162)
+                                                             g1161)))
+                                                     (g367 g1159
+                                                           (g358 (car g1162))
+                                                           g1158))
+                                                    (if (if (eq? (car g1162)
+                                                                 g354)
+                                                            (g373 g1158
+                                                                  (list-ref
+                                                                    (g307 g1157)
+                                                                    g1161))
+                                                            '#f)
+                                                        (values '#f g1158)
+                                                        (g1160
+                                                          (cdr g1162)
+                                                          (+ g1161
+                                                             '1)))))))))
+                              g1160)
+                            g1156
+                            '0)))
+                        (g1145
+                         (lambda (g1167 g1165 g1166)
+                           (if (null? g1165)
+                               (values g1167 g1166)
+                               ((lambda (g1168)
+                                  (if (eq? g1168 'shift)
+                                      (g1145 g1167 (cdr g1165) (cdr g1166))
+                                      ((lambda (g1169)
+                                         (if (vector? g1169)
+                                             (g1147
+                                               g1167
+                                               g1165
+                                               g1166
+                                               g1169
+                                               g1168)
+                                             (g1146
+                                               g1167
+                                               g1165
+                                               g1166
+                                               g1169
+                                               g1168)))
+                                       (g306 g1168))))
+                                (car g1165))))))
+                 (if (symbol? g1144)
+                     (g1145 g1144 (g265 g1143) (g264 g1143))
+                     (if (g204 g1144)
+                         ((lambda (g1149 g1148)
+                            ((lambda (g1150)
+                               (call-with-values
+                                 (lambda ()
+                                   (g1145 g1149 (g265 g1143) g1150))
+                                 (lambda (g1152 g1151)
+                                   (if (eq? g1152 g1149)
+                                       (g1145 g1149 (g265 g1148) g1151)
+                                       (values g1152 g1151)))))
+                             (g372 (g264 g1143) (g264 g1148))))
+                          ((lambda (g1153)
+                             (if (g90 g1153)
+                                 (annotation-expression g1153)
+                                 g1153))
+                           (g205 g1144))
+                          (g206 g1144))
+                         (if (g90 g1144)
+                             (g1145
+                               ((lambda (g1154)
+                                  (if (g90 g1154)
+                                      (annotation-expression g1154)
+                                      g1154))
+                                g1144)
+                               (g265 g1143)
+                               (g264 g1143))
+                             (g93 'id-var-name '"invalid id" g1144)))))))
+            (g373
+             (lambda (g1326 g1325)
+               ((lambda (g1327)
+                  (if g1327
+                      g1327
+                      (if (not (null? g1326))
+                          (if (not (null? g1325))
+                              (if (eq? (car g1326) (car g1325))
+                                  (g373 (cdr g1326) (cdr g1325))
+                                  '#f)
+                              '#f)
+                          '#f)))
+                (eq? g1326 g1325))))
+            (g372 (lambda (g1179 g1178) (g370 g1179 g1178)))
+            (g371
+             (lambda (g1322 g1321)
+               ((lambda (g1324 g1323)
+                  (if (null? g1324)
+                      (if (null? g1323)
+                          g1321
+                          (g263 (g264 g1321) (g370 g1323 (g265 g1321))))
+                      (g263 (g370 g1324 (g264 g1321))
+                            (g370 g1323 (g265 g1321)))))
+                (g264 g1322)
+                (g265 g1322))))
+            (g370
+             (lambda (g1181 g1180)
+               (if (null? g1180) g1181 (append g1181 g1180))))
+            (g369
+             (lambda (g1315)
+               (call-with-values
+                 (lambda () (g375 g1315 '(())))
+                 (lambda (g1317 g1316)
+                   (begin (if (not g1317)
+                              (syntax-error
+                                g1315
+                                '"identifier not visible for export")
+                              (void))
+                          ((lambda (g1318)
+                             (g203 g1318
+                                   (g263 g1316
+                                         (list (g304 (vector g1318)
+                                                     (vector g1316)
+                                                     (vector g1317))))))
+                           ((lambda (g1319)
+                              ((lambda (g1320)
+                                 (if (g90 g1320)
+                                     (annotation-expression g1320)
+                                     g1320))
+                               (if (g204 g1319) (g205 g1319) g1319)))
+                            g1315)))))))
+            (g368
+             (lambda (g1184 g1182 g1183)
+               (if (null? g1184)
+                   g1183
+                   (g263 (g264 g1183)
+                         (cons ((lambda (g1185)
+                                  ((lambda (g1186)
+                                     ((lambda (g1188 g1187)
+                                        (begin ((letrec ((g1189
+                                                          (lambda (g1191
+                                                                   g1190)
+                                                            (if (not (null?
+                                                                       g1191))
+                                                                (call-with-values
+                                                                  (lambda ()
+                                                                    (g262 (car g1191)
+                                                                          g1183))
+                                                                  (lambda (g1193
+                                                                           g1192)
+                                                                    (begin (vector-set!
+                                                                             g1188
+                                                                             g1190
+                                                                             g1193)
+                                                                           (vector-set!
+                                                                             g1187
+                                                                             g1190
+                                                                             g1192)
+                                                                           (g1189
+                                                                             (cdr g1191)
+                                                                             (+ g1190
+                                                                                '1)))))
+                                                                (void)))))
+                                                  g1189)
+                                                g1184
+                                                '0)
+                                               (g304 g1188 g1187 g1185)))
+                                      (make-vector g1186)
+                                      (make-vector g1186)))
+                                   (vector-length g1185)))
+                                (list->vector g1182))
+                               (g265 g1183))))))
+            (g367
+             (lambda (g1310 g1308 g1309)
+               ((lambda (g1311)
+                  (if g1311
+                      ((letrec ((g1312
+                                 (lambda (g1313)
+                                   (if (pair? g1313)
+                                       ((lambda (g1314)
+                                          (if g1314
+                                              g1314
+                                              (g1312 (cdr g1313))))
+                                        (g1312 (car g1313)))
+                                       (if (g373 g1309 (g264 (g206 g1313)))
+                                           g1313
+                                           '#f)))))
+                         g1312)
+                       g1311)
+                      '#f))
+                (g100 g1310 g1308))))
+            (g366
+             (lambda (g1195 g1194)
+               (g309 g1195 (cons (g356 g1194) (g306 g1195)))))
+            (g365
+             (lambda (g1307 g1306)
+               (begin (g309 g1307 (cons g354 (g306 g1307)))
+                      (g310 g1307 (cons (g264 g1306) (g307 g1307))))))
+            (g364 (lambda (g1197 g1196) (g365 g1197 (g206 g1196))))
+            (g363
+             (lambda (g1304 g1302 g1303)
+               (begin (g309 g1304
+                            (cons ((lambda (g1305)
+                                     (if (g90 g1305)
+                                         (annotation-expression g1305)
+                                         g1305))
+                                   (g205 g1302))
+                                  (g306 g1304)))
+                      (g310 g1304 (cons (g264 (g206 g1302)) (g307 g1304)))
+                      (g311 g1304 (cons g1303 (g308 g1304))))))
+            (g358 cdr)
+            (g357
+             (lambda (g1301)
+               (if (pair? g1301) (eq? (car g1301) g355) '#f)))
+            (g356 (lambda (g1198) (cons g355 g1198)))
+            (g355 'import-token)
+            (g354 '#f)
+            (g349
+             (lambda (g1300)
+               (g263 (cons '#f (g264 g1300)) (cons 'shift (g265 g1300)))))
+            (g311 (lambda (g1200 g1199) (vector-set! g1200 '3 g1199)))
+            (g310 (lambda (g1299 g1298) (vector-set! g1299 '2 g1298)))
+            (g309 (lambda (g1202 g1201) (vector-set! g1202 '1 g1201)))
+            (g308 (lambda (g1297) (vector-ref g1297 '3)))
+            (g307 (lambda (g1203) (vector-ref g1203 '2)))
+            (g306 (lambda (g1296) (vector-ref g1296 '1)))
+            (g305
+             (lambda (g1204)
+               (if (vector? g1204)
+                   (if (= (vector-length g1204) '4)
+                       (eq? (vector-ref g1204 '0) 'ribcage)
+                       '#f)
+                   '#f)))
+            (g304
+             (lambda (g1295 g1293 g1294)
+               (vector 'ribcage g1295 g1293 g1294)))
+            (g303 set-car!)
+            (g302 car)
+            (g301 pair?)
+            (g300 (lambda () (list (g297))))
+            (g299
+             (lambda (g1205)
+               (if (null? g1205) '() (cons (g297) (g299 (cdr g1205))))))
+            (g298
+             (lambda (g1290)
+               ((lambda (g1291)
+                  (if g1291
+                      g1291
+                      ((lambda (g1292) (if g1292 g1292 (g301 g1290)))
+                       (symbol? g1290))))
+                (string? g1290))))
+            (g297 (lambda () (string '#\i)))
+            (g265 cdr)
+            (g264 car)
+            (g263 cons)
+            (g262
+             (lambda (g1207 g1206)
+               (if (g204 g1207)
+                   (values
+                     ((lambda (g1208)
+                        (if (g90 g1208)
+                            (annotation-expression g1208)
+                            g1208))
+                      (g205 g1207))
+                     (g372 (g264 g1206) (g264 (g206 g1207))))
+                   (values
+                     ((lambda (g1209)
+                        (if (g90 g1209)
+                            (annotation-expression g1209)
+                            g1209))
+                      g1207)
+                     (g264 g1206)))))
+            (g256
+             (lambda (g1288)
+               (if (symbol? g1288)
+                   '#t
+                   (if (g204 g1288)
+                       (symbol?
+                         ((lambda (g1289)
+                            (if (g90 g1289)
+                                (annotation-expression g1289)
+                                g1289))
+                          (g205 g1288)))
+                       (if (g90 g1288)
+                           (symbol? (annotation-expression g1288))
+                           '#f)))))
+            (g255
+             (lambda (g1210)
+               (if (g204 g1210)
+                   (symbol?
+                     ((lambda (g1211)
+                        (if (g90 g1211)
+                            (annotation-expression g1211)
+                            g1211))
+                      (g205 g1210)))
+                   '#f)))
+            (g254
+             (lambda (g1287 g1285 g1286) (g98 g1285 (g231 g1287 g1286))))
+            (g253
+             (lambda (g1213 g1212)
+               (letrec ((g1214
+                         (lambda (g1221 g1220)
+                           (begin (g234 g1221 (g232 g1220))
+                                  (g235 g1221 (g233 g1220))))))
+                 ((lambda (g1215)
+                    ((lambda (g1216)
+                       (if (memv g1216 '(deferred))
+                           (begin (g1214
+                                    g1215
+                                    ((lambda (g1217)
+                                       ((lambda (g1218)
+                                          (if g1218
+                                              g1218
+                                              (syntax-error
+                                                g1217
+                                                '"invalid transformer")))
+                                        (g252 g1217)))
+                                     (g92 (g233 g1215))))
+                                  ((lambda (g1219) g1215) (g232 g1215)))
+                           g1215))
+                     (g232 g1215)))
+                  (g251 g1213 g1212)))))
+            (g252
+             (lambda (g1283)
+               (if (procedure? g1283)
+                   (g231 'macro g1283)
+                   (if (g236 g1283)
+                       ((lambda (g1284)
+                          (if (memv g1284 '(core macro macro!))
+                              (if (procedure? (g233 g1283)) g1283 '#f)
+                              (if (memv g1284 '(module))
+                                  (if (g403 (g233 g1283)) g1283 '#f)
+                                  g1283)))
+                        (g232 g1283))
+                       '#f))))
+            (g251
+             (lambda (g1223 g1222)
+               ((lambda (g1224)
+                  (if g1224
+                      (cdr g1224)
+                      (if (symbol? g1223)
+                          ((lambda (g1225)
+                             (if g1225 g1225 (g231 'global g1223)))
+                           (g99 g1223))
+                          (g231 'displaced-lexical '#f))))
+                (assq g1223 g1222))))
+            (g250
+             (lambda (g1282)
+               (syntax-error
+                 g1282
+                 (if (g377 g1282 '(()))
+                     '"identifier out of context"
+                     '"identifier not visible"))))
+            (g249
+             (lambda (g1226)
+               (if (null? g1226)
+                   '()
+                   ((lambda (g1227)
+                      (if (eq? (cadr g1227) 'lexical)
+                          (g249 (cdr g1226))
+                          (cons g1227 (g249 (cdr g1226)))))
+                    (car g1226)))))
+            (g248
+             (lambda (g1281 g1279 g1280)
+               (if (null? g1281)
+                   g1280
+                   (g248 (cdr g1281)
+                         (cdr g1279)
+                         (g246 (car g1281)
+                               (g231 'lexical (car g1279))
+                               g1280)))))
+            (g247
+             (lambda (g1230 g1228 g1229)
+               (if (null? g1230)
+                   g1229
+                   (g247 (cdr g1230)
+                         (cdr g1228)
+                         (g246 (car g1230) (car g1228) g1229)))))
+            (g246
+             (lambda (g1278 g1276 g1277)
+               (cons (cons g1278 g1276) g1277)))
+            (g236
+             (lambda (g1231)
+               (if (pair? g1231) (symbol? (car g1231)) '#f)))
+            (g235 set-cdr!)
+            (g234 set-car!)
+            (g233 cdr)
+            (g232 car)
+            (g231 (lambda (g1275 g1274) (cons g1275 g1274)))
+            (g223
+             (lambda (g1232)
+               (if (g90 g1232)
+                   (annotation-source g1232)
+                   (if (g204 g1232) (g223 (g205 g1232)) '#f))))
+            (g208 (lambda (g1273 g1272) (vector-set! g1273 '2 g1272)))
+            (g207 (lambda (g1234 g1233) (vector-set! g1234 '1 g1233)))
+            (g206 (lambda (g1271) (vector-ref g1271 '2)))
+            (g205 (lambda (g1235) (vector-ref g1235 '1)))
+            (g204
+             (lambda (g1270)
+               (if (vector? g1270)
+                   (if (= (vector-length g1270) '3)
+                       (eq? (vector-ref g1270 '0) 'syntax-object)
+                       '#f)
+                   '#f)))
+            (g203
+             (lambda (g1237 g1236) (vector 'syntax-object g1237 g1236)))
+            (g191
+             (lambda (g1269 g1266 g1268 g1267)
+               (if (null? g1266)
+                   g1267
+                   (list 'letrec (map list g1266 g1268) g1267))))
+            (g190
+             (lambda (g1239 g1238)
+               (if (null? (cdr g1238)) (car g1238) (cons 'begin g1238))))
+            (g101
+             ((lambda (g1251)
+                (letrec ((g1254
+                          (lambda (g1260)
+                            ((letrec ((g1261
+                                       (lambda (g1263 g1262)
+                                         (if (< g1263 g1251)
+                                             (list->string
+                                               (cons (g1253 g1263) g1262))
+                                             ((lambda (g1265 g1264)
+                                                (g1261
+                                                  g1264
+                                                  (cons (g1253 g1265)
+                                                        g1262)))
+                                              (modulo g1263 g1251)
+                                              (quotient g1263 g1251))))))
+                               g1261)
+                             g1260
+                             '())))
+                         (g1253
+                          (lambda (g1259) (integer->char (+ g1259 '33))))
+                         (g1252 (lambda () '0)))
+                  ((lambda (g1256 g1255)
+                     (lambda (g1257)
+                       (begin (set! g1255 (+ g1255 '1))
+                              ((lambda (g1258) g1258)
+                               (string->symbol
+                                 (string-append
+                                   '"#"
+                                   g1256
+                                   (g1254 g1255)))))))
+                   (g1254 (g1252))
+                   '-1)))
+              (- '127 '32 '2)))
+            (g100 (lambda (g1241 g1240) (getprop g1241 g1240)))
+            (g99 (lambda (g1250) (getprop g1250 '*sc-expander*)))
+            (g98 (lambda (g1243 g1242) ($sc-put-cte g1243 g1242)))
+            (g93
+             (lambda (g1249 g1247 g1248)
+               (error g1249 '"~a ~s" g1247 g1248)))
+            (g92 (lambda (g1244) (eval (list g53 g1244))))
+            (g91 (lambda (g1246) (eval (list g53 g1246))))
+            (g90 (lambda (g1245) '#f))
+            (g53 '"noexpand"))
+     (begin (set! $sc-put-cte
+              (lambda (g802 g801)
+                (letrec ((g805
+                          (lambda (g831 g830)
+                            ((lambda (g832)
+                               (putprop g832 '*sc-expander* g830))
+                             (if (symbol? g831) g831 (g377 g831 '(()))))))
+                         (g804
+                          (lambda (g815 g814)
+                            (g429 (lambda (g816) (g803 g816 g814)) g815)))
+                         (g803
+                          (lambda (g818 g817)
+                            (letrec ((g820
+                                      (lambda (g828 g827)
+                                        (if (pair? g827)
+                                            (if (g388 (car g827) g828)
+                                                (g820 g828 (cdr g827))
+                                                (g819 (car g827)
+                                                      (g820 g828
+                                                            (cdr g827))))
+                                            (if ((lambda (g829)
+                                                   (if g829
+                                                       g829
+                                                       (g388 g827 g828)))
+                                                 (not g827))
+                                                '#f
+                                                g827))))
+                                     (g819
+                                      (lambda (g826 g825)
+                                        (if (not g825)
+                                            g826
+                                            (cons g826 g825)))))
+                              ((lambda (g821)
+                                 ((lambda (g822)
+                                    (if (if (not g822) (symbol? g818) '#f)
+                                        (remprop g821 g817)
+                                        (putprop
+                                          g821
+                                          g817
+                                          (g819 g818 g822))))
+                                  (g820 g818 (getprop g821 g817))))
+                               ((lambda (g823)
+                                  ((lambda (g824)
+                                     (if (g90 g824)
+                                         (annotation-expression g824)
+                                         g824))
+                                   (if (g204 g823) (g205 g823) g823)))
+                                g818))))))
+                  ((lambda (g806)
+                     ((lambda (g807)
+                        (if (memv g807 '(module))
+                            (begin ((lambda (g808)
+                                      (g804 (g404 g808) (g405 g808)))
+                                    (g233 g806))
+                                   (g805 g802 g806))
+                            (if (memv g807 '(do-import))
+                                ((lambda (g809)
+                                   ((lambda (g810)
+                                      ((lambda (g811)
+                                         (if (memv g811 '(module))
+                                             ((lambda (g812)
+                                                (begin (if (not (eq? (g405 g812)
+                                                                     g809))
+                                                           (syntax-error
+                                                             g802
+                                                             '"import mismatch for module")
+                                                           (void))
+                                                       (g804 (g404 g812)
+                                                             '*top*)))
+                                              (g233 g810))
+                                             (syntax-error
+                                               g802
+                                               '"import from unknown module")))
+                                       (g232 g810)))
+                                    (g253 (g377 g802 '(())) '())))
+                                 (g233 g801))
+                                (g805 g802 g806))))
+                      (g232 g806)))
+                   ((lambda (g813)
+                      (if g813
+                          g813
+                          (error 'define-syntax
+                            '"invalid transformer ~s"
+                            g801)))
+                    (g252 g801))))))
+            (g254 'local-syntax 'letrec-syntax '#t)
+            (g254 'local-syntax 'let-syntax '#f)
+            (g254 'core
+                  'fluid-let-syntax
+                  (lambda (g456 g453 g455 g454)
+                    ((lambda (g457)
+                       ((lambda (g458)
+                          (if (if g458
+                                  (apply
+                                    (lambda (g463 g459 g462 g460 g461)
+                                      (g389 g459))
+                                    g458)
+                                  '#f)
+                              (apply
+                                (lambda (g469 g465 g468 g466 g467)
+                                  ((lambda (g470)
+                                     (begin (for-each
+                                              (lambda (g477 g476)
+                                                ((lambda (g478)
+                                                   (if (memv g478
+                                                             '(displaced-lexical))
+                                                       (g250 (g393 g477
+                                                                   g455))
+                                                       (void)))
+                                                 (g232 (g253 g476 g453))))
+                                              g465
+                                              g470)
+                                            (g437 (cons g466 g467)
+                                                  (g394 g456 g455 g454)
+                                                  (g247 g470
+                                                        ((lambda (g471)
+                                                           (map (lambda (g473)
+                                                                  (g231 'deferred
+                                                                        (g432 g473
+                                                                              g471
+                                                                              g455)))
+                                                                g468))
+                                                         (g249 g453))
+                                                        g453)
+                                                  g455)))
+                                   (map (lambda (g480) (g377 g480 g455))
+                                        g465)))
+                                g458)
+                              ((lambda (g481)
+                                 (syntax-error (g394 g456 g455 g454)))
+                               g457)))
+                        ($syntax-dispatch
+                          g457
+                          '(any #(each (any any)) any . each-any))))
+                     g456)))
+            (g254 'core
+                  'quote
+                  (lambda (g795 g792 g794 g793)
+                    ((lambda (g796)
+                       ((lambda (g797)
+                          (if g797
+                              (apply
+                                (lambda (g799 g798)
+                                  (list 'quote (g450 g798 g794)))
+                                g797)
+                              ((lambda (g800)
+                                 (syntax-error (g394 g795 g794 g793)))
+                               g796)))
+                        ($syntax-dispatch g796 '(any any))))
+                     g795)))
+            (g254 'core
+                  'syntax
+                  ((lambda ()
+                     (letrec ((g489
+                               (lambda (g584)
+                                 ((lambda (g585)
+                                    (if (memv g585 '(ref))
+                                        (cadr g584)
+                                        (if (memv g585 '(primitive))
+                                            (cadr g584)
+                                            (if (memv g585 '(quote))
+                                                (list 'quote (cadr g584))
+                                                (if (memv g585 '(lambda))
+                                                    (list 'lambda
+                                                          (cadr g584)
+                                                          (g489 (caddr
+                                                                  g584)))
+                                                    (if (memv g585 '(map))
+                                                        ((lambda (g586)
+                                                           (cons (if (= (length
+                                                                          g586)
+                                                                        '2)
+                                                                     'map
+                                                                     'map)
+                                                                 g586))
+                                                         (map g489
+                                                              (cdr g584)))
+                                                        (cons (car g584)
+                                                              (map g489
+                                                                   (cdr g584)))))))))
+                                  (car g584))))
+                              (g488
+                               (lambda (g502)
+                                 (if (eq? (car g502) 'list)
+                                     (cons 'vector (cdr g502))
+                                     (if (eq? (car g502) 'quote)
+                                         (list 'quote
+                                               (list->vector (cadr g502)))
+                                         (list 'list->vector g502)))))
+                              (g487
+                               (lambda (g583 g582)
+                                 (if (equal? g582 ''())
+                                     g583
+                                     (list 'append g583 g582))))
+                              (g486
+                               (lambda (g504 g503)
+                                 ((lambda (g505)
+                                    (if (memv g505 '(quote))
+                                        (if (eq? (car g504) 'quote)
+                                            (list 'quote
+                                                  (cons (cadr g504)
+                                                        (cadr g503)))
+                                            (if (eq? (cadr g503) '())
+                                                (list 'list g504)
+                                                (list 'cons g504 g503)))
+                                        (if (memv g505 '(list))
+                                            (cons 'list
+                                                  (cons g504 (cdr g503)))
+                                            (list 'cons g504 g503))))
+                                  (car g503))))
+                              (g485
+                               (lambda (g575 g574)
+                                 ((lambda (g577 g576)
+                                    (if (eq? (car g575) 'ref)
+                                        (car g576)
+                                        (if (andmap
+                                              (lambda (g578)
+                                                (if (eq? (car g578) 'ref)
+                                                    (memq (cadr g578) g577)
+                                                    '#f))
+                                              (cdr g575))
+                                            (cons 'map
+                                                  (cons (list 'primitive
+                                                              (car g575))
+                                                        (map ((lambda (g579)
+                                                                (lambda (g580)
+                                                                  (cdr (assq (cadr g580)
+                                                                             g579))))
+                                                              (map cons
+                                                                   g577
+                                                                   g576))
+                                                             (cdr g575))))
+                                            (cons 'map
+                                                  (cons (list 'lambda
+                                                              g577
+                                                              g575)
+                                                        g576)))))
+                                  (map cdr g574)
+                                  (map (lambda (g581)
+                                         (list 'ref (car g581)))
+                                       g574))))
+                              (g484
+                               (lambda (g507 g506)
+                                 (list 'apply
+                                       '(primitive append)
+                                       (g485 g507 g506))))
+                              (g483
+                               (lambda (g569 g566 g568 g567)
+                                 (if (= g568 '0)
+                                     (values g566 g567)
+                                     (if (null? g567)
+                                         (syntax-error
+                                           g569
+                                           '"missing ellipsis in syntax form")
+                                         (call-with-values
+                                           (lambda ()
+                                             (g483 g569
+                                                   g566
+                                                   (- g568 '1)
+                                                   (cdr g567)))
+                                           (lambda (g571 g570)
+                                             ((lambda (g572)
+                                                (if g572
+                                                    (values
+                                                      (cdr g572)
+                                                      g567)
+                                                    ((lambda (g573)
+                                                       (values
+                                                         g573
+                                                         (cons (cons (cons g571
+                                                                           g573)
+                                                                     (car g567))
+                                                               g570)))
+                                                     (g451 'tmp))))
+                                              (assq g571 (car g567)))))))))
+                              (g482
+                               (lambda (g512 g508 g511 g509 g510)
+                                 (if (g256 g508)
+                                     ((lambda (g513)
+                                        ((lambda (g514)
+                                           (if (eq? (g232 g514) 'syntax)
+                                               (call-with-values
+                                                 (lambda ()
+                                                   ((lambda (g517)
+                                                      (g483 g512
+                                                            (car g517)
+                                                            (cdr g517)
+                                                            g509))
+                                                    (g233 g514)))
+                                                 (lambda (g516 g515)
+                                                   (values
+                                                     (list 'ref g516)
+                                                     g515)))
+                                               (if (g510 g508)
+                                                   (syntax-error
+                                                     g512
+                                                     '"misplaced ellipsis in syntax form")
+                                                   (values
+                                                     (list 'quote g508)
+                                                     g509))))
+                                         (g253 g513 g511)))
+                                      (g377 g508 '(())))
+                                     ((lambda (g518)
+                                        ((lambda (g519)
+                                           (if (if g519
+                                                   (apply
+                                                     (lambda (g521 g520)
+                                                       (g510 g521))
+                                                     g519)
+                                                   '#f)
+                                               (apply
+                                                 (lambda (g523 g522)
+                                                   (g482 g512
+                                                         g522
+                                                         g511
+                                                         g509
+                                                         (lambda (g524)
+                                                           '#f)))
+                                                 g519)
+                                               ((lambda (g525)
+                                                  (if (if g525
+                                                          (apply
+                                                            (lambda (g528
+                                                                     g526
+                                                                     g527)
+                                                              (g510 g526))
+                                                            g525)
+                                                          '#f)
+                                                      (apply
+                                                        (lambda (g531
+                                                                 g529
+                                                                 g530)
+                                                          ((letrec ((g532
+                                                                     (lambda (g534
+                                                                              g533)
+                                                                       ((lambda (g535)
+                                                                          ((lambda (g536)
+                                                                             (if (if g536
+                                                                                     (apply
+                                                                                       (lambda (g538
+                                                                                                g537)
+                                                                                         (g510 g538))
+                                                                                       g536)
+                                                                                     '#f)
+                                                                                 (apply
+                                                                                   (lambda (g540
+                                                                                            g539)
+                                                                                     (g532 g539
+                                                                                           (lambda (g541)
+                                                                                             (call-with-values
+                                                                                               (lambda ()
+                                                                                                 (g533 (cons '()
+                                                                                                             g541)))
+                                                                                               (lambda (g543
+                                                                                                        g542)
+                                                                                                 (if (null?
+                                                                                                       (car g542))
+                                                                                                     (syntax-error
+                                                                                                       g512
+                                                                                                       '"extra ellipsis in syntax form")
+                                                                                                     (values
+                                                                                                       (g484 g543
+                                                                                                             (car g542))
+                                                                                                       (cdr g542))))))))
+                                                                                   g536)
+                                                                                 ((lambda (g544)
+                                                                                    (call-with-values
+                                                                                      (lambda ()
+                                                                                        (g482 g512
+                                                                                              g534
+                                                                                              g511
+                                                                                              g509
+                                                                                              g510))
+                                                                                      (lambda (g546
+                                                                                               g545)
+                                                                                        (call-with-values
+                                                                                          (lambda ()
+                                                                                            (g533 g545))
+                                                                                          (lambda (g548
+                                                                                                   g547)
+                                                                                            (values
+                                                                                              (g487 g548
+                                                                                                    g546)
+                                                                                              g547))))))
+                                                                                  g535)))
+                                                                           ($syntax-dispatch
+                                                                             g535
+                                                                             '(any .
+                                                                                   any))))
+                                                                        g534))))
+                                                             g532)
+                                                           g530
+                                                           (lambda (g549)
+                                                             (call-with-values
+                                                               (lambda ()
+                                                                 (g482 g512
+                                                                       g531
+                                                                       g511
+                                                                       (cons '()
+                                                                             g549)
+                                                                       g510))
+                                                               (lambda (g551
+                                                                        g550)
+                                                                 (if (null?
+                                                                       (car g550))
+                                                                     (syntax-error
+                                                                       g512
+                                                                       '"extra ellipsis in syntax form")
+                                                                     (values
+                                                                       (g485 g551
+                                                                             (car g550))
+                                                                       (cdr g550))))))))
+                                                        g525)
+                                                      ((lambda (g552)
+                                                         (if g552
+                                                             (apply
+                                                               (lambda (g554
+                                                                        g553)
+                                                                 (call-with-values
+                                                                   (lambda ()
+                                                                     (g482 g512
+                                                                           g554
+                                                                           g511
+                                                                           g509
+                                                                           g510))
+                                                                   (lambda (g556
+                                                                            g555)
+                                                                     (call-with-values
+                                                                       (lambda ()
+                                                                         (g482 g512
+                                                                               g553
+                                                                               g511
+                                                                               g555
+                                                                               g510))
+                                                                       (lambda (g558
+                                                                                g557)
+                                                                         (values
+                                                                           (g486 g556
+                                                                                 g558)
+                                                                           g557))))))
+                                                               g552)
+                                                             ((lambda (g559)
+                                                                (if g559
+                                                                    (apply
+                                                                      (lambda (g561
+                                                                               g560)
+                                                                        (call-with-values
+                                                                          (lambda ()
+                                                                            (g482 g512
+                                                                                  (cons g561
+                                                                                        g560)
+                                                                                  g511
+                                                                                  g509
+                                                                                  g510))
+                                                                          (lambda (g563
+                                                                                   g562)
+                                                                            (values
+                                                                              (g488 g563)
+                                                                              g562))))
+                                                                      g559)
+                                                                    ((lambda (g565)
+                                                                       (values
+                                                                         (list 'quote
+                                                                               g508)
+                                                                         g509))
+                                                                     g518)))
+                                                              ($syntax-dispatch
+                                                                g518
+                                                                '#(vector
+                                                                   (any .
+                                                                        each-any))))))
+                                                       ($syntax-dispatch
+                                                         g518
+                                                         '(any . any)))))
+                                                ($syntax-dispatch
+                                                  g518
+                                                  '(any any . any)))))
+                                         ($syntax-dispatch
+                                           g518
+                                           '(any any))))
+                                      g508)))))
+                       (lambda (g493 g490 g492 g491)
+                         ((lambda (g494)
+                            ((lambda (g495)
+                               ((lambda (g496)
+                                  (if g496
+                                      (apply
+                                        (lambda (g498 g497)
+                                          (call-with-values
+                                            (lambda ()
+                                              (g482 g494
+                                                    g497
+                                                    g490
+                                                    '()
+                                                    g447))
+                                            (lambda (g500 g499)
+                                              (g489 g500))))
+                                        g496)
+                                      ((lambda (g501) (syntax-error g494))
+                                       g495)))
+                                ($syntax-dispatch g495 '(any any))))
+                             g494))
+                          (g394 g493 g492 g491)))))))
+            (g254 'core
+                  'lambda
+                  (lambda (g785 g782 g784 g783)
+                    ((lambda (g786)
+                       ((lambda (g787)
+                          (if g787
+                              (apply
+                                (lambda (g789 g788)
+                                  (g444 (g394 g785 g784 g783)
+                                        g788
+                                        g782
+                                        g784
+                                        (lambda (g791 g790)
+                                          (list 'lambda g791 g790))))
+                                g787)
+                              (syntax-error g786)))
+                        ($syntax-dispatch g786 '(any . any))))
+                     g785)))
+            (g254 'core
+                  'letrec
+                  (lambda (g590 g587 g589 g588)
+                    ((lambda (g591)
+                       ((lambda (g592)
+                          (if g592
+                              (apply
+                                (lambda (g597 g593 g596 g594 g595)
+                                  ((lambda (g598)
+                                     (if (not (g389 g598))
+                                         (g391 (map (lambda (g599)
+                                                      (g393 g599 g589))
+                                                    g598)
+                                               (g394 g590 g589 g588)
+                                               '"bound variable")
+                                         ((lambda (g601 g600)
+                                            ((lambda (g603 g602)
+                                               (g191 g588
+                                                     g600
+                                                     (map (lambda (g606)
+                                                            (g432 g606
+                                                                  g602
+                                                                  g603))
+                                                          g596)
+                                                     (g437 (cons g594 g595)
+                                                           (g394 g590
+                                                                 g603
+                                                                 g588)
+                                                           g602
+                                                           g603)))
+                                             (g368 g598 g601 g589)
+                                             (g248 g601 g600 g587)))
+                                          (g299 g598)
+                                          (map g451 g598))))
+                                   g593))
+                                g592)
+                              ((lambda (g608)
+                                 (syntax-error (g394 g590 g589 g588)))
+                               g591)))
+                        ($syntax-dispatch
+                          g591
+                          '(any #(each (any any)) any . each-any))))
+                     g590)))
+            (g254 'core
+                  'if
+                  (lambda (g770 g767 g769 g768)
+                    ((lambda (g771)
+                       ((lambda (g772)
+                          (if g772
+                              (apply
+                                (lambda (g775 g773 g774)
+                                  (list 'if
+                                        (g432 g773 g767 g769)
+                                        (g432 g774 g767 g769)
+                                        (g446)))
+                                g772)
+                              ((lambda (g776)
+                                 (if g776
+                                     (apply
+                                       (lambda (g780 g777 g779 g778)
+                                         (list 'if
+                                               (g432 g777 g767 g769)
+                                               (g432 g779 g767 g769)
+                                               (g432 g778 g767 g769)))
+                                       g776)
+                                     ((lambda (g781)
+                                        (syntax-error
+                                          (g394 g770 g769 g768)))
+                                      g771)))
+                               ($syntax-dispatch
+                                 g771
+                                 '(any any any any)))))
+                        ($syntax-dispatch g771 '(any any any))))
+                     g770)))
+            (g254 'set! 'set! '())
+            (g254 'begin 'begin '())
+            (g254 'module-key 'module '())
+            (g254 'import 'import '#f)
+            (g254 'import 'import-only '#t)
+            (g254 'define 'define '())
+            (g254 'define-syntax 'define-syntax '())
+            (g254 'eval-when 'eval-when '())
+            (g254 'core
+                  'syntax-case
+                  ((lambda ()
+                     (letrec ((g612
+                               (lambda (g693 g690 g692 g691)
+                                 (if (null? g692)
+                                     (list 'syntax-error g693)
+                                     ((lambda (g694)
+                                        ((lambda (g695)
+                                           (if g695
+                                               (apply
+                                                 (lambda (g697 g696)
+                                                   (if (if (g256 g697)
+                                                           (if (not (g392 g697
+                                                                          g690))
+                                                               (not (g447 g697))
+                                                               '#f)
+                                                           '#f)
+                                                       ((lambda (g699 g698)
+                                                          (list (list 'lambda
+                                                                      (list g698)
+                                                                      (g432 g696
+                                                                            (g246 g699
+                                                                                  (g231 'syntax
+                                                                                        (cons g698
+                                                                                              '0))
+                                                                                  g691)
+                                                                            (g368 (list g697)
+                                                                                  (list g699)
+                                                                                  '(()))))
+                                                                g693))
+                                                        (g297)
+                                                        (g451 g697))
+                                                       (g611 g693
+                                                             g690
+                                                             (cdr g692)
+                                                             g691
+                                                             g697
+                                                             '#t
+                                                             g696)))
+                                                 g695)
+                                               ((lambda (g700)
+                                                  (if g700
+                                                      (apply
+                                                        (lambda (g703
+                                                                 g701
+                                                                 g702)
+                                                          (g611 g693
+                                                                g690
+                                                                (cdr g692)
+                                                                g691
+                                                                g703
+                                                                g701
+                                                                g702))
+                                                        g700)
+                                                      ((lambda (g704)
+                                                         (syntax-error
+                                                           (car g692)
+                                                           '"invalid syntax-case clause"))
+                                                       g694)))
+                                                ($syntax-dispatch
+                                                  g694
+                                                  '(any any any)))))
+                                         ($syntax-dispatch
+                                           g694
+                                           '(any any))))
+                                      (car g692)))))
+                              (g611
+                               (lambda (g635 g629 g634 g630 g633 g631 g632)
+                                 (call-with-values
+                                   (lambda () (g609 g633 g629))
+                                   (lambda (g637 g636)
+                                     (if (not (g390 (map car g636)))
+                                         (g391 (map car g636)
+                                               g633
+                                               '"pattern variable")
+                                         (if (not (andmap
+                                                    (lambda (g638)
+                                                      (not (g447 (car g638))))
+                                                    g636))
+                                             (syntax-error
+                                               g633
+                                               '"misplaced ellipsis in syntax-case pattern")
+                                             ((lambda (g639)
+                                                (list (list 'lambda
+                                                            (list g639)
+                                                            (list 'if
+                                                                  ((lambda (g649)
+                                                                     ((lambda (g650)
+                                                                        (if g650
+                                                                            (apply
+                                                                              (lambda ()
+                                                                                g639)
+                                                                              g650)
+                                                                            ((lambda (g651)
+                                                                               (list 'if
+                                                                                     g639
+                                                                                     (g610 g636
+                                                                                           g631
+                                                                                           g639
+                                                                                           g630)
+                                                                                     (list 'quote
+                                                                                           '#f)))
+                                                                             g649)))
+                                                                      ($syntax-dispatch
+                                                                        g649
+                                                                        '#(atom
+                                                                           #t))))
+                                                                   g631)
+                                                                  (g610 g636
+                                                                        g632
+                                                                        g639
+                                                                        g630)
+                                                                  (g612 g635
+                                                                        g629
+                                                                        g634
+                                                                        g630)))
+                                                      (if (eq? g637 'any)
+                                                          (list 'list g635)
+                                                          (list '$syntax-dispatch
+                                                                g635
+                                                                (list 'quote
+                                                                      g637)))))
+                                              (g451 'tmp))))))))
+                              (g610
+                               (lambda (g683 g680 g682 g681)
+                                 ((lambda (g685 g684)
+                                    ((lambda (g687 g686)
+                                       (list 'apply
+                                             (list 'lambda
+                                                   g686
+                                                   (g432 g680
+                                                         (g247 g687
+                                                               (map (lambda (g689
+                                                                             g688)
+                                                                      (g231 'syntax
+                                                                            (cons g689
+                                                                                  g688)))
+                                                                    g686
+                                                                    (map cdr
+                                                                         g683))
+                                                               g681)
+                                                         (g368 g685
+                                                               g687
+                                                               '(()))))
+                                             g682))
+                                     (g299 g685)
+                                     (map g451 g685)))
+                                  (map car g683)
+                                  (map cdr g683))))
+                              (g609
+                               (lambda (g653 g652)
+                                 ((letrec ((g654
+                                            (lambda (g657 g655 g656)
+                                              (if (g256 g657)
+                                                  (if (g392 g657 g652)
+                                                      (values
+                                                        (vector
+                                                          'free-id
+                                                          g657)
+                                                        g656)
+                                                      (values
+                                                        'any
+                                                        (cons (cons g657
+                                                                    g655)
+                                                              g656)))
+                                                  ((lambda (g658)
+                                                     ((lambda (g659)
+                                                        (if (if g659
+                                                                (apply
+                                                                  (lambda (g661
+                                                                           g660)
+                                                                    (g447 g660))
+                                                                  g659)
+                                                                '#f)
+                                                            (apply
+                                                              (lambda (g663
+                                                                       g662)
+                                                                (call-with-values
+                                                                  (lambda ()
+                                                                    (g654 g663
+                                                                          (+ g655
+                                                                             '1)
+                                                                          g656))
+                                                                  (lambda (g665
+                                                                           g664)
+                                                                    (values
+                                                                      (if (eq? g665
+                                                                               'any)
+                                                                          'each-any
+                                                                          (vector
+                                                                            'each
+                                                                            g665))
+                                                                      g664))))
+                                                              g659)
+                                                            ((lambda (g666)
+                                                               (if g666
+                                                                   (apply
+                                                                     (lambda (g668
+                                                                              g667)
+                                                                       (call-with-values
+                                                                         (lambda ()
+                                                                           (g654 g667
+                                                                                 g655
+                                                                                 g656))
+                                                                         (lambda (g670
+                                                                                  g669)
+                                                                           (call-with-values
+                                                                             (lambda ()
+                                                                               (g654 g668
+                                                                                     g655
+                                                                                     g669))
+                                                                             (lambda (g672
+                                                                                      g671)
+                                                                               (values
+                                                                                 (cons g672
+                                                                                       g670)
+                                                                                 g671))))))
+                                                                     g666)
+                                                                   ((lambda (g673)
+                                                                      (if g673
+                                                                          (apply
+                                                                            (lambda ()
+                                                                              (values
+                                                                                '()
+                                                                                g656))
+                                                                            g673)
+                                                                          ((lambda (g674)
+                                                                             (if g674
+                                                                                 (apply
+                                                                                   (lambda (g675)
+                                                                                     (call-with-values
+                                                                                       (lambda ()
+                                                                                         (g654 g675
+                                                                                               g655
+                                                                                               g656))
+                                                                                       (lambda (g677
+                                                                                                g676)
+                                                                                         (values
+                                                                                           (vector
+                                                                                             'vector
+                                                                                             g677)
+                                                                                           g676))))
+                                                                                   g674)
+                                                                                 ((lambda (g679)
+                                                                                    (values
+                                                                                      (vector
+                                                                                        'atom
+                                                                                        (g450 g657
+                                                                                              '(())))
+                                                                                      g656))
+                                                                                  g658)))
+                                                                           ($syntax-dispatch
+                                                                             g658
+                                                                             '#(vector
+                                                                                each-any)))))
+                                                                    ($syntax-dispatch
+                                                                      g658
+                                                                      '()))))
+                                                             ($syntax-dispatch
+                                                               g658
+                                                               '(any .
+                                                                     any)))))
+                                                      ($syntax-dispatch
+                                                        g658
+                                                        '(any any))))
+                                                   g657)))))
+                                    g654)
+                                  g653
+                                  '0
+                                  '()))))
+                       (lambda (g616 g613 g615 g614)
+                         ((lambda (g617)
+                            ((lambda (g618)
+                               ((lambda (g619)
+                                  (if g619
+                                      (apply
+                                        (lambda (g623 g620 g622 g621)
+                                          (if (andmap
+                                                (lambda (g625)
+                                                  (if (g256 g625)
+                                                      (not (g447 g625))
+                                                      '#f))
+                                                g622)
+                                              ((lambda (g626)
+                                                 (list (list 'lambda
+                                                             (list g626)
+                                                             (g612 g626
+                                                                   g622
+                                                                   g621
+                                                                   g613))
+                                                       (g432 g620
+                                                             g613
+                                                             '(()))))
+                                               (g451 'tmp))
+                                              (syntax-error
+                                                g617
+                                                '"invalid literals list in")))
+                                        g619)
+                                      (syntax-error g618)))
+                                ($syntax-dispatch
+                                  g618
+                                  '(any any each-any . each-any))))
+                             g617))
+                          (g394 g616 g615 g614)))))))
+            (set! sc-expand
+              ((lambda (g763 g761 g762)
+                 ((lambda (g764)
+                    (lambda (g765)
+                      (if (if (pair? g765) (equal? (car g765) g53) '#f)
+                          (cadr g765)
+                          (g400 g765 '() g764 g763 g761 g762))))
+                  (g263 (g264 '((top))) (cons g762 (g265 '((top)))))))
+               'e
+               '(eval)
+               ((lambda (g766) (begin (g366 g766 '*top*) g766))
+                (g304 '() '() '()))))
+            (set! identifier? (lambda (g705) (g255 g705)))
+            (set! datum->syntax-object
+              (lambda (g759 g758)
+                (begin ((lambda (g760)
+                          (if (not (g255 g760))
+                              (g93 'datum->syntax-object
+                                   '"invalid argument"
+                                   g760)
+                              (void)))
+                        g759)
+                       (g203 g758 (g206 g759)))))
+            (set! syntax-object->datum
+              (lambda (g706) (g450 g706 '(()))))
+            (set! generate-temporaries
+              (lambda (g755)
+                (begin ((lambda (g757)
+                          (if (not (list? g757))
+                              (g93 'generate-temporaries
+                                   '"invalid argument"
+                                   g757)
+                              (void)))
+                        g755)
+                       (map (lambda (g756) (g393 (gensym) '((top))))
+                            g755))))
+            (set! free-identifier=?
+              (lambda (g708 g707)
+                (begin ((lambda (g710)
+                          (if (not (g255 g710))
+                              (g93 'free-identifier=?
+                                   '"invalid argument"
+                                   g710)
+                              (void)))
+                        g708)
+                       ((lambda (g709)
+                          (if (not (g255 g709))
+                              (g93 'free-identifier=?
+                                   '"invalid argument"
+                                   g709)
+                              (void)))
+                        g707)
+                       (g378 g708 g707))))
+            (set! bound-identifier=?
+              (lambda (g752 g751)
+                (begin ((lambda (g754)
+                          (if (not (g255 g754))
+                              (g93 'bound-identifier=?
+                                   '"invalid argument"
+                                   g754)
+                              (void)))
+                        g752)
+                       ((lambda (g753)
+                          (if (not (g255 g753))
+                              (g93 'bound-identifier=?
+                                   '"invalid argument"
+                                   g753)
+                              (void)))
+                        g751)
+                       (g388 g752 g751))))
+            (set! syntax-error
+              (lambda (g711 . g712)
+                (begin (for-each
+                         (lambda (g714)
+                           ((lambda (g715)
+                              (if (not (string? g715))
+                                  (g93 'syntax-error
+                                       '"invalid argument"
+                                       g715)
+                                  (void)))
+                            g714))
+                         g712)
+                       ((lambda (g713) (g93 '#f g713 (g450 g711 '(()))))
+                        (if (null? g712)
+                            '"invalid syntax"
+                            (apply string-append g712))))))
+            ((lambda ()
+               (letrec ((g720
+                         (lambda (g748 g745 g747 g746)
+                           (if (not g746)
+                               '#f
+                               (if (eq? g745 'any)
+                                   (cons (g393 g748 g747) g746)
+                                   (if (g204 g748)
+                                       (g719 ((lambda (g749)
+                                                (if (g90 g749)
+                                                    (annotation-expression
+                                                      g749)
+                                                    g749))
+                                              (g205 g748))
+                                             g745
+                                             (g371 g747 (g206 g748))
+                                             g746)
+                                       (g719 ((lambda (g750)
+                                                (if (g90 g750)
+                                                    (annotation-expression
+                                                      g750)
+                                                    g750))
+                                              g748)
+                                             g745
+                                             g747
+                                             g746))))))
+                        (g719
+                         (lambda (g728 g725 g727 g726)
+                           (if (null? g725)
+                               (if (null? g728) g726 '#f)
+                               (if (pair? g725)
+                                   (if (pair? g728)
+                                       (g720 (car g728)
+                                             (car g725)
+                                             g727
+                                             (g720 (cdr g728)
+                                                   (cdr g725)
+                                                   g727
+                                                   g726))
+                                       '#f)
+                                   (if (eq? g725 'each-any)
+                                       ((lambda (g729)
+                                          (if g729 (cons g729 g726) '#f))
+                                        (g717 g728 g727))
+                                       ((lambda (g730)
+                                          (if (memv g730 '(each))
+                                              (if (null? g728)
+                                                  (g718 (vector-ref
+                                                          g725
+                                                          '1)
+                                                        g726)
+                                                  ((lambda (g731)
+                                                     (if g731
+                                                         ((letrec ((g732
+                                                                    (lambda (g733)
+                                                                      (if (null?
+                                                                            (car g733))
+                                                                          g726
+                                                                          (cons (map car
+                                                                                     g733)
+                                                                                (g732 (map cdr
+                                                                                           g733)))))))
+                                                            g732)
+                                                          g731)
+                                                         '#f))
+                                                   (g716 g728
+                                                         (vector-ref
+                                                           g725
+                                                           '1)
+                                                         g727)))
+                                              (if (memv g730 '(free-id))
+                                                  (if (g256 g728)
+                                                      (if (g378 (g393 g728
+                                                                      g727)
+                                                                (vector-ref
+                                                                  g725
+                                                                  '1))
+                                                          g726
+                                                          '#f)
+                                                      '#f)
+                                                  (if (memv g730 '(atom))
+                                                      (if (equal?
+                                                            (vector-ref
+                                                              g725
+                                                              '1)
+                                                            (g450 g728
+                                                                  g727))
+                                                          g726
+                                                          '#f)
+                                                      (if (memv g730
+                                                                '(vector))
+                                                          (if (vector?
+                                                                g728)
+                                                              (g720 (vector->list
+                                                                      g728)
+                                                                    (vector-ref
+                                                                      g725
+                                                                      '1)
+                                                                    g727
+                                                                    g726)
+                                                              '#f)
+                                                          (void))))))
+                                        (vector-ref g725 '0)))))))
+                        (g718
+                         (lambda (g743 g742)
+                           (if (null? g743)
+                               g742
+                               (if (eq? g743 'any)
+                                   (cons '() g742)
+                                   (if (pair? g743)
+                                       (g718 (car g743)
+                                             (g718 (cdr g743) g742))
+                                       (if (eq? g743 'each-any)
+                                           (cons '() g742)
+                                           ((lambda (g744)
+                                              (if (memv g744 '(each))
+                                                  (g718 (vector-ref
+                                                          g743
+                                                          '1)
+                                                        g742)
+                                                  (if (memv g744
+                                                            '(free-id
+                                                               atom))
+                                                      g742
+                                                      (if (memv g744
+                                                                '(vector))
+                                                          (g718 (vector-ref
+                                                                  g743
+                                                                  '1)
+                                                                g742)
+                                                          (void)))))
+                                            (vector-ref g743 '0))))))))
+                        (g717
+                         (lambda (g735 g734)
+                           (if (g90 g735)
+                               (g717 (annotation-expression g735) g734)
+                               (if (pair? g735)
+                                   ((lambda (g736)
+                                      (if g736
+                                          (cons (g393 (car g735) g734)
+                                                g736)
+                                          '#f))
+                                    (g717 (cdr g735) g734))
+                                   (if (null? g735)
+                                       '()
+                                       (if (g204 g735)
+                                           (g717 (g205 g735)
+                                                 (g371 g734 (g206 g735)))
+                                           '#f))))))
+                        (g716
+                         (lambda (g739 g737 g738)
+                           (if (g90 g739)
+                               (g716 (annotation-expression g739)
+                                     g737
+                                     g738)
+                               (if (pair? g739)
+                                   ((lambda (g740)
+                                      (if g740
+                                          ((lambda (g741)
+                                             (if g741
+                                                 (cons g740 g741)
+                                                 '#f))
+                                           (g716 (cdr g739) g737 g738))
+                                          '#f))
+                                    (g720 (car g739) g737 g738 '()))
+                                   (if (null? g739)
+                                       '()
+                                       (if (g204 g739)
+                                           (g716 (g205 g739)
+                                                 g737
+                                                 (g371 g738 (g206 g739)))
+                                           '#f)))))))
+                 (set! $syntax-dispatch
+                   (lambda (g722 g721)
+                     (if (eq? g721 'any)
+                         (list g722)
+                         (if (g204 g722)
+                             (g719 ((lambda (g723)
+                                      (if (g90 g723)
+                                          (annotation-expression g723)
+                                          g723))
+                                    (g205 g722))
+                                   g721
+                                   (g206 g722)
+                                   '())
+                             (g719 ((lambda (g724)
+                                      (if (g90 g724)
+                                          (annotation-expression g724)
+                                          g724))
+                                    g722)
+                                   g721
+                                   '(())
+                                   '()))))))))))))
+($sc-put-cte
+  'with-syntax
+  (lambda (g1828)
+    ((lambda (g1829)
+       ((lambda (g1830)
+          (if g1830
+              (apply
+                (lambda (g1833 g1831 g1832)
+                  (cons '#(syntax-object
+                           begin
+                           ((top)
+                            #(ribcage
+                              #(_ e1 e2)
+                              #((top) (top) (top))
+                              #("i" "i" "i"))
+                            #(ribcage () () ())
+                            #(ribcage #(x) #((top)) #("i"))
+                            #(ribcage ((import-token . *top*)) () ())))
+                        (cons g1831 g1832)))
+                g1830)
+              ((lambda (g1835)
+                 (if g1835
+                     (apply
+                       (lambda (g1840 g1836 g1839 g1837 g1838)
+                         (list '#(syntax-object
+                                  syntax-case
+                                  ((top)
+                                   #(ribcage
+                                     #(_ out in e1 e2)
+                                     #((top) (top) (top) (top) (top))
+                                     #("i" "i" "i" "i" "i"))
+                                   #(ribcage () () ())
+                                   #(ribcage #(x) #((top)) #("i"))
+                                   #(ribcage
+                                     ((import-token . *top*))
+                                     ()
+                                     ())))
+                               g1839
+                               '()
+                               (list g1836
+                                     (cons '#(syntax-object
+                                              begin
+                                              ((top)
+                                               #(ribcage
+                                                 #(_ out in e1 e2)
+                                                 #((top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top))
+                                                 #("i" "i" "i" "i" "i"))
+                                               #(ribcage () () ())
+                                               #(ribcage
+                                                 #(x)
+                                                 #((top))
+                                                 #("i"))
+                                               #(ribcage
+                                                 ((import-token . *top*))
+                                                 ()
+                                                 ())))
+                                           (cons g1837 g1838)))))
+                       g1835)
+                     ((lambda (g1842)
+                        (if g1842
+                            (apply
+                              (lambda (g1847 g1843 g1846 g1844 g1845)
+                                (list '#(syntax-object
+                                         syntax-case
+                                         ((top)
+                                          #(ribcage
+                                            #(_ out in e1 e2)
+                                            #((top)
+                                              (top)
+                                              (top)
+                                              (top)
+                                              (top))
+                                            #("i" "i" "i" "i" "i"))
+                                          #(ribcage () () ())
+                                          #(ribcage #(x) #((top)) #("i"))
+                                          #(ribcage
+                                            ((import-token . *top*))
+                                            ()
+                                            ())))
+                                      (cons '#(syntax-object
+                                               list
+                                               ((top)
+                                                #(ribcage
+                                                  #(_ out in e1 e2)
+                                                  #((top)
+                                                    (top)
+                                                    (top)
+                                                    (top)
+                                                    (top))
+                                                  #("i" "i" "i" "i" "i"))
+                                                #(ribcage () () ())
+                                                #(ribcage
+                                                  #(x)
+                                                  #((top))
+                                                  #("i"))
+                                                #(ribcage
+                                                  ((import-token . *top*))
+                                                  ()
+                                                  ())))
+                                            g1846)
+                                      '()
+                                      (list g1843
+                                            (cons '#(syntax-object
+                                                     begin
+                                                     ((top)
+                                                      #(ribcage
+                                                        #(_ out in e1 e2)
+                                                        #((top)
+                                                          (top)
+                                                          (top)
+                                                          (top)
+                                                          (top))
+                                                        #("i"
+                                                          "i"
+                                                          "i"
+                                                          "i"
+                                                          "i"))
+                                                      #(ribcage () () ())
+                                                      #(ribcage
+                                                        #(x)
+                                                        #((top))
+                                                        #("i"))
+                                                      #(ribcage
+                                                        ((import-token
+                                                           .
+                                                           *top*))
+                                                        ()
+                                                        ())))
+                                                  (cons g1844 g1845)))))
+                              g1842)
+                            (syntax-error g1829)))
+                      ($syntax-dispatch
+                        g1829
+                        '(any #(each (any any)) any . each-any)))))
+               ($syntax-dispatch
+                 g1829
+                 '(any ((any any)) any . each-any)))))
+        ($syntax-dispatch g1829 '(any () any . each-any))))
+     g1828)))
+($sc-put-cte
+  'syntax-rules
+  (lambda (g1851)
+    ((lambda (g1852)
+       ((lambda (g1853)
+          (if g1853
+              (apply
+                (lambda (g1858 g1854 g1857 g1855 g1856)
+                  (list '#(syntax-object
+                           lambda
+                           ((top)
+                            #(ribcage
+                              #(_ k keyword pattern template)
+                              #((top) (top) (top) (top) (top))
+                              #("i" "i" "i" "i" "i"))
+                            #(ribcage () () ())
+                            #(ribcage #(x) #((top)) #("i"))
+                            #(ribcage ((import-token . *top*)) () ())))
+                        '(#(syntax-object
+                            x
+                            ((top)
+                             #(ribcage
+                               #(_ k keyword pattern template)
+                               #((top) (top) (top) (top) (top))
+                               #("i" "i" "i" "i" "i"))
+                             #(ribcage () () ())
+                             #(ribcage #(x) #((top)) #("i"))
+                             #(ribcage ((import-token . *top*)) () ()))))
+                        (cons '#(syntax-object
+                                 syntax-case
+                                 ((top)
+                                  #(ribcage
+                                    #(_ k keyword pattern template)
+                                    #((top) (top) (top) (top) (top))
+                                    #("i" "i" "i" "i" "i"))
+                                  #(ribcage () () ())
+                                  #(ribcage #(x) #((top)) #("i"))
+                                  #(ribcage
+                                    ((import-token . *top*))
+                                    ()
+                                    ())))
+                              (cons '#(syntax-object
+                                       x
+                                       ((top)
+                                        #(ribcage
+                                          #(_ k keyword pattern template)
+                                          #((top) (top) (top) (top) (top))
+                                          #("i" "i" "i" "i" "i"))
+                                        #(ribcage () () ())
+                                        #(ribcage #(x) #((top)) #("i"))
+                                        #(ribcage
+                                          ((import-token . *top*))
+                                          ()
+                                          ())))
+                                    (cons g1854
+                                          (map (lambda (g1861 g1860)
+                                                 (list (cons '#(syntax-object
+                                                                dummy
+                                                                ((top)
+                                                                 #(ribcage
+                                                                   #(_
+                                                                     k
+                                                                     keyword
+                                                                     pattern
+                                                                     template)
+                                                                   #((top)
+                                                                     (top)
+                                                                     (top)
+                                                                     (top)
+                                                                     (top))
+                                                                   #("i"
+                                                                     "i"
+                                                                     "i"
+                                                                     "i"
+                                                                     "i"))
+                                                                 #(ribcage
+                                                                   ()
+                                                                   ()
+                                                                   ())
+                                                                 #(ribcage
+                                                                   #(x)
+                                                                   #((top))
+                                                                   #("i"))
+                                                                 #(ribcage
+                                                                   ((import-token
+                                                                      .
+                                                                      *top*))
+                                                                   ()
+                                                                   ())))
+                                                             g1860)
+                                                       (list '#(syntax-object
+                                                                syntax
+                                                                ((top)
+                                                                 #(ribcage
+                                                                   #(_
+                                                                     k
+                                                                     keyword
+                                                                     pattern
+                                                                     template)
+                                                                   #((top)
+                                                                     (top)
+                                                                     (top)
+                                                                     (top)
+                                                                     (top))
+                                                                   #("i"
+                                                                     "i"
+                                                                     "i"
+                                                                     "i"
+                                                                     "i"))
+                                                                 #(ribcage
+                                                                   ()
+                                                                   ()
+                                                                   ())
+                                                                 #(ribcage
+                                                                   #(x)
+                                                                   #((top))
+                                                                   #("i"))
+                                                                 #(ribcage
+                                                                   ((import-token
+                                                                      .
+                                                                      *top*))
+                                                                   ()
+                                                                   ())))
+                                                             g1861)))
+                                               g1856
+                                               g1855))))))
+                g1853)
+              (syntax-error g1852)))
+        ($syntax-dispatch
+          g1852
+          '(any each-any . #(each ((any . any) any))))))
+     g1851)))
+($sc-put-cte
+  'or
+  (lambda (g1862)
+    ((lambda (g1863)
+       ((lambda (g1864)
+          (if g1864
+              (apply
+                (lambda (g1865)
+                  '#(syntax-object
+                     #f
+                     ((top)
+                      #(ribcage #(_) #((top)) #("i"))
+                      #(ribcage () () ())
+                      #(ribcage #(x) #((top)) #("i"))
+                      #(ribcage ((import-token . *top*)) () ()))))
+                g1864)
+              ((lambda (g1866)
+                 (if g1866
+                     (apply (lambda (g1868 g1867) g1867) g1866)
+                     ((lambda (g1869)
+                        (if g1869
+                            (apply
+                              (lambda (g1873 g1870 g1872 g1871)
+                                (list '#(syntax-object
+                                         let
+                                         ((top)
+                                          #(ribcage
+                                            #(_ e1 e2 e3)
+                                            #((top) (top) (top) (top))
+                                            #("i" "i" "i" "i"))
+                                          #(ribcage () () ())
+                                          #(ribcage #(x) #((top)) #("i"))
+                                          #(ribcage
+                                            ((import-token . *top*))
+                                            ()
+                                            ())))
+                                      (list (list '#(syntax-object
+                                                     t
+                                                     ((top)
+                                                      #(ribcage
+                                                        #(_ e1 e2 e3)
+                                                        #((top)
+                                                          (top)
+                                                          (top)
+                                                          (top))
+                                                        #("i" "i" "i" "i"))
+                                                      #(ribcage () () ())
+                                                      #(ribcage
+                                                        #(x)
+                                                        #((top))
+                                                        #("i"))
+                                                      #(ribcage
+                                                        ((import-token
+                                                           .
+                                                           *top*))
+                                                        ()
+                                                        ())))
+                                                  g1870))
+                                      (list '#(syntax-object
+                                               if
+                                               ((top)
+                                                #(ribcage
+                                                  #(_ e1 e2 e3)
+                                                  #((top)
+                                                    (top)
+                                                    (top)
+                                                    (top))
+                                                  #("i" "i" "i" "i"))
+                                                #(ribcage () () ())
+                                                #(ribcage
+                                                  #(x)
+                                                  #((top))
+                                                  #("i"))
+                                                #(ribcage
+                                                  ((import-token . *top*))
+                                                  ()
+                                                  ())))
+                                            '#(syntax-object
+                                               t
+                                               ((top)
+                                                #(ribcage
+                                                  #(_ e1 e2 e3)
+                                                  #((top)
+                                                    (top)
+                                                    (top)
+                                                    (top))
+                                                  #("i" "i" "i" "i"))
+                                                #(ribcage () () ())
+                                                #(ribcage
+                                                  #(x)
+                                                  #((top))
+                                                  #("i"))
+                                                #(ribcage
+                                                  ((import-token . *top*))
+                                                  ()
+                                                  ())))
+                                            '#(syntax-object
+                                               t
+                                               ((top)
+                                                #(ribcage
+                                                  #(_ e1 e2 e3)
+                                                  #((top)
+                                                    (top)
+                                                    (top)
+                                                    (top))
+                                                  #("i" "i" "i" "i"))
+                                                #(ribcage () () ())
+                                                #(ribcage
+                                                  #(x)
+                                                  #((top))
+                                                  #("i"))
+                                                #(ribcage
+                                                  ((import-token . *top*))
+                                                  ()
+                                                  ())))
+                                            (cons '#(syntax-object
+                                                     or
+                                                     ((top)
+                                                      #(ribcage
+                                                        #(_ e1 e2 e3)
+                                                        #((top)
+                                                          (top)
+                                                          (top)
+                                                          (top))
+                                                        #("i" "i" "i" "i"))
+                                                      #(ribcage () () ())
+                                                      #(ribcage
+                                                        #(x)
+                                                        #((top))
+                                                        #("i"))
+                                                      #(ribcage
+                                                        ((import-token
+                                                           .
+                                                           *top*))
+                                                        ()
+                                                        ())))
+                                                  (cons g1872 g1871)))))
+                              g1869)
+                            (syntax-error g1863)))
+                      ($syntax-dispatch g1863 '(any any any . each-any)))))
+               ($syntax-dispatch g1863 '(any any)))))
+        ($syntax-dispatch g1863 '(any))))
+     g1862)))
+($sc-put-cte
+  'and
+  (lambda (g1875)
+    ((lambda (g1876)
+       ((lambda (g1877)
+          (if g1877
+              (apply
+                (lambda (g1881 g1878 g1880 g1879)
+                  (cons '#(syntax-object
+                           if
+                           ((top)
+                            #(ribcage
+                              #(_ e1 e2 e3)
+                              #((top) (top) (top) (top))
+                              #("i" "i" "i" "i"))
+                            #(ribcage () () ())
+                            #(ribcage #(x) #((top)) #("i"))
+                            #(ribcage ((import-token . *top*)) () ())))
+                        (cons g1878
+                              (cons (cons '#(syntax-object
+                                             and
+                                             ((top)
+                                              #(ribcage
+                                                #(_ e1 e2 e3)
+                                                #((top) (top) (top) (top))
+                                                #("i" "i" "i" "i"))
+                                              #(ribcage () () ())
+                                              #(ribcage
+                                                #(x)
+                                                #((top))
+                                                #("i"))
+                                              #(ribcage
+                                                ((import-token . *top*))
+                                                ()
+                                                ())))
+                                          (cons g1880 g1879))
+                                    '(#(syntax-object
+                                        #f
+                                        ((top)
+                                         #(ribcage
+                                           #(_ e1 e2 e3)
+                                           #((top) (top) (top) (top))
+                                           #("i" "i" "i" "i"))
+                                         #(ribcage () () ())
+                                         #(ribcage #(x) #((top)) #("i"))
+                                         #(ribcage
+                                           ((import-token . *top*))
+                                           ()
+                                           ()))))))))
+                g1877)
+              ((lambda (g1883)
+                 (if g1883
+                     (apply (lambda (g1885 g1884) g1884) g1883)
+                     ((lambda (g1886)
+                        (if g1886
+                            (apply
+                              (lambda (g1887)
+                                '#(syntax-object
+                                   #t
+                                   ((top)
+                                    #(ribcage #(_) #((top)) #("i"))
+                                    #(ribcage () () ())
+                                    #(ribcage #(x) #((top)) #("i"))
+                                    #(ribcage
+                                      ((import-token . *top*))
+                                      ()
+                                      ()))))
+                              g1886)
+                            (syntax-error g1876)))
+                      ($syntax-dispatch g1876 '(any)))))
+               ($syntax-dispatch g1876 '(any any)))))
+        ($syntax-dispatch g1876 '(any any any . each-any))))
+     g1875)))
+($sc-put-cte
+  'let
+  (lambda (g1888)
+    ((lambda (g1889)
+       ((lambda (g1890)
+          (if (if g1890
+                  (apply
+                    (lambda (g1895 g1891 g1894 g1892 g1893)
+                      (andmap identifier? g1891))
+                    g1890)
+                  '#f)
+              (apply
+                (lambda (g1901 g1897 g1900 g1898 g1899)
+                  (cons (cons '#(syntax-object
+                                 lambda
+                                 ((top)
+                                  #(ribcage
+                                    #(_ x v e1 e2)
+                                    #((top) (top) (top) (top) (top))
+                                    #("i" "i" "i" "i" "i"))
+                                  #(ribcage () () ())
+                                  #(ribcage #(x) #((top)) #("i"))
+                                  #(ribcage
+                                    ((import-token . *top*))
+                                    ()
+                                    ())))
+                              (cons g1897 (cons g1898 g1899)))
+                        g1900))
+                g1890)
+              ((lambda (g1905)
+                 (if (if g1905
+                         (apply
+                           (lambda (g1911 g1906 g1910 g1907 g1909 g1908)
+                             (andmap identifier? (cons g1906 g1910)))
+                           g1905)
+                         '#f)
+                     (apply
+                       (lambda (g1918 g1913 g1917 g1914 g1916 g1915)
+                         (cons (list '#(syntax-object
+                                        letrec
+                                        ((top)
+                                         #(ribcage
+                                           #(_ f x v e1 e2)
+                                           #((top)
+                                             (top)
+                                             (top)
+                                             (top)
+                                             (top)
+                                             (top))
+                                           #("i" "i" "i" "i" "i" "i"))
+                                         #(ribcage () () ())
+                                         #(ribcage #(x) #((top)) #("i"))
+                                         #(ribcage
+                                           ((import-token . *top*))
+                                           ()
+                                           ())))
+                                     (list (list g1913
+                                                 (cons '#(syntax-object
+                                                          lambda
+                                                          ((top)
+                                                           #(ribcage
+                                                             #(_
+                                                               f
+                                                               x
+                                                               v
+                                                               e1
+                                                               e2)
+                                                             #((top)
+                                                               (top)
+                                                               (top)
+                                                               (top)
+                                                               (top)
+                                                               (top))
+                                                             #("i"
+                                                               "i"
+                                                               "i"
+                                                               "i"
+                                                               "i"
+                                                               "i"))
+                                                           #(ribcage
+                                                             ()
+                                                             ()
+                                                             ())
+                                                           #(ribcage
+                                                             #(x)
+                                                             #((top))
+                                                             #("i"))
+                                                           #(ribcage
+                                                             ((import-token
+                                                                .
+                                                                *top*))
+                                                             ()
+                                                             ())))
+                                                       (cons g1917
+                                                             (cons g1916
+                                                                   g1915)))))
+                                     g1913)
+                               g1914))
+                       g1905)
+                     (syntax-error g1889)))
+               ($syntax-dispatch
+                 g1889
+                 '(any any #(each (any any)) any . each-any)))))
+        ($syntax-dispatch
+          g1889
+          '(any #(each (any any)) any . each-any))))
+     g1888)))
+($sc-put-cte
+  'let*
+  (lambda (g1922)
+    ((lambda (g1923)
+       ((lambda (g1924)
+          (if (if g1924
+                  (apply
+                    (lambda (g1929 g1925 g1928 g1926 g1927)
+                      (andmap identifier? g1925))
+                    g1924)
+                  '#f)
+              (apply
+                (lambda (g1935 g1931 g1934 g1932 g1933)
+                  ((letrec ((g1936
+                             (lambda (g1937)
+                               (if (null? g1937)
+                                   (cons '#(syntax-object
+                                            let
+                                            ((top)
+                                             #(ribcage () () ())
+                                             #(ribcage
+                                               #(bindings)
+                                               #((top))
+                                               #("i"))
+                                             #(ribcage
+                                               #(f)
+                                               #((top))
+                                               #("i"))
+                                             #(ribcage
+                                               #(let* x v e1 e2)
+                                               #((top)
+                                                 (top)
+                                                 (top)
+                                                 (top)
+                                                 (top))
+                                               #("i" "i" "i" "i" "i"))
+                                             #(ribcage () () ())
+                                             #(ribcage
+                                               #(x)
+                                               #((top))
+                                               #("i"))
+                                             #(ribcage
+                                               ((import-token . *top*))
+                                               ()
+                                               ())))
+                                         (cons '() (cons g1932 g1933)))
+                                   ((lambda (g1939)
+                                      ((lambda (g1940)
+                                         (if g1940
+                                             (apply
+                                               (lambda (g1942 g1941)
+                                                 (list '#(syntax-object
+                                                          let
+                                                          ((top)
+                                                           #(ribcage
+                                                             #(body
+                                                               binding)
+                                                             #((top) (top))
+                                                             #("i" "i"))
+                                                           #(ribcage
+                                                             ()
+                                                             ()
+                                                             ())
+                                                           #(ribcage
+                                                             #(bindings)
+                                                             #((top))
+                                                             #("i"))
+                                                           #(ribcage
+                                                             #(f)
+                                                             #((top))
+                                                             #("i"))
+                                                           #(ribcage
+                                                             #(let*
+                                                               x
+                                                               v
+                                                               e1
+                                                               e2)
+                                                             #((top)
+                                                               (top)
+                                                               (top)
+                                                               (top)
+                                                               (top))
+                                                             #("i"
+                                                               "i"
+                                                               "i"
+                                                               "i"
+                                                               "i"))
+                                                           #(ribcage
+                                                             ()
+                                                             ()
+                                                             ())
+                                                           #(ribcage
+                                                             #(x)
+                                                             #((top))
+                                                             #("i"))
+                                                           #(ribcage
+                                                             ((import-token
+                                                                .
+                                                                *top*))
+                                                             ()
+                                                             ())))
+                                                       (list g1941)
+                                                       g1942))
+                                               g1940)
+                                             (syntax-error g1939)))
+                                       ($syntax-dispatch
+                                         g1939
+                                         '(any any))))
+                                    (list (g1936 (cdr g1937))
+                                          (car g1937)))))))
+                     g1936)
+                   (map list g1931 g1934)))
+                g1924)
+              (syntax-error g1923)))
+        ($syntax-dispatch
+          g1923
+          '(any #(each (any any)) any . each-any))))
+     g1922)))
+($sc-put-cte
+  'cond
+  (lambda (g1945)
+    ((lambda (g1946)
+       ((lambda (g1947)
+          (if g1947
+              (apply
+                (lambda (g1950 g1948 g1949)
+                  ((letrec ((g1951
+                             (lambda (g1953 g1952)
+                               (if (null? g1952)
+                                   ((lambda (g1954)
+                                      ((lambda (g1955)
+                                         (if g1955
+                                             (apply
+                                               (lambda (g1957 g1956)
+                                                 (cons '#(syntax-object
+                                                          begin
+                                                          ((top)
+                                                           #(ribcage
+                                                             #(e1 e2)
+                                                             #((top) (top))
+                                                             #("i" "i"))
+                                                           #(ribcage
+                                                             ()
+                                                             ()
+                                                             ())
+                                                           #(ribcage
+                                                             #(clause
+                                                               clauses)
+                                                             #((top) (top))
+                                                             #("i" "i"))
+                                                           #(ribcage
+                                                             #(f)
+                                                             #((top))
+                                                             #("i"))
+                                                           #(ribcage
+                                                             #(_ m1 m2)
+                                                             #((top)
+                                                               (top)
+                                                               (top))
+                                                             #("i"
+                                                               "i"
+                                                               "i"))
+                                                           #(ribcage
+                                                             ()
+                                                             ()
+                                                             ())
+                                                           #(ribcage
+                                                             #(x)
+                                                             #((top))
+                                                             #("i"))
+                                                           #(ribcage
+                                                             ((import-token
+                                                                .
+                                                                *top*))
+                                                             ()
+                                                             ())))
+                                                       (cons g1957 g1956)))
+                                               g1955)
+                                             ((lambda (g1959)
+                                                (if g1959
+                                                    (apply
+                                                      (lambda (g1960)
+                                                        (cons '#(syntax-object
+                                                                 let
+                                                                 ((top)
+                                                                  #(ribcage
+                                                                    #(e0)
+                                                                    #((top))
+                                                                    #("i"))
+                                                                  #(ribcage
+                                                                    ()
+                                                                    ()
+                                                                    ())
+                                                                  #(ribcage
+                                                                    #(clause
+                                                                      clauses)
+                                                                    #((top)
+                                                                      (top))
+                                                                    #("i"
+                                                                      "i"))
+                                                                  #(ribcage
+                                                                    #(f)
+                                                                    #((top))
+                                                                    #("i"))
+                                                                  #(ribcage
+                                                                    #(_
+                                                                      m1
+                                                                      m2)
+                                                                    #((top)
+                                                                      (top)
+                                                                      (top))
+                                                                    #("i"
+                                                                      "i"
+                                                                      "i"))
+                                                                  #(ribcage
+                                                                    ()
+                                                                    ()
+                                                                    ())
+                                                                  #(ribcage
+                                                                    #(x)
+                                                                    #((top))
+                                                                    #("i"))
+                                                                  #(ribcage
+                                                                    ((import-token
+                                                                       .
+                                                                       *top*))
+                                                                    ()
+                                                                    ())))
+                                                              (cons (list (list '#(syntax-object
+                                                                                   t
+                                                                                   ((top)
+                                                                                    #(ribcage
+                                                                                      #(e0)
+                                                                                      #((top))
+                                                                                      #("i"))
+                                                                                    #(ribcage
+                                                                                      ()
+                                                                                      ()
+                                                                                      ())
+                                                                                    #(ribcage
+                                                                                      #(clause
+                                                                                        clauses)
+                                                                                      #((top)
+                                                                                        (top))
+                                                                                      #("i"
+                                                                                        "i"))
+                                                                                    #(ribcage
+                                                                                      #(f)
+                                                                                      #((top))
+                                                                                      #("i"))
+                                                                                    #(ribcage
+                                                                                      #(_
+                                                                                        m1
+                                                                                        m2)
+                                                                                      #((top)
+                                                                                        (top)
+                                                                                        (top))
+                                                                                      #("i"
+                                                                                        "i"
+                                                                                        "i"))
+                                                                                    #(ribcage
+                                                                                      ()
+                                                                                      ()
+                                                                                      ())
+                                                                                    #(ribcage
+                                                                                      #(x)
+                                                                                      #((top))
+                                                                                      #("i"))
+                                                                                    #(ribcage
+                                                                                      ((import-token
+                                                                                         .
+                                                                                         *top*))
+                                                                                      ()
+                                                                                      ())))
+                                                                                g1960))
+                                                                    '((#(syntax-object
+                                                                         if
+                                                                         ((top)
+                                                                          #(ribcage
+                                                                            #(e0)
+                                                                            #((top))
+                                                                            #("i"))
+                                                                          #(ribcage
+                                                                            ()
+                                                                            ()
+                                                                            ())
+                                                                          #(ribcage
+                                                                            #(clause
+                                                                              clauses)
+                                                                            #((top)
+                                                                              (top))
+                                                                            #("i"
+                                                                              "i"))
+                                                                          #(ribcage
+                                                                            #(f)
+                                                                            #((top))
+                                                                            #("i"))
+                                                                          #(ribcage
+                                                                            #(_
+                                                                              m1
+                                                                              m2)
+                                                                            #((top)
+                                                                              (top)
+                                                                              (top))
+                                                                            #("i"
+                                                                              "i"
+                                                                              "i"))
+                                                                          #(ribcage
+                                                                            ()
+                                                                            ()
+                                                                            ())
+                                                                          #(ribcage
+                                                                            #(x)
+                                                                            #((top))
+                                                                            #("i"))
+                                                                          #(ribcage
+                                                                            ((import-token
+                                                                               .
+                                                                               *top*))
+                                                                            ()
+                                                                            ())))
+                                                                        #(syntax-object
+                                                                          t
+                                                                          ((top)
+                                                                           #(ribcage
+                                                                             #(e0)
+                                                                             #((top))
+                                                                             #("i"))
+                                                                           #(ribcage
+                                                                             ()
+                                                                             ()
+                                                                             ())
+                                                                           #(ribcage
+                                                                             #(clause
+                                                                               clauses)
+                                                                             #((top)
+                                                                               (top))
+                                                                             #("i"
+                                                                               "i"))
+                                                                           #(ribcage
+                                                                             #(f)
+                                                                             #((top))
+                                                                             #("i"))
+                                                                           #(ribcage
+                                                                             #(_
+                                                                               m1
+                                                                               m2)
+                                                                             #((top)
+                                                                               (top)
+                                                                               (top))
+                                                                             #("i"
+                                                                               "i"
+                                                                               "i"))
+                                                                           #(ribcage
+                                                                             ()
+                                                                             ()
+                                                                             ())
+                                                                           #(ribcage
+                                                                             #(x)
+                                                                             #((top))
+                                                                             #("i"))
+                                                                           #(ribcage
+                                                                             ((import-token
+                                                                                .
+                                                                                *top*))
+                                                                             ()
+                                                                             ())))
+                                                                        #(syntax-object
+                                                                          t
+                                                                          ((top)
+                                                                           #(ribcage
+                                                                             #(e0)
+                                                                             #((top))
+                                                                             #("i"))
+                                                                           #(ribcage
+                                                                             ()
+                                                                             ()
+                                                                             ())
+                                                                           #(ribcage
+                                                                             #(clause
+                                                                               clauses)
+                                                                             #((top)
+                                                                               (top))
+                                                                             #("i"
+                                                                               "i"))
+                                                                           #(ribcage
+                                                                             #(f)
+                                                                             #((top))
+                                                                             #("i"))
+                                                                           #(ribcage
+                                                                             #(_
+                                                                               m1
+                                                                               m2)
+                                                                             #((top)
+                                                                               (top)
+                                                                               (top))
+                                                                             #("i"
+                                                                               "i"
+                                                                               "i"))
+                                                                           #(ribcage
+                                                                             ()
+                                                                             ()
+                                                                             ())
+                                                                           #(ribcage
+                                                                             #(x)
+                                                                             #((top))
+                                                                             #("i"))
+                                                                           #(ribcage
+                                                                             ((import-token
+                                                                                .
+                                                                                *top*))
+                                                                             ()
+                                                                             ()))))))))
+                                                      g1959)
+                                                    ((lambda (g1961)
+                                                       (if g1961
+                                                           (apply
+                                                             (lambda (g1963
+                                                                      g1962)
+                                                               (list '#(syntax-object
+                                                                        let
+                                                                        ((top)
+                                                                         #(ribcage
+                                                                           #(e0
+                                                                             e1)
+                                                                           #((top)
+                                                                             (top))
+                                                                           #("i"
+                                                                             "i"))
+                                                                         #(ribcage
+                                                                           ()
+                                                                           ()
+                                                                           ())
+                                                                         #(ribcage
+                                                                           #(clause
+                                                                             clauses)
+                                                                           #((top)
+                                                                             (top))
+                                                                           #("i"
+                                                                             "i"))
+                                                                         #(ribcage
+                                                                           #(f)
+                                                                           #((top))
+                                                                           #("i"))
+                                                                         #(ribcage
+                                                                           #(_
+                                                                             m1
+                                                                             m2)
+                                                                           #((top)
+                                                                             (top)
+                                                                             (top))
+                                                                           #("i"
+                                                                             "i"
+                                                                             "i"))
+                                                                         #(ribcage
+                                                                           ()
+                                                                           ()
+                                                                           ())
+                                                                         #(ribcage
+                                                                           #(x)
+                                                                           #((top))
+                                                                           #("i"))
+                                                                         #(ribcage
+                                                                           ((import-token
+                                                                              .
+                                                                              *top*))
+                                                                           ()
+                                                                           ())))
+                                                                     (list (list '#(syntax-object
+                                                                                    t
+                                                                                    ((top)
+                                                                                     #(ribcage
+                                                                                       #(e0
+                                                                                         e1)
+                                                                                       #((top)
+                                                                                         (top))
+                                                                                       #("i"
+                                                                                         "i"))
+                                                                                     #(ribcage
+                                                                                       ()
+                                                                                       ()
+                                                                                       ())
+                                                                                     #(ribcage
+                                                                                       #(clause
+                                                                                         clauses)
+                                                                                       #((top)
+                                                                                         (top))
+                                                                                       #("i"
+                                                                                         "i"))
+                                                                                     #(ribcage
+                                                                                       #(f)
+                                                                                       #((top))
+                                                                                       #("i"))
+                                                                                     #(ribcage
+                                                                                       #(_
+                                                                                         m1
+                                                                                         m2)
+                                                                                       #((top)
+                                                                                         (top)
+                                                                                         (top))
+                                                                                       #("i"
+                                                                                         "i"
+                                                                                         "i"))
+                                                                                     #(ribcage
+                                                                                       ()
+                                                                                       ()
+                                                                                       ())
+                                                                                     #(ribcage
+                                                                                       #(x)
+                                                                                       #((top))
+                                                                                       #("i"))
+                                                                                     #(ribcage
+                                                                                       ((import-token
+                                                                                          .
+                                                                                          *top*))
+                                                                                       ()
+                                                                                       ())))
+                                                                                 g1963))
+                                                                     (list '#(syntax-object
+                                                                              if
+                                                                              ((top)
+                                                                               #(ribcage
+                                                                                 #(e0
+                                                                                   e1)
+                                                                                 #((top)
+                                                                                   (top))
+                                                                                 #("i"
+                                                                                   "i"))
+                                                                               #(ribcage
+                                                                                 ()
+                                                                                 ()
+                                                                                 ())
+                                                                               #(ribcage
+                                                                                 #(clause
+                                                                                   clauses)
+                                                                                 #((top)
+                                                                                   (top))
+                                                                                 #("i"
+                                                                                   "i"))
+                                                                               #(ribcage
+                                                                                 #(f)
+                                                                                 #((top))
+                                                                                 #("i"))
+                                                                               #(ribcage
+                                                                                 #(_
+                                                                                   m1
+                                                                                   m2)
+                                                                                 #((top)
+                                                                                   (top)
+                                                                                   (top))
+                                                                                 #("i"
+                                                                                   "i"
+                                                                                   "i"))
+                                                                               #(ribcage
+                                                                                 ()
+                                                                                 ()
+                                                                                 ())
+                                                                               #(ribcage
+                                                                                 #(x)
+                                                                                 #((top))
+                                                                                 #("i"))
+                                                                               #(ribcage
+                                                                                 ((import-token
+                                                                                    .
+                                                                                    *top*))
+                                                                                 ()
+                                                                                 ())))
+                                                                           '#(syntax-object
+                                                                              t
+                                                                              ((top)
+                                                                               #(ribcage
+                                                                                 #(e0
+                                                                                   e1)
+                                                                                 #((top)
+                                                                                   (top))
+                                                                                 #("i"
+                                                                                   "i"))
+                                                                               #(ribcage
+                                                                                 ()
+                                                                                 ()
+                                                                                 ())
+                                                                               #(ribcage
+                                                                                 #(clause
+                                                                                   clauses)
+                                                                                 #((top)
+                                                                                   (top))
+                                                                                 #("i"
+                                                                                   "i"))
+                                                                               #(ribcage
+                                                                                 #(f)
+                                                                                 #((top))
+                                                                                 #("i"))
+                                                                               #(ribcage
+                                                                                 #(_
+                                                                                   m1
+                                                                                   m2)
+                                                                                 #((top)
+                                                                                   (top)
+                                                                                   (top))
+                                                                                 #("i"
+                                                                                   "i"
+                                                                                   "i"))
+                                                                               #(ribcage
+                                                                                 ()
+                                                                                 ()
+                                                                                 ())
+                                                                               #(ribcage
+                                                                                 #(x)
+                                                                                 #((top))
+                                                                                 #("i"))
+                                                                               #(ribcage
+                                                                                 ((import-token
+                                                                                    .
+                                                                                    *top*))
+                                                                                 ()
+                                                                                 ())))
+                                                                           (cons g1962
+                                                                                 '(#(syntax-object
+                                                                                     t
+                                                                                     ((top)
+                                                                                      #(ribcage
+                                                                                        #(e0
+                                                                                          e1)
+                                                                                        #((top)
+                                                                                          (top))
+                                                                                        #("i"
+                                                                                          "i"))
+                                                                                      #(ribcage
+                                                                                        ()
+                                                                                        ()
+                                                                                        ())
+                                                                                      #(ribcage
+                                                                                        #(clause
+                                                                                          clauses)
+                                                                                        #((top)
+                                                                                          (top))
+                                                                                        #("i"
+                                                                                          "i"))
+                                                                                      #(ribcage
+                                                                                        #(f)
+                                                                                        #((top))
+                                                                                        #("i"))
+                                                                                      #(ribcage
+                                                                                        #(_
+                                                                                          m1
+                                                                                          m2)
+                                                                                        #((top)
+                                                                                          (top)
+                                                                                          (top))
+                                                                                        #("i"
+                                                                                          "i"
+                                                                                          "i"))
+                                                                                      #(ribcage
+                                                                                        ()
+                                                                                        ()
+                                                                                        ())
+                                                                                      #(ribcage
+                                                                                        #(x)
+                                                                                        #((top))
+                                                                                        #("i"))
+                                                                                      #(ribcage
+                                                                                        ((import-token
+                                                                                           .
+                                                                                           *top*))
+                                                                                        ()
+                                                                                        ()))))))))
+                                                             g1961)
+                                                           ((lambda (g1964)
+                                                              (if g1964
+                                                                  (apply
+                                                                    (lambda (g1967
+                                                                             g1965
+                                                                             g1966)
+                                                                      (list '#(syntax-object
+                                                                               if
+                                                                               ((top)
+                                                                                #(ribcage
+                                                                                  #(e0
+                                                                                    e1
+                                                                                    e2)
+                                                                                  #((top)
+                                                                                    (top)
+                                                                                    (top))
+                                                                                  #("i"
+                                                                                    "i"
+                                                                                    "i"))
+                                                                                #(ribcage
+                                                                                  ()
+                                                                                  ()
+                                                                                  ())
+                                                                                #(ribcage
+                                                                                  #(clause
+                                                                                    clauses)
+                                                                                  #((top)
+                                                                                    (top))
+                                                                                  #("i"
+                                                                                    "i"))
+                                                                                #(ribcage
+                                                                                  #(f)
+                                                                                  #((top))
+                                                                                  #("i"))
+                                                                                #(ribcage
+                                                                                  #(_
+                                                                                    m1
+                                                                                    m2)
+                                                                                  #((top)
+                                                                                    (top)
+                                                                                    (top))
+                                                                                  #("i"
+                                                                                    "i"
+                                                                                    "i"))
+                                                                                #(ribcage
+                                                                                  ()
+                                                                                  ()
+                                                                                  ())
+                                                                                #(ribcage
+                                                                                  #(x)
+                                                                                  #((top))
+                                                                                  #("i"))
+                                                                                #(ribcage
+                                                                                  ((import-token
+                                                                                     .
+                                                                                     *top*))
+                                                                                  ()
+                                                                                  ())))
+                                                                            g1967
+                                                                            (cons '#(syntax-object
+                                                                                     begin
+                                                                                     ((top)
+                                                                                      #(ribcage
+                                                                                        #(e0
+                                                                                          e1
+                                                                                          e2)
+                                                                                        #((top)
+                                                                                          (top)
+                                                                                          (top))
+                                                                                        #("i"
+                                                                                          "i"
+                                                                                          "i"))
+                                                                                      #(ribcage
+                                                                                        ()
+                                                                                        ()
+                                                                                        ())
+                                                                                      #(ribcage
+                                                                                        #(clause
+                                                                                          clauses)
+                                                                                        #((top)
+                                                                                          (top))
+                                                                                        #("i"
+                                                                                          "i"))
+                                                                                      #(ribcage
+                                                                                        #(f)
+                                                                                        #((top))
+                                                                                        #("i"))
+                                                                                      #(ribcage
+                                                                                        #(_
+                                                                                          m1
+                                                                                          m2)
+                                                                                        #((top)
+                                                                                          (top)
+                                                                                          (top))
+                                                                                        #("i"
+                                                                                          "i"
+                                                                                          "i"))
+                                                                                      #(ribcage
+                                                                                        ()
+                                                                                        ()
+                                                                                        ())
+                                                                                      #(ribcage
+                                                                                        #(x)
+                                                                                        #((top))
+                                                                                        #("i"))
+                                                                                      #(ribcage
+                                                                                        ((import-token
+                                                                                           .
+                                                                                           *top*))
+                                                                                        ()
+                                                                                        ())))
+                                                                                  (cons g1965
+                                                                                        g1966))))
+                                                                    g1964)
+                                                                  ((lambda (g1969)
+                                                                     (syntax-error
+                                                                       g1945))
+                                                                   g1954)))
+                                                            ($syntax-dispatch
+                                                              g1954
+                                                              '(any any
+                                                                    .
+                                                                    each-any)))))
+                                                     ($syntax-dispatch
+                                                       g1954
+                                                       '(any #(free-id
+                                                               #(syntax-object
+                                                                 =>
+                                                                 ((top)
+                                                                  #(ribcage
+                                                                    ()
+                                                                    ()
+                                                                    ())
+                                                                  #(ribcage
+                                                                    #(clause
+                                                                      clauses)
+                                                                    #((top)
+                                                                      (top))
+                                                                    #("i"
+                                                                      "i"))
+                                                                  #(ribcage
+                                                                    #(f)
+                                                                    #((top))
+                                                                    #("i"))
+                                                                  #(ribcage
+                                                                    #(_
+                                                                      m1
+                                                                      m2)
+                                                                    #((top)
+                                                                      (top)
+                                                                      (top))
+                                                                    #("i"
+                                                                      "i"
+                                                                      "i"))
+                                                                  #(ribcage
+                                                                    ()
+                                                                    ()
+                                                                    ())
+                                                                  #(ribcage
+                                                                    #(x)
+                                                                    #((top))
+                                                                    #("i"))
+                                                                  #(ribcage
+                                                                    ((import-token
+                                                                       .
+                                                                       *top*))
+                                                                    ()
+                                                                    ()))))
+                                                             any)))))
+                                              ($syntax-dispatch
+                                                g1954
+                                                '(any)))))
+                                       ($syntax-dispatch
+                                         g1954
+                                         '(#(free-id
+                                             #(syntax-object
+                                               else
+                                               ((top)
+                                                #(ribcage () () ())
+                                                #(ribcage
+                                                  #(clause clauses)
+                                                  #((top) (top))
+                                                  #("i" "i"))
+                                                #(ribcage
+                                                  #(f)
+                                                  #((top))
+                                                  #("i"))
+                                                #(ribcage
+                                                  #(_ m1 m2)
+                                                  #((top) (top) (top))
+                                                  #("i" "i" "i"))
+                                                #(ribcage () () ())
+                                                #(ribcage
+                                                  #(x)
+                                                  #((top))
+                                                  #("i"))
+                                                #(ribcage
+                                                  ((import-token . *top*))
+                                                  ()
+                                                  ()))))
+                                            any
+                                            .
+                                            each-any))))
+                                    g1953)
+                                   ((lambda (g1970)
+                                      ((lambda (g1971)
+                                         ((lambda (g1972)
+                                            ((lambda (g1973)
+                                               (if g1973
+                                                   (apply
+                                                     (lambda (g1974)
+                                                       (list '#(syntax-object
+                                                                let
+                                                                ((top)
+                                                                 #(ribcage
+                                                                   #(e0)
+                                                                   #((top))
+                                                                   #("i"))
+                                                                 #(ribcage
+                                                                   #(rest)
+                                                                   #((top))
+                                                                   #("i"))
+                                                                 #(ribcage
+                                                                   ()
+                                                                   ()
+                                                                   ())
+                                                                 #(ribcage
+                                                                   #(clause
+                                                                     clauses)
+                                                                   #((top)
+                                                                     (top))
+                                                                   #("i"
+                                                                     "i"))
+                                                                 #(ribcage
+                                                                   #(f)
+                                                                   #((top))
+                                                                   #("i"))
+                                                                 #(ribcage
+                                                                   #(_
+                                                                     m1
+                                                                     m2)
+                                                                   #((top)
+                                                                     (top)
+                                                                     (top))
+                                                                   #("i"
+                                                                     "i"
+                                                                     "i"))
+                                                                 #(ribcage
+                                                                   ()
+                                                                   ()
+                                                                   ())
+                                                                 #(ribcage
+                                                                   #(x)
+                                                                   #((top))
+                                                                   #("i"))
+                                                                 #(ribcage
+                                                                   ((import-token
+                                                                      .
+                                                                      *top*))
+                                                                   ()
+                                                                   ())))
+                                                             (list (list '#(syntax-object
+                                                                            t
+                                                                            ((top)
+                                                                             #(ribcage
+                                                                               #(e0)
+                                                                               #((top))
+                                                                               #("i"))
+                                                                             #(ribcage
+                                                                               #(rest)
+                                                                               #((top))
+                                                                               #("i"))
+                                                                             #(ribcage
+                                                                               ()
+                                                                               ()
+                                                                               ())
+                                                                             #(ribcage
+                                                                               #(clause
+                                                                                 clauses)
+                                                                               #((top)
+                                                                                 (top))
+                                                                               #("i"
+                                                                                 "i"))
+                                                                             #(ribcage
+                                                                               #(f)
+                                                                               #((top))
+                                                                               #("i"))
+                                                                             #(ribcage
+                                                                               #(_
+                                                                                 m1
+                                                                                 m2)
+                                                                               #((top)
+                                                                                 (top)
+                                                                                 (top))
+                                                                               #("i"
+                                                                                 "i"
+                                                                                 "i"))
+                                                                             #(ribcage
+                                                                               ()
+                                                                               ()
+                                                                               ())
+                                                                             #(ribcage
+                                                                               #(x)
+                                                                               #((top))
+                                                                               #("i"))
+                                                                             #(ribcage
+                                                                               ((import-token
+                                                                                  .
+                                                                                  *top*))
+                                                                               ()
+                                                                               ())))
+                                                                         g1974))
+                                                             (list '#(syntax-object
+                                                                      if
+                                                                      ((top)
+                                                                       #(ribcage
+                                                                         #(e0)
+                                                                         #((top))
+                                                                         #("i"))
+                                                                       #(ribcage
+                                                                         #(rest)
+                                                                         #((top))
+                                                                         #("i"))
+                                                                       #(ribcage
+                                                                         ()
+                                                                         ()
+                                                                         ())
+                                                                       #(ribcage
+                                                                         #(clause
+                                                                           clauses)
+                                                                         #((top)
+                                                                           (top))
+                                                                         #("i"
+                                                                           "i"))
+                                                                       #(ribcage
+                                                                         #(f)
+                                                                         #((top))
+                                                                         #("i"))
+                                                                       #(ribcage
+                                                                         #(_
+                                                                           m1
+                                                                           m2)
+                                                                         #((top)
+                                                                           (top)
+                                                                           (top))
+                                                                         #("i"
+                                                                           "i"
+                                                                           "i"))
+                                                                       #(ribcage
+                                                                         ()
+                                                                         ()
+                                                                         ())
+                                                                       #(ribcage
+                                                                         #(x)
+                                                                         #((top))
+                                                                         #("i"))
+                                                                       #(ribcage
+                                                                         ((import-token
+                                                                            .
+                                                                            *top*))
+                                                                         ()
+                                                                         ())))
+                                                                   '#(syntax-object
+                                                                      t
+                                                                      ((top)
+                                                                       #(ribcage
+                                                                         #(e0)
+                                                                         #((top))
+                                                                         #("i"))
+                                                                       #(ribcage
+                                                                         #(rest)
+                                                                         #((top))
+                                                                         #("i"))
+                                                                       #(ribcage
+                                                                         ()
+                                                                         ()
+                                                                         ())
+                                                                       #(ribcage
+                                                                         #(clause
+                                                                           clauses)
+                                                                         #((top)
+                                                                           (top))
+                                                                         #("i"
+                                                                           "i"))
+                                                                       #(ribcage
+                                                                         #(f)
+                                                                         #((top))
+                                                                         #("i"))
+                                                                       #(ribcage
+                                                                         #(_
+                                                                           m1
+                                                                           m2)
+                                                                         #((top)
+                                                                           (top)
+                                                                           (top))
+                                                                         #("i"
+                                                                           "i"
+                                                                           "i"))
+                                                                       #(ribcage
+                                                                         ()
+                                                                         ()
+                                                                         ())
+                                                                       #(ribcage
+                                                                         #(x)
+                                                                         #((top))
+                                                                         #("i"))
+                                                                       #(ribcage
+                                                                         ((import-token
+                                                                            .
+                                                                            *top*))
+                                                                         ()
+                                                                         ())))
+                                                                   '#(syntax-object
+                                                                      t
+                                                                      ((top)
+                                                                       #(ribcage
+                                                                         #(e0)
+                                                                         #((top))
+                                                                         #("i"))
+                                                                       #(ribcage
+                                                                         #(rest)
+                                                                         #((top))
+                                                                         #("i"))
+                                                                       #(ribcage
+                                                                         ()
+                                                                         ()
+                                                                         ())
+                                                                       #(ribcage
+                                                                         #(clause
+                                                                           clauses)
+                                                                         #((top)
+                                                                           (top))
+                                                                         #("i"
+                                                                           "i"))
+                                                                       #(ribcage
+                                                                         #(f)
+                                                                         #((top))
+                                                                         #("i"))
+                                                                       #(ribcage
+                                                                         #(_
+                                                                           m1
+                                                                           m2)
+                                                                         #((top)
+                                                                           (top)
+                                                                           (top))
+                                                                         #("i"
+                                                                           "i"
+                                                                           "i"))
+                                                                       #(ribcage
+                                                                         ()
+                                                                         ()
+                                                                         ())
+                                                                       #(ribcage
+                                                                         #(x)
+                                                                         #((top))
+                                                                         #("i"))
+                                                                       #(ribcage
+                                                                         ((import-token
+                                                                            .
+                                                                            *top*))
+                                                                         ()
+                                                                         ())))
+                                                                   g1971)))
+                                                     g1973)
+                                                   ((lambda (g1975)
+                                                      (if g1975
+                                                          (apply
+                                                            (lambda (g1977
+                                                                     g1976)
+                                                              (list '#(syntax-object
+                                                                       let
+                                                                       ((top)
+                                                                        #(ribcage
+                                                                          #(e0
+                                                                            e1)
+                                                                          #((top)
+                                                                            (top))
+                                                                          #("i"
+                                                                            "i"))
+                                                                        #(ribcage
+                                                                          #(rest)
+                                                                          #((top))
+                                                                          #("i"))
+                                                                        #(ribcage
+                                                                          ()
+                                                                          ()
+                                                                          ())
+                                                                        #(ribcage
+                                                                          #(clause
+                                                                            clauses)
+                                                                          #((top)
+                                                                            (top))
+                                                                          #("i"
+                                                                            "i"))
+                                                                        #(ribcage
+                                                                          #(f)
+                                                                          #((top))
+                                                                          #("i"))
+                                                                        #(ribcage
+                                                                          #(_
+                                                                            m1
+                                                                            m2)
+                                                                          #((top)
+                                                                            (top)
+                                                                            (top))
+                                                                          #("i"
+                                                                            "i"
+                                                                            "i"))
+                                                                        #(ribcage
+                                                                          ()
+                                                                          ()
+                                                                          ())
+                                                                        #(ribcage
+                                                                          #(x)
+                                                                          #((top))
+                                                                          #("i"))
+                                                                        #(ribcage
+                                                                          ((import-token
+                                                                             .
+                                                                             *top*))
+                                                                          ()
+                                                                          ())))
+                                                                    (list (list '#(syntax-object
+                                                                                   t
+                                                                                   ((top)
+                                                                                    #(ribcage
+                                                                                      #(e0
+                                                                                        e1)
+                                                                                      #((top)
+                                                                                        (top))
+                                                                                      #("i"
+                                                                                        "i"))
+                                                                                    #(ribcage
+                                                                                      #(rest)
+                                                                                      #((top))
+                                                                                      #("i"))
+                                                                                    #(ribcage
+                                                                                      ()
+                                                                                      ()
+                                                                                      ())
+                                                                                    #(ribcage
+                                                                                      #(clause
+                                                                                        clauses)
+                                                                                      #((top)
+                                                                                        (top))
+                                                                                      #("i"
+                                                                                        "i"))
+                                                                                    #(ribcage
+                                                                                      #(f)
+                                                                                      #((top))
+                                                                                      #("i"))
+                                                                                    #(ribcage
+                                                                                      #(_
+                                                                                        m1
+                                                                                        m2)
+                                                                                      #((top)
+                                                                                        (top)
+                                                                                        (top))
+                                                                                      #("i"
+                                                                                        "i"
+                                                                                        "i"))
+                                                                                    #(ribcage
+                                                                                      ()
+                                                                                      ()
+                                                                                      ())
+                                                                                    #(ribcage
+                                                                                      #(x)
+                                                                                      #((top))
+                                                                                      #("i"))
+                                                                                    #(ribcage
+                                                                                      ((import-token
+                                                                                         .
+                                                                                         *top*))
+                                                                                      ()
+                                                                                      ())))
+                                                                                g1977))
+                                                                    (list '#(syntax-object
+                                                                             if
+                                                                             ((top)
+                                                                              #(ribcage
+                                                                                #(e0
+                                                                                  e1)
+                                                                                #((top)
+                                                                                  (top))
+                                                                                #("i"
+                                                                                  "i"))
+                                                                              #(ribcage
+                                                                                #(rest)
+                                                                                #((top))
+                                                                                #("i"))
+                                                                              #(ribcage
+                                                                                ()
+                                                                                ()
+                                                                                ())
+                                                                              #(ribcage
+                                                                                #(clause
+                                                                                  clauses)
+                                                                                #((top)
+                                                                                  (top))
+                                                                                #("i"
+                                                                                  "i"))
+                                                                              #(ribcage
+                                                                                #(f)
+                                                                                #((top))
+                                                                                #("i"))
+                                                                              #(ribcage
+                                                                                #(_
+                                                                                  m1
+                                                                                  m2)
+                                                                                #((top)
+                                                                                  (top)
+                                                                                  (top))
+                                                                                #("i"
+                                                                                  "i"
+                                                                                  "i"))
+                                                                              #(ribcage
+                                                                                ()
+                                                                                ()
+                                                                                ())
+                                                                              #(ribcage
+                                                                                #(x)
+                                                                                #((top))
+                                                                                #("i"))
+                                                                              #(ribcage
+                                                                                ((import-token
+                                                                                   .
+                                                                                   *top*))
+                                                                                ()
+                                                                                ())))
+                                                                          '#(syntax-object
+                                                                             t
+                                                                             ((top)
+                                                                              #(ribcage
+                                                                                #(e0
+                                                                                  e1)
+                                                                                #((top)
+                                                                                  (top))
+                                                                                #("i"
+                                                                                  "i"))
+                                                                              #(ribcage
+                                                                                #(rest)
+                                                                                #((top))
+                                                                                #("i"))
+                                                                              #(ribcage
+                                                                                ()
+                                                                                ()
+                                                                                ())
+                                                                              #(ribcage
+                                                                                #(clause
+                                                                                  clauses)
+                                                                                #((top)
+                                                                                  (top))
+                                                                                #("i"
+                                                                                  "i"))
+                                                                              #(ribcage
+                                                                                #(f)
+                                                                                #((top))
+                                                                                #("i"))
+                                                                              #(ribcage
+                                                                                #(_
+                                                                                  m1
+                                                                                  m2)
+                                                                                #((top)
+                                                                                  (top)
+                                                                                  (top))
+                                                                                #("i"
+                                                                                  "i"
+                                                                                  "i"))
+                                                                              #(ribcage
+                                                                                ()
+                                                                                ()
+                                                                                ())
+                                                                              #(ribcage
+                                                                                #(x)
+                                                                                #((top))
+                                                                                #("i"))
+                                                                              #(ribcage
+                                                                                ((import-token
+                                                                                   .
+                                                                                   *top*))
+                                                                                ()
+                                                                                ())))
+                                                                          (cons g1976
+                                                                                '(#(syntax-object
+                                                                                    t
+                                                                                    ((top)
+                                                                                     #(ribcage
+                                                                                       #(e0
+                                                                                         e1)
+                                                                                       #((top)
+                                                                                         (top))
+                                                                                       #("i"
+                                                                                         "i"))
+                                                                                     #(ribcage
+                                                                                       #(rest)
+                                                                                       #((top))
+                                                                                       #("i"))
+                                                                                     #(ribcage
+                                                                                       ()
+                                                                                       ()
+                                                                                       ())
+                                                                                     #(ribcage
+                                                                                       #(clause
+                                                                                         clauses)
+                                                                                       #((top)
+                                                                                         (top))
+                                                                                       #("i"
+                                                                                         "i"))
+                                                                                     #(ribcage
+                                                                                       #(f)
+                                                                                       #((top))
+                                                                                       #("i"))
+                                                                                     #(ribcage
+                                                                                       #(_
+                                                                                         m1
+                                                                                         m2)
+                                                                                       #((top)
+                                                                                         (top)
+                                                                                         (top))
+                                                                                       #("i"
+                                                                                         "i"
+                                                                                         "i"))
+                                                                                     #(ribcage
+                                                                                       ()
+                                                                                       ()
+                                                                                       ())
+                                                                                     #(ribcage
+                                                                                       #(x)
+                                                                                       #((top))
+                                                                                       #("i"))
+                                                                                     #(ribcage
+                                                                                       ((import-token
+                                                                                          .
+                                                                                          *top*))
+                                                                                       ()
+                                                                                       ())))))
+                                                                          g1971)))
+                                                            g1975)
+                                                          ((lambda (g1978)
+                                                             (if g1978
+                                                                 (apply
+                                                                   (lambda (g1981
+                                                                            g1979
+                                                                            g1980)
+                                                                     (list '#(syntax-object
+                                                                              if
+                                                                              ((top)
+                                                                               #(ribcage
+                                                                                 #(e0
+                                                                                   e1
+                                                                                   e2)
+                                                                                 #((top)
+                                                                                   (top)
+                                                                                   (top))
+                                                                                 #("i"
+                                                                                   "i"
+                                                                                   "i"))
+                                                                               #(ribcage
+                                                                                 #(rest)
+                                                                                 #((top))
+                                                                                 #("i"))
+                                                                               #(ribcage
+                                                                                 ()
+                                                                                 ()
+                                                                                 ())
+                                                                               #(ribcage
+                                                                                 #(clause
+                                                                                   clauses)
+                                                                                 #((top)
+                                                                                   (top))
+                                                                                 #("i"
+                                                                                   "i"))
+                                                                               #(ribcage
+                                                                                 #(f)
+                                                                                 #((top))
+                                                                                 #("i"))
+                                                                               #(ribcage
+                                                                                 #(_
+                                                                                   m1
+                                                                                   m2)
+                                                                                 #((top)
+                                                                                   (top)
+                                                                                   (top))
+                                                                                 #("i"
+                                                                                   "i"
+                                                                                   "i"))
+                                                                               #(ribcage
+                                                                                 ()
+                                                                                 ()
+                                                                                 ())
+                                                                               #(ribcage
+                                                                                 #(x)
+                                                                                 #((top))
+                                                                                 #("i"))
+                                                                               #(ribcage
+                                                                                 ((import-token
+                                                                                    .
+                                                                                    *top*))
+                                                                                 ()
+                                                                                 ())))
+                                                                           g1981
+                                                                           (cons '#(syntax-object
+                                                                                    begin
+                                                                                    ((top)
+                                                                                     #(ribcage
+                                                                                       #(e0
+                                                                                         e1
+                                                                                         e2)
+                                                                                       #((top)
+                                                                                         (top)
+                                                                                         (top))
+                                                                                       #("i"
+                                                                                         "i"
+                                                                                         "i"))
+                                                                                     #(ribcage
+                                                                                       #(rest)
+                                                                                       #((top))
+                                                                                       #("i"))
+                                                                                     #(ribcage
+                                                                                       ()
+                                                                                       ()
+                                                                                       ())
+                                                                                     #(ribcage
+                                                                                       #(clause
+                                                                                         clauses)
+                                                                                       #((top)
+                                                                                         (top))
+                                                                                       #("i"
+                                                                                         "i"))
+                                                                                     #(ribcage
+                                                                                       #(f)
+                                                                                       #((top))
+                                                                                       #("i"))
+                                                                                     #(ribcage
+                                                                                       #(_
+                                                                                         m1
+                                                                                         m2)
+                                                                                       #((top)
+                                                                                         (top)
+                                                                                         (top))
+                                                                                       #("i"
+                                                                                         "i"
+                                                                                         "i"))
+                                                                                     #(ribcage
+                                                                                       ()
+                                                                                       ()
+                                                                                       ())
+                                                                                     #(ribcage
+                                                                                       #(x)
+                                                                                       #((top))
+                                                                                       #("i"))
+                                                                                     #(ribcage
+                                                                                       ((import-token
+                                                                                          .
+                                                                                          *top*))
+                                                                                       ()
+                                                                                       ())))
+                                                                                 (cons g1979
+                                                                                       g1980))
+                                                                           g1971))
+                                                                   g1978)
+                                                                 ((lambda (g1983)
+                                                                    (syntax-error
+                                                                      g1945))
+                                                                  g1972)))
+                                                           ($syntax-dispatch
+                                                             g1972
+                                                             '(any any
+                                                                   .
+                                                                   each-any)))))
+                                                    ($syntax-dispatch
+                                                      g1972
+                                                      '(any #(free-id
+                                                              #(syntax-object
+                                                                =>
+                                                                ((top)
+                                                                 #(ribcage
+                                                                   #(rest)
+                                                                   #((top))
+                                                                   #("i"))
+                                                                 #(ribcage
+                                                                   ()
+                                                                   ()
+                                                                   ())
+                                                                 #(ribcage
+                                                                   #(clause
+                                                                     clauses)
+                                                                   #((top)
+                                                                     (top))
+                                                                   #("i"
+                                                                     "i"))
+                                                                 #(ribcage
+                                                                   #(f)
+                                                                   #((top))
+                                                                   #("i"))
+                                                                 #(ribcage
+                                                                   #(_
+                                                                     m1
+                                                                     m2)
+                                                                   #((top)
+                                                                     (top)
+                                                                     (top))
+                                                                   #("i"
+                                                                     "i"
+                                                                     "i"))
+                                                                 #(ribcage
+                                                                   ()
+                                                                   ()
+                                                                   ())
+                                                                 #(ribcage
+                                                                   #(x)
+                                                                   #((top))
+                                                                   #("i"))
+                                                                 #(ribcage
+                                                                   ((import-token
+                                                                      .
+                                                                      *top*))
+                                                                   ()
+                                                                   ()))))
+                                                            any)))))
+                                             ($syntax-dispatch
+                                               g1972
+                                               '(any))))
+                                          g1953))
+                                       g1970))
+                                    (g1951 (car g1952) (cdr g1952)))))))
+                     g1951)
+                   g1948
+                   g1949))
+                g1947)
+              (syntax-error g1946)))
+        ($syntax-dispatch g1946 '(any any . each-any))))
+     g1945)))
+($sc-put-cte
+  'do
+  (lambda (g1985)
+    ((lambda (g1986)
+       ((lambda (g1987)
+          (if g1987
+              (apply
+                (lambda (g1994 g1988 g1993 g1989 g1992 g1990 g1991)
+                  ((lambda (g1995)
+                     ((lambda (g2005)
+                        (if g2005
+                            (apply
+                              (lambda (g2006)
+                                ((lambda (g2007)
+                                   ((lambda (g2009)
+                                      (if g2009
+                                          (apply
+                                            (lambda ()
+                                              (list '#(syntax-object
+                                                       let
+                                                       ((top)
+                                                        #(ribcage
+                                                          #(step)
+                                                          #((top))
+                                                          #("i"))
+                                                        #(ribcage
+                                                          #(_
+                                                            var
+                                                            init
+                                                            step
+                                                            e0
+                                                            e1
+                                                            c)
+                                                          #((top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top))
+                                                          #("i"
+                                                            "i"
+                                                            "i"
+                                                            "i"
+                                                            "i"
+                                                            "i"
+                                                            "i"))
+                                                        #(ribcage () () ())
+                                                        #(ribcage
+                                                          #(orig-x)
+                                                          #((top))
+                                                          #("i"))
+                                                        #(ribcage
+                                                          ((import-token
+                                                             .
+                                                             *top*))
+                                                          ()
+                                                          ())))
+                                                    '#(syntax-object
+                                                       doloop
+                                                       ((top)
+                                                        #(ribcage
+                                                          #(step)
+                                                          #((top))
+                                                          #("i"))
+                                                        #(ribcage
+                                                          #(_
+                                                            var
+                                                            init
+                                                            step
+                                                            e0
+                                                            e1
+                                                            c)
+                                                          #((top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top))
+                                                          #("i"
+                                                            "i"
+                                                            "i"
+                                                            "i"
+                                                            "i"
+                                                            "i"
+                                                            "i"))
+                                                        #(ribcage () () ())
+                                                        #(ribcage
+                                                          #(orig-x)
+                                                          #((top))
+                                                          #("i"))
+                                                        #(ribcage
+                                                          ((import-token
+                                                             .
+                                                             *top*))
+                                                          ()
+                                                          ())))
+                                                    (map list g1988 g1993)
+                                                    (list '#(syntax-object
+                                                             if
+                                                             ((top)
+                                                              #(ribcage
+                                                                #(step)
+                                                                #((top))
+                                                                #("i"))
+                                                              #(ribcage
+                                                                #(_
+                                                                  var
+                                                                  init
+                                                                  step
+                                                                  e0
+                                                                  e1
+                                                                  c)
+                                                                #((top)
+                                                                  (top)
+                                                                  (top)
+                                                                  (top)
+                                                                  (top)
+                                                                  (top)
+                                                                  (top))
+                                                                #("i"
+                                                                  "i"
+                                                                  "i"
+                                                                  "i"
+                                                                  "i"
+                                                                  "i"
+                                                                  "i"))
+                                                              #(ribcage
+                                                                ()
+                                                                ()
+                                                                ())
+                                                              #(ribcage
+                                                                #(orig-x)
+                                                                #((top))
+                                                                #("i"))
+                                                              #(ribcage
+                                                                ((import-token
+                                                                   .
+                                                                   *top*))
+                                                                ()
+                                                                ())))
+                                                          (list '#(syntax-object
+                                                                   not
+                                                                   ((top)
+                                                                    #(ribcage
+                                                                      #(step)
+                                                                      #((top))
+                                                                      #("i"))
+                                                                    #(ribcage
+                                                                      #(_
+                                                                        var
+                                                                        init
+                                                                        step
+                                                                        e0
+                                                                        e1
+                                                                        c)
+                                                                      #((top)
+                                                                        (top)
+                                                                        (top)
+                                                                        (top)
+                                                                        (top)
+                                                                        (top)
+                                                                        (top))
+                                                                      #("i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"))
+                                                                    #(ribcage
+                                                                      ()
+                                                                      ()
+                                                                      ())
+                                                                    #(ribcage
+                                                                      #(orig-x)
+                                                                      #((top))
+                                                                      #("i"))
+                                                                    #(ribcage
+                                                                      ((import-token
+                                                                         .
+                                                                         *top*))
+                                                                      ()
+                                                                      ())))
+                                                                g1992)
+                                                          (cons '#(syntax-object
+                                                                   begin
+                                                                   ((top)
+                                                                    #(ribcage
+                                                                      #(step)
+                                                                      #((top))
+                                                                      #("i"))
+                                                                    #(ribcage
+                                                                      #(_
+                                                                        var
+                                                                        init
+                                                                        step
+                                                                        e0
+                                                                        e1
+                                                                        c)
+                                                                      #((top)
+                                                                        (top)
+                                                                        (top)
+                                                                        (top)
+                                                                        (top)
+                                                                        (top)
+                                                                        (top))
+                                                                      #("i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"
+                                                                        "i"))
+                                                                    #(ribcage
+                                                                      ()
+                                                                      ()
+                                                                      ())
+                                                                    #(ribcage
+                                                                      #(orig-x)
+                                                                      #((top))
+                                                                      #("i"))
+                                                                    #(ribcage
+                                                                      ((import-token
+                                                                         .
+                                                                         *top*))
+                                                                      ()
+                                                                      ())))
+                                                                (append
+                                                                  g1991
+                                                                  (list (cons '#(syntax-object
+                                                                                 doloop
+                                                                                 ((top)
+                                                                                  #(ribcage
+                                                                                    #(step)
+                                                                                    #((top))
+                                                                                    #("i"))
+                                                                                  #(ribcage
+                                                                                    #(_
+                                                                                      var
+                                                                                      init
+                                                                                      step
+                                                                                      e0
+                                                                                      e1
+                                                                                      c)
+                                                                                    #((top)
+                                                                                      (top)
+                                                                                      (top)
+                                                                                      (top)
+                                                                                      (top)
+                                                                                      (top)
+                                                                                      (top))
+                                                                                    #("i"
+                                                                                      "i"
+                                                                                      "i"
+                                                                                      "i"
+                                                                                      "i"
+                                                                                      "i"
+                                                                                      "i"))
+                                                                                  #(ribcage
+                                                                                    ()
+                                                                                    ()
+                                                                                    ())
+                                                                                  #(ribcage
+                                                                                    #(orig-x)
+                                                                                    #((top))
+                                                                                    #("i"))
+                                                                                  #(ribcage
+                                                                                    ((import-token
+                                                                                       .
+                                                                                       *top*))
+                                                                                    ()
+                                                                                    ())))
+                                                                              g2006)))))))
+                                            g2009)
+                                          ((lambda (g2014)
+                                             (if g2014
+                                                 (apply
+                                                   (lambda (g2016 g2015)
+                                                     (list '#(syntax-object
+                                                              let
+                                                              ((top)
+                                                               #(ribcage
+                                                                 #(e1 e2)
+                                                                 #((top)
+                                                                   (top))
+                                                                 #("i"
+                                                                   "i"))
+                                                               #(ribcage
+                                                                 #(step)
+                                                                 #((top))
+                                                                 #("i"))
+                                                               #(ribcage
+                                                                 #(_
+                                                                   var
+                                                                   init
+                                                                   step
+                                                                   e0
+                                                                   e1
+                                                                   c)
+                                                                 #((top)
+                                                                   (top)
+                                                                   (top)
+                                                                   (top)
+                                                                   (top)
+                                                                   (top)
+                                                                   (top))
+                                                                 #("i"
+                                                                   "i"
+                                                                   "i"
+                                                                   "i"
+                                                                   "i"
+                                                                   "i"
+                                                                   "i"))
+                                                               #(ribcage
+                                                                 ()
+                                                                 ()
+                                                                 ())
+                                                               #(ribcage
+                                                                 #(orig-x)
+                                                                 #((top))
+                                                                 #("i"))
+                                                               #(ribcage
+                                                                 ((import-token
+                                                                    .
+                                                                    *top*))
+                                                                 ()
+                                                                 ())))
+                                                           '#(syntax-object
+                                                              doloop
+                                                              ((top)
+                                                               #(ribcage
+                                                                 #(e1 e2)
+                                                                 #((top)
+                                                                   (top))
+                                                                 #("i"
+                                                                   "i"))
+                                                               #(ribcage
+                                                                 #(step)
+                                                                 #((top))
+                                                                 #("i"))
+                                                               #(ribcage
+                                                                 #(_
+                                                                   var
+                                                                   init
+                                                                   step
+                                                                   e0
+                                                                   e1
+                                                                   c)
+                                                                 #((top)
+                                                                   (top)
+                                                                   (top)
+                                                                   (top)
+                                                                   (top)
+                                                                   (top)
+                                                                   (top))
+                                                                 #("i"
+                                                                   "i"
+                                                                   "i"
+                                                                   "i"
+                                                                   "i"
+                                                                   "i"
+                                                                   "i"))
+                                                               #(ribcage
+                                                                 ()
+                                                                 ()
+                                                                 ())
+                                                               #(ribcage
+                                                                 #(orig-x)
+                                                                 #((top))
+                                                                 #("i"))
+                                                               #(ribcage
+                                                                 ((import-token
+                                                                    .
+                                                                    *top*))
+                                                                 ()
+                                                                 ())))
+                                                           (map list
+                                                                g1988
+                                                                g1993)
+                                                           (list '#(syntax-object
+                                                                    if
+                                                                    ((top)
+                                                                     #(ribcage
+                                                                       #(e1
+                                                                         e2)
+                                                                       #((top)
+                                                                         (top))
+                                                                       #("i"
+                                                                         "i"))
+                                                                     #(ribcage
+                                                                       #(step)
+                                                                       #((top))
+                                                                       #("i"))
+                                                                     #(ribcage
+                                                                       #(_
+                                                                         var
+                                                                         init
+                                                                         step
+                                                                         e0
+                                                                         e1
+                                                                         c)
+                                                                       #((top)
+                                                                         (top)
+                                                                         (top)
+                                                                         (top)
+                                                                         (top)
+                                                                         (top)
+                                                                         (top))
+                                                                       #("i"
+                                                                         "i"
+                                                                         "i"
+                                                                         "i"
+                                                                         "i"
+                                                                         "i"
+                                                                         "i"))
+                                                                     #(ribcage
+                                                                       ()
+                                                                       ()
+                                                                       ())
+                                                                     #(ribcage
+                                                                       #(orig-x)
+                                                                       #((top))
+                                                                       #("i"))
+                                                                     #(ribcage
+                                                                       ((import-token
+                                                                          .
+                                                                          *top*))
+                                                                       ()
+                                                                       ())))
+                                                                 g1992
+                                                                 (cons '#(syntax-object
+                                                                          begin
+                                                                          ((top)
+                                                                           #(ribcage
+                                                                             #(e1
+                                                                               e2)
+                                                                             #((top)
+                                                                               (top))
+                                                                             #("i"
+                                                                               "i"))
+                                                                           #(ribcage
+                                                                             #(step)
+                                                                             #((top))
+                                                                             #("i"))
+                                                                           #(ribcage
+                                                                             #(_
+                                                                               var
+                                                                               init
+                                                                               step
+                                                                               e0
+                                                                               e1
+                                                                               c)
+                                                                             #((top)
+                                                                               (top)
+                                                                               (top)
+                                                                               (top)
+                                                                               (top)
+                                                                               (top)
+                                                                               (top))
+                                                                             #("i"
+                                                                               "i"
+                                                                               "i"
+                                                                               "i"
+                                                                               "i"
+                                                                               "i"
+                                                                               "i"))
+                                                                           #(ribcage
+                                                                             ()
+                                                                             ()
+                                                                             ())
+                                                                           #(ribcage
+                                                                             #(orig-x)
+                                                                             #((top))
+                                                                             #("i"))
+                                                                           #(ribcage
+                                                                             ((import-token
+                                                                                .
+                                                                                *top*))
+                                                                             ()
+                                                                             ())))
+                                                                       (cons g2016
+                                                                             g2015))
+                                                                 (cons '#(syntax-object
+                                                                          begin
+                                                                          ((top)
+                                                                           #(ribcage
+                                                                             #(e1
+                                                                               e2)
+                                                                             #((top)
+                                                                               (top))
+                                                                             #("i"
+                                                                               "i"))
+                                                                           #(ribcage
+                                                                             #(step)
+                                                                             #((top))
+                                                                             #("i"))
+                                                                           #(ribcage
+                                                                             #(_
+                                                                               var
+                                                                               init
+                                                                               step
+                                                                               e0
+                                                                               e1
+                                                                               c)
+                                                                             #((top)
+                                                                               (top)
+                                                                               (top)
+                                                                               (top)
+                                                                               (top)
+                                                                               (top)
+                                                                               (top))
+                                                                             #("i"
+                                                                               "i"
+                                                                               "i"
+                                                                               "i"
+                                                                               "i"
+                                                                               "i"
+                                                                               "i"))
+                                                                           #(ribcage
+                                                                             ()
+                                                                             ()
+                                                                             ())
+                                                                           #(ribcage
+                                                                             #(orig-x)
+                                                                             #((top))
+                                                                             #("i"))
+                                                                           #(ribcage
+                                                                             ((import-token
+                                                                                .
+                                                                                *top*))
+                                                                             ()
+                                                                             ())))
+                                                                       (append
+                                                                         g1991
+                                                                         (list (cons '#(syntax-object
+                                                                                        doloop
+                                                                                        ((top)
+                                                                                         #(ribcage
+                                                                                           #(e1
+                                                                                             e2)
+                                                                                           #((top)
+                                                                                             (top))
+                                                                                           #("i"
+                                                                                             "i"))
+                                                                                         #(ribcage
+                                                                                           #(step)
+                                                                                           #((top))
+                                                                                           #("i"))
+                                                                                         #(ribcage
+                                                                                           #(_
+                                                                                             var
+                                                                                             init
+                                                                                             step
+                                                                                             e0
+                                                                                             e1
+                                                                                             c)
+                                                                                           #((top)
+                                                                                             (top)
+                                                                                             (top)
+                                                                                             (top)
+                                                                                             (top)
+                                                                                             (top)
+                                                                                             (top))
+                                                                                           #("i"
+                                                                                             "i"
+                                                                                             "i"
+                                                                                             "i"
+                                                                                             "i"
+                                                                                             "i"
+                                                                                             "i"))
+                                                                                         #(ribcage
+                                                                                           ()
+                                                                                           ()
+                                                                                           ())
+                                                                                         #(ribcage
+                                                                                           #(orig-x)
+                                                                                           #((top))
+                                                                                           #("i"))
+                                                                                         #(ribcage
+                                                                                           ((import-token
+                                                                                              .
+                                                                                              *top*))
+                                                                                           ()
+                                                                                           ())))
+                                                                                     g2006)))))))
+                                                   g2014)
+                                                 (syntax-error g2007)))
+                                           ($syntax-dispatch
+                                             g2007
+                                             '(any . each-any)))))
+                                    ($syntax-dispatch g2007 '())))
+                                 g1990))
+                              g2005)
+                            (syntax-error g1995)))
+                      ($syntax-dispatch g1995 'each-any)))
+                   (map (lambda (g1999 g1998)
+                          ((lambda (g2000)
+                             ((lambda (g2001)
+                                (if g2001
+                                    (apply (lambda () g1999) g2001)
+                                    ((lambda (g2002)
+                                       (if g2002
+                                           (apply
+                                             (lambda (g2003) g2003)
+                                             g2002)
+                                           ((lambda (g2004)
+                                              (syntax-error g1985))
+                                            g2000)))
+                                     ($syntax-dispatch g2000 '(any)))))
+                              ($syntax-dispatch g2000 '())))
+                           g1998))
+                        g1988
+                        g1989)))
+                g1987)
+              (syntax-error g1986)))
+        ($syntax-dispatch
+          g1986
+          '(any #(each (any any . any))
+                (any . each-any)
+                .
+                each-any))))
+     g1985)))
+($sc-put-cte
+  'quasiquote
+  (letrec ((g2030
+            (lambda (g2142)
+              (if (identifier? g2142)
+                  (free-identifier=?
+                    g2142
+                    '#(syntax-object
+                       quote
+                       ((top)
+                        #(ribcage () () ())
+                        #(ribcage () () ())
+                        #(ribcage #(x) #((top)) #("i"))
+                        #(ribcage
+                          #(isquote?
+                            islist?
+                            iscons?
+                            quote-nil?
+                            quasilist*
+                            quasicons
+                            quasiappend
+                            quasivector
+                            quasi)
+                          #((top)
+                            (top)
+                            (top)
+                            (top)
+                            (top)
+                            (top)
+                            (top)
+                            (top)
+                            (top))
+                          #("i" "i" "i" "i" "i" "i" "i" "i" "i"))
+                        #(ribcage ((import-token . *top*)) () ()))))
+                  '#f)))
+           (g2022
+            (lambda (g2036)
+              (if (identifier? g2036)
+                  (free-identifier=?
+                    g2036
+                    '#(syntax-object
+                       list
+                       ((top)
+                        #(ribcage () () ())
+                        #(ribcage () () ())
+                        #(ribcage #(x) #((top)) #("i"))
+                        #(ribcage
+                          #(isquote?
+                            islist?
+                            iscons?
+                            quote-nil?
+                            quasilist*
+                            quasicons
+                            quasiappend
+                            quasivector
+                            quasi)
+                          #((top)
+                            (top)
+                            (top)
+                            (top)
+                            (top)
+                            (top)
+                            (top)
+                            (top)
+                            (top))
+                          #("i" "i" "i" "i" "i" "i" "i" "i" "i"))
+                        #(ribcage ((import-token . *top*)) () ()))))
+                  '#f)))
+           (g2029
+            (lambda (g2141)
+              (if (identifier? g2141)
+                  (free-identifier=?
+                    g2141
+                    '#(syntax-object
+                       cons
+                       ((top)
+                        #(ribcage () () ())
+                        #(ribcage () () ())
+                        #(ribcage #(x) #((top)) #("i"))
+                        #(ribcage
+                          #(isquote?
+                            islist?
+                            iscons?
+                            quote-nil?
+                            quasilist*
+                            quasicons
+                            quasiappend
+                            quasivector
+                            quasi)
+                          #((top)
+                            (top)
+                            (top)
+                            (top)
+                            (top)
+                            (top)
+                            (top)
+                            (top)
+                            (top))
+                          #("i" "i" "i" "i" "i" "i" "i" "i" "i"))
+                        #(ribcage ((import-token . *top*)) () ()))))
+                  '#f)))
+           (g2023
+            (lambda (g2037)
+              ((lambda (g2038)
+                 ((lambda (g2039)
+                    (if g2039
+                        (apply (lambda (g2040) (g2030 g2040)) g2039)
+                        ((lambda (g2041) '#f) g2038)))
+                  ($syntax-dispatch g2038 '(any ()))))
+               g2037)))
+           (g2028
+            (lambda (g2138 g2137)
+              ((letrec ((g2139
+                         (lambda (g2140)
+                           (if (null? g2140)
+                               g2137
+                               (g2024 (car g2140) (g2139 (cdr g2140)))))))
+                 g2139)
+               g2138)))
+           (g2024
+            (lambda (g2043 g2042)
+              ((lambda (g2044)
+                 ((lambda (g2045)
+                    (if g2045
+                        (apply
+                          (lambda (g2047 g2046)
+                            ((lambda (g2048)
+                               ((lambda (g2049)
+                                  (if (if g2049
+                                          (apply
+                                            (lambda (g2051 g2050)
+                                              (g2030 g2051))
+                                            g2049)
+                                          '#f)
+                                      (apply
+                                        (lambda (g2053 g2052)
+                                          ((lambda (g2054)
+                                             ((lambda (g2055)
+                                                (if (if g2055
+                                                        (apply
+                                                          (lambda (g2057
+                                                                   g2056)
+                                                            (g2030 g2057))
+                                                          g2055)
+                                                        '#f)
+                                                    (apply
+                                                      (lambda (g2059 g2058)
+                                                        (list '#(syntax-object
+                                                                 quote
+                                                                 ((top)
+                                                                  #(ribcage
+                                                                    #(quote?
+                                                                      dx)
+                                                                    #((top)
+                                                                      (top))
+                                                                    #("i"
+                                                                      "i"))
+                                                                  #(ribcage
+                                                                    #(quote?
+                                                                      dy)
+                                                                    #((top)
+                                                                      (top))
+                                                                    #("i"
+                                                                      "i"))
+                                                                  #(ribcage
+                                                                    #(x y)
+                                                                    #((top)
+                                                                      (top))
+                                                                    #("i"
+                                                                      "i"))
+                                                                  #(ribcage
+                                                                    ()
+                                                                    ()
+                                                                    ())
+                                                                  #(ribcage
+                                                                    ()
+                                                                    ()
+                                                                    ())
+                                                                  #(ribcage
+                                                                    #(x y)
+                                                                    #((top)
+                                                                      (top))
+                                                                    #("i"
+                                                                      "i"))
+                                                                  #(ribcage
+                                                                    #(isquote?
+                                                                      islist?
+                                                                      iscons?
+                                                                      quote-nil?
+                                                                      quasilist*
+                                                                      quasicons
+                                                                      quasiappend
+                                                                      quasivector
+                                                                      quasi)
+                                                                    #((top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top))
+                                                                    #("i"
+                                                                      "i"
+                                                                      "i"
+                                                                      "i"
+                                                                      "i"
+                                                                      "i"
+                                                                      "i"
+                                                                      "i"
+                                                                      "i"))
+                                                                  #(ribcage
+                                                                    ((import-token
+                                                                       .
+                                                                       *top*))
+                                                                    ()
+                                                                    ())))
+                                                              (cons g2058
+                                                                    g2052)))
+                                                      g2055)
+                                                    ((lambda (g2060)
+                                                       (if (null? g2052)
+                                                           (list '#(syntax-object
+                                                                    list
+                                                                    ((top)
+                                                                     #(ribcage
+                                                                       #(_)
+                                                                       #((top))
+                                                                       #("i"))
+                                                                     #(ribcage
+                                                                       #(quote?
+                                                                         dy)
+                                                                       #((top)
+                                                                         (top))
+                                                                       #("i"
+                                                                         "i"))
+                                                                     #(ribcage
+                                                                       #(x
+                                                                         y)
+                                                                       #((top)
+                                                                         (top))
+                                                                       #("i"
+                                                                         "i"))
+                                                                     #(ribcage
+                                                                       ()
+                                                                       ()
+                                                                       ())
+                                                                     #(ribcage
+                                                                       ()
+                                                                       ()
+                                                                       ())
+                                                                     #(ribcage
+                                                                       #(x
+                                                                         y)
+                                                                       #((top)
+                                                                         (top))
+                                                                       #("i"
+                                                                         "i"))
+                                                                     #(ribcage
+                                                                       #(isquote?
+                                                                         islist?
+                                                                         iscons?
+                                                                         quote-nil?
+                                                                         quasilist*
+                                                                         quasicons
+                                                                         quasiappend
+                                                                         quasivector
+                                                                         quasi)
+                                                                       #((top)
+                                                                         (top)
+                                                                         (top)
+                                                                         (top)
+                                                                         (top)
+                                                                         (top)
+                                                                         (top)
+                                                                         (top)
+                                                                         (top))
+                                                                       #("i"
+                                                                         "i"
+                                                                         "i"
+                                                                         "i"
+                                                                         "i"
+                                                                         "i"
+                                                                         "i"
+                                                                         "i"
+                                                                         "i"))
+                                                                     #(ribcage
+                                                                       ((import-token
+                                                                          .
+                                                                          *top*))
+                                                                       ()
+                                                                       ())))
+                                                                 g2047)
+                                                           (list '#(syntax-object
+                                                                    cons
+                                                                    ((top)
+                                                                     #(ribcage
+                                                                       #(_)
+                                                                       #((top))
+                                                                       #("i"))
+                                                                     #(ribcage
+                                                                       #(quote?
+                                                                         dy)
+                                                                       #((top)
+                                                                         (top))
+                                                                       #("i"
+                                                                         "i"))
+                                                                     #(ribcage
+                                                                       #(x
+                                                                         y)
+                                                                       #((top)
+                                                                         (top))
+                                                                       #("i"
+                                                                         "i"))
+                                                                     #(ribcage
+                                                                       ()
+                                                                       ()
+                                                                       ())
+                                                                     #(ribcage
+                                                                       ()
+                                                                       ()
+                                                                       ())
+                                                                     #(ribcage
+                                                                       #(x
+                                                                         y)
+                                                                       #((top)
+                                                                         (top))
+                                                                       #("i"
+                                                                         "i"))
+                                                                     #(ribcage
+                                                                       #(isquote?
+                                                                         islist?
+                                                                         iscons?
+                                                                         quote-nil?
+                                                                         quasilist*
+                                                                         quasicons
+                                                                         quasiappend
+                                                                         quasivector
+                                                                         quasi)
+                                                                       #((top)
+                                                                         (top)
+                                                                         (top)
+                                                                         (top)
+                                                                         (top)
+                                                                         (top)
+                                                                         (top)
+                                                                         (top)
+                                                                         (top))
+                                                                       #("i"
+                                                                         "i"
+                                                                         "i"
+                                                                         "i"
+                                                                         "i"
+                                                                         "i"
+                                                                         "i"
+                                                                         "i"
+                                                                         "i"))
+                                                                     #(ribcage
+                                                                       ((import-token
+                                                                          .
+                                                                          *top*))
+                                                                       ()
+                                                                       ())))
+                                                                 g2047
+                                                                 g2046)))
+                                                     g2054)))
+                                              ($syntax-dispatch
+                                                g2054
+                                                '(any any))))
+                                           g2047))
+                                        g2049)
+                                      ((lambda (g2061)
+                                         (if (if g2061
+                                                 (apply
+                                                   (lambda (g2063 g2062)
+                                                     (g2022 g2063))
+                                                   g2061)
+                                                 '#f)
+                                             (apply
+                                               (lambda (g2065 g2064)
+                                                 (cons '#(syntax-object
+                                                          list
+                                                          ((top)
+                                                           #(ribcage
+                                                             #(listp stuff)
+                                                             #((top) (top))
+                                                             #("i" "i"))
+                                                           #(ribcage
+                                                             #(x y)
+                                                             #((top) (top))
+                                                             #("i" "i"))
+                                                           #(ribcage
+                                                             ()
+                                                             ()
+                                                             ())
+                                                           #(ribcage
+                                                             ()
+                                                             ()
+                                                             ())
+                                                           #(ribcage
+                                                             #(x y)
+                                                             #((top) (top))
+                                                             #("i" "i"))
+                                                           #(ribcage
+                                                             #(isquote?
+                                                               islist?
+                                                               iscons?
+                                                               quote-nil?
+                                                               quasilist*
+                                                               quasicons
+                                                               quasiappend
+                                                               quasivector
+                                                               quasi)
+                                                             #((top)
+                                                               (top)
+                                                               (top)
+                                                               (top)
+                                                               (top)
+                                                               (top)
+                                                               (top)
+                                                               (top)
+                                                               (top))
+                                                             #("i"
+                                                               "i"
+                                                               "i"
+                                                               "i"
+                                                               "i"
+                                                               "i"
+                                                               "i"
+                                                               "i"
+                                                               "i"))
+                                                           #(ribcage
+                                                             ((import-token
+                                                                .
+                                                                *top*))
+                                                             ()
+                                                             ())))
+                                                       (cons g2047 g2064)))
+                                               g2061)
+                                             ((lambda (g2066)
+                                                (list '#(syntax-object
+                                                         cons
+                                                         ((top)
+                                                          #(ribcage
+                                                            #(else)
+                                                            #((top))
+                                                            #("i"))
+                                                          #(ribcage
+                                                            #(x y)
+                                                            #((top) (top))
+                                                            #("i" "i"))
+                                                          #(ribcage
+                                                            ()
+                                                            ()
+                                                            ())
+                                                          #(ribcage
+                                                            ()
+                                                            ()
+                                                            ())
+                                                          #(ribcage
+                                                            #(x y)
+                                                            #((top) (top))
+                                                            #("i" "i"))
+                                                          #(ribcage
+                                                            #(isquote?
+                                                              islist?
+                                                              iscons?
+                                                              quote-nil?
+                                                              quasilist*
+                                                              quasicons
+                                                              quasiappend
+                                                              quasivector
+                                                              quasi)
+                                                            #((top)
+                                                              (top)
+                                                              (top)
+                                                              (top)
+                                                              (top)
+                                                              (top)
+                                                              (top)
+                                                              (top)
+                                                              (top))
+                                                            #("i"
+                                                              "i"
+                                                              "i"
+                                                              "i"
+                                                              "i"
+                                                              "i"
+                                                              "i"
+                                                              "i"
+                                                              "i"))
+                                                          #(ribcage
+                                                            ((import-token
+                                                               .
+                                                               *top*))
+                                                            ()
+                                                            ())))
+                                                      g2047
+                                                      g2046))
+                                              g2048)))
+                                       ($syntax-dispatch
+                                         g2048
+                                         '(any . any)))))
+                                ($syntax-dispatch g2048 '(any any))))
+                             g2046))
+                          g2045)
+                        (syntax-error g2044)))
+                  ($syntax-dispatch g2044 '(any any))))
+               (list g2043 g2042))))
+           (g2027
+            (lambda (g2129 g2128)
+              ((lambda (g2130)
+                 (if (null? g2130)
+                     '(#(syntax-object
+                         quote
+                         ((top)
+                          #(ribcage () () ())
+                          #(ribcage () () ())
+                          #(ribcage #(ls) #((top)) #("i"))
+                          #(ribcage () () ())
+                          #(ribcage () () ())
+                          #(ribcage #(x y) #((top) (top)) #("i" "i"))
+                          #(ribcage
+                            #(isquote?
+                              islist?
+                              iscons?
+                              quote-nil?
+                              quasilist*
+                              quasicons
+                              quasiappend
+                              quasivector
+                              quasi)
+                            #((top)
+                              (top)
+                              (top)
+                              (top)
+                              (top)
+                              (top)
+                              (top)
+                              (top)
+                              (top))
+                            #("i" "i" "i" "i" "i" "i" "i" "i" "i"))
+                          #(ribcage ((import-token . *top*)) () ())))
+                        ())
+                     (if (null? (cdr g2130))
+                         (car g2130)
+                         ((lambda (g2131)
+                            ((lambda (g2132)
+                               (if g2132
+                                   (apply
+                                     (lambda (g2133)
+                                       (cons '#(syntax-object
+                                                append
+                                                ((top)
+                                                 #(ribcage
+                                                   #(p)
+                                                   #((top))
+                                                   #("i"))
+                                                 #(ribcage () () ())
+                                                 #(ribcage () () ())
+                                                 #(ribcage
+                                                   #(ls)
+                                                   #((top))
+                                                   #("i"))
+                                                 #(ribcage () () ())
+                                                 #(ribcage () () ())
+                                                 #(ribcage
+                                                   #(x y)
+                                                   #((top) (top))
+                                                   #("i" "i"))
+                                                 #(ribcage
+                                                   #(isquote?
+                                                     islist?
+                                                     iscons?
+                                                     quote-nil?
+                                                     quasilist*
+                                                     quasicons
+                                                     quasiappend
+                                                     quasivector
+                                                     quasi)
+                                                   #((top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top))
+                                                   #("i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"))
+                                                 #(ribcage
+                                                   ((import-token . *top*))
+                                                   ()
+                                                   ())))
+                                             g2133))
+                                     g2132)
+                                   (syntax-error g2131)))
+                             ($syntax-dispatch g2131 'each-any)))
+                          g2130))))
+               ((letrec ((g2135
+                          (lambda (g2136)
+                            (if (null? g2136)
+                                (if (g2023 g2128) '() (list g2128))
+                                (if (g2023 (car g2136))
+                                    (g2135 (cdr g2136))
+                                    (cons (car g2136)
+                                          (g2135 (cdr g2136))))))))
+                  g2135)
+                g2129))))
+           (g2025
+            (lambda (g2067)
+              ((lambda (g2068)
+                 ((lambda (g2069)
+                    ((lambda (g2070)
+                       ((lambda (g2071)
+                          (if (if g2071
+                                  (apply
+                                    (lambda (g2073 g2072) (g2030 g2073))
+                                    g2071)
+                                  '#f)
+                              (apply
+                                (lambda (g2075 g2074)
+                                  (list '#(syntax-object
+                                           quote
+                                           ((top)
+                                            #(ribcage
+                                              #(quote? x)
+                                              #((top) (top))
+                                              #("i" "i"))
+                                            #(ribcage
+                                              #(pat-x)
+                                              #((top))
+                                              #("i"))
+                                            #(ribcage () () ())
+                                            #(ribcage () () ())
+                                            #(ribcage #(x) #((top)) #("i"))
+                                            #(ribcage
+                                              #(isquote?
+                                                islist?
+                                                iscons?
+                                                quote-nil?
+                                                quasilist*
+                                                quasicons
+                                                quasiappend
+                                                quasivector
+                                                quasi)
+                                              #((top)
+                                                (top)
+                                                (top)
+                                                (top)
+                                                (top)
+                                                (top)
+                                                (top)
+                                                (top)
+                                                (top))
+                                              #("i"
+                                                "i"
+                                                "i"
+                                                "i"
+                                                "i"
+                                                "i"
+                                                "i"
+                                                "i"
+                                                "i"))
+                                            #(ribcage
+                                              ((import-token . *top*))
+                                              ()
+                                              ())))
+                                        (list->vector g2074)))
+                                g2071)
+                              ((lambda (g2077)
+                                 ((letrec ((g2078
+                                            (lambda (g2080 g2079)
+                                              ((lambda (g2081)
+                                                 ((lambda (g2082)
+                                                    (if (if g2082
+                                                            (apply
+                                                              (lambda (g2084
+                                                                       g2083)
+                                                                (g2030
+                                                                  g2084))
+                                                              g2082)
+                                                            '#f)
+                                                        (apply
+                                                          (lambda (g2086
+                                                                   g2085)
+                                                            (g2079
+                                                              (map (lambda (g2087)
+                                                                     (list '#(syntax-object
+                                                                              quote
+                                                                              ((top)
+                                                                               #(ribcage
+                                                                                 #(quote?
+                                                                                   x)
+                                                                                 #((top)
+                                                                                   (top))
+                                                                                 #("i"
+                                                                                   "i"))
+                                                                               #(ribcage
+                                                                                 ()
+                                                                                 ()
+                                                                                 ())
+                                                                               #(ribcage
+                                                                                 #(x
+                                                                                   k)
+                                                                                 #((top)
+                                                                                   (top))
+                                                                                 #("i"
+                                                                                   "i"))
+                                                                               #(ribcage
+                                                                                 #(f)
+                                                                                 #((top))
+                                                                                 #("i"))
+                                                                               #(ribcage
+                                                                                 #(_)
+                                                                                 #((top))
+                                                                                 #("i"))
+                                                                               #(ribcage
+                                                                                 #(pat-x)
+                                                                                 #((top))
+                                                                                 #("i"))
+                                                                               #(ribcage
+                                                                                 ()
+                                                                                 ()
+                                                                                 ())
+                                                                               #(ribcage
+                                                                                 ()
+                                                                                 ()
+                                                                                 ())
+                                                                               #(ribcage
+                                                                                 #(x)
+                                                                                 #((top))
+                                                                                 #("i"))
+                                                                               #(ribcage
+                                                                                 #(isquote?
+                                                                                   islist?
+                                                                                   iscons?
+                                                                                   quote-nil?
+                                                                                   quasilist*
+                                                                                   quasicons
+                                                                                   quasiappend
+                                                                                   quasivector
+                                                                                   quasi)
+                                                                                 #((top)
+                                                                                   (top)
+                                                                                   (top)
+                                                                                   (top)
+                                                                                   (top)
+                                                                                   (top)
+                                                                                   (top)
+                                                                                   (top)
+                                                                                   (top))
+                                                                                 #("i"
+                                                                                   "i"
+                                                                                   "i"
+                                                                                   "i"
+                                                                                   "i"
+                                                                                   "i"
+                                                                                   "i"
+                                                                                   "i"
+                                                                                   "i"))
+                                                                               #(ribcage
+                                                                                 ((import-token
+                                                                                    .
+                                                                                    *top*))
+                                                                                 ()
+                                                                                 ())))
+                                                                           g2087))
+                                                                   g2085)))
+                                                          g2082)
+                                                        ((lambda (g2088)
+                                                           (if (if g2088
+                                                                   (apply
+                                                                     (lambda (g2090
+                                                                              g2089)
+                                                                       (g2022
+                                                                         g2090))
+                                                                     g2088)
+                                                                   '#f)
+                                                               (apply
+                                                                 (lambda (g2092
+                                                                          g2091)
+                                                                   (g2079
+                                                                     g2091))
+                                                                 g2088)
+                                                               ((lambda (g2094)
+                                                                  (if (if g2094
+                                                                          (apply
+                                                                            (lambda (g2097
+                                                                                     g2095
+                                                                                     g2096)
+                                                                              (g2029
+                                                                                g2097))
+                                                                            g2094)
+                                                                          '#f)
+                                                                      (apply
+                                                                        (lambda (g2100
+                                                                                 g2098
+                                                                                 g2099)
+                                                                          (g2078
+                                                                            g2099
+                                                                            (lambda (g2101)
+                                                                              (g2079
+                                                                                (cons g2098
+                                                                                      g2101)))))
+                                                                        g2094)
+                                                                      ((lambda (g2102)
+                                                                         (list '#(syntax-object
+                                                                                  list->vector
+                                                                                  ((top)
+                                                                                   #(ribcage
+                                                                                     #(else)
+                                                                                     #((top))
+                                                                                     #("i"))
+                                                                                   #(ribcage
+                                                                                     ()
+                                                                                     ()
+                                                                                     ())
+                                                                                   #(ribcage
+                                                                                     #(x
+                                                                                       k)
+                                                                                     #((top)
+                                                                                       (top))
+                                                                                     #("i"
+                                                                                       "i"))
+                                                                                   #(ribcage
+                                                                                     #(f)
+                                                                                     #((top))
+                                                                                     #("i"))
+                                                                                   #(ribcage
+                                                                                     #(_)
+                                                                                     #((top))
+                                                                                     #("i"))
+                                                                                   #(ribcage
+                                                                                     #(pat-x)
+                                                                                     #((top))
+                                                                                     #("i"))
+                                                                                   #(ribcage
+                                                                                     ()
+                                                                                     ()
+                                                                                     ())
+                                                                                   #(ribcage
+                                                                                     ()
+                                                                                     ()
+                                                                                     ())
+                                                                                   #(ribcage
+                                                                                     #(x)
+                                                                                     #((top))
+                                                                                     #("i"))
+                                                                                   #(ribcage
+                                                                                     #(isquote?
+                                                                                       islist?
+                                                                                       iscons?
+                                                                                       quote-nil?
+                                                                                       quasilist*
+                                                                                       quasicons
+                                                                                       quasiappend
+                                                                                       quasivector
+                                                                                       quasi)
+                                                                                     #((top)
+                                                                                       (top)
+                                                                                       (top)
+                                                                                       (top)
+                                                                                       (top)
+                                                                                       (top)
+                                                                                       (top)
+                                                                                       (top)
+                                                                                       (top))
+                                                                                     #("i"
+                                                                                       "i"
+                                                                                       "i"
+                                                                                       "i"
+                                                                                       "i"
+                                                                                       "i"
+                                                                                       "i"
+                                                                                       "i"
+                                                                                       "i"))
+                                                                                   #(ribcage
+                                                                                     ((import-token
+                                                                                        .
+                                                                                        *top*))
+                                                                                     ()
+                                                                                     ())))
+                                                                               g2069))
+                                                                       g2081)))
+                                                                ($syntax-dispatch
+                                                                  g2081
+                                                                  '(any any
+                                                                        any)))))
+                                                         ($syntax-dispatch
+                                                           g2081
+                                                           '(any .
+                                                                 each-any)))))
+                                                  ($syntax-dispatch
+                                                    g2081
+                                                    '(any each-any))))
+                                               g2080))))
+                                    g2078)
+                                  g2067
+                                  (lambda (g2103)
+                                    (cons '#(syntax-object
+                                             vector
+                                             ((top)
+                                              #(ribcage () () ())
+                                              #(ribcage () () ())
+                                              #(ribcage
+                                                #(ls)
+                                                #((top))
+                                                #("i"))
+                                              #(ribcage
+                                                #(_)
+                                                #((top))
+                                                #("i"))
+                                              #(ribcage
+                                                #(pat-x)
+                                                #((top))
+                                                #("i"))
+                                              #(ribcage () () ())
+                                              #(ribcage () () ())
+                                              #(ribcage
+                                                #(x)
+                                                #((top))
+                                                #("i"))
+                                              #(ribcage
+                                                #(isquote?
+                                                  islist?
+                                                  iscons?
+                                                  quote-nil?
+                                                  quasilist*
+                                                  quasicons
+                                                  quasiappend
+                                                  quasivector
+                                                  quasi)
+                                                #((top)
+                                                  (top)
+                                                  (top)
+                                                  (top)
+                                                  (top)
+                                                  (top)
+                                                  (top)
+                                                  (top)
+                                                  (top))
+                                                #("i"
+                                                  "i"
+                                                  "i"
+                                                  "i"
+                                                  "i"
+                                                  "i"
+                                                  "i"
+                                                  "i"
+                                                  "i"))
+                                              #(ribcage
+                                                ((import-token . *top*))
+                                                ()
+                                                ())))
+                                          g2103))))
+                               g2070)))
+                        ($syntax-dispatch g2070 '(any each-any))))
+                     g2069))
+                  g2068))
+               g2067)))
+           (g2026
+            (lambda (g2105 g2104)
+              ((lambda (g2106)
+                 ((lambda (g2107)
+                    (if g2107
+                        (apply
+                          (lambda (g2108)
+                            (if (= g2104 '0)
+                                g2108
+                                (g2024
+                                  '(#(syntax-object
+                                      quote
+                                      ((top)
+                                       #(ribcage #(p) #((top)) #("i"))
+                                       #(ribcage () () ())
+                                       #(ribcage
+                                         #(p lev)
+                                         #((top) (top))
+                                         #("i" "i"))
+                                       #(ribcage
+                                         #(isquote?
+                                           islist?
+                                           iscons?
+                                           quote-nil?
+                                           quasilist*
+                                           quasicons
+                                           quasiappend
+                                           quasivector
+                                           quasi)
+                                         #((top)
+                                           (top)
+                                           (top)
+                                           (top)
+                                           (top)
+                                           (top)
+                                           (top)
+                                           (top)
+                                           (top))
+                                         #("i"
+                                           "i"
+                                           "i"
+                                           "i"
+                                           "i"
+                                           "i"
+                                           "i"
+                                           "i"
+                                           "i"))
+                                       #(ribcage
+                                         ((import-token . *top*))
+                                         ()
+                                         ())))
+                                     #(syntax-object
+                                       unquote
+                                       ((top)
+                                        #(ribcage #(p) #((top)) #("i"))
+                                        #(ribcage () () ())
+                                        #(ribcage
+                                          #(p lev)
+                                          #((top) (top))
+                                          #("i" "i"))
+                                        #(ribcage
+                                          #(isquote?
+                                            islist?
+                                            iscons?
+                                            quote-nil?
+                                            quasilist*
+                                            quasicons
+                                            quasiappend
+                                            quasivector
+                                            quasi)
+                                          #((top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top)
+                                            (top))
+                                          #("i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"
+                                            "i"))
+                                        #(ribcage
+                                          ((import-token . *top*))
+                                          ()
+                                          ()))))
+                                  (g2026 (list g2108) (- g2104 '1)))))
+                          g2107)
+                        ((lambda (g2109)
+                           (if g2109
+                               (apply
+                                 (lambda (g2111 g2110)
+                                   (if (= g2104 '0)
+                                       (g2028 g2111 (g2026 g2110 g2104))
+                                       (g2024
+                                         (g2024
+                                           '(#(syntax-object
+                                               quote
+                                               ((top)
+                                                #(ribcage
+                                                  #(p q)
+                                                  #((top) (top))
+                                                  #("i" "i"))
+                                                #(ribcage () () ())
+                                                #(ribcage
+                                                  #(p lev)
+                                                  #((top) (top))
+                                                  #("i" "i"))
+                                                #(ribcage
+                                                  #(isquote?
+                                                    islist?
+                                                    iscons?
+                                                    quote-nil?
+                                                    quasilist*
+                                                    quasicons
+                                                    quasiappend
+                                                    quasivector
+                                                    quasi)
+                                                  #((top)
+                                                    (top)
+                                                    (top)
+                                                    (top)
+                                                    (top)
+                                                    (top)
+                                                    (top)
+                                                    (top)
+                                                    (top))
+                                                  #("i"
+                                                    "i"
+                                                    "i"
+                                                    "i"
+                                                    "i"
+                                                    "i"
+                                                    "i"
+                                                    "i"
+                                                    "i"))
+                                                #(ribcage
+                                                  ((import-token . *top*))
+                                                  ()
+                                                  ())))
+                                              #(syntax-object
+                                                unquote
+                                                ((top)
+                                                 #(ribcage
+                                                   #(p q)
+                                                   #((top) (top))
+                                                   #("i" "i"))
+                                                 #(ribcage () () ())
+                                                 #(ribcage
+                                                   #(p lev)
+                                                   #((top) (top))
+                                                   #("i" "i"))
+                                                 #(ribcage
+                                                   #(isquote?
+                                                     islist?
+                                                     iscons?
+                                                     quote-nil?
+                                                     quasilist*
+                                                     quasicons
+                                                     quasiappend
+                                                     quasivector
+                                                     quasi)
+                                                   #((top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top)
+                                                     (top))
+                                                   #("i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"
+                                                     "i"))
+                                                 #(ribcage
+                                                   ((import-token . *top*))
+                                                   ()
+                                                   ()))))
+                                           (g2026 g2111 (- g2104 '1)))
+                                         (g2026 g2110 g2104))))
+                                 g2109)
+                               ((lambda (g2114)
+                                  (if g2114
+                                      (apply
+                                        (lambda (g2116 g2115)
+                                          (if (= g2104 '0)
+                                              (g2027
+                                                g2116
+                                                (g2026 g2115 g2104))
+                                              (g2024
+                                                (g2024
+                                                  '(#(syntax-object
+                                                      quote
+                                                      ((top)
+                                                       #(ribcage
+                                                         #(p q)
+                                                         #((top) (top))
+                                                         #("i" "i"))
+                                                       #(ribcage () () ())
+                                                       #(ribcage
+                                                         #(p lev)
+                                                         #((top) (top))
+                                                         #("i" "i"))
+                                                       #(ribcage
+                                                         #(isquote?
+                                                           islist?
+                                                           iscons?
+                                                           quote-nil?
+                                                           quasilist*
+                                                           quasicons
+                                                           quasiappend
+                                                           quasivector
+                                                           quasi)
+                                                         #((top)
+                                                           (top)
+                                                           (top)
+                                                           (top)
+                                                           (top)
+                                                           (top)
+                                                           (top)
+                                                           (top)
+                                                           (top))
+                                                         #("i"
+                                                           "i"
+                                                           "i"
+                                                           "i"
+                                                           "i"
+                                                           "i"
+                                                           "i"
+                                                           "i"
+                                                           "i"))
+                                                       #(ribcage
+                                                         ((import-token
+                                                            .
+                                                            *top*))
+                                                         ()
+                                                         ())))
+                                                     #(syntax-object
+                                                       unquote-splicing
+                                                       ((top)
+                                                        #(ribcage
+                                                          #(p q)
+                                                          #((top) (top))
+                                                          #("i" "i"))
+                                                        #(ribcage () () ())
+                                                        #(ribcage
+                                                          #(p lev)
+                                                          #((top) (top))
+                                                          #("i" "i"))
+                                                        #(ribcage
+                                                          #(isquote?
+                                                            islist?
+                                                            iscons?
+                                                            quote-nil?
+                                                            quasilist*
+                                                            quasicons
+                                                            quasiappend
+                                                            quasivector
+                                                            quasi)
+                                                          #((top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top))
+                                                          #("i"
+                                                            "i"
+                                                            "i"
+                                                            "i"
+                                                            "i"
+                                                            "i"
+                                                            "i"
+                                                            "i"
+                                                            "i"))
+                                                        #(ribcage
+                                                          ((import-token
+                                                             .
+                                                             *top*))
+                                                          ()
+                                                          ()))))
+                                                  (g2026
+                                                    g2116
+                                                    (- g2104 '1)))
+                                                (g2026 g2115 g2104))))
+                                        g2114)
+                                      ((lambda (g2119)
+                                         (if g2119
+                                             (apply
+                                               (lambda (g2120)
+                                                 (g2024
+                                                   '(#(syntax-object
+                                                       quote
+                                                       ((top)
+                                                        #(ribcage
+                                                          #(p)
+                                                          #((top))
+                                                          #("i"))
+                                                        #(ribcage () () ())
+                                                        #(ribcage
+                                                          #(p lev)
+                                                          #((top) (top))
+                                                          #("i" "i"))
+                                                        #(ribcage
+                                                          #(isquote?
+                                                            islist?
+                                                            iscons?
+                                                            quote-nil?
+                                                            quasilist*
+                                                            quasicons
+                                                            quasiappend
+                                                            quasivector
+                                                            quasi)
+                                                          #((top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top)
+                                                            (top))
+                                                          #("i"
+                                                            "i"
+                                                            "i"
+                                                            "i"
+                                                            "i"
+                                                            "i"
+                                                            "i"
+                                                            "i"
+                                                            "i"))
+                                                        #(ribcage
+                                                          ((import-token
+                                                             .
+                                                             *top*))
+                                                          ()
+                                                          ())))
+                                                      #(syntax-object
+                                                        quasiquote
+                                                        ((top)
+                                                         #(ribcage
+                                                           #(p)
+                                                           #((top))
+                                                           #("i"))
+                                                         #(ribcage
+                                                           ()
+                                                           ()
+                                                           ())
+                                                         #(ribcage
+                                                           #(p lev)
+                                                           #((top) (top))
+                                                           #("i" "i"))
+                                                         #(ribcage
+                                                           #(isquote?
+                                                             islist?
+                                                             iscons?
+                                                             quote-nil?
+                                                             quasilist*
+                                                             quasicons
+                                                             quasiappend
+                                                             quasivector
+                                                             quasi)
+                                                           #((top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top)
+                                                             (top))
+                                                           #("i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"
+                                                             "i"))
+                                                         #(ribcage
+                                                           ((import-token
+                                                              .
+                                                              *top*))
+                                                           ()
+                                                           ()))))
+                                                   (g2026
+                                                     (list g2120)
+                                                     (+ g2104 '1))))
+                                               g2119)
+                                             ((lambda (g2121)
+                                                (if g2121
+                                                    (apply
+                                                      (lambda (g2123 g2122)
+                                                        (g2024
+                                                          (g2026
+                                                            g2123
+                                                            g2104)
+                                                          (g2026
+                                                            g2122
+                                                            g2104)))
+                                                      g2121)
+                                                    ((lambda (g2124)
+                                                       (if g2124
+                                                           (apply
+                                                             (lambda (g2125)
+                                                               (g2025
+                                                                 (g2026
+                                                                   g2125
+                                                                   g2104)))
+                                                             g2124)
+                                                           ((lambda (g2127)
+                                                              (list '#(syntax-object
+                                                                       quote
+                                                                       ((top)
+                                                                        #(ribcage
+                                                                          #(p)
+                                                                          #((top))
+                                                                          #("i"))
+                                                                        #(ribcage
+                                                                          ()
+                                                                          ()
+                                                                          ())
+                                                                        #(ribcage
+                                                                          #(p
+                                                                            lev)
+                                                                          #((top)
+                                                                            (top))
+                                                                          #("i"
+                                                                            "i"))
+                                                                        #(ribcage
+                                                                          #(isquote?
+                                                                            islist?
+                                                                            iscons?
+                                                                            quote-nil?
+                                                                            quasilist*
+                                                                            quasicons
+                                                                            quasiappend
+                                                                            quasivector
+                                                                            quasi)
+                                                                          #((top)
+                                                                            (top)
+                                                                            (top)
+                                                                            (top)
+                                                                            (top)
+                                                                            (top)
+                                                                            (top)
+                                                                            (top)
+                                                                            (top))
+                                                                          #("i"
+                                                                            "i"
+                                                                            "i"
+                                                                            "i"
+                                                                            "i"
+                                                                            "i"
+                                                                            "i"
+                                                                            "i"
+                                                                            "i"))
+                                                                        #(ribcage
+                                                                          ((import-token
+                                                                             .
+                                                                             *top*))
+                                                                          ()
+                                                                          ())))
+                                                                    g2127))
+                                                            g2106)))
+                                                     ($syntax-dispatch
+                                                       g2106
+                                                       '#(vector
+                                                          each-any)))))
+                                              ($syntax-dispatch
+                                                g2106
+                                                '(any . any)))))
+                                       ($syntax-dispatch
+                                         g2106
+                                         '(#(free-id
+                                             #(syntax-object
+                                               quasiquote
+                                               ((top)
+                                                #(ribcage () () ())
+                                                #(ribcage
+                                                  #(p lev)
+                                                  #((top) (top))
+                                                  #("i" "i"))
+                                                #(ribcage
+                                                  #(isquote?
+                                                    islist?
+                                                    iscons?
+                                                    quote-nil?
+                                                    quasilist*
+                                                    quasicons
+                                                    quasiappend
+                                                    quasivector
+                                                    quasi)
+                                                  #((top)
+                                                    (top)
+                                                    (top)
+                                                    (top)
+                                                    (top)
+                                                    (top)
+                                                    (top)
+                                                    (top)
+                                                    (top))
+                                                  #("i"
+                                                    "i"
+                                                    "i"
+                                                    "i"
+                                                    "i"
+                                                    "i"
+                                                    "i"
+                                                    "i"
+                                                    "i"))
+                                                #(ribcage
+                                                  ((import-token . *top*))
+                                                  ()
+                                                  ()))))
+                                            any)))))
+                                ($syntax-dispatch
+                                  g2106
+                                  '((#(free-id
+                                       #(syntax-object
+                                         unquote-splicing
+                                         ((top)
+                                          #(ribcage () () ())
+                                          #(ribcage
+                                            #(p lev)
+                                            #((top) (top))
+                                            #("i" "i"))
+                                          #(ribcage
+                                            #(isquote?
+                                              islist?
+                                              iscons?
+                                              quote-nil?
+                                              quasilist*
+                                              quasicons
+                                              quasiappend
+                                              quasivector
+                                              quasi)
+                                            #((top)
+                                              (top)
+                                              (top)
+                                              (top)
+                                              (top)
+                                              (top)
+                                              (top)
+                                              (top)
+                                              (top))
+                                            #("i"
+                                              "i"
+                                              "i"
+                                              "i"
+                                              "i"
+                                              "i"
+                                              "i"
+                                              "i"
+                                              "i"))
+                                          #(ribcage
+                                            ((import-token . *top*))
+                                            ()
+                                            ()))))
+                                      .
+                                      each-any)
+                                    .
+                                    any)))))
+                         ($syntax-dispatch
+                           g2106
+                           '((#(free-id
+                                #(syntax-object
+                                  unquote
+                                  ((top)
+                                   #(ribcage () () ())
+                                   #(ribcage
+                                     #(p lev)
+                                     #((top) (top))
+                                     #("i" "i"))
+                                   #(ribcage
+                                     #(isquote?
+                                       islist?
+                                       iscons?
+                                       quote-nil?
+                                       quasilist*
+                                       quasicons
+                                       quasiappend
+                                       quasivector
+                                       quasi)
+                                     #((top)
+                                       (top)
+                                       (top)
+                                       (top)
+                                       (top)
+                                       (top)
+                                       (top)
+                                       (top)
+                                       (top))
+                                     #("i"
+                                       "i"
+                                       "i"
+                                       "i"
+                                       "i"
+                                       "i"
+                                       "i"
+                                       "i"
+                                       "i"))
+                                   #(ribcage
+                                     ((import-token . *top*))
+                                     ()
+                                     ()))))
+                               .
+                               each-any)
+                             .
+                             any)))))
+                  ($syntax-dispatch
+                    g2106
+                    '(#(free-id
+                        #(syntax-object
+                          unquote
+                          ((top)
+                           #(ribcage () () ())
+                           #(ribcage #(p lev) #((top) (top)) #("i" "i"))
+                           #(ribcage
+                             #(isquote?
+                               islist?
+                               iscons?
+                               quote-nil?
+                               quasilist*
+                               quasicons
+                               quasiappend
+                               quasivector
+                               quasi)
+                             #((top)
+                               (top)
+                               (top)
+                               (top)
+                               (top)
+                               (top)
+                               (top)
+                               (top)
+                               (top))
+                             #("i" "i" "i" "i" "i" "i" "i" "i" "i"))
+                           #(ribcage ((import-token . *top*)) () ()))))
+                       any))))
+               g2105))))
+    (lambda (g2031)
+      ((lambda (g2032)
+         ((lambda (g2033)
+            (if g2033
+                (apply (lambda (g2035 g2034) (g2026 g2034 '0)) g2033)
+                (syntax-error g2032)))
+          ($syntax-dispatch g2032 '(any any))))
+       g2031))))
+($sc-put-cte
+  'include
+  (lambda (g2143)
+    (letrec ((g2144
+              (lambda (g2155 g2154)
+                ((lambda (g2156)
+                   ((letrec ((g2157
+                              (lambda ()
+                                ((lambda (g2158)
+                                   (if (eof-object? g2158)
+                                       (begin (close-input-port g2156) '())
+                                       (cons (datum->syntax-object
+                                               g2154
+                                               g2158)
+                                             (g2157))))
+                                 (read g2156)))))
+                      g2157)))
+                 (open-input-file g2155)))))
+      ((lambda (g2145)
+         ((lambda (g2146)
+            (if g2146
+                (apply
+                  (lambda (g2148 g2147)
+                    ((lambda (g2149)
+                       ((lambda (g2150)
+                          ((lambda (g2151)
+                             (if g2151
+                                 (apply
+                                   (lambda (g2152)
+                                     (cons '#(syntax-object
+                                              begin
+                                              ((top)
+                                               #(ribcage
+                                                 #(exp)
+                                                 #((top))
+                                                 #("i"))
+                                               #(ribcage () () ())
+                                               #(ribcage () () ())
+                                               #(ribcage
+                                                 #(fn)
+                                                 #((top))
+                                                 #("i"))
+                                               #(ribcage
+                                                 #(k filename)
+                                                 #((top) (top))
+                                                 #("i" "i"))
+                                               #(ribcage
+                                                 (read-file)
+                                                 ((top))
+                                                 ("i"))
+                                               #(ribcage
+                                                 #(x)
+                                                 #((top))
+                                                 #("i"))
+                                               #(ribcage
+                                                 ((import-token . *top*))
+                                                 ()
+                                                 ())))
+                                           g2152))
+                                   g2151)
+                                 (syntax-error g2150)))
+                           ($syntax-dispatch g2150 'each-any)))
+                        (g2144 g2149 g2148)))
+                     (syntax-object->datum g2147)))
+                  g2146)
+                (syntax-error g2145)))
+          ($syntax-dispatch g2145 '(any any))))
+       g2143))))
+($sc-put-cte
+  'unquote
+  (lambda (g2159)
+    ((lambda (g2160)
+       ((lambda (g2161)
+          (if g2161
+              (apply
+                (lambda (g2163 g2162)
+                  (syntax-error
+                    g2159
+                    '"expression not valid outside of quasiquote"))
+                g2161)
+              (syntax-error g2160)))
+        ($syntax-dispatch g2160 '(any . each-any))))
+     g2159)))
+($sc-put-cte
+  'unquote-splicing
+  (lambda (g2164)
+    ((lambda (g2165)
+       ((lambda (g2166)
+          (if g2166
+              (apply
+                (lambda (g2168 g2167)
+                  (syntax-error
+                    g2164
+                    '"expression not valid outside of quasiquote"))
+                g2166)
+              (syntax-error g2165)))
+        ($syntax-dispatch g2165 '(any . each-any))))
+     g2164)))
+($sc-put-cte
+  'case
+  (lambda (g2169)
+    ((lambda (g2170)
+       ((lambda (g2171)
+          (if g2171
+              (apply
+                (lambda (g2175 g2172 g2174 g2173)
+                  ((lambda (g2176)
+                     ((lambda (g2203)
+                        (list '#(syntax-object
+                                 let
+                                 ((top)
+                                  #(ribcage #(body) #((top)) #("i"))
+                                  #(ribcage
+                                    #(_ e m1 m2)
+                                    #((top) (top) (top) (top))
+                                    #("i" "i" "i" "i"))
+                                  #(ribcage () () ())
+                                  #(ribcage #(x) #((top)) #("i"))
+                                  #(ribcage
+                                    ((import-token . *top*))
+                                    ()
+                                    ())))
+                              (list (list '#(syntax-object
+                                             t
+                                             ((top)
+                                              #(ribcage
+                                                #(body)
+                                                #((top))
+                                                #("i"))
+                                              #(ribcage
+                                                #(_ e m1 m2)
+                                                #((top) (top) (top) (top))
+                                                #("i" "i" "i" "i"))
+                                              #(ribcage () () ())
+                                              #(ribcage
+                                                #(x)
+                                                #((top))
+                                                #("i"))
+                                              #(ribcage
+                                                ((import-token . *top*))
+                                                ()
+                                                ())))
+                                          g2172))
+                              g2203))
+                      g2176))
+                   ((letrec ((g2177
+                              (lambda (g2179 g2178)
+                                (if (null? g2178)
+                                    ((lambda (g2180)
+                                       ((lambda (g2181)
+                                          (if g2181
+                                              (apply
+                                                (lambda (g2183 g2182)
+                                                  (cons '#(syntax-object
+                                                           begin
+                                                           ((top)
+                                                            #(ribcage
+                                                              #(e1 e2)
+                                                              #((top)
+                                                                (top))
+                                                              #("i" "i"))
+                                                            #(ribcage
+                                                              ()
+                                                              ()
+                                                              ())
+                                                            #(ribcage
+                                                              #(clause
+                                                                clauses)
+                                                              #((top)
+                                                                (top))
+                                                              #("i" "i"))
+                                                            #(ribcage
+                                                              #(f)
+                                                              #((top))
+                                                              #("i"))
+                                                            #(ribcage
+                                                              #(_ e m1 m2)
+                                                              #((top)
+                                                                (top)
+                                                                (top)
+                                                                (top))
+                                                              #("i"
+                                                                "i"
+                                                                "i"
+                                                                "i"))
+                                                            #(ribcage
+                                                              ()
+                                                              ()
+                                                              ())
+                                                            #(ribcage
+                                                              #(x)
+                                                              #((top))
+                                                              #("i"))
+                                                            #(ribcage
+                                                              ((import-token
+                                                                 .
+                                                                 *top*))
+                                                              ()
+                                                              ())))
+                                                        (cons g2183
+                                                              g2182)))
+                                                g2181)
+                                              ((lambda (g2185)
+                                                 (if g2185
+                                                     (apply
+                                                       (lambda (g2188
+                                                                g2186
+                                                                g2187)
+                                                         (list '#(syntax-object
+                                                                  if
+                                                                  ((top)
+                                                                   #(ribcage
+                                                                     #(k
+                                                                       e1
+                                                                       e2)
+                                                                     #((top)
+                                                                       (top)
+                                                                       (top))
+                                                                     #("i"
+                                                                       "i"
+                                                                       "i"))
+                                                                   #(ribcage
+                                                                     ()
+                                                                     ()
+                                                                     ())
+                                                                   #(ribcage
+                                                                     #(clause
+                                                                       clauses)
+                                                                     #((top)
+                                                                       (top))
+                                                                     #("i"
+                                                                       "i"))
+                                                                   #(ribcage
+                                                                     #(f)
+                                                                     #((top))
+                                                                     #("i"))
+                                                                   #(ribcage
+                                                                     #(_
+                                                                       e
+                                                                       m1
+                                                                       m2)
+                                                                     #((top)
+                                                                       (top)
+                                                                       (top)
+                                                                       (top))
+                                                                     #("i"
+                                                                       "i"
+                                                                       "i"
+                                                                       "i"))
+                                                                   #(ribcage
+                                                                     ()
+                                                                     ()
+                                                                     ())
+                                                                   #(ribcage
+                                                                     #(x)
+                                                                     #((top))
+                                                                     #("i"))
+                                                                   #(ribcage
+                                                                     ((import-token
+                                                                        .
+                                                                        *top*))
+                                                                     ()
+                                                                     ())))
+                                                               (list '#(syntax-object
+                                                                        memv
+                                                                        ((top)
+                                                                         #(ribcage
+                                                                           #(k
+                                                                             e1
+                                                                             e2)
+                                                                           #((top)
+                                                                             (top)
+                                                                             (top))
+                                                                           #("i"
+                                                                             "i"
+                                                                             "i"))
+                                                                         #(ribcage
+                                                                           ()
+                                                                           ()
+                                                                           ())
+                                                                         #(ribcage
+                                                                           #(clause
+                                                                             clauses)
+                                                                           #((top)
+                                                                             (top))
+                                                                           #("i"
+                                                                             "i"))
+                                                                         #(ribcage
+                                                                           #(f)
+                                                                           #((top))
+                                                                           #("i"))
+                                                                         #(ribcage
+                                                                           #(_
+                                                                             e
+                                                                             m1
+                                                                             m2)
+                                                                           #((top)
+                                                                             (top)
+                                                                             (top)
+                                                                             (top))
+                                                                           #("i"
+                                                                             "i"
+                                                                             "i"
+                                                                             "i"))
+                                                                         #(ribcage
+                                                                           ()
+                                                                           ()
+                                                                           ())
+                                                                         #(ribcage
+                                                                           #(x)
+                                                                           #((top))
+                                                                           #("i"))
+                                                                         #(ribcage
+                                                                           ((import-token
+                                                                              .
+                                                                              *top*))
+                                                                           ()
+                                                                           ())))
+                                                                     '#(syntax-object
+                                                                        t
+                                                                        ((top)
+                                                                         #(ribcage
+                                                                           #(k
+                                                                             e1
+                                                                             e2)
+                                                                           #((top)
+                                                                             (top)
+                                                                             (top))
+                                                                           #("i"
+                                                                             "i"
+                                                                             "i"))
+                                                                         #(ribcage
+                                                                           ()
+                                                                           ()
+                                                                           ())
+                                                                         #(ribcage
+                                                                           #(clause
+                                                                             clauses)
+                                                                           #((top)
+                                                                             (top))
+                                                                           #("i"
+                                                                             "i"))
+                                                                         #(ribcage
+                                                                           #(f)
+                                                                           #((top))
+                                                                           #("i"))
+                                                                         #(ribcage
+                                                                           #(_
+                                                                             e
+                                                                             m1
+                                                                             m2)
+                                                                           #((top)
+                                                                             (top)
+                                                                             (top)
+                                                                             (top))
+                                                                           #("i"
+                                                                             "i"
+                                                                             "i"
+                                                                             "i"))
+                                                                         #(ribcage
+                                                                           ()
+                                                                           ()
+                                                                           ())
+                                                                         #(ribcage
+                                                                           #(x)
+                                                                           #((top))
+                                                                           #("i"))
+                                                                         #(ribcage
+                                                                           ((import-token
+                                                                              .
+                                                                              *top*))
+                                                                           ()
+                                                                           ())))
+                                                                     (list '#(syntax-object
+                                                                              quote
+                                                                              ((top)
+                                                                               #(ribcage
+                                                                                 #(k
+                                                                                   e1
+                                                                                   e2)
+                                                                                 #((top)
+                                                                                   (top)
+                                                                                   (top))
+                                                                                 #("i"
+                                                                                   "i"
+                                                                                   "i"))
+                                                                               #(ribcage
+                                                                                 ()
+                                                                                 ()
+                                                                                 ())
+                                                                               #(ribcage
+                                                                                 #(clause
+                                                                                   clauses)
+                                                                                 #((top)
+                                                                                   (top))
+                                                                                 #("i"
+                                                                                   "i"))
+                                                                               #(ribcage
+                                                                                 #(f)
+                                                                                 #((top))
+                                                                                 #("i"))
+                                                                               #(ribcage
+                                                                                 #(_
+                                                                                   e
+                                                                                   m1
+                                                                                   m2)
+                                                                                 #((top)
+                                                                                   (top)
+                                                                                   (top)
+                                                                                   (top))
+                                                                                 #("i"
+                                                                                   "i"
+                                                                                   "i"
+                                                                                   "i"))
+                                                                               #(ribcage
+                                                                                 ()
+                                                                                 ()
+                                                                                 ())
+                                                                               #(ribcage
+                                                                                 #(x)
+                                                                                 #((top))
+                                                                                 #("i"))
+                                                                               #(ribcage
+                                                                                 ((import-token
+                                                                                    .
+                                                                                    *top*))
+                                                                                 ()
+                                                                                 ())))
+                                                                           g2188))
+                                                               (cons '#(syntax-object
+                                                                        begin
+                                                                        ((top)
+                                                                         #(ribcage
+                                                                           #(k
+                                                                             e1
+                                                                             e2)
+                                                                           #((top)
+                                                                             (top)
+                                                                             (top))
+                                                                           #("i"
+                                                                             "i"
+                                                                             "i"))
+                                                                         #(ribcage
+                                                                           ()
+                                                                           ()
+                                                                           ())
+                                                                         #(ribcage
+                                                                           #(clause
+                                                                             clauses)
+                                                                           #((top)
+                                                                             (top))
+                                                                           #("i"
+                                                                             "i"))
+                                                                         #(ribcage
+                                                                           #(f)
+                                                                           #((top))
+                                                                           #("i"))
+                                                                         #(ribcage
+                                                                           #(_
+                                                                             e
+                                                                             m1
+                                                                             m2)
+                                                                           #((top)
+                                                                             (top)
+                                                                             (top)
+                                                                             (top))
+                                                                           #("i"
+                                                                             "i"
+                                                                             "i"
+                                                                             "i"))
+                                                                         #(ribcage
+                                                                           ()
+                                                                           ()
+                                                                           ())
+                                                                         #(ribcage
+                                                                           #(x)
+                                                                           #((top))
+                                                                           #("i"))
+                                                                         #(ribcage
+                                                                           ((import-token
+                                                                              .
+                                                                              *top*))
+                                                                           ()
+                                                                           ())))
+                                                                     (cons g2186
+                                                                           g2187))))
+                                                       g2185)
+                                                     ((lambda (g2191)
+                                                        (syntax-error
+                                                          g2169))
+                                                      g2180)))
+                                               ($syntax-dispatch
+                                                 g2180
+                                                 '(each-any
+                                                    any
+                                                    .
+                                                    each-any)))))
+                                        ($syntax-dispatch
+                                          g2180
+                                          '(#(free-id
+                                              #(syntax-object
+                                                else
+                                                ((top)
+                                                 #(ribcage () () ())
+                                                 #(ribcage
+                                                   #(clause clauses)
+                                                   #((top) (top))
+                                                   #("i" "i"))
+                                                 #(ribcage
+                                                   #(f)
+                                                   #((top))
+                                                   #("i"))
+                                                 #(ribcage
+                                                   #(_ e m1 m2)
+                                                   #((top)
+                                                     (top)
+                                                     (top)
+                                                     (top))
+                                                   #("i" "i" "i" "i"))
+                                                 #(ribcage () () ())
+                                                 #(ribcage
+                                                   #(x)
+                                                   #((top))
+                                                   #("i"))
+                                                 #(ribcage
+                                                   ((import-token . *top*))
+                                                   ()
+                                                   ()))))
+                                             any
+                                             .
+                                             each-any))))
+                                     g2179)
+                                    ((lambda (g2192)
+                                       ((lambda (g2193)
+                                          ((lambda (g2194)
+                                             ((lambda (g2195)
+                                                (if g2195
+                                                    (apply
+                                                      (lambda (g2198
+                                                               g2196
+                                                               g2197)
+                                                        (list '#(syntax-object
+                                                                 if
+                                                                 ((top)
+                                                                  #(ribcage
+                                                                    #(k
+                                                                      e1
+                                                                      e2)
+                                                                    #((top)
+                                                                      (top)
+                                                                      (top))
+                                                                    #("i"
+                                                                      "i"
+                                                                      "i"))
+                                                                  #(ribcage
+                                                                    #(rest)
+                                                                    #((top))
+                                                                    #("i"))
+                                                                  #(ribcage
+                                                                    ()
+                                                                    ()
+                                                                    ())
+                                                                  #(ribcage
+                                                                    #(clause
+                                                                      clauses)
+                                                                    #((top)
+                                                                      (top))
+                                                                    #("i"
+                                                                      "i"))
+                                                                  #(ribcage
+                                                                    #(f)
+                                                                    #((top))
+                                                                    #("i"))
+                                                                  #(ribcage
+                                                                    #(_
+                                                                      e
+                                                                      m1
+                                                                      m2)
+                                                                    #((top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top))
+                                                                    #("i"
+                                                                      "i"
+                                                                      "i"
+                                                                      "i"))
+                                                                  #(ribcage
+                                                                    ()
+                                                                    ()
+                                                                    ())
+                                                                  #(ribcage
+                                                                    #(x)
+                                                                    #((top))
+                                                                    #("i"))
+                                                                  #(ribcage
+                                                                    ((import-token
+                                                                       .
+                                                                       *top*))
+                                                                    ()
+                                                                    ())))
+                                                              (list '#(syntax-object
+                                                                       memv
+                                                                       ((top)
+                                                                        #(ribcage
+                                                                          #(k
+                                                                            e1
+                                                                            e2)
+                                                                          #((top)
+                                                                            (top)
+                                                                            (top))
+                                                                          #("i"
+                                                                            "i"
+                                                                            "i"))
+                                                                        #(ribcage
+                                                                          #(rest)
+                                                                          #((top))
+                                                                          #("i"))
+                                                                        #(ribcage
+                                                                          ()
+                                                                          ()
+                                                                          ())
+                                                                        #(ribcage
+                                                                          #(clause
+                                                                            clauses)
+                                                                          #((top)
+                                                                            (top))
+                                                                          #("i"
+                                                                            "i"))
+                                                                        #(ribcage
+                                                                          #(f)
+                                                                          #((top))
+                                                                          #("i"))
+                                                                        #(ribcage
+                                                                          #(_
+                                                                            e
+                                                                            m1
+                                                                            m2)
+                                                                          #((top)
+                                                                            (top)
+                                                                            (top)
+                                                                            (top))
+                                                                          #("i"
+                                                                            "i"
+                                                                            "i"
+                                                                            "i"))
+                                                                        #(ribcage
+                                                                          ()
+                                                                          ()
+                                                                          ())
+                                                                        #(ribcage
+                                                                          #(x)
+                                                                          #((top))
+                                                                          #("i"))
+                                                                        #(ribcage
+                                                                          ((import-token
+                                                                             .
+                                                                             *top*))
+                                                                          ()
+                                                                          ())))
+                                                                    '#(syntax-object
+                                                                       t
+                                                                       ((top)
+                                                                        #(ribcage
+                                                                          #(k
+                                                                            e1
+                                                                            e2)
+                                                                          #((top)
+                                                                            (top)
+                                                                            (top))
+                                                                          #("i"
+                                                                            "i"
+                                                                            "i"))
+                                                                        #(ribcage
+                                                                          #(rest)
+                                                                          #((top))
+                                                                          #("i"))
+                                                                        #(ribcage
+                                                                          ()
+                                                                          ()
+                                                                          ())
+                                                                        #(ribcage
+                                                                          #(clause
+                                                                            clauses)
+                                                                          #((top)
+                                                                            (top))
+                                                                          #("i"
+                                                                            "i"))
+                                                                        #(ribcage
+                                                                          #(f)
+                                                                          #((top))
+                                                                          #("i"))
+                                                                        #(ribcage
+                                                                          #(_
+                                                                            e
+                                                                            m1
+                                                                            m2)
+                                                                          #((top)
+                                                                            (top)
+                                                                            (top)
+                                                                            (top))
+                                                                          #("i"
+                                                                            "i"
+                                                                            "i"
+                                                                            "i"))
+                                                                        #(ribcage
+                                                                          ()
+                                                                          ()
+                                                                          ())
+                                                                        #(ribcage
+                                                                          #(x)
+                                                                          #((top))
+                                                                          #("i"))
+                                                                        #(ribcage
+                                                                          ((import-token
+                                                                             .
+                                                                             *top*))
+                                                                          ()
+                                                                          ())))
+                                                                    (list '#(syntax-object
+                                                                             quote
+                                                                             ((top)
+                                                                              #(ribcage
+                                                                                #(k
+                                                                                  e1
+                                                                                  e2)
+                                                                                #((top)
+                                                                                  (top)
+                                                                                  (top))
+                                                                                #("i"
+                                                                                  "i"
+                                                                                  "i"))
+                                                                              #(ribcage
+                                                                                #(rest)
+                                                                                #((top))
+                                                                                #("i"))
+                                                                              #(ribcage
+                                                                                ()
+                                                                                ()
+                                                                                ())
+                                                                              #(ribcage
+                                                                                #(clause
+                                                                                  clauses)
+                                                                                #((top)
+                                                                                  (top))
+                                                                                #("i"
+                                                                                  "i"))
+                                                                              #(ribcage
+                                                                                #(f)
+                                                                                #((top))
+                                                                                #("i"))
+                                                                              #(ribcage
+                                                                                #(_
+                                                                                  e
+                                                                                  m1
+                                                                                  m2)
+                                                                                #((top)
+                                                                                  (top)
+                                                                                  (top)
+                                                                                  (top))
+                                                                                #("i"
+                                                                                  "i"
+                                                                                  "i"
+                                                                                  "i"))
+                                                                              #(ribcage
+                                                                                ()
+                                                                                ()
+                                                                                ())
+                                                                              #(ribcage
+                                                                                #(x)
+                                                                                #((top))
+                                                                                #("i"))
+                                                                              #(ribcage
+                                                                                ((import-token
+                                                                                   .
+                                                                                   *top*))
+                                                                                ()
+                                                                                ())))
+                                                                          g2198))
+                                                              (cons '#(syntax-object
+                                                                       begin
+                                                                       ((top)
+                                                                        #(ribcage
+                                                                          #(k
+                                                                            e1
+                                                                            e2)
+                                                                          #((top)
+                                                                            (top)
+                                                                            (top))
+                                                                          #("i"
+                                                                            "i"
+                                                                            "i"))
+                                                                        #(ribcage
+                                                                          #(rest)
+                                                                          #((top))
+                                                                          #("i"))
+                                                                        #(ribcage
+                                                                          ()
+                                                                          ()
+                                                                          ())
+                                                                        #(ribcage
+                                                                          #(clause
+                                                                            clauses)
+                                                                          #((top)
+                                                                            (top))
+                                                                          #("i"
+                                                                            "i"))
+                                                                        #(ribcage
+                                                                          #(f)
+                                                                          #((top))
+                                                                          #("i"))
+                                                                        #(ribcage
+                                                                          #(_
+                                                                            e
+                                                                            m1
+                                                                            m2)
+                                                                          #((top)
+                                                                            (top)
+                                                                            (top)
+                                                                            (top))
+                                                                          #("i"
+                                                                            "i"
+                                                                            "i"
+                                                                            "i"))
+                                                                        #(ribcage
+                                                                          ()
+                                                                          ()
+                                                                          ())
+                                                                        #(ribcage
+                                                                          #(x)
+                                                                          #((top))
+                                                                          #("i"))
+                                                                        #(ribcage
+                                                                          ((import-token
+                                                                             .
+                                                                             *top*))
+                                                                          ()
+                                                                          ())))
+                                                                    (cons g2196
+                                                                          g2197))
+                                                              g2193))
+                                                      g2195)
+                                                    ((lambda (g2201)
+                                                       (syntax-error
+                                                         g2169))
+                                                     g2194)))
+                                              ($syntax-dispatch
+                                                g2194
+                                                '(each-any
+                                                   any
+                                                   .
+                                                   each-any))))
+                                           g2179))
+                                        g2192))
+                                     (g2177 (car g2178) (cdr g2178)))))))
+                      g2177)
+                    g2174
+                    g2173)))
+                g2171)
+              (syntax-error g2170)))
+        ($syntax-dispatch g2170 '(any any any . each-any))))
+     g2169)))
+($sc-put-cte
+  'identifier-syntax
+  (lambda (g2204)
+    ((lambda (g2205)
+       ((lambda (g2206)
+          (if g2206
+              (apply
+                (lambda (g2208 g2207)
+                  (list '#(syntax-object
+                           lambda
+                           ((top)
+                            #(ribcage #(_ e) #((top) (top)) #("i" "i"))
+                            #(ribcage () () ())
+                            #(ribcage #(x) #((top)) #("i"))
+                            #(ribcage ((import-token . *top*)) () ())))
+                        '(#(syntax-object
+                            x
+                            ((top)
+                             #(ribcage #(_ e) #((top) (top)) #("i" "i"))
+                             #(ribcage () () ())
+                             #(ribcage #(x) #((top)) #("i"))
+                             #(ribcage ((import-token . *top*)) () ()))))
+                        (list '#(syntax-object
+                                 syntax-case
+                                 ((top)
+                                  #(ribcage
+                                    #(_ e)
+                                    #((top) (top))
+                                    #("i" "i"))
+                                  #(ribcage () () ())
+                                  #(ribcage #(x) #((top)) #("i"))
+                                  #(ribcage
+                                    ((import-token . *top*))
+                                    ()
+                                    ())))
+                              '#(syntax-object
+                                 x
+                                 ((top)
+                                  #(ribcage
+                                    #(_ e)
+                                    #((top) (top))
+                                    #("i" "i"))
+                                  #(ribcage () () ())
+                                  #(ribcage #(x) #((top)) #("i"))
+                                  #(ribcage
+                                    ((import-token . *top*))
+                                    ()
+                                    ())))
+                              '()
+                              (list '#(syntax-object
+                                       id
+                                       ((top)
+                                        #(ribcage
+                                          #(_ e)
+                                          #((top) (top))
+                                          #("i" "i"))
+                                        #(ribcage () () ())
+                                        #(ribcage #(x) #((top)) #("i"))
+                                        #(ribcage
+                                          ((import-token . *top*))
+                                          ()
+                                          ())))
+                                    '(#(syntax-object
+                                        identifier?
+                                        ((top)
+                                         #(ribcage
+                                           #(_ e)
+                                           #((top) (top))
+                                           #("i" "i"))
+                                         #(ribcage () () ())
+                                         #(ribcage #(x) #((top)) #("i"))
+                                         #(ribcage
+                                           ((import-token . *top*))
+                                           ()
+                                           ())))
+                                       (#(syntax-object
+                                          syntax
+                                          ((top)
+                                           #(ribcage
+                                             #(_ e)
+                                             #((top) (top))
+                                             #("i" "i"))
+                                           #(ribcage () () ())
+                                           #(ribcage #(x) #((top)) #("i"))
+                                           #(ribcage
+                                             ((import-token . *top*))
+                                             ()
+                                             ())))
+                                         #(syntax-object
+                                           id
+                                           ((top)
+                                            #(ribcage
+                                              #(_ e)
+                                              #((top) (top))
+                                              #("i" "i"))
+                                            #(ribcage () () ())
+                                            #(ribcage #(x) #((top)) #("i"))
+                                            #(ribcage
+                                              ((import-token . *top*))
+                                              ()
+                                              ())))))
+                                    (list '#(syntax-object
+                                             syntax
+                                             ((top)
+                                              #(ribcage
+                                                #(_ e)
+                                                #((top) (top))
+                                                #("i" "i"))
+                                              #(ribcage () () ())
+                                              #(ribcage
+                                                #(x)
+                                                #((top))
+                                                #("i"))
+                                              #(ribcage
+                                                ((import-token . *top*))
+                                                ()
+                                                ())))
+                                          g2207))
+                              (list (cons g2208
+                                          '(#(syntax-object
+                                              x
+                                              ((top)
+                                               #(ribcage
+                                                 #(_ e)
+                                                 #((top) (top))
+                                                 #("i" "i"))
+                                               #(ribcage () () ())
+                                               #(ribcage
+                                                 #(x)
+                                                 #((top))
+                                                 #("i"))
+                                               #(ribcage
+                                                 ((import-token . *top*))
+                                                 ()
+                                                 ())))
+                                             #(syntax-object
+                                               ...
+                                               ((top)
+                                                #(ribcage
+                                                  #(_ e)
+                                                  #((top) (top))
+                                                  #("i" "i"))
+                                                #(ribcage () () ())
+                                                #(ribcage
+                                                  #(x)
+                                                  #((top))
+                                                  #("i"))
+                                                #(ribcage
+                                                  ((import-token . *top*))
+                                                  ()
+                                                  ())))))
+                                    (list '#(syntax-object
+                                             syntax
+                                             ((top)
+                                              #(ribcage
+                                                #(_ e)
+                                                #((top) (top))
+                                                #("i" "i"))
+                                              #(ribcage () () ())
+                                              #(ribcage
+                                                #(x)
+                                                #((top))
+                                                #("i"))
+                                              #(ribcage
+                                                ((import-token . *top*))
+                                                ()
+                                                ())))
+                                          (cons g2207
+                                                '(#(syntax-object
+                                                    x
+                                                    ((top)
+                                                     #(ribcage
+                                                       #(_ e)
+                                                       #((top) (top))
+                                                       #("i" "i"))
+                                                     #(ribcage () () ())
+                                                     #(ribcage
+                                                       #(x)
+                                                       #((top))
+                                                       #("i"))
+                                                     #(ribcage
+                                                       ((import-token
+                                                          .
+                                                          *top*))
+                                                       ()
+                                                       ())))
+                                                   #(syntax-object
+                                                     ...
+                                                     ((top)
+                                                      #(ribcage
+                                                        #(_ e)
+                                                        #((top) (top))
+                                                        #("i" "i"))
+                                                      #(ribcage () () ())
+                                                      #(ribcage
+                                                        #(x)
+                                                        #((top))
+                                                        #("i"))
+                                                      #(ribcage
+                                                        ((import-token
+                                                           .
+                                                           *top*))
+                                                        ()
+                                                        ()))))))))))
+                g2206)
+              ((lambda (g2209)
+                 (if (if g2209
+                         (apply
+                           (lambda (g2215 g2210 g2214 g2211 g2213 g2212)
+                             (if (identifier? g2210)
+                                 (identifier? g2211)
+                                 '#f))
+                           g2209)
+                         '#f)
+                     (apply
+                       (lambda (g2221 g2216 g2220 g2217 g2219 g2218)
+                         (list '#(syntax-object
+                                  cons
+                                  ((top)
+                                   #(ribcage
+                                     #(_ id exp1 var val exp2)
+                                     #((top) (top) (top) (top) (top) (top))
+                                     #("i" "i" "i" "i" "i" "i"))
+                                   #(ribcage () () ())
+                                   #(ribcage #(x) #((top)) #("i"))
+                                   #(ribcage
+                                     ((import-token . *top*))
+                                     ()
+                                     ())))
+                               '(#(syntax-object
+                                   quote
+                                   ((top)
+                                    #(ribcage
+                                      #(_ id exp1 var val exp2)
+                                      #((top)
+                                        (top)
+                                        (top)
+                                        (top)
+                                        (top)
+                                        (top))
+                                      #("i" "i" "i" "i" "i" "i"))
+                                    #(ribcage () () ())
+                                    #(ribcage #(x) #((top)) #("i"))
+                                    #(ribcage
+                                      ((import-token . *top*))
+                                      ()
+                                      ())))
+                                  #(syntax-object
+                                    macro!
+                                    ((top)
+                                     #(ribcage
+                                       #(_ id exp1 var val exp2)
+                                       #((top)
+                                         (top)
+                                         (top)
+                                         (top)
+                                         (top)
+                                         (top))
+                                       #("i" "i" "i" "i" "i" "i"))
+                                     #(ribcage () () ())
+                                     #(ribcage #(x) #((top)) #("i"))
+                                     #(ribcage
+                                       ((import-token . *top*))
+                                       ()
+                                       ()))))
+                               (list '#(syntax-object
+                                        lambda
+                                        ((top)
+                                         #(ribcage
+                                           #(_ id exp1 var val exp2)
+                                           #((top)
+                                             (top)
+                                             (top)
+                                             (top)
+                                             (top)
+                                             (top))
+                                           #("i" "i" "i" "i" "i" "i"))
+                                         #(ribcage () () ())
+                                         #(ribcage #(x) #((top)) #("i"))
+                                         #(ribcage
+                                           ((import-token . *top*))
+                                           ()
+                                           ())))
+                                     '(#(syntax-object
+                                         x
+                                         ((top)
+                                          #(ribcage
+                                            #(_ id exp1 var val exp2)
+                                            #((top)
+                                              (top)
+                                              (top)
+                                              (top)
+                                              (top)
+                                              (top))
+                                            #("i" "i" "i" "i" "i" "i"))
+                                          #(ribcage () () ())
+                                          #(ribcage #(x) #((top)) #("i"))
+                                          #(ribcage
+                                            ((import-token . *top*))
+                                            ()
+                                            ()))))
+                                     (list '#(syntax-object
+                                              syntax-case
+                                              ((top)
+                                               #(ribcage
+                                                 #(_ id exp1 var val exp2)
+                                                 #((top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top))
+                                                 #("i"
+                                                   "i"
+                                                   "i"
+                                                   "i"
+                                                   "i"
+                                                   "i"))
+                                               #(ribcage () () ())
+                                               #(ribcage
+                                                 #(x)
+                                                 #((top))
+                                                 #("i"))
+                                               #(ribcage
+                                                 ((import-token . *top*))
+                                                 ()
+                                                 ())))
+                                           '#(syntax-object
+                                              x
+                                              ((top)
+                                               #(ribcage
+                                                 #(_ id exp1 var val exp2)
+                                                 #((top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top)
+                                                   (top))
+                                                 #("i"
+                                                   "i"
+                                                   "i"
+                                                   "i"
+                                                   "i"
+                                                   "i"))
+                                               #(ribcage () () ())
+                                               #(ribcage
+                                                 #(x)
+                                                 #((top))
+                                                 #("i"))
+                                               #(ribcage
+                                                 ((import-token . *top*))
+                                                 ()
+                                                 ())))
+                                           '(#(syntax-object
+                                               set!
+                                               ((top)
+                                                #(ribcage
+                                                  #(_ id exp1 var val exp2)
+                                                  #((top)
+                                                    (top)
+                                                    (top)
+                                                    (top)
+                                                    (top)
+                                                    (top))
+                                                  #("i"
+                                                    "i"
+                                                    "i"
+                                                    "i"
+                                                    "i"
+                                                    "i"))
+                                                #(ribcage () () ())
+                                                #(ribcage
+                                                  #(x)
+                                                  #((top))
+                                                  #("i"))
+                                                #(ribcage
+                                                  ((import-token . *top*))
+                                                  ()
+                                                  ()))))
+                                           (list (list '#(syntax-object
+                                                          set!
+                                                          ((top)
+                                                           #(ribcage
+                                                             #(_
+                                                               id
+                                                               exp1
+                                                               var
+                                                               val
+                                                               exp2)
+                                                             #((top)
+                                                               (top)
+                                                               (top)
+                                                               (top)
+                                                               (top)
+                                                               (top))
+                                                             #("i"
+                                                               "i"
+                                                               "i"
+                                                               "i"
+                                                               "i"
+                                                               "i"))
+                                                           #(ribcage
+                                                             ()
+                                                             ()
+                                                             ())
+                                                           #(ribcage
+                                                             #(x)
+                                                             #((top))
+                                                             #("i"))
+                                                           #(ribcage
+                                                             ((import-token
+                                                                .
+                                                                *top*))
+                                                             ()
+                                                             ())))
+                                                       g2217
+                                                       g2219)
+                                                 (list '#(syntax-object
+                                                          syntax
+                                                          ((top)
+                                                           #(ribcage
+                                                             #(_
+                                                               id
+                                                               exp1
+                                                               var
+                                                               val
+                                                               exp2)
+                                                             #((top)
+                                                               (top)
+                                                               (top)
+                                                               (top)
+                                                               (top)
+                                                               (top))
+                                                             #("i"
+                                                               "i"
+                                                               "i"
+                                                               "i"
+                                                               "i"
+                                                               "i"))
+                                                           #(ribcage
+                                                             ()
+                                                             ()
+                                                             ())
+                                                           #(ribcage
+                                                             #(x)
+                                                             #((top))
+                                                             #("i"))
+                                                           #(ribcage
+                                                             ((import-token
+                                                                .
+                                                                *top*))
+                                                             ()
+                                                             ())))
+                                                       g2218))
+                                           (list (cons g2216
+                                                       '(#(syntax-object
+                                                           x
+                                                           ((top)
+                                                            #(ribcage
+                                                              #(_
+                                                                id
+                                                                exp1
+                                                                var
+                                                                val
+                                                                exp2)
+                                                              #((top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top)
+                                                                (top))
+                                                              #("i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"
+                                                                "i"))
+                                                            #(ribcage
+                                                              ()
+                                                              ()
+                                                              ())
+                                                            #(ribcage
+                                                              #(x)
+                                                              #((top))
+                                                              #("i"))
+                                                            #(ribcage
+                                                              ((import-token
+                                                                 .
+                                                                 *top*))
+                                                              ()
+                                                              ())))
+                                                          #(syntax-object
+                                                            ...
+                                                            ((top)
+                                                             #(ribcage
+                                                               #(_
+                                                                 id
+                                                                 exp1
+                                                                 var
+                                                                 val
+                                                                 exp2)
+                                                               #((top)
+                                                                 (top)
+                                                                 (top)
+                                                                 (top)
+                                                                 (top)
+                                                                 (top))
+                                                               #("i"
+                                                                 "i"
+                                                                 "i"
+                                                                 "i"
+                                                                 "i"
+                                                                 "i"))
+                                                             #(ribcage
+                                                               ()
+                                                               ()
+                                                               ())
+                                                             #(ribcage
+                                                               #(x)
+                                                               #((top))
+                                                               #("i"))
+                                                             #(ribcage
+                                                               ((import-token
+                                                                  .
+                                                                  *top*))
+                                                               ()
+                                                               ())))))
+                                                 (list '#(syntax-object
+                                                          syntax
+                                                          ((top)
+                                                           #(ribcage
+                                                             #(_
+                                                               id
+                                                               exp1
+                                                               var
+                                                               val
+                                                               exp2)
+                                                             #((top)
+                                                               (top)
+                                                               (top)
+                                                               (top)
+                                                               (top)
+                                                               (top))
+                                                             #("i"
+                                                               "i"
+                                                               "i"
+                                                               "i"
+                                                               "i"
+                                                               "i"))
+                                                           #(ribcage
+                                                             ()
+                                                             ()
+                                                             ())
+                                                           #(ribcage
+                                                             #(x)
+                                                             #((top))
+                                                             #("i"))
+                                                           #(ribcage
+                                                             ((import-token
+                                                                .
+                                                                *top*))
+                                                             ()
+                                                             ())))
+                                                       (cons g2220
+                                                             '(#(syntax-object
+                                                                 x
+                                                                 ((top)
+                                                                  #(ribcage
+                                                                    #(_
+                                                                      id
+                                                                      exp1
+                                                                      var
+                                                                      val
+                                                                      exp2)
+                                                                    #((top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top)
+                                                                      (top))
+                                                                    #("i"
+                                                                      "i"
+                                                                      "i"
+                                                                      "i"
+                                                                      "i"
+                                                                      "i"))
+                                                                  #(ribcage
+                                                                    ()
+                                                                    ()
+                                                                    ())
+                                                                  #(ribcage
+                                                                    #(x)
+                                                                    #((top))
+                                                                    #("i"))
+                                                                  #(ribcage
+                                                                    ((import-token
+                                                                       .
+                                                                       *top*))
+                                                                    ()
+                                                                    ())))
+                                                                #(syntax-object
+                                                                  ...
+                                                                  ((top)
+                                                                   #(ribcage
+                                                                     #(_
+                                                                       id
+                                                                       exp1
+                                                                       var
+                                                                       val
+                                                                       exp2)
+                                                                     #((top)
+                                                                       (top)
+                                                                       (top)
+                                                                       (top)
+                                                                       (top)
+                                                                       (top))
+                                                                     #("i"
+                                                                       "i"
+                                                                       "i"
+                                                                       "i"
+                                                                       "i"
+                                                                       "i"))
+                                                                   #(ribcage
+                                                                     ()
+                                                                     ()
+                                                                     ())
+                                                                   #(ribcage
+                                                                     #(x)
+                                                                     #((top))
+                                                                     #("i"))
+                                                                   #(ribcage
+                                                                     ((import-token
+                                                                        .
+                                                                        *top*))
+                                                                     ()
+                                                                     ())))))))
+                                           (list g2216
+                                                 (list '#(syntax-object
+                                                          identifier?
+                                                          ((top)
+                                                           #(ribcage
+                                                             #(_
+                                                               id
+                                                               exp1
+                                                               var
+                                                               val
+                                                               exp2)
+                                                             #((top)
+                                                               (top)
+                                                               (top)
+                                                               (top)
+                                                               (top)
+                                                               (top))
+                                                             #("i"
+                                                               "i"
+                                                               "i"
+                                                               "i"
+                                                               "i"
+                                                               "i"))
+                                                           #(ribcage
+                                                             ()
+                                                             ()
+                                                             ())
+                                                           #(ribcage
+                                                             #(x)
+                                                             #((top))
+                                                             #("i"))
+                                                           #(ribcage
+                                                             ((import-token
+                                                                .
+                                                                *top*))
+                                                             ()
+                                                             ())))
+                                                       (list '#(syntax-object
+                                                                syntax
+                                                                ((top)
+                                                                 #(ribcage
+                                                                   #(_
+                                                                     id
+                                                                     exp1
+                                                                     var
+                                                                     val
+                                                                     exp2)
+                                                                   #((top)
+                                                                     (top)
+                                                                     (top)
+                                                                     (top)
+                                                                     (top)
+                                                                     (top))
+                                                                   #("i"
+                                                                     "i"
+                                                                     "i"
+                                                                     "i"
+                                                                     "i"
+                                                                     "i"))
+                                                                 #(ribcage
+                                                                   ()
+                                                                   ()
+                                                                   ())
+                                                                 #(ribcage
+                                                                   #(x)
+                                                                   #((top))
+                                                                   #("i"))
+                                                                 #(ribcage
+                                                                   ((import-token
+                                                                      .
+                                                                      *top*))
+                                                                   ()
+                                                                   ())))
+                                                             g2216))
+                                                 (list '#(syntax-object
+                                                          syntax
+                                                          ((top)
+                                                           #(ribcage
+                                                             #(_
+                                                               id
+                                                               exp1
+                                                               var
+                                                               val
+                                                               exp2)
+                                                             #((top)
+                                                               (top)
+                                                               (top)
+                                                               (top)
+                                                               (top)
+                                                               (top))
+                                                             #("i"
+                                                               "i"
+                                                               "i"
+                                                               "i"
+                                                               "i"
+                                                               "i"))
+                                                           #(ribcage
+                                                             ()
+                                                             ()
+                                                             ())
+                                                           #(ribcage
+                                                             #(x)
+                                                             #((top))
+                                                             #("i"))
+                                                           #(ribcage
+                                                             ((import-token
+                                                                .
+                                                                *top*))
+                                                             ()
+                                                             ())))
+                                                       g2220))))))
+                       g2209)
+                     (syntax-error g2205)))
+               ($syntax-dispatch
+                 g2205
+                 '(any (any any)
+                       ((#(free-id
+                           #(syntax-object
+                             set!
+                             ((top)
+                              #(ribcage () () ())
+                              #(ribcage #(x) #((top)) #("i"))
+                              #(ribcage ((import-token . *top*)) () ()))))
+                          any
+                          any)
+                        any))))))
+        ($syntax-dispatch g2205 '(any any))))
+     g2204)))
diff --git a/module/language/r5rs/psyntax.ss b/module/language/r5rs/psyntax.ss
new file mode 100644
index 000000000..c8ac3e503
--- /dev/null
+++ b/module/language/r5rs/psyntax.ss
@@ -0,0 +1,3202 @@
+;;; Portable implementation of syntax-case
+;;; Extracted from Chez Scheme Version 6.3
+;;; Authors: R. Kent Dybvig, Oscar Waddell, Bob Hieb, Carl Bruggeman
+
+;;; Copyright (c) 1992-2000 Cadence Research Systems
+;;; Permission to copy this software, in whole or in part, to use this
+;;; software for any lawful purpose, and to redistribute this software
+;;; is granted subject to the restriction that all copies made of this
+;;; software must include this copyright notice in full.  This software
+;;; is provided AS IS, with NO WARRANTY, EITHER EXPRESS OR IMPLIED,
+;;; INCLUDING BUT NOT LIMITED TO IMPLIED WARRANTIES OF MERCHANTABILITY
+;;; OR FITNESS FOR ANY PARTICULAR PURPOSE.  IN NO EVENT SHALL THE
+;;; AUTHORS BE LIABLE FOR CONSEQUENTIAL OR INCIDENTAL DAMAGES OF ANY
+;;; NATURE WHATSOEVER.
+
+;;; Before attempting to port this code to a new implementation of
+;;; Scheme, please read the notes below carefully.
+
+;;; This file defines the syntax-case expander, sc-expand, and a set
+;;; of associated syntactic forms and procedures.  Of these, the
+;;; following are documented in The Scheme Programming Language,
+;;; Second Edition (R. Kent Dybvig, Prentice Hall, 1996), which can be
+;;; found online at http://www.scheme.com.  Most are also documented
+;;; in the R4RS and draft R5RS.
+;;;
+;;;   bound-identifier=?
+;;;   datum->syntax-object
+;;;   define-syntax
+;;;   fluid-let-syntax
+;;;   free-identifier=?
+;;;   generate-temporaries
+;;;   identifier?
+;;;   identifier-syntax
+;;;   let-syntax
+;;;   letrec-syntax
+;;;   syntax
+;;;   syntax-case
+;;;   syntax-object->datum
+;;;   syntax-rules
+;;;   with-syntax
+;;;
+;;; All standard Scheme syntactic forms are supported by the expander
+;;; or syntactic abstractions defined in this file.  Only the R4RS
+;;; delay is omitted, since its expansion is implementation-dependent.
+
+;;; Also defined are three forms that support modules: module, import,
+;;; and import-only.  These are documented in the Chez Scheme User's
+;;; Guide (R. Kent Dybvig, Cadence Research Systems, 1998), which can
+;;; also be found online at http://www.scheme.com.  They are described
+;;; briefly here as well.
+;;;
+;;; Both are definitions and may appear where and only where other
+;;; definitions may appear.  modules may be named:
+;;;
+;;;   (module id (ex ...) defn ... init ...)
+;;;
+;;; or anonymous:
+;;;
+;;;   (module (ex ...) defn ... init ...)
+;;;
+;;; The latter form is semantically equivalent to:
+;;;
+;;;   (module T (ex ...) defn ... init ...)
+;;;   (import T)
+;;;
+;;; where T is a fresh identifier.
+;;;
+;;; In either form, each of the exports in (ex ...) is either an
+;;; identifier or of the form (id ex ...).  In the former case, the
+;;; single identifier ex is exported.  In the latter, the identifier
+;;; id is exported and the exports ex ... are "implicitly" exported.
+;;; This listing of implicit exports is useful only when id is a
+;;; keyword bound to a transformer that expands into references to
+;;; the listed implicit exports.  In the present implementation,
+;;; listing of implicit exports is necessary only for top-level
+;;; modules and allows the implementation to avoid placing all
+;;; identifiers into the top-level environment where subsequent passes
+;;; of the compiler will be unable to deal effectively with them.
+;;;
+;;; Named modules may be referenced in import statements, which
+;;; always take one of the forms:
+;;;
+;;;   (import id)
+;;;   (import-only id)
+;;;
+;;; id must name a module.  Each exported identifier becomes visible
+;;; within the scope of the import form.  In the case of import-only,
+;;; all other identifiers become invisible in the scope of the
+;;; import-only form, except for those established by definitions
+;;; that appear textually after the import-only form.
+
+;;; The remaining exports are listed below.  sc-expand, eval-when, and
+;;; syntax-error are described in the Chez Scheme User's Guide.
+;;;
+;;;   (sc-expand datum)
+;;;      if datum represents a valid expression, sc-expand returns an
+;;;      expanded version of datum in a core language that includes no
+;;;      syntactic abstractions.  The core language includes begin,
+;;;      define, if, lambda, letrec, quote, and set!.
+;;;   (eval-when situations expr ...)
+;;;      conditionally evaluates expr ... at compile-time or run-time
+;;;      depending upon situations
+;;;   (syntax-error object message)
+;;;      used to report errors found during expansion
+;;;   ($syntax-dispatch e p)
+;;;      used by expanded code to handle syntax-case matching
+;;;   ($sc-put-cte symbol val)
+;;;      used to establish top-level compile-time (expand-time) bindings.
+
+;;; The following nonstandard procedures must be provided by the
+;;; implementation for this code to run.
+;;;
+;;; (void)
+;;; returns the implementation's cannonical "unspecified value".  The
+;;; following usually works:
+;;;
+;;; (define void (lambda () (if #f #f))).
+;;;
+;;; (andmap proc list1 list2 ...)
+;;; returns true if proc returns true when applied to each element of list1
+;;; along with the corresponding elements of list2 ....  The following
+;;; definition works but does no error checking:
+;;;
+;;; (define andmap
+;;;   (lambda (f first . rest)
+;;;     (or (null? first)
+;;;         (if (null? rest)
+;;;             (let andmap ((first first))
+;;;               (let ((x (car first)) (first (cdr first)))
+;;;                 (if (null? first)
+;;;                     (f x)
+;;;                     (and (f x) (andmap first)))))
+;;;             (let andmap ((first first) (rest rest))
+;;;               (let ((x (car first))
+;;;                     (xr (map car rest))
+;;;                     (first (cdr first))
+;;;                     (rest (map cdr rest)))
+;;;                 (if (null? first)
+;;;                     (apply f (cons x xr))
+;;;                     (and (apply f (cons x xr)) (andmap first rest)))))))))
+;;;
+;;; (ormap proc list1)
+;;; returns the first non-false return result of proc applied to
+;;; the elements of list1 or false if none.  The following definition
+;;; works but does no error checking:
+;;;
+;;; (define ormap
+;;;   (lambda (proc list1)
+;;;     (and (not (null? list1))
+;;;          (or (proc (car list1)) (ormap proc (cdr list1))))))
+;;;
+;;; The following nonstandard procedures must also be provided by the
+;;; implementation for this code to run using the standard portable
+;;; hooks and output constructors.  They are not used by expanded code,
+;;; and so need be present only at expansion time.
+;;;
+;;; (eval x)
+;;; where x is always in the form ("noexpand" expr).
+;;; returns the value of expr.  the "noexpand" flag is used to tell the
+;;; evaluator/expander that no expansion is necessary, since expr has
+;;; already been fully expanded to core forms.
+;;;
+;;; eval will not be invoked during the loading of psyntax.pp.  After
+;;; psyntax.pp has been loaded, the expansion of any macro definition,
+;;; whether local or global, results in a call to eval.  If, however,
+;;; sc-expand has already been registered as the expander to be used
+;;; by eval, and eval accepts one argument, nothing special must be done
+;;; to support the "noexpand" flag, since it is handled by sc-expand.
+;;;
+;;; (error who format-string why what)
+;;; where who is either a symbol or #f, format-string is always "~a ~s",
+;;; why is always a string, and what may be any object.  error should
+;;; signal an error with a message something like
+;;;
+;;;    "error in <who>: <why> <what>"
+;;;
+;;; (gensym)
+;;; returns a unique symbol each time it's called.  In Chez Scheme, gensym
+;;; returns a symbol with a "globally" unique name so that gensyms that
+;;; end up in the object code of separately compiled files cannot conflict.
+;;; This is necessary only if you intend to support compiled files.
+;;;
+;;; (putprop symbol key value)
+;;; (getprop symbol key)
+;;; (remprop symbol key)
+;;; key is always a symbol; value may be any object.  putprop should
+;;; associate the given value with the given symbol and key in some way
+;;; that it can be retrieved later with getprop.  getprop should return
+;;; #f if no value is associated with the given symbol and key.  remprop
+;;; should remove the association between the given symbol and key.
+
+;;; When porting to a new Scheme implementation, you should define the
+;;; procedures listed above, load the expanded version of psyntax.ss
+;;; (psyntax.pp, which should be available whereever you found
+;;; psyntax.ss), and register sc-expand as the current expander (how
+;;; you do this depends upon your implementation of Scheme).  You may
+;;; change the hooks and constructors defined toward the beginning of
+;;; the code below, but to avoid bootstrapping problems, do so only
+;;; after you have a working version of the expander.
+
+;;; Chez Scheme allows the syntactic form (syntax <template>) to be
+;;; abbreviated to #'<template>, just as (quote <datum>) may be
+;;; abbreviated to '<datum>.  The #' syntax makes programs written
+;;; using syntax-case shorter and more readable and draws out the
+;;; intuitive connection between syntax and quote.  If you have access
+;;; to the source code of your Scheme system's reader, you might want
+;;; to implement this extension.
+
+;;; If you find that this code loads or runs slowly, consider
+;;; switching to faster hardware or a faster implementation of
+;;; Scheme.  In Chez Scheme on a 200Mhz Pentium Pro, expanding,
+;;; compiling (with full optimization), and loading this file takes
+;;; between one and two seconds.
+
+;;; In the expander implementation, we sometimes use syntactic abstractions
+;;; when procedural abstractions would suffice.  For example, we define
+;;; top-wrap and top-marked? as
+;;;   (define-syntax top-wrap (identifier-syntax '((top))))
+;;;   (define-syntax top-marked?
+;;;     (syntax-rules ()
+;;;       ((_ w) (memq 'top (wrap-marks w)))))
+;;; rather than
+;;;   (define top-wrap '((top)))
+;;;   (define top-marked?
+;;;     (lambda (w) (memq 'top (wrap-marks w))))
+;;; On ther other hand, we don't do this consistently; we define make-wrap,
+;;; wrap-marks, and wrap-subst simply as
+;;;   (define make-wrap cons)
+;;;   (define wrap-marks car)
+;;;   (define wrap-subst cdr)
+;;; In Chez Scheme, the syntactic and procedural forms of these
+;;; abstractions are equivalent, since the optimizer consistently
+;;; integrates constants and small procedures.  Some Scheme
+;;; implementations, however, may benefit from more consistent use 
+;;; of one form or the other.
+
+
+;;; Implementation notes:
+
+;;; "begin" is treated as a splicing construct at top level and at
+;;; the beginning of bodies.  Any sequence of expressions that would
+;;; be allowed where the "begin" occurs is allowed.
+
+;;; "let-syntax" and "letrec-syntax" are also treated as splicing
+;;; constructs, in violation of the R5RS.  A consequence is that let-syntax
+;;; and letrec-syntax do not create local contours, as do let and letrec.
+;;; Although the functionality is greater as it is presently implemented,
+;;; we will probably change it to conform to the R5RS.  modules provide
+;;; similar functionality to nonsplicing letrec-syntax when the latter is
+;;; used as a definition.
+
+;;; Objects with no standard print syntax, including objects containing
+;;; cycles and syntax objects, are allowed in quoted data as long as they
+;;; are contained within a syntax form or produced by datum->syntax-object.
+;;; Such objects are never copied.
+
+;;; When the expander encounters a reference to an identifier that has
+;;; no global or lexical binding, it treats it as a global-variable
+;;; reference.  This allows one to write mutually recursive top-level
+;;; definitions, e.g.:
+;;;   
+;;;   (define f (lambda (x) (g x)))
+;;;   (define g (lambda (x) (f x)))
+;;;
+;;; but may not always yield the intended when the variable in question
+;;; is later defined as a keyword.
+
+;;; Top-level variable definitions of syntax keywords are permitted.
+;;; In order to make this work, top-level define not only produces a
+;;; top-level definition in the core language, but also modifies the
+;;; compile-time environment (using $sc-put-cte) to record the fact
+;;; that the identifier is a variable.
+
+;;; Top-level definitions of macro-introduced identifiers are visible
+;;; only in code produced by the macro.  That is, a binding for a
+;;; hidden (generated) identifier is created instead, and subsequent
+;;; references within the macro output are renamed accordingly.  For
+;;; example:
+;;;
+;;; (define-syntax a
+;;;   (syntax-rules ()
+;;;     ((_ var exp)
+;;;      (begin
+;;;        (define secret exp)
+;;;        (define var
+;;;          (lambda ()
+;;;            (set! secret (+ secret 17))
+;;;            secret))))))
+;;; (a x 0)
+;;; (x) => 17
+;;; (x) => 34
+;;; secret => Error: variable secret is not bound
+;;;
+;;; The definition above would fail if the definition for secret
+;;; were placed after the definition for var, since the expander would
+;;; encounter the references to secret before the definition that
+;;; establishes the compile-time map from the identifier secret to
+;;; the generated identifier.
+
+;;; Identifiers and syntax objects are implemented as vectors for
+;;; portability.  As a result, it is possible to "forge" syntax
+;;; objects.
+
+;;; The input to sc-expand may contain "annotations" describing, e.g., the
+;;; source file and character position from where each object was read if
+;;; it was read from a file.  These annotations are handled properly by
+;;; sc-expand only if the annotation? hook (see hooks below) is implemented
+;;; properly and the operators make-annotation, annotation-expression,
+;;; annotation-source, annotation-stripped, and set-annotation-stripped!
+;;; are supplied.  If annotations are supplied, the proper annotation
+;;; source is passed to the various output constructors, allowing
+;;; implementations to accurately correlate source and expanded code.
+;;; Contact one of the authors for details if you wish to make use of
+;;; this feature.
+
+;;; Implementation of modules:
+;;;
+;;; The implementation of modules requires that implicit top-level exports
+;;; be listed with the exported macro at some level where both are visible,
+;;; e.g.,
+;;;
+;;;   (module M (alpha (beta b))
+;;;     (module ((alpha a) b)
+;;;       (define-syntax alpha (identifier-syntax a))
+;;;       (define a 'a)
+;;;       (define b 'b))
+;;;     (define-syntax beta (identifier-syntax b)))
+;;;
+;;; Listing of implicit imports is not needed for macros that do not make
+;;; it out to top level, including all macros that are local to a "body".
+;;; (They may be listed in this case, however.)  We need this information
+;;; for top-level modules since a top-level module expands into a letrec
+;;; for non-top-level variables and top-level definitions (assignments) for
+;;; top-level variables.  Because of the general nature of macro
+;;; transformers, we cannot determine the set of implicit exports from the
+;;; transformer code, so without the user's help, we'd have to put all
+;;; variables at top level.
+;;; 
+;;; Each such top-level identifier is given a generated name (gensym).
+;;; When a top-level module is imported at top level, a compile-time
+;;; alias is established from the top-level name to the generated name.
+;;; The expander follows these aliases transparently.  When any module is
+;;; imported anywhere other than at top level, the id-var-name of the
+;;; import identifier is set to the id-var-name of the export identifier.
+;;; Since we can't determine the actual labels for identifiers defined in
+;;; top-level modules until we determine which are placed in the letrec
+;;; and which make it to top level, we give each an "indirect" label---a
+;;; pair whose car will eventually contain the actual label.  Import does
+;;; not follow the indirect, but id-var-name does.
+;;;
+;;; All identifiers defined within a local module are folded into the
+;;; letrec created for the enclosing body.  Visibility is controlled in
+;;; this case and for nested top-level modules by introducing a new wrap
+;;; for each module.
+
+
+;;; Bootstrapping:
+
+;;; When changing syntax-object representations, it is necessary to support
+;;; both old and new syntax-object representations in id-var-name.  It
+;;; should be sufficient to recognize old representations and treat
+;;; them as not lexically bound.
+
+
+(let ()
+
+(define-syntax when
+  (syntax-rules ()
+    ((_ test e1 e2 ...) (if test (begin e1 e2 ...)))))
+(define-syntax unless
+  (syntax-rules ()
+    ((_ test e1 e2 ...) (when (not test) (begin e1 e2 ...)))))
+(define-syntax define-structure
+  (lambda (x)
+    (define construct-name
+      (lambda (template-identifier . args)
+        (datum->syntax-object
+          template-identifier
+          (string->symbol
+            (apply string-append
+                   (map (lambda (x)
+                          (if (string? x)
+                              x
+                              (symbol->string (syntax-object->datum x))))
+                        args))))))
+    (syntax-case x ()
+      ((_ (name id1 ...))
+       (andmap identifier? (syntax (name id1 ...)))
+       (with-syntax
+         ((constructor (construct-name (syntax name) "make-" (syntax name)))
+          (predicate (construct-name (syntax name) (syntax name) "?"))
+          ((access ...)
+           (map (lambda (x) (construct-name x (syntax name) "-" x))
+                (syntax (id1 ...))))
+          ((assign ...)
+           (map (lambda (x)
+                  (construct-name x "set-" (syntax name) "-" x "!"))
+                (syntax (id1 ...))))
+          (structure-length
+           (+ (length (syntax (id1 ...))) 1))
+          ((index ...)
+           (let f ((i 1) (ids (syntax (id1 ...))))
+              (if (null? ids)
+                  '()
+                  (cons i (f (+ i 1) (cdr ids)))))))
+         (syntax (begin
+                   (define constructor
+                     (lambda (id1 ...)
+                       (vector 'name id1 ... )))
+                   (define predicate
+                     (lambda (x)
+                       (and (vector? x)
+                            (= (vector-length x) structure-length)
+                            (eq? (vector-ref x 0) 'name))))
+                   (define access
+                     (lambda (x)
+                       (vector-ref x index)))
+                   ...
+                   (define assign
+                     (lambda (x update)
+                       (vector-set! x index update)))
+                   ...)))))))
+
+(define noexpand "noexpand")
+
+;;; hooks to nonportable run-time helpers
+(begin
+(define-syntax fx+ (identifier-syntax +))
+(define-syntax fx- (identifier-syntax -))
+(define-syntax fx= (identifier-syntax =))
+(define-syntax fx< (identifier-syntax <))
+
+(define annotation? (lambda (x) #f))
+
+(define top-level-eval-hook
+  (lambda (x)
+    (eval `(,noexpand ,x))))
+
+(define local-eval-hook
+  (lambda (x)
+    (eval `(,noexpand ,x))))
+
+(define error-hook
+  (lambda (who why what)
+    (error who "~a ~s" why what)))
+
+(define-syntax gensym-hook
+  (syntax-rules ()
+    ((_) (gensym))))
+
+(define put-global-definition-hook
+  (lambda (symbol val)
+    ($sc-put-cte symbol val)))
+
+(define get-global-definition-hook
+  (lambda (symbol)
+    (getprop symbol '*sc-expander*)))
+
+(define get-import-binding
+  (lambda (symbol token)
+    (getprop symbol token)))
+
+(define generate-id
+  (let ((b (- 127 32 2)))
+   ; session-key should generate a unique integer for each system run
+   ; to support separate compilation
+    (define session-key (lambda () 0))
+    (define make-digit (lambda (x) (integer->char (fx+ x 33))))
+    (define fmt
+      (lambda (n)
+        (let fmt ((n n) (a '()))
+          (if (< n b)
+              (list->string (cons (make-digit n) a))
+              (let ((r (modulo n b)) (rest (quotient n b)))
+                (fmt rest (cons (make-digit r) a)))))))
+    (let ((prefix (fmt (session-key))) (n -1))
+      (lambda (name)
+        (set! n (+ n 1))
+        (let ((newsym (string->symbol (string-append "#" prefix (fmt n)))))
+          newsym)))))
+)
+
+
+;;; output constructors
+(begin
+(define-syntax build-application
+  (syntax-rules ()
+    ((_ source fun-exp arg-exps)
+     `(,fun-exp . ,arg-exps))))
+
+(define-syntax build-conditional
+  (syntax-rules ()
+    ((_ source test-exp then-exp else-exp)
+     `(if ,test-exp ,then-exp ,else-exp))))
+
+(define-syntax build-lexical-reference
+  (syntax-rules ()
+    ((_ type source var)
+     var)))
+
+(define-syntax build-lexical-assignment
+  (syntax-rules ()
+    ((_ source var exp)
+     `(set! ,var ,exp))))
+
+(define-syntax build-global-reference
+  (syntax-rules ()
+    ((_ source var)
+     var)))
+
+(define-syntax build-global-assignment
+  (syntax-rules ()
+    ((_ source var exp)
+     `(set! ,var ,exp))))
+
+(define-syntax build-global-definition
+  (syntax-rules ()
+    ((_ source var exp)
+     `(define ,var ,exp))))
+
+(define-syntax build-module-definition
+ ; should have the effect of a global definition but may not appear at top level
+  (identifier-syntax build-global-assignment))
+
+(define-syntax build-cte-install
+ ; should build a call that has the same effect as calling the
+ ; global definition hook
+  (syntax-rules ()
+    ((_ sym exp) `($sc-put-cte ',sym ,exp))))
+ 
+(define-syntax build-lambda
+  (syntax-rules ()
+    ((_ src vars exp)
+     `(lambda ,vars ,exp))))
+
+(define-syntax build-primref
+  (syntax-rules ()
+    ((_ src name) name)
+    ((_ src level name) name)))
+
+(define-syntax build-data
+  (syntax-rules ()
+    ((_ src exp) `',exp)))
+
+(define build-sequence
+  (lambda (src exps)
+    (if (null? (cdr exps))
+        (car exps)
+        `(begin ,@exps))))
+
+(define build-letrec
+  (lambda (src vars val-exps body-exp)
+    (if (null? vars)
+        body-exp
+        `(letrec ,(map list vars val-exps) ,body-exp))))
+
+(define-syntax build-lexical-var
+  (syntax-rules ()
+    ((_ src id) (gensym))))
+
+(define-syntax self-evaluating?
+  (syntax-rules ()
+    ((_ e)
+     (let ((x e))
+       (or (boolean? x) (number? x) (string? x) (char? x) (null? x))))))
+)
+
+(define-structure (syntax-object expression wrap))
+
+(define-syntax unannotate
+  (syntax-rules ()
+    ((_ x)
+     (let ((e x))
+       (if (annotation? e)
+           (annotation-expression e)
+           e)))))
+
+(define-syntax no-source (identifier-syntax #f))
+
+(define source-annotation
+  (lambda (x)
+     (cond
+       ((annotation? x) (annotation-source x))
+       ((syntax-object? x) (source-annotation (syntax-object-expression x)))
+       (else no-source))))
+
+(define-syntax arg-check
+  (syntax-rules ()
+    ((_ pred? e who)
+     (let ((x e))
+       (if (not (pred? x)) (error-hook who "invalid argument" x))))))
+
+;;; compile-time environments
+
+;;; wrap and environment comprise two level mapping.
+;;;   wrap : id --> label
+;;;   env : label --> <element>
+
+;;; environments are represented in two parts: a lexical part and a global
+;;; part.  The lexical part is a simple list of associations from labels
+;;; to bindings.  The global part is implemented by
+;;; {put,get}-global-definition-hook and associates symbols with
+;;; bindings.
+
+;;; global (assumed global variable) and displaced-lexical (see below)
+;;; do not show up in any environment; instead, they are fabricated by
+;;; lookup when it finds no other bindings.
+
+;;; <environment>              ::= ((<label> . <binding>)*)
+
+;;; identifier bindings include a type and a value
+
+;;; <binding> ::= (macro . <procedure>)           macros
+;;;               (deferred . <expanded code>)    lazy-evaluation of transformers
+;;;               (core . <procedure>)            core forms
+;;;               (begin)                         begin
+;;;               (define)                        define
+;;;               (define-syntax)                 define-syntax
+;;;               (local-syntax . rec?)           let-syntax/letrec-syntax
+;;;               (eval-when)                     eval-when
+;;;               (syntax . (<var> . <level>))    pattern variables
+;;;               (global . <symbol>)             assumed global variable
+;;;               (lexical . <var>)               lexical variables
+;;;               (displaced-lexical . #f)        id-var-name not found in store
+;;; <level>   ::= <nonnegative integer>
+;;; <var>     ::= variable returned by build-lexical-var
+
+;;; a macro is a user-defined syntactic-form.  a core is a system-defined
+;;; syntactic form.  begin, define, define-syntax, and eval-when are
+;;; treated specially since they are sensitive to whether the form is
+;;; at top-level and (except for eval-when) can denote valid internal
+;;; definitions.
+
+;;; a pattern variable is a variable introduced by syntax-case and can
+;;; be referenced only within a syntax form.
+
+;;; any identifier for which no top-level syntax definition or local
+;;; binding of any kind has been seen is assumed to be a global
+;;; variable.
+
+;;; a lexical variable is a lambda- or letrec-bound variable.
+
+;;; a displaced-lexical identifier is a lexical identifier removed from
+;;; it's scope by the return of a syntax object containing the identifier.
+;;; a displaced lexical can also appear when a letrec-syntax-bound
+;;; keyword is referenced on the rhs of one of the letrec-syntax clauses.
+;;; a displaced lexical should never occur with properly written macros.
+
+(define make-binding (lambda (x y) (cons x y)))
+(define binding-type car)
+(define binding-value cdr)
+(define set-binding-type! set-car!)
+(define set-binding-value! set-cdr!)
+(define binding? (lambda (x) (and (pair? x) (symbol? (car x)))))
+
+(define-syntax null-env (identifier-syntax '()))
+
+(define extend-env
+  (lambda (label binding r)
+    (cons (cons label binding) r)))
+
+(define extend-env*
+  (lambda (labels bindings r) 
+    (if (null? labels)
+        r
+        (extend-env* (cdr labels) (cdr bindings)
+          (extend-env (car labels) (car bindings) r)))))
+
+(define extend-var-env*
+  ; variant of extend-env* that forms "lexical" binding
+  (lambda (labels vars r)
+    (if (null? labels)
+        r
+        (extend-var-env* (cdr labels) (cdr vars)
+          (extend-env (car labels) (make-binding 'lexical (car vars)) r)))))
+
+;;; we use a "macros only" environment in expansion of local macro
+;;; definitions so that their definitions can use local macros without
+;;; attempting to use other lexical identifiers.
+;;;
+;;; - can make this null-env if we don't want to allow macros to use other
+;;;   macros in defining their transformers
+;;; - can add a cache here if it pays off
+(define transformer-env
+  (lambda (r)
+    (if (null? r)
+        '()
+        (let ((a (car r)))
+          (if (eq? (cadr a) 'lexical)       ; only strip out lexical so that (transformer x) works
+              (transformer-env (cdr r))
+              (cons a (transformer-env (cdr r))))))))
+
+(define displaced-lexical-error
+  (lambda (id)
+    (syntax-error id
+      (if (id-var-name id empty-wrap)
+          "identifier out of context"
+          "identifier not visible"))))
+
+(define lookup*
+  ; x may be a label or a symbol
+  ; although symbols are usually global, we check the environment first
+  ; anyway because a temporary binding may have been established by
+  ; fluid-let-syntax
+  (lambda (x r)
+    (cond
+      ((assq x r) => cdr)
+      ((symbol? x)
+       (or (get-global-definition-hook x) (make-binding 'global x)))
+      (else (make-binding 'displaced-lexical #f)))))
+
+(define sanitize-binding
+  (lambda (b)
+    (cond
+      ((procedure? b) (make-binding 'macro b))
+      ((binding? b)
+       (case (binding-type b)
+         ((core macro macro!) (and (procedure? (binding-value b)) b))
+         ((module) (and (interface? (binding-value b)) b))
+         (else b)))
+      (else #f))))
+
+(define lookup
+  (lambda (x r)
+    (define whack-binding!
+      (lambda (b *b)
+        (set-binding-type! b (binding-type *b))
+        (set-binding-value! b (binding-value *b))))
+    (let ((b (lookup* x r)))
+      (case (binding-type b)
+;        ((*alias) (lookup (id-var-name (binding-value b) empty-wrap) r))
+        ((deferred)
+         (whack-binding! b
+           (let ((*b (local-eval-hook (binding-value b))))
+             (or (sanitize-binding *b)
+                 (syntax-error *b "invalid transformer"))))
+         (case (binding-type b)
+;           ((*alias) (lookup (id-var-name (binding-value b) empty-wrap) r))
+           (else b)))
+        (else b)))))
+
+(define global-extend
+  (lambda (type sym val)
+    (put-global-definition-hook sym (make-binding type val))))
+
+
+;;; Conceptually, identifiers are always syntax objects.  Internally,
+;;; however, the wrap is sometimes maintained separately (a source of
+;;; efficiency and confusion), so that symbols are also considered
+;;; identifiers by id?.  Externally, they are always wrapped.
+
+(define nonsymbol-id?
+  (lambda (x)
+    (and (syntax-object? x)
+         (symbol? (unannotate (syntax-object-expression x))))))
+
+(define id?
+  (lambda (x)
+    (cond
+      ((symbol? x) #t)
+      ((syntax-object? x) (symbol? (unannotate (syntax-object-expression x))))
+      ((annotation? x) (symbol? (annotation-expression x)))
+      (else #f))))
+
+(define-syntax id-sym-name
+  (syntax-rules ()
+    ((_ e)
+     (let ((x e))
+       (unannotate (if (syntax-object? x) (syntax-object-expression x) x))))))
+
+(define id-sym-name&marks
+  (lambda (x w)
+    (if (syntax-object? x)
+        (values
+          (unannotate (syntax-object-expression x))
+          (join-marks (wrap-marks w) (wrap-marks (syntax-object-wrap x))))
+        (values (unannotate x) (wrap-marks w)))))
+
+;;; syntax object wraps
+
+;;;         <wrap> ::= ((<mark> ...) . (<subst> ...))
+;;;        <subst> ::= <ribcage> | <shift>
+;;;      <ribcage> ::= #((<ex-symname> ...) (<mark> ...) (<label> ...)) ; extensible, for chi-internal/external
+;;;                  | #(#(<symname> ...) #(<mark> ...) #(<label> ...)) ; nonextensible
+;;;   <ex-symname> ::= <symname> | <import token> | <barrier>
+;;;        <shift> ::= shift
+;;;      <barrier> ::= #f                                               ; inserted by import-only
+;;; <import token> ::= #<"import-token" <token>>
+;;;        <token> ::= <generated id>
+
+(define make-wrap cons)
+(define wrap-marks car)
+(define wrap-subst cdr)
+
+(define-syntax subst-rename? (identifier-syntax vector?))
+(define-syntax rename-old (syntax-rules () ((_ x) (vector-ref x 0))))
+(define-syntax rename-new (syntax-rules () ((_ x) (vector-ref x 1))))
+(define-syntax rename-marks (syntax-rules () ((_ x) (vector-ref x 2))))
+(define-syntax make-rename
+  (syntax-rules ()
+    ((_ old new marks) (vector old new marks))))
+
+;;; labels
+
+;;; simple labels must be comparable with "eq?" and distinct from symbols
+;;; and pairs.
+
+;;; indirect labels, which are implemented as pairs, are used to support
+;;; import aliasing for identifiers exported (explictly or implicitly) from
+;;; top-level modules.  chi-external creates an indirect label for each
+;;; defined identifier, import causes the pair to be shared aliases it
+;;; establishes, and chi-top-module whacks the pair to hold the top-level
+;;; identifier name (symbol) if the id is to be placed at top level, before
+;;; expanding the right-hand sides of the definitions in the module.
+
+(define gen-label
+  (lambda () (string #\i)))
+(define label?
+  (lambda (x)
+    (or (string? x) ; normal lexical labels
+        (symbol? x) ; global labels (symbolic names)
+        (indirect-label? x))))
+
+(define gen-labels
+  (lambda (ls)
+    (if (null? ls)
+        '()
+        (cons (gen-label) (gen-labels (cdr ls))))))
+
+(define gen-indirect-label
+  (lambda () (list (gen-label))))
+
+(define indirect-label? pair?)
+(define get-indirect-label car)
+(define set-indirect-label! set-car!)
+
+(define-structure (ribcage symnames marks labels))
+(define-syntax empty-wrap (identifier-syntax '(())))
+
+(define-syntax top-wrap (identifier-syntax '((top))))
+
+(define-syntax top-marked?
+  (syntax-rules ()
+    ((_ w) (memq 'top (wrap-marks w)))))
+
+(define-syntax only-top-marked?
+  (syntax-rules ()
+    ((_ id) (same-marks? (wrap-marks (syntax-object-wrap id)) (wrap-marks top-wrap)))))
+
+;;; Marks must be comparable with "eq?" and distinct from pairs and
+;;; the symbol top.  We do not use integers so that marks will remain
+;;; unique even across file compiles.
+
+(define-syntax the-anti-mark (identifier-syntax #f))
+
+(define anti-mark
+  (lambda (w)
+    (make-wrap (cons the-anti-mark (wrap-marks w))
+               (cons 'shift (wrap-subst w)))))
+
+(define-syntax new-mark
+  (syntax-rules ()
+    ((_) (string #\m))))
+
+(define barrier-marker #f)
+(module (make-import-token import-token? import-token-key)
+  (define tag 'import-token)
+  (define make-import-token (lambda (x) (cons tag x)))
+  (define import-token? (lambda (x) (and (pair? x) (eq? (car x) tag))))
+  (define import-token-key cdr))
+
+;;; make-empty-ribcage and extend-ribcage maintain list-based ribcages for
+;;; internal definitions, in which the ribcages are built incrementally
+(define-syntax make-empty-ribcage
+  (syntax-rules ()
+    ((_) (make-ribcage '() '() '()))))
+
+(define extend-ribcage!
+ ; must receive ids with complete wraps
+ ; ribcage guaranteed to be list-based
+  (lambda (ribcage id label)
+    (set-ribcage-symnames! ribcage
+      (cons (unannotate (syntax-object-expression id))
+            (ribcage-symnames ribcage)))
+    (set-ribcage-marks! ribcage
+      (cons (wrap-marks (syntax-object-wrap id))
+            (ribcage-marks ribcage)))
+    (set-ribcage-labels! ribcage
+      (cons label (ribcage-labels ribcage)))))
+
+(define extend-ribcage-barrier!
+ ; must receive ids with complete wraps
+ ; ribcage guaranteed to be list-based
+  (lambda (ribcage killer-id)
+    (extend-ribcage-barrier-help! ribcage (syntax-object-wrap killer-id))))
+
+(define extend-ribcage-barrier-help!
+  (lambda (ribcage wrap)
+    (set-ribcage-symnames! ribcage
+      (cons barrier-marker (ribcage-symnames ribcage)))
+    (set-ribcage-marks! ribcage
+      (cons (wrap-marks wrap) (ribcage-marks ribcage)))))
+
+(define extend-ribcage-subst!
+ ; ribcage guaranteed to be list-based
+  (lambda (ribcage token)
+    (set-ribcage-symnames! ribcage
+      (cons (make-import-token token) (ribcage-symnames ribcage)))))
+
+(define lookup-import-binding-name
+  (lambda (sym key marks)
+    (let ((new (get-import-binding sym key)))
+      (and new
+           (let f ((new new))
+             (cond
+               ((pair? new) (or (f (car new)) (f (cdr new))))
+               ((same-marks? marks (wrap-marks (syntax-object-wrap new))) new)
+               (else #f)))))))
+
+;;; make-binding-wrap creates vector-based ribcages
+(define make-binding-wrap
+  (lambda (ids labels w)
+    (if (null? ids)
+        w
+        (make-wrap
+          (wrap-marks w)
+          (cons
+            (let ((labelvec (list->vector labels)))
+              (let ((n (vector-length labelvec)))
+                (let ((symnamevec (make-vector n)) (marksvec (make-vector n)))
+                  (let f ((ids ids) (i 0))
+                    (if (not (null? ids))
+                        (call-with-values
+                          (lambda () (id-sym-name&marks (car ids) w))
+                          (lambda (symname marks)
+                            (vector-set! symnamevec i symname)
+                            (vector-set! marksvec i marks)
+                            (f (cdr ids) (fx+ i 1))))))
+                  (make-ribcage symnamevec marksvec labelvec))))
+            (wrap-subst w))))))
+
+;;; make-trimmed-syntax-object is used by make-resolved-interface to support
+;;; creation of module export lists whose constituent ids do not contain
+;;; unnecessary substitutions or marks.
+(define make-trimmed-syntax-object
+  (lambda (id)
+    (call-with-values
+      (lambda () (id-var-name&marks id empty-wrap))
+      (lambda (tosym marks)
+        (unless tosym
+          (syntax-error id "identifier not visible for export"))
+        (let ((fromsym (id-sym-name id)))
+          (make-syntax-object fromsym
+            (make-wrap marks
+              (list (make-ribcage (vector fromsym) (vector marks) (vector tosym))))))))))
+
+;;; Scheme's append should not copy the first argument if the second is
+;;; nil, but it does, so we define a smart version here.
+(define smart-append
+  (lambda (m1 m2)
+    (if (null? m2)
+        m1
+        (append m1 m2))))
+
+(define join-wraps
+  (lambda (w1 w2)
+    (let ((m1 (wrap-marks w1)) (s1 (wrap-subst w1)))
+      (if (null? m1)
+          (if (null? s1)
+              w2
+              (make-wrap
+                (wrap-marks w2)
+                (smart-append s1 (wrap-subst w2))))
+          (make-wrap
+            (smart-append m1 (wrap-marks w2))
+            (smart-append s1 (wrap-subst w2)))))))
+
+(define join-marks
+  (lambda (m1 m2)
+    (smart-append m1 m2)))
+
+(define same-marks?
+  (lambda (x y)
+    (or (eq? x y)
+        (and (not (null? x))
+             (not (null? y))
+             (eq? (car x) (car y))
+             (same-marks? (cdr x) (cdr y))))))
+
+(define id-var-name-loc&marks
+  (lambda (id w)
+    (define search
+      (lambda (sym subst marks)
+        (if (null? subst)
+            (values sym marks)
+            (let ((fst (car subst)))
+              (if (eq? fst 'shift)
+                  (search sym (cdr subst) (cdr marks))
+                  (let ((symnames (ribcage-symnames fst)))
+                    (if (vector? symnames)
+                        (search-vector-rib sym subst marks symnames fst)
+                        (search-list-rib sym subst marks symnames fst))))))))
+    (define search-list-rib
+      (lambda (sym subst marks symnames ribcage)
+        (let f ((symnames symnames) (i 0))
+          (cond
+            ((null? symnames) (search sym (cdr subst) marks))
+            ((and (eq? (car symnames) sym)
+                  (same-marks? marks (list-ref (ribcage-marks ribcage) i)))
+             (values (list-ref (ribcage-labels ribcage) i) marks))
+            ((import-token? (car symnames))
+             (cond
+               ((lookup-import-binding-name sym (import-token-key (car symnames)) marks) =>
+                (lambda (id)
+                  (if (symbol? id)
+                      (values id marks)
+                      (id-var-name&marks id empty-wrap))))   ; could be more efficient:  new is a resolved id
+               (else (f (cdr symnames) i))))
+            ((and (eq? (car symnames) barrier-marker)
+                  (same-marks? marks (list-ref (ribcage-marks ribcage) i)))
+             (values #f marks))
+            (else (f (cdr symnames) (fx+ i 1)))))))
+    (define search-vector-rib
+      (lambda (sym subst marks symnames ribcage)
+        (let ((n (vector-length symnames)))
+          (let f ((i 0))
+            (cond
+              ((fx= i n) (search sym (cdr subst) marks))
+              ((and (eq? (vector-ref symnames i) sym)
+                    (same-marks? marks (vector-ref (ribcage-marks ribcage) i)))
+               (values (vector-ref (ribcage-labels ribcage) i) marks))
+              (else (f (fx+ i 1))))))))
+    (cond
+      ((symbol? id) (search id (wrap-subst w) (wrap-marks w)))
+      ((syntax-object? id)
+       (let ((sym (unannotate (syntax-object-expression id)))
+             (w1 (syntax-object-wrap id)))
+         (let ((marks (join-marks (wrap-marks w) (wrap-marks w1))))
+           (call-with-values (lambda () (search sym (wrap-subst w) marks))
+             (lambda (new-id marks)
+               (if (eq? new-id sym)
+                   (search sym (wrap-subst w1) marks)
+                   (values new-id marks)))))))
+      ((annotation? id) (search (unannotate id) (wrap-subst w) (wrap-marks w)))
+      (else (error-hook 'id-var-name "invalid id" id)))))
+
+(define id-var-name&marks
+ ; this version follows indirect labels
+  (lambda (id w)
+    (call-with-values
+      (lambda () (id-var-name-loc&marks id w))
+      (lambda (label marks)
+        (values (if (indirect-label? label) (get-indirect-label label) label) marks)))))
+
+(define id-var-name-loc
+ ; this version doesn't follow indirect labels
+  (lambda (id w)
+    (call-with-values
+      (lambda () (id-var-name-loc&marks id w))
+      (lambda (label marks) label))))
+
+(define id-var-name
+ ; this version follows indirect labels
+  (lambda (id w)
+    (call-with-values
+      (lambda () (id-var-name-loc&marks id w))
+      (lambda (label marks)
+        (if (indirect-label? label) (get-indirect-label label) label)))))
+
+;;; free-id=? must be passed fully wrapped ids since (free-id=? x y)
+;;; may be true even if (free-id=? (wrap x w) (wrap y w)) is not.
+
+(define free-id=?
+  (lambda (i j)
+    (and (eq? (id-sym-name i) (id-sym-name j)) ; accelerator
+         (eq? (id-var-name i empty-wrap) (id-var-name j empty-wrap)))))
+
+(define-syntax literal-id=? (identifier-syntax free-id=?))
+
+;;; bound-id=? may be passed unwrapped (or partially wrapped) ids as
+;;; long as the missing portion of the wrap is common to both of the ids
+;;; since (bound-id=? x y) iff (bound-id=? (wrap x w) (wrap y w))
+
+(define bound-id=?
+  (lambda (i j)
+    (if (and (syntax-object? i) (syntax-object? j))
+        (and (eq? (unannotate (syntax-object-expression i))
+                  (unannotate (syntax-object-expression j)))
+             (same-marks? (wrap-marks (syntax-object-wrap i))
+                  (wrap-marks (syntax-object-wrap j))))
+        (eq? (unannotate i) (unannotate j)))))
+
+;;; "valid-bound-ids?" returns #t if it receives a list of distinct ids.
+;;; valid-bound-ids? may be passed unwrapped (or partially wrapped) ids
+;;; as long as the missing portion of the wrap is common to all of the
+;;; ids.
+
+(define valid-bound-ids?
+  (lambda (ids)
+     (and (let all-ids? ((ids ids))
+            (or (null? ids)
+                (and (id? (car ids))
+                     (all-ids? (cdr ids)))))
+          (distinct-bound-ids? ids))))
+
+;;; distinct-bound-ids? expects a list of ids and returns #t if there are
+;;; no duplicates.  It is quadratic on the length of the id list; long
+;;; lists could be sorted to make it more efficient.  distinct-bound-ids?
+;;; may be passed unwrapped (or partially wrapped) ids as long as the
+;;; missing portion of the wrap is common to all of the ids.
+
+(define distinct-bound-ids?
+  (lambda (ids)
+    (let distinct? ((ids ids))
+      (or (null? ids)
+          (and (not (bound-id-member? (car ids) (cdr ids)))
+               (distinct? (cdr ids)))))))
+
+(define invalid-ids-error
+ ; find first bad one and complain about it
+  (lambda (ids exp class)
+    (let find ((ids ids) (gooduns '()))
+      (if (null? ids)
+          (syntax-error exp) ; shouldn't happen
+          (if (id? (car ids))
+              (if (bound-id-member? (car ids) gooduns)
+                  (syntax-error (car ids) "duplicate " class)
+                  (find (cdr ids) (cons (car ids) gooduns)))
+              (syntax-error (car ids) "invalid " class))))))
+
+(define bound-id-member?
+   (lambda (x list)
+      (and (not (null? list))
+           (or (bound-id=? x (car list))
+               (bound-id-member? x (cdr list))))))
+
+;;; wrapping expressions and identifiers
+
+(define wrap
+  (lambda (x w)
+    (cond
+      ((and (null? (wrap-marks w)) (null? (wrap-subst w))) x)
+      ((syntax-object? x)
+       (make-syntax-object
+         (syntax-object-expression x)
+         (join-wraps w (syntax-object-wrap x))))
+      ((null? x) x)
+      (else (make-syntax-object x w)))))
+
+(define source-wrap
+  (lambda (x w s)
+    (wrap (if s (make-annotation x s #f) x) w)))
+
+;;; expanding
+
+(define chi-sequence
+  (lambda (body r w s)
+    (build-sequence s
+      (let dobody ((body body) (r r) (w w))
+        (if (null? body)
+            '()
+            (let ((first (chi (car body) r w)))
+              (cons first (dobody (cdr body) r w))))))))
+
+(define chi-top-sequence
+  (lambda (body r w s m esew ribcage)
+    (build-sequence s
+      (let dobody ((body body) (r r) (w w) (m m) (esew esew))
+        (if (null? body)
+            '()
+            (let ((first (chi-top (car body) r w m esew ribcage)))
+              (cons first (dobody (cdr body) r w m esew))))))))
+
+(define chi-when-list
+  (lambda (e when-list w)
+    ; when-list is syntax'd version of list of situations
+    (let f ((when-list when-list) (situations '()))
+      (if (null? when-list)
+          situations
+          (f (cdr when-list)
+             (cons (let ((x (car when-list)))
+                     (cond
+                       ((literal-id=? x (syntax compile)) 'compile)
+                       ((literal-id=? x (syntax load)) 'load)
+                       ((literal-id=? x (syntax eval)) 'eval)
+                       (else (syntax-error (wrap x w)
+                               "invalid eval-when situation"))))
+                   situations))))))
+
+;;; syntax-type returns five values: type, value, e, w, and s.  The first
+;;; two are described in the table below.
+;;;
+;;;    type                   value         explanation
+;;;    -------------------------------------------------------------------
+;;;    begin                  none          begin keyword
+;;;    begin-form             none          begin expression
+;;;    call                   none          any other call
+;;;    constant               none          self-evaluating datum
+;;;    core                   procedure     core form (including singleton)
+;;;    define                 none          define keyword
+;;;    define-form            none          variable definition
+;;;    define-syntax          none          define-syntax keyword
+;;;    define-syntax-form     none          syntax definition
+;;;    displaced-lexical      none          displaced lexical identifier
+;;;    eval-when              none          eval-when keyword
+;;;    eval-when-form         none          eval-when form
+;;;    global                 name          global variable reference
+;;;    import                 none          import keyword
+;;;    import-form            none          import form
+;;;    lexical                name          lexical variable reference
+;;;    lexical-call           name          call to lexical variable
+;;;    local-syntax           rec?          letrec-syntax/let-syntax keyword
+;;;    local-syntax-form      rec?          syntax definition
+;;;    module                 none          module keyword
+;;;    module-form            none          module definition
+;;;    other                  none          anything else
+;;;    syntax                 level         pattern variable
+;;;
+;;; For all forms, e is the form, w is the wrap for e. and s is the source.
+;;;
+;;; syntax-type expands macros and unwraps as necessary to get to
+;;; one of the forms above.
+
+(define syntax-type
+  (lambda (e r w s rib)
+    (cond
+      ((symbol? e)
+       (let* ((n (id-var-name e w))
+              (b (lookup n r))
+              (type (binding-type b)))
+         (case type
+           ((lexical) (values type (binding-value b) e w s))
+          ((global) (values type (binding-value b) e w s))
+           ((macro macro!) (syntax-type (chi-macro (binding-value b) e r w s rib) r empty-wrap #f rib))
+           (else (values type (binding-value b) e w s)))))
+      ((pair? e)
+       (let ((first (car e)))
+         (if (id? first)
+             (let* ((n (id-var-name first w))
+                    (b (lookup n r))
+                    (type (binding-type b)))
+               (case type
+                 ((lexical) (values 'lexical-call (binding-value b) e w s))
+                 ((macro macro!)
+                  (syntax-type (chi-macro (binding-value b) e r w s rib)
+                    r empty-wrap #f rib))
+                 ((core) (values type (binding-value b) e w s))
+                 ((local-syntax)
+                  (values 'local-syntax-form (binding-value b) e w s))
+                 ((begin) (values 'begin-form #f e w s))
+                 ((eval-when) (values 'eval-when-form #f e w s))
+                 ((define) (values 'define-form #f e w s))
+                 ((define-syntax) (values 'define-syntax-form #f e w s))
+                 ((module-key) (values 'module-form #f e w s))
+                 ((import) (values 'import-form (and (binding-value b) (wrap first w)) e w s))
+                 ((set!) (chi-set! e r w s rib))
+                 (else (values 'call #f e w s))))
+             (values 'call #f e w s))))
+      ((syntax-object? e)
+       ;; s can't be valid source if we've unwrapped
+       (syntax-type (syntax-object-expression e)
+                    r
+                    (join-wraps w (syntax-object-wrap e))
+                    no-source rib))
+      ((annotation? e)
+       (syntax-type (annotation-expression e) r w (annotation-source e) rib))
+      ((self-evaluating? e) (values 'constant #f e w s))
+      (else (values 'other #f e w s)))))
+
+(define chi-top-expr
+  (lambda (e r w top-ribcage)
+    (call-with-values
+      (lambda () (syntax-type e r w no-source top-ribcage))
+      (lambda (type value e w s)
+        (chi-expr type value e r w s)))))
+
+(define chi-top
+  (lambda (e r w m esew top-ribcage)
+    (define-syntax eval-if-c&e
+      (syntax-rules ()
+        ((_ m e)
+         (let ((x e))
+           (if (eq? m 'c&e) (top-level-eval-hook x))
+           x))))
+    (call-with-values
+      (lambda () (syntax-type e r w no-source top-ribcage))
+      (lambda (type value e w s)
+        (case type
+          ((begin-form)
+           (syntax-case e ()
+             ((_) (chi-void))
+             ((_ e1 e2 ...)
+              (chi-top-sequence (syntax (e1 e2 ...)) r w s m esew top-ribcage))))
+          ((local-syntax-form)
+           (chi-local-syntax value e r w s
+             (lambda (body r w s)
+               (chi-top-sequence body r w s m esew top-ribcage))))
+          ((eval-when-form)
+           (syntax-case e ()
+             ((_ (x ...) e1 e2 ...)
+              (let ((when-list (chi-when-list e (syntax (x ...)) w))
+                    (body (syntax (e1 e2 ...))))
+                (cond
+                  ((eq? m 'e)
+                   (if (memq 'eval when-list)
+                       (chi-top-sequence body r w s 'e '(eval) top-ribcage)
+                       (chi-void)))
+                  ((memq 'load when-list)
+                   (if (or (memq 'compile when-list)
+                           (and (eq? m 'c&e) (memq 'eval when-list)))
+                       (chi-top-sequence body r w s 'c&e '(compile load) top-ribcage)
+                       (if (memq m '(c c&e))
+                           (chi-top-sequence body r w s 'c '(load) top-ribcage)
+                           (chi-void))))
+                  ((or (memq 'compile when-list)
+                       (and (eq? m 'c&e) (memq 'eval when-list)))
+                   (top-level-eval-hook
+                     (chi-top-sequence body r w s 'e '(eval) top-ribcage))
+                   (chi-void))
+                  (else (chi-void)))))))
+          ((define-syntax-form)
+           (parse-define-syntax e w s
+             (lambda (id rhs w)
+               (let ((id (wrap id w)))
+                 (let ((n (id-var-name id empty-wrap)))
+                   (let ((b (lookup n r)))
+                     (case (binding-type b)
+                       ((displaced-lexical) (displaced-lexical-error id)))))
+                 (ct-eval/residualize m esew
+                   (lambda ()
+                     (build-cte-install
+                       (let ((sym (id-sym-name id)))
+                         (if (only-top-marked? id)
+                             sym
+                             (let ((marks (wrap-marks (syntax-object-wrap id))))
+                               (make-syntax-object sym
+                                 (make-wrap marks
+                                   (list (make-ribcage (vector sym)
+                                           (vector marks) (vector (generate-id sym)))))))))
+                       (chi rhs (transformer-env r) w))))))))
+          ((define-form)
+           (parse-define e w s
+             (lambda (id rhs w)
+               (let ((id (wrap id w)))
+                 (let ((n (id-var-name id empty-wrap)))
+                   (let ((b (lookup n r)))
+                     (case (binding-type b)
+                       ((displaced-lexical) (displaced-lexical-error id)))))
+                 (let ((sym (id-sym-name id)))
+                   (let ((valsym (if (only-top-marked? id) sym (generate-id sym))))
+                     (build-sequence no-source
+                       (list
+                         (ct-eval/residualize m esew
+                           (lambda ()
+                             (build-cte-install
+                               (if (eq? sym valsym)
+                                   sym
+                                   (let ((marks (wrap-marks (syntax-object-wrap id))))
+                                     (make-syntax-object sym
+                                       (make-wrap marks
+                                         (list (make-ribcage (vector sym)
+                                                 (vector marks) (vector valsym)))))))
+                               (build-data no-source (make-binding 'global valsym)))))
+                         (eval-if-c&e m (build-global-definition s valsym (chi rhs r w))))))
+                  )))))
+          ((module-form)
+           (let ((r (cons '("top-level module placeholder" . (placeholder)) r))
+                 (ribcage (make-empty-ribcage)))
+             (parse-module e w s (make-wrap (wrap-marks w) (cons ribcage (wrap-subst w)))
+               (lambda (id exports forms)
+                 (if id
+                     (begin
+                       (let ((n (id-var-name id empty-wrap)))
+                         (let ((b (lookup n r)))
+                           (case (binding-type b)
+                             ((displaced-lexical) (displaced-lexical-error (wrap id w))))))
+                       (chi-top-module e r ribcage w s m esew id exports forms))
+                     (chi-top-module e r ribcage w s m esew #f exports forms))))))
+          ((import-form)
+           (parse-import e w s
+             (lambda (mid)
+               (ct-eval/residualize m esew
+                 (lambda ()
+                   (when value (syntax-error (source-wrap e w s) "not valid at top-level"))
+                   (let ((binding (lookup (id-var-name mid empty-wrap) null-env)))
+                     (case (binding-type binding)
+                       ((module) (do-top-import mid (interface-token (binding-value binding))))
+                       ((displaced-lexical) (displaced-lexical-error mid))
+                       (else (syntax-error mid "import from unknown module")))))))))
+          (else (eval-if-c&e m (chi-expr type value e r w s))))))))
+
+(define flatten-exports
+  (lambda (exports)
+    (let loop ((exports exports) (ls '()))
+      (if (null? exports)
+          ls
+          (loop (cdr exports)
+                (if (pair? (car exports))
+                    (loop (car exports) ls)
+                    (cons (car exports) ls)))))))
+
+
+(define-structure (interface exports token))
+
+(define make-trimmed-interface
+ ; trim out implicit exports
+  (lambda (exports)
+    (make-interface
+      (list->vector (map (lambda (x) (if (pair? x) (car x) x)) exports))
+      #f)))
+
+(define make-resolved-interface
+ ; trim out implicit exports & resolve others to actual top-level symbol
+  (lambda (exports import-token)
+    (make-interface
+      (list->vector (map (lambda (x) (make-trimmed-syntax-object (if (pair? x) (car x) x))) exports))
+      import-token)))
+
+(define-structure (module-binding type id label imps val))
+
+(define chi-top-module
+  (lambda (e r ribcage w s m esew id exports forms)
+    (let ((fexports (flatten-exports exports)))
+      (chi-external ribcage (source-wrap e w s)
+        (map (lambda (d) (cons r d)) forms) r exports fexports m esew
+        (lambda (bindings inits)
+         ; dvs & des: "defined" (letrec-bound) vars & rhs expressions
+         ; svs & ses: "set!" (top-level) vars & rhs expressions
+          (let partition ((fexports fexports) (bs bindings) (svs '()) (ses '()) (ctdefs '()))
+            (if (null? fexports)
+               ; remaining bindings are either local vars or local macros/modules
+                (let partition ((bs bs) (dvs '()) (des '()))
+                  (if (null? bs)
+                      (let ((ses (map (lambda (x) (chi (cdr x) (car x) empty-wrap)) ses))
+                            (des (map (lambda (x) (chi (cdr x) (car x) empty-wrap)) des))
+                            (inits (map (lambda (x) (chi (cdr x) (car x) empty-wrap)) inits)))
+                       ; we wait to do this here so that expansion of des & ses use
+                       ; local versions, which in particular, allows us to use macros
+                       ; locally even if esew tells us not to eval them
+                        (for-each (lambda (x)
+                                    (apply (lambda (t label sym val)
+                                             (when label (set-indirect-label! label sym)))
+                                           x))
+                                  ctdefs)
+                        (build-sequence no-source
+                          (list (ct-eval/residualize m esew
+                                  (lambda ()
+                                    (if (null? ctdefs)
+                                        (chi-void)
+                                        (build-sequence no-source
+                                          (map (lambda (x)
+                                                 (apply (lambda (t label sym val)
+                                                          (build-cte-install sym
+                                                            (if (eq? t 'define-syntax-form)
+                                                                val
+                                                                (build-data no-source
+                                                                  (make-binding 'module
+                                                                    (make-resolved-interface val sym))))))
+                                                        x))
+                                               ctdefs)))))
+                                (ct-eval/residualize m esew
+                                  (lambda ()
+                                    (let ((n (if id (id-sym-name id) #f)))
+                                      (let* ((token (generate-id n))
+                                             (b (build-data no-source
+                                                  (make-binding 'module
+                                                    (make-resolved-interface exports token)))))
+                                        (if n
+                                            (build-cte-install
+                                              (if (only-top-marked? id)
+                                                  n
+                                                  (let ((marks (wrap-marks (syntax-object-wrap id))))
+                                                    (make-syntax-object n
+                                                      (make-wrap marks
+                                                        (list (make-ribcage (vector n)
+                                                                (vector marks) (vector (generate-id n))))))))
+                                              b)
+                                            (let ((n (generate-id 'tmp)))
+                                              (build-sequence no-source
+                                                (list (build-cte-install n b)
+                                                      (do-top-import n token)))))))))
+                              ; Some systems complain when undefined variables are assigned.
+                               (build-sequence no-source
+                                 (map (lambda (v) (build-global-definition no-source v (chi-void))) svs))
+                                (build-letrec no-source
+                                  dvs
+                                  des
+                                  (build-sequence no-source
+                                    (list 
+                                      (if (null? svs)
+                                          (chi-void)
+                                          (build-sequence no-source
+                                            (map (lambda (v e)
+                                                   (build-module-definition no-source v e))
+                                                 svs
+                                                 ses)))
+                                      (if (null? inits)
+                                          (chi-void)
+                                          (build-sequence no-source inits)))))
+                                (chi-void))))
+                      (let ((b (car bs)))
+                        (case (module-binding-type b)
+                          ((define-form)
+                           (let ((var (gen-var (module-binding-id b))))
+                             (extend-store! r
+                               (get-indirect-label (module-binding-label b))
+                               (make-binding 'lexical var))
+                             (partition (cdr bs) (cons var dvs)
+                               (cons (module-binding-val b) des))))
+                          ((define-syntax-form module-form) (partition (cdr bs) dvs des))
+                          (else (error 'sc-expand-internal "unexpected module binding type"))))))
+                (let ((id (car fexports)) (fexports (cdr fexports)))
+                  (define pluck-binding
+                    (lambda (id bs succ fail)
+                      (let loop ((bs bs) (new-bs '()))
+                        (if (null? bs)
+                            (fail)
+                            (if (bound-id=? (module-binding-id (car bs)) id)
+                                (succ (car bs) (smart-append (reverse new-bs) (cdr bs)))
+                                (loop (cdr bs) (cons (car bs) new-bs)))))))
+                  (pluck-binding id bs
+                    (lambda (b bs)
+                      (let ((t (module-binding-type b))
+                            (label (module-binding-label b))
+                            (imps (module-binding-imps b)))
+                        (let ((fexports (append imps fexports))
+                              (sym (generate-id (id-sym-name id))))
+                          (case t
+                            ((define-form)
+                             (set-indirect-label! label sym)
+                             (partition fexports bs (cons sym svs)
+                               (cons (module-binding-val b) ses)
+                               ctdefs))
+                            ((define-syntax-form)
+                             (partition fexports bs svs ses
+                               (cons (list t label sym (module-binding-val b)) ctdefs)))
+                            ((module-form)
+                             (let ((exports (module-binding-val b)))
+                               (partition (append (flatten-exports exports) fexports) bs
+                                 svs ses
+                                 (cons (list t label sym exports) ctdefs))))
+                            (else (error 'sc-expand-internal "unexpected module binding type"))))))
+                    (lambda () (partition fexports bs svs ses ctdefs)))))))))))
+
+(define id-set-diff
+  (lambda (exports defs)
+    (cond
+      ((null? exports) '())
+      ((bound-id-member? (car exports) defs) (id-set-diff (cdr exports) defs))
+      (else (cons (car exports) (id-set-diff (cdr exports) defs))))))
+
+(define extend-store!
+  (lambda (r label binding)
+    (set-cdr! r (extend-env label binding (cdr r)))))
+
+(define check-module-exports
+  ; After processing the definitions of a module this is called to verify that the
+  ; module has defined or imported each exported identifier.  Because ids in fexports are
+  ; wrapped with the given ribcage, they will contain substitutions for anything defined
+  ; or imported here.  These subsitutions can be used by do-import! and do-import-top! to
+  ; provide access to reexported bindings, for example.
+  (lambda (source-exp fexports ids)
+    (define defined?
+      (lambda (e ids)
+        (ormap (lambda (x)
+                 (if (interface? x)
+                     (let ((token (interface-token x)))
+                       (if token
+                           (lookup-import-binding-name (id-sym-name e) token (wrap-marks (syntax-object-wrap e)))
+                           (let ((v (interface-exports x)))
+                             (let lp ((i (fx- (vector-length v) 1)))
+                               (and (fx>= i 0)
+                                    (or (bound-id=? e (vector-ref v i))
+                                        (lp (fx- i 1))))))))
+                     (bound-id=? e x)))
+               ids)))
+    (let loop ((fexports fexports) (missing '()))
+      (if (null? fexports)
+          (unless (null? missing) (syntax-error missing "missing definition for export(s)"))
+          (let ((e (car fexports)) (fexports (cdr fexports)))
+            (if (defined? e ids) 
+                (loop fexports missing)
+                (loop fexports (cons e missing))))))))
+
+(define check-defined-ids
+  (lambda (source-exp ls)
+    (define b-i=?
+      ; cope with fat-fingered top-level
+      (lambda (x y)
+        (if (symbol? x)
+            (if (symbol? y)
+                (eq? x y)
+                (and (eq? x (id-sym-name y))
+                     (same-marks? (wrap-marks (syntax-object-wrap y)) (wrap-marks top-wrap))))
+            (if (symbol? y)
+                (and (eq? y (id-sym-name x))
+                     (same-marks? (wrap-marks (syntax-object-wrap x)) (wrap-marks top-wrap)))
+                (bound-id=? x y)))))
+    (define vfold
+      (lambda (v p cls)
+        (let ((len (vector-length v)))
+          (let lp ((i 0) (cls cls))
+            (if (fx= i len)
+                cls
+                (lp (fx+ i 1) (p (vector-ref v i) cls)))))))
+    (define conflicts
+      (lambda (x y cls)
+        (if (interface? x)
+            (if (interface? y)
+                (call-with-values
+                  (lambda ()
+                    (let ((xe (interface-exports x)) (ye (interface-exports y)))
+                      (if (fx> (vector-length xe) (vector-length ye))
+                          (values x ye)
+                          (values y xe))))
+                  (lambda (iface exports)
+                    (vfold exports (lambda (id cls) (id-iface-conflicts id iface cls)) cls)))
+                (id-iface-conflicts y x cls))
+            (if (interface? y)
+                (id-iface-conflicts x y cls)
+                (if (b-i=? x y) (cons x cls) cls)))))
+     (define id-iface-conflicts
+       (lambda (id iface cls)
+         (let ((token (interface-token iface)))
+           (if token
+               (if (lookup-import-binding-name (id-sym-name id) token
+                     (if (symbol? id)
+                         (wrap-marks top-wrap)
+                         (wrap-marks (syntax-object-wrap id))))
+                   (cons id cls)
+                   cls)
+               (vfold (interface-exports iface)
+                      (lambda (*id cls) (if (b-i=? *id id) (cons *id cls) cls))
+                      cls)))))
+     (unless (null? ls)
+       (let lp ((x (car ls)) (ls (cdr ls)) (cls '()))
+         (if (null? ls)
+             (unless (null? cls)
+               (let ((cls (syntax-object->datum cls)))
+                 (syntax-error source-exp "duplicate definition for "
+                  (symbol->string (car cls))
+                   " in")))
+             (let lp2 ((ls2 ls) (cls cls))
+               (if (null? ls2)
+                   (lp (car ls) (cdr ls) cls)
+                   (lp2 (cdr ls2) (conflicts x (car ls2) cls)))))))))
+
+(define chi-external
+  (lambda (ribcage source-exp body r exports fexports m esew k)
+    (define return
+      (lambda (bindings ids inits)
+        (check-defined-ids source-exp ids)
+        (check-module-exports source-exp fexports ids)
+        (k bindings inits)))
+    (define get-implicit-exports
+      (lambda (id)
+        (let f ((exports exports))
+          (if (null? exports)
+              '()
+              (if (and (pair? (car exports)) (bound-id=? id (caar exports)))
+                  (flatten-exports (cdar exports))
+                  (f (cdr exports)))))))
+    (define update-imp-exports
+      (lambda (bindings exports)
+        (let ((exports (map (lambda (x) (if (pair? x) (car x) x)) exports)))
+          (map (lambda (b)
+                 (let ((id (module-binding-id b)))
+                   (if (not (bound-id-member? id exports))
+                       b
+                       (make-module-binding
+                         (module-binding-type b)
+                         id
+                         (module-binding-label b)
+                         (append (get-implicit-exports id) (module-binding-imps b))
+                         (module-binding-val b)))))
+               bindings))))
+    (let parse ((body body) (ids '()) (bindings '()) (inits '()))
+      (if (null? body)
+          (return bindings ids inits)
+          (let ((e (cdar body)) (er (caar body)))
+            (call-with-values
+              (lambda () (syntax-type e er empty-wrap no-source ribcage))
+              (lambda (type value e w s)
+                (case type
+                  ((define-form)
+                   (parse-define e w s
+                     (lambda (id rhs w)
+                       (let* ((id (wrap id w))
+                              (label (gen-indirect-label))
+                              (imps (get-implicit-exports id)))
+                         (extend-ribcage! ribcage id label)
+                         (parse
+                           (cdr body)
+                           (cons id ids)
+                           (cons (make-module-binding type id label
+                                   imps (cons er (wrap rhs w)))
+                                 bindings)
+                           inits)))))
+                  ((define-syntax-form)
+                   (parse-define-syntax e w s
+                     (lambda (id rhs w)
+                       (let* ((id (wrap id w))
+                              (label (gen-indirect-label))
+                              (imps (get-implicit-exports id))
+                              (exp (chi rhs (transformer-env er) w)))
+                         ; arrange to evaluate the transformer lazily
+                         (extend-store! r (get-indirect-label label) (cons 'deferred exp))
+                         (extend-ribcage! ribcage id label)
+                         (parse
+                           (cdr body)
+                           (cons id ids)
+                           (cons (make-module-binding type id label imps exp)
+                                 bindings)
+                           inits)))))
+                  ((module-form)
+                   (let* ((*ribcage (make-empty-ribcage))
+                          (*w (make-wrap (wrap-marks w) (cons *ribcage (wrap-subst w)))))
+                     (parse-module e w s *w
+                       (lambda (id *exports forms)
+                         (chi-external *ribcage (source-wrap e w s)
+                                     (map (lambda (d) (cons er d)) forms)
+                                     r *exports (flatten-exports *exports) m esew
+                           (lambda (*bindings *inits)
+                             (let* ((iface (make-trimmed-interface *exports))
+                                    (bindings (append (if id *bindings (update-imp-exports *bindings *exports)) bindings))
+                                    (inits (append inits *inits)))
+                               (if id
+                                   (let ((label (gen-indirect-label))
+                                         (imps (get-implicit-exports id)))
+                                     (extend-store! r (get-indirect-label label)
+                                       (make-binding 'module iface))
+                                     (extend-ribcage! ribcage id label)
+                                     (parse
+                                       (cdr body)
+                                       (cons id ids)
+                                       (cons (make-module-binding type id label imps *exports) bindings)
+                                       inits))
+                                   (let ()
+                                     (do-import! iface ribcage)
+                                     (parse (cdr body) (cons iface ids) bindings inits))))))))))
+                 ((import-form)
+                  (parse-import e w s
+                    (lambda (mid)
+                      (let ((mlabel (id-var-name mid empty-wrap)))
+                        (let ((binding (lookup mlabel r)))
+                          (case (binding-type binding)
+                            ((module)
+                             (let ((iface (binding-value binding)))
+                               (when value (extend-ribcage-barrier! ribcage value))
+                               (do-import! iface ribcage)
+                               (parse
+                                 (cdr body)
+                                 (cons iface ids)
+                                 (update-imp-exports bindings (vector->list (interface-exports iface)))
+                                 inits)))
+                            ((displaced-lexical) (displaced-lexical-error mid))
+                            (else (syntax-error mid "import from unknown module"))))))))
+                  ((begin-form)
+                   (syntax-case e ()
+                     ((_ e1 ...)
+                      (parse (let f ((forms (syntax (e1 ...))))
+                               (if (null? forms)
+                                   (cdr body)
+                                   (cons (cons er (wrap (car forms) w))
+                                         (f (cdr forms)))))
+                        ids bindings inits))))
+                  ((local-syntax-form)
+                   (chi-local-syntax value e er w s
+                     (lambda (forms er w s)
+                       (parse (let f ((forms forms))
+                                (if (null? forms)
+                                    (cdr body)
+                                    (cons (cons er (wrap (car forms) w))
+                                          (f (cdr forms)))))
+                         ids bindings inits))))
+                  (else ; found an init expression
+                   (return bindings ids
+                     (append inits (cons (cons er (source-wrap e w s)) (cdr body)))))))))))))
+
+(define vmap
+  (lambda (fn v)
+    (do ((i (fx- (vector-length v) 1) (fx- i 1))
+         (ls '() (cons (fn (vector-ref v i)) ls)))
+        ((fx< i 0) ls))))
+
+(define vfor-each
+  (lambda (fn v)
+    (let ((len (vector-length v)))
+      (do ((i 0 (fx+ i 1)))
+          ((fx= i len))
+        (fn (vector-ref v i))))))
+
+(define do-top-import
+  (lambda (mid token)
+    (build-cte-install mid
+      (build-data no-source
+        (make-binding 'do-import token)))))
+
+(define ct-eval/residualize
+  (lambda (m esew thunk)
+    (case m
+      ((c) (if (memq 'compile esew)
+               (let ((e (thunk)))
+                 (top-level-eval-hook e)
+                 (if (memq 'load esew) e (chi-void)))
+               (if (memq 'load esew) (thunk) (chi-void))))
+      ((c&e) (let ((e (thunk))) (top-level-eval-hook e) e))
+      (else (if (memq 'eval esew) (top-level-eval-hook (thunk))) (chi-void)))))
+
+(define chi
+  (lambda (e r w)
+    (call-with-values
+      (lambda () (syntax-type e r w no-source #f))
+      (lambda (type value e w s)
+        (chi-expr type value e r w s)))))
+
+(define chi-expr
+  (lambda (type value e r w s)
+    (case type
+      ((lexical)
+       (build-lexical-reference 'value s value))
+      ((core) (value e r w s))
+      ((lexical-call)
+       (chi-application
+         (build-lexical-reference 'fun (source-annotation (car e)) value)
+         e r w s))
+      ((constant) (build-data s (strip (source-wrap e w s) empty-wrap)))
+      ((global) (build-global-reference s value))
+      ((call) (chi-application (chi (car e) r w) e r w s))
+      ((begin-form)
+       (syntax-case e ()
+         ((_ e1 e2 ...) (chi-sequence (syntax (e1 e2 ...)) r w s))))
+      ((local-syntax-form)
+       (chi-local-syntax value e r w s chi-sequence))
+      ((eval-when-form)
+       (syntax-case e ()
+         ((_ (x ...) e1 e2 ...)
+          (let ((when-list (chi-when-list e (syntax (x ...)) w)))
+            (if (memq 'eval when-list)
+                (chi-sequence (syntax (e1 e2 ...)) r w s)
+                (chi-void))))))
+      ((define-form define-syntax-form module-form import-form)
+       (syntax-error (source-wrap e w s) "invalid context for definition"))
+      ((syntax)
+       (syntax-error (source-wrap e w s)
+         "reference to pattern variable outside syntax form"))
+      ((displaced-lexical) (displaced-lexical-error (source-wrap e w s)))
+      (else (syntax-error (source-wrap e w s))))))
+
+(define chi-application
+  (lambda (x e r w s)
+    (syntax-case e ()
+      ((e0 e1 ...)
+       (build-application s x
+         (map (lambda (e) (chi e r w)) (syntax (e1 ...)))))
+      (_ (syntax-error (source-wrap e w s))))))
+
+(define chi-set!
+  (lambda (e r w s rib)
+    (syntax-case e ()
+      ((_ id val)
+       (id? (syntax id))
+       (let ((n (id-var-name (syntax id) w)))
+         (let ((b (lookup n r)))
+           (case (binding-type b)
+             ((macro!)
+              (let ((id (wrap (syntax id) w)) (val (wrap (syntax val) w)))
+                (syntax-type (chi-macro (binding-value b)
+                               `(,(syntax set!) ,id ,val)
+                               r empty-wrap s rib) r empty-wrap s rib)))
+             (else
+              (values 'core
+                (lambda (e r w s)
+                 ; repeat lookup in case we were first expression (init) in
+                 ; module or lambda body.  we repeat id-var-name as well,
+                 ; although this is only necessary if we allow inits to
+                 ; preced definitions
+                  (let ((val (chi (syntax val) r w))
+                        (n (id-var-name (syntax id) w)))
+                    (let ((b (lookup n r)))
+                      (case (binding-type b)
+                        ((lexical) (build-lexical-assignment s (binding-value b) val))
+                        ((global) (build-global-assignment s (binding-value b) val))
+                        ((displaced-lexical)
+                         (syntax-error (wrap (syntax id) w) "identifier out of context"))
+                        (else (syntax-error (source-wrap e w s)))))))
+                e w s))))))
+      (_ (syntax-error (source-wrap e w s))))))
+
+(define chi-macro
+  (lambda (p e r w s rib)
+    (define rebuild-macro-output
+      (lambda (x m)
+        (cond ((pair? x)
+               (cons (rebuild-macro-output (car x) m)
+                     (rebuild-macro-output (cdr x) m)))
+              ((syntax-object? x)
+               (let ((w (syntax-object-wrap x)))
+                 (let ((ms (wrap-marks w)) (s (wrap-subst w)))
+                   (make-syntax-object (syntax-object-expression x)
+                     (if (and (pair? ms) (eq? (car ms) the-anti-mark))
+                         (make-wrap (cdr ms)
+                           (if rib (cons rib (cdr s)) (cdr s)))
+                         (make-wrap (cons m ms)
+                           (if rib
+                               (cons rib (cons 'shift s))
+                               (cons 'shift s))))))))
+              ((vector? x)
+               (let* ((n (vector-length x)) (v (make-vector n)))
+                 (do ((i 0 (fx+ i 1)))
+                     ((fx= i n) v)
+                     (vector-set! v i
+                       (rebuild-macro-output (vector-ref x i) m)))))
+              ((symbol? x)
+               (syntax-error (source-wrap e w s)
+                 "encountered raw symbol "
+                 (format "~s" x)
+                 " in output of macro"))
+              (else x))))
+    (rebuild-macro-output
+      (let ((out (p (source-wrap e (anti-mark w) s))))
+        (if (procedure? out)
+            (out (lambda (id)
+                   (unless (identifier? id)
+                     (syntax-error id
+                       "environment argument is not an identifier"))
+                   (lookup (id-var-name id empty-wrap) r)))
+            out))
+      (new-mark))))
+
+(define chi-body
+  ;; Here we create the empty wrap and new environment with placeholder
+  ;; as required by chi-internal.  On return we extend the environment
+  ;; to recognize the var-labels as lexical variables and build a letrec
+  ;; binding them to the var-vals which we expand here.
+  (lambda (body outer-form r w)
+    (let* ((r (cons '("placeholder" . (placeholder)) r))
+           (ribcage (make-empty-ribcage))
+           (w (make-wrap (wrap-marks w) (cons ribcage (wrap-subst w))))
+           (body (map (lambda (x) (cons r (wrap x w))) body)))
+      (chi-internal ribcage outer-form body r
+        (lambda (exprs ids vars vals inits)
+          (when (null? exprs) (syntax-error outer-form "no expressions in body"))
+          (build-letrec no-source
+            vars
+            (map (lambda (x) (chi (cdr x) (car x) empty-wrap)) vals)
+            (build-sequence no-source
+              (map (lambda (x) (chi (cdr x) (car x) empty-wrap)) (append inits exprs)))))))))
+
+(define chi-internal
+  ;; In processing the forms of the body, we create a new, empty wrap.
+  ;; This wrap is augmented (destructively) each time we discover that
+  ;; the next form is a definition.  This is done:
+  ;;
+  ;;   (1) to allow the first nondefinition form to be a call to
+  ;;       one of the defined ids even if the id previously denoted a
+  ;;       definition keyword or keyword for a macro expanding into a
+  ;;       definition;
+  ;;   (2) to prevent subsequent definition forms (but unfortunately
+  ;;       not earlier ones) and the first nondefinition form from
+  ;;       confusing one of the bound identifiers for an auxiliary
+  ;;       keyword; and
+  ;;   (3) so that we do not need to restart the expansion of the
+  ;;       first nondefinition form, which is problematic anyway
+  ;;       since it might be the first element of a begin that we
+  ;;       have just spliced into the body (meaning if we restarted,
+  ;;       we'd really need to restart with the begin or the macro
+  ;;       call that expanded into the begin, and we'd have to give
+  ;;       up allowing (begin <defn>+ <expr>+), which is itself
+  ;;       problematic since we don't know if a begin contains only
+  ;;       definitions until we've expanded it).
+  ;;
+  ;; Before processing the body, we also create a new environment
+  ;; containing a placeholder for the bindings we will add later and
+  ;; associate this environment with each form.  In processing a
+  ;; let-syntax or letrec-syntax, the associated environment may be
+  ;; augmented with local keyword bindings, so the environment may
+  ;; be different for different forms in the body.  Once we have
+  ;; gathered up all of the definitions, we evaluate the transformer
+  ;; expressions and splice into r at the placeholder the new variable
+  ;; and keyword bindings.  This allows let-syntax or letrec-syntax
+  ;; forms local to a portion or all of the body to shadow the
+  ;; definition bindings.
+  ;;
+  ;; Subforms of a begin, let-syntax, or letrec-syntax are spliced
+  ;; into the body.
+  ;;
+  ;; outer-form is fully wrapped w/source
+  (lambda (ribcage source-exp body r k)
+    (define return
+      (lambda (exprs ids vars vals inits)
+        (check-defined-ids source-exp ids)
+        (k exprs ids vars vals inits)))
+    (let parse ((body body) (ids '()) (vars '()) (vals '()) (inits '()))
+      (if (null? body)
+          (return body ids vars vals inits)
+          (let ((e (cdar body)) (er (caar body)))
+            (call-with-values
+              (lambda () (syntax-type e er empty-wrap no-source ribcage))
+              (lambda (type value e w s)
+                (case type
+                  ((define-form)
+                   (parse-define e w s
+                     (lambda (id rhs w)
+                       (let ((id (wrap id w)) (label (gen-label)))
+                         (let ((var (gen-var id)))
+                           (extend-ribcage! ribcage id label)
+                           (extend-store! r label (make-binding 'lexical var))
+                           (parse
+                             (cdr body)
+                             (cons id ids)
+                             (cons var vars)
+                             (cons (cons er (wrap rhs w)) vals)
+                             inits))))))
+                  ((define-syntax-form)
+                   (parse-define-syntax e w s
+                     (lambda (id rhs w)
+                       (let ((id (wrap id w))
+                             (label (gen-label))
+                             (exp (chi rhs (transformer-env er) w)))
+                         (extend-ribcage! ribcage id label)
+                         (extend-store! r label (make-binding 'deferred exp))
+                         (parse (cdr body) (cons id ids) vars vals inits)))))
+                  ((module-form)
+                   (let* ((*ribcage (make-empty-ribcage))
+                          (*w (make-wrap (wrap-marks w) (cons *ribcage (wrap-subst w)))))
+                     (parse-module e w s *w
+                       (lambda (id exports forms)
+                         (chi-internal *ribcage (source-wrap e w s)
+                           (map (lambda (d) (cons er d)) forms) r
+                           (lambda (*body *ids *vars *vals *inits)
+                             ; valid bound ids checked already by chi-internal
+                             (check-module-exports source-exp (flatten-exports exports) *ids)
+                             (let ((iface (make-trimmed-interface exports))
+                                   (vars (append *vars vars))
+                                   (vals (append *vals vals))
+                                   (inits (append inits *inits *body)))
+                               (if id
+                                   (let ((label (gen-label)))
+                                     (extend-ribcage! ribcage id label)
+                                     (extend-store! r label (make-binding 'module iface))
+                                     (parse (cdr body) (cons id ids) vars vals inits))
+                                   (let ()
+                                     (do-import! iface ribcage)
+                                     (parse (cdr body) (cons iface ids) vars vals inits))))))))))
+                 ((import-form)
+                  (parse-import e w s
+                    (lambda (mid)
+                      (let ((mlabel (id-var-name mid empty-wrap)))
+                        (let ((binding (lookup mlabel r)))
+                          (case (car binding)
+                            ((module)
+                             (let ((iface (cdr binding)))
+                               (when value (extend-ribcage-barrier! ribcage value))
+                               (do-import! iface ribcage)
+                               (parse (cdr body) (cons iface ids) vars vals inits)))
+                            ((displaced-lexical) (displaced-lexical-error mid))
+                            (else (syntax-error mid "import from unknown module"))))))))
+                  ((begin-form)
+                   (syntax-case e ()
+                     ((_ e1 ...)
+                      (parse (let f ((forms (syntax (e1 ...))))
+                               (if (null? forms)
+                                   (cdr body)
+                                   (cons (cons er (wrap (car forms) w))
+                                         (f (cdr forms)))))
+                        ids vars vals inits))))
+                  ((local-syntax-form)
+                   (chi-local-syntax value e er w s
+                     (lambda (forms er w s)
+                       (parse (let f ((forms forms))
+                                (if (null? forms)
+                                    (cdr body)
+                                    (cons (cons er (wrap (car forms) w))
+                                          (f (cdr forms)))))
+                         ids vars vals inits))))
+                  (else ; found a non-definition
+                   (return (cons (cons er (source-wrap e w s)) (cdr body))
+                           ids vars vals inits))))))))))
+
+(define do-import!
+  (lambda (interface ribcage)
+    (let ((token (interface-token interface)))
+      (if token
+          (extend-ribcage-subst! ribcage token)
+          (vfor-each
+            (lambda (id)
+              (let ((label1 (id-var-name-loc id empty-wrap)))
+                (unless label1
+                  (syntax-error id "exported identifier not visible"))
+                (extend-ribcage! ribcage id label1)))
+            (interface-exports interface))))))
+
+(define parse-module
+  (lambda (e w s *w k)
+    (define listify
+      (lambda (exports)
+        (if (null? exports)
+            '()
+            (cons (syntax-case (car exports) ()
+                    ((ex ...) (listify (syntax (ex ...))))
+                    (x (if (id? (syntax x))
+                           (wrap (syntax x) *w)
+                           (syntax-error (source-wrap e w s)
+                             "invalid exports list in"))))
+                  (listify (cdr exports))))))
+    (define return
+      (lambda (id exports forms)
+        (k id (listify exports) (map (lambda (x) (wrap x *w)) forms))))
+    (syntax-case e ()
+      ((_ (ex ...) form ...)
+       (return #f (syntax (ex ...)) (syntax (form ...))))
+      ((_ mid (ex ...) form ...)
+       (id? (syntax mid))
+      ; id receives old wrap so it won't be confused with id of same name
+      ; defined within the module
+       (return (wrap (syntax mid) w) (syntax (ex ...)) (syntax (form ...))))
+      (_ (syntax-error (source-wrap e w s))))))
+
+(define parse-import
+  (lambda (e w s k)
+    (syntax-case e ()
+      ((_ mid)
+       (id? (syntax mid))
+       (k (wrap (syntax mid) w)))
+      (_ (syntax-error (source-wrap e w s))))))
+
+(define parse-define
+  (lambda (e w s k)
+    (syntax-case e ()
+      ((_ name val)
+       (id? (syntax name))
+       (k (syntax name) (syntax val) w))
+      ((_ (name . args) e1 e2 ...)
+       (and (id? (syntax name))
+            (valid-bound-ids? (lambda-var-list (syntax args))))
+       (k (wrap (syntax name) w)
+          (cons (syntax lambda) (wrap (syntax (args e1 e2 ...)) w))
+          empty-wrap))
+      ((_ name)
+       (id? (syntax name))
+       (k (wrap (syntax name) w) (syntax (void)) empty-wrap))
+      (_ (syntax-error (source-wrap e w s))))))
+
+(define parse-define-syntax
+  (lambda (e w s k)
+    (syntax-case e ()
+      ((_ name val)
+       (id? (syntax name))
+       (k (syntax name) (syntax val) w))
+      (_ (syntax-error (source-wrap e w s))))))
+
+(define chi-lambda-clause
+  (lambda (e c r w k)
+    (syntax-case c ()
+      (((id ...) e1 e2 ...)
+       (let ((ids (syntax (id ...))))
+         (if (not (valid-bound-ids? ids))
+             (syntax-error e "invalid parameter list in")
+             (let ((labels (gen-labels ids))
+                   (new-vars (map gen-var ids)))
+               (k new-vars
+                  (chi-body (syntax (e1 e2 ...))
+                            e
+                            (extend-var-env* labels new-vars r)
+                            (make-binding-wrap ids labels w)))))))
+      ((ids e1 e2 ...)
+       (let ((old-ids (lambda-var-list (syntax ids))))
+         (if (not (valid-bound-ids? old-ids))
+             (syntax-error e "invalid parameter list in")
+             (let ((labels (gen-labels old-ids))
+                   (new-vars (map gen-var old-ids)))
+               (k (let f ((ls1 (cdr new-vars)) (ls2 (car new-vars)))
+                    (if (null? ls1)
+                        ls2
+                        (f (cdr ls1) (cons (car ls1) ls2))))
+                  (chi-body (syntax (e1 e2 ...))
+                            e
+                            (extend-var-env* labels new-vars r)
+                            (make-binding-wrap old-ids labels w)))))))
+      (_ (syntax-error e)))))
+
+(define chi-local-syntax
+  (lambda (rec? e r w s k)
+    (syntax-case e ()
+      ((_ ((id val) ...) e1 e2 ...)
+       (let ((ids (syntax (id ...))))
+         (if (not (valid-bound-ids? ids))
+             (invalid-ids-error (map (lambda (x) (wrap x w)) ids)
+               (source-wrap e w s)
+               "keyword")
+             (let ((labels (gen-labels ids)))
+               (let ((new-w (make-binding-wrap ids labels w)))
+                 (k (syntax (e1 e2 ...))
+                    (extend-env*
+                      labels
+                      (let ((w (if rec? new-w w))
+                            (trans-r (transformer-env r)))
+                        (map (lambda (x) (make-binding 'deferred (chi x trans-r w))) (syntax (val ...))))
+                      r)
+                    new-w
+                    s))))))
+      (_ (syntax-error (source-wrap e w s))))))
+
+(define chi-void
+  (lambda ()
+    (build-application no-source (build-primref no-source 'void) '())))
+
+(define ellipsis?
+  (lambda (x)
+    (and (nonsymbol-id? x)
+         (literal-id=? x (syntax (... ...))))))
+
+;;; data
+
+;;; strips all annotations from potentially circular reader output
+
+(define strip-annotation
+  (lambda (x parent)
+    (cond
+      ((pair? x)
+       (let ((new (cons #f #f)))
+         (when parent (set-annotation-stripped! parent new))
+         (set-car! new (strip-annotation (car x) #f))
+         (set-cdr! new (strip-annotation (cdr x) #f))
+         new))
+      ((annotation? x)
+       (or (annotation-stripped x)
+           (strip-annotation (annotation-expression x) x)))
+      ((vector? x)
+       (let ((new (make-vector (vector-length x))))
+         (when parent (set-annotation-stripped! parent new))
+         (let loop ((i (- (vector-length x) 1)))
+           (unless (fx< i 0)
+             (vector-set! new i (strip-annotation (vector-ref x i) #f))
+             (loop (fx- i 1))))
+         new))
+      (else x))))
+
+;;; strips syntax-objects down to top-wrap; if top-wrap is layered directly
+;;; on an annotation, strips the annotation as well.
+;;; since only the head of a list is annotated by the reader, not each pair
+;;; in the spine, we also check for pairs whose cars are annotated in case
+;;; we've been passed the cdr of an annotated list
+
+(define strip*
+  (lambda (x w fn)
+    (if (top-marked? w)
+        (fn x)
+        (let f ((x x))
+          (cond
+            ((syntax-object? x)
+             (strip* (syntax-object-expression x) (syntax-object-wrap x) fn))
+            ((pair? x)
+             (let ((a (f (car x))) (d (f (cdr x))))
+               (if (and (eq? a (car x)) (eq? d (cdr x)))
+                   x
+                   (cons a d))))
+            ((vector? x)
+             (let ((old (vector->list x)))
+                (let ((new (map f old)))
+                   (if (andmap eq? old new) x (list->vector new)))))
+            (else x))))))
+
+(define strip
+  (lambda (x w)
+    (strip* x w
+      (lambda (x)
+        (if (or (annotation? x) (and (pair? x) (annotation? (car x))))
+            (strip-annotation x #f)
+            x)))))
+
+;;; lexical variables
+
+(define gen-var
+  (lambda (id)
+    (let ((id (if (syntax-object? id) (syntax-object-expression id) id)))
+      (if (annotation? id)
+          (build-lexical-var (annotation-source id) (annotation-expression id))
+          (build-lexical-var no-source id)))))
+
+(define lambda-var-list
+  (lambda (vars)
+    (let lvl ((vars vars) (ls '()) (w empty-wrap))
+       (cond
+         ((pair? vars) (lvl (cdr vars) (cons (wrap (car vars) w) ls) w))
+         ((id? vars) (cons (wrap vars w) ls))
+         ((null? vars) ls)
+         ((syntax-object? vars)
+          (lvl (syntax-object-expression vars)
+               ls
+               (join-wraps w (syntax-object-wrap vars))))
+         ((annotation? vars)
+          (lvl (annotation-expression vars) ls w))
+       ; include anything else to be caught by subsequent error
+       ; checking
+         (else (cons vars ls))))))
+
+
+; must precede global-extends
+
+(set! $sc-put-cte
+  (lambda (id b)
+    (define put-token
+      (lambda (id token)
+        (define cons-id
+          (lambda (id x)
+            (if (not x) id (cons id x))))
+        (define weed
+          (lambda (id x)
+            (if (pair? x)
+                (if (bound-id=? (car x) id) ; could just check same-marks
+                    (weed id (cdr x))
+                    (cons-id (car x) (weed id (cdr x))))
+                (if (or (not x) (bound-id=? x id))
+                    #f
+                    x))))
+        (let ((sym (id-sym-name id)))
+          (let ((x (weed id (getprop sym token))))
+            (if (and (not x) (symbol? id))
+               ; don't pollute property list when all we have is a plain
+               ; top-level binding, since that's what's assumed anyway
+                (remprop sym token)
+                (putprop sym token (cons-id id x)))))))
+    (define sc-put-module
+      (lambda (exports token)
+        (vfor-each
+          (lambda (id) (put-token id token))
+          exports)))
+    (define (put-cte id binding)
+     ;; making assumption here that all macros should be visible to the user and that system
+     ;; globals don't come through here (primvars.ss sets up their properties)
+      (let ((sym (if (symbol? id) id (id-var-name id empty-wrap))))
+        (putprop sym '*sc-expander* binding)))
+    (let ((binding (or (sanitize-binding b) (error 'define-syntax "invalid transformer ~s" b))))
+      (case (binding-type binding)
+        ((module)
+         (let ((iface (binding-value binding)))
+           (sc-put-module (interface-exports iface) (interface-token iface)))
+         (put-cte id binding))
+        ((do-import) ; fake binding: id is module id, binding-value is import token
+         (let ((token (binding-value b)))
+           (let ((b (lookup (id-var-name id empty-wrap) null-env)))
+             (case (binding-type b)
+               ((module)
+                (let ((iface (binding-value b)))
+                  (unless (eq? (interface-token iface) token)
+                    (syntax-error id "import mismatch for module"))
+                  (sc-put-module (interface-exports iface) '*top*)))
+               (else (syntax-error id "import from unknown module"))))))
+        (else (put-cte id binding))))))
+
+
+;;; core transformers
+
+(global-extend 'local-syntax 'letrec-syntax #t)
+(global-extend 'local-syntax 'let-syntax #f)
+
+
+(global-extend 'core 'fluid-let-syntax
+  (lambda (e r w s)
+    (syntax-case e ()
+      ((_ ((var val) ...) e1 e2 ...)
+       (valid-bound-ids? (syntax (var ...)))
+       (let ((names (map (lambda (x) (id-var-name x w)) (syntax (var ...)))))
+         (for-each
+           (lambda (id n)
+             (case (binding-type (lookup n r))
+               ((displaced-lexical) (displaced-lexical-error (wrap id w)))))
+           (syntax (var ...))
+           names)
+         (chi-body
+           (syntax (e1 e2 ...))
+           (source-wrap e w s)
+           (extend-env*
+             names
+             (let ((trans-r (transformer-env r)))
+               (map (lambda (x) (make-binding 'deferred (chi x trans-r w))) (syntax (val ...))))
+             r)
+           w)))
+      (_ (syntax-error (source-wrap e w s))))))
+
+(global-extend 'core 'quote
+   (lambda (e r w s)
+      (syntax-case e ()
+         ((_ e) (build-data s (strip (syntax e) w)))
+         (_ (syntax-error (source-wrap e w s))))))
+
+(global-extend 'core 'syntax
+  (let ()
+    (define gen-syntax
+      (lambda (src e r maps ellipsis?)
+        (if (id? e)
+            (let ((label (id-var-name e empty-wrap)))
+              (let ((b (lookup label r)))
+                (if (eq? (binding-type b) 'syntax)
+                    (call-with-values
+                      (lambda ()
+                        (let ((var.lev (binding-value b)))
+                          (gen-ref src (car var.lev) (cdr var.lev) maps)))
+                      (lambda (var maps) (values `(ref ,var) maps)))
+                    (if (ellipsis? e)
+                        (syntax-error src "misplaced ellipsis in syntax form")
+                        (values `(quote ,e) maps)))))
+            (syntax-case e ()
+              ((dots e)
+               (ellipsis? (syntax dots))
+               (gen-syntax src (syntax e) r maps (lambda (x) #f)))
+              ((x dots . y)
+               ; this could be about a dozen lines of code, except that we
+               ; choose to handle (syntax (x ... ...)) forms
+               (ellipsis? (syntax dots))
+               (let f ((y (syntax y))
+                       (k (lambda (maps)
+                            (call-with-values
+                              (lambda ()
+                                (gen-syntax src (syntax x) r
+                                  (cons '() maps) ellipsis?))
+                              (lambda (x maps)
+                                (if (null? (car maps))
+                                    (syntax-error src
+                                      "extra ellipsis in syntax form")
+                                    (values (gen-map x (car maps))
+                                            (cdr maps))))))))
+                 (syntax-case y ()
+                   ((dots . y)
+                    (ellipsis? (syntax dots))
+                    (f (syntax y)
+                       (lambda (maps)
+                         (call-with-values
+                           (lambda () (k (cons '() maps)))
+                           (lambda (x maps)
+                             (if (null? (car maps))
+                                 (syntax-error src
+                                   "extra ellipsis in syntax form")
+                                 (values (gen-mappend x (car maps))
+                                         (cdr maps))))))))
+                   (_ (call-with-values
+                        (lambda () (gen-syntax src y r maps ellipsis?))
+                        (lambda (y maps)
+                          (call-with-values
+                            (lambda () (k maps))
+                            (lambda (x maps)
+                              (values (gen-append x y) maps)))))))))
+              ((x . y)
+               (call-with-values
+                 (lambda () (gen-syntax src (syntax x) r maps ellipsis?))
+                 (lambda (x maps)
+                   (call-with-values
+                     (lambda () (gen-syntax src (syntax y) r maps ellipsis?))
+                     (lambda (y maps) (values (gen-cons x y) maps))))))
+              (#(e1 e2 ...)
+               (call-with-values
+                 (lambda ()
+                   (gen-syntax src (syntax (e1 e2 ...)) r maps ellipsis?))
+                 (lambda (e maps) (values (gen-vector e) maps))))
+              (_ (values `(quote ,e) maps))))))
+
+    (define gen-ref
+      (lambda (src var level maps)
+        (if (fx= level 0)
+            (values var maps)
+            (if (null? maps)
+                (syntax-error src "missing ellipsis in syntax form")
+                (call-with-values
+                  (lambda () (gen-ref src var (fx- level 1) (cdr maps)))
+                  (lambda (outer-var outer-maps)
+                    (let ((b (assq outer-var (car maps))))
+                      (if b
+                          (values (cdr b) maps)
+                          (let ((inner-var (gen-var 'tmp)))
+                            (values inner-var
+                                    (cons (cons (cons outer-var inner-var)
+                                                (car maps))
+                                          outer-maps)))))))))))
+
+    (define gen-mappend
+      (lambda (e map-env)
+        `(apply (primitive append) ,(gen-map e map-env))))
+
+    (define gen-map
+      (lambda (e map-env)
+        (let ((formals (map cdr map-env))
+              (actuals (map (lambda (x) `(ref ,(car x))) map-env)))
+          (cond
+            ((eq? (car e) 'ref)
+             ; identity map equivalence:
+             ; (map (lambda (x) x) y) == y
+             (car actuals))
+            ((andmap
+                (lambda (x) (and (eq? (car x) 'ref) (memq (cadr x) formals)))
+                (cdr e))
+             ; eta map equivalence:
+             ; (map (lambda (x ...) (f x ...)) y ...) == (map f y ...)
+             `(map (primitive ,(car e))
+                   ,@(map (let ((r (map cons formals actuals)))
+                            (lambda (x) (cdr (assq (cadr x) r))))
+                          (cdr e))))
+            (else `(map (lambda ,formals ,e) ,@actuals))))))
+
+    (define gen-cons
+      (lambda (x y)
+        (case (car y)
+          ((quote)
+           (if (eq? (car x) 'quote)
+               `(quote (,(cadr x) . ,(cadr y)))
+               (if (eq? (cadr y) '())
+                   `(list ,x)
+                   `(cons ,x ,y))))
+          ((list) `(list ,x ,@(cdr y)))
+          (else `(cons ,x ,y)))))
+
+    (define gen-append
+      (lambda (x y)
+        (if (equal? y '(quote ()))
+            x
+            `(append ,x ,y))))
+
+    (define gen-vector
+      (lambda (x)
+        (cond
+          ((eq? (car x) 'list) `(vector ,@(cdr x)))
+          ((eq? (car x) 'quote) `(quote #(,@(cadr x))))
+          (else `(list->vector ,x)))))
+
+
+    (define regen
+      (lambda (x)
+        (case (car x)
+          ((ref) (build-lexical-reference 'value no-source (cadr x)))
+          ((primitive) (build-primref no-source (cadr x)))
+          ((quote) (build-data no-source (cadr x)))
+          ((lambda) (build-lambda no-source (cadr x) (regen (caddr x))))
+          ((map) (let ((ls (map regen (cdr x))))
+                   (build-application no-source
+                     (if (fx= (length ls) 2)
+                         (build-primref no-source 'map)
+                        ; really need to do our own checking here
+                         (build-primref no-source 2 'map)) ; require error check
+                     ls)))
+          (else (build-application no-source
+                  (build-primref no-source (car x))
+                  (map regen (cdr x)))))))
+
+    (lambda (e r w s)
+      (let ((e (source-wrap e w s)))
+        (syntax-case e ()
+          ((_ x)
+           (call-with-values
+             (lambda () (gen-syntax e (syntax x) r '() ellipsis?))
+             (lambda (e maps) (regen e))))
+          (_ (syntax-error e)))))))
+
+
+(global-extend 'core 'lambda
+   (lambda (e r w s)
+      (syntax-case e ()
+         ((_ . c)
+          (chi-lambda-clause (source-wrap e w s) (syntax c) r w
+            (lambda (vars body) (build-lambda s vars body)))))))
+
+
+(global-extend 'core 'letrec
+  (lambda (e r w s)
+    (syntax-case e ()
+      ((_ ((id val) ...) e1 e2 ...)
+       (let ((ids (syntax (id ...))))
+         (if (not (valid-bound-ids? ids))
+             (invalid-ids-error (map (lambda (x) (wrap x w)) ids)
+               (source-wrap e w s) "bound variable")
+             (let ((labels (gen-labels ids))
+                   (new-vars (map gen-var ids)))
+               (let ((w (make-binding-wrap ids labels w))
+                    (r (extend-var-env* labels new-vars r)))
+                 (build-letrec s
+                   new-vars
+                   (map (lambda (x) (chi x r w)) (syntax (val ...)))
+                   (chi-body (syntax (e1 e2 ...)) (source-wrap e w s) r w)))))))
+      (_ (syntax-error (source-wrap e w s))))))
+
+(global-extend 'core 'if
+   (lambda (e r w s)
+      (syntax-case e ()
+         ((_ test then)
+          (build-conditional s
+             (chi (syntax test) r w)
+             (chi (syntax then) r w)
+             (chi-void)))
+         ((_ test then else)
+          (build-conditional s
+             (chi (syntax test) r w)
+             (chi (syntax then) r w)
+             (chi (syntax else) r w)))
+         (_ (syntax-error (source-wrap e w s))))))
+
+
+
+(global-extend 'set! 'set! '())
+
+(global-extend 'begin 'begin '())
+
+(global-extend 'module-key 'module '())
+(global-extend 'import 'import #f)
+(global-extend 'import 'import-only #t)
+
+(global-extend 'define 'define '())
+
+(global-extend 'define-syntax 'define-syntax '())
+
+(global-extend 'eval-when 'eval-when '())
+
+(global-extend 'core 'syntax-case
+  (let ()
+    (define convert-pattern
+      ; accepts pattern & keys
+      ; returns syntax-dispatch pattern & ids
+      (lambda (pattern keys)
+        (let cvt ((p pattern) (n 0) (ids '()))
+          (if (id? p)
+              (if (bound-id-member? p keys)
+                  (values (vector 'free-id p) ids)
+                  (values 'any (cons (cons p n) ids)))
+              (syntax-case p ()
+                ((x dots)
+                 (ellipsis? (syntax dots))
+                 (call-with-values
+                   (lambda () (cvt (syntax x) (fx+ n 1) ids))
+                   (lambda (p ids)
+                     (values (if (eq? p 'any) 'each-any (vector 'each p))
+                             ids))))
+                ((x . y)
+                 (call-with-values
+                   (lambda () (cvt (syntax y) n ids))
+                   (lambda (y ids)
+                     (call-with-values
+                       (lambda () (cvt (syntax x) n ids))
+                       (lambda (x ids)
+                         (values (cons x y) ids))))))
+                (() (values '() ids))
+                (#(x ...)
+                 (call-with-values
+                   (lambda () (cvt (syntax (x ...)) n ids))
+                   (lambda (p ids) (values (vector 'vector p) ids))))
+                (x (values (vector 'atom (strip p empty-wrap)) ids)))))))
+
+    (define build-dispatch-call
+      (lambda (pvars exp y r)
+        (let ((ids (map car pvars)) (levels (map cdr pvars)))
+          (let ((labels (gen-labels ids)) (new-vars (map gen-var ids)))
+            (build-application no-source
+              (build-primref no-source 'apply)
+              (list (build-lambda no-source new-vars
+                      (chi exp
+                         (extend-env*
+                             labels
+                             (map (lambda (var level)
+                                    (make-binding 'syntax `(,var . ,level)))
+                                  new-vars
+                                  (map cdr pvars))
+                             r)
+                           (make-binding-wrap ids labels empty-wrap)))
+                    y))))))
+
+    (define gen-clause
+      (lambda (x keys clauses r pat fender exp)
+        (call-with-values
+          (lambda () (convert-pattern pat keys))
+          (lambda (p pvars)
+            (cond
+              ((not (distinct-bound-ids? (map car pvars)))
+               (invalid-ids-error (map car pvars) pat "pattern variable"))
+              ((not (andmap (lambda (x) (not (ellipsis? (car x)))) pvars))
+               (syntax-error pat
+                 "misplaced ellipsis in syntax-case pattern"))
+              (else
+               (let ((y (gen-var 'tmp)))
+                 ; fat finger binding and references to temp variable y
+                 (build-application no-source
+                   (build-lambda no-source (list y)
+                     (let-syntax ((y (identifier-syntax
+                                       (build-lexical-reference 'value no-source y))))
+                       (build-conditional no-source
+                         (syntax-case fender ()
+                           (#t y)
+                           (_ (build-conditional no-source
+                                y
+                                (build-dispatch-call pvars fender y r)
+                                (build-data no-source #f))))
+                         (build-dispatch-call pvars exp y r)
+                         (gen-syntax-case x keys clauses r))))
+                   (list (if (eq? p 'any)
+                             (build-application no-source
+                               (build-primref no-source 'list)
+                               (list (build-lexical-reference no-source 'value x)))
+                             (build-application no-source
+                               (build-primref no-source '$syntax-dispatch)
+                               (list (build-lexical-reference no-source 'value x)
+                                     (build-data no-source p)))))))))))))
+
+    (define gen-syntax-case
+      (lambda (x keys clauses r)
+        (if (null? clauses)
+            (build-application no-source
+              (build-primref no-source 'syntax-error)
+              (list (build-lexical-reference 'value no-source x)))
+            (syntax-case (car clauses) ()
+              ((pat exp)
+               (if (and (id? (syntax pat))
+                        (not (bound-id-member? (syntax pat) keys))
+                        (not (ellipsis? (syntax pat))))
+                   (let ((label (gen-label))
+                         (var (gen-var (syntax pat))))
+                     (build-application no-source
+                       (build-lambda no-source (list var)
+                         (chi (syntax exp)
+                              (extend-env label (make-binding 'syntax `(,var . 0)) r)
+                              (make-binding-wrap (syntax (pat))
+                                (list label) empty-wrap)))
+                       (list (build-lexical-reference 'value no-source x))))
+                   (gen-clause x keys (cdr clauses) r
+                     (syntax pat) #t (syntax exp))))
+              ((pat fender exp)
+               (gen-clause x keys (cdr clauses) r
+                 (syntax pat) (syntax fender) (syntax exp)))
+              (_ (syntax-error (car clauses) "invalid syntax-case clause"))))))
+
+    (lambda (e r w s)
+      (let ((e (source-wrap e w s)))
+        (syntax-case e ()
+          ((_ val (key ...) m ...)
+           (if (andmap (lambda (x) (and (id? x) (not (ellipsis? x))))
+                       (syntax (key ...)))
+               (let ((x (gen-var 'tmp)))
+                 ; fat finger binding and references to temp variable x
+                 (build-application s
+                   (build-lambda no-source (list x)
+                     (gen-syntax-case x
+                       (syntax (key ...)) (syntax (m ...))
+                       r))
+                   (list (chi (syntax val) r empty-wrap))))
+               (syntax-error e "invalid literals list in"))))))))
+
+;;; The portable sc-expand seeds chi-top's mode m with 'e (for
+;;; evaluating) and esew (which stands for "eval syntax expanders
+;;; when") with '(eval).  In Chez Scheme, m is set to 'c instead of e
+;;; if we are compiling a file, and esew is set to
+;;; (eval-syntactic-expanders-when), which defaults to the list
+;;; '(compile load eval).  This means that, by default, top-level
+;;; syntactic definitions are evaluated immediately after they are
+;;; expanded, and the expanded definitions are also residualized into
+;;; the object file if we are compiling a file.
+(set! sc-expand
+  (let ((m 'e) (esew '(eval))
+        (user-ribcage
+         (let ((ribcage (make-empty-ribcage)))
+           (extend-ribcage-subst! ribcage '*top*)
+           ribcage)))
+    (let ((user-top-wrap
+           (make-wrap (wrap-marks top-wrap)
+             (cons user-ribcage (wrap-subst top-wrap)))))
+      (lambda (x)
+        (if (and (pair? x) (equal? (car x) noexpand))
+            (cadr x)
+            (chi-top x null-env user-top-wrap m esew user-ribcage))))))
+
+(set! identifier?
+  (lambda (x)
+    (nonsymbol-id? x)))
+
+(set! datum->syntax-object
+  (lambda (id datum)
+    (arg-check nonsymbol-id? id 'datum->syntax-object)
+    (make-syntax-object datum (syntax-object-wrap id))))
+
+(set! syntax-object->datum
+  ; accepts any object, since syntax objects may consist partially
+  ; or entirely of unwrapped, nonsymbolic data
+  (lambda (x)
+    (strip x empty-wrap)))
+
+(set! generate-temporaries
+  (lambda (ls)
+    (arg-check list? ls 'generate-temporaries)
+    (map (lambda (x) (wrap (gensym-hook) top-wrap)) ls)))
+
+(set! free-identifier=?
+   (lambda (x y)
+      (arg-check nonsymbol-id? x 'free-identifier=?)
+      (arg-check nonsymbol-id? y 'free-identifier=?)
+      (free-id=? x y)))
+
+(set! bound-identifier=?
+   (lambda (x y)
+      (arg-check nonsymbol-id? x 'bound-identifier=?)
+      (arg-check nonsymbol-id? y 'bound-identifier=?)
+      (bound-id=? x y)))
+
+
+(set! syntax-error
+  (lambda (object . messages)
+    (for-each (lambda (x) (arg-check string? x 'syntax-error)) messages)
+    (let ((message (if (null? messages)
+                       "invalid syntax"
+                       (apply string-append messages))))
+      (error-hook #f message (strip object empty-wrap)))))
+
+;;; syntax-dispatch expects an expression and a pattern.  If the expression
+;;; matches the pattern a list of the matching expressions for each
+;;; "any" is returned.  Otherwise, #f is returned.  (This use of #f will
+;;; not work on r4rs implementations that violate the ieee requirement
+;;; that #f and () be distinct.)
+
+;;; The expression is matched with the pattern as follows:
+
+;;; pattern:                           matches:
+;;;   ()                                 empty list
+;;;   any                                anything
+;;;   (<pattern>1 . <pattern>2)          (<pattern>1 . <pattern>2)
+;;;   each-any                           (any*)
+;;;   #(free-id <key>)                   <key> with free-identifier=?
+;;;   #(each <pattern>)                  (<pattern>*)
+;;;   #(vector <pattern>)                (list->vector <pattern>)
+;;;   #(atom <object>)                   <object> with "equal?"
+
+;;; Vector cops out to pair under assumption that vectors are rare.  If
+;;; not, should convert to:
+;;;   #(vector <pattern>*)               #(<pattern>*)
+
+(let ()
+
+(define match-each
+  (lambda (e p w)
+    (cond
+      ((annotation? e)
+       (match-each (annotation-expression e) p w))
+      ((pair? e)
+       (let ((first (match (car e) p w '())))
+         (and first
+              (let ((rest (match-each (cdr e) p w)))
+                 (and rest (cons first rest))))))
+      ((null? e) '())
+      ((syntax-object? e)
+       (match-each (syntax-object-expression e)
+                   p
+                   (join-wraps w (syntax-object-wrap e))))
+      (else #f))))
+
+(define match-each-any
+  (lambda (e w)
+    (cond
+      ((annotation? e)
+       (match-each-any (annotation-expression e) w))
+      ((pair? e)
+       (let ((l (match-each-any (cdr e) w)))
+         (and l (cons (wrap (car e) w) l))))
+      ((null? e) '())
+      ((syntax-object? e)
+       (match-each-any (syntax-object-expression e)
+                       (join-wraps w (syntax-object-wrap e))))
+      (else #f))))
+
+(define match-empty
+  (lambda (p r)
+    (cond
+      ((null? p) r)
+      ((eq? p 'any) (cons '() r))
+      ((pair? p) (match-empty (car p) (match-empty (cdr p) r)))
+      ((eq? p 'each-any) (cons '() r))
+      (else
+       (case (vector-ref p 0)
+         ((each) (match-empty (vector-ref p 1) r))
+         ((free-id atom) r)
+         ((vector) (match-empty (vector-ref p 1) r)))))))
+
+(define match*
+  (lambda (e p w r)
+    (cond
+      ((null? p) (and (null? e) r))
+      ((pair? p)
+       (and (pair? e) (match (car e) (car p) w
+                        (match (cdr e) (cdr p) w r))))
+      ((eq? p 'each-any)
+       (let ((l (match-each-any e w))) (and l (cons l r))))
+      (else
+       (case (vector-ref p 0)
+         ((each)
+          (if (null? e)
+              (match-empty (vector-ref p 1) r)
+              (let ((l (match-each e (vector-ref p 1) w)))
+                (and l
+                     (let collect ((l l))
+                       (if (null? (car l))
+                           r
+                           (cons (map car l) (collect (map cdr l)))))))))
+         ((free-id) (and (id? e) (literal-id=? (wrap e w) (vector-ref p 1)) r))
+         ((atom) (and (equal? (vector-ref p 1) (strip e w)) r))
+         ((vector)
+          (and (vector? e)
+               (match (vector->list e) (vector-ref p 1) w r))))))))
+
+(define match
+  (lambda (e p w r)
+    (cond
+      ((not r) #f)
+      ((eq? p 'any) (cons (wrap e w) r))
+      ((syntax-object? e)
+       (match*
+         (unannotate (syntax-object-expression e))
+         p
+         (join-wraps w (syntax-object-wrap e))
+         r))
+      (else (match* (unannotate e) p w r)))))
+
+(set! $syntax-dispatch
+  (lambda (e p)
+    (cond
+      ((eq? p 'any) (list e))
+      ((syntax-object? e)
+       (match* (unannotate (syntax-object-expression e))
+         p (syntax-object-wrap e) '()))
+      (else (match* (unannotate e) p empty-wrap '())))))
+))
+
+
+(define-syntax with-syntax
+   (lambda (x)
+      (syntax-case x ()
+         ((_ () e1 e2 ...)
+          (syntax (begin e1 e2 ...)))
+         ((_ ((out in)) e1 e2 ...)
+          (syntax (syntax-case in () (out (begin e1 e2 ...)))))
+         ((_ ((out in) ...) e1 e2 ...)
+          (syntax (syntax-case (list in ...) ()
+                     ((out ...) (begin e1 e2 ...))))))))
+ 
+(define-syntax syntax-rules
+  (lambda (x)
+    (syntax-case x ()
+      ((_ (k ...) ((keyword . pattern) template) ...)
+       (syntax (lambda (x)
+                (syntax-case x (k ...)
+                  ((dummy . pattern) (syntax template))
+                  ...)))))))
+
+(define-syntax or
+   (lambda (x)
+      (syntax-case x ()
+         ((_) (syntax #f))
+         ((_ e) (syntax e))
+         ((_ e1 e2 e3 ...)
+          (syntax (let ((t e1)) (if t t (or e2 e3 ...))))))))
+
+(define-syntax and
+   (lambda (x)
+      (syntax-case x ()
+         ((_ e1 e2 e3 ...) (syntax (if e1 (and e2 e3 ...) #f)))
+         ((_ e) (syntax e))
+         ((_) (syntax #t)))))
+
+(define-syntax let
+   (lambda (x)
+      (syntax-case x ()
+         ((_ ((x v) ...) e1 e2 ...)
+          (andmap identifier? (syntax (x ...)))
+          (syntax ((lambda (x ...) e1 e2 ...) v ...)))
+         ((_ f ((x v) ...) e1 e2 ...)
+          (andmap identifier? (syntax (f x ...)))
+          (syntax ((letrec ((f (lambda (x ...) e1 e2 ...))) f)
+                    v ...))))))
+
+(define-syntax let*
+  (lambda (x)
+    (syntax-case x ()
+      ((let* ((x v) ...) e1 e2 ...)
+       (andmap identifier? (syntax (x ...)))
+       (let f ((bindings (syntax ((x v)  ...))))
+         (if (null? bindings)
+             (syntax (let () e1 e2 ...))
+             (with-syntax ((body (f (cdr bindings)))
+                           (binding (car bindings)))
+               (syntax (let (binding) body)))))))))
+
+(define-syntax cond
+  (lambda (x)
+    (syntax-case x ()
+      ((_ m1 m2 ...)
+       (let f ((clause (syntax m1)) (clauses (syntax (m2 ...))))
+         (if (null? clauses)
+             (syntax-case clause (else =>)
+               ((else e1 e2 ...) (syntax (begin e1 e2 ...)))
+               ((e0) (syntax (let ((t e0)) (if t t))))
+               ((e0 => e1) (syntax (let ((t e0)) (if t (e1 t)))))
+               ((e0 e1 e2 ...) (syntax (if e0 (begin e1 e2 ...))))
+               (_ (syntax-error x)))
+             (with-syntax ((rest (f (car clauses) (cdr clauses))))
+               (syntax-case clause (else =>)
+                 ((e0) (syntax (let ((t e0)) (if t t rest))))
+                 ((e0 => e1) (syntax (let ((t e0)) (if t (e1 t) rest))))
+                 ((e0 e1 e2 ...) (syntax (if e0 (begin e1 e2 ...) rest)))
+                 (_ (syntax-error x))))))))))
+
+(define-syntax do
+   (lambda (orig-x)
+      (syntax-case orig-x ()
+         ((_ ((var init . step) ...) (e0 e1 ...) c ...)
+          (with-syntax (((step ...)
+                         (map (lambda (v s)
+                                 (syntax-case s ()
+                                    (() v)
+                                    ((e) (syntax e))
+                                    (_ (syntax-error orig-x))))
+                              (syntax (var ...))
+                              (syntax (step ...)))))
+             (syntax-case (syntax (e1 ...)) ()
+                (() (syntax (let doloop ((var init) ...)
+                               (if (not e0)
+                                   (begin c ... (doloop step ...))))))
+                ((e1 e2 ...)
+                 (syntax (let doloop ((var init) ...)
+                            (if e0
+                                (begin e1 e2 ...)
+                                (begin c ... (doloop step ...))))))))))))
+
+(define-syntax quasiquote
+   (letrec
+     ; these are here because syntax-case uses literal-identifier=?,
+     ; and we want the more precise free-identifier=?
+      ((isquote? (lambda (x)
+                   (and (identifier? x)
+                        (free-identifier=? x (syntax quote)))))
+       (islist? (lambda (x)
+                  (and (identifier? x)
+                       (free-identifier=? x (syntax list)))))
+       (iscons? (lambda (x)
+                  (and (identifier? x)
+                       (free-identifier=? x (syntax cons)))))
+       (quote-nil? (lambda (x)
+                    (syntax-case x ()
+                      ((quote? ()) (isquote? (syntax quote?)))
+                      (_ #f))))
+       (quasilist*
+        (lambda (x y)
+          (let f ((x x))
+            (if (null? x)
+                y
+                (quasicons (car x) (f (cdr x)))))))
+       (quasicons
+        (lambda (x y)
+          (with-syntax ((x x) (y y))
+            (syntax-case (syntax y) ()
+              ((quote? dy)
+               (isquote? (syntax quote?))
+               (syntax-case (syntax x) ()
+                 ((quote? dx)
+                  (isquote? (syntax quote?))
+                  (syntax (quote (dx . dy))))
+                 (_ (if (null? (syntax dy))
+                        (syntax (list x))
+                        (syntax (cons x y))))))
+              ((listp . stuff)
+               (islist? (syntax listp))
+               (syntax (list x . stuff)))
+              (else (syntax (cons x y)))))))
+       (quasiappend
+        (lambda (x y)
+          (let ((ls (let f ((x x))
+                      (if (null? x)
+                          (if (quote-nil? y)
+                              '()
+                              (list y))
+                          (if (quote-nil? (car x))
+                              (f (cdr x))
+                              (cons (car x) (f (cdr x))))))))
+            (cond
+              ((null? ls) (syntax (quote ())))
+              ((null? (cdr ls)) (car ls))
+              (else (with-syntax (((p ...) ls))
+                      (syntax (append p ...))))))))
+       (quasivector
+        (lambda (x)
+          (with-syntax ((pat-x x))
+            (syntax-case (syntax pat-x) ()
+              ((quote? (x ...))
+               (isquote? (syntax quote?))
+               (syntax (quote #(x ...))))
+              (_ (let f ((x x) (k (lambda (ls) `(,(syntax vector) ,@ls))))
+                   (syntax-case x ()
+                     ((quote? (x ...))
+                      (isquote? (syntax quote?))
+                      (k (syntax ((quote x) ...))))
+                     ((listp x ...)
+                      (islist? (syntax listp))
+                      (k (syntax (x ...))))
+                     ((cons? x y)
+                      (iscons? (syntax cons?))
+                      (f (syntax y) (lambda (ls) (k (cons (syntax x) ls)))))
+                     (else
+                      (syntax (list->vector pat-x))))))))))
+       (quasi
+        (lambda (p lev)
+           (syntax-case p (unquote unquote-splicing quasiquote)
+              ((unquote p)
+               (if (= lev 0)
+                   (syntax p)
+                   (quasicons (syntax (quote unquote))
+                              (quasi (syntax (p)) (- lev 1)))))
+              (((unquote p ...) . q)
+               (if (= lev 0)
+                   (quasilist* (syntax (p ...)) (quasi (syntax q) lev))
+                   (quasicons (quasicons (syntax (quote unquote))
+                                         (quasi (syntax (p ...)) (- lev 1)))
+                              (quasi (syntax q) lev))))
+              (((unquote-splicing p ...) . q)
+               (if (= lev 0)
+                   (quasiappend (syntax (p ...)) (quasi (syntax q) lev))
+                   (quasicons (quasicons (syntax (quote unquote-splicing))
+                                         (quasi (syntax (p ...)) (- lev 1)))
+                              (quasi (syntax q) lev))))
+              ((quasiquote p)
+               (quasicons (syntax (quote quasiquote))
+                          (quasi (syntax (p)) (+ lev 1))))
+              ((p . q)
+               (quasicons (quasi (syntax p) lev) (quasi (syntax q) lev)))
+              (#(x ...) (quasivector (quasi (syntax (x ...)) lev)))
+              (p (syntax (quote p)))))))
+    (lambda (x)
+       (syntax-case x ()
+          ((_ e) (quasi (syntax e) 0))))))
+
+(define-syntax include
+  (lambda (x)
+    (define read-file
+      (lambda (fn k)
+        (let ((p (open-input-file fn)))
+          (let f ()
+            (let ((x (read p)))
+              (if (eof-object? x)
+                  (begin (close-input-port p) '())
+                  (cons (datum->syntax-object k x) (f))))))))
+    (syntax-case x ()
+      ((k filename)
+       (let ((fn (syntax-object->datum (syntax filename))))
+         (with-syntax (((exp ...) (read-file fn (syntax k))))
+           (syntax (begin exp ...))))))))
+
+(define-syntax unquote
+  (lambda (x)
+    (syntax-case x ()
+      ((_ e ...)
+       (syntax-error x
+         "expression not valid outside of quasiquote")))))
+
+(define-syntax unquote-splicing
+  (lambda (x)
+    (syntax-case x ()
+      ((_ e ...)
+       (syntax-error x
+         "expression not valid outside of quasiquote")))))
+
+(define-syntax case
+  (lambda (x)
+    (syntax-case x ()
+      ((_ e m1 m2 ...)
+       (with-syntax
+         ((body (let f ((clause (syntax m1)) (clauses (syntax (m2 ...))))
+                  (if (null? clauses)
+                      (syntax-case clause (else)
+                        ((else e1 e2 ...) (syntax (begin e1 e2 ...)))
+                        (((k ...) e1 e2 ...)
+                         (syntax (if (memv t '(k ...)) (begin e1 e2 ...))))
+                        (_ (syntax-error x)))
+                      (with-syntax ((rest (f (car clauses) (cdr clauses))))
+                        (syntax-case clause (else)
+                          (((k ...) e1 e2 ...)
+                           (syntax (if (memv t '(k ...))
+                                       (begin e1 e2 ...)
+                                       rest)))
+                          (_ (syntax-error x))))))))
+         (syntax (let ((t e)) body)))))))
+
+(define-syntax identifier-syntax
+  (lambda (x)
+    (syntax-case x (set!)
+      ((_ e)
+       (syntax
+         (lambda (x)
+           (syntax-case x ()
+             (id
+              (identifier? (syntax id))
+              (syntax e))
+             ((_ x (... ...))
+              (syntax (e x (... ...))))))))
+      ((_ (id exp1) ((set! var val) exp2))
+       (and (identifier? (syntax id)) (identifier? (syntax var)))
+       (syntax
+         (cons 'macro!
+           (lambda (x)
+             (syntax-case x (set!)
+               ((set! var val) (syntax exp2))
+               ((id x (... ...)) (syntax (exp1 x (... ...))))
+               (id (identifier? (syntax id)) (syntax exp1))))))))))
+
diff --git a/module/language/r5rs/spec.scm b/module/language/r5rs/spec.scm
new file mode 100644
index 000000000..67f8d74cf
--- /dev/null
+++ b/module/language/r5rs/spec.scm
@@ -0,0 +1,63 @@
+;;; Guile R5RS
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (language r5rs spec)
+  #:use-module (system base language)
+  #:use-module (language r5rs expand)
+  #:use-module (language r5rs translate)
+  #:export (r5rs))
+
+
+;;;
+;;; Translator
+;;;
+
+(define (translate x) (if (pair? x) (translate-pair x) x))
+
+(define (translate-pair x)
+  (let ((head (car x)) (rest (cdr x)))
+    (case head
+      ((quote) (cons '@quote rest))
+      ((define set! if and or begin)
+       (cons (symbol-append '@ head) (map translate rest)))
+      ((let let* letrec)
+       (cons* (symbol-append '@ head)
+	      (map (lambda (b) (cons (car b) (map translate (cdr b))))
+		   (car rest))
+	      (map translate (cdr rest))))
+      ((lambda)
+       (cons* '@lambda (car rest) (map translate (cdr rest))))
+      (else
+       (cons (translate head) (map translate rest))))))
+
+
+;;;
+;;; Language definition
+;;;
+
+(define-language r5rs
+  #:title	"Standard Scheme (R5RS + syntax-case)"
+  #:version	"0.3"
+  #:reader	read
+  #:expander	expand
+  #:translator	translate
+  #:printer	write
+;;  #:environment	(global-ref 'Language::R5RS::core)
+  )
diff --git a/module/language/scheme/compile-ghil.scm b/module/language/scheme/compile-ghil.scm
new file mode 100644
index 000000000..dc03af6cf
--- /dev/null
+++ b/module/language/scheme/compile-ghil.scm
@@ -0,0 +1,494 @@
+;;; Guile Scheme specification
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (language scheme compile-ghil)
+  #:use-module (system base pmatch)
+  #:use-module (system base language)
+  #:use-module (language ghil)
+  #:use-module (language scheme inline)
+  #:use-module (system vm objcode)
+  #:use-module (ice-9 receive)
+  #:use-module (ice-9 optargs)
+  #:use-module (language tree-il)
+  #:use-module ((system base compile) #:select (syntax-error))
+  #:export (compile-ghil translate-1
+            *translate-table* define-scheme-translator))
+
+;;; environment := #f
+;;;                | MODULE
+;;;                | COMPILE-ENV
+;;; compile-env := (MODULE LEXICALS|GHIL-ENV . EXTERNALS)
+(define (cenv-module env)
+  (cond ((not env) #f)
+        ((module? env) env)
+        ((and (pair? env) (module? (car env))) (car env))
+        (else (error "bad environment" env))))
+
+(define (cenv-ghil-env env)
+  (cond ((not env) (make-ghil-toplevel-env))
+        ((module? env) (make-ghil-toplevel-env))
+        ((pair? env)
+         (if (struct? (cadr env))
+             (cadr env)
+             (ghil-env-dereify (cadr env))))
+        (else (error "bad environment" env))))
+
+(define (cenv-externals env)
+  (cond ((not env) '())
+        ((module? env) '())
+        ((pair? env) (cddr env))
+        (else (error "bad environment" env))))
+
+(define (make-cenv module lexicals externals)
+  (cons module (cons lexicals externals)))
+
+
+
+(define (compile-ghil x e opts)
+  (save-module-excursion
+   (lambda ()
+     (and=> (cenv-module e) set-current-module)
+     (call-with-ghil-environment (cenv-ghil-env e) '()
+       (lambda (env vars)
+         (let ((x (tree-il->scheme
+                   (sc-expand x 'c '(compile load eval)))))
+           (let ((x (make-ghil-lambda env #f vars #f '()
+                                      (translate-1 env #f x)))
+                 (cenv (make-cenv (current-module)
+                                  (ghil-env-parent env)
+                                  (if e (cenv-externals e) '()))))
+             (values x cenv cenv))))))))
+
+
+;;;
+;;; Translator
+;;;
+
+(define *forbidden-primitives*
+  ;; Guile's `procedure->macro' family is evil because it crosses the
+  ;; compilation boundary.  One solution might be to evaluate calls to
+  ;; `procedure->memoizing-macro' at compilation time, but it may be more
+  ;; compicated than that.
+  '(procedure->syntax procedure->macro))
+
+;; Looks up transformers relative to the current module at
+;; compilation-time. See also the discussion of ghil-lookup in ghil.scm.
+;;
+;; FIXME shadowing lexicals?
+(define (lookup-transformer head retrans)
+  (define (module-ref/safe mod sym)
+    (and mod
+         (and=> (module-variable mod sym) 
+                (lambda (var)
+                  ;; unbound vars can happen if the module
+                  ;; definition forward-declared them
+                  (and (variable-bound? var) (variable-ref var))))))
+  (let* ((mod (current-module))
+         (val (cond
+               ((symbol? head) (module-ref/safe mod head))
+               ((pmatch head
+                  ((@ ,modname ,sym)
+                   (module-ref/safe (resolve-interface modname) sym))
+                  ((@@ ,modname ,sym)
+                   (module-ref/safe (resolve-module modname) sym))
+                  (else #f)))
+               (else #f))))
+    (cond
+     ((hashq-ref *translate-table* val))
+
+     ((macro? val)
+      (syntax-error #f "unknown kind of macro" head))
+
+     (else #f))))
+
+(define (translate-1 e l x)
+  (let ((l (or l (location x))))
+    (define (retrans x) (translate-1 e #f x))
+    (define (retrans/loc x) (translate-1 e (or (location x) l) x))
+    (cond ((pair? x)
+           (let ((head (car x)) (tail (cdr x)))
+             (cond
+              ((lookup-transformer head retrans/loc)
+               => (lambda (t) (t e l x)))
+
+              ;; FIXME: lexical/module overrides of forbidden primitives
+              ((memq head *forbidden-primitives*)
+               (syntax-error l (format #f "`~a' is forbidden" head)
+                             (cons head tail)))
+
+              (else
+               (let ((tail (map retrans tail)))
+                 (or (and (symbol? head)
+                          (try-inline-with-env e l (cons head tail)))
+                     (make-ghil-call e l (retrans head) tail)))))))
+
+          ((symbol? x)
+           (make-ghil-ref e l (ghil-var-for-ref! e x)))
+
+          ;; fixme: non-self-quoting objects like #<foo>
+          (else
+           (make-ghil-quote e l x)))))
+
+(define (valid-bindings? bindings . it-is-for-do)
+  (define (valid-binding? b)
+    (pmatch b 
+      ((,sym ,var) (guard (symbol? sym)) #t)
+      ((,sym ,var ,update) (guard (pair? it-is-for-do) (symbol? sym)) #t)
+      (else #f)))
+  (and (list? bindings) (and-map valid-binding? bindings)))
+
+(define *translate-table* (make-hash-table))
+
+(define-macro (-> form)
+  `(,(symbol-append 'make-ghil- (car form)) e l . ,(cdr form)))
+
+(define-macro (define-scheme-translator sym . clauses)
+  `(hashq-set! (@ (language scheme compile-ghil) *translate-table*)
+               (module-ref (current-module) ',sym)
+               (lambda (e l exp)
+                 (define (retrans x)
+                   ((@ (language scheme compile-ghil) translate-1)
+                    e
+                    (or ((@@ (language scheme compile-ghil) location) x) l)
+                    x))
+                 (define syntax-error (@ (system base compile) syntax-error))
+                 (pmatch (cdr exp)
+                         ,@clauses
+                         ,@(if (assq 'else clauses) '()
+                               `((else
+                                  (syntax-error l (format #f "bad ~A" ',sym) exp))))))))
+
+(define-scheme-translator quote
+  ;; (quote OBJ)
+  ((,obj)
+   (-> (quote obj))))
+    
+(define-scheme-translator quasiquote
+  ;; (quasiquote OBJ)
+  ((,obj)
+   (-> (quasiquote (trans-quasiquote e l obj 0)))))
+
+(define-scheme-translator define
+  ;; (define NAME VAL)
+  ((,name ,val) (guard (symbol? name)
+                       (ghil-toplevel-env? (ghil-env-parent e)))
+   (-> (define (ghil-var-define! (ghil-env-parent e) name)
+               (maybe-name-value! (retrans val) name))))
+  ;; (define (NAME FORMALS...) BODY...)
+  (((,name . ,formals) . ,body) (guard (symbol? name))
+   ;; -> (define NAME (lambda FORMALS BODY...))
+   (retrans `(define ,name (lambda ,formals ,@body)))))
+
+(define-scheme-translator set!
+  ;; (set! NAME VAL)
+  ((,name ,val) (guard (symbol? name))
+   (-> (set (ghil-var-for-set! e name) (retrans val))))
+
+  ;; FIXME: Would be nice to verify the values of @ and @@ relative
+  ;; to imported modules...
+  (((@ ,modname ,name) ,val) (guard (symbol? name)
+                                    (list? modname)
+                                    (and-map symbol? modname)
+                                    (not (ghil-var-is-bound? e '@)))
+   (-> (set (ghil-var-at-module! e modname name #t) (retrans val))))
+
+  (((@@ ,modname ,name) ,val) (guard (symbol? name)
+                                     (list? modname)
+                                     (and-map symbol? modname)
+                                     (not (ghil-var-is-bound? e '@@)))
+   (-> (set (ghil-var-at-module! e modname name #f) (retrans val))))
+
+  ;; (set! (NAME ARGS...) VAL)
+  (((,name . ,args) ,val) (guard (symbol? name))
+   ;; -> ((setter NAME) ARGS... VAL)
+   (retrans `((setter ,name) . (,@args ,val)))))
+
+(define-scheme-translator if
+  ;; (if TEST THEN [ELSE])
+  ((,test ,then)
+   (-> (if (retrans test) (retrans then) (retrans '(begin)))))
+  ((,test ,then ,else)
+   (-> (if (retrans test) (retrans then) (retrans else)))))
+
+(define-scheme-translator and
+  ;; (and EXPS...)
+  (,tail
+   (-> (and (map retrans tail)))))
+
+(define-scheme-translator or
+  ;; (or EXPS...)
+  (,tail
+   (-> (or (map retrans tail)))))
+
+(define-scheme-translator begin
+  ;; (begin EXPS...)
+  (,tail
+   (-> (begin (map retrans tail)))))
+
+(define-scheme-translator let
+  ;; (let NAME ((SYM VAL) ...) BODY...)
+  ((,name ,bindings . ,body) (guard (symbol? name)
+                                    (valid-bindings? bindings))
+   ;; -> (letrec ((NAME (lambda (SYM...) BODY...))) (NAME VAL...))
+   (retrans `(letrec ((,name (lambda ,(map car bindings) ,@body)))
+               (,name ,@(map cadr bindings)))))
+
+  ;; (let () BODY...)
+  ((() . ,body)
+   ;; Note: this differs from `begin'
+   (-> (begin (list (trans-body e l body)))))
+    
+  ;; (let ((SYM VAL) ...) BODY...)
+  ((,bindings . ,body) (guard (valid-bindings? bindings))
+   (let ((vals (map (lambda (b)
+                      (maybe-name-value! (retrans (cadr b)) (car b)))
+                    bindings)))
+     (call-with-ghil-bindings e (map car bindings)
+       (lambda (vars)
+         (-> (bind vars vals (trans-body e l body))))))))
+
+(define-scheme-translator let*
+  ;; (let* ((SYM VAL) ...) BODY...)
+  ((() . ,body)
+   (retrans `(let () ,@body)))
+  ((((,sym ,val) . ,rest) . ,body) (guard (symbol? sym))
+   (retrans `(let ((,sym ,val)) (let* ,rest ,@body)))))
+
+(define-scheme-translator letrec
+  ;; (letrec ((SYM VAL) ...) BODY...)
+  ((,bindings . ,body) (guard (valid-bindings? bindings))
+   (call-with-ghil-bindings e (map car bindings)
+     (lambda (vars)
+       (let ((vals (map (lambda (b)
+                          (maybe-name-value!
+                           (retrans (cadr b)) (car b)))
+                        bindings)))
+         (-> (bind vars vals (trans-body e l body))))))))
+
+(define-scheme-translator cond
+  ;; (cond (CLAUSE BODY...) ...)
+  (() (retrans '(begin)))
+  (((else . ,body)) (retrans `(begin ,@body)))
+  (((,test) . ,rest) (retrans `(or ,test (cond ,@rest))))
+  (((,test => ,proc) . ,rest)
+   ;; FIXME hygiene!
+   (retrans `(let ((_t ,test)) (if _t (,proc _t) (cond ,@rest)))))
+  (((,test . ,body) . ,rest)
+   (retrans `(if ,test (begin ,@body) (cond ,@rest)))))
+
+(define-scheme-translator case
+  ;; (case EXP ((KEY...) BODY...) ...)
+  ((,exp . ,clauses)
+   (retrans
+    ;; FIXME hygiene!
+    `(let ((_t ,exp))
+       ,(let loop ((ls clauses))
+          (cond ((null? ls) '(begin))
+                ((eq? (caar ls) 'else) `(begin ,@(cdar ls)))
+                (else `(if (memv _t ',(caar ls))
+                           (begin ,@(cdar ls))
+                           ,(loop (cdr ls))))))))))
+
+(define-scheme-translator do
+  ;; (do ((SYM VAL [UPDATE]) ...) (TEST RESULT...) BODY...)
+  ((,bindings (,test . ,result) . ,body)
+   (let ((sym (map car bindings))
+         (val (map cadr bindings))
+         (update (map cddr bindings)))
+     (define (next s x) (if (pair? x) (car x) s))
+     (retrans
+      ;; FIXME hygiene!
+      `(letrec ((_l (lambda ,sym
+                      (if ,test
+                          (begin ,@result)
+                          (begin ,@body
+                                 (_l ,@(map next sym update)))))))
+         (_l ,@val))))))
+
+(define-scheme-translator lambda
+  ;; (lambda FORMALS BODY...)
+  ((,formals . ,body)
+   (receive (syms rest) (parse-formals formals)
+     (call-with-ghil-environment e syms
+       (lambda (e vars)
+         (receive (meta body) (parse-lambda-meta body)
+           (-> (lambda vars rest meta (trans-body e l body)))))))))
+
+(define-scheme-translator delay
+  ;; FIXME not hygienic
+  ((,expr)
+   (retrans `(make-promise (lambda () ,expr)))))
+
+(define-scheme-translator @
+  ((,modname ,sym)
+   (-> (ref (ghil-var-at-module! e modname sym #t)))))
+
+(define-scheme-translator @@
+  ((,modname ,sym)
+   (-> (ref (ghil-var-at-module! e modname sym #f)))))
+
+(define *the-compile-toplevel-symbol* 'compile-toplevel)
+(define-scheme-translator eval-when
+  ((,when . ,body) (guard (list? when) (and-map symbol? when))
+   (if (memq 'compile when)
+       (primitive-eval `(begin . ,body)))
+   (if (memq 'load when)
+       (retrans `(begin . ,body))
+       (retrans `(begin)))))
+
+(define-scheme-translator apply
+  ;; FIXME: not hygienic, relies on @apply not being shadowed
+  (,args (retrans `(@apply ,@args))))
+
+;; FIXME: we could add inliners for `list' and `vector'
+
+(define-scheme-translator @apply
+  ((,proc ,arg1 . ,args)
+   (let ((args (cons (retrans arg1) (map retrans args))))
+     (cond ((and (symbol? proc)
+                 (not (ghil-var-is-bound? e proc))
+                 (and=> (module-variable (current-module) proc)
+                        (lambda (var)
+                          (and (variable-bound? var)
+                               (lookup-apply-transformer (variable-ref var))))))
+            ;; that is, a variable, not part of this compilation
+            ;; unit, but defined in the toplevel environment, and has
+            ;; an apply transformer registered
+            => (lambda (t) (t e l args)))
+           (else
+            (-> (inline 'apply (cons (retrans proc) args))))))))
+
+(define-scheme-translator call-with-values
+  ;; FIXME: not hygienic, relies on @call-with-values not being shadowed
+  ((,producer ,consumer)
+   (retrans `(@call-with-values ,producer ,consumer)))
+  (else #f))
+
+(define-scheme-translator @call-with-values
+  ((,producer ,consumer)
+   (-> (mv-call (retrans producer) (retrans consumer)))))
+
+(define-scheme-translator call-with-current-continuation
+  ;; FIXME: not hygienic, relies on @call-with-current-continuation
+  ;; not being shadowed
+  ((,proc)
+   (retrans `(@call-with-current-continuation ,proc)))
+  (else #f))
+
+(define-scheme-translator @call-with-current-continuation
+  ((,proc)
+   (-> (inline 'call/cc (list (retrans proc))))))
+
+(define-scheme-translator receive
+  ((,formals ,producer-exp . ,body)
+   ;; Lovely, self-referential usage. Not strictly necessary, the
+   ;; macro would do the trick; but it's good to test the mv-bind
+   ;; code.
+   (receive (syms rest) (parse-formals formals)
+            (let ((producer (retrans `(lambda () ,producer-exp))))
+              (call-with-ghil-bindings e syms
+                (lambda (vars)
+                  (-> (mv-bind producer vars rest
+                               (trans-body e l body)))))))))
+
+(define-scheme-translator values
+  ((,x) (retrans x))
+  (,args
+   (-> (values (map retrans args)))))
+
+(define (lookup-apply-transformer proc)
+  (cond ((eq? proc values)
+         (lambda (e l args)
+           (-> (values* args))))
+        (else #f)))
+
+(define (trans-quasiquote e l x level)
+  (cond ((not (pair? x)) x)
+	((memq (car x) '(unquote unquote-splicing))
+	 (let ((l (location x)))
+	   (pmatch (cdr x)
+	     ((,obj)
+              (cond
+               ((zero? level) 
+                (if (eq? (car x) 'unquote)
+                    (-> (unquote (translate-1 e l obj)))
+                    (-> (unquote-splicing (translate-1 e l obj)))))
+               (else
+                (list (car x) (trans-quasiquote e l obj (1- level))))))
+	     (else (syntax-error l (format #f "bad ~A" (car x)) x)))))
+        ((eq? (car x) 'quasiquote)
+	 (let ((l (location x)))
+	   (pmatch (cdr x)
+	     ((,obj) (list 'quasiquote (trans-quasiquote e l obj (1+ level))))
+             (else (syntax-error l (format #f "bad ~A" (car x)) x)))))
+	(else (cons (trans-quasiquote e l (car x) level)
+		    (trans-quasiquote e l (cdr x) level)))))
+
+(define (trans-body e l body)
+  (define (define->binding df)
+    (pmatch (cdr df)
+      ((,name ,val) (guard (symbol? name)) (list name val))
+      (((,name . ,formals) . ,body) (guard (symbol? name))
+       (list name `(lambda ,formals ,@body)))
+      (else (syntax-error (location df) "bad define" df))))
+  ;; main
+  (let loop ((ls body) (ds '()))
+    (pmatch ls
+      (() (syntax-error l "bad body" body))
+      (((define . _) . _)
+       (loop (cdr ls) (cons (car ls) ds)))
+      (else
+       (if (null? ds)
+           (translate-1 e l `(begin ,@ls))
+           (translate-1 e l `(letrec ,(map define->binding ds) ,@ls)))))))
+
+(define (parse-formals formals)
+  (cond
+   ;; (lambda x ...)
+   ((symbol? formals) (values (list formals) #t))
+   ;; (lambda (x y z) ...)
+   ((list? formals) (values formals #f))
+   ;; (lambda (x y . z) ...)
+   ((pair? formals)
+    (let loop ((l formals) (v '()))
+      (if (pair? l)
+	  (loop (cdr l) (cons (car l) v))
+	  (values (reverse! (cons l v)) #t))))
+   (else (syntax-error (location formals) "bad formals" formals))))
+
+(define (parse-lambda-meta body)
+  (cond ((or (null? body) (null? (cdr body))) (values '() body))
+        ((string? (car body))
+         (values `((documentation . ,(car body))) (cdr body)))
+        (else (values '() body))))
+
+(define (maybe-name-value! val name)
+  (cond
+   ((ghil-lambda? val)
+    (if (not (assq-ref (ghil-lambda-meta val) 'name))
+        (set! (ghil-lambda-meta val)
+              (acons 'name name (ghil-lambda-meta val))))))
+  val)
+
+(define (location x)
+  (and (pair? x)
+       (let ((props (source-properties x)))
+	 (and (not (null? props))
+              props))))
diff --git a/module/language/scheme/compile-tree-il.scm b/module/language/scheme/compile-tree-il.scm
new file mode 100644
index 000000000..4ac33d77e
--- /dev/null
+++ b/module/language/scheme/compile-tree-il.scm
@@ -0,0 +1,63 @@
+;;; Guile Scheme specification
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (language scheme compile-tree-il)
+  #:use-module (language tree-il)
+  #:export (compile-tree-il))
+
+;;; environment := #f
+;;;                | MODULE
+;;;                | COMPILE-ENV
+;;; compile-env := (MODULE LEXICALS . EXTERNALS)
+(define (cenv-module env)
+  (cond ((not env) #f)
+        ((module? env) env)
+        ((and (pair? env) (module? (car env))) (car env))
+        (else (error "bad environment" env))))
+
+(define (cenv-lexicals env)
+  (cond ((not env) '())
+        ((module? env) '())
+        ((pair? env) (cadr env))
+        (else (error "bad environment" env))))
+
+(define (cenv-externals env)
+  (cond ((not env) '())
+        ((module? env) '())
+        ((pair? env) (cddr env))
+        (else (error "bad environment" env))))
+
+(define (make-cenv module lexicals externals)
+  (cons module (cons lexicals externals)))
+
+(define (location x)
+  (and (pair? x)
+       (let ((props (source-properties x)))
+	 (and (not (null? props))
+              props))))
+
+(define (compile-tree-il x e opts)
+  (save-module-excursion
+   (lambda ()
+     (and=> (cenv-module e) set-current-module)
+     (let* ((x (sc-expand x 'c '(compile load eval)))
+            (cenv (make-cenv (current-module)
+                             (cenv-lexicals e) (cenv-externals e))))
+       (values x cenv cenv)))))
diff --git a/module/language/scheme/decompile-tree-il.scm b/module/language/scheme/decompile-tree-il.scm
new file mode 100644
index 000000000..9243f4e6a
--- /dev/null
+++ b/module/language/scheme/decompile-tree-il.scm
@@ -0,0 +1,26 @@
+;;; Guile VM code converters
+
+;; Copyright (C) 2001,2009 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (language scheme decompile-tree-il)
+  #:use-module (language tree-il)
+  #:export (decompile-tree-il))
+
+(define (decompile-tree-il x env opts)
+  (values (tree-il->scheme x) env))
diff --git a/module/language/scheme/inline.scm b/module/language/scheme/inline.scm
new file mode 100644
index 000000000..b178b2adc
--- /dev/null
+++ b/module/language/scheme/inline.scm
@@ -0,0 +1,205 @@
+;;; GHIL macros
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (language scheme inline)
+  #:use-module (system base syntax)
+  #:use-module (language ghil)
+  #:use-module (srfi srfi-16)
+  #:export (*inline-table* define-inline try-inline try-inline-with-env))
+
+(define *inline-table* '())
+
+(define-macro (define-inline sym . clauses)
+  (define (inline-args args)
+    (let lp ((in args) (out '()))
+      (cond ((null? in) `(list ,@(reverse out)))
+            ((symbol? in) `(cons* ,@(reverse out) ,in))
+            ((pair? (car in))
+             (lp (cdr in)
+                 (cons `(or (try-inline ,(caar in) ,(inline-args (cdar in)))
+                            (error "what" ',(car in)))
+                       out)))
+            ((symbol? (car in))
+             ;; assume it's locally bound
+             (lp (cdr in) (cons (car in) out)))
+            ((number? (car in))
+             (lp (cdr in) (cons `(make-ghil-quote #f #f ,(car in)) out)))
+            (else
+             (error "what what" (car in))))))
+  (define (consequent exp)
+    (cond
+     ((pair? exp)
+      `(make-ghil-inline #f #f ',(car exp) ,(inline-args (cdr exp))))
+     ((symbol? exp)
+      ;; assume locally bound
+      exp)
+     ((number? exp)
+      `(make-ghil-quote #f #f ,exp))
+     (else (error "bad consequent yall" exp))))
+  `(set! (@ (language scheme inline) *inline-table*)
+         (assq-set! (@ (language scheme inline) *inline-table*)
+                    ,sym
+                    (let ((make-ghil-inline (@ (language ghil) make-ghil-inline))
+                          (make-ghil-quote (@ (language ghil) make-ghil-quote))
+                          (try-inline (@ (language scheme inline) try-inline)))
+                      (case-lambda
+                       ,@(let lp ((in clauses) (out '()))
+                           (if (null? in)
+                               (reverse (cons '(else #f) out))
+                               (lp (cddr in)
+                                   (cons `(,(car in)
+                                           ,(consequent (cadr in))) out)))))))))
+
+(define (try-inline head-value args)
+  (and=> (assq-ref *inline-table* head-value)
+         (lambda (proc) (apply proc args))))
+
+
+(define (try-inline-with-env env loc exp)
+  (let ((sym (car exp)))
+    (let loop ((e env))
+      (record-case e
+        ((<ghil-toplevel-env> table)
+         (let ((mod (current-module)))
+           (and (not (assoc-ref table (cons (module-name mod) sym)))
+                (module-bound? mod sym)
+                (try-inline (module-ref mod sym) (cdr exp)))))
+        ((<ghil-env> parent table variables)
+         (and (not (assq-ref table sym))
+              (loop parent)))))))
+
+(define-inline eq? (x y)
+  (eq? x y))
+
+(define-inline eqv? (x y)
+  (eqv? x y))
+
+(define-inline equal? (x y)
+  (equal? x y))
+  
+(define-inline = (x y)
+  (ee? x y))
+
+(define-inline < (x y)
+  (lt? x y))
+
+(define-inline > (x y)
+  (gt? x y))
+
+(define-inline <= (x y)
+  (le? x y))
+
+(define-inline >= (x y)
+  (ge? x y))
+
+(define-inline zero? (x)
+  (ee? x 0))
+  
+(define-inline +
+  () 0
+  (x) x
+  (x y) (add x y)
+  (x y . rest) (add x (+ y . rest)))
+  
+(define-inline *
+  () 1
+  (x) x
+  (x y) (mul x y)
+  (x y . rest) (mul x (* y . rest)))
+  
+(define-inline -
+  (x) (sub 0 x)
+  (x y) (sub x y)
+  (x y . rest) (sub x (+ y . rest)))
+  
+(define-inline 1-
+  (x) (sub x 1))
+
+(define-inline /
+  (x) (div 1 x)
+  (x y) (div x y)
+  (x y . rest) (div x (* y . rest)))
+  
+(define-inline quotient (x y)
+  (quo x y))
+
+(define-inline remainder (x y)
+  (rem x y))
+
+(define-inline modulo (x y)
+  (mod x y))
+
+(define-inline not (x)
+  (not x))
+
+(define-inline pair? (x)
+  (pair? x))
+
+(define-inline cons (x y)
+  (cons x y))
+
+(define-inline car (x) (car x))
+(define-inline cdr (x) (cdr x))
+
+(define-inline set-car! (x y) (set-car! x y))
+(define-inline set-cdr! (x y) (set-cdr! x y))
+
+(define-inline caar (x) (car (car x)))
+(define-inline cadr (x) (car (cdr x)))
+(define-inline cdar (x) (cdr (car x)))
+(define-inline cddr (x) (cdr (cdr x)))
+(define-inline caaar (x) (car (car (car x))))
+(define-inline caadr (x) (car (car (cdr x))))
+(define-inline cadar (x) (car (cdr (car x))))
+(define-inline caddr (x) (car (cdr (cdr x))))
+(define-inline cdaar (x) (cdr (car (car x))))
+(define-inline cdadr (x) (cdr (car (cdr x))))
+(define-inline cddar (x) (cdr (cdr (car x))))
+(define-inline cdddr (x) (cdr (cdr (cdr x))))
+(define-inline caaaar (x) (car (car (car (car x)))))
+(define-inline caaadr (x) (car (car (car (cdr x)))))
+(define-inline caadar (x) (car (car (cdr (car x)))))
+(define-inline caaddr (x) (car (car (cdr (cdr x)))))
+(define-inline cadaar (x) (car (cdr (car (car x)))))
+(define-inline cadadr (x) (car (cdr (car (cdr x)))))
+(define-inline caddar (x) (car (cdr (cdr (car x)))))
+(define-inline cadddr (x) (car (cdr (cdr (cdr x)))))
+(define-inline cdaaar (x) (cdr (car (car (car x)))))
+(define-inline cdaadr (x) (cdr (car (car (cdr x)))))
+(define-inline cdadar (x) (cdr (car (cdr (car x)))))
+(define-inline cdaddr (x) (cdr (car (cdr (cdr x)))))
+(define-inline cddaar (x) (cdr (cdr (car (car x)))))
+(define-inline cddadr (x) (cdr (cdr (car (cdr x)))))
+(define-inline cdddar (x) (cdr (cdr (cdr (car x)))))
+(define-inline cddddr (x) (cdr (cdr (cdr (cdr x)))))
+
+(define-inline null? (x)
+  (null? x))
+
+(define-inline list? (x)
+  (list? x))
+
+(define-inline cons*
+  (x) x
+  (x y) (cons x y)
+  (x y . rest) (cons x (cons* y . rest)))
+
+(define-inline acons
+  (x y z) (cons (cons x y) z))
diff --git a/module/language/scheme/spec.scm b/module/language/scheme/spec.scm
new file mode 100644
index 000000000..df618581f
--- /dev/null
+++ b/module/language/scheme/spec.scm
@@ -0,0 +1,45 @@
+;;; Guile Scheme specification
+
+;; Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (language scheme spec)
+  #:use-module (system base language)
+  #:use-module (language scheme compile-tree-il)
+  #:use-module (language scheme decompile-tree-il)
+  #:export (scheme))
+
+;;;
+;;; Reader
+;;;
+
+(read-enable 'positions)
+
+;;;
+;;; Language definition
+;;;
+
+(define-language scheme
+  #:title	"Guile Scheme"
+  #:version	"0.5"
+  #:reader	read
+  #:compilers   `((tree-il . ,compile-tree-il))
+  #:decompilers `((tree-il . ,decompile-tree-il))
+  #:evaluator	(lambda (x module) (primitive-eval x))
+  #:printer	write
+  )
diff --git a/module/language/tree-il.scm b/module/language/tree-il.scm
new file mode 100644
index 000000000..ad8b73176
--- /dev/null
+++ b/module/language/tree-il.scm
@@ -0,0 +1,474 @@
+;;;; 	Copyright (C) 2009 Free Software Foundation, Inc.
+;;;; 
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+;;;; 
+
+
+(define-module (language tree-il)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
+  #:use-module (system base pmatch)
+  #:use-module (system base syntax)
+  #:export (tree-il-src
+
+            <void> void? make-void void-src
+            <const> const? make-const const-src const-exp
+            <primitive-ref> primitive-ref? make-primitive-ref primitive-ref-src primitive-ref-name
+            <lexical-ref> lexical-ref? make-lexical-ref lexical-ref-src lexical-ref-name lexical-ref-gensym
+            <lexical-set> lexical-set? make-lexical-set lexical-set-src lexical-set-name lexical-set-gensym lexical-set-exp
+            <module-ref> module-ref? make-module-ref module-ref-src module-ref-mod module-ref-name module-ref-public?
+            <module-set> module-set? make-module-set module-set-src module-set-mod module-set-name module-set-public? module-set-exp
+            <toplevel-ref> toplevel-ref? make-toplevel-ref toplevel-ref-src toplevel-ref-name
+            <toplevel-set> toplevel-set? make-toplevel-set toplevel-set-src toplevel-set-name toplevel-set-exp
+            <toplevel-define> toplevel-define? make-toplevel-define toplevel-define-src toplevel-define-name toplevel-define-exp
+            <conditional> conditional? make-conditional conditional-src conditional-test conditional-then conditional-else
+            <application> application? make-application application-src application-proc application-args
+            <sequence> sequence? make-sequence sequence-src sequence-exps
+            <lambda> lambda? make-lambda lambda-src lambda-names lambda-vars lambda-meta lambda-body
+            <let> let? make-let let-src let-names let-vars let-vals let-body
+            <letrec> letrec? make-letrec letrec-src letrec-names letrec-vars letrec-vals letrec-body
+            <fix> fix? make-fix fix-src fix-names fix-vars fix-vals fix-body
+            <let-values> let-values? make-let-values let-values-src let-values-names let-values-vars let-values-exp let-values-body
+
+            parse-tree-il
+            unparse-tree-il
+            tree-il->scheme
+
+            tree-il-fold
+            make-tree-il-folder
+            post-order!
+            pre-order!))
+
+(define-type (<tree-il> #:common-slots (src))
+  (<void>)
+  (<const> exp)
+  (<primitive-ref> name)
+  (<lexical-ref> name gensym)
+  (<lexical-set> name gensym exp)
+  (<module-ref> mod name public?)
+  (<module-set> mod name public? exp)
+  (<toplevel-ref> name)
+  (<toplevel-set> name exp)
+  (<toplevel-define> name exp)
+  (<conditional> test then else)
+  (<application> proc args)
+  (<sequence> exps)
+  (<lambda> names vars meta body)
+  (<let> names vars vals body)
+  (<letrec> names vars vals body)
+  (<fix> names vars vals body)
+  (<let-values> names vars exp body))
+  
+
+
+(define (location x)
+  (and (pair? x)
+       (let ((props (source-properties x)))
+	 (and (pair? props) props))))
+
+(define (parse-tree-il exp)
+  (let ((loc (location exp))
+        (retrans (lambda (x) (parse-tree-il x))))
+    (pmatch exp
+     ((void)
+      (make-void loc))
+
+     ((apply ,proc . ,args)
+      (make-application loc (retrans proc) (map retrans args)))
+
+     ((if ,test ,then ,else)
+      (make-conditional loc (retrans test) (retrans then) (retrans else)))
+
+     ((primitive ,name) (guard (symbol? name))
+      (make-primitive-ref loc name))
+
+     ((lexical ,name) (guard (symbol? name))
+      (make-lexical-ref loc name name))
+
+     ((lexical ,name ,sym) (guard (symbol? name) (symbol? sym))
+      (make-lexical-ref loc name sym))
+
+     ((set! (lexical ,name) ,exp) (guard (symbol? name))
+      (make-lexical-set loc name name (retrans exp)))
+
+     ((set! (lexical ,name ,sym) ,exp) (guard (symbol? name) (symbol? sym))
+      (make-lexical-set loc name sym (retrans exp)))
+
+     ((@ ,mod ,name) (guard (and-map symbol? mod) (symbol? name))
+      (make-module-ref loc mod name #t))
+
+     ((set! (@ ,mod ,name) ,exp) (guard (and-map symbol? mod) (symbol? name))
+      (make-module-set loc mod name #t (retrans exp)))
+
+     ((@@ ,mod ,name) (guard (and-map symbol? mod) (symbol? name))
+      (make-module-ref loc mod name #f))
+
+     ((set! (@@ ,mod ,name) ,exp) (guard (and-map symbol? mod) (symbol? name))
+      (make-module-set loc mod name #f (retrans exp)))
+
+     ((toplevel ,name) (guard (symbol? name))
+      (make-toplevel-ref loc name))
+
+     ((set! (toplevel ,name) ,exp) (guard (symbol? name))
+      (make-toplevel-set loc name (retrans exp)))
+
+     ((define ,name ,exp) (guard (symbol? name))
+      (make-toplevel-define loc name (retrans exp)))
+
+     ((lambda ,names ,vars ,exp)
+      (make-lambda loc names vars '() (retrans exp)))
+
+     ((lambda ,names ,vars ,meta ,exp)
+      (make-lambda loc names vars meta (retrans exp)))
+
+     ((const ,exp)
+      (make-const loc exp))
+
+     ((begin . ,exps)
+      (make-sequence loc (map retrans exps)))
+
+     ((let ,names ,vars ,vals ,body)
+      (make-let loc names vars (map retrans vals) (retrans body)))
+
+     ((letrec ,names ,vars ,vals ,body)
+      (make-letrec loc names vars (map retrans vals) (retrans body)))
+
+     ((fix ,names ,vars ,vals ,body)
+      (make-fix loc names vars (map retrans vals) (retrans body)))
+
+     ((let-values ,names ,vars ,exp ,body)
+      (make-let-values loc names vars (retrans exp) (retrans body)))
+
+     (else
+      (error "unrecognized tree-il" exp)))))
+
+(define (unparse-tree-il tree-il)
+  (record-case tree-il
+    ((<void>)
+     '(void))
+
+    ((<application> proc args)
+     `(apply ,(unparse-tree-il proc) ,@(map unparse-tree-il args)))
+
+    ((<conditional> test then else)
+     `(if ,(unparse-tree-il test) ,(unparse-tree-il then) ,(unparse-tree-il else)))
+
+    ((<primitive-ref> name)
+     `(primitive ,name))
+
+    ((<lexical-ref> name gensym)
+     `(lexical ,name ,gensym))
+
+    ((<lexical-set> name gensym exp)
+     `(set! (lexical ,name ,gensym) ,(unparse-tree-il exp)))
+
+    ((<module-ref> mod name public?)
+     `(,(if public? '@ '@@) ,mod ,name))
+
+    ((<module-set> mod name public? exp)
+     `(set! (,(if public? '@ '@@) ,mod ,name) ,(unparse-tree-il exp)))
+
+    ((<toplevel-ref> name)
+     `(toplevel ,name))
+
+    ((<toplevel-set> name exp)
+     `(set! (toplevel ,name) ,(unparse-tree-il exp)))
+
+    ((<toplevel-define> name exp)
+     `(define ,name ,(unparse-tree-il exp)))
+
+    ((<lambda> names vars meta body)
+     `(lambda ,names ,vars ,meta ,(unparse-tree-il body)))
+
+    ((<const> exp)
+     `(const ,exp))
+
+    ((<sequence> exps)
+     `(begin ,@(map unparse-tree-il exps)))
+
+    ((<let> names vars vals body)
+     `(let ,names ,vars ,(map unparse-tree-il vals) ,(unparse-tree-il body)))
+
+    ((<letrec> names vars vals body)
+     `(letrec ,names ,vars ,(map unparse-tree-il vals) ,(unparse-tree-il body)))
+
+    ((<fix> names vars vals body)
+     `(fix ,names ,vars ,(map unparse-tree-il vals) ,(unparse-tree-il body)))
+
+    ((<let-values> names vars exp body)
+     `(let-values ,names ,vars ,(unparse-tree-il exp) ,(unparse-tree-il body)))))
+
+(define (tree-il->scheme e)
+  (record-case e
+    ((<void>)
+     '(if #f #f))
+
+    ((<application> proc args)
+     `(,(tree-il->scheme proc) ,@(map tree-il->scheme args)))
+
+    ((<conditional> test then else)
+     (if (void? else)
+         `(if ,(tree-il->scheme test) ,(tree-il->scheme then))
+         `(if ,(tree-il->scheme test) ,(tree-il->scheme then) ,(tree-il->scheme else))))
+
+    ((<primitive-ref> name)
+     name)
+    
+    ((<lexical-ref> name gensym)
+     gensym)
+    
+    ((<lexical-set> name gensym exp)
+     `(set! ,gensym ,(tree-il->scheme exp)))
+    
+    ((<module-ref> mod name public?)
+     `(,(if public? '@ '@@) ,mod ,name))
+    
+    ((<module-set> mod name public? exp)
+     `(set! (,(if public? '@ '@@) ,mod ,name) ,(tree-il->scheme exp)))
+    
+    ((<toplevel-ref> name)
+     name)
+    
+    ((<toplevel-set> name exp)
+     `(set! ,name ,(tree-il->scheme exp)))
+    
+    ((<toplevel-define> name exp)
+     `(define ,name ,(tree-il->scheme exp)))
+    
+    ((<lambda> vars meta body)
+     `(lambda ,vars
+        ,@(cond ((assq-ref meta 'documentation) => list) (else '()))
+        ,(tree-il->scheme body)))
+    
+    ((<const> exp)
+     (if (and (self-evaluating? exp) (not (vector? exp)))
+         exp
+         (list 'quote exp)))
+    
+    ((<sequence> exps)
+     `(begin ,@(map tree-il->scheme exps)))
+    
+    ((<let> vars vals body)
+     `(let ,(map list vars (map tree-il->scheme vals)) ,(tree-il->scheme body)))
+    
+    ((<letrec> vars vals body)
+     `(letrec ,(map list vars (map tree-il->scheme vals)) ,(tree-il->scheme body)))
+
+    ((<fix> vars vals body)
+     ;; not a typo, we really do translate back to letrec
+     `(letrec ,(map list vars (map tree-il->scheme vals)) ,(tree-il->scheme body)))
+
+    ((<let-values> vars exp body)
+     `(call-with-values (lambda () ,(tree-il->scheme exp))
+        (lambda ,vars ,(tree-il->scheme body))))))
+
+
+(define (tree-il-fold leaf down up seed tree)
+  "Traverse TREE, calling LEAF on each leaf encountered, DOWN upon descent
+into a sub-tree, and UP when leaving a sub-tree.  Each of these procedures is
+invoked as `(PROC TREE SEED)', where TREE is the sub-tree or leaf considered
+and SEED is the current result, intially seeded with SEED.
+
+This is an implementation of `foldts' as described by Andy Wingo in
+``Applications of fold to XML transformation''."
+  (let loop ((tree   tree)
+             (result seed))
+    (if (or (null? tree) (pair? tree))
+        (fold loop result tree)
+        (record-case tree
+          ((<lexical-set> exp)
+           (up tree (loop exp (down tree result))))
+          ((<module-set> exp)
+           (up tree (loop exp (down tree result))))
+          ((<toplevel-set> exp)
+           (up tree (loop exp (down tree result))))
+          ((<toplevel-define> exp)
+           (up tree (loop exp (down tree result))))
+          ((<conditional> test then else)
+           (up tree (loop else
+                          (loop then
+                                (loop test (down tree result))))))
+          ((<application> proc args)
+           (up tree (loop (cons proc args) (down tree result))))
+          ((<sequence> exps)
+           (up tree (loop exps (down tree result))))
+          ((<lambda> body)
+           (up tree (loop body (down tree result))))
+          ((<let> vals body)
+           (up tree (loop body
+                          (loop vals
+                                (down tree result)))))
+          ((<letrec> vals body)
+           (up tree (loop body
+                          (loop vals
+                                (down tree result)))))
+          ((<fix> vals body)
+           (up tree (loop body
+                          (loop vals
+                                (down tree result)))))
+          ((<let-values> exp body)
+           (up tree (loop body (loop exp (down tree result)))))
+          (else
+           (leaf tree result))))))
+
+
+(define-syntax make-tree-il-folder
+  (syntax-rules ()
+    ((_ seed ...)
+     (lambda (tree down up seed ...)
+       (define (fold-values proc exps seed ...)
+         (if (null? exps)
+             (values seed ...)
+             (let-values (((seed ...) (proc (car exps) seed ...)))
+               (fold-values proc (cdr exps) seed ...))))
+       (let foldts ((tree tree) (seed seed) ...)
+         (let*-values
+             (((seed ...) (down tree seed ...))
+              ((seed ...)
+               (record-case tree
+                 ((<lexical-set> exp)
+                  (foldts exp seed ...))
+                 ((<module-set> exp)
+                  (foldts exp seed ...))
+                 ((<toplevel-set> exp)
+                  (foldts exp seed ...))
+                 ((<toplevel-define> exp)
+                  (foldts exp seed ...))
+                 ((<conditional> test then else)
+                  (let*-values (((seed ...) (foldts test seed ...))
+                                ((seed ...) (foldts then seed ...)))
+                    (foldts else seed ...)))
+                 ((<application> proc args)
+                  (let-values (((seed ...) (foldts proc seed ...)))
+                    (fold-values foldts args seed ...)))
+                 ((<sequence> exps)
+                  (fold-values foldts exps seed ...))
+                 ((<lambda> body)
+                  (foldts body seed ...))
+                 ((<let> vals body)
+                  (let*-values (((seed ...) (fold-values foldts vals seed ...)))
+                    (foldts body seed ...)))
+                 ((<letrec> vals body)
+                  (let*-values (((seed ...) (fold-values foldts vals seed ...)))
+                    (foldts body seed ...)))
+                 ((<fix> vals body)
+                  (let*-values (((seed ...) (fold-values foldts vals seed ...)))
+                    (foldts body seed ...)))
+                 ((<let-values> exp body)
+                  (let*-values (((seed ...) (foldts exp seed ...)))
+                    (foldts body seed ...)))
+                 (else
+                  (values seed ...)))))
+           (up tree seed ...)))))))
+
+(define (post-order! f x)
+  (let lp ((x x))
+    (record-case x
+      ((<application> proc args)
+       (set! (application-proc x) (lp proc))
+       (set! (application-args x) (map lp args)))
+
+      ((<conditional> test then else)
+       (set! (conditional-test x) (lp test))
+       (set! (conditional-then x) (lp then))
+       (set! (conditional-else x) (lp else)))
+      
+      ((<lexical-set> name gensym exp)
+       (set! (lexical-set-exp x) (lp exp)))
+      
+      ((<module-set> mod name public? exp)
+       (set! (module-set-exp x) (lp exp)))
+      
+      ((<toplevel-set> name exp)
+       (set! (toplevel-set-exp x) (lp exp)))
+      
+      ((<toplevel-define> name exp)
+       (set! (toplevel-define-exp x) (lp exp)))
+      
+      ((<lambda> vars meta body)
+       (set! (lambda-body x) (lp body)))
+      
+      ((<sequence> exps)
+       (set! (sequence-exps x) (map lp exps)))
+      
+      ((<let> vars vals body)
+       (set! (let-vals x) (map lp vals))
+       (set! (let-body x) (lp body)))
+      
+      ((<letrec> vars vals body)
+       (set! (letrec-vals x) (map lp vals))
+       (set! (letrec-body x) (lp body)))
+      
+      ((<fix> vars vals body)
+       (set! (fix-vals x) (map lp vals))
+       (set! (fix-body x) (lp body)))
+      
+      ((<let-values> vars exp body)
+       (set! (let-values-exp x) (lp exp))
+       (set! (let-values-body x) (lp body)))
+      
+      (else #f))
+    
+    (or (f x) x)))
+
+(define (pre-order! f x)
+  (let lp ((x x))
+    (let ((x (or (f x) x)))
+      (record-case x
+        ((<application> proc args)
+         (set! (application-proc x) (lp proc))
+         (set! (application-args x) (map lp args)))
+
+        ((<conditional> test then else)
+         (set! (conditional-test x) (lp test))
+         (set! (conditional-then x) (lp then))
+         (set! (conditional-else x) (lp else)))
+
+        ((<lexical-set> name gensym exp)
+         (set! (lexical-set-exp x) (lp exp)))
+               
+        ((<module-set> mod name public? exp)
+         (set! (module-set-exp x) (lp exp)))
+
+        ((<toplevel-set> name exp)
+         (set! (toplevel-set-exp x) (lp exp)))
+
+        ((<toplevel-define> name exp)
+         (set! (toplevel-define-exp x) (lp exp)))
+
+        ((<lambda> vars meta body)
+         (set! (lambda-body x) (lp body)))
+
+        ((<sequence> exps)
+         (set! (sequence-exps x) (map lp exps)))
+
+        ((<let> vars vals body)
+         (set! (let-vals x) (map lp vals))
+         (set! (let-body x) (lp body)))
+
+        ((<letrec> vars vals body)
+         (set! (letrec-vals x) (map lp vals))
+         (set! (letrec-body x) (lp body)))
+
+        ((<fix> vars vals body)
+         (set! (fix-vals x) (map lp vals))
+         (set! (fix-body x) (lp body)))
+
+        ((<let-values> vars exp body)
+         (set! (let-values-exp x) (lp exp))
+         (set! (let-values-body x) (lp body)))
+
+        (else #f))
+      x)))
diff --git a/module/language/tree-il/analyze.scm b/module/language/tree-il/analyze.scm
new file mode 100644
index 000000000..b93a0bd7e
--- /dev/null
+++ b/module/language/tree-il/analyze.scm
@@ -0,0 +1,617 @@
+;;; TREE-IL -> GLIL compiler
+
+;; Copyright (C) 2001,2008,2009 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (language tree-il analyze)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (system base syntax)
+  #:use-module (system base message)
+  #:use-module (language tree-il)
+  #:export (analyze-lexicals
+            report-unused-variables))
+
+;; Allocation is the process of assigning storage locations for lexical
+;; variables. A lexical variable has a distinct "address", or storage
+;; location, for each procedure in which it is referenced.
+;;
+;; A variable is "local", i.e., allocated on the stack, if it is
+;; referenced from within the procedure that defined it. Otherwise it is
+;; a "closure" variable. For example:
+;;
+;;    (lambda (a) a) ; a will be local
+;; `a' is local to the procedure.
+;;
+;;    (lambda (a) (lambda () a))
+;; `a' is local to the outer procedure, but a closure variable with
+;; respect to the inner procedure.
+;;
+;; If a variable is ever assigned, it needs to be heap-allocated
+;; ("boxed"). This is so that closures and continuations capture the
+;; variable's identity, not just one of the values it may have over the
+;; course of program execution. If the variable is never assigned, there
+;; is no distinction between value and identity, so closing over its
+;; identity (whether through closures or continuations) can make a copy
+;; of its value instead.
+;;
+;; Local variables are stored on the stack within a procedure's call
+;; frame. Their index into the stack is determined from their linear
+;; postion within a procedure's binding path:
+;; (let (0 1)
+;;   (let (2 3) ...)
+;;   (let (2) ...))
+;;   (let (2 3 4) ...))
+;; etc.
+;;
+;; This algorithm has the problem that variables are only allocated
+;; indices at the end of the binding path. If variables bound early in
+;; the path are not used in later portions of the path, their indices
+;; will not be recycled. This problem is particularly egregious in the
+;; expansion of `or':
+;;
+;;  (or x y z)
+;;    -> (let ((a x)) (if a a (let ((b y)) (if b b z))))
+;;
+;; As you can see, the `a' binding is only used in the ephemeral `then'
+;; clause of the first `if', but its index would be reserved for the
+;; whole of the `or' expansion. So we have a hack for this specific
+;; case. A proper solution would be some sort of liveness analysis, and
+;; not our linear allocation algorithm.
+;;
+;; Closure variables are captured when a closure is created, and stored
+;; in a vector. Each closure variable has a unique index into that
+;; vector.
+;;
+;; There is one more complication. Procedures bound by <fix> may, in
+;; some cases, be rendered inline to their parent procedure. That is to
+;; say,
+;;
+;;  (letrec ((lp (lambda () (lp)))) (lp))
+;;    => (fix ((lp (lambda () (lp)))) (lp))
+;;      => goto FIX-BODY; LP: goto LP; FIX-BODY: goto LP;
+;;         ^ jump over the loop  ^ the fixpoint lp ^ starting off the loop
+;;
+;; The upshot is that we don't have to allocate any space for the `lp'
+;; closure at all, as it can be rendered inline as a loop. So there is
+;; another kind of allocation, "label allocation", in which the
+;; procedure is simply a label, placed at the start of the lambda body.
+;; The label is the gensym under which the lambda expression is bound.
+;;
+;; The analyzer checks to see that the label is called with the correct
+;; number of arguments. Calls to labels compile to rename + goto.
+;; Lambda, the ultimate goto!
+;;
+;;
+;; The return value of `analyze-lexicals' is a hash table, the
+;; "allocation".
+;;
+;; The allocation maps gensyms -- recall that each lexically bound
+;; variable has a unique gensym -- to storage locations ("addresses").
+;; Since one gensym may have many storage locations, if it is referenced
+;; in many procedures, it is a two-level map.
+;;
+;; The allocation also stored information on how many local variables
+;; need to be allocated for each procedure, lexicals that have been
+;; translated into labels, and information on what free variables to
+;; capture from its lexical parent procedure.
+;;
+;; That is:
+;;
+;;  sym -> {lambda -> address}
+;;  lambda -> (nlocs labels . free-locs)
+;;
+;; address ::= (local? boxed? . index)
+;; labels ::= ((sym . lambda-vars) ...)
+;; free-locs ::= ((sym0 . address0) (sym1 . address1) ...)
+;; free variable addresses are relative to parent proc.
+
+(define (make-hashq k v)
+  (let ((res (make-hash-table)))
+    (hashq-set! res k v)
+    res))
+
+(define (analyze-lexicals x)
+  ;; bound-vars: lambda -> (sym ...)
+  ;;  all identifiers bound within a lambda
+  (define bound-vars (make-hash-table))
+  ;; free-vars: lambda -> (sym ...)
+  ;;  all identifiers referenced in a lambda, but not bound
+  ;;  NB, this includes identifiers referenced by contained lambdas
+  (define free-vars (make-hash-table))
+  ;; assigned: sym -> #t
+  ;;  variables that are assigned
+  (define assigned (make-hash-table))
+  ;; refcounts: sym -> count
+  ;;  allows us to detect the or-expansion in O(1) time
+  (define refcounts (make-hash-table))
+  ;; labels: sym -> lambda-vars
+  ;;  for determining if fixed-point procedures can be rendered as
+  ;;  labels. lambda-vars may be an improper list.
+  (define labels (make-hash-table))
+
+  ;; returns variables referenced in expr
+  (define (analyze! x proc labels-in-proc tail? tail-call-args)
+    (define (step y) (analyze! y proc labels-in-proc #f #f))
+    (define (step-tail y) (analyze! y proc labels-in-proc tail? #f))
+    (define (step-tail-call y args) (analyze! y proc labels-in-proc #f
+                                              (and tail? args)))
+    (define (recur/labels x new-proc labels)
+      (analyze! x new-proc (append labels labels-in-proc) #t #f))
+    (define (recur x new-proc) (analyze! x new-proc '() tail? #f))
+    (record-case x
+      ((<application> proc args)
+       (apply lset-union eq? (step-tail-call proc args)
+              (map step args)))
+
+      ((<conditional> test then else)
+       (lset-union eq? (step test) (step-tail then) (step-tail else)))
+
+      ((<lexical-ref> name gensym)
+       (hashq-set! refcounts gensym (1+ (hashq-ref refcounts gensym 0)))
+       (if (not (and tail-call-args
+                     (memq gensym labels-in-proc)
+                     (let ((args (hashq-ref labels gensym)))
+                       (and (list? args)
+                            (= (length args) (length tail-call-args))))))
+           (hashq-set! labels gensym #f))
+       (list gensym))
+      
+      ((<lexical-set> name gensym exp)
+       (hashq-set! assigned gensym #t)
+       (hashq-set! labels gensym #f)
+       (lset-adjoin eq? (step exp) gensym))
+      
+      ((<module-set> mod name public? exp)
+       (step exp))
+      
+      ((<toplevel-set> name exp)
+       (step exp))
+      
+      ((<toplevel-define> name exp)
+       (step exp))
+      
+      ((<sequence> exps)
+       (let lp ((exps exps) (ret '()))
+         (cond ((null? exps) '())
+               ((null? (cdr exps))
+                (lset-union eq? ret (step-tail (car exps))))
+               (else
+                (lp (cdr exps) (lset-union eq? ret (step (car exps))))))))
+      
+      ((<lambda> vars meta body)
+       (let ((locally-bound (let rev* ((vars vars) (out '()))
+                              (cond ((null? vars) out)
+                                    ((pair? vars) (rev* (cdr vars)
+                                                        (cons (car vars) out)))
+                                    (else (cons vars out))))))
+         (hashq-set! bound-vars x locally-bound)
+         (let* ((referenced (recur body x))
+                (free (lset-difference eq? referenced locally-bound))
+                (all-bound (reverse! (hashq-ref bound-vars x))))
+           (hashq-set! bound-vars x all-bound)
+           (hashq-set! free-vars x free)
+           free)))
+      
+      ((<let> vars vals body)
+       (hashq-set! bound-vars proc
+                   (append (reverse vars) (hashq-ref bound-vars proc)))
+       (lset-difference eq?
+                        (apply lset-union eq? (step-tail body) (map step vals))
+                        vars))
+      
+      ((<letrec> vars vals body)
+       (hashq-set! bound-vars proc
+                   (append (reverse vars) (hashq-ref bound-vars proc)))
+       (for-each (lambda (sym) (hashq-set! assigned sym #t)) vars)
+       (lset-difference eq?
+                        (apply lset-union eq? (step-tail body) (map step vals))
+                        vars))
+      
+      ((<fix> vars vals body)
+       ;; Try to allocate these procedures as labels.
+       (for-each (lambda (sym val) (hashq-set! labels sym (lambda-vars val)))
+                 vars vals)
+       (hashq-set! bound-vars proc
+                   (append (reverse vars) (hashq-ref bound-vars proc)))
+       ;; Step into subexpressions.
+       (let* ((var-refs
+               (map
+                ;; Since we're trying to label-allocate the lambda,
+                ;; pretend it's not a closure, and just recurse into its
+                ;; body directly. (Otherwise, recursing on a closure
+                ;; that references one of the fix's bound vars would
+                ;; prevent label allocation.)
+                (lambda (x)
+                  (record-case x
+                    ((<lambda> (lvars vars) body)
+                     (let ((locally-bound
+                            (let rev* ((lvars lvars) (out '()))
+                              (cond ((null? lvars) out)
+                                    ((pair? lvars) (rev* (cdr lvars)
+                                                         (cons (car lvars) out)))
+                                    (else (cons lvars out))))))
+                       (hashq-set! bound-vars x locally-bound)
+                       ;; recur/labels, the difference from the closure case
+                       (let* ((referenced (recur/labels body x vars))
+                              (free (lset-difference eq? referenced locally-bound))
+                              (all-bound (reverse! (hashq-ref bound-vars x))))
+                         (hashq-set! bound-vars x all-bound)
+                         (hashq-set! free-vars x free)
+                         free)))))
+                vals))
+              (vars-with-refs (map cons vars var-refs))
+              (body-refs (recur/labels body proc vars)))
+         (define (delabel-dependents! sym)
+           (let ((refs (assq-ref vars-with-refs sym)))
+             (if refs
+                 (for-each (lambda (sym)
+                             (if (hashq-ref labels sym)
+                                 (begin
+                                   (hashq-set! labels sym #f)
+                                   (delabel-dependents! sym))))
+                           refs))))
+         ;; Stepping into the lambdas and the body might have made some
+         ;; procedures not label-allocatable -- which might have
+         ;; knock-on effects. For example:
+         ;;   (fix ((a (lambda () (b)))
+         ;;         (b (lambda () a)))
+         ;;     (a))
+         ;; As far as `a' is concerned, both `a' and `b' are
+         ;; label-allocatable. But `b' references `a' not in a proc-tail
+         ;; position, which makes `a' not label-allocatable. The
+         ;; knock-on effect is that, when back-propagating this
+         ;; information to `a', `b' will also become not
+         ;; label-allocatable, as it is referenced within `a', which is
+         ;; allocated as a closure. This is a transitive relationship.
+         (for-each (lambda (sym)
+                     (if (not (hashq-ref labels sym))
+                         (delabel-dependents! sym)))
+                   vars)
+         ;; Now lift bound variables with label-allocated lambdas to the
+         ;; parent procedure.
+         (for-each
+          (lambda (sym val)
+            (if (hashq-ref labels sym)
+                ;; Remove traces of the label-bound lambda. The free
+                ;; vars will propagate up via the return val.
+                (begin
+                  (hashq-set! bound-vars proc
+                              (append (hashq-ref bound-vars val)
+                                      (hashq-ref bound-vars proc)))
+                  (hashq-remove! bound-vars val)
+                  (hashq-remove! free-vars val))))
+          vars vals)
+         (lset-difference eq?
+                          (apply lset-union eq? body-refs var-refs)
+                          vars)))
+      
+      ((<let-values> vars exp body)
+       (let ((bound (let lp ((out (hashq-ref bound-vars proc)) (in vars))
+                      (if (pair? in)
+                          (lp (cons (car in) out) (cdr in))
+                          (if (null? in) out (cons in out))))))
+         (hashq-set! bound-vars proc bound)
+         (lset-difference eq?
+                          (lset-union eq? (step exp) (step-tail body))
+                          bound)))
+      
+      (else '())))
+  
+  ;; allocation: sym -> {lambda -> address}
+  ;;             lambda -> (nlocs labels . free-locs)
+  (define allocation (make-hash-table))
+  
+  (define (allocate! x proc n)
+    (define (recur y) (allocate! y proc n))
+    (record-case x
+      ((<application> proc args)
+       (apply max (recur proc) (map recur args)))
+
+      ((<conditional> test then else)
+       (max (recur test) (recur then) (recur else)))
+
+      ((<lexical-set> name gensym exp)
+       (recur exp))
+      
+      ((<module-set> mod name public? exp)
+       (recur exp))
+      
+      ((<toplevel-set> name exp)
+       (recur exp))
+      
+      ((<toplevel-define> name exp)
+       (recur exp))
+      
+      ((<sequence> exps)
+       (apply max (map recur exps)))
+      
+      ((<lambda> vars meta body)
+       ;; allocate closure vars in order
+       (let lp ((c (hashq-ref free-vars x)) (n 0))
+         (if (pair? c)
+             (begin
+               (hashq-set! (hashq-ref allocation (car c))
+                           x
+                           `(#f ,(hashq-ref assigned (car c)) . ,n))
+               (lp (cdr c) (1+ n)))))
+      
+       (let ((nlocs
+              (let lp ((vars vars) (n 0))
+                (if (not (null? vars))
+                    ;; allocate args
+                    (let ((v (if (pair? vars) (car vars) vars)))
+                      (hashq-set! allocation v
+                                  (make-hashq
+                                   x `(#t ,(hashq-ref assigned v) . ,n)))
+                      (lp (if (pair? vars) (cdr vars) '()) (1+ n)))
+                    ;; allocate body, return number of additional locals
+                    (- (allocate! body x n) n))))
+             (free-addresses
+              (map (lambda (v)
+                     (hashq-ref (hashq-ref allocation v) proc))
+                   (hashq-ref free-vars x)))
+             (labels (filter cdr
+                             (map (lambda (sym)
+                                    (cons sym (hashq-ref labels sym)))
+                                  (hashq-ref bound-vars x)))))
+         ;; set procedure allocations
+         (hashq-set! allocation x (cons* nlocs labels free-addresses)))
+       n)
+
+      ((<let> vars vals body)
+       (let ((nmax (apply max (map recur vals))))
+         (cond
+          ;; the `or' hack
+          ((and (conditional? body)
+                (= (length vars) 1)
+                (let ((v (car vars)))
+                  (and (not (hashq-ref assigned v))
+                       (= (hashq-ref refcounts v 0) 2)
+                       (lexical-ref? (conditional-test body))
+                       (eq? (lexical-ref-gensym (conditional-test body)) v)
+                       (lexical-ref? (conditional-then body))
+                       (eq? (lexical-ref-gensym (conditional-then body)) v))))
+           (hashq-set! allocation (car vars)
+                       (make-hashq proc `(#t #f . ,n)))
+           ;; the 1+ for this var
+           (max nmax (1+ n) (allocate! (conditional-else body) proc n)))
+          (else
+           (let lp ((vars vars) (n n))
+             (if (null? vars)
+                 (max nmax (allocate! body proc n))
+                 (let ((v (car vars)))
+                   (hashq-set!
+                    allocation v
+                    (make-hashq proc
+                                `(#t ,(hashq-ref assigned v) . ,n)))
+                   (lp (cdr vars) (1+ n)))))))))
+      
+      ((<letrec> vars vals body)
+       (let lp ((vars vars) (n n))
+         (if (null? vars)
+             (let ((nmax (apply max
+                                (map (lambda (x)
+                                       (allocate! x proc n))
+                                     vals))))
+               (max nmax (allocate! body proc n)))
+             (let ((v (car vars)))
+               (hashq-set!
+                allocation v
+                (make-hashq proc
+                            `(#t ,(hashq-ref assigned v) . ,n)))
+               (lp (cdr vars) (1+ n))))))
+
+      ((<fix> vars vals body)
+       (let lp ((in vars) (n n))
+         (if (null? in)
+             (let lp ((vars vars) (vals vals) (nmax n))
+               (cond
+                ((null? vars)
+                 (max nmax (allocate! body proc n)))
+                ((hashq-ref labels (car vars))                 
+                 ;; allocate label bindings & body inline to proc
+                 (lp (cdr vars)
+                     (cdr vals)
+                     (record-case (car vals)
+                       ((<lambda> vars body)
+                        (let lp ((vars vars) (n n))
+                          (if (not (null? vars))
+                              ;; allocate bindings
+                              (let ((v (if (pair? vars) (car vars) vars)))
+                                (hashq-set!
+                                 allocation v
+                                 (make-hashq
+                                  proc `(#t ,(hashq-ref assigned v) . ,n)))
+                                (lp (if (pair? vars) (cdr vars) '()) (1+ n)))
+                              ;; allocate body
+                              (max nmax (allocate! body proc n))))))))
+                (else
+                 ;; allocate closure
+                 (lp (cdr vars)
+                     (cdr vals)
+                     (max nmax (allocate! (car vals) proc n))))))
+             
+             (let ((v (car in)))
+               (cond
+                ((hashq-ref assigned v)
+                 (error "fixpoint procedures may not be assigned" x))
+                ((hashq-ref labels v)
+                 ;; no binding, it's a label
+                 (lp (cdr in) n))
+                (else
+                 ;; allocate closure binding
+                 (hashq-set! allocation v (make-hashq proc `(#t #f . ,n)))
+                 (lp (cdr in) (1+ n))))))))
+
+      ((<let-values> vars exp body)
+       (let ((nmax (recur exp)))
+         (let lp ((vars vars) (n n))
+           (cond
+            ((null? vars)
+             (max nmax (allocate! body proc n)))
+            ((not (pair? vars))
+             (hashq-set! allocation vars
+                         (make-hashq proc
+                                     `(#t ,(hashq-ref assigned vars) . ,n)))
+             ;; the 1+ for this var
+             (max nmax (allocate! body proc (1+ n))))
+            (else               
+             (let ((v (car vars)))
+               (hashq-set!
+                allocation v
+                (make-hashq proc
+                            `(#t ,(hashq-ref assigned v) . ,n)))
+               (lp (cdr vars) (1+ n))))))))
+      
+      (else n)))
+
+  (analyze! x #f '() #t #f)
+  (allocate! x #f 0)
+
+  allocation)
+
+
+;;;
+;;; Unused variable analysis.
+;;;
+
+;; <binding-info> records are used during tree traversals in
+;; `report-unused-variables'.  They contain a list of the local vars
+;; currently in scope, a list of locals vars that have been referenced, and a
+;; "location stack" (the stack of `tree-il-src' values for each parent tree).
+(define-record-type <binding-info>
+  (make-binding-info vars refs locs)
+  binding-info?
+  (vars binding-info-vars)  ;; ((GENSYM NAME LOCATION) ...)
+  (refs binding-info-refs)  ;; (GENSYM ...)
+  (locs binding-info-locs)) ;; (LOCATION ...)
+
+(define (report-unused-variables tree)
+  "Report about unused variables in TREE.  Return TREE."
+
+  (define (dotless-list lst)
+    ;; If LST is a dotted list, return a proper list equal to LST except that
+    ;; the very last element is a pair; otherwise return LST.
+    (let loop ((lst    lst)
+               (result '()))
+      (cond ((null? lst)
+             (reverse result))
+            ((pair? lst)
+             (loop (cdr lst) (cons (car lst) result)))
+            (else
+             (loop '() (cons lst result))))))
+
+  (tree-il-fold (lambda (x info)
+                  ;; X is a leaf: extend INFO's refs accordingly.
+                  (let ((refs (binding-info-refs info))
+                        (vars (binding-info-vars info))
+                        (locs (binding-info-locs info)))
+                    (record-case x
+                      ((<lexical-ref> gensym)
+                       (make-binding-info vars (cons gensym refs) locs))
+                      (else info))))
+
+                (lambda (x info)
+                  ;; Going down into X: extend INFO's variable list
+                  ;; accordingly.
+                  (let ((refs (binding-info-refs info))
+                        (vars (binding-info-vars info))
+                        (locs (binding-info-locs info))
+                        (src  (tree-il-src x)))
+                    (define (extend inner-vars inner-names)
+                      (append (map (lambda (var name)
+                                     (list var name src))
+                                   inner-vars
+                                   inner-names)
+                              vars))
+                    (record-case x
+                      ((<lexical-set> gensym)
+                       (make-binding-info vars (cons gensym refs)
+                                          (cons src locs)))
+                      ((<lambda> vars names)
+                       (let ((vars  (dotless-list vars))
+                             (names (dotless-list names)))
+                         (make-binding-info (extend vars names) refs
+                                            (cons src locs))))
+                      ((<let> vars names)
+                       (make-binding-info (extend vars names) refs
+                                          (cons src locs)))
+                      ((<letrec> vars names)
+                       (make-binding-info (extend vars names) refs
+                                          (cons src locs)))
+                      ((<fix> vars names)
+                       (make-binding-info (extend vars names) refs
+                                          (cons src locs)))
+                      ((<let-values> vars names)
+                       (make-binding-info (extend vars names) refs
+                                          (cons src locs)))
+                      (else info))))
+
+                (lambda (x info)
+                  ;; Leaving X's scope: shrink INFO's variable list
+                  ;; accordingly and reported unused nested variables.
+                  (let ((refs (binding-info-refs info))
+                        (vars (binding-info-vars info))
+                        (locs (binding-info-locs info)))
+                    (define (shrink inner-vars refs)
+                      (for-each (lambda (var)
+                                  (let ((gensym (car var)))
+                                    ;; Don't report lambda parameters as
+                                    ;; unused.
+                                    (if (and (not (memq gensym refs))
+                                             (not (and (lambda? x)
+                                                       (memq gensym
+                                                             inner-vars))))
+                                        (let ((name (cadr var))
+                                              ;; We can get approximate
+                                              ;; source location by going up
+                                              ;; the LOCS location stack.
+                                              (loc  (or (caddr var)
+                                                        (find pair? locs))))
+                                          (warning 'unused-variable loc name)))))
+                                (filter (lambda (var)
+                                          (memq (car var) inner-vars))
+                                        vars))
+                      (fold alist-delete vars inner-vars))
+
+                    ;; For simplicity, we leave REFS untouched, i.e., with
+                    ;; names of variables that are now going out of scope.
+                    ;; It doesn't hurt as these are unique names, it just
+                    ;; makes REFS unnecessarily fat.
+                    (record-case x
+                      ((<lambda> vars)
+                       (let ((vars (dotless-list vars)))
+                         (make-binding-info (shrink vars refs) refs
+                                            (cdr locs))))
+                      ((<let> vars)
+                       (make-binding-info (shrink vars refs) refs
+                                          (cdr locs)))
+                      ((<letrec> vars)
+                       (make-binding-info (shrink vars refs) refs
+                                          (cdr locs)))
+                      ((<fix> vars)
+                       (make-binding-info (shrink vars refs) refs
+                                          (cdr locs)))
+                      ((<let-values> vars)
+                       (make-binding-info (shrink vars refs) refs
+                                          (cdr locs)))
+                      (else info))))
+                (make-binding-info '() '() '())
+                tree)
+  tree)
diff --git a/module/language/tree-il/compile-glil.scm b/module/language/tree-il/compile-glil.scm
new file mode 100644
index 000000000..86b610f94
--- /dev/null
+++ b/module/language/tree-il/compile-glil.scm
@@ -0,0 +1,729 @@
+;;; TREE-IL -> GLIL compiler
+
+;; Copyright (C) 2001,2008,2009 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (language tree-il compile-glil)
+  #:use-module (system base syntax)
+  #:use-module (system base pmatch)
+  #:use-module (system base message)
+  #:use-module (ice-9 receive)
+  #:use-module (language glil)
+  #:use-module (system vm instruction)
+  #:use-module (language tree-il)
+  #:use-module (language tree-il optimize)
+  #:use-module (language tree-il analyze)
+  #:export (compile-glil))
+
+;;; TODO:
+;;
+;; call-with-values -> mv-bind
+;; basic degenerate-case reduction
+
+;; allocation:
+;;  sym -> {lambda -> address}
+;;  lambda -> (nlocs labels . free-locs)
+;;
+;; address := (local? boxed? . index)
+;; free-locs ::= ((sym0 . address0) (sym1 . address1) ...)
+;; free variable addresses are relative to parent proc.
+
+(define *comp-module* (make-fluid))
+
+(define %warning-passes
+  `((unused-variable . ,report-unused-variables)))
+
+(define (compile-glil x e opts)
+  (define warnings
+    (or (and=> (memq #:warnings opts) cadr)
+        '()))
+
+  ;; Go throught the warning passes.
+  (for-each (lambda (kind)
+                (let ((warn (assoc-ref %warning-passes kind)))
+                  (and (procedure? warn)
+                       (warn x))))
+            warnings)
+
+  (let* ((x (make-lambda (tree-il-src x) '() '() '() x))
+         (x (optimize! x e opts))
+         (allocation (analyze-lexicals x)))
+
+    (with-fluid* *comp-module* (or (and e (car e)) (current-module))
+      (lambda ()
+        (values (flatten-lambda x #f allocation)
+                (and e (cons (car e) (cddr e)))
+                e)))))
+
+
+
+(define *primcall-ops* (make-hash-table))
+(for-each
+ (lambda (x) (hash-set! *primcall-ops* (car x) (cdr x)))
+ '(((eq? . 2) . eq?)
+   ((eqv? . 2) . eqv?)
+   ((equal? . 2) . equal?)
+   ((= . 2) . ee?)
+   ((< . 2) . lt?)
+   ((> . 2) . gt?)
+   ((<= . 2) . le?)
+   ((>= . 2) . ge?)
+   ((+ . 2) . add)
+   ((- . 2) . sub)
+   ((1+ . 1) . add1)
+   ((1- . 1) . sub1)
+   ((* . 2) . mul)
+   ((/ . 2) . div)
+   ((quotient . 2) . quo)
+   ((remainder . 2) . rem)
+   ((modulo . 2) . mod)
+   ((not . 1) . not)
+   ((pair? . 1) . pair?)
+   ((cons . 2) . cons)
+   ((car . 1) . car)
+   ((cdr . 1) . cdr)
+   ((set-car! . 2) . set-car!)
+   ((set-cdr! . 2) . set-cdr!)
+   ((null? . 1) . null?)
+   ((list? . 1) . list?)
+   (list . list)
+   (vector . vector)
+   ((@slot-ref . 2) . slot-ref)
+   ((@slot-set! . 3) . slot-set)
+   ((vector-ref . 2) . vector-ref)
+   ((vector-set! . 3) . vector-set)
+
+   ((bytevector-u8-ref . 2) . bv-u8-ref)
+   ((bytevector-u8-set! . 3) . bv-u8-set)
+   ((bytevector-s8-ref . 2) . bv-s8-ref)
+   ((bytevector-s8-set! . 3) . bv-s8-set)
+
+   ((bytevector-u16-ref . 3) . bv-u16-ref)
+   ((bytevector-u16-set! . 4) . bv-u16-set)
+   ((bytevector-u16-native-ref . 2) . bv-u16-native-ref)
+   ((bytevector-u16-native-set! . 3) . bv-u16-native-set)
+   ((bytevector-s16-ref . 3) . bv-s16-ref)
+   ((bytevector-s16-set! . 4) . bv-s16-set)
+   ((bytevector-s16-native-ref . 2) . bv-s16-native-ref)
+   ((bytevector-s16-native-set! . 3) . bv-s16-native-set)
+    
+   ((bytevector-u32-ref . 3) . bv-u32-ref)
+   ((bytevector-u32-set! . 4) . bv-u32-set)
+   ((bytevector-u32-native-ref . 2) . bv-u32-native-ref)
+   ((bytevector-u32-native-set! . 3) . bv-u32-native-set)
+   ((bytevector-s32-ref . 3) . bv-s32-ref)
+   ((bytevector-s32-set! . 4) . bv-s32-set)
+   ((bytevector-s32-native-ref . 2) . bv-s32-native-ref)
+   ((bytevector-s32-native-set! . 3) . bv-s32-native-set)
+    
+   ((bytevector-u64-ref . 3) . bv-u64-ref)
+   ((bytevector-u64-set! . 4) . bv-u64-set)
+   ((bytevector-u64-native-ref . 2) . bv-u64-native-ref)
+   ((bytevector-u64-native-set! . 3) . bv-u64-native-set)
+   ((bytevector-s64-ref . 3) . bv-s64-ref)
+   ((bytevector-s64-set! . 4) . bv-s64-set)
+   ((bytevector-s64-native-ref . 2) . bv-s64-native-ref)
+   ((bytevector-s64-native-set! . 3) . bv-s64-native-set)
+    
+   ((bytevector-ieee-single-ref . 3) . bv-f32-ref)
+   ((bytevector-ieee-single-set! . 4) . bv-f32-set)
+   ((bytevector-ieee-single-native-ref . 2) . bv-f32-native-ref)
+   ((bytevector-ieee-single-native-set! . 3) . bv-f32-native-set)
+   ((bytevector-ieee-double-ref . 3) . bv-f64-ref)
+   ((bytevector-ieee-double-set! . 4) . bv-f64-set)
+   ((bytevector-ieee-double-native-ref . 2) . bv-f64-native-ref)
+   ((bytevector-ieee-double-native-set! . 3) . bv-f64-native-set)))
+
+
+
+
+(define (make-label) (gensym ":L"))
+
+(define (vars->bind-list ids vars allocation proc)
+  (map (lambda (id v)
+         (pmatch (hashq-ref (hashq-ref allocation v) proc)
+           ((#t ,boxed? . ,n)
+            (list id boxed? n))
+           (,x (error "badness" x))))
+       ids
+       vars))
+
+;; FIXME: always emit? otherwise it's hard to pair bind with unbind
+(define (emit-bindings src ids vars allocation proc emit-code)
+  (emit-code src (make-glil-bind
+                  (vars->bind-list ids vars allocation proc))))
+
+(define (with-output-to-code proc)
+  (let ((out '()))
+    (define (emit-code src x)
+      (set! out (cons x out))
+      (if src
+          (set! out (cons (make-glil-source src) out))))
+    (proc emit-code)
+    (reverse out)))
+
+(define (flatten-lambda x self-label allocation)
+  (receive (ids vars nargs nrest)
+      (let lp ((ids (lambda-names x)) (vars (lambda-vars x))
+               (oids '()) (ovars '()) (n 0))
+          (cond ((null? vars) (values (reverse oids) (reverse ovars) n 0))
+                ((pair? vars) (lp (cdr ids) (cdr vars)
+                                  (cons (car ids) oids) (cons (car vars) ovars)
+                                  (1+ n)))
+                (else (values (reverse (cons ids oids))
+                              (reverse (cons vars ovars))
+                              (1+ n) 1))))
+    (let ((nlocs (car (hashq-ref allocation x)))
+          (labels (cadr (hashq-ref allocation x))))
+      (make-glil-program
+       nargs nrest nlocs (lambda-meta x)
+       (with-output-to-code
+        (lambda (emit-code)
+          ;; emit label for self tail calls
+          (if self-label
+              (emit-code #f (make-glil-label self-label)))
+          ;; write bindings and source debugging info
+          (if (not (null? ids))
+              (emit-bindings #f ids vars allocation x emit-code))
+          (if (lambda-src x)
+              (emit-code #f (make-glil-source (lambda-src x))))
+          ;; box args if necessary
+          (for-each
+           (lambda (v)
+             (pmatch (hashq-ref (hashq-ref allocation v) x)
+                     ((#t #t . ,n)
+                      (emit-code #f (make-glil-lexical #t #f 'ref n))
+                      (emit-code #f (make-glil-lexical #t #t 'box n)))))
+           vars)
+          ;; and here, here, dear reader: we compile.
+          (flatten (lambda-body x) allocation x self-label
+                   labels emit-code)))))))
+
+(define (flatten x allocation self self-label fix-labels emit-code)
+  (define (emit-label label)
+    (emit-code #f (make-glil-label label)))
+  (define (emit-branch src inst label)
+    (emit-code src (make-glil-branch inst label)))
+
+  ;; RA: "return address"; #f unless we're in a non-tail fix with labels
+  ;; MVRA: "multiple-values return address"; #f unless we're in a let-values
+  (let comp ((x x) (context 'tail) (RA #f) (MVRA #f))
+    (define (comp-tail tree) (comp tree context RA MVRA))
+    (define (comp-push tree) (comp tree 'push #f #f))
+    (define (comp-drop tree) (comp tree 'drop #f #f))
+    (define (comp-vals tree MVRA) (comp tree 'vals #f MVRA))
+    (define (comp-fix tree RA) (comp tree context RA MVRA))
+
+    ;; A couple of helpers. Note that if we are in tail context, we
+    ;; won't have an RA.
+    (define (maybe-emit-return)
+      (if RA
+          (emit-branch #f 'br RA)
+          (if (eq? context 'tail)
+              (emit-code #f (make-glil-call 'return 1)))))
+    
+    (record-case x
+      ((<void>)
+       (case context
+         ((push vals tail)
+          (emit-code #f (make-glil-void))))
+       (maybe-emit-return))
+
+      ((<const> src exp)
+       (case context
+         ((push vals tail)
+          (emit-code src (make-glil-const exp))))
+       (maybe-emit-return))
+
+      ;; FIXME: should represent sequence as exps tail
+      ((<sequence> src exps)
+       (let lp ((exps exps))
+         (if (null? (cdr exps))
+             (comp-tail (car exps))
+             (begin
+               (comp-drop (car exps))
+               (lp (cdr exps))))))
+
+      ((<application> src proc args)
+       ;; FIXME: need a better pattern-matcher here
+       (cond
+        ((and (primitive-ref? proc)
+              (eq? (primitive-ref-name proc) '@apply)
+              (>= (length args) 1))
+         (let ((proc (car args))
+               (args (cdr args)))
+           (cond
+            ((and (primitive-ref? proc) (eq? (primitive-ref-name proc) 'values)
+                  (not (eq? context 'push)) (not (eq? context 'vals)))
+             ;; tail: (lambda () (apply values '(1 2)))
+             ;; drop: (lambda () (apply values '(1 2)) 3)
+             ;; push: (lambda () (list (apply values '(10 12)) 1))
+             (case context
+               ((drop) (for-each comp-drop args) (maybe-emit-return))
+               ((tail)
+                (for-each comp-push args)
+                (emit-code src (make-glil-call 'return/values* (length args))))))
+
+            (else
+             (case context
+               ((tail)
+                (comp-push proc)
+                (for-each comp-push args)
+                (emit-code src (make-glil-call 'goto/apply (1+ (length args)))))
+               ((push)
+                (emit-code src (make-glil-call 'new-frame 0))
+                (comp-push proc)
+                (for-each comp-push args)
+                (emit-code src (make-glil-call 'apply (1+ (length args))))
+                (maybe-emit-return))
+               ((vals)
+                (comp-vals
+                 (make-application src (make-primitive-ref #f 'apply)
+                                   (cons proc args))
+                 MVRA)
+                (maybe-emit-return))
+               ((drop)
+                ;; Well, shit. The proc might return any number of
+                ;; values (including 0), since it's in a drop context,
+                ;; yet apply does not create a MV continuation. So we
+                ;; mv-call out to our trampoline instead.
+                (comp-drop
+                 (make-application src (make-primitive-ref #f 'apply)
+                                   (cons proc args)))
+                (maybe-emit-return)))))))
+        
+        ((and (primitive-ref? proc) (eq? (primitive-ref-name proc) 'values)
+              (not (eq? context 'push)))
+         ;; tail: (lambda () (values '(1 2)))
+         ;; drop: (lambda () (values '(1 2)) 3)
+         ;; push: (lambda () (list (values '(10 12)) 1))
+         ;; vals: (let-values (((a b ...) (values 1 2 ...))) ...)
+         (case context
+           ((drop) (for-each comp-drop args) (maybe-emit-return))
+           ((vals)
+            (for-each comp-push args)
+            (emit-code #f (make-glil-const (length args)))
+            (emit-branch src 'br MVRA))
+           ((tail)
+            (for-each comp-push args)
+            (emit-code src (make-glil-call 'return/values (length args))))))
+        
+        ((and (primitive-ref? proc)
+              (eq? (primitive-ref-name proc) '@call-with-values)
+              (= (length args) 2))
+	 ;; CONSUMER
+         ;; PRODUCER
+         ;; (mv-call MV)
+         ;; ([tail]-call 1)
+         ;; goto POST
+         ;; MV: [tail-]call/nargs
+         ;; POST: (maybe-drop)
+         (case context
+           ((vals)
+            ;; Fall back.
+            (comp-vals
+             (make-application src (make-primitive-ref #f 'call-with-values)
+                               args)
+             MVRA)
+            (maybe-emit-return))
+           (else
+            (let ((MV (make-label)) (POST (make-label))
+                  (producer (car args)) (consumer (cadr args)))
+              (if (not (eq? context 'tail))
+                  (emit-code src (make-glil-call 'new-frame 0)))
+              (comp-push consumer)
+              (emit-code src (make-glil-call 'new-frame 0))
+              (comp-push producer)
+              (emit-code src (make-glil-mv-call 0 MV))
+              (case context
+                ((tail) (emit-code src (make-glil-call 'goto/args 1)))
+                (else   (emit-code src (make-glil-call 'call 1))
+                        (emit-branch #f 'br POST)))
+              (emit-label MV)
+              (case context
+                ((tail) (emit-code src (make-glil-call 'goto/nargs 0)))
+                (else   (emit-code src (make-glil-call 'call/nargs 0))
+                        (emit-label POST)
+                        (if (eq? context 'drop)
+                            (emit-code #f (make-glil-call 'drop 1)))
+                        (maybe-emit-return)))))))
+
+        ((and (primitive-ref? proc)
+              (eq? (primitive-ref-name proc) '@call-with-current-continuation)
+              (= (length args) 1))
+         (case context
+           ((tail)
+            (comp-push (car args))
+            (emit-code src (make-glil-call 'goto/cc 1)))
+           ((vals)
+            (comp-vals
+             (make-application
+              src (make-primitive-ref #f 'call-with-current-continuation)
+              args)
+             MVRA)
+            (maybe-emit-return))
+           ((push)
+            (comp-push (car args))
+            (emit-code src (make-glil-call 'call/cc 1))
+            (maybe-emit-return))
+           ((drop)
+            ;; Crap. Just like `apply' in drop context.
+            (comp-drop
+             (make-application
+              src (make-primitive-ref #f 'call-with-current-continuation)
+              args))
+            (maybe-emit-return))))
+
+        ((and (primitive-ref? proc)
+              (or (hash-ref *primcall-ops*
+                            (cons (primitive-ref-name proc) (length args)))
+                  (hash-ref *primcall-ops* (primitive-ref-name proc))))
+         => (lambda (op)
+              (for-each comp-push args)
+              (emit-code src (make-glil-call op (length args)))
+              (case (instruction-pushes op)
+                ((0)
+                 (case context
+                   ((tail push vals) (emit-code #f (make-glil-void))))
+                 (maybe-emit-return))
+                ((1)
+                 (case context
+                   ((drop) (emit-code #f (make-glil-call 'drop 1))))
+                 (maybe-emit-return))
+                (else
+                 (error "bad primitive op: too many pushes"
+                        op (instruction-pushes op))))))
+        
+        ;; da capo al fine
+        ((and (lexical-ref? proc)
+              self-label (eq? (lexical-ref-gensym proc) self-label)
+              ;; self-call in tail position is a goto
+              (eq? context 'tail)
+              ;; make sure the arity is right
+              (list? (lambda-vars self))
+              (= (length args) (length (lambda-vars self))))
+         ;; evaluate new values
+         (for-each comp-push args)
+         ;; rename & goto
+         (for-each (lambda (sym)
+                     (pmatch (hashq-ref (hashq-ref allocation sym) self)
+                       ((#t ,boxed? . ,index)
+                        ;; set unboxed, as the proc prelude will box if needed
+                        (emit-code #f (make-glil-lexical #t #f 'set index)))
+                       (,x (error "what" x))))
+                   (reverse (lambda-vars self)))
+         (emit-branch src 'br self-label))
+        
+        ;; lambda, the ultimate goto
+        ((and (lexical-ref? proc)
+              (assq (lexical-ref-gensym proc) fix-labels))
+         ;; evaluate new values, assuming that analyze-lexicals did its
+         ;; job, and that the arity was right
+         (for-each comp-push args)
+         ;; rename
+         (for-each (lambda (sym)
+                     (pmatch (hashq-ref (hashq-ref allocation sym) self)
+                       ((#t #f . ,index)
+                        (emit-code #f (make-glil-lexical #t #f 'set index)))
+                       ((#t #t . ,index)
+                        (emit-code #f (make-glil-lexical #t #t 'box index)))
+                       (,x (error "what" x))))
+                   (reverse (assq-ref fix-labels (lexical-ref-gensym proc))))
+         ;; goto!
+         (emit-branch src 'br (lexical-ref-gensym proc)))
+        
+        (else
+         (if (not (eq? context 'tail))
+             (emit-code src (make-glil-call 'new-frame 0)))
+         (comp-push proc)
+         (for-each comp-push args)
+         (let ((len (length args)))
+           (case context
+             ((tail) (emit-code src (make-glil-call 'goto/args len)))
+             ((push) (emit-code src (make-glil-call 'call len))
+                     (maybe-emit-return))
+             ((vals) (emit-code src (make-glil-mv-call len MVRA))
+                     (maybe-emit-return))
+             ((drop) (let ((MV (make-label)) (POST (make-label)))
+                       (emit-code src (make-glil-mv-call len MV))
+                       (emit-code #f (make-glil-call 'drop 1))
+                       (emit-branch #f 'br (or RA POST))
+                       (emit-label MV)
+                       (emit-code #f (make-glil-mv-bind '() #f))
+                       (emit-code #f (make-glil-unbind))
+                       (if RA
+                           (emit-branch #f 'br RA)
+                           (emit-label POST)))))))))
+
+      ((<conditional> src test then else)
+       ;;     TEST
+       ;;     (br-if-not L1)
+       ;;     THEN
+       ;;     (br L2)
+       ;; L1: ELSE
+       ;; L2:
+       (let ((L1 (make-label)) (L2 (make-label)))
+         (comp-push test)
+         (emit-branch src 'br-if-not L1)
+         (comp-tail then)
+         ;; if there is an RA, comp-tail will cause a jump to it -- just
+         ;; have to clean up here if there is no RA.
+         (if (and (not RA) (not (eq? context 'tail)))
+             (emit-branch #f 'br L2))
+         (emit-label L1)
+         (comp-tail else)
+         (if (and (not RA) (not (eq? context 'tail)))
+             (emit-label L2))))
+      
+      ((<primitive-ref> src name)
+       (cond
+        ((eq? (module-variable (fluid-ref *comp-module*) name)
+              (module-variable the-root-module name))
+         (case context
+           ((tail push vals)
+            (emit-code src (make-glil-toplevel 'ref name))))
+         (maybe-emit-return))
+        ((module-variable the-root-module name)
+         (case context
+           ((tail push vals)
+            (emit-code src (make-glil-module 'ref '(guile) name #f))))
+         (maybe-emit-return))
+        (else
+         (case context
+           ((tail push vals)
+            (emit-code src (make-glil-module
+                            'ref (module-name (fluid-ref *comp-module*)) name #f))))
+         (maybe-emit-return))))
+
+      ((<lexical-ref> src name gensym)
+       (case context
+         ((push vals tail)
+          (pmatch (hashq-ref (hashq-ref allocation gensym) self)
+            ((,local? ,boxed? . ,index)
+             (emit-code src (make-glil-lexical local? boxed? 'ref index)))
+            (,loc
+             (error "badness" x loc)))))
+       (maybe-emit-return))
+      
+      ((<lexical-set> src name gensym exp)
+       (comp-push exp)
+       (pmatch (hashq-ref (hashq-ref allocation gensym) self)
+         ((,local? ,boxed? . ,index)
+          (emit-code src (make-glil-lexical local? boxed? 'set index)))
+         (,loc
+          (error "badness" x loc)))
+       (case context
+         ((tail push vals)
+          (emit-code #f (make-glil-void))))
+       (maybe-emit-return))
+      
+      ((<module-ref> src mod name public?)
+       (emit-code src (make-glil-module 'ref mod name public?))
+       (case context
+         ((drop) (emit-code #f (make-glil-call 'drop 1))))
+       (maybe-emit-return))
+      
+      ((<module-set> src mod name public? exp)
+       (comp-push exp)
+       (emit-code src (make-glil-module 'set mod name public?))
+       (case context
+         ((tail push vals)
+          (emit-code #f (make-glil-void))))
+       (maybe-emit-return))
+
+      ((<toplevel-ref> src name)
+       (emit-code src (make-glil-toplevel 'ref name))
+       (case context
+         ((drop) (emit-code #f (make-glil-call 'drop 1))))
+       (maybe-emit-return))
+      
+      ((<toplevel-set> src name exp)
+       (comp-push exp)
+       (emit-code src (make-glil-toplevel 'set name))
+       (case context
+         ((tail push vals)
+          (emit-code #f (make-glil-void))))
+       (maybe-emit-return))
+      
+      ((<toplevel-define> src name exp)
+       (comp-push exp)
+       (emit-code src (make-glil-toplevel 'define name))
+       (case context
+         ((tail push vals)
+          (emit-code #f (make-glil-void))))
+       (maybe-emit-return))
+
+      ((<lambda>)
+       (let ((free-locs (cddr (hashq-ref allocation x))))
+         (case context
+           ((push vals tail)
+            (emit-code #f (flatten-lambda x #f allocation))
+            (if (not (null? free-locs))
+                (begin
+                  (for-each
+                   (lambda (loc)
+                     (pmatch loc
+                       ((,local? ,boxed? . ,n)
+                        (emit-code #f (make-glil-lexical local? #f 'ref n)))
+                       (else (error "what" x loc))))
+                   free-locs)
+                  (emit-code #f (make-glil-call 'vector (length free-locs)))
+                  (emit-code #f (make-glil-call 'make-closure 2)))))))
+       (maybe-emit-return))
+      
+      ((<let> src names vars vals body)
+       (for-each comp-push vals)
+       (emit-bindings src names vars allocation self emit-code)
+       (for-each (lambda (v)
+                   (pmatch (hashq-ref (hashq-ref allocation v) self)
+                     ((#t #f . ,n)
+                      (emit-code src (make-glil-lexical #t #f 'set n)))
+                     ((#t #t . ,n)
+                      (emit-code src (make-glil-lexical #t #t 'box n)))
+                     (,loc (error "badness" x loc))))
+                 (reverse vars))
+       (comp-tail body)
+       (emit-code #f (make-glil-unbind)))
+
+      ((<letrec> src names vars vals body)
+       (for-each (lambda (v)
+                   (pmatch (hashq-ref (hashq-ref allocation v) self)
+                     ((#t #t . ,n)
+                      (emit-code src (make-glil-lexical #t #t 'empty-box n)))
+                     (,loc (error "badness" x loc))))
+                 vars)
+       (for-each comp-push vals)
+       (emit-bindings src names vars allocation self emit-code)
+       (for-each (lambda (v)
+                   (pmatch (hashq-ref (hashq-ref allocation v) self)
+                     ((#t #t . ,n)
+                      (emit-code src (make-glil-lexical #t #t 'set n)))
+                     (,loc (error "badness" x loc))))
+                 (reverse vars))
+       (comp-tail body)
+       (emit-code #f (make-glil-unbind)))
+
+      ((<fix> src names vars vals body)
+       ;; The ideal here is to just render the lambda bodies inline, and
+       ;; wire the code together with gotos. We can do that if
+       ;; analyze-lexicals has determined that a given var has "label"
+       ;; allocation -- which is the case if it is in `fix-labels'.
+       ;;
+       ;; But even for closures that we can't inline, we can do some
+       ;; tricks to avoid heap-allocation for the binding itself. Since
+       ;; we know the vals are lambdas, we can set them to their local
+       ;; var slots first, then capture their bindings, mutating them in
+       ;; place.
+       (let ((RA (if (eq? context 'tail) #f (make-label))))
+         (for-each
+          (lambda (x v)
+            (cond
+             ((hashq-ref allocation x)
+              ;; allocating a closure
+              (emit-code #f (flatten-lambda x v allocation))
+              (if (not (null? (cddr (hashq-ref allocation x))))
+                  ;; Need to make-closure first, but with a temporary #f
+                  ;; free-variables vector, so we are mutating fresh
+                  ;; closures on the heap.
+                  (begin
+                    (emit-code #f (make-glil-const #f))
+                    (emit-code #f (make-glil-call 'make-closure 2))))
+              (pmatch (hashq-ref (hashq-ref allocation v) self)
+                ((#t #f . ,n)
+                 (emit-code src (make-glil-lexical #t #f 'set n)))
+                (,loc (error "badness" x loc))))
+             (else
+              ;; labels allocation: emit label & body, but jump over it
+              (let ((POST (make-label)))
+                (emit-branch #f 'br POST)
+                (emit-label v)
+                ;; we know the lambda vars are a list
+                (emit-bindings #f (lambda-names x) (lambda-vars x)
+                               allocation self emit-code)
+                (if (lambda-src x)
+                    (emit-code #f (make-glil-source (lambda-src x))))
+                (comp-fix (lambda-body x) RA)
+                (emit-code #f (make-glil-unbind))
+                (emit-label POST)))))
+          vals
+          vars)
+         ;; Emit bindings metadata for closures
+         (let ((binds (let lp ((out '()) (vars vars) (names names))
+                        (cond ((null? vars) (reverse! out))
+                              ((assq (car vars) fix-labels)
+                               (lp out (cdr vars) (cdr names)))
+                              (else
+                               (lp (acons (car vars) (car names) out)
+                                   (cdr vars) (cdr names)))))))
+           (emit-bindings src (map cdr binds) (map car binds)
+                          allocation self emit-code))
+         ;; Now go back and fix up the bindings for closures.
+         (for-each
+          (lambda (x v)
+            (let ((free-locs (if (hashq-ref allocation x)
+                                 (cddr (hashq-ref allocation x))
+                                 ;; can hit this latter case for labels allocation
+                                 '())))
+              (if (not (null? free-locs))
+                  (begin
+                    (for-each
+                     (lambda (loc)
+                       (pmatch loc
+                         ((,local? ,boxed? . ,n)
+                          (emit-code #f (make-glil-lexical local? #f 'ref n)))
+                         (else (error "what" x loc))))
+                     free-locs)
+                    (emit-code #f (make-glil-call 'vector (length free-locs)))
+                    (pmatch (hashq-ref (hashq-ref allocation v) self)
+                      ((#t #f . ,n)
+                       (emit-code #f (make-glil-lexical #t #f 'fix n)))
+                      (,loc (error "badness" x loc)))))))
+          vals
+          vars)
+         (comp-tail body)
+         (emit-label RA)
+         (emit-code #f (make-glil-unbind))))
+
+      ((<let-values> src names vars exp body)
+       (let lp ((names '()) (vars '()) (inames names) (ivars vars) (rest? #f))
+         (cond
+          ((pair? inames)
+           (lp (cons (car inames) names) (cons (car ivars) vars)
+               (cdr inames) (cdr ivars) #f))
+          ((not (null? inames))
+           (lp (cons inames names) (cons ivars vars) '() '() #t))
+          (else
+           (let ((names (reverse! names))
+                 (vars (reverse! vars))
+                 (MV (make-label)))
+             (comp-vals exp MV)
+             (emit-code #f (make-glil-const 1))
+             (emit-label MV)
+             (emit-code src (make-glil-mv-bind
+                             (vars->bind-list names vars allocation self)
+                             rest?))
+             (for-each (lambda (v)
+                         (pmatch (hashq-ref (hashq-ref allocation v) self)
+                           ((#t #f . ,n)
+                            (emit-code src (make-glil-lexical #t #f 'set n)))
+                           ((#t #t . ,n)
+                            (emit-code src (make-glil-lexical #t #t 'box n)))
+                           (,loc (error "badness" x loc))))
+                       (reverse vars))
+             (comp-tail body)
+             (emit-code #f (make-glil-unbind))))))))))
diff --git a/module/language/tree-il/fix-letrec.scm b/module/language/tree-il/fix-letrec.scm
new file mode 100644
index 000000000..9b66d9ed5
--- /dev/null
+++ b/module/language/tree-il/fix-letrec.scm
@@ -0,0 +1,240 @@
+;;; transformation of letrec into simpler forms
+
+;; Copyright (C) 2009 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (language tree-il fix-letrec)
+  #:use-module (system base syntax)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
+  #:use-module (language tree-il)
+  #:use-module (language tree-il primitives)
+  #:export (fix-letrec!))
+
+;; For a detailed discussion, see "Fixing Letrec: A Faithful Yet
+;; Efficient Implementation of Scheme’s Recursive Binding Construct", by
+;; Oscar Waddell, Dipanwita Sarkar, and R. Kent Dybvig.
+
+(define fix-fold
+  (make-tree-il-folder unref ref set simple lambda complex))
+
+(define (simple-expression? x bound-vars)
+  (record-case x
+    ((<void>) #t)
+    ((<const>) #t)
+    ((<lexical-ref> gensym)
+     (not (memq gensym bound-vars)))
+    ((<conditional> test then else)
+     (and (simple-expression? test bound-vars)
+          (simple-expression? then bound-vars)
+          (simple-expression? else bound-vars)))
+    ((<sequence> exps)
+     (and-map (lambda (x) (simple-expression? x bound-vars))
+              exps))
+    ((<application> proc args)
+     (and (primitive-ref? proc)
+          (effect-free-primitive? (primitive-ref-name proc))
+          (and-map (lambda (x) (simple-expression? x bound-vars))
+                   args)))
+    (else #f)))
+
+(define (partition-vars x)
+  (let-values
+      (((unref ref set simple lambda* complex)
+        (fix-fold x
+                  (lambda (x unref ref set simple lambda* complex)
+                    (record-case x
+                      ((<lexical-ref> gensym)
+                       (values (delq gensym unref)
+                               (lset-adjoin eq? ref gensym)
+                               set
+                               simple
+                               lambda*
+                               complex))
+                      ((<lexical-set> gensym)
+                       (values unref
+                               ref
+                               (lset-adjoin eq? set gensym)
+                               simple
+                               lambda*
+                               complex))
+                      ((<letrec> vars)
+                       (values (append vars unref)
+                               ref
+                               set
+                               simple
+                               lambda*
+                               complex))
+                      ((<let> vars)
+                       (values (append vars unref)
+                               ref
+                               set
+                               simple
+                               lambda*
+                               complex))
+                      (else
+                       (values unref ref set simple lambda* complex))))
+                  (lambda (x unref ref set simple lambda* complex)
+                    (record-case x
+                      ((<letrec> (orig-vars vars) vals)
+                       (let lp ((vars orig-vars) (vals vals)
+                                (s '()) (l '()) (c '()))
+                         (cond
+                          ((null? vars)
+                           (values unref
+                                   ref
+                                   set
+                                   (append s simple)
+                                   (append l lambda*)
+                                   (append c complex)))
+                          ((memq (car vars) unref)
+                           (lp (cdr vars) (cdr vals)
+                               s l c))
+                          ((memq (car vars) set)
+                           (lp (cdr vars) (cdr vals)
+                               s l (cons (car vars) c)))
+                          ((lambda? (car vals))
+                           (lp (cdr vars) (cdr vals)
+                               s (cons (car vars) l) c))
+                          ((simple-expression? (car vals) orig-vars)
+                           (lp (cdr vars) (cdr vals)
+                               (cons (car vars) s) l c))
+                          (else
+                           (lp (cdr vars) (cdr vals)
+                               s l (cons (car vars) c))))))
+                      ((<let> (orig-vars vars) vals)
+                       ;; The point is to compile let-bound lambdas as
+                       ;; efficiently as we do letrec-bound lambdas, so
+                       ;; we use the same algorithm for analyzing the
+                       ;; vars. There is no problem recursing into the
+                       ;; bindings after the let, because all variables
+                       ;; have been renamed.
+                       (let lp ((vars orig-vars) (vals vals)
+                                (s '()) (l '()) (c '()))
+                         (cond
+                          ((null? vars)
+                           (values unref
+                                   ref
+                                   set
+                                   (append s simple)
+                                   (append l lambda*)
+                                   (append c complex)))
+                          ((memq (car vars) unref)
+                           (lp (cdr vars) (cdr vals)
+                               s l c))
+                          ((memq (car vars) set)
+                           (lp (cdr vars) (cdr vals)
+                               s l (cons (car vars) c)))
+                          ((and (lambda? (car vals))
+                                (not (memq (car vars) set)))
+                           (lp (cdr vars) (cdr vals)
+                               s (cons (car vars) l) c))
+                          ;; There is no difference between simple and
+                          ;; complex, for the purposes of let. Just lump
+                          ;; them all into complex.
+                          (else
+                           (lp (cdr vars) (cdr vals)
+                               s l (cons (car vars) c))))))
+                      (else
+                       (values unref ref set simple lambda* complex))))
+                  '()
+                  '()
+                  '()
+                  '()
+                  '()
+                  '())))
+    (values unref simple lambda* complex)))
+
+(define (fix-letrec! x)
+  (let-values (((unref simple lambda* complex) (partition-vars x)))
+    (post-order!
+     (lambda (x)
+       (record-case x
+
+         ;; Sets to unreferenced variables may be replaced by their
+         ;; expression, called for effect.
+         ((<lexical-set> gensym exp)
+          (if (memq gensym unref)
+              (make-sequence #f (list exp (make-void #f)))
+              x))
+
+         ((<letrec> src names vars vals body)
+          (let ((binds (map list vars names vals)))
+            (define (lookup set)
+              (map (lambda (v) (assq v binds))
+                   (lset-intersection eq? vars set)))
+            (let ((u (lookup unref))
+                  (s (lookup simple))
+                  (l (lookup lambda*))
+                  (c (lookup complex)))
+              ;; Bind "simple" bindings, and locations for complex
+              ;; bindings.
+              (make-let
+               src
+               (append (map cadr s) (map cadr c))
+               (append (map car s) (map car c))
+               (append (map caddr s) (map (lambda (x) (make-void #f)) c))
+               ;; Bind lambdas using the fixpoint operator.
+               (make-fix
+                src (map cadr l) (map car l) (map caddr l)
+                (make-sequence
+                 src
+                 (append
+                  ;; The right-hand-sides of the unreferenced
+                  ;; bindings, for effect.
+                  (map caddr u)
+                  (if (null? c)
+                      ;; No complex bindings, just emit the body.
+                      (list body)
+                      (list
+                       ;; Evaluate the the "complex" bindings, in a `let' to
+                       ;; indicate that order doesn't matter, and bind to
+                       ;; their variables.
+                       (let ((tmps (map (lambda (x) (gensym)) c)))
+                         (make-let
+                          #f (map cadr c) tmps (map caddr c)
+                          (make-sequence
+                           #f
+                           (map (lambda (x tmp)
+                                  (make-lexical-set
+                                   #f (cadr x) (car x)
+                                   (make-lexical-ref #f (cadr x) tmp)))
+                                c tmps))))
+                       ;; Finally, the body.
+                       body)))))))))
+
+         ((<let> src names vars vals body)
+          (let ((binds (map list vars names vals)))
+            (define (lookup set)
+              (map (lambda (v) (assq v binds))
+                   (lset-intersection eq? vars set)))
+            (let ((u (lookup unref))
+                  (l (lookup lambda*))
+                  (c (lookup complex)))
+              (make-sequence
+               src
+               (append
+                ;; unreferenced bindings, called for effect.
+                (map caddr u)
+                (list
+                 ;; unassigned lambdas use fix.
+                 (make-fix src (map cadr l) (map car l) (map caddr l)
+                           ;; and the "complex" bindings.
+                           (make-let src (map cadr c) (map car c) (map caddr c)
+                                     body))))))))
+         
+         (else x)))
+     x)))
diff --git a/module/language/tree-il/inline.scm b/module/language/tree-il/inline.scm
new file mode 100644
index 000000000..adc3f18bd
--- /dev/null
+++ b/module/language/tree-il/inline.scm
@@ -0,0 +1,81 @@
+;;; a simple inliner
+
+;; Copyright (C) 2009 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (language tree-il inline)
+  #:use-module (system base syntax)
+  #:use-module (language tree-il)
+  #:export (inline!))
+
+;; Possible optimizations:
+;; * constant folding, propagation
+;; * procedure inlining
+;;   * always when single call site
+;;   * always for "trivial" procs
+;;   * otherwise who knows
+;; * dead code elimination
+;; * degenerate case optimizations
+;; * "fixing letrec"
+
+;; This is a completely brain-dead optimization pass whose sole claim to
+;; fame is ((lambda () x)) => x.
+(define (inline! x)
+  (post-order!
+   (lambda (x)
+     (record-case x
+       ((<application> src proc args)
+        (cond
+
+         ;; ((lambda () x)) => x
+         ((and (lambda? proc) (null? (lambda-vars proc))
+               (null? args))
+          (lambda-body proc))
+
+         ;; (call-with-values (lambda () foo) (lambda (a b . c) bar))
+         ;; => (let-values (((a b . c) foo)) bar)
+         ;;
+         ;; Note that this is a singly-binding form of let-values. Also
+         ;; note that Scheme's let-values expands into call-with-values,
+         ;; then here we reduce it to tree-il's let-values.
+         ((and (primitive-ref? proc)
+               (eq? (primitive-ref-name proc) '@call-with-values)
+               (= (length args) 2)
+               (lambda? (cadr args)))
+          (let ((producer (car args))
+                (consumer (cadr args)))
+            (make-let-values src
+                             (lambda-names consumer)
+                             (lambda-vars consumer)
+                             (if (and (lambda? producer)
+                                      (null? (lambda-names producer)))
+                                 (lambda-body producer)
+                                 (make-application src producer '()))
+                             (lambda-body consumer))))
+
+         (else #f)))
+       
+       ((<let> vars body)
+        (if (null? vars) body x))
+       
+       ((<letrec> vars body)
+        (if (null? vars) body x))
+       
+       ((<fix> vars body)
+        (if (null? vars) body x))
+       
+       (else #f)))
+   x))
diff --git a/module/language/tree-il/optimize.scm b/module/language/tree-il/optimize.scm
new file mode 100644
index 000000000..0e490a636
--- /dev/null
+++ b/module/language/tree-il/optimize.scm
@@ -0,0 +1,35 @@
+;;; Tree-il optimizer
+
+;; Copyright (C) 2009 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (language tree-il optimize)
+  #:use-module (language tree-il)
+  #:use-module (language tree-il primitives)
+  #:use-module (language tree-il inline)
+  #:use-module (language tree-il fix-letrec)
+  #:export (optimize!))
+
+(define (env-module e)
+  (if e (car e) (current-module)))
+
+(define (optimize! x env opts)
+  (inline!
+   (fix-letrec!
+    (expand-primitives! 
+     (resolve-primitives! x (env-module env))))))
diff --git a/module/language/tree-il/primitives.scm b/module/language/tree-il/primitives.scm
new file mode 100644
index 000000000..955c7bf25
--- /dev/null
+++ b/module/language/tree-il/primitives.scm
@@ -0,0 +1,287 @@
+;;; open-coding primitive procedures
+
+;; Copyright (C) 2009 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (language tree-il primitives)
+  #:use-module (system base pmatch)
+  #:use-module (rnrs bytevector)
+  #:use-module (system base syntax)
+  #:use-module (language tree-il)
+  #:use-module (srfi srfi-16)
+  #:export (resolve-primitives! add-interesting-primitive!
+            expand-primitives! effect-free-primitive?))
+
+(define *interesting-primitive-names* 
+  '(apply @apply
+    call-with-values @call-with-values
+    call-with-current-continuation @call-with-current-continuation
+    call/cc
+    values
+    eq? eqv? equal?
+    = < > <= >= zero?
+    + * - / 1- 1+ quotient remainder modulo
+    not
+    pair? null? list? acons cons cons*
+
+    list vector
+
+    car cdr
+    set-car! set-cdr!
+
+    caar cadr cdar cddr
+
+    caaar caadr cadar caddr cdaar cdadr cddar cdddr
+
+    caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr
+    cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr
+
+    vector-ref vector-set!
+
+    bytevector-u8-ref bytevector-u8-set!
+    bytevector-s8-ref bytevector-s8-set!
+
+    bytevector-u16-ref bytevector-u16-set!
+    bytevector-u16-native-ref bytevector-u16-native-set!
+    bytevector-s16-ref bytevector-s16-set!
+    bytevector-s16-native-ref bytevector-s16-native-set!
+    
+    bytevector-u32-ref bytevector-u32-set!
+    bytevector-u32-native-ref bytevector-u32-native-set!
+    bytevector-s32-ref bytevector-s32-set!
+    bytevector-s32-native-ref bytevector-s32-native-set!
+    
+    bytevector-u64-ref bytevector-u64-set!
+    bytevector-u64-native-ref bytevector-u64-native-set!
+    bytevector-s64-ref bytevector-s64-set!
+    bytevector-s64-native-ref bytevector-s64-native-set!
+    
+    bytevector-ieee-single-ref bytevector-ieee-single-set!
+    bytevector-ieee-single-native-ref bytevector-ieee-single-native-set!
+    bytevector-ieee-double-ref bytevector-ieee-double-set!
+    bytevector-ieee-double-native-ref bytevector-ieee-double-native-set!))
+
+(define (add-interesting-primitive! name)
+  (hashq-set! *interesting-primitive-vars*
+              (module-variable (current-module) name)
+              name))
+
+(define *interesting-primitive-vars* (make-hash-table))
+
+(for-each add-interesting-primitive! *interesting-primitive-names*)
+
+(define *effect-free-primitives*
+  '(values
+    eq? eqv? equal?
+    = < > <= >= zero?
+    + * - / 1- 1+ quotient remainder modulo
+    not
+    pair? null? list? acons cons cons*
+    list vector
+    car cdr
+    caar cadr cdar cddr
+    caaar caadr cadar caddr cdaar cdadr cddar cdddr
+    caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr
+    cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr
+    vector-ref
+    bytevector-u8-ref bytevector-s8-ref
+    bytevector-u16-ref bytevector-u16-native-ref
+    bytevector-s16-ref bytevector-s16-native-ref
+    bytevector-u32-ref bytevector-u32-native-ref
+    bytevector-s32-ref bytevector-s32-native-ref
+    bytevector-u64-ref bytevector-u64-native-ref
+    bytevector-s64-ref bytevector-s64-native-ref
+    bytevector-ieee-single-ref bytevector-ieee-single-native-ref
+    bytevector-ieee-double-ref bytevector-ieee-double-native-ref))
+
+
+(define *effect-free-primitive-table* (make-hash-table))
+
+(for-each (lambda (x) (hashq-set! *effect-free-primitive-table* x #t))
+          *effect-free-primitives*)
+
+(define (effect-free-primitive? prim)
+  (hashq-ref *effect-free-primitive-table* prim))
+
+(define (resolve-primitives! x mod)
+  (post-order!
+   (lambda (x)
+     (record-case x
+       ((<toplevel-ref> src name)
+        (and=> (hashq-ref *interesting-primitive-vars*
+                          (module-variable mod name))
+               (lambda (name) (make-primitive-ref src name))))
+       ((<module-ref> src mod name public?)
+        ;; for the moment, we're disabling primitive resolution for
+        ;; public refs because resolve-interface can raise errors.
+        (let ((m (and (not public?) (resolve-module mod))))
+          (and m 
+               (and=> (hashq-ref *interesting-primitive-vars*
+                                 (module-variable m name))
+                      (lambda (name) (make-primitive-ref src name))))))
+       (else #f)))
+   x))
+
+
+
+(define *primitive-expand-table* (make-hash-table))
+
+(define (expand-primitives! x)
+  (pre-order!
+   (lambda (x)
+     (record-case x
+       ((<application> src proc args)
+        (and (primitive-ref? proc)
+             (let ((expand (hashq-ref *primitive-expand-table*
+                                      (primitive-ref-name proc))))
+               (and expand (apply expand src args)))))
+       (else #f)))
+   x))
+
+;;; I actually did spend about 10 minutes trying to redo this with
+;;; syntax-rules. Patches appreciated.
+;;;
+(define-macro (define-primitive-expander sym . clauses)
+  (define (inline-args args)
+    (let lp ((in args) (out '()))
+      (cond ((null? in) `(list ,@(reverse out)))
+            ((symbol? in) `(cons* ,@(reverse out) ,in))
+            ((pair? (car in))
+             (lp (cdr in)
+                 (cons `(make-application src (make-primitive-ref src ',(caar in))
+                                          ,(inline-args (cdar in)))
+                       out)))
+            ((symbol? (car in))
+             ;; assume it's locally bound
+             (lp (cdr in) (cons (car in) out)))
+            ((number? (car in))
+             (lp (cdr in) (cons `(make-const src ,(car in)) out)))
+            (else
+             (error "what what" (car in))))))
+  (define (consequent exp)
+    (cond
+     ((pair? exp)
+      (pmatch exp
+        ((if ,test ,then ,else)
+         `(if ,test
+              ,(consequent then)
+              ,(consequent else)))
+        (else
+         `(make-application src (make-primitive-ref src ',(car exp))
+                            ,(inline-args (cdr exp))))))
+     ((symbol? exp)
+      ;; assume locally bound
+      exp)
+     ((number? exp)
+      `(make-const src ,exp))
+     (else (error "bad consequent yall" exp))))
+  `(hashq-set! *primitive-expand-table*
+               ',sym
+               (case-lambda
+                ,@(let lp ((in clauses) (out '()))
+                    (if (null? in)
+                        (reverse (cons '(else #f) out))
+                        (lp (cddr in)
+                            (cons `((src . ,(car in))
+                                    ,(consequent (cadr in))) out)))))))
+
+(define-primitive-expander zero? (x)
+  (= x 0))
+
+(define-primitive-expander +
+  () 0
+  (x) x
+  (x y) (if (and (const? y)
+                 (let ((y (const-exp y)))
+                   (and (exact? y) (= y 1))))
+            (1+ x)
+            (if (and (const? x)
+                     (let ((x (const-exp x)))
+                       (and (exact? x) (= x 1))))
+                (1+ y)
+                (+ x y)))
+  (x y z . rest) (+ x (+ y z . rest)))
+  
+(define-primitive-expander *
+  () 1
+  (x) x
+  (x y z . rest) (* x (* y z . rest)))
+  
+(define-primitive-expander -
+  (x) (- 0 x)
+  (x y) (if (and (const? y)
+                 (let ((y (const-exp y)))
+                   (and (exact? y) (= y 1))))
+            (1- x)
+            (- x y))
+  (x y z . rest) (- x (+ y z . rest)))
+  
+(define-primitive-expander /
+  (x) (/ 1 x)
+  (x y z . rest) (/ x (* y z . rest)))
+  
+(define-primitive-expander caar (x) (car (car x)))
+(define-primitive-expander cadr (x) (car (cdr x)))
+(define-primitive-expander cdar (x) (cdr (car x)))
+(define-primitive-expander cddr (x) (cdr (cdr x)))
+(define-primitive-expander caaar (x) (car (car (car x))))
+(define-primitive-expander caadr (x) (car (car (cdr x))))
+(define-primitive-expander cadar (x) (car (cdr (car x))))
+(define-primitive-expander caddr (x) (car (cdr (cdr x))))
+(define-primitive-expander cdaar (x) (cdr (car (car x))))
+(define-primitive-expander cdadr (x) (cdr (car (cdr x))))
+(define-primitive-expander cddar (x) (cdr (cdr (car x))))
+(define-primitive-expander cdddr (x) (cdr (cdr (cdr x))))
+(define-primitive-expander caaaar (x) (car (car (car (car x)))))
+(define-primitive-expander caaadr (x) (car (car (car (cdr x)))))
+(define-primitive-expander caadar (x) (car (car (cdr (car x)))))
+(define-primitive-expander caaddr (x) (car (car (cdr (cdr x)))))
+(define-primitive-expander cadaar (x) (car (cdr (car (car x)))))
+(define-primitive-expander cadadr (x) (car (cdr (car (cdr x)))))
+(define-primitive-expander caddar (x) (car (cdr (cdr (car x)))))
+(define-primitive-expander cadddr (x) (car (cdr (cdr (cdr x)))))
+(define-primitive-expander cdaaar (x) (cdr (car (car (car x)))))
+(define-primitive-expander cdaadr (x) (cdr (car (car (cdr x)))))
+(define-primitive-expander cdadar (x) (cdr (car (cdr (car x)))))
+(define-primitive-expander cdaddr (x) (cdr (car (cdr (cdr x)))))
+(define-primitive-expander cddaar (x) (cdr (cdr (car (car x)))))
+(define-primitive-expander cddadr (x) (cdr (cdr (car (cdr x)))))
+(define-primitive-expander cdddar (x) (cdr (cdr (cdr (car x)))))
+(define-primitive-expander cddddr (x) (cdr (cdr (cdr (cdr x)))))
+
+(define-primitive-expander cons*
+  (x) x
+  (x y) (cons x y)
+  (x y . rest) (cons x (cons* y . rest)))
+
+(define-primitive-expander acons (x y z)
+  (cons (cons x y) z))
+
+(define-primitive-expander apply (f . args)
+  (@apply f . args))
+
+(define-primitive-expander call-with-values (producer consumer)
+  (@call-with-values producer consumer))
+
+(define-primitive-expander call-with-current-continuation (proc)
+  (@call-with-current-continuation proc))
+
+(define-primitive-expander call/cc (proc)
+  (@call-with-current-continuation proc))
+
+(define-primitive-expander values (x) x)
diff --git a/module/language/tree-il/spec.scm b/module/language/tree-il/spec.scm
new file mode 100644
index 000000000..2d24f7bf6
--- /dev/null
+++ b/module/language/tree-il/spec.scm
@@ -0,0 +1,42 @@
+;;; Tree Intermediate Language
+
+;; Copyright (C) 2009 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (language tree-il spec)
+  #:use-module (system base language)
+  #:use-module (language glil)
+  #:use-module (language tree-il)
+  #:use-module (language tree-il compile-glil)
+  #:export (tree-il))
+
+(define (write-tree-il exp . port)
+  (apply write (unparse-tree-il exp) port))
+
+(define (join exps env)
+  (make-sequence #f exps))
+
+(define-language tree-il
+  #:title	"Tree Intermediate Language"
+  #:version	"1.0"
+  #:reader	read
+  #:printer	write-tree-il
+  #:parser      parse-tree-il
+  #:joiner      join
+  #:compilers   `((glil . ,compile-glil))
+  )
diff --git a/module/language/value/spec.scm b/module/language/value/spec.scm
new file mode 100644
index 000000000..aebba8c8d
--- /dev/null
+++ b/module/language/value/spec.scm
@@ -0,0 +1,30 @@
+;;; Guile Lowlevel Intermediate Language
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (language value spec)
+  #:use-module (system base language)
+  #:export (value))
+
+(define-language value
+  #:title	"Guile Values"
+  #:version	"0.3"
+  #:reader	#f
+  #:printer	write
+  )
diff --git a/oop/ChangeLog-2008 b/module/oop/ChangeLog-2008
index 6727ef3fb..6727ef3fb 100644
--- a/oop/ChangeLog-2008
+++ b/module/oop/ChangeLog-2008
diff --git a/oop/goops.scm b/module/oop/goops.scm
index c8f1f1837..c1754da3e 100644
--- a/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -26,6 +26,7 @@
 ;;;;
 
 (define-module (oop goops)
+  :use-module (srfi srfi-1)
   :export-syntax (define-class class standard-define-class
 		  define-generic define-accessor define-method
 		  define-extended-generic define-extended-generics
@@ -36,12 +37,7 @@
 	   make-generic ensure-generic
 	   make-extended-generic
 	   make-accessor ensure-accessor
-	   process-class-pre-define-generic
-	   process-class-pre-define-accessor
-	   process-define-generic
-	   process-define-accessor
-	   make-method add-method!
-	   object-eqv? object-equal?
+	   add-method!
 	   class-slot-ref class-slot-set! slot-unbound slot-missing 
 	   slot-definition-name  slot-definition-options
 	   slot-definition-allocation
@@ -72,15 +68,19 @@
 	   class-direct-methods class-direct-slots class-precedence-list
 	   class-slots class-environment
 	   generic-function-name
-	   generic-function-methods method-generic-function method-specializers
+	   generic-function-methods method-generic-function
+	   method-specializers method-formals
 	   primitive-generic-generic enable-primitive-generic!
 	   method-procedure accessor-method-slot-definition
 	   slot-exists? make find-method get-keyword)
   :replace (<class> <operator-class> <entity-class> <entity>)
   :no-backtrace)
 
+(define *goops-module* (current-module))
+
 ;; First initialize the builtin part of GOOPS
-(%init-goops-builtins)
+(eval-when (eval load compile)
+  (%init-goops-builtins))
 
 ;; Then load the rest of GOOPS
 (use-modules (oop goops util)
@@ -88,9 +88,9 @@
 	     (oop goops compile))
 
 
-(define min-fixnum (- (expt 2 29)))
-
-(define max-fixnum (- (expt 2 29) 1))
+(eval-when (eval load compile)
+  (define min-fixnum (- (expt 2 29)))
+  (define max-fixnum (- (expt 2 29) 1)))
 
 ;;
 ;; goops-error
@@ -128,10 +128,9 @@
   (if (null? supers)
       <class>
       (let* ((all-metas (map (lambda (x) (class-of x)) supers))
-	     (all-cpls  (apply append
-			       (map (lambda (m)
-				      (cdr (class-precedence-list m))) 
-				    all-metas)))
+	     (all-cpls  (append-map (lambda (m)
+                                      (cdr (class-precedence-list m))) 
+                                    all-metas))
 	     (needed-metas '()))
 	;; Find the most specific metaclasses.  The new metaclass will be
 	;; a subclass of these.
@@ -155,165 +154,20 @@
 ;;;   SLOT-DEFINITION ::= SLOT-NAME | (SLOT-NAME OPTION ...)
 ;;;   OPTION ::= KEYWORD VALUE
 ;;;
-(define (define-class-pre-definition keyword exp env)
-  (case keyword
-    ((#:getter #:setter)
-     `(process-class-pre-define-generic ',exp))
-    ((#:accessor)
-     `(process-class-pre-define-accessor ',exp))
-    (else #f)))
-
-(define (process-class-pre-define-generic name)
-  (let ((var (module-variable (current-module) name)))
-    (if (not (and var
-		  (variable-bound? var)
-		  (is-a? (variable-ref var) <generic>)))
-	(process-define-generic name))))
-
-(define (process-class-pre-define-accessor name)
-  (let ((var (module-variable (current-module) name)))
-    (cond ((or (not var)
-	       (not (variable-bound? var)))
-	   (process-define-accessor name))
-	  ((or (is-a? (variable-ref var) <accessor>)
-	       (is-a? (variable-ref var) <extended-generic-with-setter>)))
-	  ((is-a? (variable-ref var) <generic>)
-	   ;;*fixme* don't mutate an imported object!
-	   (variable-set! var (ensure-accessor (variable-ref var) name)))
-	  (else
-	   (process-define-accessor name)))))
-
-;;; This code should be implemented in C.
-;;;
-(define define-class
-  (letrec (;; Some slot options require extra definitions to be made.
-	   ;; In particular, we want to make sure that the generic
-	   ;; function objects which represent accessors exist
-	   ;; before `make-class' tries to add methods to them.
-	   ;;
-	   ;; Postpone error handling to class macro.
-	   ;;
-	   (pre-definitions
-	    (lambda (slots env)
-	      (do ((slots slots (cdr slots))
-		   (definitions '()
-		     (if (pair? (car slots))
-			 (do ((options (cdar slots) (cddr options))
-			      (definitions definitions
-				(cond ((not (symbol? (cadr options)))
-				       definitions)
-				      ((define-class-pre-definition
-					 (car options)
-					 (cadr options)
-					 env)
-				       => (lambda (definition)
-					    (cons definition definitions)))
-				      (else definitions))))
-			     ((not (and (pair? options)
-					(pair? (cdr options))))
-			      definitions))
-			 definitions)))
-		  ((or (not (pair? slots))
-		       (keyword? (car slots)))
-		   (reverse definitions)))))
-	   
-	   ;; Syntax
-	   (name cadr)
-	   (slots cdddr))
-    
-    (procedure->memoizing-macro
-      (lambda (exp env)
-	(cond ((not (top-level-env? env))
-	       (goops-error "define-class: Only allowed at top level"))
-	      ((not (and (list? exp) (>= (length exp) 3)))
-	       (goops-error "missing or extra expression"))
-	      (else
-	       (let ((name (name exp)))
-		 `(begin
-		    ;; define accessors
-		    ,@(pre-definitions (slots exp) env)
-		    ;; update the current-module
-		    (let* ((class (class ,@(cddr exp) #:name ',name))
-			   (var (module-ensure-local-variable!
-				 (current-module) ',name))
-			   (old (and (variable-bound? var)
-				     (variable-ref var))))
-		      (if (and old
-			       (is-a? old <class>)
-			       (memq <object> (class-precedence-list old)))
-			  (variable-set! var (class-redefinition old class))
-			  (variable-set! var class)))))))))))
-
-(define standard-define-class define-class)
 
-;;; (class (SUPER ...) SLOT-DEFINITION ... OPTION ...)
-;;;
-;;;   SLOT-DEFINITION ::= SLOT-NAME | (SLOT-NAME OPTION ...)
-;;;   OPTION ::= KEYWORD VALUE
-;;;
-(define class
-  (letrec ((slot-option-keyword car)
-	   (slot-option-value cadr)
-	   (process-slot-options
-	    (lambda (options)
-	      (let loop ((options options)
-			 (res '()))
-		(cond ((null? options)
-		       (reverse res))
-		      ((null? (cdr options))
-		       (goops-error "malformed slot option list"))
-		      ((not (keyword? (slot-option-keyword options)))
-		       (goops-error "malformed slot option list"))
-		      (else
-		       (case (slot-option-keyword options)
-			 ((#:init-form)
-			  (loop (cddr options)
-				(append (list `(lambda ()
-						 ,(slot-option-value options))
-					      #:init-thunk
-					      (list 'quote
-						    (slot-option-value options))
-					      #:init-form)
-					res)))
-			 (else
-			  (loop (cddr options)
-				(cons (cadr options)
-				      (cons (car options)
-					    res)))))))))))
-    
-    (procedure->memoizing-macro
-      (let ((supers cadr)
-	    (slots cddr)
-	    (options cdddr))
-	(lambda (exp env)
-	  (cond ((not (and (list? exp) (>= (length exp) 2)))
-		 (goops-error "missing or extra expression"))
-		((not (list? (supers exp)))
-		 (goops-error "malformed superclass list: ~S" (supers exp)))
-		(else
-		 (let ((slot-defs (cons #f '())))
-		   (do ((slots (slots exp) (cdr slots))
-			(defs slot-defs (cdr defs)))
-		       ((or (null? slots)
-			    (keyword? (car slots)))
-			`(make-class
-			  ;; evaluate super class variables
-			  (list ,@(supers exp))
-			  ;; evaluate slot definitions, except the slot name!
-			  (list ,@(cdr slot-defs))
-			  ;; evaluate class options
-			  ,@slots
-			  ;; place option last in case someone wants to
-			  ;; pass a different value
-			  #:environment ',env))
-		     (set-cdr!
-		      defs
-		      (list (if (pair? (car slots))
-				`(list ',(slot-definition-name (car slots))
-				       ,@(process-slot-options
-					  (slot-definition-options
-					   (car slots))))
-				`(list ',(car slots))))))))))))))
+(define (kw-do-map mapper f kwargs)
+  (define (keywords l)
+    (cond
+     ((null? l) '())
+     ((or (null? (cdr l)) (not (keyword? (car l))))
+      (goops-error "malformed keyword arguments: ~a" kwargs))
+     (else (cons (car l) (keywords (cddr l))))))
+  (define (args l)
+    (if (null? l) '() (cons (cadr l) (args (cddr l)))))
+  ;; let* to check keywords first
+  (let* ((k (keywords kwargs))
+         (a (args kwargs)))
+    (mapper f k a)))
 
 (define (make-class supers slots . options)
   (let ((env (or (get-keyword #:environment options #f)
@@ -347,55 +201,139 @@
 	     #:environment env
 	     options))))
 
+;;; (class (SUPER ...) SLOT-DEFINITION ... OPTION ...)
+;;;
+;;;   SLOT-DEFINITION ::= SLOT-NAME | (SLOT-NAME OPTION ...)
+;;;   OPTION ::= KEYWORD VALUE
+;;;
+(define-macro (class supers . slots)
+  (define (make-slot-definition-forms slots)
+    (map
+     (lambda (def)
+       (cond
+        ((pair? def)
+         `(list ',(car def)
+                ,@(kw-do-map append-map
+                             (lambda (kw arg)
+                               (case kw
+                                 ((#:init-form)
+                                  `(#:init-form ',arg
+                                    #:init-thunk (lambda () ,arg)))
+                                 (else (list kw arg))))
+                             (cdr def))))
+        (else
+         `(list ',def))))
+     slots))
+  (if (not (list? supers))
+      (goops-error "malformed superclass list: ~S" supers))
+  (let ((slot-defs (cons #f '()))
+        (slots (take-while (lambda (x) (not (keyword? x))) slots))
+        (options (or (find-tail keyword? slots) '())))
+    `(make-class
+      ;; evaluate super class variables
+      (list ,@supers)
+      ;; evaluate slot definitions, except the slot name!
+      (list ,@(make-slot-definition-forms slots))
+      ;; evaluate class options
+      ,@options)))
+
+(define-syntax define-class-pre-definition
+  (lambda (x)
+    (syntax-case x ()
+      ((_ (k arg rest ...) out ...)
+       (keyword? (syntax->datum (syntax k)))
+       (case (syntax->datum (syntax k))
+         ((#:getter #:setter)
+          (syntax
+           (define-class-pre-definition (rest ...)
+             out ...
+             (if (or (not (defined? 'arg))
+                     (not (is-a? arg <generic>)))
+                 (toplevel-define!
+                  'arg
+                  (ensure-generic (if (defined? 'arg) arg #f) 'arg))))))
+         ((#:accessor)
+          (syntax
+           (define-class-pre-definition (rest ...)
+             out ...
+             (if (or (not (defined? 'arg))
+                     (not (is-a? arg <accessor>)))
+                 (toplevel-define!
+                  'arg
+                  (ensure-accessor (if (defined? 'arg) arg #f) 'arg))))))
+         (else
+          (syntax
+           (define-class-pre-definition (rest ...) out ...)))))
+      ((_ () out ...)
+       (syntax (begin out ...))))))
+       
+;; Some slot options require extra definitions to be made. In
+;; particular, we want to make sure that the generic function objects
+;; which represent accessors exist before `make-class' tries to add
+;; methods to them.
+(define-syntax define-class-pre-definitions
+  (lambda (x)
+    (syntax-case x ()
+      ((_ () out ...)
+       (syntax (begin out ...)))
+      ((_ (slot rest ...) out ...)
+       (keyword? (syntax->datum (syntax slot)))
+       (syntax (begin out ...)))
+      ((_ (slot rest ...) out ...)
+       (identifier? (syntax slot))
+       (syntax (define-class-pre-definitions (rest ...)
+                 out ...)))
+      ((_ ((slotname slotopt ...) rest ...) out ...)
+       (syntax (define-class-pre-definitions (rest ...) 
+                 out ... (define-class-pre-definition (slotopt ...))))))))
+
+(define-syntax define-class
+  (syntax-rules ()
+    ((_ name supers slot ...)
+     (begin
+       (define-class-pre-definitions (slot ...))
+       (if (and (defined? 'name)
+                (is-a? name <class>)
+                (memq <object> (class-precedence-list name)))
+           (class-redefinition name
+                               (class supers slot ... #:name 'name))
+           (toplevel-define! 'name (class supers slot ... #:name 'name)))))))
+       
+(define-syntax standard-define-class
+  (syntax-rules ()
+    ((_ arg ...) (define-class arg ...))))
+
 ;;;
 ;;; {Generic functions and accessors}
 ;;;
 
-(define define-generic
-  (procedure->memoizing-macro
-    (lambda (exp env)
-      (let ((name (cadr exp)))
-	(cond ((not (symbol? name))
-	       (goops-error "bad generic function name: ~S" name))
-	      ((top-level-env? env)
-	       `(process-define-generic ',name))
-	      (else
-	       `(define ,name (make <generic> #:name ',name))))))))
-
-(define (process-define-generic name)
-  (let ((var (module-ensure-local-variable! (current-module) name)))
-    (if (or (not var)
-	    (not (variable-bound? var))
-	    (is-a? (variable-ref var) <generic>))
-	;; redefine if NAME isn't defined previously, or is another generic
-	(variable-set! var (make <generic> #:name name))
-	;; otherwise try to upgrade the object to a generic
-	(variable-set! var (ensure-generic (variable-ref var) name)))))
-
-(define define-extended-generic
-  (procedure->memoizing-macro
-    (lambda (exp env)
-      (let ((name (cadr exp)))
-	(cond ((not (symbol? name))
-	       (goops-error "bad generic function name: ~S" name))
-	      ((null? (cddr exp))
-	       (goops-error "missing expression"))
-	      (else
-	       `(define ,name (make-extended-generic ,(caddr exp) ',name))))))))
-(define define-extended-generics
-  (procedure->memoizing-macro
-    (lambda (exp env)
-      (let ((names (cadr exp))
-	    (prefixes (get-keyword #:prefix (cddr exp) #f)))
-	(if prefixes
-	    `(begin
-	       ,@(map (lambda (name)
-			`(define-extended-generic ,name
-			   (list ,@(map (lambda (prefix)
-					  (symbol-append prefix name))
-					prefixes))))
-		      names))
-	    (goops-error "no prefixes supplied"))))))
+;; Apparently the desired semantics are that we extend previous
+;; procedural definitions, but that if `name' was already a generic, we
+;; overwrite its definition.
+(define-macro (define-generic name)
+  (if (not (symbol? name))
+      (goops-error "bad generic function name: ~S" name))
+  `(define ,name
+     (if (and (defined? ',name) (is-a? ,name <generic>))
+         (make <generic> #:name ',name)
+         (ensure-generic (if (defined? ',name) ,name #f) ',name))))
+
+(define-macro (define-extended-generic name val)
+  (if (not (symbol? name))
+      (goops-error "bad generic function name: ~S" name))
+  `(define ,name (make-extended-generic ,val ',name)))
+
+(define-macro (define-extended-generics names . args)
+  (let ((prefixes (get-keyword #:prefix args #f)))
+    (if prefixes
+        `(begin
+           ,@(map (lambda (name)
+                    `(define-extended-generic ,name
+                       (list ,@(map (lambda (prefix)
+                                      (symbol-append prefix name))
+                                    prefixes))))
+                  names))
+        (goops-error "no prefixes supplied"))))
 
 (define (make-generic . name)
   (let ((name (and (pair? name) (car name))))
@@ -408,13 +346,12 @@
     (let ((ans (if gws?
 		   (let* ((sname (and name (make-setter-name name)))
 			  (setters
-			   (apply append
-				  (map (lambda (gf)
+			   (append-map (lambda (gf)
 					 (if (is-a? gf <generic-with-setter>)
 					     (list (ensure-generic (setter gf)
 								   sname))
 					     '()))
-				       gfs)))
+				       gfs))
 			  (es (make <extended-generic-with-setter>
 				#:name name
 				#:extends gfs
@@ -453,27 +390,14 @@
 	   (make <generic> #:name name #:default old-definition))
 	  (else (make <generic> #:name name)))))
 
-(define define-accessor
-  (procedure->memoizing-macro
-    (lambda (exp env)
-      (let ((name (cadr exp)))
-	(cond ((not (symbol? name))
-	       (goops-error "bad accessor name: ~S" name))
-	      ((top-level-env? env)
-	       `(process-define-accessor ',name))
-	      (else
-	       `(define ,name (make-accessor ',name))))))))
-
-(define (process-define-accessor name)
-  (let ((var (module-ensure-local-variable! (current-module) name)))
-    (if (or (not var)
-	    (not (variable-bound? var))
-	    (is-a? (variable-ref var) <accessor>)
-	    (is-a? (variable-ref var) <extended-generic-with-setter>))
-	;; redefine if NAME isn't defined previously, or is another accessor
-	(variable-set! var (make-accessor name))
-	;; otherwise try to upgrade the object to an accessor
-	(variable-set! var (ensure-accessor (variable-ref var) name)))))
+;; same semantics as <generic>
+(define-syntax define-accessor
+  (syntax-rules ()
+    ((_ name)
+     (define name
+       (cond ((not (defined? 'name))  (ensure-accessor #f 'name))
+             ((is-a? name <accessor>) (make <accessor> #:name 'name))
+             (else                    (ensure-accessor name 'name)))))))
 
 (define (make-setter-name name)
   (string->symbol (string-append "setter:" (symbol->string name))))
@@ -528,87 +452,132 @@
 ;;; {Methods}
 ;;;
 
-(define define-method
-  (procedure->memoizing-macro
-    (lambda (exp env)
-      (let ((head (cadr exp)))
-	(if (not (pair? head))
-	    (goops-error "bad method head: ~S" head)
-	    (let ((gf (car head)))
-	      (cond ((and (pair? gf)
-			  (eq? (car gf) 'setter)
-			  (pair? (cdr gf))
-			  (symbol? (cadr gf))
-			  (null? (cddr gf)))
-		     ;; named setter method
-		     (let ((name (cadr gf)))
-		       (cond ((not (symbol? name))
-			      `(add-method! (setter ,name)
-					    (method ,(cdadr exp)
-						    ,@(cddr exp))))
-			     ((defined? name env)
-			      `(begin
-				 ;; *fixme* Temporary hack for the current
-				 ;;         module system
-				 (if (not ,name)
-				     (define-accessor ,name))
-				 (add-method! (setter ,name)
-					      (method ,(cdadr exp)
-						      ,@(cddr exp)))))
-			     (else
-			      `(begin
-				 (define-accessor ,name)
-				 (add-method! (setter ,name)
-					      (method ,(cdadr exp)
-						      ,@(cddr exp))))))))
-		    ((not (symbol? gf))
-		     `(add-method! ,gf (method ,(cdadr exp) ,@(cddr exp))))
-		    ((defined? gf env)
-		     `(begin
-			;; *fixme* Temporary hack for the current
-			;;         module system
-			(if (not ,gf)
-			    (define-generic ,gf))
-			(add-method! ,gf
-				     (method ,(cdadr exp)
-					     ,@(cddr exp)))))
-		    (else
-		     `(begin
-			(define-generic ,gf)
-			(add-method! ,gf
-				     (method ,(cdadr exp)
-					     ,@(cddr exp))))))))))))
-
-(define (make-method specializers procedure)
-  (make <method>
-	#:specializers specializers
-	#:procedure procedure))
-
-(define method
-  (letrec ((specializers
-	    (lambda (ls)
-	      (cond ((null? ls) (list (list 'quote '())))
-		    ((pair? ls) (cons (if (pair? (car ls))
-					  (cadar ls)
-					  '<top>)
-				      (specializers (cdr ls))))
-		    (else '(<top>)))))
-	   (formals
-	    (lambda (ls)
-	      (if (pair? ls)
-		  (cons (if (pair? (car ls)) (caar ls) (car ls))
-			(formals (cdr ls)))
-		  ls))))
-    (procedure->memoizing-macro
-      (lambda (exp env)
-	(let ((args (cadr exp))
-	      (body (cddr exp)))
-	  `(make <method>
-		 #:specializers (cons* ,@(specializers args))
-		 #:procedure (lambda ,(formals args)
-			       ,@(if (null? body)
-				     (list *unspecified*)
-				     body))))))))
+(define (toplevel-define! name val)
+  (module-define! (current-module) name val))
+
+(define-syntax define-method
+  (syntax-rules (setter)
+    ((_ ((setter name) . args) body ...)
+     (begin
+       (if (or (not (defined? 'name))
+               (not (is-a? name <accessor>)))
+           (toplevel-define! 'name
+                             (ensure-accessor
+                              (if (defined? 'name) name #f) 'name)))
+       (add-method! (setter name) (method args body ...))))
+    ((_ (name . args) body ...)
+     (begin
+       ;; FIXME: this code is how it always was, but it's quite cracky:
+       ;; it will only define the generic function if it was undefined
+       ;; before (ok), or *was defined to #f*. The latter is crack. But
+       ;; there are bootstrap issues about fixing this -- change it to
+       ;; (is-a? name <generic>) and see.
+       (if (or (not (defined? 'name))
+               (not name))
+           (toplevel-define! 'name (make <generic> #:name 'name)))
+       (add-method! name (method args body ...))))))
+
+(define-syntax method
+  (lambda (x)
+    (define (parse-args args)
+      (let lp ((ls args) (formals '()) (specializers '()))
+        (syntax-case ls ()
+          (((f s) . rest)
+           (and (identifier? (syntax f)) (identifier? (syntax s)))
+           (lp (syntax rest)
+               (cons (syntax f) formals)
+               (cons (syntax s) specializers)))
+          ((f . rest)
+           (identifier? (syntax f))
+           (lp (syntax rest)
+               (cons (syntax f) formals)
+               (cons (syntax <top>) specializers)))
+          (()
+           (list (reverse formals)
+                 (reverse (cons (syntax '()) specializers))))
+          (tail
+           (identifier? (syntax tail))
+           (list (append (reverse formals) (syntax tail))
+                 (reverse (cons (syntax <top>) specializers)))))))
+
+    (define (find-free-id exp referent)
+      (syntax-case exp ()
+        ((x . y)
+         (or (find-free-id (syntax x) referent)
+             (find-free-id (syntax y) referent)))
+        (x
+         (identifier? (syntax x))
+         (let ((id (datum->syntax (syntax x) referent)))
+           (and (free-identifier=? (syntax x) id) id)))
+        (_ #f)))
+
+    (define (compute-procedure formals body)
+      (syntax-case body ()
+        ((body0 ...)
+         (with-syntax ((formals formals))
+           (syntax (lambda formals body0 ...))))))
+
+    (define (->proper args)
+      (let lp ((ls args) (out '()))
+        (syntax-case ls ()
+          ((x . xs)        (lp (syntax xs) (cons (syntax x) out)))
+          (()              (reverse out))
+          (tail            (reverse (cons (syntax tail) out))))))
+
+    (define (compute-make-procedure formals body next-method)
+      (syntax-case body ()
+        ((body ...)
+         (with-syntax ((next-method next-method))
+           (syntax-case formals ()
+             ((formal ...)
+              (syntax
+               (lambda (real-next-method)
+                 (lambda (formal ...)
+                   (let ((next-method (lambda args
+                                        (if (null? args)
+                                            (real-next-method formal ...)
+                                            (apply real-next-method args)))))
+                     body ...)))))
+             (formals
+              (with-syntax (((formal ...) (->proper (syntax formals))))
+                (syntax
+                 (lambda (real-next-method)
+                   (lambda formals
+                     (let ((next-method (lambda args
+                                          (if (null? args)
+                                              (apply real-next-method formal ...)
+                                              (apply real-next-method args)))))
+                       body ...)))))))))))
+
+    (define (compute-procedures formals body)
+      ;; So, our use of this is broken, because it operates on the
+      ;; pre-expansion source code. It's equivalent to just searching
+      ;; for referent in the datums. Ah well.
+      (let ((id (find-free-id body 'next-method)))
+        (if id
+            ;; return a make-procedure
+            (values (syntax #f)
+                    (compute-make-procedure formals body id))
+            (values (compute-procedure formals body)
+                    (syntax #f)))))
+
+    (syntax-case x ()
+      ((_ args) (syntax (method args (if #f #f))))
+      ((_ args body0 body1 ...)
+       (with-syntax (((formals (specializer ...)) (parse-args (syntax args))))
+         (call-with-values
+             (lambda ()
+               (compute-procedures (syntax formals) (syntax (body0 body1 ...))))
+           (lambda (procedure make-procedure)
+             (with-syntax ((procedure procedure)
+                           (make-procedure make-procedure))
+               (syntax
+                (make <method>
+                  #:specializers (cons* specializer ...)
+                  #:formals 'formals
+                  #:body '(body0 body1 ...)
+                  #:make-procedure make-procedure
+                  #:procedure procedure))))))))))
 
 ;;;
 ;;; {add-method!}
@@ -618,7 +587,7 @@
   ;; Add method in all the classes which appears in its specializers list
   (for-each* (lambda (x)
 	       (let ((dm (class-direct-methods x)))
-		 (if (not (memv m dm))
+		 (if (not (memq m dm))
 		     (slot-set! x 'direct-methods (cons m dm)))))
 	     (method-specializers m)))
 
@@ -644,23 +613,21 @@
 		methods)
 	      (loop (cdr l)))))))
 
-(define (internal-add-method! gf m)
-  (slot-set! m  'generic-function gf)
-  (slot-set! gf 'methods (compute-new-list-of-methods gf m))
-  (let ((specializers (slot-ref m 'specializers)))
-    (slot-set! gf 'n-specialized
-	       (max (length* specializers)
-		    (slot-ref gf 'n-specialized))))
-  (%invalidate-method-cache! gf)
-  (add-method-in-classes! m)
-  *unspecified*)
+(define internal-add-method!
+  (method ((gf <generic>) (m <method>))
+    (slot-set! m  'generic-function gf)
+    (slot-set! gf 'methods (compute-new-list-of-methods gf m))
+    (let ((specializers (slot-ref m 'specializers)))
+      (slot-set! gf 'n-specialized
+                 (max (length* specializers)
+                      (slot-ref gf 'n-specialized))))
+    (%invalidate-method-cache! gf)
+    (add-method-in-classes! m)
+    *unspecified*))
 
 (define-generic add-method!)
 
-(internal-add-method! add-method!
-		      (make <method>
-			#:specializers (list <generic> <method>)
-			#:procedure internal-add-method!))
+((method-procedure internal-add-method!) add-method! internal-add-method!)
 
 (define-method (add-method! (proc <procedure>) (m <method>))
   (if (generic-capability? proc)
@@ -684,12 +651,16 @@
 ;;;
 (define-method (method-source (m <method>))
   (let* ((spec (map* class-name (slot-ref m 'specializers)))
-	 (proc (procedure-source (slot-ref m 'procedure)))
-	 (args (cadr proc))
-	 (body (cddr proc)))
-    (cons 'method
-	  (cons (map* list args spec)
-		body))))
+	 (src (procedure-source (slot-ref m 'procedure))))
+    (and src
+         (let ((args (cadr src))
+               (body (cddr src)))
+           (cons 'method
+                 (cons (map* list args spec)
+                       body))))))
+
+(define-method (method-formals (m <method>))
+  (slot-ref m 'formals))
 
 ;;;
 ;;; Slots
@@ -740,12 +711,6 @@
 (define-method (eqv? x y) #f)
 (define-method (equal? x y) (eqv? x y))
 
-;;; These following two methods are for backward compatibility only.
-;;; They are not called by the Guile interpreter.
-;;;
-(define-method (object-eqv? x y)    #f)
-(define-method (object-equal? x y)  (eqv? x y))
-
 ;;;
 ;;; methods to display/write an object
 ;;;
@@ -1159,33 +1124,49 @@
 	   (procedure-environment proc)))
 	(lambda (o) (assert-bound (proc o) o)))))
 
-(define n-standard-accessor-methods 10)
-
-(define bound-check-get-methods (make-vector n-standard-accessor-methods #f))
-(define standard-get-methods (make-vector n-standard-accessor-methods #f))
-(define standard-set-methods (make-vector n-standard-accessor-methods #f))
-
-(define (standard-accessor-method make methods)
-  (lambda (index)
-    (cond ((>= index n-standard-accessor-methods) (make index))
-	  ((vector-ref methods index))
-	  (else (let ((m (make index)))
-		  (vector-set! methods index m)
-		  m)))))
-
-(define (make-bound-check-get index)
-  (local-eval `(lambda (o) (@assert-bound-ref o ,index)) (the-environment)))
-
-(define (make-get index)
-  (local-eval `(lambda (o) (@slot-ref o ,index)) (the-environment)))
+;; the idea is to compile the index into the procedure, for fastest
+;; lookup. Also, @slot-ref and @slot-set! have their own bytecodes.
+
+(eval-when (compile)
+  (use-modules ((language tree-il primitives) :select (add-interesting-primitive!)))
+  (add-interesting-primitive! '@slot-ref)
+  (add-interesting-primitive! '@slot-set!))
+
+(eval-when (eval load compile)
+  (define num-standard-pre-cache 20))
+
+(define-macro (define-standard-accessor-method form . body)
+  (let ((name (caar form))
+        (n-var (cadar form))
+        (args (cdr form)))
+    (define (make-one x)
+      (define (body-trans form)
+        (cond ((not (pair? form)) form)
+              ((eq? (car form) '@slot-ref)
+               `(,(car form) ,(cadr form) ,x))
+              ((eq? (car form) '@slot-set!)
+               `(,(car form) ,(cadr form) ,x ,(cadddr form)))
+              (else
+               (map body-trans form))))
+      `(lambda ,args ,@(map body-trans body)))
+    `(define ,name
+       (let ((cache (vector ,@(map make-one (iota num-standard-pre-cache)))))
+         (lambda (n)
+           (if (< n ,num-standard-pre-cache)
+               (vector-ref cache n)
+               ((lambda (,n-var) (lambda ,args ,@body)) n)))))))
+
+(define-standard-accessor-method ((bound-check-get n) o)
+  (let ((x (@slot-ref o n)))
+    (if (unbound? x)
+        (slot-unbound obj)
+        x)))
 
-(define (make-set index)
-  (local-eval `(lambda (o v) (@slot-set! o ,index v)) (the-environment)))
+(define-standard-accessor-method ((standard-get n) o)
+  (@slot-ref o n))
 
-(define bound-check-get
-  (standard-accessor-method make-bound-check-get bound-check-get-methods))
-(define standard-get (standard-accessor-method make-get standard-get-methods))
-(define standard-set (standard-accessor-method make-set standard-set-methods))
+(define-standard-accessor-method ((standard-set n) o v)
+  (@slot-set! o n v))
 
 ;;; compute-getters-n-setters
 ;;;
@@ -1214,12 +1195,17 @@
 	  (else
 	   (let ((get (car l)) 
 		 (set (cadr l)))
-	     (if (not (and (closure? get)
-			   (= (car (procedure-property get 'arity)) 1)))
+             ;; note that we allow non-closures; we only check arity on
+             ;; the closures, though, because we inline their dispatch
+             ;; in %get-slot-value / %set-slot-value.
+	     (if (or (not (procedure? get))
+                     (and (closure? get)
+                          (not (= (car (procedure-property get 'arity)) 1))))
 		 (goops-error "Bad getter closure for slot `~S' in ~S: ~S"
 			      slot class get))
-	     (if (not (and (closure? set)
-			   (= (car (procedure-property set 'arity)) 2)))
+	     (if (or (not (procedure? set))
+                     (and (closure? set)
+                          (not (= (car (procedure-property set 'arity)) 2))))
 		 (goops-error "Bad setter closure for slot `~S' in ~S: ~S"
 			      slot class set))))))
 
@@ -1522,12 +1508,8 @@
 	(name (get-keyword #:name initargs #f)))
     (next-method)
     (slot-set! generic 'methods (if (is-a? previous-definition <procedure>)
-				    (list (make <method>
-						#:specializers <top>
-						#:procedure
-						(lambda l
-						  (apply previous-definition 
-							 l))))
+				    (list (method args
+                                            (apply previous-definition args)))
 				    '()))
     (if name
 	(set-procedure-property! generic 'name name))
@@ -1544,8 +1526,12 @@
   (slot-set! method 'generic-function (get-keyword #:generic-function initargs #f))
   (slot-set! method 'specializers (get-keyword #:specializers initargs '()))
   (slot-set! method 'procedure
-	     (get-keyword #:procedure initargs dummy-procedure))
-  (slot-set! method 'code-table '()))
+	     (get-keyword #:procedure initargs #f))
+  (slot-set! method 'code-table '())
+  (slot-set! method 'formals (get-keyword #:formals initargs '()))
+  (slot-set! method 'body (get-keyword #:body initargs '()))
+  (slot-set! method 'make-procedure (get-keyword #:make-procedure initargs #f)))
+             
 
 (define-method (initialize (obj <foreign-object>) initargs))
 
diff --git a/module/oop/goops/accessors.scm b/module/oop/goops/accessors.scm
new file mode 100644
index 000000000..5b05d3b15
--- /dev/null
+++ b/module/oop/goops/accessors.scm
@@ -0,0 +1,72 @@
+;;;; 	Copyright (C) 1999, 2000, 2005, 2006 Free Software Foundation, Inc.
+;;;; 
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+;;;; 
+
+
+(define-module (oop goops accessors)
+  :use-module (oop goops)
+  :re-export (standard-define-class)
+  :export (define-class-with-accessors
+	   define-class-with-accessors-keywords))
+
+(define-macro (define-class-with-accessors name supers . slots)
+  (let ((eat? #f))
+    `(standard-define-class
+      ,name ,supers
+      ,@(map-in-order
+         (lambda (slot)
+           (cond (eat?
+                  (set! eat? #f)
+                  slot)
+                 ((keyword? slot)
+                  (set! eat? #t)
+                  slot)
+                 ((pair? slot)
+                  (if (get-keyword #:accessor (cdr slot) #f)
+                      slot
+                      (let ((name (car slot)))
+                        `(,name #:accessor ,name ,@(cdr slot)))))
+                 (else
+                  `(,slot #:accessor ,slot))))
+         slots))))
+
+(define-macro (define-class-with-accessors-keywords name supers . slots)
+  (let ((eat? #f))
+    `(standard-define-class
+      ,name ,supers
+      ,@(map-in-order
+         (lambda (slot)
+           (cond (eat?
+                  (set! eat? #f)
+                  slot)
+                 ((keyword? slot)
+                  (set! eat? #t)
+                  slot)
+                 ((pair? slot)
+                  (let ((slot
+                         (if (get-keyword #:accessor (cdr slot) #f)
+                             slot
+                             (let ((name (car slot)))
+                               `(,name #:accessor ,name ,@(cdr slot))))))
+                    (if (get-keyword #:init-keyword (cdr slot) #f)
+                        slot
+                        (let* ((name (car slot))
+                               (keyword (symbol->keyword name)))
+                          `(,name #:init-keyword ,keyword ,@(cdr slot))))))
+                 (else
+                  `(,slot #:accessor ,slot
+                          #:init-keyword ,(symbol->keyword slot)))))
+         slots))))
diff --git a/oop/goops/active-slot.scm b/module/oop/goops/active-slot.scm
index e6b409ad0..5cd2afe10 100644
--- a/oop/goops/active-slot.scm
+++ b/module/oop/goops/active-slot.scm
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/module/oop/goops/compile.scm b/module/oop/goops/compile.scm
new file mode 100644
index 000000000..5db406cd0
--- /dev/null
+++ b/module/oop/goops/compile.scm
@@ -0,0 +1,81 @@
+;;;; 	Copyright (C) 1999, 2001, 2006 Free Software Foundation, Inc.
+;;;; 
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+;;;; 
+
+
+;; There are circularities here; you can't import (oop goops compile)
+;; before (oop goops). So when compiling, make sure that things are
+;; kosher.
+(eval-when (compile) (resolve-module '(oop goops)))
+
+(define-module (oop goops compile)
+  :use-module (oop goops)
+  :use-module (oop goops util)
+  :export (compute-cmethod)
+  :no-backtrace
+  )
+
+;;;
+;;; Method entries
+;;;
+
+(define code-table-lookup
+  (letrec ((check-entry (lambda (entry types)
+                          (cond
+                           ((not (pair? entry)) (and (null? types) entry))
+                           ((null? types) #f)
+                           (else
+                            (and (eq? (car entry) (car types))
+                                 (check-entry (cdr entry) (cdr types))))))))
+    (lambda (code-table types)
+      (cond ((null? code-table) #f)
+	    ((check-entry (car code-table) types))
+	    (else (code-table-lookup (cdr code-table) types))))))
+
+(define (compute-cmethod methods types)
+  (or (code-table-lookup (slot-ref (car methods) 'code-table) types)
+      (let* ((method (car methods))
+             (cmethod (compile-method methods types))
+	     (entry (append types cmethod)))
+	(slot-set! method 'code-table
+		   (cons entry (slot-ref method 'code-table)))
+	cmethod)))
+
+;;;
+;;; Compiling next methods into method bodies
+;;;
+
+;;; So, for the reader: there basic idea is that, given that the
+;;; semantics of `next-method' depend on the concrete types being
+;;; dispatched, why not compile a specific procedure to handle each type
+;;; combination that we see at runtime.
+;;;
+;;; In theory we can do much better than a bytecode compilation, because
+;;; we know the *exact* types of the arguments. It's ideal for native
+;;; compilation. A task for the future.
+;;;
+;;; I think this whole generic application mess would benefit from a
+;;; strict MOP.
+
+(define (compile-method methods types)
+  (let ((make-procedure (slot-ref (car methods) 'make-procedure)))
+    (if make-procedure
+        (make-procedure
+         (if (null? methods)
+             (lambda args
+               (no-next-method (method-generic-function (car methods)) args))
+             (compute-cmethod (cdr methods) types)))
+        (method-procedure (car methods)))))
diff --git a/oop/goops/composite-slot.scm b/module/oop/goops/composite-slot.scm
index 9bf5cf8f8..b3f8cc038 100644
--- a/oop/goops/composite-slot.scm
+++ b/module/oop/goops/composite-slot.scm
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/oop/goops/describe.scm b/module/oop/goops/describe.scm
index 184fef214..fa7bc466c 100644
--- a/oop/goops/describe.scm
+++ b/module/oop/goops/describe.scm
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/oop/goops/dispatch.scm b/module/oop/goops/dispatch.scm
index 73f413234..0dd169d59 100644
--- a/oop/goops/dispatch.scm
+++ b/module/oop/goops/dispatch.scm
@@ -3,7 +3,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -16,6 +16,11 @@
 ;;;;
 
 
+;; There are circularities here; you can't import (oop goops compile)
+;; before (oop goops). So when compiling, make sure that things are
+;; kosher.
+(eval-when (compile) (resolve-module '(oop goops)))
+
 (define-module (oop goops dispatch)
   :use-module (oop goops)
   :use-module (oop goops util)
@@ -117,7 +122,7 @@
 (define (cache-methods entries)
   (do ((i (- (vector-length entries) 1) (- i 1))
        (methods '() (let ((entry (vector-ref entries i)))
-		      (if (struct? (car entry))
+		      (if (or (not (pair? entry)) (struct? (car entry)))
 			  (cons entry methods)
 			  methods))))
       ((< i 0) methods)))
@@ -176,37 +181,36 @@
   (let ((hashset-index (+ hashset-index hashset)))
     (do ((sum 0)
 	 (classes entry (cdr classes)))
-	((not (struct? (car classes))) sum)
+	((not (and (pair? classes) (struct? (car classes))))
+         sum)
       (set! sum (+ sum (struct-ref (car classes) hashset-index))))))
 
 (define (cache-try-hash! min-misses hashset cache entries)
   (let ((max-misses 0)
 	(mask (- (vector-length cache) 1)))
-    (catch 'misses
-	   (lambda ()
-	     (do ((ls entries (cdr ls))
-		  (misses 0 0))
-		 ((null? ls) max-misses)
-	       (do ((i (logand mask (cache-hashval hashset (car ls)))
-		       (logand mask (+ i 1))))
-		   ((not (struct? (car (vector-ref cache i))))
-		    (vector-set! cache i (car ls)))
-		 (set! misses (+ 1 misses))
-		 (if (>= misses min-misses)
-		     (throw 'misses misses)))
-	       (if (> misses max-misses)
-		   (set! max-misses misses))))
-	   (lambda (key misses)
-	     misses))))
+    (let outer ((in entries) (max-misses 0))
+      (if (null? in)
+          max-misses
+          (let inner ((i (logand mask (cache-hashval hashset (car in))))
+                      (misses 0))
+            (cond
+             ((and (pair? (vector-ref cache i))
+                   (eq? (car (vector-ref cache i)) 'no-method))
+              (vector-set! cache i (car in))
+              (outer (cdr in) (if (> misses max-misses) misses max-misses)))
+             (else
+              (let ((misses (+ 1 misses)))
+                (if (>= misses min-misses)
+                    misses ;; this is a return, yo.
+                    (inner (logand mask (+ i 1)) misses))))))))))
 
 ;;;
 ;;; Memoization
 ;;;
 
 ;; Backward compatibility
-(if (not (defined? 'lookup-create-cmethod))
-    (define (lookup-create-cmethod gf args)
-      (no-applicable-method (car args) (cadr args))))
+(define (lookup-create-cmethod gf args)
+  (no-applicable-method (car args) (cadr args)))
 
 (define (memoize-method! gf args exp)
   (if (not (slot-ref gf 'used-by))
@@ -260,7 +264,6 @@
 		  (+ 1 (slot-ref (method-cache-generic-function exp)
 				 'n-specialized)))))
 	(let* ((types (map class-of (first-n args n-specializers)))
-	       (entry+cmethod (compute-entry-with-cmethod applicable types)))
-	  (insert! exp (car entry+cmethod)) ; entry = types + cmethod
-	  (cdr entry+cmethod) ; cmethod
-	  )))))
+	       (cmethod (compute-cmethod applicable types)))
+	  (insert! exp (append types cmethod)) ; entry = types + cmethod
+	  cmethod))))) ; cmethod
diff --git a/oop/goops/internal.scm b/module/oop/goops/internal.scm
index d996805e4..15919d44b 100644
--- a/oop/goops/internal.scm
+++ b/module/oop/goops/internal.scm
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/oop/goops/save.scm b/module/oop/goops/save.scm
index e9c8e00eb..0c7d71a2d 100644
--- a/oop/goops/save.scm
+++ b/module/oop/goops/save.scm
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -110,14 +110,10 @@
 ;;; Readables
 ;;;
 
-(if (or (not (defined? 'readables))
-	(not readables))
-    (define readables (make-weak-key-hash-table 61)))
+(define readables (make-weak-key-hash-table 61))
 
-(define readable
-  (procedure->memoizing-macro
-    (lambda (exp env)
-      `(make-readable ,(cadr exp) ',(copy-tree (cadr exp))))))
+(define-macro (readable exp)
+  `(make-readable ,exp ',(copy-tree exp)))
 
 (define (make-readable obj expr)
   (hashq-set! readables obj expr)
@@ -377,16 +373,14 @@
 	    (class-slots class)
 	    (slot-ref class 'getters-n-setters)))
 
-(define restore
-  (procedure->memoizing-macro
-    (lambda (exp env)
-      "(restore CLASS (SLOT-NAME1 ...) EXP1 ...)"
-      `(let ((o (,%allocate-instance ,(cadr exp) '())))
-	 (for-each (lambda (name val)
-		     (,slot-set! o name val))
-		   ',(caddr exp)
-		   (list ,@(cdddr exp)))
-	 o))))
+(define-macro (restore class slots . exps)
+  "(restore CLASS (SLOT-NAME1 ...) EXP1 ...)"
+  `(let ((o ((@@ (oop goops) %allocate-instance) ,class '())))
+     (for-each (lambda (name val)
+                 (slot-set! o name val))
+               ',slots
+               (list ,@exps))
+     o))
 
 (define-method (enumerate! (o <object>) env)
   (get-set-for-each (lambda (get set)
@@ -621,13 +615,11 @@
 
 ;;; write-component OBJECT PATCHER FILE ENV
 ;;;
-(define write-component
-  (procedure->memoizing-macro
-    (lambda (exp env)
-      `(or (write-component-procedure ,(cadr exp) ,@(cdddr exp))
-	   (begin
-	     (display #f ,(cadddr exp))
-	     (add-patcher! ,(caddr exp) env))))))
+(define-macro (write-component object patcher file env)
+  `(or (write-component-procedure ,object ,file ,env)
+       (begin
+         (display #f ,file)
+         (add-patcher! ,patcher ,env))))
 
 ;;;
 ;;; Main engine
diff --git a/oop/goops/simple.scm b/module/oop/goops/simple.scm
index 48e76f312..bc5405a8d 100644
--- a/oop/goops/simple.scm
+++ b/module/oop/goops/simple.scm
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -23,6 +23,9 @@
   :export (define-class)
   :no-backtrace)
 
-(define define-class define-class-with-accessors-keywords)
+(define-syntax define-class
+  (syntax-rules ()
+    ((_ arg ...)
+     (define-class-with-accessors-keywords arg ...))))
 
 (module-use! %module-public-interface (resolve-interface '(oop goops)))
diff --git a/oop/goops/stklos.scm b/module/oop/goops/stklos.scm
index 60ab293c3..835969f13 100644
--- a/oop/goops/stklos.scm
+++ b/module/oop/goops/stklos.scm
@@ -3,7 +3,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -47,51 +47,30 @@
 ;;; Enable keyword support (*fixme*---currently this has global effect)
 (read-set! keywords 'prefix)
 
-(define standard-define-class-transformer
-  (macro-transformer standard-define-class))
+(define-syntax define-class
+  (syntax-rules ()
+    ((_ name supers (slot ...) rest ...)
+     (standard-define-class name supers slot ... rest ...))))
 
-(define define-class
-  ;; Syntax
-  (let ((name cadr)
-	(supers caddr)
-	(slots cadddr)
-	(rest cddddr))
-    (procedure->memoizing-macro
-      (lambda (exp env)
-	(standard-define-class-transformer
-	 `(define-class ,(name exp) ,(supers exp) ,@(slots exp)
-	    ,@(rest exp))
-	 env)))))
+(define (toplevel-define! name val)
+  (module-define! (current-module) name val))
 
-(define define-method
-  (procedure->memoizing-macro
-    (lambda (exp env)
-      (let ((name (cadr exp)))
-	(if (and (pair? name)
-		 (eq? (car name) 'setter)
-		 (pair? (cdr name))
-		 (null? (cddr name)))
-	    (let ((name (cadr name)))
-	      (cond ((not (symbol? name))
-		     (goops-error "bad method name: ~S" name))
-		    ((defined? name env)
-		     `(begin
-			(if (not (is-a? ,name <generic-with-setter>))
-			    (define-accessor ,name))
-			(add-method! (setter ,name) (method ,@(cddr exp)))))
-		    (else
-		     `(begin
-			(define-accessor ,name)
-			(add-method! (setter ,name) (method ,@(cddr exp)))))))
-	    (cond ((not (symbol? name))
-		   (goops-error "bad method name: ~S" name))
-		  ((defined? name env)
-		   `(begin
-		      (if (not (or (is-a? ,name <generic>)
-				   (is-a? ,name <primitive-generic>)))
-			  (define-generic ,name))
-		      (add-method! ,name (method ,@(cddr exp)))))
-		  (else
-		   `(begin
-		      (define-generic ,name)
-		      (add-method! ,name (method ,@(cddr exp)))))))))))
+(define-syntax define-method
+  (syntax-rules (setter)
+    ((_ (setter name) rest ...)
+     (begin
+       (if (or (not (defined? 'name))
+               (not (is-a? name <generic-with-setter>)))
+           (toplevel-define! 'name
+                             (ensure-accessor
+                              (if (defined? 'name) name #f) 'name)))
+       (add-method! (setter name) (method rest ...))))
+    ((_ name rest ...)
+     (begin
+       (if (or (not (defined? 'name))
+               (not (or (is-a? name <generic>)
+                        (is-a? name <primitive-generic>))))
+           (toplevel-define! 'name
+                             (ensure-generic
+                              (if (defined? 'name) name #f) 'name)))
+       (add-method! name (method rest ...))))))
diff --git a/oop/goops/util.scm b/module/oop/goops/util.scm
index b6276aa37..69bb898bf 100644
--- a/oop/goops/util.scm
+++ b/module/oop/goops/util.scm
@@ -3,7 +3,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/module/rnrs/bytevector.scm b/module/rnrs/bytevector.scm
new file mode 100644
index 000000000..32929c698
--- /dev/null
+++ b/module/rnrs/bytevector.scm
@@ -0,0 +1,85 @@
+;;;; bytevector.scm --- R6RS bytevector API
+
+;;;;	Copyright (C) 2009 Free Software Foundation, Inc.
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Author: Ludovic Court�s <ludo@gnu.org>
+
+;;; Commentary:
+;;;
+;;; A "bytevector" is a raw bit string.  This module provides procedures to
+;;; manipulate bytevectors and interpret their contents in a number of ways:
+;;; bytevector contents can be accessed as signed or unsigned integer of
+;;; various sizes and endianness, as IEEE-754 floating point numbers, or as
+;;; strings.  It is a useful tool to decode binary data.
+;;;
+;;; Code:
+
+(define-module (rnrs bytevector)
+  :export-syntax (endianness)
+  :export (native-endianness bytevector?
+           make-bytevector bytevector-length bytevector=? bytevector-fill!
+           bytevector-copy! bytevector-copy
+           uniform-array->bytevector
+           bytevector-u8-ref bytevector-s8-ref
+           bytevector-u8-set! bytevector-s8-set! bytevector->u8-list
+           u8-list->bytevector
+           bytevector-uint-ref bytevector-uint-set!
+           bytevector-sint-ref bytevector-sint-set!
+           bytevector->sint-list bytevector->uint-list
+           uint-list->bytevector sint-list->bytevector
+
+           bytevector-u16-ref bytevector-s16-ref
+           bytevector-u16-set! bytevector-s16-set!
+           bytevector-u16-native-ref bytevector-s16-native-ref
+           bytevector-u16-native-set! bytevector-s16-native-set!
+
+           bytevector-u32-ref bytevector-s32-ref
+           bytevector-u32-set! bytevector-s32-set!
+           bytevector-u32-native-ref bytevector-s32-native-ref
+           bytevector-u32-native-set! bytevector-s32-native-set!
+
+           bytevector-u64-ref bytevector-s64-ref
+           bytevector-u64-set! bytevector-s64-set!
+           bytevector-u64-native-ref bytevector-s64-native-ref
+           bytevector-u64-native-set! bytevector-s64-native-set!
+
+           bytevector-ieee-single-ref
+           bytevector-ieee-single-set!
+           bytevector-ieee-single-native-ref
+           bytevector-ieee-single-native-set!
+
+           bytevector-ieee-double-ref
+           bytevector-ieee-double-set!
+           bytevector-ieee-double-native-ref
+           bytevector-ieee-double-native-set!
+
+           string->utf8 string->utf16 string->utf32
+           utf8->string utf16->string utf32->string))
+
+
+(load-extension "libguile" "scm_init_bytevectors")
+
+(define-macro (endianness sym)
+  (if (memq sym '(big little))
+      `(quote ,sym)
+      (error "unsupported endianness" sym)))
+
+;;; Local Variables:
+;;; coding: latin-1
+;;; End:
+
+;;; bytevector.scm ends here
diff --git a/module/rnrs/io/ports.scm b/module/rnrs/io/ports.scm
new file mode 100644
index 000000000..d1b96b31a
--- /dev/null
+++ b/module/rnrs/io/ports.scm
@@ -0,0 +1,111 @@
+;;;; ports.scm --- R6RS port API
+
+;;;;	Copyright (C) 2009 Free Software Foundation, Inc.
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Author: Ludovic Court�s <ludo@gnu.org>
+
+;;; Commentary:
+;;;
+;;; The I/O port API of the R6RS is provided by this module.  In many areas
+;;; it complements or refines Guile's own historical port API.  For instance,
+;;; it allows for binary I/O with bytevectors.
+;;;
+;;; Code:
+
+(define-module (rnrs io ports)
+  :re-export (eof-object? port? input-port? output-port?)
+  :export (eof-object
+
+           ;; input & output ports
+           port-transcoder binary-port? transcoded-port
+           port-position set-port-position!
+           port-has-port-position? port-has-set-port-position!?
+           call-with-port
+
+           ;; input ports
+           open-bytevector-input-port
+           make-custom-binary-input-port
+
+           ;; binary input
+           get-u8 lookahead-u8
+           get-bytevector-n get-bytevector-n!
+           get-bytevector-some get-bytevector-all
+
+           ;; output ports
+           open-bytevector-output-port
+           make-custom-binary-output-port
+
+           ;; binary output
+           put-u8 put-bytevector))
+
+(load-extension "libguile" "scm_init_r6rs_ports")
+
+
+
+;;;
+;;; Input and output ports.
+;;;
+
+(define (port-transcoder port)
+  (error "port transcoders are not supported" port))
+
+(define (binary-port? port)
+  ;; So far, we don't support transcoders other than the binary transcoder.
+  #t)
+
+(define (transcoded-port port)
+  (error "port transcoders are not supported" port))
+
+(define (port-position port)
+  "Return the offset (an integer) indicating where the next octet will be
+read from/written to in @var{port}."
+
+  ;; FIXME: We should raise an `&assertion' error when not supported.
+  (seek port 0 SEEK_CUR))
+
+(define (set-port-position! port offset)
+  "Set the position where the next octet will be read from/written to
+@var{port}."
+
+  ;; FIXME: We should raise an `&assertion' error when not supported.
+  (seek port offset SEEK_SET))
+
+(define (port-has-port-position? port)
+  "Return @code{#t} is @var{port} supports @code{port-position}."
+  (and (false-if-exception (port-position port)) #t))
+
+(define (port-has-set-port-position!? port)
+  "Return @code{#t} is @var{port} supports @code{set-port-position!}."
+  (and (false-if-exception (set-port-position! port (port-position port)))
+       #t))
+
+(define (call-with-port port proc)
+  "Call @var{proc}, passing it @var{port} and closing @var{port} upon exit of
+@var{proc}.  Return the return values of @var{proc}."
+  (dynamic-wind
+      (lambda ()
+        #t)
+      (lambda ()
+        (proc port))
+      (lambda ()
+        (close-port port))))
+
+;;; Local Variables:
+;;; coding: latin-1
+;;; End:
+
+;;; ports.scm ends here
diff --git a/scripts/ChangeLog-2008 b/module/scripts/ChangeLog-2008
index feef87dfd..feef87dfd 100644
--- a/scripts/ChangeLog-2008
+++ b/module/scripts/ChangeLog-2008
diff --git a/scripts/PROGRAM b/module/scripts/PROGRAM.scm
index e83540851..56e5cf334 100755..100644
--- a/scripts/PROGRAM
+++ b/module/scripts/PROGRAM.scm
@@ -1,26 +1,21 @@
-#!/bin/sh
-# aside from this initial boilerplate, this is actually -*- scheme -*- code
-main='(module-ref (resolve-module '\''(scripts PROGRAM)) '\'main')'
-exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
-!#
 ;;; PROGRAM --- Does something
 
 ;; 	Copyright (C) 2002, 2006 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
+;; modify it under the terms of the GNU Lesser General Public License
+;; as published by the Free Software Foundation; either version 3, 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.
+;; Lesser General Public License for more details.
 ;;
-;; You should have received a copy of the GNU General Public License
-;; along with this software; see the file COPYING.  If not, write to
-;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301 USA
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this software; see the file COPYING.LESSER.  If
+;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;; Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 ;;; Author: J.R.Hacker
 
diff --git a/scripts/README b/module/scripts/README
index 56dd286fb..56dd286fb 100644
--- a/scripts/README
+++ b/module/scripts/README
diff --git a/scripts/api-diff b/module/scripts/api-diff.scm
index 0b41eeaaf..b842b03ff 100755..100644
--- a/scripts/api-diff
+++ b/module/scripts/api-diff.scm
@@ -1,26 +1,21 @@
-#!/bin/sh
-# aside from this initial boilerplate, this is actually -*- scheme -*- code
-main='(module-ref (resolve-module '\''(scripts api-diff)) '\'main')'
-exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
-!#
 ;;; api-diff --- diff guile-api.alist files
 
 ;; 	Copyright (C) 2002, 2006 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
+;; modify it under the terms of the GNU Lesser General Public License
+;; as published by the Free Software Foundation; either version 3, 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.
+;; Lesser General Public License for more details.
 ;;
-;; You should have received a copy of the GNU General Public License
-;; along with this software; see the file COPYING.  If not, write to
-;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301 USA
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this software; see the file COPYING.LESSER.  If
+;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;; Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 ;;; Author: Thien-Thi Nguyen <ttn@gnu.org>
 
diff --git a/scripts/autofrisk b/module/scripts/autofrisk.scm
index 154b635bb..e29ccc992 100755..100644
--- a/scripts/autofrisk
+++ b/module/scripts/autofrisk.scm
@@ -1,26 +1,21 @@
-#!/bin/sh
-# aside from this initial boilerplate, this is actually -*- scheme -*- code
-main='(module-ref (resolve-module '\''(scripts autofrisk)) '\'main')'
-exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
-!#
 ;;; autofrisk --- Generate module checks for use with auto* tools
 
 ;; 	Copyright (C) 2002, 2006 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
+;; modify it under the terms of the GNU Lesser General Public License
+;; as published by the Free Software Foundation; either version 3, 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.
+;; Lesser General Public License for more details.
 ;;
-;; You should have received a copy of the GNU General Public License
-;; along with this software; see the file COPYING.  If not, write to
-;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301 USA
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this software; see the file COPYING.LESSER.  If
+;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;; Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 ;;; Author: Thien-Thi Nguyen <ttn@gnu.org>
 
diff --git a/module/scripts/compile.scm b/module/scripts/compile.scm
new file mode 100644
index 000000000..9b14f2fca
--- /dev/null
+++ b/module/scripts/compile.scm
@@ -0,0 +1,183 @@
+;;; Compile --- Command-line Guile Scheme compiler
+
+;; Copyright 2005,2008,2009 Free Software Foundation, Inc.
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public License
+;; as published by the Free Software Foundation; either version 3, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; Lesser General Public License for more details.
+;;
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this software; see the file COPYING.LESSER.  If
+;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;; Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Author: Ludovic Court�s <ludo@gnu.org>
+;;; Author: Andy Wingo <wingo@pobox.com>
+
+;;; Commentary:
+
+;; Usage: compile [ARGS]
+;;
+;; A command-line interface to the Guile compiler.
+
+;;; Code:
+
+(define-module (scripts compile)
+  #:use-module ((system base compile) #:select (compile-file))
+  #:use-module (system base message)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-13)
+  #:use-module (srfi srfi-37)
+  #:use-module (ice-9 format)
+  #:export (compile))
+
+
+(define (fail . messages)
+  (format (current-error-port)
+	  (string-concatenate `("error: " ,@messages "~%")))
+  (exit 1))
+
+(define %options
+  ;; Specifications of the command-line options.
+  (list (option '(#\h "help") #f #f
+                (lambda (opt name arg result)
+		  (alist-cons 'help? #t result)))
+        (option '("version") #f #f
+                (lambda (opt name arg result)
+                  (show-version)
+                  (exit 0)))
+
+	(option '(#\L "load-path") #t #f
+		(lambda (opt name arg result)
+		  (let ((load-path (assoc-ref result 'load-path)))
+		    (alist-cons 'load-path (cons arg load-path)
+				result))))
+	(option '(#\o "output") #t #f
+		(lambda (opt name arg result)
+		  (if (assoc-ref result 'output-file)
+		      (fail "`-o' option cannot be specified more than once")
+		      (alist-cons 'output-file arg result))))
+
+        (option '(#\W "warn") #t #f
+                (lambda (opt name arg result)
+                  (if (string=? arg "help")
+                      (begin
+                        (show-warning-help)
+                        (exit 0))
+                      (let ((warnings (assoc-ref result 'warnings)))
+                        (alist-cons 'warnings
+                                    (cons (string->symbol arg) warnings)
+                                    (alist-delete 'warnings result))))))
+
+	(option '(#\O "optimize") #f #f
+		(lambda (opt name arg result)
+		  (alist-cons 'optimize? #t result)))
+	(option '(#\f "from") #t #f
+		(lambda (opt name arg result)
+                  (if (assoc-ref result 'from)
+                      (fail "`--from' option cannot be specified more than once")
+                      (alist-cons 'from (string->symbol arg) result))))
+	(option '(#\t "to") #t #f
+		(lambda (opt name arg result)
+                  (if (assoc-ref result 'to)
+                      (fail "`--to' option cannot be specified more than once")
+                      (alist-cons 'to (string->symbol arg) result))))))
+
+(define (parse-args args)
+  "Parse argument list @var{args} and return an alist with all the relevant
+options."
+  (args-fold args %options
+             (lambda (opt name arg result)
+               (format (current-error-port) "~A: unrecognized option" name)
+	       (exit 1))
+             (lambda (file result)
+	       (let ((input-files (assoc-ref result 'input-files)))
+		 (alist-cons 'input-files (cons file input-files)
+			     result)))
+
+	     ;; default option values
+             '((input-files)
+	       (load-path)
+               (warnings unsupported-warning))))
+
+(define (show-version)
+  (format #t "compile (GNU Guile) ~A~%" (version))
+  (format #t "Copyright (C) 2009 Free Software Foundation, Inc.
+License LGPLv3+: GNU LGPL version 3 or later <http://gnu.org/licenses/lgpl.html>.
+This is free software: you are free to change and redistribute it.
+There is NO WARRANTY, to the extent permitted by law.~%"))
+
+(define (show-warning-help)
+  (format #t "The available warning types are:~%~%")
+  (for-each (lambda (wt)
+              (format #t "  ~22A ~A~%"
+                      (format #f "`~A'" (warning-type-name wt))
+                      (warning-type-description wt)))
+            %warning-types)
+  (format #t "~%"))
+
+
+(define (compile . args)
+  (let* ((options         (parse-args args))
+         (help?           (assoc-ref options 'help?))
+         (compile-opts    (let ((o `(#:warnings
+                                     ,(assoc-ref options 'warnings))))
+                            (if (assoc-ref options 'optimize?)
+                                (cons #:O o)
+                                o)))
+         (from            (or (assoc-ref options 'from) 'scheme))
+         (to              (or (assoc-ref options 'to) 'objcode))
+	 (input-files     (assoc-ref options 'input-files))
+	 (output-file     (assoc-ref options 'output-file))
+	 (load-path       (assoc-ref options 'load-path)))
+    (if (or help? (null? input-files))
+        (begin
+          (format #t "Usage: compile [OPTION] FILE...
+Compile each Guile source file FILE into a Guile object.
+
+  -h, --help           print this help message
+
+  -L, --load-path=DIR  add DIR to the front of the module load path
+  -o, --output=OFILE   write output to OFILE
+
+  -W, --warn=WARNING   emit warnings of type WARNING; use `--warn=help'
+                       for a list of available warnings
+
+  -f, --from=LANG      specify a source language other than `scheme'
+  -t, --to=LANG        specify a target language other than `objcode'
+
+Note that autocompilation will be turned off.
+
+Report bugs to <~A>.~%"
+                  %guile-bug-report-address)
+          (exit 0)))
+
+    (set! %load-path (append load-path %load-path))
+    (set! %load-should-autocompile #f)
+
+    (if (and output-file
+             (or (null? input-files)
+                 (not (null? (cdr input-files)))))
+        (fail "`-o' option can only be specified "
+              "when compiling a single file"))
+
+    (for-each (lambda (file)
+                (format #t "wrote `~A'\n"
+                        (compile-file file
+                                      #:output-file output-file
+                                      #:from from
+                                      #:to to
+                                      #:opts compile-opts)))
+              input-files)))
+
+(define main compile)
+
+;;; Local Variables:
+;;; coding: latin-1
+;;; End:
diff --git a/module/scripts/disassemble.scm b/module/scripts/disassemble.scm
new file mode 100644
index 000000000..8907f6d08
--- /dev/null
+++ b/module/scripts/disassemble.scm
@@ -0,0 +1,40 @@
+;;; Disassemble --- Disassemble .go files into something human-readable
+
+;; Copyright 2005, 2008, 2009 Free Software Foundation, Inc.
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public License
+;; as published by the Free Software Foundation; either version 3, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; Lesser General Public License for more details.
+;;
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this software; see the file COPYING.LESSER.  If
+;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;; Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Author: Ludovic Courtès <ludo@gnu.org>
+;;; Author: Andy Wingo <wingo@pobox.com>
+
+;;; Commentary:
+
+;; Usage: disassemble [ARGS]
+
+;;; Code:
+
+(define-module (scripts disassemble)
+  #:use-module (system vm objcode)
+  #:use-module ((language assembly disassemble)
+                #:renamer (symbol-prefix-proc 'asm:))
+  #:export (disassemble))
+
+(define (disassemble . files)
+  (for-each (lambda (file)
+              (asm:disassemble (load-objcode file)))
+            files))
+
+(define main disassemble)
diff --git a/scripts/display-commentary b/module/scripts/display-commentary.scm
index a12dae8c7..5bd249ce9 100755..100644
--- a/scripts/display-commentary
+++ b/module/scripts/display-commentary.scm
@@ -1,26 +1,21 @@
-#!/bin/sh
-# aside from this initial boilerplate, this is actually -*- scheme -*- code
-main='(module-ref (resolve-module '\''(scripts display-commentary)) '\'main')'
-exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
-!#
 ;;; display-commentary --- As advertized
 
 ;; 	Copyright (C) 2001, 2006 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
+;; modify it under the terms of the GNU Lesser General Public License
+;; as published by the Free Software Foundation; either version 3, 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.
+;; Lesser General Public License for more details.
 ;;
-;; You should have received a copy of the GNU General Public License
-;; along with this software; see the file COPYING.  If not, write to
-;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301 USA
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this software; see the file COPYING.LESSER.  If
+;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;; Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 ;;; Author: Thien-Thi Nguyen
 
diff --git a/scripts/doc-snarf b/module/scripts/doc-snarf.scm
index 4bc09f57c..b5665b973 100755..100644
--- a/scripts/doc-snarf
+++ b/module/scripts/doc-snarf.scm
@@ -1,26 +1,21 @@
-#!/bin/sh
-# aside from this initial boilerplate, this is actually -*- scheme -*- code
-main='(module-ref (resolve-module '\''(scripts doc-snarf)) '\'main')'
-exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
-!#
 ;;; doc-snarf --- Extract documentation from source files
 
 ;; 	Copyright (C) 2001, 2006 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
+;; modify it under the terms of the GNU Lesser General Public License
+;; as published by the Free Software Foundation; either version 3, 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.
+;; Lesser General Public License for more details.
 ;;
-;; You should have received a copy of the GNU General Public License
-;; along with this software; see the file COPYING.  If not, write to
-;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301 USA
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this software; see the file COPYING.LESSER.  If
+;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;; Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 ;;; Author: Martin Grabmueller
 
diff --git a/scripts/frisk b/module/scripts/frisk.scm
index 609a5e6a9..0cf50d6a8 100755..100644
--- a/scripts/frisk
+++ b/module/scripts/frisk.scm
@@ -1,26 +1,21 @@
-#!/bin/sh
-# aside from this initial boilerplate, this is actually -*- scheme -*- code
-main='(module-ref (resolve-module '\''(scripts frisk)) '\'main')'
-exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
-!#
 ;;; frisk --- Grok the module interfaces of a body of files
 
 ;; 	Copyright (C) 2002, 2006 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
+;; modify it under the terms of the GNU Lesser General Public License
+;; as published by the Free Software Foundation; either version 3, 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.
+;; Lesser General Public License for more details.
 ;;
-;; You should have received a copy of the GNU General Public License
-;; along with this software; see the file COPYING.  If not, write to
-;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301 USA
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this software; see the file COPYING.LESSER.  If
+;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;; Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 ;;; Author: Thien-Thi Nguyen <ttn@gnu.org>
 
diff --git a/scripts/generate-autoload b/module/scripts/generate-autoload.scm
index b08be8357..781931015 100755..100644
--- a/scripts/generate-autoload
+++ b/module/scripts/generate-autoload.scm
@@ -1,26 +1,21 @@
-#!/bin/sh
-# aside from this initial boilerplate, this is actually -*- scheme -*- code
-main='(module-ref (resolve-module '\''(scripts generate-autoload)) '\'main')'
-exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
-!#
 ;;; generate-autoload --- Display define-module form with autoload info
 
 ;; 	Copyright (C) 2001, 2006 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
+;; modify it under the terms of the GNU Lesser General Public License
+;; as published by the Free Software Foundation; either version 3, 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.
+;; Lesser General Public License for more details.
 ;;
-;; You should have received a copy of the GNU General Public License
-;; along with this software; see the file COPYING.  If not, write to
-;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301 USA
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this software; see the file COPYING.LESSER.  If
+;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;; Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 ;;; Author: Thien-Thi Nguyen
 
diff --git a/scripts/lint b/module/scripts/lint.scm
index 354420751..b4a7f530a 100755..100644
--- a/scripts/lint
+++ b/module/scripts/lint.scm
@@ -1,26 +1,21 @@
-#!/bin/sh
-# aside from this initial boilerplate, this is actually -*- scheme -*- code
-main='(module-ref (resolve-module '\''(scripts lint)) '\'main')'
-exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
-!#
 ;;; lint --- Preemptive checks for coding errors in Guile Scheme code
 
 ;; 	Copyright (C) 2002, 2006 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
+;; modify it under the terms of the GNU Lesser General Public License
+;; as published by the Free Software Foundation; either version 3, 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.
+;; Lesser General Public License for more details.
 ;;
-;; You should have received a copy of the GNU General Public License
-;; along with this software; see the file COPYING.  If not, write to
-;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301 USA
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this software; see the file COPYING.LESSER.  If
+;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;; Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 ;;; Author: Neil Jerram
 
diff --git a/scripts/punify b/module/scripts/punify.scm
index 0f6a36114..1627722d3 100755..100644
--- a/scripts/punify
+++ b/module/scripts/punify.scm
@@ -1,26 +1,21 @@
-#!/bin/sh
-# aside from this initial boilerplate, this is actually -*- scheme -*- code
-main='(module-ref (resolve-module '\''(scripts punify)) '\'main')'
-exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
-!#
 ;;; punify --- Display Scheme code w/o unnecessary comments / whitespace
 
 ;; 	Copyright (C) 2001, 2006 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
+;; modify it under the terms of the GNU Lesser General Public License
+;; as published by the Free Software Foundation; either version 3, 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.
+;; Lesser General Public License for more details.
 ;;
-;; You should have received a copy of the GNU General Public License
-;; along with this software; see the file COPYING.  If not, write to
-;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301 USA
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this software; see the file COPYING.LESSER.  If
+;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;; Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 ;;; Author: Thien-Thi Nguyen
 
diff --git a/scripts/read-rfc822 b/module/scripts/read-rfc822.scm
index 0904d61d1..c0a54f28c 100755..100644
--- a/scripts/read-rfc822
+++ b/module/scripts/read-rfc822.scm
@@ -1,26 +1,21 @@
-#!/bin/sh
-# aside from this initial boilerplate, this is actually -*- scheme -*- code
-main='(module-ref (resolve-module '\''(scripts read-rfc822)) '\'main')'
-exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
-!#
 ;;; read-rfc822 --- Validate RFC822 file by displaying it to stdout
 
 ;; 	Copyright (C) 2002, 2004, 2006 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
+;; modify it under the terms of the GNU Lesser General Public License
+;; as published by the Free Software Foundation; either version 3, 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.
+;; Lesser General Public License for more details.
 ;;
-;; You should have received a copy of the GNU General Public License
-;; along with this software; see the file COPYING.  If not, write to
-;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301 USA
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this software; see the file COPYING.LESSER.  If
+;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;; Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 ;;; Author: Thien-Thi Nguyen <ttn@gnu.org>
 
diff --git a/scripts/read-scheme-source b/module/scripts/read-scheme-source.scm
index 05bb1064c..b48a88f9b 100755..100644
--- a/scripts/read-scheme-source
+++ b/module/scripts/read-scheme-source.scm
@@ -1,26 +1,21 @@
-#!/bin/sh
-# aside from this initial boilerplate, this is actually -*- scheme -*- code
-main='(module-ref (resolve-module '\''(scripts read-scheme-source)) '\'main')'
-exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
-!#
 ;;; read-scheme-source --- Read a file, recognizing scheme forms and comments
 
 ;; 	Copyright (C) 2001, 2006 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
+;; modify it under the terms of the GNU Lesser General Public License
+;; as published by the Free Software Foundation; either version 3, 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.
+;; Lesser General Public License for more details.
 ;;
-;; You should have received a copy of the GNU General Public License
-;; along with this software; see the file COPYING.  If not, write to
-;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301 USA
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this software; see the file COPYING.LESSER.  If
+;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;; Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 ;;; Author: Thien-Thi Nguyen
 
diff --git a/scripts/read-text-outline b/module/scripts/read-text-outline.scm
index c85026952..64221fbe1 100755..100644
--- a/scripts/read-text-outline
+++ b/module/scripts/read-text-outline.scm
@@ -1,26 +1,21 @@
-#!/bin/sh
-# aside from this initial boilerplate, this is actually -*- scheme -*- code
-main='(module-ref (resolve-module '\''(scripts read-text-outline)) '\'main')'
-exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
-!#
 ;;; read-text-outline --- Read a text outline and display it as a sexp
 
 ;; 	Copyright (C) 2002, 2006 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
+;; modify it under the terms of the GNU Lesser General Public License
+;; as published by the Free Software Foundation; either version 3, 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.
+;; Lesser General Public License for more details.
 ;;
-;; You should have received a copy of the GNU General Public License
-;; along with this software; see the file COPYING.  If not, write to
-;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301 USA
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this software; see the file COPYING.LESSER.  If
+;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;; Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 ;;; Author: Thien-Thi Nguyen <ttn@gnu.org>
 
diff --git a/scripts/scan-api b/module/scripts/scan-api.scm
index 3ea10dbe6..9236f8742 100755..100644
--- a/scripts/scan-api
+++ b/module/scripts/scan-api.scm
@@ -1,26 +1,21 @@
-#!/bin/sh
-# aside from this initial boilerplate, this is actually -*- scheme -*- code
-main='(module-ref (resolve-module '\''(scripts scan-api)) '\'main')'
-exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
-!#
 ;;; scan-api --- Scan and group interpreter and libguile interface elements
 
 ;; 	Copyright (C) 2002, 2006 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
+;; modify it under the terms of the GNU Lesser General Public License
+;; as published by the Free Software Foundation; either version 3, 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.
+;; Lesser General Public License for more details.
 ;;
-;; You should have received a copy of the GNU General Public License
-;; along with this software; see the file COPYING.  If not, write to
-;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301 USA
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this software; see the file COPYING.LESSER.  If
+;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;; Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 ;;; Author: Thien-Thi Nguyen <ttn@gnu.org>
 
diff --git a/scripts/snarf-check-and-output-texi b/module/scripts/snarf-check-and-output-texi.scm
index ea33e1797..0e7efae47 100755..100644
--- a/scripts/snarf-check-and-output-texi
+++ b/module/scripts/snarf-check-and-output-texi.scm
@@ -1,26 +1,21 @@
-#!/bin/sh
-# aside from this initial boilerplate, this is actually -*- scheme -*- code
-main="(module-ref (resolve-module '(scripts snarf-check-and-output-texi)) 'main)"
-exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
-!#
 ;;; snarf-check-and-output-texi --- called by the doc snarfer.
 
 ;; 	Copyright (C) 2001, 2002, 2006 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
+;; modify it under the terms of the GNU Lesser General Public License
+;; as published by the Free Software Foundation; either version 3, 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.
+;; Lesser General Public License for more details.
 ;;
-;; You should have received a copy of the GNU General Public License
-;; along with this software; see the file COPYING.  If not, write to
-;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301 USA
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this software; see the file COPYING.LESSER.  If
+;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;; Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 ;;; Author: Michael Livshin
 
diff --git a/scripts/snarf-guile-m4-docs b/module/scripts/snarf-guile-m4-docs.scm
index b80f187fe..05c305ebd 100755..100644
--- a/scripts/snarf-guile-m4-docs
+++ b/module/scripts/snarf-guile-m4-docs.scm
@@ -1,26 +1,21 @@
-#!/bin/sh
-# aside from this initial boilerplate, this is actually -*- scheme -*- code
-main='(module-ref (resolve-module '\''(scripts snarf-guile-m4-docs)) '\'main')'
-exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
-!#
 ;;; snarf-guile-m4-docs --- Parse guile.m4 comments for texi documentation
 
 ;; 	Copyright (C) 2002, 2006 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
+;; modify it under the terms of the GNU Lesser General Public License
+;; as published by the Free Software Foundation; either version 3, 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.
+;; Lesser General Public License for more details.
 ;;
-;; You should have received a copy of the GNU General Public License
-;; along with this software; see the file COPYING.  If not, write to
-;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301 USA
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this software; see the file COPYING.LESSER.  If
+;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;; Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 ;;; Author: Thien-Thi Nguyen <ttn@gnu.org>
 
diff --git a/scripts/summarize-guile-TODO b/module/scripts/summarize-guile-TODO.scm
index 79543fe27..a67c92ede 100755..100644
--- a/scripts/summarize-guile-TODO
+++ b/module/scripts/summarize-guile-TODO.scm
@@ -1,26 +1,21 @@
-#!/bin/sh
-# aside from this initial boilerplate, this is actually -*- scheme -*- code
-main='(module-ref (resolve-module '\''(scripts summarize-guile-TODO)) '\'main')'
-exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
-!#
 ;;; summarize-guile-TODO --- Display Guile TODO list in various ways
 
 ;; 	Copyright (C) 2002, 2006 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
+;; modify it under the terms of the GNU Lesser General Public License
+;; as published by the Free Software Foundation; either version 3, 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.
+;; Lesser General Public License for more details.
 ;;
-;; You should have received a copy of the GNU General Public License
-;; along with this software; see the file COPYING.  If not, write to
-;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301 USA
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this software; see the file COPYING.LESSER.  If
+;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;; Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 ;;; Author: Thien-Thi Nguyen <ttn@gnu.org>
 
diff --git a/scripts/use2dot b/module/scripts/use2dot.scm
index 30b4690e0..ab97afbc7 100755..100644
--- a/scripts/use2dot
+++ b/module/scripts/use2dot.scm
@@ -1,26 +1,21 @@
-#!/bin/sh
-# aside from this initial boilerplate, this is actually -*- scheme -*- code
-main='(module-ref (resolve-module '\''(scripts use2dot)) '\'main')'
-exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
-!#
 ;;; use2dot --- Display module dependencies as a DOT specification
 
 ;; 	Copyright (C) 2001, 2006 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
+;; modify it under the terms of the GNU Lesser General Public License
+;; as published by the Free Software Foundation; either version 3, 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.
+;; Lesser General Public License for more details.
 ;;
-;; You should have received a copy of the GNU General Public License
-;; along with this software; see the file COPYING.  If not, write to
-;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301 USA
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this software; see the file COPYING.LESSER.  If
+;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;; Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 ;;; Author: Thien-Thi Nguyen
 
diff --git a/module/srfi/Makefile.am b/module/srfi/Makefile.am
new file mode 100644
index 000000000..7cbac6630
--- /dev/null
+++ b/module/srfi/Makefile.am
@@ -0,0 +1,52 @@
+## Process this file with automake to produce Makefile.in.
+##
+##  	Copyright (C) 2000, 2004, 2006, 2008 Free Software Foundation, Inc.
+##
+##   This file is part of GUILE.
+##   
+##   GUILE is free software; you can redistribute it and/or modify it
+##   under the terms of the GNU Lesser General Public License as
+##   published by the Free Software Foundation; either version 3, or
+##   (at your option) any later version.
+##
+##   GUILE is distributed in the hope that it will be useful, but
+##   WITHOUT ANY WARRANTY; without even the implied warranty of
+##   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+##   GNU Lesser General Public License for more details.
+##
+##   You should have received a copy of the GNU Lesser General Public
+##   License along with GUILE; see the file COPYING.LESSER.  If not,
+##   write to the Free Software Foundation, Inc., 51 Franklin Street,
+##   Fifth Floor, Boston, MA 02110-1301 USA
+
+AUTOMAKE_OPTIONS = gnu
+
+modpath = srfi
+SOURCES = \
+            srfi-1.scm \
+            srfi-2.scm \
+	    srfi-4.scm \
+            srfi-6.scm \
+            srfi-8.scm \
+            srfi-9.scm \
+            srfi-10.scm \
+            srfi-11.scm \
+            srfi-13.scm \
+            srfi-14.scm \
+	    srfi-16.scm \
+            srfi-17.scm \
+            srfi-19.scm \
+            srfi-26.scm \
+            srfi-31.scm \
+            srfi-34.scm \
+	    srfi-35.scm \
+            srfi-37.scm \
+            srfi-39.scm \
+            srfi-60.scm \
+	    srfi-69.scm \
+	    srfi-88.scm
+
+# Will poke this later.
+NOCOMP_SOURCES = srfi-18.scm
+
+include $(top_srcdir)/am/guilec
diff --git a/srfi/srfi-1.scm b/module/srfi/srfi-1.scm
index 7c55d9923..db21122b9 100644
--- a/srfi/srfi-1.scm
+++ b/module/srfi/srfi-1.scm
@@ -5,7 +5,7 @@
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
 ;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
+;; version 3 of the License, or (at your option) any later version.
 ;; 
 ;; This library is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/srfi/srfi-10.scm b/module/srfi/srfi-10.scm
index 8e7181a3b..533d9f769 100644
--- a/srfi/srfi-10.scm
+++ b/module/srfi/srfi-10.scm
@@ -5,7 +5,7 @@
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
 ;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
+;; version 3 of the License, or (at your option) any later version.
 ;; 
 ;; This library is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/module/srfi/srfi-11.scm b/module/srfi/srfi-11.scm
new file mode 100644
index 000000000..22bda21a2
--- /dev/null
+++ b/module/srfi/srfi-11.scm
@@ -0,0 +1,146 @@
+;;; srfi-11.scm --- let-values and let*-values
+
+;; Copyright (C) 2000, 2001, 2002, 2004, 2006, 2009 Free Software Foundation, Inc.
+;;
+;; This library is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public
+;; License as published by the Free Software Foundation; either
+;; version 3 of the License, or (at your option) any later version.
+;; 
+;; This library is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; Lesser General Public License for more details.
+;; 
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Commentary:
+
+;; This module exports two syntax forms: let-values and let*-values.
+;;
+;; Sample usage:
+;;
+;;   (let-values (((x y . z) (foo a b))
+;;                ((p q) (bar c)))
+;;     (baz x y z p q))
+;;
+;; This binds `x' and `y' to the first to values returned by `foo',
+;; `z' to the rest of the values from `foo', and `p' and `q' to the
+;; values returned by `bar'.  All of these are available to `baz'.
+;;
+;; let*-values : let-values :: let* : let
+;;
+;; This module is fully documented in the Guile Reference Manual.
+
+;;; Code:
+
+(define-module (srfi srfi-11)
+  :export-syntax (let-values let*-values))
+
+(cond-expand-provide (current-module) '(srfi-11))
+
+;;;;;;;;;;;;;;
+;; let-values
+;;
+;; Current approach is to translate
+;;
+;;   (let-values (((x y . z) (foo a b))
+;;                ((p q) (bar c)))
+;;     (baz x y z p q))
+;;
+;; into
+;;
+;;   (call-with-values (lambda () (foo a b))
+;;     (lambda (<tmp-x> <tmp-y> . <tmp-z>)
+;;       (call-with-values (lambda () (bar c))
+;;         (lambda (<tmp-p> <tmp-q>)
+;;           (let ((x <tmp-x>)
+;;                 (y <tmp-y>)
+;;                 (z <tmp-z>)
+;;                 (p <tmp-p>)
+;;                 (q <tmp-q>))
+;;             (baz x y z p q))))))
+
+;; We could really use quasisyntax here...
+(define-syntax let-values
+  (lambda (x)
+    (syntax-case x ()
+      ((_ ((binds exp)) b0 b1 ...)
+       (syntax (call-with-values (lambda () exp)
+                 (lambda binds b0 b1 ...))))
+      ((_ (clause ...) b0 b1 ...)
+       (let lp ((clauses (syntax (clause ...)))
+                (ids '())
+                (tmps '()))
+         (if (null? clauses)
+             (with-syntax (((id ...) ids)
+                           ((tmp ...) tmps))
+               (syntax (let ((id tmp) ...)
+                         b0 b1 ...)))
+             (syntax-case (car clauses) ()
+               (((var ...) exp)
+                (with-syntax (((new-tmp ...) (generate-temporaries 
+                                              (syntax (var ...))))
+                              ((id ...) ids)
+                              ((tmp ...) tmps))
+                  (with-syntax ((inner (lp (cdr clauses)
+                                           (syntax (var ... id ...))
+                                           (syntax (new-tmp ... tmp ...)))))
+                    (syntax (call-with-values (lambda () exp)
+                              (lambda (new-tmp ...) inner))))))
+               ((vars exp)
+                (with-syntax ((((new-tmp . new-var) ...)
+                               (let lp ((vars (syntax vars)))
+                                 (syntax-case vars ()
+                                   ((id . rest)
+                                    (acons (syntax id)
+                                           (car
+                                            (generate-temporaries (syntax (id))))
+                                           (lp (syntax rest))))
+                                   (id (acons (syntax id)
+                                              (car
+                                               (generate-temporaries (syntax (id))))
+                                              '())))))
+                              ((id ...) ids)
+                              ((tmp ...) tmps))
+                  (with-syntax ((inner (lp (cdr clauses)
+                                           (syntax (new-var ... id ...))
+                                           (syntax (new-tmp ... tmp ...))))
+                                (args (let lp ((tmps (syntax (new-tmp ...))))
+                                        (syntax-case tmps ()
+                                          ((id) (syntax id))
+                                          ((id . rest) (cons (syntax id)
+                                                             (lp (syntax rest))))))))
+                    (syntax (call-with-values (lambda () exp)
+                              (lambda args inner)))))))))))))
+
+;;;;;;;;;;;;;;
+;; let*-values
+;;
+;; Current approach is to translate
+;;
+;;   (let*-values (((x y z) (foo a b))
+;;                ((p q) (bar c)))
+;;     (baz x y z p q))
+;;
+;; into
+;;
+;;   (call-with-values (lambda () (foo a b))
+;;     (lambda (x y z)
+;;       (call-with-values (lambda (bar c))
+;;         (lambda (p q)
+;;           (baz x y z p q)))))
+
+(define-syntax let*-values
+  (syntax-rules ()
+    ((let*-values () body ...)
+     (let () body ...))
+    ((let*-values ((vars-1 binding-1) (vars-2 binding-2) ...) body ...)
+     (call-with-values (lambda () binding-1)
+       (lambda vars-1
+         (let*-values ((vars-2 binding-2) ...)
+           body ...))))))
+
+;;; srfi-11.scm ends here
diff --git a/srfi/srfi-13.scm b/module/srfi/srfi-13.scm
index 1036a0f47..a2d64cba3 100644
--- a/srfi/srfi-13.scm
+++ b/module/srfi/srfi-13.scm
@@ -5,7 +5,7 @@
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
 ;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
+;; version 3 of the License, or (at your option) any later version.
 ;; 
 ;; This library is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/srfi/srfi-14.scm b/module/srfi/srfi-14.scm
index 100b43b8e..ecc21e52e 100644
--- a/srfi/srfi-14.scm
+++ b/module/srfi/srfi-14.scm
@@ -5,7 +5,7 @@
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
 ;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
+;; version 3 of the License, or (at your option) any later version.
 ;; 
 ;; This library is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/srfi/srfi-16.scm b/module/srfi/srfi-16.scm
index 0b213fde7..dc3c70920 100644
--- a/srfi/srfi-16.scm
+++ b/module/srfi/srfi-16.scm
@@ -5,7 +5,7 @@
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
 ;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
+;; version 3 of the License, or (at your option) any later version.
 ;; 
 ;; This library is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/srfi/srfi-17.scm b/module/srfi/srfi-17.scm
index c9cb2abfe..a14c5c33b 100644
--- a/srfi/srfi-17.scm
+++ b/module/srfi/srfi-17.scm
@@ -5,7 +5,7 @@
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
 ;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
+;; version 3 of the License, or (at your option) any later version.
 ;; 
 ;; This library is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/srfi/srfi-18.scm b/module/srfi/srfi-18.scm
index 925ecb304..26acb6300 100644
--- a/srfi/srfi-18.scm
+++ b/module/srfi/srfi-18.scm
@@ -5,7 +5,7 @@
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
 ;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
+;; version 3 of the License, or (at your option) any later version.
 ;; 
 ;; This library is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -151,8 +151,10 @@
                    (hashq-set! thread-exception-handlers ct hl) 
                    (handler obj))
                  (lambda () 
-                   (let ((r (thunk)))
-                     (hashq-set! thread-exception-handlers ct hl) r))))))
+                   (call-with-values thunk
+                     (lambda res
+                       (hashq-set! thread-exception-handlers ct hl)
+                       (apply values res))))))))
 
 (define (current-exception-handler)
   (car (current-handler-stack)))
@@ -249,8 +251,8 @@
 (define (wrap thunk)
   (lambda (continuation)
     (with-exception-handler (lambda (obj)
-			      (apply (current-exception-handler) (list obj))
-			      (apply continuation (list)))
+			      ((current-exception-handler) obj)
+			      (continuation))
 			    thunk)))
 
 ;; A pass-thru to cancel-thread that first installs a handler that throws
diff --git a/srfi/srfi-19.scm b/module/srfi/srfi-19.scm
index 5b78cad70..b91824976 100644
--- a/srfi/srfi-19.scm
+++ b/module/srfi/srfi-19.scm
@@ -5,7 +5,7 @@
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
 ;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
+;; version 3 of the License, or (at your option) any later version.
 ;; 
 ;; This library is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -236,8 +236,7 @@
     (63072000  . 10)))
 
 (define (read-leap-second-table filename)
-  (set! priv:leap-second-table (priv:read-tai-utc-data filename))
-  (values))
+  (set! priv:leap-second-table (priv:read-tai-utc-data filename)))
 
 
 (define (priv:leap-second-delta utc-seconds)
@@ -1131,8 +1130,7 @@
     (if associated (cdr associated) #f)))
 
 (define (priv:date-printer date index format-string str-len port)
-  (if (>= index str-len)
-      (values)
+  (if (< index str-len)
       (let ((current-char (string-ref format-string index)))
         (if (not (char=? current-char #\~))
             (begin
@@ -1340,9 +1338,9 @@
 ;; for input,
 ;; 3. a port reader procedure that knows how to read the current port
 ;; for a value. Its one parameter is the port.
-;; 4. a action procedure, that takes the value (from 3.) and some
-;; object (here, always the date) and (probably) side-effects it.
-;; In some cases (e.g., ~A) the action is to do nothing
+;; 4. an optional action procedure, that takes the value (from 3.) and
+;; some object (here, always the date) and (probably) side-effects it.
+;; If no action is required, as with ~A, this element may be #f.
 
 (define priv:read-directives
   (let ((ireader4 (priv:make-integer-reader 4))
@@ -1358,13 +1356,12 @@
                                      priv:locale-abbr-month->index))
         (locale-reader-long-month   (priv:make-locale-reader
                                      priv:locale-long-month->index))
-        (char-fail (lambda (ch) #t))
-        (do-nothing (lambda (val object) (values))))
+        (char-fail (lambda (ch) #t)))
 
     (list
-     (list #\~ char-fail (priv:make-char-id-reader #\~) do-nothing)
-     (list #\a char-alphabetic? locale-reader-abbr-weekday do-nothing)
-     (list #\A char-alphabetic? locale-reader-long-weekday do-nothing)
+     (list #\~ char-fail (priv:make-char-id-reader #\~) #f)
+     (list #\a char-alphabetic? locale-reader-abbr-weekday #f)
+     (list #\A char-alphabetic? locale-reader-long-weekday #f)
      (list #\b char-alphabetic? locale-reader-abbr-month
            (lambda (val object)
              (set-date-month! object val)))
@@ -1410,9 +1407,7 @@
           (priv:time-error 'string->date 'bad-date-format-string template-string)
           (if (not (skipper ch))
               (begin (read-char port) (skip-until port skipper))))))
-  (if (>= index str-len)
-      (begin
-        (values))
+  (if (< index str-len)
       (let ((current-char (string-ref format-string index)))
         (if (not (char=? current-char #\~))
             (let ((port-char (read-char port)))
@@ -1445,7 +1440,7 @@
                                 (priv:time-error 'string->date
                                                  'bad-date-format-string
                                                  template-string)
-                                (actor val date)))
+                                (if actor (actor val date))))
                           (priv:string->date date
                                              (+ index 2)
                                              format-string
diff --git a/srfi/srfi-2.scm b/module/srfi/srfi-2.scm
index 0dfe38305..c09323fbb 100644
--- a/srfi/srfi-2.scm
+++ b/module/srfi/srfi-2.scm
@@ -5,7 +5,7 @@
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
 ;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
+;; version 3 of the License, or (at your option) any later version.
 ;; 
 ;; This library is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/srfi/srfi-26.scm b/module/srfi/srfi-26.scm
index 410d2e2f8..324a5dc37 100644
--- a/srfi/srfi-26.scm
+++ b/module/srfi/srfi-26.scm
@@ -5,7 +5,7 @@
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
 ;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
+;; version 3 of the License, or (at your option) any later version.
 ;; 
 ;; This library is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/srfi/srfi-31.scm b/module/srfi/srfi-31.scm
index 54c2f9fd4..4238dc269 100644
--- a/srfi/srfi-31.scm
+++ b/module/srfi/srfi-31.scm
@@ -5,7 +5,7 @@
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
 ;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
+;; version 3 of the License, or (at your option) any later version.
 ;; 
 ;; This library is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/srfi/srfi-34.scm b/module/srfi/srfi-34.scm
index 18a2fda1c..7fb9d1dd6 100644
--- a/srfi/srfi-34.scm
+++ b/module/srfi/srfi-34.scm
@@ -5,7 +5,7 @@
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
 ;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
+;; version 3 of the License, or (at your option) any later version.
 ;; 
 ;; This library is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/srfi/srfi-35.scm b/module/srfi/srfi-35.scm
index 203546625..873b08b13 100644
--- a/srfi/srfi-35.scm
+++ b/module/srfi/srfi-35.scm
@@ -1,11 +1,11 @@
 ;;; srfi-35.scm --- Conditions
 
-;; Copyright (C) 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc.
 ;;
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
 ;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
+;; version 3 of the License, or (at your option) any later version.
 ;;
 ;; This library is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -28,6 +28,7 @@
 
 (define-module (srfi srfi-35)
   #:use-module (srfi srfi-1)
+  #:use-module (ice-9 syncase)
   #:export (make-condition-type condition-type?
             make-condition condition? condition-has-type? condition-ref
             make-compound-condition extract-condition
@@ -274,37 +275,39 @@ by C."
 ;;; Syntax.
 ;;;
 
-(define-macro (define-condition-type name parent pred . field-specs)
-  `(begin
-     (define ,name
-       (make-condition-type ',name ,parent
-			    ',(map car field-specs)))
-     (define (,pred c)
-       (condition-has-type? c ,name))
-     ,@(map (lambda (field-spec)
-	      (let ((field-name (car field-spec))
-		    (accessor   (cadr field-spec)))
-		`(define (,accessor c)
-		   (condition-ref c ',field-name))))
-	    field-specs)))
-
-(define-macro (condition . type-field-bindings)
-  (cond ((null? type-field-bindings)
-	 (error "`condition' syntax error" type-field-bindings))
-	(else
-	 ;; the poor man's hygienic macro
-	 (let ((mc   (gensym "mc"))
-	       (mcct (gensym "mcct")))
-	   `(let ((,mc   (@  (srfi srfi-35) make-condition))
-		  (,mcct (@@ (srfi srfi-35) make-compound-condition-type)))
-	      (,mc (,mcct 'compound (list ,@(map car type-field-bindings)))
-		   ,@(append-map (lambda (type-field-binding)
-				   (append-map (lambda (field+value)
-						 (let ((f (car field+value))
-						       (v (cadr field+value)))
-						   `(',f ,v)))
-					       (cdr type-field-binding)))
-				 type-field-bindings)))))))
+(define-syntax define-condition-type
+  (syntax-rules ()
+    ((_ name parent pred (field-name field-accessor) ...)
+     (begin
+       (define name
+         (make-condition-type 'name parent '(field-name ...)))
+       (define (pred c)
+         (condition-has-type? c name))
+       (define (field-accessor c)
+         (condition-ref c 'field-name))
+       ...))))
+
+(define-syntax compound-condition
+  ;; Create a compound condition using `make-compound-condition-type'.
+  (syntax-rules ()
+    ((_ (type ...) (field ...))
+     (condition ((make-compound-condition-type '%compound `(,type ...))
+                 field ...)))))
+
+(define-syntax condition-instantiation
+  ;; Build the `(make-condition type ...)' call.
+  (syntax-rules ()
+    ((_ type (out ...))
+     (make-condition type out ...))
+    ((_ type (out ...) (field-name field-value) rest ...)
+     (condition-instantiation type (out ... 'field-name field-value) rest ...))))
+
+(define-syntax condition
+  (syntax-rules ()
+    ((_ (type field ...))
+     (condition-instantiation type () field ...))
+    ((_ (type field ...) ...)
+     (compound-condition (type ...) (field ... ...)))))
 
 
 ;;;
diff --git a/srfi/srfi-37.scm b/module/srfi/srfi-37.scm
index 5e6d512a2..565b44cb9 100644
--- a/srfi/srfi-37.scm
+++ b/module/srfi/srfi-37.scm
@@ -5,7 +5,7 @@
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
 ;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
+;; version 3 of the License, or (at your option) any later version.
 ;;
 ;; This library is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/srfi/srfi-39.scm b/module/srfi/srfi-39.scm
index 086751170..61e67b820 100644
--- a/srfi/srfi-39.scm
+++ b/module/srfi/srfi-39.scm
@@ -5,7 +5,7 @@
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
 ;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
+;; version 3 of the License, or (at your option) any later version.
 ;;
 ;; This library is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -35,7 +35,6 @@
 ;;; Code:
 
 (define-module (srfi srfi-39)
-  #:use-module (ice-9 syncase)
   #:use-module (srfi srfi-16)
 
   #:export (make-parameter)
diff --git a/srfi/srfi-4.scm b/module/srfi/srfi-4.scm
index f30e83952..b133f2106 100644
--- a/srfi/srfi-4.scm
+++ b/module/srfi/srfi-4.scm
@@ -5,7 +5,7 @@
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
 ;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
+;; version 3 of the License, or (at your option) any later version.
 ;; 
 ;; This library is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/module/srfi/srfi-4/gnu.scm b/module/srfi/srfi-4/gnu.scm
new file mode 100644
index 000000000..d3f73b3e9
--- /dev/null
+++ b/module/srfi/srfi-4/gnu.scm
@@ -0,0 +1,52 @@
+;;; Extensions to SRFI-4
+
+;; 	Copyright (C) 2001, 2002, 2004, 2006, 2009 Free Software Foundation, Inc.
+;;
+;; This library is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public
+;; License as published by the Free Software Foundation; either
+;; version 3 of the License, or (at your option) any later version.
+;; 
+;; This library is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; Lesser General Public License for more details.
+;; 
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Commentary:
+
+;; Extensions to SRFI-4. Fully documented in the Guile Reference Manual.
+
+;;; Code:
+
+(define-module (srfi srfi-4 gnu)
+  #:use-module (srfi srfi-4)
+  #:export (;; Somewhat polymorphic conversions.
+            any->u8vector any->s8vector any->u16vector any->s16vector
+            any->u32vector any->s32vector any->u64vector any->s64vector
+            any->f32vector any->f64vector any->c32vector any->c64vector))
+
+
+(define-macro (define-any->vector . tags)
+  `(begin
+     ,@(map (lambda (tag)
+              `(define (,(symbol-append 'any-> tag 'vector) obj)
+                 (cond ((,(symbol-append tag 'vector?) obj) obj)
+                       ((pair? obj) (,(symbol-append 'list-> tag 'vector) obj))
+                       ((generalized-vector? obj)
+                        (let* ((len (generalized-vector-length obj))
+                               (v (,(symbol-append 'make- tag 'vector) len)))
+                          (let lp ((i 0))
+                            (if (< i len)
+                                (begin
+                                  (,(symbol-append tag 'vector-set!)
+                                   v i (generalized-vector-ref obj i))
+                                  (lp (1+ i)))
+                                v))))
+                       (else (scm-error 'wrong-type-arg #f "" '() (list obj))))))
+            tags)))
+
+(define-any->vector u8 s8 u16 s16 u32 s32 u64 s64 f32 f64 c32 c64)
diff --git a/srfi/srfi-6.scm b/module/srfi/srfi-6.scm
index 1e455bb5c..098b586cc 100644
--- a/srfi/srfi-6.scm
+++ b/module/srfi/srfi-6.scm
@@ -5,7 +5,7 @@
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
 ;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
+;; version 3 of the License, or (at your option) any later version.
 ;; 
 ;; This library is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/srfi/srfi-60.scm b/module/srfi/srfi-60.scm
index 177f97681..c9eb60f8b 100644
--- a/srfi/srfi-60.scm
+++ b/module/srfi/srfi-60.scm
@@ -5,7 +5,7 @@
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
 ;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
+;; version 3 of the License, or (at your option) any later version.
 ;; 
 ;; This library is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/srfi/srfi-69.scm b/module/srfi/srfi-69.scm
index 7da560b1b..0d835d09b 100644
--- a/srfi/srfi-69.scm
+++ b/module/srfi/srfi-69.scm
@@ -5,7 +5,7 @@
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
 ;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
+;; version 3 of the License, or (at your option) any later version.
 ;; 
 ;; This library is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -90,6 +90,28 @@
 
 (cond-expand-provide (current-module) '(srfi-37))
 
+;;;; Internal helper macros
+
+;; Define these first, so the compiler will pick them up.
+
+;; I am a macro only for efficiency, to avoid varargs/apply.
+(define-macro (hashx-invoke hashx-proc ht-var . args)
+  "Invoke HASHX-PROC, a `hashx-*' procedure taking a hash-function,
+assoc-function, and the hash-table as first args."
+  `(,hashx-proc (hash-table-hash-function ,ht-var)
+		(ht-associator ,ht-var)
+		(ht-real-table ,ht-var)
+		. ,args))
+
+(define-macro (with-hashx-values bindings ht-var . body-forms)
+  "Bind BINDINGS to the hash-function, associator, and real-table of
+HT-VAR, while evaluating BODY-FORMS."
+  `(let ((,(first bindings) (hash-table-hash-function ,ht-var))
+	 (,(second bindings) (ht-associator ,ht-var))
+	 (,(third bindings) (ht-real-table ,ht-var)))
+     . ,body-forms))
+
+
 ;;;; Hashing
 
 ;;; The largest fixnum is in `most-positive-fixnum' in module (guile),
@@ -198,23 +220,6 @@ manual for specifics, of which there are many."
 ;; possible collision with *unspecified*.
 (define ht-unspecified (cons *unspecified* "ht-value"))
 
-;; I am a macro only for efficiency, to avoid varargs/apply.
-(define-macro (hashx-invoke hashx-proc ht-var . args)
-  "Invoke HASHX-PROC, a `hashx-*' procedure taking a hash-function,
-assoc-function, and the hash-table as first args."
-  `(,hashx-proc (hash-table-hash-function ,ht-var)
-		(ht-associator ,ht-var)
-		(ht-real-table ,ht-var)
-		. ,args))
-
-(define-macro (with-hashx-values bindings ht-var . body-forms)
-  "Bind BINDINGS to the hash-function, associator, and real-table of
-HT-VAR, while evaluating BODY-FORMS."
-  `(let ((,(first bindings) (hash-table-hash-function ,ht-var))
-	 (,(second bindings) (ht-associator ,ht-var))
-	 (,(third bindings) (ht-real-table ,ht-var)))
-     . ,body-forms))
-
 (define (hash-table-ref ht key . default-thunk-lst)
   "Lookup KEY in HT and answer the value, invoke DEFAULT-THUNK if KEY
 isn't present, or signal an error if DEFAULT-THUNK isn't provided."
@@ -295,7 +300,9 @@ for tables where #:weak was #f or not specified at creation time."
 
 (define (hash-table-walk ht proc)
   "Call PROC with each key and value as two arguments."
-  (hash-table-fold ht (lambda (k v unspec) (proc k v) unspec)
+  (hash-table-fold ht (lambda (k v unspec)
+                        (call-with-values (lambda () (proc k v))
+                          (lambda vals unspec)))
 		   *unspecified*))
 
 (define (hash-table-fold ht f knil)
diff --git a/srfi/srfi-8.scm b/module/srfi/srfi-8.scm
index c15cbe9c0..ced123894 100644
--- a/srfi/srfi-8.scm
+++ b/module/srfi/srfi-8.scm
@@ -5,7 +5,7 @@
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
 ;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
+;; version 3 of the License, or (at your option) any later version.
 ;; 
 ;; This library is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/srfi/srfi-88.scm b/module/srfi/srfi-88.scm
index ebde81d0b..0fec19ee1 100644
--- a/srfi/srfi-88.scm
+++ b/module/srfi/srfi-88.scm
@@ -5,7 +5,7 @@
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
 ;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
+;; version 3 of the License, or (at your option) any later version.
 ;;
 ;; This library is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/srfi/srfi-9.scm b/module/srfi/srfi-9.scm
index 59d23bf53..c64be5e51 100644
--- a/srfi/srfi-9.scm
+++ b/module/srfi/srfi-9.scm
@@ -5,7 +5,7 @@
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
 ;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
+;; version 3 of the License, or (at your option) any later version.
 ;; 
 ;; This library is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/module/srfi/srfi-98.scm b/module/srfi/srfi-98.scm
new file mode 100644
index 000000000..944f40261
--- /dev/null
+++ b/module/srfi/srfi-98.scm
@@ -0,0 +1,44 @@
+;;; srfi-98.scm --- An interface to access environment variables
+
+;; Copyright (C) 2009 Free Software Foundation, Inc.
+;;
+;; This library is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public
+;; License as published by the Free Software Foundation; either
+;; version 3 of the License, or (at your option) any later version.
+;; 
+;; This library is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; Lesser General Public License for more details.
+;; 
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Author: Julian Graham <julian.graham@aya.yale.edu>
+;;; Date: 2009-05-26
+
+;;; Commentary:
+
+;; This is an implementation of SRFI-98 (An interface to access environment 
+;; variables).
+;;
+;; This module is fully documented in the Guile Reference Manual.
+
+;;; Code:
+
+(define-module (srfi srfi-98)
+  :use-module (srfi srfi-1)
+  :export (get-environment-variable
+	   get-environment-variables))
+
+(cond-expand-provide (current-module) '(srfi-98))
+
+(define get-environment-variable getenv)
+(define (get-environment-variables)
+  (define (string->alist-entry str)
+    (let ((pvt (string-index str #\=))
+	  (len (string-length str)))
+      (and pvt (cons (substring str 0 pvt) (substring str (+ pvt 1) len)))))
+  (filter-map string->alist-entry (environ)))
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
new file mode 100644
index 000000000..26dd29e20
--- /dev/null
+++ b/module/system/base/compile.scm
@@ -0,0 +1,258 @@
+;;; High-level compiler interface
+
+;; Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public
+;;; License as published by the Free Software Foundation; either
+;;; version 3 of the License, or (at your option) any later version.
+;;;
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (system base compile)
+  #:use-module (system base syntax)
+  #:use-module (system base language)
+  #:use-module (system base message)
+  #:use-module (system vm vm) ;; FIXME: there's a reason for this, can't remember why tho
+  #:use-module (ice-9 regex)
+  #:use-module (ice-9 optargs)
+  #:use-module (ice-9 receive)
+  #:export (syntax-error 
+            *current-language*
+            compiled-file-name compile-file compile-and-load
+            compile
+            decompile)
+  #:export-syntax (call-with-compile-error-catch))
+
+;;;
+;;; Compiler environment
+;;;
+
+(define (syntax-error loc msg exp)
+  (throw 'syntax-error-compile-time loc msg exp))
+
+(define-macro (call-with-compile-error-catch thunk)
+  `(catch 'syntax-error-compile-time
+	 ,thunk
+	 (lambda (key loc msg exp)
+	   (if (pair? loc)
+               (let ((file (or (assq-ref loc 'filename) "unknown file"))
+                     (line (assq-ref loc 'line))
+                     (col (assq-ref loc 'column)))
+                 (format (current-error-port)
+                         "~A:~A:~A: ~A: ~A~%" file line col msg exp))
+               (format (current-error-port)
+                       "unknown location: ~A: ~S~%" msg exp)))))
+
+
+;;;
+;;; Compiler
+;;;
+
+(define *current-language* (make-fluid))
+(fluid-set! *current-language* 'scheme)
+(define (current-language)
+  (fluid-ref *current-language*))
+
+(define (call-once thunk)
+  (let ((entered #f))
+    (dynamic-wind
+        (lambda ()
+          (if entered
+              (error "thunk may only be entered once: ~a" thunk))
+          (set! entered #t))
+        thunk
+        (lambda () #t))))
+
+(define* (call-with-output-file/atomic filename proc #:optional reference)
+  (let* ((template (string-append filename ".XXXXXX"))
+         (tmp (mkstemp! template)))
+    (call-once
+     (lambda ()
+       (with-throw-handler #t
+         (lambda ()
+           (proc tmp)
+           (chmod tmp (logand #o0666 (lognot (umask))))
+           (close-port tmp)
+           (if reference
+               (let ((st (stat reference)))
+                 (utime template (stat:atime st) (stat:mtime st))))
+           (rename-file template filename))
+         (lambda args
+           (delete-file template)))))))
+
+(define (ensure-language x)
+  (if (language? x)
+      x
+      (lookup-language x)))
+
+;; Throws an exception if `dir' is not writable. The double-stat is OK,
+;; as this is only used during compilation.
+(define (ensure-writable-dir dir)
+  (if (file-exists? dir)
+      (if (access? dir W_OK)
+          #t
+          (error "directory not writable" dir))
+      (begin
+        (ensure-writable-dir (dirname dir))
+        (mkdir dir))))
+
+(define (dsu-sort list key less)
+  (map cdr
+       (stable-sort (map (lambda (x) (cons (key x) x)) list)
+                    (lambda (x y) (less (car x) (car y))))))
+
+;;; This function is among the trickiest I've ever written. I tried many
+;;; variants. In the end, simple is best, of course.
+;;;
+;;; After turning this around a number of times, it seems that the the
+;;; desired behavior is that .go files should exist in a path, for
+;;; searching. That is orthogonal to this function. For writing .go
+;;; files, either you know where they should go, in which case you tell
+;;; compile-file explicitly, as in the srcdir != builddir case; or you
+;;; don't know, in which case this function is called, and we just put
+;;; them in your own ccache dir in ~/.guile-ccache.
+(define (compiled-file-name file)
+  (define (compiled-extension)
+    (cond ((or (null? %load-compiled-extensions)
+               (string-null? (car %load-compiled-extensions)))
+           (warn "invalid %load-compiled-extensions"
+                 %load-compiled-extensions)
+           ".go")
+          (else (car %load-compiled-extensions))))
+  (and %compile-fallback-path
+       (let ((f (string-append
+                 %compile-fallback-path
+                 ;; no need for '/' separator here, canonicalize-path
+                 ;; will give us an absolute path
+                 (canonicalize-path file)
+                 (compiled-extension))))
+         (and (false-if-exception (ensure-writable-dir (dirname f)))
+              f))))
+
+(define* (compile-file file #:key
+                       (output-file #f)
+                       (env #f)
+                       (from (current-language))
+                       (to 'objcode)
+                       (opts '()))
+  (let* ((comp (or output-file (compiled-file-name file)))
+         (in (open-input-file file))
+         (enc (file-encoding in)))
+    (if enc
+        (set-port-encoding! in enc))
+    (ensure-writable-dir (dirname comp))
+    (call-with-output-file/atomic comp
+      (lambda (port)
+        ((language-printer (ensure-language to))
+         (read-and-compile in #:env env #:from from #:to to #:opts opts)
+         port))
+      file)
+    comp))
+
+(define* (compile-and-load file #:key (from 'scheme) (to 'value) (opts '()))
+  (read-and-compile (open-input-file file)
+                    #:from from #:to to #:opts opts))
+
+
+;;;
+;;; Compiler interface
+;;;
+
+(define (compile-passes from to opts)
+  (map cdr
+       (or (lookup-compilation-order from to)
+           (error "no way to compile" from "to" to))))
+
+(define (compile-fold passes exp env opts)
+  (let lp ((passes passes) (x exp) (e env) (cenv env) (first? #t))
+    (if (null? passes)
+        (values x e cenv)
+        (receive (x e new-cenv) ((car passes) x e opts)
+          (lp (cdr passes) x e (if first? new-cenv cenv) #f)))))
+
+(define (find-language-joint from to)
+  (let lp ((in (reverse (or (lookup-compilation-order from to)
+                            (error "no way to compile" from "to" to))))
+           (lang to))
+    (cond ((null? in)
+           (error "don't know how to join expressions" from to))
+          ((language-joiner lang) lang)
+          (else
+           (lp (cdr in) (caar in))))))
+
+(define* (read-and-compile port #:key
+                           (env #f)
+                           (from (current-language))
+                           (to 'objcode)
+                           (opts '()))
+  (let ((from (ensure-language from))
+        (to (ensure-language to)))
+    (let ((joint (find-language-joint from to)))
+      (with-fluids ((*current-language* from))
+        (let lp ((exps '()) (env #f) (cenv env))
+          (let ((x ((language-reader (current-language)) port)))
+            (cond
+             ((eof-object? x)
+              (compile ((language-joiner joint) (reverse exps) env)
+                       #:from joint #:to to #:env env #:opts opts))
+             (else
+              ;; compile-fold instead of compile so we get the env too
+              (receive (jexp jenv jcenv)
+                  (compile-fold (compile-passes (current-language) joint opts)
+                                x cenv opts)
+                (lp (cons jexp exps) jenv jcenv))))))))))
+
+(define* (compile x #:key
+                  (env #f)
+                  (from (current-language))
+                  (to 'value)
+                  (opts '()))
+
+  (let ((warnings (memq #:warnings opts)))
+    (if (pair? warnings)
+        (let ((warnings (cadr warnings)))
+          ;; Sanity-check the requested warnings.
+          (for-each (lambda (w)
+                      (or (lookup-warning-type w)
+                          (warning 'unsupported-warning #f w)))
+                    warnings))))
+
+  (receive (exp env cenv)
+      (compile-fold (compile-passes from to opts) x env opts)
+    exp))
+
+
+;;;
+;;; Decompiler interface
+;;;
+
+(define (decompile-passes from to opts)
+  (map cdr
+       (or (lookup-decompilation-order from to)
+           (error "no way to decompile" from "to" to))))
+
+(define (decompile-fold passes exp env opts)
+  (if (null? passes)
+      (values exp env)
+      (receive (exp env) ((car passes) exp env opts)
+        (decompile-fold (cdr passes) exp env opts))))
+
+(define* (decompile x #:key
+                    (env #f)
+                    (from 'value)
+                    (to 'assembly)
+                    (opts '()))
+  (decompile-fold (decompile-passes from to opts)
+                  x
+                  env
+                  opts))
diff --git a/module/system/base/language.scm b/module/system/base/language.scm
new file mode 100644
index 000000000..3670c53d9
--- /dev/null
+++ b/module/system/base/language.scm
@@ -0,0 +1,99 @@
+;;; Multi-language support
+
+;; Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+
+;; This library is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public
+;; License as published by the Free Software Foundation; either
+;; version 3 of the License, or (at your option) any later version.
+;; 
+;; This library is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; Lesser General Public License for more details.
+;; 
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+;; 02110-1301 USA
+
+;;; Code:
+
+(define-module (system base language)
+  #:use-module (system base syntax)
+  #:export (define-language language? lookup-language make-language
+            language-name language-title language-version language-reader
+            language-printer language-parser 
+            language-compilers language-decompilers language-evaluator
+            language-joiner
+
+            lookup-compilation-order lookup-decompilation-order
+            invalidate-compilation-cache!))
+
+
+;;;
+;;; Language class
+;;;
+
+(define-record/keywords <language>
+  name
+  title
+  version
+  reader
+  printer
+  (parser #f)
+  (compilers '())
+  (decompilers '())
+  (evaluator #f)
+  (joiner #f))
+
+(define-macro (define-language name . spec)
+  `(begin
+     (invalidate-compilation-cache!)
+     (define ,name (make-language #:name ',name ,@spec))))
+
+(define (lookup-language name)
+  (let ((m (resolve-module `(language ,name spec))))
+    (if (module-bound? m name)
+	(module-ref m name)
+	(error "no such language" name))))
+
+(define *compilation-cache* '())
+(define *decompilation-cache* '())
+
+(define (invalidate-compilation-cache!)
+  (set! *decompilation-cache* '())
+  (set! *compilation-cache* '()))
+
+(define (compute-translation-order from to language-translators)
+  (cond
+   ((not (language? to))
+    (compute-translation-order from (lookup-language to) language-translators))
+   (else
+    (let lp ((from from) (seen '()))
+      (cond
+       ((not (language? from))
+        (lp (lookup-language from) seen))
+       ((eq? from to) (reverse! seen))
+       ((memq from seen) #f)
+       (else (or-map (lambda (pair)
+                       (lp (car pair) (acons from (cdr pair) seen)))
+                     (language-translators from))))))))
+
+(define (lookup-compilation-order from to)
+  (let ((key (cons from to)))
+    (or (assoc-ref *compilation-cache* key)
+        (let ((order (compute-translation-order from to language-compilers)))
+          (set! *compilation-cache*
+                (acons key order *compilation-cache*))
+          order))))
+
+(define (lookup-decompilation-order from to)
+  (let ((key (cons from to)))
+    (or (assoc-ref *decompilation-cache* key)
+        ;; trickery!
+        (let ((order (and=>
+                      (compute-translation-order to from language-decompilers)
+                      reverse!)))
+          (set! *decompilation-cache* (acons key order *decompilation-cache*))
+          order))))
diff --git a/module/system/base/message.scm b/module/system/base/message.scm
new file mode 100644
index 000000000..6b68c5639
--- /dev/null
+++ b/module/system/base/message.scm
@@ -0,0 +1,102 @@
+;;; User interface messages
+
+;; Copyright (C) 2009 Free Software Foundation, Inc.
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public
+;;; License as published by the Free Software Foundation; either
+;;; version 3 of the License, or (at your option) any later version.
+;;;
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Commentary:
+;;;
+;;; This module provide a simple interface to send messages to the user.
+;;; TODO: Internationalize messages.
+;;;
+;;; Code:
+
+(define-module (system base message)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:export (*current-warning-port* warning
+
+            warning-type? warning-type-name warning-type-description
+            warning-type-printer lookup-warning-type
+
+            %warning-types))
+
+
+;;;
+;;; Source location
+;;;
+
+(define (location-string loc)
+  (if (pair? loc)
+      (format #f "~a:~a:~a"
+              (or (assoc-ref loc 'filename) "<stdin>")
+              (1+ (assoc-ref loc 'line))
+              (assoc-ref loc 'column))
+      "<unknown-location>"))
+
+
+;;;
+;;; Warnings
+;;;
+
+(define *current-warning-port*
+  ;; The port where warnings are sent.
+  (make-fluid))
+
+(fluid-set! *current-warning-port* (current-error-port))
+
+(define-record-type <warning-type>
+  (make-warning-type name description printer)
+  warning-type?
+  (name         warning-type-name)
+  (description  warning-type-description)
+  (printer      warning-type-printer))
+
+(define %warning-types
+  ;; List of know warning types.
+  (map (lambda (args)
+         (apply make-warning-type args))
+
+       `((unsupported-warning ;; a "meta warning"
+          "warn about unknown warning types"
+          ,(lambda (port unused name)
+             (format port "warning: unknown warning type `~A'~%"
+                     name)))
+
+         (unused-variable
+          "report unused variables"
+          ,(lambda (port loc name)
+             (format port "~A: warning: unused variable `~A'~%"
+                     loc name))))))
+
+(define (lookup-warning-type name)
+  "Return the warning type NAME or `#f' if not found."
+  (find (lambda (wt)
+          (eq? name (warning-type-name wt)))
+        %warning-types))
+
+(define (warning type location . args)
+  "Emit a warning of type TYPE for source location LOCATION (a source
+property alist) using the data in ARGS."
+  (let ((wt   (lookup-warning-type type))
+        (port (fluid-ref *current-warning-port*)))
+    (if (warning-type? wt)
+        (apply (warning-type-printer wt)
+               port (location-string location)
+               args)
+        (format port "~A: unknown warning type `~A': ~A~%"
+                (location-string location) type args))))
+
+;;; message.scm ends here
diff --git a/module/system/base/pmatch.scm b/module/system/base/pmatch.scm
new file mode 100644
index 000000000..4777431e5
--- /dev/null
+++ b/module/system/base/pmatch.scm
@@ -0,0 +1,41 @@
+(define-module (system base pmatch)
+  #:export (pmatch))
+;; FIXME: shouldn't have to export ppat...
+
+;; Originally written by Oleg Kiselyov. Taken from:
+;; αKanren: A Fresh Name in Nominal Logic Programming
+;; by William E. Byrd and Daniel P. Friedman
+;; Proceedings of the 2007 Workshop on Scheme and Functional Programming
+;; Université Laval Technical Report DIUL-RT-0701
+
+;; Licensing unclear. Probably need to ask Oleg for a disclaimer.
+
+(define-syntax pmatch
+  (syntax-rules (else guard)
+    ((_ (op arg ...) cs ...)
+     (let ((v (op arg ...)))
+       (pmatch v cs ...)))
+    ((_ v) (if #f #f))
+    ((_ v (else e0 e ...)) (let () e0 e ...))
+    ((_ v (pat (guard g ...) e0 e ...) cs ...)
+     (let ((fk (lambda () (pmatch v cs ...))))
+       (ppat v pat
+             (if (and g ...) (let () e0 e ...) (fk))
+             (fk))))
+    ((_ v (pat e0 e ...) cs ...)
+     (let ((fk (lambda () (pmatch v cs ...))))
+       (ppat v pat (let () e0 e ...) (fk))))))
+
+(define-syntax ppat
+  (syntax-rules (_ quote unquote)
+    ((_ v _ kt kf) kt)
+    ((_ v () kt kf) (if (null? v) kt kf))
+    ((_ v (quote lit) kt kf)
+     (if (equal? v (quote lit)) kt kf))
+    ((_ v (unquote var) kt kf) (let ((var v)) kt))
+    ((_ v (x . y) kt kf)
+     (if (pair? v)
+         (let ((vx (car v)) (vy (cdr v)))
+           (ppat vx x (ppat vy y kt kf) kf))
+         kf))
+    ((_ v lit kt kf) (if (eq? v (quote lit)) kt kf))))
diff --git a/module/system/base/syntax.scm b/module/system/base/syntax.scm
new file mode 100644
index 000000000..249961d79
--- /dev/null
+++ b/module/system/base/syntax.scm
@@ -0,0 +1,327 @@
+;;; Guile VM specific syntaxes and utilities
+
+;; Copyright (C) 2001, 2009 Free Software Foundation, Inc
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public
+;;; License as published by the Free Software Foundation; either
+;;; version 3 of the License, or (at your option) any later version.
+;;;
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (system base syntax)
+  #:export (%compute-initargs)
+  #:export-syntax (define-type define-record define-record/keywords
+                   record-case transform-record))
+
+(define (symbol-trim-both sym pred)
+  (string->symbol (string-trim-both (symbol->string sym) pred)))
+(define (trim-brackets sym)
+  (symbol-trim-both sym (list->char-set '(#\< #\>))))
+
+
+;;;
+;;; Type
+;;;
+
+(define-macro (define-type name . rest)
+  (let ((name (if (pair? name) (car name) name))
+        (opts (if (pair? name) (cdr name) '())))
+    (let ((printer (kw-arg-ref opts #:printer))
+          (common-slots (or (kw-arg-ref opts #:common-slots) '())))
+      `(begin ,@(map (lambda (def)
+                       `(define-record ,(if printer
+                                            `(,(car def) ,printer)
+                                            (car def))
+                          ,@common-slots
+                          ,@(cdr def)))
+                     rest)
+              ,@(map (lambda (common-slot i)
+                       `(define ,(symbol-append (trim-brackets name)
+                                                '- common-slot)
+                          (make-procedure-with-setter
+                           (lambda (x) (struct-ref x ,i))
+                           (lambda (x v) (struct-set! x ,i v)))))
+                     common-slots (iota (length common-slots)))))))
+
+
+;;;
+;;; Record
+;;;
+
+(define-macro (define-record name-form . slots)
+  (let* ((name (if (pair? name-form) (car name-form) name-form))
+         (printer (and (pair? name-form) (cadr name-form)))
+         (slot-names (map (lambda (slot) (if (pair? slot) (car slot) slot))
+                          slots))
+         (stem (trim-brackets name)))
+    `(begin
+       (define ,name (make-record-type ,(symbol->string name) ',slot-names
+                                       ,@(if printer (list printer) '())))
+       ,(let* ((reqs (let lp ((slots slots))
+                       (if (or (null? slots) (not (symbol? (car slots))))
+                           '()
+                           (cons (car slots) (lp (cdr slots))))))
+               (opts (list-tail slots (length reqs)))
+               (tail (gensym)))
+          `(define (,(symbol-append 'make- stem) ,@reqs . ,tail)
+             (let ,(map (lambda (o)
+                          `(,(car o) (cond ((null? ,tail) ,(cadr o))
+                                           (else (let ((_x (car ,tail)))
+                                                   (set! ,tail (cdr ,tail))
+                                                   _x)))))
+                        opts)
+               (make-struct ,name 0 ,@slot-names))))
+       (define ,(symbol-append stem '?) (record-predicate ,name))
+       ,@(map (lambda (sname)
+                `(define ,(symbol-append stem '- sname)
+                   (make-procedure-with-setter
+                    (record-accessor ,name ',sname)
+                    (record-modifier ,name ',sname))))
+              slot-names))))
+
+;; like the former, but accepting keyword arguments in addition to
+;; optional arguments
+(define-macro (define-record/keywords name-form . slots)
+  (let* ((name (if (pair? name-form) (car name-form) name-form))
+         (printer (and (pair? name-form) (cadr name-form)))
+         (slot-names (map (lambda (slot) (if (pair? slot) (car slot) slot))
+                          slots))
+         (stem (trim-brackets name)))
+    `(begin
+       (define ,name (make-record-type ,(symbol->string name) ',slot-names
+                                       ,@(if printer (list printer) '())))
+       (define ,(symbol-append 'make- stem)
+         (let ((slots (list ,@(map (lambda (slot)
+                                     (if (pair? slot)
+                                         `(cons ',(car slot) ,(cadr slot))
+                                         `',slot))
+                                   slots)))
+               (constructor (record-constructor ,name)))
+           (lambda args
+             (apply constructor (%compute-initargs args slots)))))
+       (define ,(symbol-append stem '?) (record-predicate ,name))
+       ,@(map (lambda (sname)
+                `(define ,(symbol-append stem '- sname)
+                   (make-procedure-with-setter
+                    (record-accessor ,name ',sname)
+                    (record-modifier ,name ',sname))))
+              slot-names))))
+
+(define (%compute-initargs args slots)
+  (define (finish out)
+    (map (lambda (slot)
+           (let ((name (if (pair? slot) (car slot) slot)))
+             (cond ((assq name out) => cdr)
+                   ((pair? slot) (cdr slot))
+                   (else (error "unbound slot" args slots name)))))
+         slots))
+  (let lp ((in args) (positional slots) (out '()))
+    (cond
+     ((null? in)
+      (finish out))
+     ((keyword? (car in))
+      (let ((sym (keyword->symbol (car in))))
+        (cond
+         ((and (not (memq sym slots))
+               (not (assq sym (filter pair? slots))))
+          (error "unknown slot" sym))
+         ((assq sym out) (error "slot already set" sym out))
+         (else (lp (cddr in) '() (acons sym (cadr in) out))))))
+     ((null? positional)
+      (error "too many initargs" args slots))
+     (else
+      (lp (cdr in) (cdr positional)
+          (let ((slot (car positional)))
+            (acons (if (pair? slot) (car slot) slot)
+                   (car in)
+                   out)))))))
+
+;; So, dear reader. It is pleasant indeed around this fire or at this
+;; cafe or in this room, is it not? I think so too.
+;;
+;; This macro used to generate code that looked like this:
+;;
+;;  `(((record-predicate ,record-type) ,r)
+;;    (let ,(map (lambda (slot)
+;;                 (if (pair? slot)
+;;                     `(,(car slot) ((record-accessor ,record-type ',(cadr slot)) ,r))
+;;                     `(,slot ((record-accessor ,record-type ',slot) ,r))))
+;;               slots)
+;;      ,@body)))))
+;;
+;; But this was a hot spot, so computing all those predicates and
+;; accessors all the time was getting expensive, so we did a terrible
+;; thing: we decided that since above we're already defining accessors
+;; and predicates with computed names, we might as well just rely on that fact here.
+;;
+;; It's a bit nasty, I agree. But it is fast.
+;;
+;;scheme@(guile-user)> (with-statprof #:hz 1000 #:full-stacks? #t (resolve-module '(oop goops)))%     cumulative   self             
+;; time   seconds     seconds      name
+;;   8.82      0.03      0.01  glil->assembly
+;;   8.82      0.01      0.01  record-type-fields
+;;   5.88      0.01      0.01  %compute-initargs
+;;   5.88      0.01      0.01  list-index
+
+
+;;; So ugly... but I am too ignorant to know how to make it better.
+(define-syntax record-case
+  (lambda (x)
+    (syntax-case x ()
+      ((_ record clause ...)
+       (let ((r (syntax r))
+             (rtd (syntax rtd)))
+         (define (process-clause tag fields exprs)
+           (let ((infix (trim-brackets (syntax->datum tag))))
+             (with-syntax ((tag tag)
+                           (((f . accessor) ...)
+                            (let lp ((fields fields))
+                              (syntax-case fields ()
+                                (() (syntax ()))
+                                (((v0 f0) f1 ...)
+                                 (acons (syntax v0)
+                                        (datum->syntax x 
+                                                       (symbol-append infix '- (syntax->datum
+                                                                                (syntax f0))))
+                                        (lp (syntax (f1 ...)))))
+                                ((f0 f1 ...)
+                                 (acons (syntax f0)
+                                        (datum->syntax x 
+                                                       (symbol-append infix '- (syntax->datum
+                                                                                (syntax f0))))
+                                        (lp (syntax (f1 ...))))))))
+                           ((e0 e1 ...)
+                            (syntax-case exprs ()
+                              (() (syntax (#t)))
+                              ((e0 e1 ...) (syntax (e0 e1 ...))))))
+               (syntax
+                ((eq? rtd tag)
+                 (let ((f (accessor r))
+                       ...)
+                   e0 e1 ...))))))
+         (with-syntax
+             ((r r)
+              (rtd rtd)
+              ((processed ...)
+               (let lp ((clauses (syntax (clause ...)))
+                        (out '()))
+                 (syntax-case clauses (else)
+                   (()
+                    (reverse! (cons (syntax
+                                     (else (error "unhandled record" r)))
+                                    out)))
+                   (((else e0 e1 ...))
+                    (reverse! (cons (syntax (else e0 e1 ...)) out)))
+                   (((else e0 e1 ...) . rest)
+                    (syntax-violation 'record-case
+                                      "bad else clause placement"
+                                      (syntax x)
+                                      (syntax (else e0 e1 ...))))
+                   ((((<foo> f0 ...) e0 ...) . rest)
+                    (lp (syntax rest)
+                        (cons (process-clause (syntax <foo>)
+                                              (syntax (f0 ...))
+                                              (syntax (e0 ...)))
+                              out)))))))
+           (syntax
+            (let* ((r record)
+                   (rtd (struct-vtable r)))
+              (cond processed ...)))))))))
+
+
+;; Here we take the terrorism to another level. Nasty, but the client
+;; code looks good.
+
+(define-macro (transform-record type-and-common record . clauses)
+  (let ((r (gensym))
+        (rtd (gensym))
+        (type-stem (trim-brackets (car type-and-common))))
+    (define (make-stem s)
+      (symbol-append type-stem '- s))
+    (define (further-predicates x record-stem slots)
+      (define (access slot)
+        `(,(symbol-append (make-stem record-stem) '- slot) ,x))
+      (let lp ((in slots) (out '()))
+        (cond ((null? in) out)
+              ((pair? (car in))
+               (let ((slot (caar in))
+                     (arg (cadar in)))
+                 (cond ((symbol? arg)
+                        (lp (cdr in) out))
+                       ((pair? arg)
+                        (lp (cdr in)
+                            (append (further-predicates (access slot)
+                                                        (car arg)
+                                                        (cdr arg))
+                                    out)))
+                       (else (lp (cdr in) (cons `(eq? ,(access slot) ',arg)
+                                                out))))))
+              (else (lp (cdr in) out)))))
+    (define (let-clauses x record-stem slots)
+      (define (access slot)
+        `(,(symbol-append (make-stem record-stem) '- slot) ,x))
+      (let lp ((in slots) (out '()))
+        (cond ((null? in) out)
+              ((pair? (car in))
+               (let ((slot (caar in))
+                     (arg (cadar in)))
+                 (cond ((symbol? arg)
+                        (lp (cdr in)
+                            (cons `(,arg ,(access slot)) out)))
+                       ((pair? arg)
+                        (lp (cdr in)
+                            (append (let-clauses (access slot)
+                                                 (car arg)
+                                                 (cdr arg))
+                                    out)))
+                       (else
+                        (lp (cdr in) out)))))
+              (else
+               (lp (cdr in)
+                   (cons `(,(car in) ,(access (car in))) out))))))
+    (define (transform-expr x)
+      (cond ((not (pair? x)) x)
+            ((eq? (car x) '->)
+             (if (= (length x) 2)
+                 (let ((form (cadr x)))
+                   `(,(symbol-append 'make- (make-stem (car form)))
+                     ,@(cdr type-and-common)
+                     ,@(map (lambda (y)
+                              (if (and (pair? y) (eq? (car y) 'unquote))
+                                  (transform-expr (cadr y))
+                                  y))
+                            (cdr form))))
+                 (error "bad -> form" x)))
+            (else (cons (car x) (map transform-expr (cdr x))))))
+    (define (process-clause clause)
+      (if (eq? (car clause) 'else)
+          clause
+          (let ((stem (caar clause))
+                (slots (cdar clause))
+                (body (cdr clause)))
+            (let ((record-type (symbol-append '< (make-stem stem) '>)))
+              `((and (eq? ,rtd ,record-type)
+                     ,@(reverse (further-predicates r stem slots)))
+                (let ,(reverse (let-clauses r stem slots))
+                  ,@(if (pair? body)
+                        (map transform-expr body)
+                        '((if #f #f)))))))))
+    `(let* ((,r ,record)
+            (,rtd (struct-vtable ,r))
+            ,@(map (lambda (slot)
+                     `(,slot (,(make-stem slot) ,r)))
+                   (cdr type-and-common)))
+       (cond ,@(let ((clauses (map process-clause clauses)))
+                 (if (assq 'else clauses)
+                     clauses
+                     (append clauses `((else (error "unhandled record" ,r))))))))))
diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
new file mode 100644
index 000000000..a99e1bae9
--- /dev/null
+++ b/module/system/repl/command.scm
@@ -0,0 +1,502 @@
+;;; Repl commands
+
+;; Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+
+;; This library is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public
+;; License as published by the Free Software Foundation; either
+;; version 3 of the License, or (at your option) any later version.
+;; 
+;; This library is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; Lesser General Public License for more details.
+;; 
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+;; 02110-1301 USA
+
+;;; Code:
+
+(define-module (system repl command)
+  #:use-module (system base syntax)
+  #:use-module (system base pmatch)
+  #:use-module (system base compile)
+  #:use-module (system repl common)
+  #:use-module (system vm objcode)
+  #:use-module (system vm program)
+  #:use-module (system vm vm)
+  #:autoload (system base language) (lookup-language language-reader)
+  #:autoload (system vm debug) (vm-debugger vm-backtrace)
+  #:autoload (system vm trace) (vm-trace vm-trace-on vm-trace-off)
+  #:autoload (system vm profile) (vm-profile)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 session)
+  #:use-module (ice-9 documentation)
+  #:use-module (ice-9 and-let-star)
+  #:use-module (ice-9 rdelim)
+  #:export (meta-command))
+
+
+;;;
+;;; Meta command interface
+;;;
+
+(define *command-table*
+  '((help     (help h) (apropos a) (describe d) (option o) (quit q))
+    (module   (module m) (import i) (load l) (binding b))
+    (language (language L))
+    (compile  (compile c) (compile-file cc)
+	      (disassemble x) (disassemble-file xx))
+    (profile  (time t) (profile pr))
+    (debug    (backtrace bt) (debugger db) (trace tr) (step st))
+    (system   (gc) (statistics stat))))
+
+(define (group-name g) (car g))
+(define (group-commands g) (cdr g))
+
+;; Hack, until core can be extended.
+(define procedure-documentation
+  (let ((old-definition procedure-documentation))
+    (lambda (p)
+      (if (program? p)
+          (program-documentation p)
+          (old-definition p)))))
+
+(define *command-module* (current-module))
+(define (command-name c) (car c))
+(define (command-abbrev c) (if (null? (cdr c)) #f (cadr c)))
+(define (command-procedure c) (module-ref *command-module* (command-name c)))
+(define (command-doc c) (procedure-documentation (command-procedure c)))
+
+(define (command-usage c)
+  (let ((doc (command-doc c)))
+    (substring doc 0 (string-index doc #\newline))))
+
+(define (command-summary c)
+  (let* ((doc (command-doc c))
+	 (start (1+ (string-index doc #\newline))))
+    (cond ((string-index doc #\newline start)
+	   => (lambda (end) (substring doc start end)))
+	  (else (substring doc start)))))
+
+(define (lookup-group name)
+  (assq name *command-table*))
+
+(define (lookup-command key)
+  (let loop ((groups *command-table*) (commands '()))
+    (cond ((and (null? groups) (null? commands)) #f)
+	  ((null? commands)
+	   (loop (cdr groups) (cdar groups)))
+	  ((memq key (car commands)) (car commands))
+	  (else (loop groups (cdr commands))))))
+
+(define (display-group group . opts)
+  (format #t "~:(~A~) Commands [abbrev]:~2%" (group-name group))
+  (for-each (lambda (c)
+	      (display-summary (command-usage c)
+			       (command-abbrev c)
+			       (command-summary c)))
+	    (group-commands group))
+  (newline))
+
+(define (display-command command)
+  (display "Usage: ")
+  (display (command-doc command))
+  (newline))
+
+(define (display-summary usage abbrev summary)
+  (let ((abbrev (if abbrev (format #f "[,~A]" abbrev) "")))
+    (format #t " ,~24A ~8@A - ~A\n" usage abbrev summary)))
+
+(define (read-datum repl)
+  (read))
+
+(define read-line
+  (let ((orig-read-line read-line))
+    (lambda (repl)
+      (orig-read-line))))
+
+(define (meta-command repl)
+  (let ((command (read-datum repl)))
+    (if (not (symbol? command))
+        (user-error "Meta-command not a symbol: ~s" command))
+    (let ((c (lookup-command command)))
+      (if c
+          ((command-procedure c) repl)
+          (user-error "Unknown meta command: ~A" command)))))
+
+(define-syntax define-meta-command
+  (syntax-rules ()
+    ((_ (name repl (expression0 ...) . datums) docstring b0 b1 ...)
+     (define (name repl)
+       docstring
+       (let* ((expression0
+               (with-fluid* current-reader
+                            (language-reader (repl-language repl))
+                 (lambda () (repl-reader ""))))
+              ...)
+         (apply (lambda datums b0 b1 ...)
+                (let ((port (open-input-string (read-line repl))))
+                  (let lp ((out '()))
+                    (let ((x (read port)))
+                      (if (eof-object? x)
+                          (reverse out)
+                          (lp (cons x out))))))))))
+    ((_ (name repl . datums) docstring b0 b1 ...)
+     (define-meta-command (name repl () . datums)
+       docstring b0 b1 ...))))
+
+
+
+;;;
+;;; Help commands
+;;;
+
+(define-meta-command (help repl . args)
+  "help 
+help GROUP
+help [-c] COMMAND
+
+Gives help on the meta-commands available at the REPL.
+
+With one argument, tries to look up the argument as a group name, giving
+help on that group if successful. Otherwise tries to look up the
+argument as a command, giving help on the command.
+
+If there is a command whose name is also a group name, use the ,help
+-c COMMAND form to give help on the command instead of the group.
+
+Without any argument, a list of help commands and command groups
+are displayed."
+  (pmatch args
+    (()
+     (display-group (lookup-group 'help))
+     (display "Command Groups:\n\n")
+     (display-summary "help all" #f "List all commands")
+     (for-each (lambda (g)
+		 (let* ((name (symbol->string (group-name g)))
+			(usage (string-append "help " name))
+			(header (string-append "List " name " commands")))
+		   (display-summary usage #f header)))
+	       (cdr *command-table*))
+     (newline)
+     (display "Type `,COMMAND -h' to show documentation of each command.")
+     (newline))
+    ((all)
+     (for-each display-group *command-table*))
+    ((,group) (guard (lookup-group group))
+     (display-group (lookup-group group)))
+    ((,command) (guard (lookup-command command))
+     (display-command (lookup-command command)))
+    ((-c ,command) (guard (lookup-command command))
+     (display-command (lookup-command command)))
+    ((,command)
+     (user-error "Unknown command or group: ~A" command))
+    ((-c ,command)
+     (user-error "Unknown command: ~A" command))
+    (else
+     (user-error "Bad arguments: ~A" args))))
+
+(define guile:apropos apropos)
+(define-meta-command (apropos repl regexp)
+  "apropos REGEXP
+Find bindings/modules/packages."
+  (guile:apropos (->string regexp)))
+
+(define-meta-command (describe repl (form))
+  "describe OBJ
+Show description/documentation."
+  (display (object-documentation (repl-eval repl (repl-parse repl form))))
+  (newline))
+
+(define-meta-command (option repl . args)
+  "option [KEY VALUE]
+List/show/set options."
+  (pmatch args
+    (()
+     (for-each (lambda (key+val)
+		 (format #t "~A\t~A\n" (car key+val) (cdr key+val)))
+	       (repl-options repl)))
+    ((,key)
+     (display (repl-option-ref repl key))
+     (newline))
+    ((,key ,val)
+     (repl-option-set! repl key val)
+     (case key
+       ((trace)
+        (let ((vm (repl-vm repl)))
+          (if val
+              (apply vm-trace-on vm val)
+              (vm-trace-off vm))))))))
+
+(define-meta-command (quit repl)
+  "quit
+Quit this session."
+  (throw 'quit))
+
+
+;;;
+;;; Module commands
+;;;
+
+(define-meta-command (module repl . args)
+  "module [MODULE]
+Change modules / Show current module."
+  (pmatch args
+    (() (puts (module-name (current-module))))
+    ((,mod-name) (guard (list? mod-name))
+     (set-current-module (resolve-module mod-name)))
+    (,mod-name (set-current-module (resolve-module mod-name)))))
+
+(define-meta-command (import repl . args)
+  "import [MODULE ...]
+Import modules / List those imported."
+  (let ()
+    (define (use name)
+      (let ((mod (resolve-interface name)))
+        (if mod
+            (module-use! (current-module) mod)
+            (user-error "No such module: ~A" name))))
+    (if (null? args)
+        (for-each puts (map module-name (module-uses (current-module))))
+        (for-each use args))))
+
+(define-meta-command (load repl file . opts)
+  "load FILE
+Load a file in the current module.
+
+  -f    Load source file (see `compile')"
+  (let* ((file (->string file))
+	 (objcode (if (memq #:f opts)
+		      (apply load-source-file file opts)
+		      (apply load-file file opts))))
+    (vm-load (repl-vm repl) objcode)))
+
+(define-meta-command (binding repl)
+  "binding
+List current bindings."
+  (module-for-each (lambda (k v) (format #t "~23A ~A\n" k v))
+                   (current-module)))
+
+
+;;;
+;;; Language commands
+;;;
+
+(define-meta-command (language repl name)
+  "language LANGUAGE
+Change languages."
+  (set! (repl-language repl) (lookup-language name))
+  (repl-welcome repl))
+
+
+;;;
+;;; Compile commands
+;;;
+
+(define-meta-command (compile repl (form) . opts)
+  "compile FORM
+Generate compiled code.
+
+  -e    Stop after expanding syntax/macro
+  -t    Stop after translating into GHIL
+  -c    Stop after generating GLIL
+
+  -O    Enable optimization
+  -D    Add debug information"
+  (let ((x (apply repl-compile repl (repl-parse repl form) opts)))
+    (cond ((objcode? x) (guile:disassemble x))
+          (else (repl-print repl x)))))
+
+(define guile:compile-file compile-file)
+(define-meta-command (compile-file repl file . opts)
+  "compile-file FILE
+Compile a file."
+  (guile:compile-file (->string file) #:opts opts))
+
+(define (guile:disassemble x)
+  ((@ (language assembly disassemble) disassemble) x))
+
+(define-meta-command (disassemble repl (form))
+  "disassemble PROGRAM
+Disassemble a program."
+  (guile:disassemble (repl-eval repl (repl-parse repl form))))
+
+(define-meta-command (disassemble-file repl file)
+  "disassemble-file FILE
+Disassemble a file."
+  (guile:disassemble (load-objcode (->string file))))
+
+
+;;;
+;;; Profile commands
+;;;
+
+(define-meta-command (time repl (form))
+  "time FORM
+Time execution."
+  (let* ((vms-start (vm-stats (repl-vm repl)))
+	 (gc-start (gc-run-time))
+	 (tms-start (times))
+	 (result (repl-eval repl (repl-parse repl form)))
+	 (tms-end (times))
+	 (gc-end (gc-run-time))
+	 (vms-end (vm-stats (repl-vm repl))))
+    (define (get proc start end)
+      (exact->inexact (/ (- (proc end) (proc start)) internal-time-units-per-second)))
+    (repl-print repl result)
+    (display "clock utime stime cutime cstime gctime\n")
+    (format #t "~5,2F ~5,2F ~5,2F ~6,2F ~6,2F ~6,2F\n"
+	    (get tms:clock tms-start tms-end)
+	    (get tms:utime tms-start tms-end)
+	    (get tms:stime tms-start tms-end)
+	    (get tms:cutime tms-start tms-end)
+	    (get tms:cstime tms-start tms-end)
+	    (get identity gc-start gc-end))
+    result))
+
+(define-meta-command (profile repl form . opts)
+  "profile FORM
+Profile execution."
+  (apply vm-profile
+         (repl-vm repl)
+         (repl-compile repl (repl-parse repl form))
+         opts))
+
+
+;;;
+;;; Debug commands
+;;;
+
+(define-meta-command (backtrace repl)
+  "backtrace
+Display backtrace."
+  (vm-backtrace (repl-vm repl)))
+
+(define-meta-command (debugger repl)
+  "debugger
+Start debugger."
+  (vm-debugger (repl-vm repl)))
+
+(define-meta-command (trace repl form . opts)
+  "trace FORM
+Trace execution.
+
+  -s    Display stack
+  -l    Display local variables
+  -b    Bytecode level trace"
+  (apply vm-trace (repl-vm repl)
+         (repl-compile repl (repl-parse repl form))
+         opts))
+
+(define-meta-command (step repl)
+  "step FORM
+Step execution."
+  (display "Not implemented yet\n"))
+
+
+;;;
+;;; System commands 
+;;;
+
+(define guile:gc gc)
+(define-meta-command (gc repl)
+  "gc
+Garbage collection."
+  (guile:gc))
+
+(define-meta-command (statistics repl)
+  "statistics
+Display statistics."
+  (let ((this-tms (times))
+	(this-vms (vm-stats (repl-vm repl)))
+	(this-gcs (gc-stats))
+	(last-tms (repl-tm-stats repl))
+	(last-vms (repl-vm-stats repl))
+	(last-gcs (repl-gc-stats repl)))
+    ;; GC times
+    (let ((this-times  (assq-ref this-gcs 'gc-times))
+	  (last-times  (assq-ref last-gcs 'gc-times)))
+      (display-diff-stat "GC times:" #t this-times last-times "times")
+      (newline))
+    ;; Memory size
+    (let ((this-cells  (assq-ref this-gcs 'cells-allocated))
+	  (this-heap   (assq-ref this-gcs 'cell-heap-size))
+	  (this-bytes  (assq-ref this-gcs 'bytes-malloced))
+	  (this-malloc (assq-ref this-gcs 'gc-malloc-threshold)))
+      (display-stat-title "Memory size:" "current" "limit")
+      (display-stat "heap" #f this-cells this-heap "cells")
+      (display-stat "malloc" #f this-bytes this-malloc "bytes")
+      (newline))
+    ;; Cells collected
+    (let ((this-marked (assq-ref this-gcs 'cells-marked))
+	  (last-marked (assq-ref last-gcs 'cells-marked))
+	  (this-swept  (assq-ref this-gcs 'cells-swept))
+	  (last-swept  (assq-ref last-gcs 'cells-swept)))
+      (display-stat-title "Cells collected:" "diff" "total")
+      (display-diff-stat "marked" #f this-marked last-marked "cells")
+      (display-diff-stat "swept" #f this-swept last-swept "cells")
+      (newline))
+    ;; GC time taken
+    (let ((this-mark  (assq-ref this-gcs 'gc-mark-time-taken))
+	  (last-mark  (assq-ref last-gcs 'gc-mark-time-taken))
+	  (this-total (assq-ref this-gcs 'gc-time-taken))
+	  (last-total (assq-ref last-gcs 'gc-time-taken)))
+      (display-stat-title "GC time taken:" "diff" "total")
+      (display-time-stat "mark" this-mark last-mark)
+      (display-time-stat "total" this-total last-total)
+      (newline))
+    ;; Process time spent
+    (let ((this-utime  (tms:utime this-tms))
+	  (last-utime  (tms:utime last-tms))
+	  (this-stime  (tms:stime this-tms))
+	  (last-stime  (tms:stime last-tms))
+	  (this-cutime (tms:cutime this-tms))
+	  (last-cutime (tms:cutime last-tms))
+	  (this-cstime (tms:cstime this-tms))
+	  (last-cstime (tms:cstime last-tms)))
+      (display-stat-title "Process time spent:" "diff" "total")
+      (display-time-stat "user" this-utime last-utime)
+      (display-time-stat "system" this-stime last-stime)
+      (display-time-stat "child user" this-cutime last-cutime)
+      (display-time-stat "child system" this-cstime last-cstime)
+      (newline))
+    ;; VM statistics
+    (let ((this-time  (vms:time this-vms))
+	  (last-time  (vms:time last-vms))
+	  (this-clock (vms:clock this-vms))
+	  (last-clock (vms:clock last-vms)))
+      (display-stat-title "VM statistics:" "diff" "total")
+      (display-time-stat "time spent" this-time last-time)
+      (display-diff-stat "bogoclock" #f this-clock last-clock "clock")
+      (display-mips-stat "bogomips" this-time this-clock last-time last-clock)
+      (newline))
+    ;; Save statistics
+    ;; Save statistics
+    (set! (repl-tm-stats repl) this-tms)
+    (set! (repl-vm-stats repl) this-vms)
+    (set! (repl-gc-stats repl) this-gcs)))
+
+(define (display-stat title flag field1 field2 unit)
+  (let ((str (format #f "~~20~AA ~~10@A /~~10@A ~~A~~%" (if flag "" "@"))))
+    (format #t str title field1 field2 unit)))
+
+(define (display-stat-title title field1 field2)
+  (display-stat title #t field1 field2 ""))
+
+(define (display-diff-stat title flag this last unit)
+  (display-stat title flag (- this last) this unit))
+
+(define (display-time-stat title this last)
+  (define (conv num)
+    (format #f "~10,2F" (exact->inexact (/ num internal-time-units-per-second))))
+  (display-stat title #f (conv (- this last)) (conv this) "s"))
+
+(define (display-mips-stat title this-time this-clock last-time last-clock)
+  (define (mips time clock)
+    (if (= time 0) "----" (format #f "~10,2F" (/ clock time 1000000.0))))
+  (display-stat title #f
+		(mips (- this-time last-time) (- this-clock last-clock))
+		(mips this-time this-clock) "mips"))
diff --git a/module/system/repl/common.scm b/module/system/repl/common.scm
new file mode 100644
index 000000000..2db4518ad
--- /dev/null
+++ b/module/system/repl/common.scm
@@ -0,0 +1,112 @@
+;;; Repl common routines
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public
+;;; License as published by the Free Software Foundation; either
+;;; version 3 of the License, or (at your option) any later version.
+;;;
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (system repl common)
+  #:use-module (system base syntax)
+  #:use-module (system base compile)
+  #:use-module (system base language)
+  #:use-module (system vm vm)
+  #:export (<repl> make-repl repl-vm repl-language repl-options
+            repl-tm-stats repl-gc-stats repl-vm-stats
+            repl-welcome repl-prompt repl-read repl-compile repl-eval
+            repl-parse repl-print repl-option-ref repl-option-set!
+            puts ->string user-error))
+
+
+;;;
+;;; Repl type
+;;;
+
+(define-record/keywords <repl> vm language options tm-stats gc-stats vm-stats)
+
+(define repl-default-options
+  '((trace . #f)
+    (interp . #f)))
+
+(define %make-repl make-repl)
+(define (make-repl lang)
+  (%make-repl #:vm (the-vm)
+              #:language (lookup-language lang)
+              #:options repl-default-options
+              #:tm-stats (times)
+              #:gc-stats (gc-stats)
+              #:vm-stats (vm-stats (the-vm))))
+
+(define (repl-welcome repl)
+  (let ((language (repl-language repl)))
+    (format #t "~A interpreter ~A on Guile ~A\n"
+            (language-title language) (language-version language) (version)))
+  (display "Copyright (C) 2001-2008 Free Software Foundation, Inc.\n\n")
+  (display "Enter `,help' for help.\n"))
+
+(define (repl-prompt repl)
+  (format #f "~A@~A> " (language-name (repl-language repl))
+          (module-name (current-module))))
+
+(define (repl-read repl)
+  ((language-reader (repl-language repl))))
+
+(define (repl-compile repl form . opts)
+  (let ((to (lookup-language (cond ((memq #:e opts) 'scheme)
+                                   ((memq #:t opts) 'ghil)
+                                   ((memq #:c opts) 'glil)
+                                   (else 'objcode)))))
+    (compile form #:from (repl-language repl) #:to to #:opts opts)))
+
+(define (repl-parse repl form)
+  (let ((parser (language-parser (repl-language repl))))
+    (if parser (parser form) form)))
+
+(define (repl-eval repl form)
+  (let ((eval (language-evaluator (repl-language repl))))
+    (if (and eval
+             (or (null? (language-compilers (repl-language repl)))
+                 (assq-ref (repl-options repl) 'interp)))
+        (eval form (current-module))
+        (vm-load (repl-vm repl) (repl-compile repl form '())))))
+
+(define (repl-print repl val)
+  (if (not (eq? val *unspecified*))
+      (begin
+        ;; The result of an evaluation is representable in scheme, and
+        ;; should be printed with the generic printer, `write'. The
+        ;; language-printer is something else: it prints expressions of
+        ;; a given language, not the result of evaluation.
+	(write val)
+	(newline))))
+
+(define (repl-option-ref repl key)
+  (assq-ref (repl-options repl) key))
+
+(define (repl-option-set! repl key val)
+  (set! (repl-options repl) (assq-set! (repl-options repl) key val)))
+
+
+;;;
+;;; Utilities
+;;;
+
+(define (puts x) (display x) (newline))
+
+(define (->string x)
+  (object->string x display))
+
+(define (user-error msg . args)
+  (throw 'user-error #f msg args #f))
diff --git a/module/system/repl/describe.scm b/module/system/repl/describe.scm
new file mode 100644
index 000000000..590d2235a
--- /dev/null
+++ b/module/system/repl/describe.scm
@@ -0,0 +1,360 @@
+;;; Describe objects
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public
+;;; License as published by the Free Software Foundation; either
+;;; version 3 of the License, or (at your option) any later version.
+;;;
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (system repl describe)
+  #:use-module (oop goops)
+  #:use-module (ice-9 regex)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 and-let-star)
+  #:export (describe))
+
+(define-method (describe (symbol <symbol>))
+  (format #t "`~s' is " symbol)
+  (if (not (defined? symbol))
+      (display "not defined in the current module.\n")
+      (describe-object (module-ref (current-module) symbol))))
+
+
+;;;
+;;; Display functions
+;;;
+
+(define (safe-class-name class)
+  (if (slot-bound? class 'name)
+      (class-name class)
+      class))
+
+(define-method (display-class class . args)
+  (let* ((name (safe-class-name class))
+	 (desc (if (pair? args) (car args) name)))
+    (if (eq? *describe-format* 'tag)
+	(format #t "@class{~a}{~a}" name desc)
+	(format #t "~a" desc))))
+
+(define (display-list title list)
+  (if title (begin (display title) (display ":\n\n")))
+  (if (null? list)
+      (display "(not defined)\n")
+      (for-each display-summary list)))
+
+(define (display-slot-list title instance list)
+  (if title (begin (display title) (display ":\n\n")))
+  (if (null? list)
+      (display "(not defined)\n")
+      (for-each (lambda (slot)
+		  (let ((name (slot-definition-name slot)))
+		    (display "Slot: ")
+		    (display name)
+		    (if (and instance (slot-bound? instance name))
+			(begin
+			  (display " = ")
+			  (display (slot-ref instance name))))
+		    (newline)))
+		list)))
+
+(define (display-file location)
+  (display "Defined in ")
+  (if (eq? *describe-format* 'tag)
+      (format #t "@location{~a}.\n" location)
+      (format #t "`~a'.\n" location)))
+
+(define (format-documentation doc)
+  (with-current-buffer (make-buffer #:text doc)
+    (lambda ()
+      (let ((regexp (make-regexp "@([a-z]*)(\\{([^}]*)\\})?")))
+	(do-while (match (re-search-forward regexp))
+	  (let ((key (string->symbol (match:substring match 1)))
+		(value (match:substring match 3)))
+	    (case key
+	      ((deffnx)
+	       (delete-region! (match:start match)
+			       (begin (forward-line) (point))))
+	      ((var)
+	       (replace-match! match 0 (string-upcase value)))
+	      ((code)
+	       (replace-match! match 0 (string-append "`" value "'")))))))
+      (display (string (current-buffer)))
+      (newline))))
+
+
+;;;
+;;; Top
+;;;
+
+(define description-table
+  (list
+   (cons <boolean>   "a boolean")
+   (cons <null>      "an empty list")
+   (cons <integer>   "an integer")
+   (cons <real>      "a real number")
+   (cons <complex>   "a complex number")
+   (cons <char>      "a character")
+   (cons <symbol>    "a symbol")
+   (cons <keyword>   "a keyword")
+   (cons <promise>   "a promise")
+   (cons <hook>      "a hook")
+   (cons <fluid>     "a fluid")
+   (cons <stack>     "a stack")
+   (cons <variable>  "a variable")
+   (cons <regexp>    "a regexp object")
+   (cons <module>    "a module object")
+   (cons <unknown>   "an unknown object")))
+
+(define-generic describe-object)
+(export describe-object)
+
+(define-method (describe-object (obj <top>))
+  (display-type obj)
+  (display-location obj)
+  (newline)
+  (display-value obj)
+  (newline)
+  (display-documentation obj))
+
+(define-generic display-object)
+(define-generic display-summary)
+(define-generic display-type)
+(define-generic display-value)
+(define-generic display-location)
+(define-generic display-description)
+(define-generic display-documentation)
+(export display-object display-summary display-type display-value
+	display-location display-description display-documentation)
+
+(define-method (display-object (obj <top>))
+  (write obj))
+
+(define-method (display-summary (obj <top>))
+  (display "Value: ")
+  (display-object obj)
+  (newline))
+
+(define-method (display-type (obj <top>))
+  (cond
+   ((eof-object? obj) (display "the end-of-file object"))
+   ((unspecified? obj) (display "unspecified"))
+   (else (let ((class (class-of obj)))
+	   (display-class class (or (assq-ref description-table class)
+				    (safe-class-name class))))))
+  (display ".\n"))
+
+(define-method (display-value (obj <top>))
+  (if (not (unspecified? obj))
+      (begin (display-object obj) (newline))))
+
+(define-method (display-location (obj <top>))
+  *unspecified*)
+
+(define-method (display-description (obj <top>))
+  (let* ((doc (with-output-to-string (lambda () (display-documentation obj))))
+	 (index (string-index doc #\newline)))
+    (display (make-shared-substring doc 0 (1+ index)))))
+
+(define-method (display-documentation (obj <top>))
+  (display "Not documented.\n"))
+
+
+;;;
+;;; Pairs
+;;;
+
+(define-method (display-type (obj <pair>))
+  (cond
+   ((list? obj) (display-class <list> "a list"))
+   ((pair? (cdr obj)) (display "an improper list"))
+   (else (display-class <pair> "a pair")))
+  (display ".\n"))
+
+
+;;;
+;;; Strings
+;;;
+
+(define-method (display-type (obj <string>))
+  (if (read-only-string? 'obj)
+      (display "a read-only string")
+      (display-class <string> "a string"))
+  (display ".\n"))
+
+
+;;;
+;;; Procedures
+;;;
+
+(define-method (display-object (obj <procedure>))
+  (cond
+   ((closure? obj)
+    ;; Construct output from the source.
+    (display "(")
+    (display (procedure-name obj))
+    (let ((args (cadr (procedure-source obj))))
+      (cond ((null? args) (display ")"))
+	    ((pair? args)
+	     (let ((str (with-output-to-string (lambda () (display args)))))
+	       (format #t " ~a" (string-upcase! (substring str 1)))))
+	    (else
+	     (format #t " . ~a)" (string-upcase! (symbol->string args)))))))
+   (else
+    ;; Primitive procedure.  Let's lookup the dictionary.
+    (and-let* ((entry (lookup-procedure obj)))
+      (let ((name (entry-property entry 'name))
+	    (print-arg (lambda (arg)
+			 (display " ")
+			 (display (string-upcase (symbol->string arg))))))
+	(display "(")
+	(display name)
+	(and-let* ((args (entry-property entry 'args)))
+	  (for-each print-arg args))
+	(and-let* ((opts (entry-property entry 'opts)))
+	  (display " &optional")
+	  (for-each print-arg opts))
+	(and-let* ((rest (entry-property entry 'rest)))
+	  (display " &rest")
+	  (print-arg rest))
+	(display ")"))))))
+
+(define-method (display-summary (obj <procedure>))
+  (display "Procedure: ")
+  (display-object obj)
+  (newline)
+  (display "  ")
+  (display-description obj))
+
+(define-method (display-type (obj <procedure>))
+  (cond
+   ((and (thunk? obj) (not (procedure-name obj))) (display "a thunk"))
+   ((closure? obj) (display-class <procedure> "a procedure"))
+   ((procedure-with-setter? obj)
+    (display-class <procedure-with-setter> "a procedure with setter"))
+   ((not (struct? obj)) (display "a primitive procedure"))
+   (else (display-class <procedure> "a procedure")))
+  (display ".\n"))
+
+(define-method (display-location (obj <procedure>))
+  (and-let* ((entry (lookup-procedure obj)))
+    (display-file (entry-file entry))))
+
+(define-method (display-documentation (obj <procedure>))
+  (cond ((cond ((closure? obj) (procedure-documentation obj))
+	       ((lookup-procedure obj) => entry-text)
+	       (else #f))
+	 => format-documentation)
+	(else (next-method))))
+
+
+;;;
+;;; Classes
+;;;
+
+(define-method (describe-object (obj <class>))
+  (display-type obj)
+  (display-location obj)
+  (newline)
+  (display-documentation obj)
+  (newline)
+  (display-value obj))
+
+(define-method (display-summary (obj <class>))
+  (display "Class: ")
+  (display-class obj)
+  (newline)
+  (display "  ")
+  (display-description obj))
+
+(define-method (display-type (obj <class>))
+  (display-class <class> "a class")
+  (if (not (eq? (class-of obj) <class>))
+      (begin (display " of ") (display-class (class-of obj))))
+  (display ".\n"))
+
+(define-method (display-value (obj <class>))
+  (display-list "Class precedence list" (class-precedence-list obj))
+  (newline)
+  (display-list "Direct superclasses" (class-direct-supers obj))
+  (newline)
+  (display-list "Direct subclasses" (class-direct-subclasses obj))
+  (newline)
+  (display-slot-list "Direct slots" #f (class-direct-slots obj))
+  (newline)
+  (display-list "Direct methods" (class-direct-methods obj)))
+
+
+;;;
+;;; Instances
+;;;
+
+(define-method (display-type (obj <object>))
+  (display-class <object> "an instance")
+  (display " of class ")
+  (display-class (class-of obj))
+  (display ".\n"))
+
+(define-method (display-value (obj <object>))
+  (display-slot-list #f obj (class-slots (class-of obj))))
+
+
+;;;
+;;; Generic functions
+;;;
+
+(define-method (display-type (obj <generic>))
+  (display-class <generic> "a generic function")
+  (display " of class ")
+  (display-class (class-of obj))
+  (display ".\n"))
+
+(define-method (display-value (obj <generic>))
+  (display-list #f (generic-function-methods obj)))
+
+
+;;;
+;;; Methods
+;;;
+
+(define-method (display-object (obj <method>))
+  (display "(")
+  (let ((gf (method-generic-function obj)))
+    (display (if gf (generic-function-name gf) "#<anonymous>")))
+  (let loop ((args (method-specializers obj)))
+    (cond
+     ((null? args))
+     ((pair? args)
+      (display " ")
+      (display-class (car args))
+      (loop (cdr args)))
+     (else (display " . ") (display-class args))))
+  (display ")"))
+
+(define-method (display-summary (obj <method>))
+  (display "Method: ")
+  (display-object obj)
+  (newline)
+  (display "  ")
+  (display-description obj))
+
+(define-method (display-type (obj <method>))
+  (display-class <method> "a method")
+  (display " of class ")
+  (display-class (class-of obj))
+  (display ".\n"))
+
+(define-method (display-documentation (obj <method>))
+  (let ((doc (procedure-documentation (method-procedure obj))))
+    (if doc (format-documentation doc) (next-method))))
diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm
new file mode 100644
index 000000000..2f4a3783a
--- /dev/null
+++ b/module/system/repl/repl.scm
@@ -0,0 +1,150 @@
+;;; Read-Eval-Print Loop
+
+;; Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+
+;; This library is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public
+;; License as published by the Free Software Foundation; either
+;; version 3 of the License, or (at your option) any later version.
+;; 
+;; This library is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; Lesser General Public License for more details.
+;; 
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+;; 02110-1301 USA
+
+;;; Code:
+
+(define-module (system repl repl)
+  #:use-module (system base syntax)
+  #:use-module (system base pmatch)
+  #:use-module (system base compile)
+  #:use-module (system base language)
+  #:use-module (system repl common)
+  #:use-module (system repl command)
+  #:use-module (system vm vm)
+  #:use-module (system vm debug)
+  #:export (start-repl call-with-backtrace))
+
+(define meta-command-token (cons 'meta 'command))
+
+(define (meta-reader read)
+  (lambda read-args
+    (with-input-from-port
+        (if (pair? read-args) (car read-args) (current-input-port))
+      (lambda ()
+        (let ((ch (next-char #t)))
+          (cond ((eof-object? ch)
+                 ;; apparently sometimes even if this is eof, read will
+                 ;; wait on somethingorother. strange.
+                 ch)
+                ((eqv? ch #\,)
+                 (read-char)
+                 meta-command-token)
+                (else (read))))))))
+        
+;; repl-reader is a function defined in boot-9.scm, and is replaced by
+;; something else if readline has been activated. much of this hoopla is
+;; to be able to re-use the existing readline machinery.
+(define (prompting-meta-read repl)
+  (let ((prompt (lambda () (repl-prompt repl)))
+        (lread (language-reader (repl-language repl))))
+    (with-fluid* current-reader (meta-reader lread)
+      (lambda () (repl-reader (lambda () (repl-prompt repl)))))))
+
+(define (default-catch-handler . args)
+  (pmatch args
+    ((quit . _)
+     (apply throw args))
+    ((,key ,subr ,msg ,args . ,rest)
+     (let ((cep (current-error-port)))
+       (cond ((not (stack? (fluid-ref the-last-stack))))
+             ((memq 'backtrace (debug-options-interface))
+              (let ((highlights (if (or (eq? key 'wrong-type-arg)
+                                        (eq? key 'out-of-range))
+                                    (car rest)
+                                    '())))
+                (run-hook before-backtrace-hook)
+                (newline cep)
+                (display "Backtrace:\n")
+                (display-backtrace (fluid-ref the-last-stack) cep
+                                   #f #f highlights)
+                (newline cep)
+                (run-hook after-backtrace-hook))))
+       (run-hook before-error-hook)
+       (display-error (fluid-ref the-last-stack) cep subr msg args rest)
+       (run-hook after-error-hook)
+       (set! stack-saved? #f)
+       (force-output cep)))
+    (else
+     (format (current-error-port) "\nERROR: uncaught throw to `~a', args: ~a\n"
+             (car args) (cdr args)))))
+
+(define (call-with-backtrace thunk)
+  (catch #t
+         (lambda () (%start-stack #t thunk))
+         default-catch-handler
+         default-pre-unwind-handler))
+
+(define-macro (with-backtrace form)
+  `(call-with-backtrace (lambda () ,form)))
+
+(define (start-repl lang)
+  (let ((repl (make-repl lang))
+        (status #f))
+    (repl-welcome repl)
+    (let prompt-loop ()
+      (let ((exp (with-backtrace (prompting-meta-read repl))))
+        (cond
+         ((eqv? exp (if #f #f))) ; read error, pass
+         ((eq? exp meta-command-token)
+          (with-backtrace (meta-command repl)))
+         ((eof-object? exp)
+          (newline)
+          (set! status '()))
+         (else
+          ;; since the input port is line-buffered, consume up to the
+          ;; newline
+          (flush-to-newline)
+          (with-backtrace
+           (catch 'quit
+                  (lambda ()
+                    (call-with-values
+                        (lambda ()
+                          (run-hook before-eval-hook exp)
+                          (start-stack #t
+                                       (repl-eval repl (repl-parse repl exp))))
+                      (lambda l
+                        (for-each (lambda (v)
+                                    (run-hook before-print-hook v)
+                                    (repl-print repl v))
+                                  l))))
+                  (lambda (k . args)
+                    (set! status args))))))
+        (or status
+            (begin
+              (next-char #f) ;; consume trailing whitespace
+              (prompt-loop)))))))
+
+(define (next-char wait)
+  (if (or wait (char-ready?))
+      (let ((ch (peek-char)))
+	(cond ((eof-object? ch) ch)
+	      ((char-whitespace? ch) (read-char) (next-char wait))
+	      (else ch)))
+      #f))
+
+(define (flush-to-newline) 
+  (if (char-ready?)
+      (let ((ch (peek-char)))
+        (if (and (not (eof-object? ch)) (char-whitespace? ch))
+            (begin
+              (read-char)
+              (if (not (char=? ch #\newline))
+                  (flush-to-newline)))))))
+          
+          
\ No newline at end of file
diff --git a/module/system/vm/debug.scm b/module/system/vm/debug.scm
new file mode 100644
index 000000000..740111257
--- /dev/null
+++ b/module/system/vm/debug.scm
@@ -0,0 +1,62 @@
+;;; Guile VM debugging facilities
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; 
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; 
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(define-module (system vm debug)
+  #:use-module (system base syntax)
+  #:use-module (system vm vm)
+  #:use-module (system vm frame)
+  #:use-module (ice-9 format)
+  #:export (vm-debugger vm-backtrace))
+
+
+;;;
+;;; Debugger
+;;;
+
+(define-record/keywords <debugger> vm chain index)
+
+(define (vm-debugger vm)
+  (let ((chain (vm-last-frame-chain vm)))
+    (if (null? chain)
+      (display "Nothing to debug\n")
+      (debugger-repl (make-debugger
+                      #:vm vm #:chain chain #:index (length chain))))))
+
+(define (debugger-repl db)
+  (let loop ()
+    (display "debug> ")
+    (let ((cmd (read)))
+      (case cmd
+	((bt) (vm-backtrace (debugger-vm db)))
+	((stack)
+	 (write (vm-fetch-stack (debugger-vm db)))
+	 (newline))
+	(else
+	 (format #t "Unknown command: ~A" cmd))))))
+
+
+;;;
+;;; Backtrace
+;;;
+
+(define (vm-backtrace vm)
+  (print-frame-chain-as-backtrace
+   (reverse (vm-last-frame-chain vm))))
diff --git a/module/system/vm/frame.scm b/module/system/vm/frame.scm
new file mode 100644
index 000000000..332cd6172
--- /dev/null
+++ b/module/system/vm/frame.scm
@@ -0,0 +1,209 @@
+;;; Guile VM frame functions
+
+;;; Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+;;; Copyright (C) 2005 Ludovic Court�s  <ludovic.courtes@laas.fr>
+;;;
+;;; 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., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
+
+;;; Code:
+
+(define-module (system vm frame)
+  #:use-module (system vm program)
+  #:use-module (system vm instruction)
+  #:use-module ((srfi srfi-1) #:select (fold))
+  #:export (vm-frame?
+            vm-frame-program
+            vm-frame-local-ref vm-frame-local-set!
+            vm-frame-return-address vm-frame-mv-return-address
+            vm-frame-dynamic-link
+            vm-frame-stack
+
+
+            vm-frame-number vm-frame-address
+            make-frame-chain
+            print-frame print-frame-chain-as-backtrace
+            frame-arguments frame-local-variables
+            frame-environment
+            frame-variable-exists? frame-variable-ref frame-variable-set!
+            frame-object-name
+            frame-local-ref frame-local-set!
+            frame-return-address frame-program
+            frame-dynamic-link heap-frame?))
+
+(load-extension "libguile" "scm_init_frames")
+
+;;;
+;;; Frame chain
+;;;
+
+(define vm-frame-number (make-object-property))
+(define vm-frame-address (make-object-property))
+
+;; FIXME: the header.
+(define (bootstrap-frame? frame)
+  (let ((code (objcode->bytecode (program-objcode (frame-program frame)))))
+    (and (= (uniform-vector-ref code (1- (uniform-vector-length code)))
+            (instruction->opcode 'halt)))))
+
+(define (make-frame-chain frame addr)
+  (define (make-rest)
+    (make-frame-chain (frame-dynamic-link frame)
+                      (frame-return-address frame)))
+  (cond
+   ((or (eq? frame #t) (eq? frame #f))
+    ;; handle #f or #t dynamic links
+    '())
+   ((bootstrap-frame? frame)
+    (make-rest))
+   (else
+    (let ((chain (make-rest)))
+      (set! (frame-number frame) (length chain))
+      (set! (frame-address frame)
+            (- addr (program-base (frame-program frame))))
+      (cons frame chain)))))
+
+
+;;;
+;;; Pretty printing
+;;;
+
+(define (frame-line-number frame)
+  (let ((addr (frame-address frame)))
+    (cond ((assv addr (program-sources (frame-program frame)))
+           => source:line)
+          (else (format #f "@~a" addr)))))
+
+(define (frame-file frame prev)
+  (let ((sources (program-sources (frame-program frame))))
+    (if (null? sources)
+        prev
+        (or (source:file (car sources))
+            "current input"))))
+
+(define (print-frame frame)
+  (format #t "~4@a: ~a   ~s\n" (frame-line-number frame) (frame-number frame)
+          (frame-call-representation frame)))
+
+
+(define (frame-call-representation frame)
+  (define (abbrev x)
+    (cond ((list? x)
+           (if (> (length x) 4)
+               (list (abbrev (car x)) (abbrev (cadr x)) '...)
+               (map abbrev x)))
+	  ((pair? x)
+           (cons (abbrev (car x)) (abbrev (cdr x))))
+	  ((vector? x)
+           (case (vector-length x)
+             ((0) x)
+             ((1) (vector (abbrev (vector-ref x 0))))
+             (else (vector (abbrev (vector-ref x 0)) '...))))
+	  (else x)))
+  (abbrev (cons (frame-program-name frame) (frame-arguments frame))))
+
+(define (print-frame-chain-as-backtrace frames)
+  (if (null? frames)
+      (format #t "No backtrace available.\n")
+      (begin
+        (format #t "VM backtrace:\n")
+        (fold (lambda (frame file)
+                (let ((new-file (frame-file frame file)))
+                  (if (not (equal? new-file file))
+                      (format #t "In ~a:\n" new-file))
+                  (print-frame frame)
+                  new-file))
+              'no-file
+              frames))))
+
+(define (frame-program-name frame)
+  (let ((prog (frame-program frame))
+	(link (frame-dynamic-link frame)))
+    (or (program-name prog)
+        (object-property prog 'name)
+        (and (heap-frame? link) (frame-address link)
+             (frame-object-name link (1- (frame-address link)) prog))
+	(hash-fold (lambda (s v d) (if (and (variable-bound? v)
+                                            (eq? prog (variable-ref v)))
+                                       s d))
+		   prog (module-obarray (current-module))))))
+
+
+;;;
+;;; Frames
+;;;
+
+(define (frame-arguments frame)
+  (let* ((prog (frame-program frame))
+	 (arity (program-arity prog)))
+    (do ((n (+ (arity:nargs arity) -1) (1- n))
+	 (l '() (cons (frame-local-ref frame n) l)))
+	((< n 0) l))))
+
+(define (frame-local-variables frame)
+  (let* ((prog (frame-program frame))
+	 (arity (program-arity prog)))
+    (do ((n (+ (arity:nargs arity) (arity:nlocs arity) -1) (1- n))
+	 (l '() (cons (frame-local-ref frame n) l)))
+	((< n 0) l))))
+
+(define (frame-binding-ref frame binding)
+  (let ((x (frame-local-ref frame (binding:index binding))))
+    (if (and (binding:boxed? binding) (variable? x))
+        (variable-ref x)
+        x)))
+
+(define (frame-binding-set! frame binding val)
+  (if (binding:boxed? binding)
+      (let ((v (frame-local-ref frame binding)))
+        (if (variable? v)
+            (variable-set! v val)
+            (frame-local-set! frame binding (make-variable val))))
+      (frame-local-set! frame binding val)))
+
+;; FIXME handle #f program-bindings return
+(define (frame-bindings frame addr)
+  (filter (lambda (b) (and (>= addr (binding:start b))
+                           (<= addr (binding:end b))))
+          (program-bindings (frame-program frame))))
+
+(define (frame-lookup-binding frame addr sym)
+  (assq sym (reverse (frame-bindings frame addr))))
+
+(define (frame-object-binding frame addr obj)
+  (do ((bs (frame-bindings frame addr) (cdr bs)))
+      ((or (null? bs) (eq? obj (frame-binding-ref frame (car bs))))
+       (and (pair? bs) (car bs)))))
+
+(define (frame-environment frame addr)
+  (map (lambda (binding)
+	 (cons (binding:name binding) (frame-binding-ref frame binding)))
+       (frame-bindings frame addr)))
+
+(define (frame-variable-exists? frame addr sym)
+  (if (frame-lookup-binding frame addr sym) #t #f))
+
+(define (frame-variable-ref frame addr sym)
+  (cond ((frame-lookup-binding frame addr sym) =>
+	 (lambda (binding) (frame-binding-ref frame binding)))
+	(else (error "Unknown variable:" sym))))
+
+(define (frame-variable-set! frame addr sym val)
+  (cond ((frame-lookup-binding frame addr sym) =>
+	 (lambda (binding) (frame-binding-set! frame binding val)))
+	(else (error "Unknown variable:" sym))))
+
+(define (frame-object-name frame addr obj)
+  (cond ((frame-object-binding frame addr obj) => binding:name)
+	(else #f)))
diff --git a/module/system/vm/instruction.scm b/module/system/vm/instruction.scm
new file mode 100644
index 000000000..403e9cdc7
--- /dev/null
+++ b/module/system/vm/instruction.scm
@@ -0,0 +1,27 @@
+;;; Guile VM instructions
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public
+;;; License as published by the Free Software Foundation; either
+;;; version 3 of the License, or (at your option) any later version.
+;;;
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (system vm instruction)
+  #:export (instruction-list
+           instruction? instruction-length
+           instruction-pops instruction-pushes
+           instruction->opcode opcode->instruction))
+
+(load-extension "libguile" "scm_init_instructions")
diff --git a/module/system/vm/objcode.scm b/module/system/vm/objcode.scm
new file mode 100644
index 000000000..7c0490da6
--- /dev/null
+++ b/module/system/vm/objcode.scm
@@ -0,0 +1,27 @@
+;;; Guile VM object code
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public
+;;; License as published by the Free Software Foundation; either
+;;; version 3 of the License, or (at your option) any later version.
+;;;
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (system vm objcode)
+  #:export (objcode? objcode-meta
+            bytecode->objcode objcode->bytecode
+            load-objcode write-objcode
+            word-size byte-order))
+
+(load-extension "libguile" "scm_init_objcodes")
diff --git a/module/system/vm/profile.scm b/module/system/vm/profile.scm
new file mode 100644
index 000000000..6ab418ac3
--- /dev/null
+++ b/module/system/vm/profile.scm
@@ -0,0 +1,64 @@
+;;; Guile VM profiler
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public
+;;; License as published by the Free Software Foundation; either
+;;; version 3 of the License, or (at your option) any later version.
+;;;
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (system vm profile)
+  #:use-module (system vm vm)
+  #:use-module (ice-9 format)
+  #:export (vm-profile))
+
+(define (vm-profile vm objcode . opts)
+  (let ((flag (vm-option vm 'debug)))
+    (dynamic-wind
+	(lambda ()
+	  (set-vm-option! vm 'debug #t)
+	  (set-vm-option! vm 'profile-data '())
+	  (add-hook! (vm-next-hook vm) profile-next)
+	  (add-hook! (vm-enter-hook vm) profile-enter)
+	  (add-hook! (vm-exit-hook vm) profile-exit))
+	(lambda ()
+	  (vm-load vm objcode)
+	  (print-result vm))
+	(lambda ()
+	  (set-vm-option! vm 'debug flag)
+	  (remove-hook! (vm-next-hook vm) profile-next)
+	  (remove-hook! (vm-enter-hook vm) profile-enter)
+	  (remove-hook! (vm-exit-hook vm) profile-exit)))))
+
+(define (profile-next vm)
+  (set-vm-option! vm 'profile-data
+		  (cons (vm-fetch-code vm) (vm-option vm 'profile-data))))
+
+(define (profile-enter vm)
+  #f)
+
+(define (profile-exit vm)
+  #f)
+
+(define (print-result vm . opts)
+  (do ((data (vm-option vm 'profile-data) (cdr data))
+       (summary '() (let ((inst (caar data)))
+		      (assq-set! summary inst
+				 (1+ (or (assq-ref summary inst) 0))))))
+      ((null? data)
+       (display "Count  Instruction\n")
+       (display "-----  -----------\n")
+       (for-each (lambda (entry)
+		   (format #t "~5@A  ~A\n" (cdr entry) (car entry)))
+		 (sort summary (lambda (e1 e2) (> (cdr e1) (cdr e2))))))))
diff --git a/module/system/vm/program.scm b/module/system/vm/program.scm
new file mode 100644
index 000000000..755c606e2
--- /dev/null
+++ b/module/system/vm/program.scm
@@ -0,0 +1,100 @@
+;;; Guile VM program functions
+
+;;; Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+;;;
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public
+;;; License as published by the Free Software Foundation; either
+;;; version 3 of the License, or (at your option) any later version.
+;;;
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (system vm program)
+  #:export (make-program
+
+            arity:nargs arity:nrest arity:nlocs
+
+            make-binding binding:name binding:boxed? binding:index
+            binding:start binding:end
+
+            source:addr source:line source:column source:file
+            program-bindings program-sources program-source
+            program-properties program-property program-documentation
+            program-name program-arguments
+           
+            program-arity program-meta
+            program-objcode program? program-objects
+            program-module program-base program-free-variables))
+
+(load-extension "libguile" "scm_init_programs")
+
+(define arity:nargs car)
+(define arity:nrest cadr)
+(define arity:nlocs caddr)
+
+(define (make-binding name boxed? index start end)
+  (list name boxed? index start end))
+(define (binding:name b) (list-ref b 0))
+(define (binding:boxed? b) (list-ref b 1))
+(define (binding:index b) (list-ref b 2))
+(define (binding:start b) (list-ref b 3))
+(define (binding:end b) (list-ref b 4))
+
+(define (source:addr source)
+  (car source))
+(define (source:file source)
+  (cadr source))
+(define (source:line source)
+  (caddr source))
+(define (source:column source)
+  (cdddr source))
+
+(define (program-property prog prop)
+  (assq-ref (program-properties proc) prop))
+
+(define (program-documentation prog)
+  (assq-ref (program-properties prog) 'documentation))
+
+(define (program-arguments prog)
+  (let ((bindings (program-bindings prog))
+        (nargs (arity:nargs (program-arity prog)))
+        (rest? (not (zero? (arity:nrest (program-arity prog))))))
+    (if bindings
+        (let ((args (map binding:name (list-head bindings nargs))))
+          (if rest?
+              `((required . ,(list-head args (1- (length args))))
+                (rest . ,(car (last-pair args))))
+              `((required . ,args))))
+        #f)))
+
+(define (program-bindings-as-lambda-list prog)
+  (let ((bindings (program-bindings prog))
+        (nargs (arity:nargs (program-arity prog)))
+        (rest? (not (zero? (arity:nrest (program-arity prog))))))
+    (if (not bindings)
+        (if rest? (cons (1- nargs) 1) (list nargs))
+        (let ((args (map binding:name (list-head bindings nargs))))
+          (if rest?
+              (apply cons* args)
+              args)))))
+
+(define (write-program prog port)
+  (format port "#<program ~a ~a>"
+          (or (program-name prog)
+              (and=> (program-source prog 0)
+                     (lambda (s)
+                       (format #f "~a at ~a:~a:~a"
+                               (number->string (object-address prog) 16)
+                               (or (source:file s) "<unknown port>")
+                               (source:line s) (source:column s))))
+              (number->string (object-address prog) 16))
+          (program-bindings-as-lambda-list prog)))
diff --git a/module/system/vm/trace.scm b/module/system/vm/trace.scm
new file mode 100644
index 000000000..d8165f202
--- /dev/null
+++ b/module/system/vm/trace.scm
@@ -0,0 +1,76 @@
+;;; Guile VM tracer
+
+;; Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public
+;;; License as published by the Free Software Foundation; either
+;;; version 3 of the License, or (at your option) any later version.
+;;;
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (system vm trace)
+  #:use-module (system base syntax)
+  #:use-module (system vm vm)
+  #:use-module (system vm frame)
+  #:use-module (ice-9 format)
+  #:export (vm-trace vm-trace-on vm-trace-off))
+
+(define (vm-trace vm objcode . opts)
+  (dynamic-wind
+      (lambda () (apply vm-trace-on vm opts))
+      (lambda () (vm-load vm objcode))
+      (lambda () (apply vm-trace-off vm opts))))
+
+(define (vm-trace-on vm . opts)
+  (set-vm-option! vm 'trace-first #t)
+  (if (memq #:b opts) (add-hook! (vm-next-hook vm) trace-next))
+  (set-vm-option! vm 'trace-options opts)
+  (add-hook! (vm-apply-hook vm) trace-apply)
+  (add-hook! (vm-return-hook vm) trace-return))
+
+(define (vm-trace-off vm . opts)
+  (if (memq #:b opts) (remove-hook! (vm-next-hook vm) trace-next))
+  (remove-hook! (vm-apply-hook vm) trace-apply)
+  (remove-hook! (vm-return-hook vm) trace-return))
+
+(define (trace-next vm)
+  (define (puts x) (display #\tab) (write x))
+  (define (truncate! x n)
+    (if (> (length x) n)
+      (list-cdr-set! x (1- n) '(...))) x)
+  ;; main
+  (format #t "0x~8X  ~16S" (vm:ip vm) (vm-fetch-code vm))
+  (do ((opts (vm-option vm 'trace-options) (cdr opts)))
+      ((null? opts) (newline))
+    (case (car opts)
+      ((:s) (puts (truncate! (vm-fetch-stack vm) 3)))
+      ((:l) (puts (vm-fetch-locals vm))))))
+
+(define (trace-apply vm)
+  (if (vm-option vm 'trace-first)
+    (set-vm-option! vm 'trace-first #f)
+    (let ((chain (vm-current-frame-chain vm)))
+      (print-indent chain)
+      (print-frame-call (car chain))
+      (newline))))
+
+(define (trace-return vm)
+  (let ((chain (vm-current-frame-chain vm)))
+    (print-indent chain)
+    (write (vm-return-value vm))
+    (newline)))
+
+(define (print-indent chain)
+  (cond ((pair? (cdr chain))
+	 (display "| ")
+	 (print-indent (cdr chain)))))
diff --git a/module/system/vm/vm.scm b/module/system/vm/vm.scm
new file mode 100644
index 000000000..48dc4f2b8
--- /dev/null
+++ b/module/system/vm/vm.scm
@@ -0,0 +1,41 @@
+;;; Guile VM core
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; 
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; 
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(define-module (system vm vm)
+  #:use-module (system vm frame)
+  #:use-module (system vm program)
+  #:export (vm? the-vm make-vm vm-version
+            vm:ip vm:sp vm:fp vm:last-ip
+
+            vm-load vm-option set-vm-option! vm-version vm-stats
+            vms:time vms:clock
+
+            vm-trace-frame
+            vm-next-hook vm-apply-hook vm-boot-hook vm-return-hook
+            vm-break-hook vm-exit-hook vm-halt-hook vm-enter-hook))
+
+(load-extension "libguile" "scm_init_vm")
+
+(define (vms:time stat) (vector-ref stat 0))
+(define (vms:clock stat) (vector-ref stat 1))
+
+(define (vm-load vm objcode)
+  (vm (make-program objcode)))
diff --git a/module/system/xref.scm b/module/system/xref.scm
new file mode 100644
index 000000000..906ec8e4a
--- /dev/null
+++ b/module/system/xref.scm
@@ -0,0 +1,182 @@
+;;;; 	Copyright (C) 2009 Free Software Foundation, Inc.
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 2.1 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+;;;;
+
+
+(define-module (system xref)
+  #:use-module (system base pmatch)
+  #:use-module (system base compile)
+  #:use-module (system vm program)
+  #:use-module (srfi srfi-1)
+  #:export (*xref-ignored-modules*
+            procedure-callees
+            procedure-callers))
+
+(define (program-callee-rev-vars prog)
+  (define (cons-uniq x y)
+    (if (memq x y) y (cons x y)))
+  (cond
+   ((program-objects prog)
+    => (lambda (objects)
+          (let ((n (vector-length objects))
+                (progv (make-vector (vector-length objects) #f))
+                (asm (decompile (program-objcode prog) #:to 'assembly)))
+            (pmatch asm
+              ((load-program ,nargs ,nrest ,nlocs ,labels ,len . ,body)
+               (for-each
+                (lambda (x)
+                  (pmatch x
+                    ((toplevel-ref ,n) (vector-set! progv n #t))
+                    ((toplevel-set ,n) (vector-set! progv n #t))))
+                body)))
+            (let lp ((i 0) (out '()))
+              (cond
+               ((= i n) out)
+               ((program? (vector-ref objects i))
+                (lp (1+ i)
+                    (fold cons-uniq out
+                          (program-callee-rev-vars (vector-ref objects i)))))
+               ((vector-ref progv i)
+                (let ((obj (vector-ref objects i)))
+                  (if (variable? obj)
+                      (lp (1+ i) (cons-uniq obj out))
+                      ;; otherwise it's an unmemoized binding
+                      (pmatch obj
+                        (,sym (guard (symbol? sym))
+                         (let ((v (module-variable (or (program-module prog)
+                                                       the-root-module)
+                                                   sym)))
+                           (lp (1+ i) (if v (cons-uniq v out) out))))
+                        ((,mod ,sym ,public?)
+                         ;; hm, hacky.
+                         (let* ((m (nested-ref the-root-module
+                                               (append '(%app modules) mod)))
+                                (v (and m
+                                        (module-variable
+                                         (if public?
+                                             (module-public-interface m)
+                                             m)
+                                         sym))))
+                           (lp (1+ i)
+                               (if v (cons-uniq v out) out))))))))
+               (else (lp (1+ i) out)))))))
+   (else '())))
+
+(define (procedure-callee-rev-vars proc)
+  (cond
+   ((program? proc) (program-callee-rev-vars proc))
+   (else '())))
+
+(define (procedure-callees prog)
+  "Evaluates to a list of the given program callees."
+  (let lp ((in (procedure-callee-rev-vars prog)) (out '()))
+    (cond ((null? in) out)
+          ((variable-bound? (car in))
+           (lp (cdr in) (cons (variable-ref (car in)) out)))
+          (else (lp (cdr in) out)))))
+
+;; var -> ((module-name caller ...) ...)
+(define *callers-db* #f)
+;; module-name -> (callee ...)
+(define *module-callees-db* (make-hash-table))
+;; (module-name ...)
+(define *tainted-modules* '())
+
+(define *xref-ignored-modules* '((value-history)))
+(define (on-module-modified m)
+  (let ((name (module-name m)))
+    (if (and (not (member name *xref-ignored-modules*))
+             (not (member name *tainted-modules*))
+             (pair? name))
+        (set! *tainted-modules* (cons name *tainted-modules*)))))
+
+(define (add-caller callee caller mod-name)
+  (let ((all-callers (hashq-ref *callers-db* callee)))
+    (if (not all-callers)
+        (hashq-set! *callers-db* callee `((,mod-name ,caller)))
+        (let ((callers (assoc mod-name all-callers)))
+          (if callers
+              (if (not (member caller callers))
+                  (set-cdr! callers (cons caller (cdr callers))))
+              (hashq-set! *callers-db* callee
+                          (cons `(,mod-name ,caller) all-callers)))))))
+
+(define (forget-callers callee mod-name)
+  (hashq-set! *callers-db* callee
+             (assoc-remove! (hashq-ref *callers-db* callee '()) mod-name)))
+
+(define (add-callees callees mod-name)
+  (hash-set! *module-callees-db* mod-name
+             (append callees (hash-ref *module-callees-db* mod-name '()))))
+
+(define (untaint-modules)
+  (define (untaint m)
+    (for-each (lambda (callee) (forget-callers callee m))
+              (hash-ref *module-callees-db* m '()))
+    (ensure-callers-db m))
+  (ensure-callers-db #f)
+  (for-each untaint *tainted-modules*)
+  (set! *tainted-modules* '()))
+
+(define (ensure-callers-db mod-name)
+  (let ((mod (and mod-name (resolve-module mod-name)))
+        (visited #f))
+    (define (visit-variable var recurse mod-name)
+      (if (variable-bound? var)
+          (let ((x (variable-ref var)))
+            (cond
+             ((and visited (hashq-ref visited x)))
+             ((procedure? x)
+              (if visited (hashq-set! visited x #t))
+              (let ((callees (filter variable-bound?
+                                     (procedure-callee-rev-vars x))))
+                (for-each (lambda (callee)
+                            (add-caller callee x mod-name))
+                          callees)
+                (add-callees callees mod-name)))
+             ((and recurse (module? x))
+              (visit-module x #t))))))
+
+    (define (visit-module mod recurse)
+      (if visited (hashq-set! visited mod #t))
+      (if (not (memq on-module-modified (module-observers mod)))
+          (module-observe mod on-module-modified))
+      (let ((name (module-name mod)))
+        (module-for-each (lambda (sym var)
+                           (visit-variable var recurse name))
+                         mod)))
+
+    (cond ((and (not mod-name) (not *callers-db*))
+           (set! *callers-db* (make-hash-table 1000))
+           (set! visited (make-hash-table 1000))
+           (visit-module the-root-module #t))
+          (mod-name (visit-module mod #f)))))
+
+(define (procedure-callers var)
+  "Returns an association list, keyed by module name, of known callers
+of the given procedure. The latter can specified directly as a
+variable, a symbol (which gets resolved in the current module) or a
+pair of the form (module-name . variable-name), "
+  (let ((v (cond ((variable? var) var)
+                 ((symbol? var) (module-variable (current-module) var))
+                 (else
+                  (pmatch var
+                    ((,modname . ,sym)
+                     (module-variable (resolve-module modname) sym))
+                    (else
+                     (error "expected a variable, symbol, or (modname . sym)" var)))))))
+    (untaint-modules)
+    (hashq-ref *callers-db* v '())))
diff --git a/oop/Makefile.am b/oop/Makefile.am
deleted file mode 100644
index dcc20985c..000000000
--- a/oop/Makefile.am
+++ /dev/null
@@ -1,33 +0,0 @@
-## Process this file with automake to produce Makefile.in.
-##
-##  	Copyright (C) 2000, 2004, 2006, 2008 Free Software Foundation, Inc.
-##
-##   This file is part of GUILE.
-##   
-##   GUILE 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.
-##   
-##   GUILE is distributed in the hope that 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 GUILE; see the file COPYING.  If not, write
-##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-##   Floor, Boston, MA 02110-1301 USA
-
-AUTOMAKE_OPTIONS = gnu
-
-SUBDIRS = goops
-
-# These should be installed and distributed.
-oop_sources = goops.scm
-
-subpkgdatadir = $(pkgdatadir)/$(GUILE_EFFECTIVE_VERSION)/oop
-subpkgdata_DATA = $(oop_sources)
-TAGS_FILES = $(subpkgdata_DATA)
-
-EXTRA_DIST = $(oop_sources) ChangeLog-2008
diff --git a/oop/goops/Makefile.am b/oop/goops/Makefile.am
deleted file mode 100644
index 30b650d0a..000000000
--- a/oop/goops/Makefile.am
+++ /dev/null
@@ -1,34 +0,0 @@
-## Process this file with automake to produce Makefile.in.
-##
-##  	Copyright (C) 2000, 2001, 2004, 2005, 2006 Free Software Foundation, Inc.
-##
-##   This file is part of GUILE.
-##   
-##   GUILE 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.
-##   
-##   GUILE is distributed in the hope that 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 GUILE; see the file COPYING.  If not, write
-##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-##   Floor, Boston, MA 02110-1301 USA
-
-AUTOMAKE_OPTIONS = gnu
-
-# These should be installed and distributed.
-goops_sources =							\
-    active-slot.scm compile.scm composite-slot.scm describe.scm	\
-    dispatch.scm internal.scm save.scm stklos.scm util.scm      \
-    old-define-method.scm accessors.scm simple.scm
-
-subpkgdatadir = $(pkgdatadir)/$(GUILE_EFFECTIVE_VERSION)/oop/goops
-subpkgdata_DATA = $(goops_sources)
-TAGS_FILES = $(subpkgdata_DATA)
-
-EXTRA_DIST = $(goops_sources)
diff --git a/oop/goops/accessors.scm b/oop/goops/accessors.scm
deleted file mode 100644
index 1451f58ce..000000000
--- a/oop/goops/accessors.scm
+++ /dev/null
@@ -1,81 +0,0 @@
-;;;; 	Copyright (C) 1999, 2000, 2005, 2006 Free Software Foundation, Inc.
-;;;; 
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
-;;;; 
-;;;; This program is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
-;;;; 
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
-;;;; 
-
-
-(define-module (oop goops accessors)
-  :use-module (oop goops)
-  :re-export (standard-define-class)
-  :export (define-class-with-accessors
-	   define-class-with-accessors-keywords))
-
-(define define-class-with-accessors
-  (procedure->memoizing-macro
-   (lambda (exp env)
-     (let ((name (cadr exp))
-	   (supers (caddr exp))
-	   (slots (cdddr exp))
-	   (eat? #f))
-       `(standard-define-class ,name ,supers
-	  ,@(map-in-order
-	     (lambda (slot)
-	       (cond (eat?
-		      (set! eat? #f)
-		      slot)
-		     ((keyword? slot)
-		      (set! eat? #t)
-		      slot)
-		     ((pair? slot)
-		      (if (get-keyword #:accessor (cdr slot) #f)
-			  slot
-			  (let ((name (car slot)))
-			    `(,name #:accessor ,name ,@(cdr slot)))))
-		     (else
-		      `(,slot #:accessor ,slot))))
-	     slots))))))
-
-(define define-class-with-accessors-keywords
-  (procedure->memoizing-macro
-   (lambda (exp env)
-     (let ((name (cadr exp))
-	   (supers (caddr exp))
-	   (slots (cdddr exp))
-	   (eat? #f))
-       `(standard-define-class ,name ,supers
-	  ,@(map-in-order
-	     (lambda (slot)
-	       (cond (eat?
-		      (set! eat? #f)
-		      slot)
-		     ((keyword? slot)
-		      (set! eat? #t)
-		      slot)
-		     ((pair? slot)
-		      (let ((slot
-			     (if (get-keyword #:accessor (cdr slot) #f)
-				 slot
-				 (let ((name (car slot)))
-				   `(,name #:accessor ,name ,@(cdr slot))))))
-			(if (get-keyword #:init-keyword (cdr slot) #f)
-			    slot
-			    (let* ((name (car slot))
-				   (keyword (symbol->keyword name)))
-			      `(,name #:init-keyword ,keyword ,@(cdr slot))))))
-		     (else
-		      `(,slot #:accessor ,slot
-			      #:init-keyword ,(symbol->keyword slot)))))
-	     slots))))))
diff --git a/oop/goops/compile.scm b/oop/goops/compile.scm
deleted file mode 100644
index c0175a72a..000000000
--- a/oop/goops/compile.scm
+++ /dev/null
@@ -1,139 +0,0 @@
-;;;; 	Copyright (C) 1999, 2001, 2006 Free Software Foundation, Inc.
-;;;; 
-;;;; This library is free software; you can redistribute it and/or
-;;;; modify it under the terms of the GNU Lesser General Public
-;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
-;;;; 
-;;;; This library is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;;; Lesser General Public License for more details.
-;;;; 
-;;;; You should have received a copy of the GNU Lesser General Public
-;;;; License along with this library; if not, write to the Free Software
-;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-;;;; 
-
-
-(define-module (oop goops compile)
-  :use-module (oop goops)
-  :use-module (oop goops util)
-  :export (compute-cmethod compute-entry-with-cmethod
-	   compile-method cmethod-code cmethod-environment)
-  :no-backtrace
-  )
-
-(define source-formals cadr)
-(define source-body cddr)
-
-(define cmethod-code cdr)
-(define cmethod-environment car)
-
-
-;;;
-;;; Method entries
-;;;
-
-(define code-table-lookup
-  (letrec ((check-entry (lambda (entry types)
-			  (if (null? types)
-			      (and (not (struct? (car entry)))
-				   entry)
-			      (and (eq? (car entry) (car types))
-				   (check-entry (cdr entry) (cdr types)))))))
-    (lambda (code-table types)
-      (cond ((null? code-table) #f)
-	    ((check-entry (car code-table) types)
-	     => (lambda (cmethod)
-		  (cons (car code-table) cmethod)))
-	    (else (code-table-lookup (cdr code-table) types))))))
-
-(define (compute-entry-with-cmethod methods types)
-  (or (code-table-lookup (slot-ref (car methods) 'code-table) types)
-      (let* ((method (car methods))
-	     (place-holder (list #f))
-	     (entry (append types place-holder)))
-	;; In order to handle recursion nicely, put the entry
-	;; into the code-table before compiling the method 
-	(slot-set! (car methods) 'code-table
-		   (cons entry (slot-ref (car methods) 'code-table)))
-	(let ((cmethod (compile-method methods types)))
-	  (set-car! place-holder (car cmethod))
-	  (set-cdr! place-holder (cdr cmethod)))
-	(cons entry place-holder))))
-
-(define (compute-cmethod methods types)
-  (cdr (compute-entry-with-cmethod methods types)))
-
-;;;
-;;; Next methods
-;;;
-
-;;; Temporary solution---return #f if x doesn't refer to `next-method'.
-(define (next-method? x)
-  (and (pair? x)
-       (or (eq? (car x) 'next-method)
-	   (next-method? (car x))
-	   (next-method? (cdr x)))))
-
-(define (make-final-make-next-method method)
-  (lambda default-args
-    (lambda args
-      (@apply method (if (null? args) default-args args)))))	  
-
-(define (make-final-make-no-next-method gf)
-  (lambda default-args
-    (lambda args
-      (no-next-method gf (if (null? args) default-args args)))))
-
-(define (make-make-next-method vcell gf methods types)
-  (lambda default-args
-    (lambda args
-      (if (null? methods)
-	  (begin
-	    (set-cdr! vcell (make-final-make-no-next-method gf))
-	    (no-next-method gf (if (null? args) default-args args)))
-	  (let* ((cmethod (compute-cmethod methods types))
-		 (method (local-eval (cons 'lambda (cmethod-code cmethod))
-				     (cmethod-environment cmethod))))
-	    (set-cdr! vcell (make-final-make-next-method method))
-	    (@apply method (if (null? args) default-args args)))))))
-
-;;;
-;;; Method compilation
-;;;
-
-;;; NOTE: This section is far from finished.  It will finally be
-;;; implemented on C level.
-
-(define %tag-body
-  (nested-ref the-root-module '(app modules oop goops %tag-body)))
-
-(define (compile-method methods types)
-  (let* ((proc (method-procedure (car methods)))
-	 ;; XXX - procedure-source can not be guaranteed to be
-	 ;;       reliable or efficient
-	 (src (procedure-source proc)) 
-	 (formals (source-formals src))
-	 (body (source-body src)))
-    (if (next-method? body)
-	(let ((vcell (cons 'goops:make-next-method #f)))
-	  (set-cdr! vcell
-		    (make-make-next-method
-		     vcell
-		     (method-generic-function (car methods))
-		     (cdr methods) types))
-	  ;;*fixme*
-	  `(,(cons vcell (procedure-environment proc))
-	    ,formals
-	    ;;*fixme* Only do this on source where next-method can't be inlined
-	    (let ((next-method ,(if (list? formals)
-				    `(goops:make-next-method ,@formals)
-				    `(apply goops:make-next-method
-					    ,@(improper->proper formals)))))
-	      ,@body)))
-	(cons (procedure-environment proc)
-	      (cons formals
-		    (%tag-body body)))
-	)))
diff --git a/oop/goops/old-define-method.scm b/oop/goops/old-define-method.scm
deleted file mode 100644
index 3469dc9bb..000000000
--- a/oop/goops/old-define-method.scm
+++ /dev/null
@@ -1,60 +0,0 @@
-;;; installed-scm-file
-
-;;;; 	Copyright (C) 2001, 2006 Free Software Foundation, Inc.
-;;;; 
-;;;; This library is free software; you can redistribute it and/or
-;;;; modify it under the terms of the GNU Lesser General Public
-;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
-;;;; 
-;;;; This library is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;;; Lesser General Public License for more details.
-;;;; 
-;;;; You should have received a copy of the GNU Lesser General Public
-;;;; License along with this library; if not, write to the Free Software
-;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-;;;; 
-
-
-(define-module (oop goops old-define-method)
-  :use-module (oop goops)
-  :export (define-method)
-  :no-backtrace
-  )
-
-(define define-method
-  (procedure->memoizing-macro
-    (lambda (exp env)
-      (let ((name (cadr exp)))
-	(if (and (pair? name)
-		 (eq? (car name) 'setter)
-		 (pair? (cdr name))
-		 (symbol? (cadr name))
-		 (null? (cddr name)))
-	    (let ((name (cadr name)))
-	      (cond ((not (symbol? name))
-		     (goops-error "bad method name: ~S" name))
-		    ((defined? name env)
-		     `(begin
-			;; *fixme* Temporary hack for the current module system
-			(if (not ,name)
-			    (define-accessor ,name))
-			(add-method! (setter ,name) (method ,@(cddr exp)))))
-		    (else
-		     `(begin
-			(define-accessor ,name)
-			(add-method! (setter ,name) (method ,@(cddr exp)))))))
-	    (cond ((not (symbol? name))
-		   (goops-error "bad method name: ~S" name))
-		  ((defined? name env)
-		   `(begin
-		      ;; *fixme* Temporary hack for the current module system
-		      (if (not ,name)
-			  (define-generic ,name))
-		      (add-method! ,name (method ,@(cddr exp)))))
-		  (else
-		   `(begin
-		      (define-generic ,name)
-		      (add-method! ,name (method ,@(cddr exp)))))))))))
diff --git a/pre-inst-guile-env.in b/pre-inst-guile-env.in
deleted file mode 100644
index 5bf1e136a..000000000
--- a/pre-inst-guile-env.in
+++ /dev/null
@@ -1,81 +0,0 @@
-#!/bin/sh
-
-#	Copyright (C) 2003, 2006, 2008 Free Software Foundation
-#
-#   This file is part of GUILE.
-#
-# This script is free software; you can redistribute it and/or
-# modify it under the terms of the GNU Lesser General Public
-# License as published by the Free Software Foundation; either
-# version 2.1 of the License, or (at your option) any later version.
-#
-# This library is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-# Lesser General Public License for more details.
-#
-# You should have received a copy of the GNU Lesser General Public
-# License along with this library; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-
-# NOTE: If you update this file, please update pre-inst-guile.in as
-# well, if appropriate.
-
-# Usage: pre-inst-guile-env [ARGS]
-
-# This script arranges for the environment to support running Guile
-# from the build tree.  The following env vars are modified (but not
-# clobbered): GUILE_LOAD_PATH, LTDL_LIBRARY_PATH, and PATH.
-
-# Example: pre-inst-guile-env guile -c '(display "hello\n")'
-# Example: ../../pre-inst-guile-env ./guile-test-foo
-
-# config
-subdirs_with_ltlibs="srfi guile-readline"       # maintain me
-
-# env (set by configure)
-top_srcdir="@top_srcdir_absolute@"
-top_builddir="@top_builddir_absolute@"
-
-[ x"$top_srcdir"   = x -o ! -d "$top_srcdir" -o \
-  x"$top_builddir" = x -o ! -d "$top_builddir" ] && {
-    echo $0: bad environment
-    echo top_srcdir=$top_srcdir
-    echo top_builddir=$top_builddir
-    exit 1
-}
-
-if [ x"$GUILE_LOAD_PATH" = x ]
-then
-    GUILE_LOAD_PATH="${top_srcdir}/guile-readline:${top_srcdir}"
-else
-  for d in "${top_srcdir}" "${top_srcdir}/guile-readline"
-  do
-    # This hair prevents double inclusion.
-    # The ":" prevents prefix aliasing.
-    case x"$GUILE_LOAD_PATH" in
-      x*${d}:*) ;;
-      *) GUILE_LOAD_PATH="${d}:$GUILE_LOAD_PATH" ;;
-    esac
-  done
-fi
-export GUILE_LOAD_PATH
-
-# handle LTDL_LIBRARY_PATH (no clobber)
-ltdl_prefix=""
-dyld_prefix=""
-for dir in $subdirs_with_ltlibs ; do
-    ltdl_prefix="${top_builddir}/${dir}:${ltdl_prefix}"
-    dyld_prefix="${top_builddir}/${dir}/.libs:${dyld_prefix}"
-done
-LTDL_LIBRARY_PATH="${ltdl_prefix}$LTDL_LIBRARY_PATH"
-export LTDL_LIBRARY_PATH
-DYLD_LIBRARY_PATH="${dyld_prefix}${top_builddir}/libguile/.libs:$DYLD_LIBRARY_PATH"
-export DYLD_LIBRARY_PATH
-
-# handle PATH (no clobber)
-PATH="${top_builddir}/guile-config:${PATH}"
-PATH="${top_builddir}/libguile:${PATH}"
-export PATH
-
-exec "$@"
diff --git a/pre-inst-guile.in b/pre-inst-guile.in
deleted file mode 100644
index d210fdebc..000000000
--- a/pre-inst-guile.in
+++ /dev/null
@@ -1,99 +0,0 @@
-#!/bin/sh
-
-#	Copyright (C) 2002, 2006, 2008 Free Software Foundation
-#
-#   This file is part of GUILE.
-#
-#   GUILE 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.
-#
-#   GUILE is distributed in the hope that 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 GUILE; see the file COPYING.  If not, write
-#   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-#   Floor, Boston, MA 02110-1301 USA
-
-# NOTE: at some point we might consider invoking this under
-# pre-inst-guile-env.  If this will work, then most of the code below
-# can be removed.
-
-# NOTE: If you update this file, please update pre-inst-guile-env.in
-# as well, if appropriate.
-
-# Commentary:
-
-# Usage: pre-inst-guile [ARGS]
-#
-# This script arranges for the environment to support, and eventaully execs,
-# the uninstalled binary guile executable located somewhere under libguile/,
-# passing ARGS to it.  In the process, env var GUILE is clobbered, and the
-# following env vars are modified (but not clobbered):
-#   GUILE_LOAD_PATH
-#   LTDL_LIBRARY_PATH
-#
-# This script can be used as a drop-in replacement for $bindir/guile;
-# if there is a discrepency in behavior, that's a bug.
-
-# Code:
-
-# config
-subdirs_with_ltlibs="srfi guile-readline libguile" # maintain me
-
-# env (set by configure)
-top_srcdir="@top_srcdir_absolute@"
-top_builddir="@top_builddir_absolute@"
-
-[ x"$top_srcdir"   = x -o ! -d "$top_srcdir" -o \
-  x"$top_builddir" = x -o ! -d "$top_builddir" ] && {
-    echo $0: bad environment
-    echo top_srcdir=$top_srcdir
-    echo top_builddir=$top_builddir
-    exit 1
-}
-
-# handle GUILE_LOAD_PATH (no clobber)
-if [ x"$GUILE_LOAD_PATH" = x ]
-then
-    GUILE_LOAD_PATH="${top_srcdir}/guile-readline:${top_srcdir}"
-else
-  for d in "${top_srcdir}" "${top_srcdir}/guile-readline"
-  do
-    # This hair prevents double inclusion.
-    # The ":" prevents prefix aliasing.
-    case x"$GUILE_LOAD_PATH" in
-      x*${d}:*) ;;
-      *) GUILE_LOAD_PATH="${d}:$GUILE_LOAD_PATH" ;;
-    esac
-  done
-fi
-export GUILE_LOAD_PATH
-
-# handle LTDL_LIBRARY_PATH (no clobber)
-ltdl_prefix=""
-dyld_prefix=""
-for dir in $subdirs_with_ltlibs ; do
-    ltdl_prefix="${top_builddir}/${dir}:${ltdl_prefix}"
-    dyld_prefix="${top_builddir}/${dir}/.libs:${dyld_prefix}"
-done
-LTDL_LIBRARY_PATH="${ltdl_prefix}$LTDL_LIBRARY_PATH"
-export LTDL_LIBRARY_PATH
-DYLD_LIBRARY_PATH="${dyld_prefix}${top_builddir}/libguile/.libs:$DYLD_LIBRARY_PATH"
-export DYLD_LIBRARY_PATH
-
-# set GUILE (clobber)
-GUILE=${top_builddir}/libguile/guile
-export GUILE
-
-# do it
-exec $GUILE "$@"
-
-# never reached
-exit 1
-
-# pre-inst-guile ends here
diff --git a/qt/Makefile.am b/qt/Makefile.am
index fc9951d30..8a15fb6ff 100644
--- a/qt/Makefile.am
+++ b/qt/Makefile.am
@@ -4,20 +4,20 @@
 ##
 ##   This file is part of GUILE.
 ##   
-##   GUILE 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
+##   GUILE is free software; you can redistribute it and/or modify it
+##   under the terms of the GNU Lesser General Public License as
+##   published by the Free Software Foundation; either version 3, or
 ##   (at your option) any later version.
-##   
+##
 ##   GUILE is distributed in the hope that 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 GUILE; see the file COPYING.  If not, write
-##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-##   Floor, Boston, MA 02110-1301 USA
+##   GNU Lesser General Public License for more details.
+##
+##   You should have received a copy of the GNU Lesser General Public
+##   License along with GUILE; see the file COPYING.LESSER.  If not,
+##   write to the Free Software Foundation, Inc., 51 Franklin Street,
+##   Fifth Floor, Boston, MA 02110-1301 USA
 
 AUTOMAKE_OPTIONS = gnu
 
diff --git a/qt/md/Makefile.am b/qt/md/Makefile.am
index 7500dc66c..e5b29e96e 100644
--- a/qt/md/Makefile.am
+++ b/qt/md/Makefile.am
@@ -4,20 +4,20 @@
 ##
 ##   This file is part of GUILE.
 ##   
-##   GUILE 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
+##   GUILE is free software; you can redistribute it and/or modify it
+##   under the terms of the GNU Lesser General Public License as
+##   published by the Free Software Foundation; either version 3, or
 ##   (at your option) any later version.
-##   
+##
 ##   GUILE is distributed in the hope that 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 GUILE; see the file COPYING.  If not, write
-##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-##   Floor, Boston, MA 02110-1301 USA
+##   GNU Lesser General Public License for more details.
+##
+##   You should have received a copy of the GNU Lesser General Public
+##   License along with GUILE; see the file COPYING.LESSER.  If not,
+##   write to the Free Software Foundation, Inc., 51 Franklin Street,
+##   Fifth Floor, Boston, MA 02110-1301 USA
 
 AUTOMAKE_OPTIONS = gnu
 
diff --git a/qt/time/Makefile.am b/qt/time/Makefile.am
index 735620330..bdce61f38 100644
--- a/qt/time/Makefile.am
+++ b/qt/time/Makefile.am
@@ -4,20 +4,20 @@
 ##
 ##   This file is part of GUILE.
 ##   
-##   GUILE 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
+##   GUILE is free software; you can redistribute it and/or modify it
+##   under the terms of the GNU Lesser General Public License as
+##   published by the Free Software Foundation; either version 3, or
 ##   (at your option) any later version.
-##   
+##
 ##   GUILE is distributed in the hope that 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 GUILE; see the file COPYING.  If not, write
-##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-##   Floor, Boston, MA 02110-1301 USA
+##   GNU Lesser General Public License for more details.
+##
+##   You should have received a copy of the GNU Lesser General Public
+##   License along with GUILE; see the file COPYING.LESSER.  If not,
+##   write to the Free Software Foundation, Inc., 51 Franklin Street,
+##   Fifth Floor, Boston, MA 02110-1301 USA
 
 AUTOMAKE_OPTIONS = gnu
 
diff --git a/scripts/Makefile.am b/scripts/Makefile.am
deleted file mode 100644
index baf8ff46d..000000000
--- a/scripts/Makefile.am
+++ /dev/null
@@ -1,68 +0,0 @@
-## Process this file with automake to produce Makefile.in.
-##
-##  	Copyright (C) 2002, 2006, 2008 Free Software Foundation, Inc.
-##
-##   This file is part of GUILE.
-##
-##   GUILE 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.
-##
-##   GUILE is distributed in the hope that 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 GUILE; see the file COPYING.  If not, write
-##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-##   Floor, Boston, MA 02110-1301 USA
-
-AUTOMAKE_OPTIONS = gnu
-
-# These should be installed and distributed.
-scripts_sources =				\
-	PROGRAM					\
-	autofrisk				\
-	display-commentary			\
-	doc-snarf				\
-	frisk					\
-	generate-autoload			\
-	lint					\
-	punify					\
-	read-scheme-source			\
-	read-text-outline			\
-	use2dot					\
-	snarf-check-and-output-texi		\
-	summarize-guile-TODO			\
-	scan-api				\
-	api-diff				\
-	read-rfc822				\
-	snarf-guile-m4-docs
-
-subpkgdatadir = $(pkgdatadir)/$(GUILE_EFFECTIVE_VERSION)/scripts
-subpkgdata_SCRIPTS = $(scripts_sources)
-
-EXTRA_DIST = $(scripts_sources) ChangeLog-2008
-
-list:
-	@echo $(scripts_sources)
-
-include $(top_srcdir)/am/pre-inst-guile
-
-overview: $(scripts_sources)
-	@echo '----------------------------'
-	@echo Overview
-	@echo I. Commentaries
-	@echo II. Module Interfaces
-	@echo '----------------------------'
-	@echo I. Commentaries
-	@echo '----------------------------'
-	$(preinstguiletool)/display-commentary $^
-	@echo '----------------------------'
-	@echo II. Module Interfaces
-	@echo '----------------------------'
-	$(preinstguiletool)/frisk $^
-
-# Makefile.am ends here
diff --git a/srfi/Makefile.am b/srfi/Makefile.am
index 048898dce..648603007 100644
--- a/srfi/Makefile.am
+++ b/srfi/Makefile.am
@@ -4,20 +4,20 @@
 ##
 ##   This file is part of GUILE.
 ##
-##   GUILE 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
+##   GUILE is free software; you can redistribute it and/or modify it
+##   under the terms of the GNU Lesser General Public License as
+##   published by the Free Software Foundation; either version 3, or
 ##   (at your option) any later version.
 ##
 ##   GUILE is distributed in the hope that 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.
+##   GNU Lesser General Public License for more details.
 ##
-##   You should have received a copy of the GNU General Public
-##   License along with GUILE; see the file COPYING.  If not, write
-##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-##   Floor, Boston, MA 02110-1301 USA
+##   You should have received a copy of the GNU Lesser General Public
+##   License along with GUILE; see the file COPYING.LESSER.  If not,
+##   write to the Free Software Foundation, Inc., 51 Franklin Street,
+##   Fifth Floor, Boston, MA 02110-1301 USA
 
 AUTOMAKE_OPTIONS = gnu
 
@@ -64,32 +64,7 @@ libguile_srfi_srfi_60_v_@LIBGUILE_SRFI_SRFI_60_MAJOR@_la_LIBADD =	\
    $(top_builddir)/libguile/libguile.la $(top_builddir)/lib/libgnu.la
 libguile_srfi_srfi_60_v_@LIBGUILE_SRFI_SRFI_60_MAJOR@_la_LDFLAGS = -no-undefined -export-dynamic -version-info @LIBGUILE_SRFI_SRFI_60_INTERFACE@
 
-srfidir = $(datadir)/guile/$(GUILE_EFFECTIVE_VERSION)/srfi
-srfi_DATA = srfi-1.scm \
-            srfi-2.scm \
-	    srfi-4.scm \
-            srfi-6.scm \
-            srfi-8.scm \
-            srfi-9.scm \
-            srfi-10.scm \
-            srfi-11.scm \
-            srfi-13.scm \
-            srfi-14.scm \
-	    srfi-16.scm \
-            srfi-17.scm \
-            srfi-19.scm \
-            srfi-26.scm \
-            srfi-31.scm \
-            srfi-34.scm \
-	    srfi-35.scm \
-            srfi-37.scm \
-            srfi-39.scm \
-            srfi-60.scm \
-	    srfi-69.scm \
-	    srfi-88.scm
-
-EXTRA_DIST = $(srfi_DATA) ChangeLog-2008
-TAGS_FILES = $(srfi_DATA)
+EXTRA_DIST = ChangeLog-2008
 
 GUILE_SNARF = ../libguile/guile-snarf
 
diff --git a/srfi/srfi-1.c b/srfi/srfi-1.c
index dc218ab04..02f46fca0 100644
--- a/srfi/srfi-1.c
+++ b/srfi/srfi-1.c
@@ -4,18 +4,19 @@
  *   	Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 #ifdef HAVE_CONFIG_H
diff --git a/srfi/srfi-1.h b/srfi/srfi-1.h
index 936586697..5797579cc 100644
--- a/srfi/srfi-1.h
+++ b/srfi/srfi-1.h
@@ -5,18 +5,19 @@
  * 	Copyright (C) 2002, 2003, 2005, 2006 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/srfi/srfi-11.scm b/srfi/srfi-11.scm
deleted file mode 100644
index 9e17d6632..000000000
--- a/srfi/srfi-11.scm
+++ /dev/null
@@ -1,254 +0,0 @@
-;;; srfi-11.scm --- let-values and let*-values
-
-;; Copyright (C) 2000, 2001, 2002, 2004, 2006 Free Software Foundation, Inc.
-;;
-;; This library is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU Lesser General Public
-;; License as published by the Free Software Foundation; either
-;; version 2.1 of the License, or (at your option) any later version.
-;; 
-;; This library is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;; Lesser General Public License for more details.
-;; 
-;; You should have received a copy of the GNU Lesser General Public
-;; License along with this library; if not, write to the Free Software
-;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-
-;;; Commentary:
-
-;; This module exports two syntax forms: let-values and let*-values.
-;;
-;; Sample usage:
-;;
-;;   (let-values (((x y . z) (foo a b))
-;;                ((p q) (bar c)))
-;;     (baz x y z p q))
-;;
-;; This binds `x' and `y' to the first to values returned by `foo',
-;; `z' to the rest of the values from `foo', and `p' and `q' to the
-;; values returned by `bar'.  All of these are available to `baz'.
-;;
-;; let*-values : let-values :: let* : let
-;;
-;; This module is fully documented in the Guile Reference Manual.
-
-;;; Code:
-
-(define-module (srfi srfi-11)
-  :use-module (ice-9 syncase)
-  :export-syntax (let-values let*-values))
-
-(cond-expand-provide (current-module) '(srfi-11))
-
-;;;;;;;;;;;;;;
-;; let-values
-;;
-;; Current approach is to translate
-;;
-;;   (let-values (((x y . z) (foo a b))
-;;                ((p q) (bar c)))
-;;     (baz x y z p q))
-;;
-;; into
-;;
-;;   (call-with-values (lambda () (foo a b))
-;;     (lambda (<tmp-x> <tmp-y> . <tmp-z>)
-;;       (call-with-values (lambda () (bar c))
-;;         (lambda (<tmp-p> <tmp-q>)
-;;           (let ((x <tmp-x>)
-;;                 (y <tmp-y>)
-;;                 (z <tmp-z>)
-;;                 (p <tmp-p>)
-;;                 (q <tmp-q>))
-;;             (baz x y z p q))))))
-
-;; I originally wrote this as a define-macro, but then I found out
-;; that guile's gensym/gentemp was broken, so I tried rewriting it as
-;; a syntax-rules statement.
-;;     [make-symbol now fixes gensym/gentemp problems.]
-;;
-;; Since syntax-rules didn't seem powerful enough to implement
-;; let-values in one definition without exposing illegal syntax (or
-;; perhaps my brain's just not powerful enough :>).  I tried writing
-;; it using a private helper, but that didn't work because the
-;; let-values expands outside the scope of this module.  I wonder why
-;; syntax-rules wasn't designed to allow "private" patterns or
-;; similar...
-;;
-;; So in the end, I dumped the syntax-rules implementation, reproduced
-;; here for posterity, and went with the define-macro one below --
-;; gensym/gentemp's got to be fixed anyhow...
-;
-; (define-syntax let-values-helper
-;   (syntax-rules ()
-;     ;; Take the vars from one let binding (i.e. the (x y z) from ((x y
-;     ;; z) (values 1 2 3)) and turn it in to the corresponding (lambda
-;     ;; (<tmp-x> <tmp-y> <tmp-z>) ...) from above, keeping track of the
-;     ;; temps you create so you can use them later...
-;     ;;
-;     ;; I really don't fully understand why the (var-1 var-1) trick
-;     ;; works below, but basically, when all those (x x) bindings show
-;     ;; up in the final "let", syntax-rules forces a renaming.
-
-;     ((_ "consumer" () lambda-tmps final-let-bindings lv-bindings
-;         body ...)
-;      (lambda lambda-tmps
-;        (let-values-helper "cwv" lv-bindings final-let-bindings body ...)))
-
-;     ((_ "consumer" (var-1 var-2 ...) (lambda-tmp ...) final-let-bindings lv-bindings
-;         body ...)
-;      (let-values-helper "consumer"
-;                         (var-2 ...)
-;                         (lambda-tmp ... var-1)
-;                         ((var-1 var-1) . final-let-bindings)
-;                         lv-bindings
-;                         body ...))
-
-;     ((_ "cwv" () final-let-bindings body ...)
-;      (let final-let-bindings
-;          body ...))
-
-;     ((_ "cwv" ((vars-1 binding-1) other-bindings ...) final-let-bindings
-;         body ...)
-;      (call-with-values (lambda () binding-1)
-;        (let-values-helper "consumer"
-;                           vars-1
-;                           ()
-;                           final-let-bindings
-;                           (other-bindings ...)
-;                           body ...)))))
-;
-; (define-syntax let-values
-;   (syntax-rules ()
-;     ((let-values () body ...)
-;      (begin body ...))
-;     ((let-values (binding ...) body ...)
-;      (let-values-helper "cwv" (binding ...) () body ...))))
-;
-;
-; (define-syntax let-values
-;   (letrec-syntax ((build-consumer
-;                    ;; Take the vars from one let binding (i.e. the (x
-;                    ;; y z) from ((x y z) (values 1 2 3)) and turn it
-;                    ;; in to the corresponding (lambda (<tmp-x> <tmp-y>
-;                    ;; <tmp-z>) ...) from above.
-;                    (syntax-rules ()
-;                      ((_ () new-tmps tmp-vars () body ...)
-;                       (lambda new-tmps
-;                         body ...))
-;                      ((_ () new-tmps tmp-vars vars body ...)
-;                       (lambda new-tmps
-;                         (lv-builder vars tmp-vars body ...)))
-;                      ((_ (var-1 var-2 ...) new-tmps tmp-vars vars body ...)
-;                       (build-consumer (var-2 ...)
-;                                       (tmp-1 . new-tmps)
-;                                       ((var-1 tmp-1) . tmp-vars)
-;                                       bindings
-;                                       body ...))))
-;                   (lv-builder
-;                    (syntax-rules ()
-;                      ((_ () tmp-vars body ...)
-;                       (let tmp-vars
-;                           body ...))
-;                      ((_ ((vars-1 binding-1) (vars-2 binding-2) ...)
-;                          tmp-vars
-;                          body ...)
-;                       (call-with-values (lambda () binding-1)
-;                         (build-consumer vars-1
-;                                         ()
-;                                         tmp-vars
-;                                         ((vars-2 binding-2) ...)
-;                                         body ...))))))
-;
-;     (syntax-rules ()
-;       ((_ () body ...)
-;        (begin body ...))
-;       ((_ ((vars binding) ...) body ...)
-;        (lv-builder ((vars binding) ...) () body ...)))))
-
-(define-macro (let-values vars . body)
-
-  (define (map-1-dot proc elts)
-    ;; map over one optionally dotted (a b c . d) list, producing an
-    ;; optionally dotted result.
-    (cond
-     ((null? elts) '())
-     ((pair? elts) (cons (proc (car elts)) (map-1-dot proc (cdr elts))))
-     (else (proc elts))))
-
-  (define (undot-list lst)
-    ;; produce a non-dotted list from a possibly dotted list.
-    (cond
-     ((null? lst) '())
-     ((pair? lst) (cons (car lst) (undot-list (cdr lst))))
-     (else (list lst))))
-
-  (define (let-values-helper vars body prev-let-vars)
-    (let* ((var-binding (car vars))
-           (new-tmps (map-1-dot (lambda (sym) (make-symbol "let-values-var"))
-                                (car var-binding)))
-           (let-vars (map (lambda (sym tmp) (list sym tmp))
-                          (undot-list (car var-binding))
-                          (undot-list new-tmps))))
-
-      (if (null? (cdr vars))
-          `(call-with-values (lambda () ,(cadr var-binding))
-             (lambda ,new-tmps
-               (let ,(apply append let-vars prev-let-vars)
-                 ,@body)))
-          `(call-with-values (lambda () ,(cadr var-binding))
-             (lambda ,new-tmps
-               ,(let-values-helper (cdr vars) body
-                                   (cons let-vars prev-let-vars)))))))
-
-  (if (null? vars)
-      `(begin ,@body)
-      (let-values-helper vars body '())))
-
-;;;;;;;;;;;;;;
-;; let*-values
-;;
-;; Current approach is to translate
-;;
-;;   (let*-values (((x y z) (foo a b))
-;;                ((p q) (bar c)))
-;;     (baz x y z p q))
-;;
-;; into
-;;
-;;   (call-with-values (lambda () (foo a b))
-;;     (lambda (x y z)
-;;       (call-with-values (lambda (bar c))
-;;         (lambda (p q)
-;;           (baz x y z p q)))))
-
-(define-syntax let*-values
-  (syntax-rules ()
-    ((let*-values () body ...)
-     (begin body ...))
-    ((let*-values ((vars-1 binding-1) (vars-2 binding-2) ...) body ...)
-     (call-with-values (lambda () binding-1)
-       (lambda vars-1
-         (let*-values ((vars-2 binding-2) ...)
-           body ...))))))
-
-; Alternate define-macro implementation...
-;
-; (define-macro (let*-values vars . body)
-;   (define (let-values-helper vars body)
-;     (let ((var-binding (car vars)))
-;       (if (null? (cdr vars))
-;           `(call-with-values (lambda () ,(cadr var-binding))
-;              (lambda ,(car var-binding)
-;                ,@body))
-;           `(call-with-values (lambda () ,(cadr var-binding))
-;              (lambda ,(car var-binding)
-;                ,(let-values-helper (cdr vars) body))))))
-
-;   (if (null? vars)
-;       `(begin ,@body)
-;       (let-values-helper vars body)))
-
-;;; srfi-11.scm ends here
diff --git a/srfi/srfi-13.c b/srfi/srfi-13.c
index dd5ce9b15..61a960e5d 100644
--- a/srfi/srfi-13.c
+++ b/srfi/srfi-13.c
@@ -3,18 +3,19 @@
  * Copyright (C) 2001, 2004, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/srfi/srfi-13.h b/srfi/srfi-13.h
index 8007d565b..a110ffd6d 100644
--- a/srfi/srfi-13.h
+++ b/srfi/srfi-13.h
@@ -6,18 +6,19 @@
  * 	Copyright (C) 2001, 2004, 2006 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/srfi/srfi-14.c b/srfi/srfi-14.c
index 1a7297b82..9f6ad8bc0 100644
--- a/srfi/srfi-14.c
+++ b/srfi/srfi-14.c
@@ -3,18 +3,19 @@
  * Copyright (C) 2001, 2004, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 #ifdef HAVE_CONFIG_H
diff --git a/srfi/srfi-14.h b/srfi/srfi-14.h
index b1f4ae726..a793159c5 100644
--- a/srfi/srfi-14.h
+++ b/srfi/srfi-14.h
@@ -5,18 +5,19 @@
  * 	Copyright (C) 2001, 2004, 2006 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/srfi/srfi-4.c b/srfi/srfi-4.c
index f40c6b319..9b32b61a9 100644
--- a/srfi/srfi-4.c
+++ b/srfi/srfi-4.c
@@ -3,18 +3,19 @@
  * 	Copyright (C) 2001, 2004, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 /* This file is now empty since all its procedures are now in the
diff --git a/srfi/srfi-4.h b/srfi/srfi-4.h
index 079219ace..0439675da 100644
--- a/srfi/srfi-4.h
+++ b/srfi/srfi-4.h
@@ -5,18 +5,19 @@
  * 	Copyright (C) 2001, 2006 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/srfi/srfi-60.c b/srfi/srfi-60.c
index 7d89ca039..989898f9c 100644
--- a/srfi/srfi-60.c
+++ b/srfi/srfi-60.c
@@ -3,18 +3,19 @@
  * Copyright (C) 2005, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 #ifdef HAVE_CONFIG_H
diff --git a/srfi/srfi-60.h b/srfi/srfi-60.h
index 030b32525..47a8cf766 100644
--- a/srfi/srfi-60.h
+++ b/srfi/srfi-60.h
@@ -3,18 +3,19 @@
  * 	Copyright (C) 2005, 2006 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index 0940c13c2..476d6e688 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -4,27 +4,29 @@
 ##
 ## This file is part of GUILE.
 ##
-## GUILE 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.
+##   GUILE is free software; you can redistribute it and/or modify it
+##   under the terms of the GNU Lesser General Public License as
+##   published by the Free Software Foundation; either version 3, or
+##   (at your option) any later version.
 ##
-## GUILE is distributed in the hope that 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.
+##   GUILE is distributed in the hope that it will be useful, but
+##   WITHOUT ANY WARRANTY; without even the implied warranty of
+##   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+##   GNU Lesser General Public License for more details.
 ##
-## You should have received a copy of the GNU General Public
-## License along with GUILE; see the file COPYING.  If not, write
-## to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-## Floor, Boston, MA 02110-1301 USA
+##   You should have received a copy of the GNU Lesser General Public
+##   License along with GUILE; see the file COPYING.LESSER.  If not,
+##   write to the Free Software Foundation, Inc., 51 Franklin Street,
+##   Fifth Floor, Boston, MA 02110-1301 USA
 
 SUBDIRS = standalone
 
 SCM_TESTS = tests/alist.test			\
 	    tests/and-let-star.test		\
 	    tests/arbiters.test			\
+	    tests/asm-to-bytecode.test		\
 	    tests/bit-operations.test		\
+	    tests/bytevectors.test		\
 	    tests/c-api.test			\
 	    tests/chars.test			\
 	    tests/common-list.test		\
@@ -60,6 +62,7 @@ SCM_TESTS = tests/alist.test			\
 	    tests/q.test			\
 	    tests/r4rs.test			\
 	    tests/r5rs_pitfall.test		\
+	    tests/r6rs-ports.test		\
 	    tests/ramap.test			\
 	    tests/reader.test			\
 	    tests/receive.test			\
@@ -91,6 +94,7 @@ SCM_TESTS = tests/alist.test			\
 	    tests/syntax.test			\
 	    tests/threads.test			\
 	    tests/time.test			\
+	    tests/tree-il.test			\
 	    tests/unif.test			\
 	    tests/version.test			\
 	    tests/weaks.test
diff --git a/test-suite/guile-test b/test-suite/guile-test
index 1e1c70a77..65b0533c8 100755
--- a/test-suite/guile-test
+++ b/test-suite/guile-test
@@ -7,20 +7,20 @@
 ;;;;
 ;;;; 	Copyright (C) 1999, 2001, 2006 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 free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3, 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.
+;;;; GNU Lesser General Public License for more details.
 ;;;;
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this software; see the file COPYING.LESSER.
+;;;; If not, write to the Free Software Foundation, Inc., 51 Franklin
+;;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 
 ;;;; Usage: [guile -e main -s] guile-test [OPTIONS] [TEST ...]
diff --git a/test-suite/lib.scm b/test-suite/lib.scm
index c4ddf9e7c..e5b7a0813 100644
--- a/test-suite/lib.scm
+++ b/test-suite/lib.scm
@@ -1,20 +1,20 @@
 ;;;; test-suite/lib.scm --- generic support for testing
-;;;; Copyright (C) 1999, 2000, 2001, 2004, 2006, 2007 Free Software Foundation, Inc.
+;;;; Copyright (C) 1999, 2000, 2001, 2004, 2006, 2007, 2009 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 free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3, 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.
+;;;; GNU Lesser General Public License for more details.
 ;;;;
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this software; see the file COPYING.LESSER.
+;;;; If not, write to the Free Software Foundation, Inc., 51 Franklin
+;;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-suite lib)
   :use-module (ice-9 stack-catch)
@@ -32,6 +32,7 @@
  exception:system-error
  exception:miscellaneous-error
  exception:string-contains-nul
+ exception:read-error
 
  ;; Reporting passes and failures.
  run-test
@@ -45,6 +46,9 @@
  ;; Using the debugging evaluator.
  with-debugging-evaluator with-debugging-evaluator*
 
+;; Using a given locale
+with-locale with-locale*
+
  ;; Reporting results in various ways.
  register-reporter unregister-reporter reporter-registered?
  make-count-reporter print-counts
@@ -265,6 +269,8 @@
   (cons 'system-error ".*"))
 (define exception:miscellaneous-error
   (cons 'misc-error "^.*"))
+(define exception:read-error
+  (cons 'read-error "^.*$"))
 
 ;; as per throw in scm_to_locale_stringn()
 (define exception:string-contains-nul
@@ -317,20 +323,24 @@
   (set! run-test local-run-test))
 
 ;;; A short form for tests that are expected to pass, taken from Greg.
-(defmacro pass-if (name . rest)
-  (if (and (null? rest) (pair? name))
-      ;; presume this is a simple test, i.e. (pass-if (even? 2))
-      ;; where the body should also be the name.
-      `(run-test ',name #t (lambda () ,name))
-      `(run-test ,name #t (lambda () ,@rest))))
+(define-syntax pass-if
+  (syntax-rules ()
+    ((_ name)
+     ;; presume this is a simple test, i.e. (pass-if (even? 2))
+     ;; where the body should also be the name.
+     (run-test 'name #t (lambda () name)))
+    ((_ name rest ...)
+     (run-test name #t (lambda () rest ...)))))
 
 ;;; A short form for tests that are expected to fail, taken from Greg.
-(defmacro expect-fail (name . rest)
-  (if (and (null? rest) (pair? name))
-      ;; presume this is a simple test, i.e. (expect-fail (even? 2))
-      ;; where the body should also be the name.
-      `(run-test ',name #f (lambda () ,name))
-      `(run-test ,name #f (lambda () ,@rest))))
+(define-syntax expect-fail
+  (syntax-rules ()
+    ((_ name)
+     ;; presume this is a simple test, i.e. (expect-fail (even? 2))
+     ;; where the body should also be the name.
+     (run-test 'name #f (lambda () name)))
+    ((_ name rest ...)
+     (run-test name #f (lambda () rest ...)))))
 
 ;;; A helper function to implement the macros that test for exceptions.
 (define (run-test-exception name exception expect-pass thunk)
@@ -362,12 +372,16 @@
             (apply throw key proc message rest))))))))
 
 ;;; A short form for tests that expect a certain exception to be thrown.
-(defmacro pass-if-exception (name exception body . rest)
-  `(,run-test-exception ,name ,exception #t (lambda () ,body ,@rest)))
+(define-syntax pass-if-exception
+  (syntax-rules ()
+    ((_ name exception body rest ...)
+     (run-test-exception name exception #t (lambda () body rest ...)))))
 
 ;;; A short form for tests expected to fail to throw a certain exception.
-(defmacro expect-fail-exception (name exception body . rest)
-  `(,run-test-exception ,name ,exception #f (lambda () ,body ,@rest)))
+(define-syntax expect-fail-exception
+  (syntax-rules ()
+    ((_ name exception body rest ...)
+     (run-test-exception name exception #f (lambda () body rest ...)))))
 
 
 ;;;; TEST NAMES
@@ -426,6 +440,26 @@
 (define-macro (with-debugging-evaluator . body)
   `(with-debugging-evaluator* (lambda () ,@body)))
 
+;;; Call THUNK with a given locale
+(define (with-locale* nloc thunk)
+  (let ((loc #f))
+    (dynamic-wind
+	(lambda ()
+          (if (defined? 'setlocale)
+              (begin
+                (set! loc 
+                      (false-if-exception (setlocale LC_ALL nloc)))
+                (if (not loc)
+                    (throw 'unresolved)))
+              (throw 'unresolved)))
+	thunk
+	(lambda ()
+          (if (defined? 'setlocale)
+              (setlocale LC_ALL loc))))))
+
+;;; Evaluate BODY... using the given locale.
+(define-macro (with-locale loc . body)
+  `(with-locale* ,loc (lambda () ,@body)))
 
 
 ;;;; REPORTERS
diff --git a/test-suite/standalone/.gitignore b/test-suite/standalone/.gitignore
index df1ad7028..9dadde6e2 100644
--- a/test-suite/standalone/.gitignore
+++ b/test-suite/standalone/.gitignore
@@ -9,3 +9,4 @@
 /test-scm-with-guile
 /test-scm-c-read
 /test-fast-slot-ref
+/test-scm-take-locale-symbol
diff --git a/test-suite/standalone/Makefile.am b/test-suite/standalone/Makefile.am
index cc8b58871..488eb1453 100644
--- a/test-suite/standalone/Makefile.am
+++ b/test-suite/standalone/Makefile.am
@@ -1,23 +1,23 @@
 ## Process this file with automake to produce Makefile.in.
 ##
-## Copyright 2003, 2004, 2005, 2006, 2007, 2008 Software Foundation, Inc.
+## Copyright 2003, 2004, 2005, 2006, 2007, 2008, 2009 Software Foundation, Inc.
 ##
 ## This file is part of GUILE.
 ##
-## GUILE 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.
+##   GUILE is free software; you can redistribute it and/or modify it
+##   under the terms of the GNU Lesser General Public License as
+##   published by the Free Software Foundation; either version 3, or
+##   (at your option) any later version.
 ##
-## GUILE is distributed in the hope that 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.
+##   GUILE is distributed in the hope that it will be useful, but
+##   WITHOUT ANY WARRANTY; without even the implied warranty of
+##   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+##   GNU Lesser General Public License for more details.
 ##
-## You should have received a copy of the GNU General Public
-## License along with GUILE; see the file COPYING.  If not, write
-## to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-## Floor, Boston, MA 02110-1301 USA
+##   You should have received a copy of the GNU Lesser General Public
+##   License along with GUILE; see the file COPYING.LESSER.  If not,
+##   write to the Free Software Foundation, Inc., 51 Franklin Street,
+##   Fifth Floor, Boston, MA 02110-1301 USA
 
 
 # initializations so we can use += below.
@@ -28,19 +28,23 @@ check_SCRIPTS =
 BUILT_SOURCES =
 EXTRA_DIST =
 
-TESTS_ENVIRONMENT = "${top_builddir}/pre-inst-guile-env"
+TESTS_ENVIRONMENT =						\
+  GUILE_AUTO_COMPILE=0 "${top_builddir}/meta/uninstalled-env"
+
+## Check for headers in $(srcdir) and bulid dir before $(CPPFLAGS), which
+## may point us to an old, installed version of guile.
+AM_CPPFLAGS = -I$(top_srcdir) -I$(top_builddir) \
+	      -I$(top_srcdir)/lib -I$(top_builddir)/lib
 
 test_cflags =					\
-  -I$(top_srcdir)/test-suite/standalone		\
-  -I$(top_srcdir) -I$(top_builddir)		\
-  -I$(top_srcdir)/lib -I$(top_builddir)/lib	\
+  -I$(top_srcdir)/test-suite/standalone -I.	\
   $(EXTRA_DEFS) $(GUILE_CFLAGS) $(GCC_CFLAGS)
 
 AM_LDFLAGS = $(GUILE_CFLAGS)
 
-snarfcppopts =								\
-  $(DEFS) $(DEFAULT_INCLUDES) $(CPPFLAGS) $(CFLAGS) -I$(top_srcdir)	\
-  -I$(top_srcdir)/lib -I$(top_builddir)/lib -I$(top_builddir)
+snarfcppopts =								      \
+  -I$(top_srcdir) -I$(top_srcdir)/lib -I$(top_builddir)/lib -I$(top_builddir) \
+  -I. $(DEFS) $(DEFAULT_INCLUDES) $(CPPFLAGS) $(CFLAGS)
 
 SUFFIXES = .x
 .c.x:
@@ -118,6 +122,23 @@ test_scm_c_read_LDADD = ${top_builddir}/libguile/libguile.la
 check_PROGRAMS += test-scm-c-read
 TESTS += test-scm-c-read
 
+# test-scm-take-locale-symbol
+test_scm_take_locale_symbol_SOURCES = test-scm-take-locale-symbol.c
+test_scm_take_locale_symbol_CFLAGS = ${test_cflags}
+test_scm_take_locale_symbol_LDADD = ${top_builddir}/libguile/libguile.la
+check_PROGRAMS += test-scm-take-locale-symbol
+TESTS += test-scm-take-locale-symbol
+
+# test-extensions
+noinst_LTLIBRARIES += libtest-extensions.la
+libtest_extensions_la_SOURCES = test-extensions-lib.c
+libtest_extensions_la_CFLAGS = ${test_cflags}
+libtest_extensions_la_LDFLAGS = -no-undefined -rpath `pwd` # so libtool will really build an .so
+libtest_extensions_la_LIBADD = ${top_builddir}/libguile/libguile.la
+check_SCRIPTS += test-extensions
+TESTS += test-extensions
+
+
 if BUILD_PTHREAD_SUPPORT
 
 # test-with-guile-module
@@ -137,7 +158,4 @@ EXTRA_DIST += test-with-guile-module.c test-scm-with-guile.c
 
 endif
 
-all-local:
-	cd ${srcdir} && chmod u+x ${check_SCRIPTS}
-
 EXTRA_DIST += ${check_SCRIPTS}
diff --git a/test-suite/standalone/README b/test-suite/standalone/README
index 4e0bd652e..164c6ab46 100644
--- a/test-suite/standalone/README
+++ b/test-suite/standalone/README
@@ -12,7 +12,7 @@ If you want to use a scheme script, prefix it as follows:
   !#
 
 Makefile.am will arrange for all tests (scripts or executables) to be
-run under pre-inst-guile-env so that the PATH, LD_LIBRARY_PATH, and
+run under uninstalled-env so that the PATH, LD_LIBRARY_PATH, and
 GUILE_LOAD_PATH will be augmented appropriately.
 
 The Makefile.am has an example of creating a shared library to be used
diff --git a/test-suite/standalone/test-asmobs-lib.c b/test-suite/standalone/test-asmobs-lib.c
index b85f923cd..c88556ab2 100644
--- a/test-suite/standalone/test-asmobs-lib.c
+++ b/test-suite/standalone/test-asmobs-lib.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1999,2000,2001,2003, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 #ifndef HAVE_CONFIG_H
diff --git a/test-suite/standalone/test-conversion.c b/test-suite/standalone/test-conversion.c
index 92835f244..0dfa80a23 100644
--- a/test-suite/standalone/test-conversion.c
+++ b/test-suite/standalone/test-conversion.c
@@ -1,18 +1,19 @@
-/* Copyright (C) 1999,2000,2001,2003,2004, 2006, 2007, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1999,2000,2001,2003,2004, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 #if HAVE_CONFIG_H
@@ -680,31 +681,31 @@ test_8u (const char *str, scm_t_uintmax (*func) (SCM), const char *func_name,
 #define DEFSTST(f) static scm_t_intmax  tst_##f (SCM x) { return f(x); }
 #define DEFUTST(f) static scm_t_uintmax tst_##f (SCM x) { return f(x); }
 
-DEFSTST (scm_to_schar);
-DEFUTST (scm_to_uchar);
-DEFSTST (scm_to_char);
-DEFSTST (scm_to_short);
-DEFUTST (scm_to_ushort);
-DEFSTST (scm_to_int);
-DEFUTST (scm_to_uint);
-DEFSTST (scm_to_long);
-DEFUTST (scm_to_ulong);
+DEFSTST (scm_to_schar)
+DEFUTST (scm_to_uchar)
+DEFSTST (scm_to_char)
+DEFSTST (scm_to_short)
+DEFUTST (scm_to_ushort)
+DEFSTST (scm_to_int)
+DEFUTST (scm_to_uint)
+DEFSTST (scm_to_long)
+DEFUTST (scm_to_ulong)
 #if SCM_SIZEOF_LONG_LONG != 0
-DEFSTST (scm_to_long_long);
-DEFUTST (scm_to_ulong_long);
+DEFSTST (scm_to_long_long)
+DEFUTST (scm_to_ulong_long)
 #endif
-DEFSTST (scm_to_ssize_t);
-DEFUTST (scm_to_size_t);
-
-DEFSTST (scm_to_int8);
-DEFUTST (scm_to_uint8);
-DEFSTST (scm_to_int16);
-DEFUTST (scm_to_uint16);
-DEFSTST (scm_to_int32);
-DEFUTST (scm_to_uint32);
+DEFSTST (scm_to_ssize_t)
+DEFUTST (scm_to_size_t)
+
+DEFSTST (scm_to_int8)
+DEFUTST (scm_to_uint8)
+DEFSTST (scm_to_int16)
+DEFUTST (scm_to_uint16)
+DEFSTST (scm_to_int32)
+DEFUTST (scm_to_uint32)
 #ifdef SCM_HAVE_T_INT64
-DEFSTST (scm_to_int64);
-DEFUTST (scm_to_uint64);
+DEFSTST (scm_to_int64)
+DEFUTST (scm_to_uint64)
 #endif
 
 #define TEST_8S(v,f,r,re,te) test_8s (v, tst_##f, #f, r, re, te)
@@ -818,15 +819,60 @@ test_9 (double val, const char *result)
     }
 }
 
+/* The `infinity' and `not-a-number' values.  */
+static double guile_Inf, guile_NaN;
+
+/* Initialize GUILE_INF and GUILE_NAN.  Taken from `guile_ieee_init ()' in
+   `libguile/numbers.c'.  */
+static void
+ieee_init (void)
+{
+#ifdef INFINITY
+  /* C99 INFINITY, when available.
+     FIXME: The standard allows for INFINITY to be something that overflows
+     at compile time.  We ought to have a configure test to check for that
+     before trying to use it.  (But in practice we believe this is not a
+     problem on any system guile is likely to target.)  */
+  guile_Inf = INFINITY;
+#elif HAVE_DINFINITY
+  /* OSF */
+  extern unsigned int DINFINITY[2];
+  guile_Inf = (*((double *) (DINFINITY)));
+#else
+  double tmp = 1e+10;
+  guile_Inf = tmp;
+  for (;;)
+    {
+      guile_Inf *= 1e+10;
+      if (guile_Inf == tmp)
+	break;
+      tmp = guile_Inf;
+    }
+#endif
+
+#ifdef NAN
+  /* C99 NAN, when available */
+  guile_NaN = NAN;
+#elif HAVE_DQNAN
+  {
+    /* OSF */
+    extern unsigned int DQNAN[2];
+    guile_NaN = (*((double *)(DQNAN)));
+  }
+#else
+  guile_NaN = guile_Inf / guile_Inf;
+#endif
+}
+
 static void
 test_from_double ()
 {
   test_9 (12, "12.0");
   test_9 (0.25, "0.25");
   test_9 (0.1, "0.1");
-  test_9 (1.0/0.0, "+inf.0");
-  test_9 (-1.0/0.0, "-inf.0");
-  test_9 (0.0/0.0, "+nan.0");
+  test_9 (guile_Inf, "+inf.0");
+  test_9 (-guile_Inf, "-inf.0");
+  test_9 (guile_NaN, "+nan.0");
 }
 
 typedef struct {
@@ -880,8 +926,8 @@ test_to_double ()
   test_10 ("12",         12.0,  0);
   test_10 ("0.25",       0.25,  0);
   test_10 ("1/4",        0.25,  0);
-  test_10 ("+inf.0",  1.0/0.0,  0);
-  test_10 ("-inf.0", -1.0/0.0,  0);
+  test_10 ("+inf.0", guile_Inf, 0);
+  test_10 ("-inf.0",-guile_Inf, 0);
   test_10 ("+1i",         0.0,  1);
 }
 
@@ -1056,6 +1102,7 @@ tests (void *data, int argc, char **argv)
 int
 main (int argc, char *argv[])
 {
+  ieee_init ();
   scm_boot_guile (argc, argv, tests, NULL);
   return 0;
 }
diff --git a/test-suite/standalone/test-extensions b/test-suite/standalone/test-extensions
new file mode 100755
index 000000000..bea432de2
--- /dev/null
+++ b/test-suite/standalone/test-extensions
@@ -0,0 +1,14 @@
+#!/bin/sh
+exec guile -q -s "$0" "$@"
+!#
+
+(load-extension "libtest-extensions" "libtest_extensions_init")
+(load-extension "libtest-extensions" "libtest_extensions_init2")
+
+(or (= init2-count 1)
+    (error "init2 called more or less than one time"))
+
+
+;; Local Variables:
+;; mode: scheme
+;; End:
\ No newline at end of file
diff --git a/test-suite/standalone/test-extensions-lib.c b/test-suite/standalone/test-extensions-lib.c
new file mode 100644
index 000000000..7c8678895
--- /dev/null
+++ b/test-suite/standalone/test-extensions-lib.c
@@ -0,0 +1,44 @@
+/* Copyright (C) 1999,2000,2001,2003, 2006, 2008 Free Software Foundation, Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+#ifndef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <libguile.h>
+
+SCM init2_count;
+
+void libtest_extensions_init2 (void);
+void libtest_extensions_init (void);
+
+void
+libtest_extensions_init2 (void)
+{
+  scm_variable_set_x (init2_count,
+                      scm_from_int (scm_to_int (scm_variable_ref (init2_count)) + 1));
+}
+
+void
+libtest_extensions_init (void)
+{
+  scm_c_define ("init2-count", scm_from_int (0));
+  init2_count = scm_permanent_object (scm_c_lookup ("init2-count"));
+  scm_c_register_extension ("libtest-extensions", "libtest_extensions_init2",
+                            (scm_t_extension_init_func)libtest_extensions_init2, NULL);
+}
diff --git a/test-suite/standalone/test-fast-slot-ref.in b/test-suite/standalone/test-fast-slot-ref.in
index 5bd063876..e0708ab9d 100644
--- a/test-suite/standalone/test-fast-slot-ref.in
+++ b/test-suite/standalone/test-fast-slot-ref.in
@@ -2,19 +2,20 @@
 
 # Copyright (C) 2006 Free Software Foundation, Inc.
 #
-# This library is free software; you can redistribute it and/or modify it
-# under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at
-# your option) any later version.
+# This library is free software; you can redistribute it and/or
+# modify it under the terms of the GNU Lesser General Public License
+# as published by the Free Software Foundation; either version 3 of
+# the License, or (at your option) any later version.
 #
 # This library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# Lesser General Public License for more details.
 #
-# You should have received a copy of the GNU Lesser General Public License
-# along with this library; if not, write to the Free Software Foundation,
-# Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+# You should have received a copy of the GNU Lesser General Public
+# License along with this library; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 USA
 
 # Test for %fast-slot-ref, which was previously implemented such that
 # an out-of-range slot index could escape being properly detected, and
@@ -25,7 +26,7 @@
 # executing the (%fast-slot-ref i 3) line.  For reasons as yet
 # unknown, it does not cause a segmentation fault if the same code is
 # loaded as a script; that is why we run it here using "guile -q <<EOF".
-exec guile -q -l @top_builddir_absolute@/libguile/stack-limit-calibration.scm >/dev/null 2>&1 <<EOF
+exec guile -q >/dev/null 2>&1 <<EOF
 (use-modules (oop goops))
 (define-module (oop goops))
 (define-class <c> () (a #:init-value 1) (b #:init-value 2) (c #:init-value 3))
diff --git a/test-suite/standalone/test-list.c b/test-suite/standalone/test-list.c
index 02634f676..824463447 100644
--- a/test-suite/standalone/test-list.c
+++ b/test-suite/standalone/test-list.c
@@ -3,18 +3,19 @@
 /* Copyright (C) 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 #ifndef HAVE_CONFIG_H
diff --git a/test-suite/standalone/test-num2integral.c b/test-suite/standalone/test-num2integral.c
index 1e8a016d5..8b69b071d 100644
--- a/test-suite/standalone/test-num2integral.c
+++ b/test-suite/standalone/test-num2integral.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 1999,2000,2001,2003,2004, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 #ifndef HAVE_CONFIG_H
diff --git a/test-suite/standalone/test-round.c b/test-suite/standalone/test-round.c
index 9725491c9..862e7d0fd 100644
--- a/test-suite/standalone/test-round.c
+++ b/test-suite/standalone/test-round.c
@@ -1,18 +1,19 @@
-/* Copyright (C) 2004, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 2004, 2006, 2008, 2009 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 #if HAVE_CONFIG_H
@@ -25,6 +26,13 @@
 
 #if HAVE_FENV_H
 #include <fenv.h>
+#elif defined HAVE_MACHINE_FPU_H
+/* On Tru64 5.1b, the declaration of fesetround(3) is in <machine/fpu.h>.
+   On NetBSD, this header has to be included along with <sys/types.h>.  */
+# ifdef HAVE_SYS_TYPES_H
+#  include <sys/types.h>
+# endif
+# include <machine/fpu.h>
 #endif
 
 #include <libguile.h>
diff --git a/test-suite/standalone/test-scm-c-read.c b/test-suite/standalone/test-scm-c-read.c
index 1b4caa1c7..4111cd0f5 100644
--- a/test-suite/standalone/test-scm-c-read.c
+++ b/test-suite/standalone/test-scm-c-read.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 /* Exercise `scm_c_read ()' and the port type API.  Verify assumptions that
diff --git a/test-suite/standalone/test-scm-take-locale-symbol.c b/test-suite/standalone/test-scm-take-locale-symbol.c
new file mode 100644
index 000000000..808068fbf
--- /dev/null
+++ b/test-suite/standalone/test-scm-take-locale-symbol.c
@@ -0,0 +1,64 @@
+/* Copyright (C) 2009 Free Software Foundation, Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+/* Exercise `scm_take_locale_symbol ()', making sure it returns an interned
+   symbol.  See https://savannah.gnu.org/bugs/index.php?25865 .  */
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <libguile.h>
+
+#include <stdlib.h>
+#include <string.h>
+
+
+static void *
+do_test (void *result)
+{
+  SCM taken_sym, sym;
+
+  taken_sym = scm_take_locale_symbol (strdup ("some random symbol"));
+  sym = scm_from_locale_symbol ("some random symbol");
+
+  if (scm_is_true (scm_symbol_p (sym))
+      && scm_is_true (scm_symbol_p (taken_sym))
+
+      /* Relying solely on `scm_symbol_interned_p ()' is insufficient since
+	 it doesn't reflect the actual state of the symbol hashtable, hence
+	 the additional `scm_is_eq' test.  */
+      && scm_is_true (scm_symbol_interned_p (sym))
+      && scm_is_true (scm_symbol_interned_p (taken_sym))
+      && scm_is_eq (taken_sym, sym))
+    * (int *) result = EXIT_SUCCESS;
+  else
+    * (int *) result = EXIT_FAILURE;
+
+  return NULL;
+}
+
+int
+main (int argc, char *argv[])
+{
+  int result;
+
+  scm_with_guile (do_test, &result);
+
+  return result;
+}
diff --git a/test-suite/standalone/test-scm-with-guile.c b/test-suite/standalone/test-scm-with-guile.c
index 7fe16b351..a78458e6c 100644
--- a/test-suite/standalone/test-scm-with-guile.c
+++ b/test-suite/standalone/test-scm-with-guile.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
diff --git a/test-suite/standalone/test-unwind.c b/test-suite/standalone/test-unwind.c
index 472887abe..2b0291dd5 100644
--- a/test-suite/standalone/test-unwind.c
+++ b/test-suite/standalone/test-unwind.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 2004, 2005, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 #if HAVE_CONFIG_H
diff --git a/test-suite/standalone/test-use-srfi.in b/test-suite/standalone/test-use-srfi.in
index 57f84afe4..ab9d5cd5e 100755
--- a/test-suite/standalone/test-use-srfi.in
+++ b/test-suite/standalone/test-use-srfi.in
@@ -2,24 +2,25 @@
 
 # Copyright (C) 2006 Free Software Foundation, Inc.
 #
-# This library is free software; you can redistribute it and/or modify it
-# under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at
-# your option) any later version.
+# This library is free software; you can redistribute it and/or
+# modify it under the terms of the GNU Lesser General Public License
+# as published by the Free Software Foundation; either version 3 of
+# the License, or (at your option) any later version.
 #
 # This library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# Lesser General Public License for more details.
 #
-# You should have received a copy of the GNU Lesser General Public License
-# along with this library; if not, write to the Free Software Foundation,
-# Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+# You should have received a copy of the GNU Lesser General Public
+# License along with this library; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 USA
 
 
 # Test that two srfi numbers on the command line work.
 #
-guile -q -l @top_builddir_absolute@/libguile/stack-limit-calibration.scm --use-srfi=1,10 >/dev/null <<EOF
+guile -q --use-srfi=1,10 >/dev/null <<EOF
 (if (and (defined? 'partition)
          (defined? 'define-reader-ctor))
     (exit 0)   ;; good
@@ -38,7 +39,7 @@ fi
 # `top-repl' the core bindings got ahead of anything --use-srfi gave.
 #
 
-guile -q -l @top_builddir_absolute@/libguile/stack-limit-calibration.scm --use-srfi=1 >/dev/null <<EOF
+guile -q --use-srfi=1 >/dev/null <<EOF
 (catch #t
   (lambda ()
     (iota 2 3 4))
@@ -56,7 +57,7 @@ fi
 # exercises duplicates handling in `top-repl' versus `use-srfis' (in
 # boot-9.scm).
 #
-guile -q -l @top_builddir_absolute@/libguile/stack-limit-calibration.scm --use-srfi=17 >/dev/null <<EOF
+guile -q --use-srfi=17 >/dev/null <<EOF
 (if (procedure-with-setter? car)
     (exit 0)   ;; good
     (exit 1))  ;; bad
diff --git a/test-suite/standalone/test-with-guile-module.c b/test-suite/standalone/test-with-guile-module.c
index babc22b22..154f4f23f 100644
--- a/test-suite/standalone/test-with-guile-module.c
+++ b/test-suite/standalone/test-with-guile-module.c
@@ -1,18 +1,19 @@
 /* Copyright (C) 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 #ifndef HAVE_CONFIG_H
diff --git a/test-suite/tests/alist.test b/test-suite/tests/alist.test
index a9e9b0d24..699c10ef4 100644
--- a/test-suite/tests/alist.test
+++ b/test-suite/tests/alist.test
@@ -4,7 +4,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/test-suite/tests/and-let-star.test b/test-suite/tests/and-let-star.test
index 0f74934f7..150600c34 100644
--- a/test-suite/tests/and-let-star.test
+++ b/test-suite/tests/and-let-star.test
@@ -2,20 +2,19 @@
 ;;;;
 ;;;; Copyright (C) 2004, 2006 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,
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-suite test-and-let-star)
   #:use-module (test-suite lib)
diff --git a/test-suite/tests/arbiters.test b/test-suite/tests/arbiters.test
index 7591f02f0..36dc7edbd 100644
--- a/test-suite/tests/arbiters.test
+++ b/test-suite/tests/arbiters.test
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/test-suite/tests/asm-to-bytecode.test b/test-suite/tests/asm-to-bytecode.test
new file mode 100644
index 000000000..a8e251b83
--- /dev/null
+++ b/test-suite/tests/asm-to-bytecode.test
@@ -0,0 +1,110 @@
+;;;; test assembly to bytecode compilation -*- scheme -*-
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (test-suite tests asm-to-bytecode)
+  #:use-module (rnrs bytevector)
+  #:use-module (test-suite lib)
+  #:use-module (system vm instruction)
+  #:use-module (language assembly compile-bytecode))
+
+(define (->u8-list sym val)
+  (let ((entry (assq-ref `((uint16 2 ,bytevector-u16-native-set!)
+                           (uint32 4 ,bytevector-u32-native-set!))
+                         sym)))
+    (or entry (error "unknown sym" sym))
+    (let ((bv (make-bytevector (car entry))))
+      ((cadr entry) bv 0 val)
+      (bytevector->u8-list bv))))
+
+(define (munge-bytecode v)
+  (let lp ((i 0) (out '()))
+    (if (= i (vector-length v))
+        (list->u8vector (reverse out))
+        (let ((x (vector-ref v i)))
+          (cond
+           ((symbol? x)
+            (lp (1+ i) (cons (instruction->opcode x) out)))
+           ((integer? x)
+            (lp (1+ i) (cons x out)))
+           ((pair? x)
+            (lp (1+ i) (append (reverse (apply ->u8-list x)) out)))
+           (else (error "bad test bytecode" x)))))))
+
+(define (comp-test x y)
+  (let* ((y (munge-bytecode y))
+         (len (u8vector-length y))
+         (v (make-u8vector len))
+         (i 0))
+    (define (write-byte b) (u8vector-set! v i b) (set! i (1+ i)))
+    (define (get-addr) i)
+    (run-test `(length ,x) #t
+              (lambda ()
+                (write-bytecode x write-byte get-addr '())
+                (= i len)))
+    (run-test `(compile-equal? ,x ,y) #t
+              (lambda ()
+                (equal? v y)))))
+
+
+(with-test-prefix "compiler"
+  (with-test-prefix "asm-to-bytecode"
+
+    (comp-test '(make-int8 3)
+               #(make-int8 3))
+    
+    (comp-test '(load-number "3.14")
+               (vector 'load-number 0 0 4 (char->integer #\3) (char->integer #\.)
+                       (char->integer #\1) (char->integer #\4)))
+    
+    (comp-test '(load-string "foo")
+               (vector 'load-string 0 0 3 (char->integer #\f) (char->integer #\o)
+                       (char->integer #\o)))
+    
+    (comp-test '(load-symbol "foo")
+               (vector 'load-symbol 0 0 3 (char->integer #\f) (char->integer #\o)
+                       (char->integer #\o)))
+    
+    (comp-test '(load-program 3 2 1 () 3 #f (make-int8 3) (return))
+               #(load-program
+                 3 2 (uint16 1) ;; nargs, nrest, nlocs
+                 (uint32 3)     ;; len
+                 (uint32 0)     ;; metalen
+                 (uint32 0)     ;; padding
+                 make-int8 3
+                 return))
+
+    ;; the nops are to pad meta to an 8-byte alignment. not strictly
+    ;; necessary for this test, but representative of the common case.
+    (comp-test '(load-program 3 2 1 () 8
+                              (load-program 3 2 1 () 3
+                                            #f
+                                            (make-int8 3) (return))
+                              (make-int8 3) (return)
+                              (nop) (nop) (nop) (nop) (nop))
+               #(load-program
+                 3 2 (uint16 1) ;; nargs, nrest, nlocs
+                 (uint32 8)     ;; len
+                 (uint32 19)    ;; metalen
+                 (uint32 0)     ;; padding
+                 make-int8 3
+                 return
+                 nop nop nop nop nop
+                 3 2 (uint16 1) ;; nargs, nrest, nlocs
+                 (uint32 3)     ;; len
+                 (uint32 0)     ;; metalen
+                 (uint32 0)     ;; padding
+                 make-int8 3
+                 return))))
diff --git a/test-suite/tests/bit-operations.test b/test-suite/tests/bit-operations.test
index 8e35257b3..0e9df7d09 100644
--- a/test-suite/tests/bit-operations.test
+++ b/test-suite/tests/bit-operations.test
@@ -1,10 +1,10 @@
 ;;;; bit-operations.test --- bitwise operations on numbers -*- scheme -*-
-;;;; Copyright (C) 2000, 2001, 2003, 2006 Free Software Foundation, Inc.
+;;;; Copyright (C) 2000, 2001, 2003, 2006, 2009 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -15,8 +15,9 @@
 ;;;; License along with this library; if not, write to the Free Software
 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
-(use-modules (test-suite lib)
-	     (ice-9 documentation))
+(define-module (test-bit-operations)
+  :use-module (test-suite lib)
+  :use-module (ice-9 documentation))
 
 
 ;;;
diff --git a/test-suite/tests/bytevectors.test b/test-suite/tests/bytevectors.test
new file mode 100644
index 000000000..1009fb051
--- /dev/null
+++ b/test-suite/tests/bytevectors.test
@@ -0,0 +1,684 @@
+;;;; bytevectors.test --- Exercise the R6RS bytevector API.
+;;;;
+;;;; Copyright (C) 2009 Free Software Foundation, Inc.
+;;;; Ludovic Court�s
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (test-bytevector)
+  :use-module (test-suite lib)
+  :use-module (system base compile)
+  :use-module (rnrs bytevector))
+
+;;; Some of the tests in here are examples taken from the R6RS Standard
+;;; Libraries document.
+
+(define-syntax c&e
+  (syntax-rules (pass-if pass-if-exception)
+    ((_ (pass-if test-name exp))
+     (begin (pass-if (string-append test-name " (eval)")
+                     (primitive-eval 'exp))
+            (pass-if (string-append test-name " (compile)")
+                     (compile 'exp #:to 'value))))
+    ((_ (pass-if-exception test-name exc exp))
+     (begin (pass-if-exception (string-append test-name " (eval)")
+                               exc (primitive-eval 'exp))
+            (pass-if-exception (string-append test-name " (compile)")
+                               exc (compile 'exp #:to 'value))))))
+
+(define-syntax with-test-prefix/c&e
+  (syntax-rules ()
+    ((_ section-name exp ...)
+     (with-test-prefix section-name (c&e exp) ...))))
+
+
+
+(with-test-prefix/c&e "2.2 General Operations"
+
+  (pass-if "native-endianness"
+    (not (not (memq (native-endianness) '(big little)))))
+
+  (pass-if "make-bytevector"
+    (and (bytevector? (make-bytevector 20))
+         (bytevector? (make-bytevector 20 3))))
+
+  (pass-if "bytevector-length"
+    (= (bytevector-length (make-bytevector 20)) 20))
+
+  (pass-if "bytevector=?"
+    (and (bytevector=? (make-bytevector 20 7)
+                       (make-bytevector 20 7))
+         (not (bytevector=? (make-bytevector 20 7)
+                            (make-bytevector 20 0))))))
+
+
+(with-test-prefix/c&e "2.3 Operations on Bytes and Octets"
+
+  (pass-if "bytevector-{u8,s8}-ref"
+    (equal? '(-127 129 -1 255)
+            (let ((b1 (make-bytevector 16 -127))
+                  (b2 (make-bytevector 16 255)))
+              (list (bytevector-s8-ref b1 0)
+                    (bytevector-u8-ref b1 0)
+                    (bytevector-s8-ref b2 0)
+                    (bytevector-u8-ref b2 0)))))
+
+  (pass-if "bytevector-{u8,s8}-set!"
+    (equal? '(-126 130 -10 246)
+            (let ((b (make-bytevector 16 -127)))
+
+              (bytevector-s8-set! b 0 -126)
+              (bytevector-u8-set! b 1 246)
+
+              (list (bytevector-s8-ref b 0)
+                    (bytevector-u8-ref b 0)
+                    (bytevector-s8-ref b 1)
+                    (bytevector-u8-ref b 1)))))
+
+  (pass-if "bytevector->u8-list"
+    (let ((lst '(1 2 3 128 150 255)))
+      (equal? lst
+              (bytevector->u8-list
+               (let ((b (make-bytevector 6)))
+                 (for-each (lambda (i v)
+                             (bytevector-u8-set! b i v))
+                           (iota 6)
+                           lst)
+                 b)))))
+
+  (pass-if "u8-list->bytevector"
+    (let ((lst '(1 2 3 128 150 255)))
+      (equal? lst
+              (bytevector->u8-list (u8-list->bytevector lst)))))
+
+  (pass-if "bytevector-uint-{ref,set!} [small]"
+    (let ((b (make-bytevector 15)))
+      (bytevector-uint-set! b 0 #x1234
+                            (endianness little) 2)
+      (equal? (bytevector-uint-ref b 0 (endianness big) 2)
+              #x3412)))
+
+  (pass-if "bytevector-uint-set! [large]"
+    (let ((b (make-bytevector 16)))
+      (bytevector-uint-set! b 0 (- (expt 2 128) 3)
+                            (endianness little) 16)
+      (equal? (bytevector->u8-list b)
+              '(253 255 255 255 255 255 255 255
+                255 255 255 255 255 255 255 255))))
+
+  (pass-if "bytevector-uint-{ref,set!} [large]"
+    (let ((b (make-bytevector 120)))
+      (bytevector-uint-set! b 0 (- (expt 2 128) 3)
+                            (endianness little) 16)
+      (equal? (bytevector-uint-ref b 0 (endianness little) 16)
+              #xfffffffffffffffffffffffffffffffd)))
+
+  (pass-if "bytevector-sint-ref [small]"
+    (let ((b (u8-list->bytevector '(#xff #xf0 #xff))))
+      (equal? (bytevector-sint-ref b 0 (endianness big) 2)
+              (bytevector-sint-ref b 1 (endianness little) 2)
+              -16)))
+
+  (pass-if "bytevector-sint-ref [large]"
+    (let ((b (make-bytevector 50)))
+      (bytevector-uint-set! b 0 (- (expt 2 128) 3)
+                            (endianness little) 16)
+      (equal? (bytevector-sint-ref b 0 (endianness little) 16)
+              -3)))
+
+  (pass-if "bytevector-sint-set! [small]"
+    (let ((b (make-bytevector 3)))
+      (bytevector-sint-set! b 0 -16 (endianness big) 2)
+      (bytevector-sint-set! b 1 -16 (endianness little) 2)
+      (equal? (bytevector->u8-list b)
+	      '(#xff #xf0 #xff))))
+
+  (pass-if "equal?"
+    (let ((bv1 (u8-list->bytevector (iota 123)))
+          (bv2 (u8-list->bytevector (iota 123))))
+      (equal? bv1 bv2))))
+
+
+(with-test-prefix/c&e "2.4 Operations on Integers of Arbitrary Size"
+
+  (pass-if "bytevector->sint-list"
+    (let ((b (u8-list->bytevector '(1 2 3 255 1 2 1 2))))
+      (equal? (bytevector->sint-list b (endianness little) 2)
+              '(513 -253 513 513))))
+
+  (pass-if "bytevector->uint-list"
+    (let ((b (u8-list->bytevector '(2 1 255 3 2 1 2 1))))
+      (equal? (bytevector->uint-list b (endianness big) 2)
+              '(513 65283 513 513))))
+
+  (pass-if "bytevector->uint-list [empty]"
+    (let ((b (make-bytevector 0)))
+      (null? (bytevector->uint-list b (endianness big) 2))))
+
+  (pass-if-exception "bytevector->sint-list [out-of-range]"
+    exception:out-of-range
+    (bytevector->sint-list (make-bytevector 6) (endianness little) 8))
+
+  (pass-if "bytevector->sint-list [off-by-one]"
+    (equal? (bytevector->sint-list (make-bytevector 31 #xff)
+                                   (endianness little) 8)
+            '(-1 -1 -1)))
+
+  (pass-if "{sint,uint}-list->bytevector"
+    (let ((b1 (sint-list->bytevector '(513 -253 513 513)
+                                     (endianness little) 2))
+          (b2 (uint-list->bytevector '(513 65283 513 513)
+                                     (endianness little) 2))
+          (b3 (u8-list->bytevector '(1 2 3 255 1 2 1 2))))
+      (and (bytevector=? b1 b2)
+           (bytevector=? b2 b3))))
+
+  (pass-if "sint-list->bytevector [limits]"
+           (bytevector=? (sint-list->bytevector '(-32768 32767)
+                                                (endianness big) 2)
+                         (let ((bv (make-bytevector 4)))
+                           (bytevector-u8-set! bv 0 #x80)
+                           (bytevector-u8-set! bv 1 #x00)
+                           (bytevector-u8-set! bv 2 #x7f)
+                           (bytevector-u8-set! bv 3 #xff)
+                           bv)))
+
+  (pass-if-exception "sint-list->bytevector [out-of-range]"
+    exception:out-of-range
+    (sint-list->bytevector (list 0 0 (expt 2 16)) (endianness big)
+                           2))
+
+  (pass-if-exception "uint-list->bytevector [out-of-range]"
+    exception:out-of-range
+    (uint-list->bytevector '(0 -1) (endianness big) 2)))
+
+
+(with-test-prefix/c&e "2.5 Operations on 16-Bit Integers"
+
+  (pass-if "bytevector-u16-ref"
+    (let ((b (u8-list->bytevector
+              '(255 255 255 255 255 255 255 255
+                255 255 255 255 255 255 255 253))))
+      (and (equal? (bytevector-u16-ref b 14 (endianness little))
+                   #xfdff)
+           (equal? (bytevector-u16-ref b 14 (endianness big))
+                   #xfffd))))
+
+  (pass-if "bytevector-s16-ref"
+    (let ((b (u8-list->bytevector
+              '(255 255 255 255 255 255 255 255
+                255 255 255 255 255 255 255 253))))
+      (and (equal? (bytevector-s16-ref b 14 (endianness little))
+                   -513)
+           (equal? (bytevector-s16-ref b 14 (endianness big))
+                   -3))))
+
+  (pass-if "bytevector-s16-ref [unaligned]"
+    (let ((b (u8-list->bytevector '(#xff #xf0 #xff))))
+      (equal? (bytevector-s16-ref b 1 (endianness little))
+	      -16)))
+
+  (pass-if "bytevector-{u16,s16}-ref"
+    (let ((b (make-bytevector 2)))
+      (bytevector-u16-set! b 0 44444 (endianness little))
+      (and (equal? (bytevector-u16-ref b 0 (endianness little))
+                   44444)
+           (equal? (bytevector-s16-ref b 0 (endianness little))
+                   (- 44444 65536)))))
+
+  (pass-if "bytevector-native-{u16,s16}-{ref,set!}"
+    (let ((b (make-bytevector 2)))
+      (bytevector-u16-native-set! b 0 44444)
+      (and (equal? (bytevector-u16-native-ref b 0)
+                   44444)
+           (equal? (bytevector-s16-native-ref b 0)
+                   (- 44444 65536)))))
+
+  (pass-if "bytevector-s16-{ref,set!} [unaligned]"
+    (let ((b (make-bytevector 3)))
+      (bytevector-s16-set! b 1 -77 (endianness little))
+      (equal? (bytevector-s16-ref b 1 (endianness little))
+	      -77))))
+
+
+(with-test-prefix/c&e "2.6 Operations on 32-bit Integers"
+
+  (pass-if "bytevector-u32-ref"
+    (let ((b (u8-list->bytevector
+              '(255 255 255 255 255 255 255 255
+                255 255 255 255 255 255 255 253))))
+      (and (equal? (bytevector-u32-ref b 12 (endianness little))
+                   #xfdffffff)
+           (equal? (bytevector-u32-ref b 12 (endianness big))
+                   #xfffffffd))))
+
+  (pass-if "bytevector-s32-ref"
+    (let ((b (u8-list->bytevector
+              '(255 255 255 255 255 255 255 255
+                255 255 255 255 255 255 255 253))))
+      (and (equal? (bytevector-s32-ref b 12 (endianness little))
+                   -33554433)
+           (equal? (bytevector-s32-ref b 12 (endianness big))
+                   -3))))
+
+  (pass-if "bytevector-{u32,s32}-ref"
+    (let ((b (make-bytevector 4)))
+      (bytevector-u32-set! b 0 2222222222 (endianness little))
+      (and (equal? (bytevector-u32-ref b 0 (endianness little))
+                   2222222222)
+           (equal? (bytevector-s32-ref b 0 (endianness little))
+                   (- 2222222222 (expt 2 32))))))
+
+  (pass-if "bytevector-{u32,s32}-native-{ref,set!}"
+    (let ((b (make-bytevector 4)))
+      (bytevector-u32-native-set! b 0 2222222222)
+      (and (equal? (bytevector-u32-native-ref b 0)
+                   2222222222)
+           (equal? (bytevector-s32-native-ref b 0)
+                   (- 2222222222 (expt 2 32)))))))
+
+
+(with-test-prefix/c&e "2.7 Operations on 64-bit Integers"
+
+  (pass-if "bytevector-u64-ref"
+    (let ((b (u8-list->bytevector
+              '(255 255 255 255 255 255 255 255
+                255 255 255 255 255 255 255 253))))
+      (and (equal? (bytevector-u64-ref b 8 (endianness little))
+                   #xfdffffffffffffff)
+           (equal? (bytevector-u64-ref b 8 (endianness big))
+                   #xfffffffffffffffd))))
+
+  (pass-if "bytevector-s64-ref"
+    (let ((b (u8-list->bytevector
+              '(255 255 255 255 255 255 255 255
+                255 255 255 255 255 255 255 253))))
+      (and (equal? (bytevector-s64-ref b 8 (endianness little))
+                   -144115188075855873)
+           (equal? (bytevector-s64-ref b 8 (endianness big))
+                   -3))))
+
+  (pass-if "bytevector-{u64,s64}-ref"
+    (let ((b (make-bytevector 8))
+          (big 9333333333333333333))
+      (bytevector-u64-set! b 0 big (endianness little))
+      (and (equal? (bytevector-u64-ref b 0 (endianness little))
+                   big)
+           (equal? (bytevector-s64-ref b 0 (endianness little))
+                   (- big (expt 2 64))))))
+
+  (pass-if "bytevector-{u64,s64}-native-{ref,set!}"
+    (let ((b (make-bytevector 8))
+          (big 9333333333333333333))
+      (bytevector-u64-native-set! b 0 big)
+      (and (equal? (bytevector-u64-native-ref b 0)
+                   big)
+           (equal? (bytevector-s64-native-ref b 0)
+                   (- big (expt 2 64))))))
+
+  (pass-if "ref/set! with zero"
+     (let ((b (make-bytevector 8)))
+       (bytevector-s64-set! b 0 -1 (endianness big))
+       (bytevector-u64-set! b 0  0 (endianness big))
+       (= 0 (bytevector-u64-ref b 0 (endianness big))))))
+
+
+(with-test-prefix/c&e "2.8 Operations on IEEE-754 Representations"
+
+  (pass-if "bytevector-ieee-single-native-{ref,set!}"
+    (let ((b (make-bytevector 4))
+          (number 3.00))
+      (bytevector-ieee-single-native-set! b 0 number)
+      (equal? (bytevector-ieee-single-native-ref b 0)
+              number)))
+
+  (pass-if "bytevector-ieee-single-{ref,set!}"
+    (let ((b (make-bytevector 8))
+          (number 3.14))
+      (bytevector-ieee-single-set! b 0 number (endianness little))
+      (bytevector-ieee-single-set! b 4 number (endianness big))
+      (equal? (bytevector-ieee-single-ref b 0 (endianness little))
+              (bytevector-ieee-single-ref b 4 (endianness big)))))
+
+  (pass-if "bytevector-ieee-single-{ref,set!} [unaligned]"
+    (let ((b (make-bytevector 9))
+          (number 3.14))
+      (bytevector-ieee-single-set! b 1 number (endianness little))
+      (bytevector-ieee-single-set! b 5 number (endianness big))
+      (equal? (bytevector-ieee-single-ref b 1 (endianness little))
+              (bytevector-ieee-single-ref b 5 (endianness big)))))
+
+  (pass-if "bytevector-ieee-double-native-{ref,set!}"
+    (let ((b (make-bytevector 8))
+          (number 3.14))
+      (bytevector-ieee-double-native-set! b 0 number)
+      (equal? (bytevector-ieee-double-native-ref b 0)
+              number)))
+
+  (pass-if "bytevector-ieee-double-{ref,set!}"
+    (let ((b (make-bytevector 16))
+          (number 3.14))
+      (bytevector-ieee-double-set! b 0 number (endianness little))
+      (bytevector-ieee-double-set! b 8 number (endianness big))
+      (equal? (bytevector-ieee-double-ref b 0 (endianness little))
+              (bytevector-ieee-double-ref b 8 (endianness big))))))
+
+
+(define (with-locale locale thunk)
+  ;; Run THUNK under LOCALE.
+  (let ((original-locale (setlocale LC_ALL)))
+    (catch 'system-error
+      (lambda ()
+        (setlocale LC_ALL locale))
+      (lambda (key . args)
+        (throw 'unresolved)))
+
+    (dynamic-wind
+        (lambda ()
+          #t)
+        thunk
+        (lambda ()
+          (setlocale LC_ALL original-locale)))))
+
+(define (with-latin1-locale thunk)
+  ;; Try out several ISO-8859-1 locales and run THUNK under the one that
+  ;; works (if any).
+  (define %locales
+    (map (lambda (name)
+           (string-append name ".ISO-8859-1"))
+         '("fr_FR" "es_ES" "en_GB" "en_US" "de_DE" "pt_PT")))
+
+  (let loop ((locales %locales))
+    (if (null? locales)
+        (throw 'unresolved)
+        (catch 'unresolved
+          (lambda ()
+            (with-locale (car locales) thunk))
+          (lambda (key . args)
+            (loop (cdr locales)))))))
+
+
+;; Default to the C locale for the following tests.
+(setlocale LC_ALL "C")
+
+
+(with-test-prefix "2.9 Operations on Strings"
+
+  (pass-if "string->utf8"
+    (let* ((str  "hello, world")
+           (utf8 (string->utf8 str)))
+      (and (bytevector? utf8)
+           (= (bytevector-length utf8)
+              (string-length str))
+           (equal? (string->list str)
+                   (map integer->char (bytevector->u8-list utf8))))))
+
+  (pass-if "string->utf8 [latin-1]"
+    (with-latin1-locale
+      (lambda ()
+        (let* ((str  "h�, �a va bien ?")
+               (utf8 (string->utf8 str)))
+          (and (bytevector? utf8)
+               (= (bytevector-length utf8)
+                  (+ 2 (string-length str))))))))
+
+  (pass-if "string->utf16"
+    (let* ((str   "hello, world")
+           (utf16 (string->utf16 str)))
+      (and (bytevector? utf16)
+           (= (bytevector-length utf16)
+              (* 2 (string-length str)))
+           (equal? (string->list str)
+                   (map integer->char
+                        (bytevector->uint-list utf16
+                                               (endianness big) 2))))))
+
+  (pass-if "string->utf16 [little]"
+    (let* ((str   "hello, world")
+           (utf16 (string->utf16 str (endianness little))))
+      (and (bytevector? utf16)
+           (= (bytevector-length utf16)
+              (* 2 (string-length str)))
+           (equal? (string->list str)
+                   (map integer->char
+                        (bytevector->uint-list utf16
+                                               (endianness little) 2))))))
+
+
+  (pass-if "string->utf32"
+    (let* ((str   "hello, world")
+           (utf32 (string->utf32 str)))
+      (and (bytevector? utf32)
+           (= (bytevector-length utf32)
+              (* 4 (string-length str)))
+           (equal? (string->list str)
+                   (map integer->char
+                        (bytevector->uint-list utf32
+                                               (endianness big) 4))))))
+
+  (pass-if "string->utf32 [little]"
+    (let* ((str   "hello, world")
+           (utf32 (string->utf32 str (endianness little))))
+      (and (bytevector? utf32)
+           (= (bytevector-length utf32)
+              (* 4 (string-length str)))
+           (equal? (string->list str)
+                   (map integer->char
+                        (bytevector->uint-list utf32
+                                               (endianness little) 4))))))
+
+  (pass-if "utf8->string"
+    (let* ((utf8  (u8-list->bytevector (map char->integer
+                                            (string->list "hello, world"))))
+           (str   (utf8->string utf8)))
+      (and (string? str)
+           (= (string-length str)
+              (bytevector-length utf8))
+           (equal? (string->list str)
+                   (map integer->char (bytevector->u8-list utf8))))))
+
+  (pass-if "utf8->string [latin-1]"
+    (with-latin1-locale
+      (lambda ()
+        (let* ((utf8  (string->utf8 "h�, �a va bien ?"))
+               (str   (utf8->string utf8)))
+          (and (string? str)
+               (= (string-length str)
+                  (- (bytevector-length utf8) 2)))))))
+
+  (pass-if "utf16->string"
+    (let* ((utf16  (uint-list->bytevector (map char->integer
+                                               (string->list "hello, world"))
+                                          (endianness big) 2))
+           (str   (utf16->string utf16)))
+      (and (string? str)
+           (= (* 2 (string-length str))
+              (bytevector-length utf16))
+           (equal? (string->list str)
+                   (map integer->char
+                        (bytevector->uint-list utf16 (endianness big)
+                                               2))))))
+
+  (pass-if "utf16->string [little]"
+    (let* ((utf16  (uint-list->bytevector (map char->integer
+                                               (string->list "hello, world"))
+                                          (endianness little) 2))
+           (str   (utf16->string utf16 (endianness little))))
+      (and (string? str)
+           (= (* 2 (string-length str))
+              (bytevector-length utf16))
+           (equal? (string->list str)
+                   (map integer->char
+                        (bytevector->uint-list utf16 (endianness little)
+                                               2))))))
+  (pass-if "utf32->string"
+    (let* ((utf32  (uint-list->bytevector (map char->integer
+                                               (string->list "hello, world"))
+                                          (endianness big) 4))
+           (str   (utf32->string utf32)))
+      (and (string? str)
+           (= (* 4 (string-length str))
+              (bytevector-length utf32))
+           (equal? (string->list str)
+                   (map integer->char
+                        (bytevector->uint-list utf32 (endianness big)
+                                               4))))))
+
+  (pass-if "utf32->string [little]"
+    (let* ((utf32  (uint-list->bytevector (map char->integer
+                                               (string->list "hello, world"))
+                                          (endianness little) 4))
+           (str   (utf32->string utf32 (endianness little))))
+      (and (string? str)
+           (= (* 4 (string-length str))
+              (bytevector-length utf32))
+           (equal? (string->list str)
+                   (map integer->char
+                        (bytevector->uint-list utf32 (endianness little)
+                                               4)))))))
+
+
+
+(with-test-prefix "Datum Syntax"
+
+  (pass-if "empty"
+    (equal? (with-input-from-string "#vu8()" read)
+            (make-bytevector 0)))
+
+  (pass-if "simple"
+    (equal? (with-input-from-string "#vu8(1 2 3   4 5)" read)
+            (u8-list->bytevector '(1 2 3 4 5))))
+
+  (pass-if ">127"
+    (equal? (with-input-from-string "#vu8(0 255 127 128)" read)
+            (u8-list->bytevector '(0 255 127 128))))
+
+  (pass-if "self-evaluating?"
+    (self-evaluating? (make-bytevector 1)))
+
+  (pass-if "self-evaluating"
+    (equal? (eval (with-input-from-string "#vu8(1 2 3 4 5)" read)
+                  (current-module))
+            (u8-list->bytevector '(1 2 3 4 5))))
+
+  (pass-if "quoted"
+    (equal? (eval (with-input-from-string "'#vu8(1 2 3 4 5)" read)
+                  (current-module))
+            (u8-list->bytevector '(1 2 3 4 5))))
+
+  (pass-if "literal simple"
+    (equal? #vu8(1 2 3   4 5)
+            (u8-list->bytevector '(1 2 3 4 5))))
+
+  (pass-if "literal >127"
+    (equal? #vu8(0 255 127 128)
+            (u8-list->bytevector '(0 255 127 128))))
+
+  (pass-if "literal quoted"
+    (equal? '#vu8(1 2 3   4 5)
+            (u8-list->bytevector '(1 2 3 4 5))))
+
+  (pass-if-exception "incorrect prefix"
+    exception:read-error
+    (with-input-from-string "#vi8(1 2 3)" read))
+
+  (pass-if-exception "extraneous space"
+    exception:read-error
+    (with-input-from-string "#vu8 (1 2 3)" read))
+
+  (pass-if-exception "negative integers"
+    exception:wrong-type-arg
+    (with-input-from-string "#vu8(-1 -2 -3)" read))
+
+  (pass-if-exception "out-of-range integers"
+    exception:wrong-type-arg
+    (with-input-from-string "#vu8(0 256)" read)))
+
+
+(with-test-prefix "Generalized Vectors"
+
+  (pass-if "generalized-vector?"
+    (generalized-vector? #vu8(1 2 3)))
+
+  (pass-if "generalized-vector-length"
+    (equal? (iota 16)
+            (map generalized-vector-length
+                 (map make-bytevector (iota 16)))))
+
+  (pass-if "generalized-vector-ref"
+    (let ((bv #vu8(255 127)))
+      (and (= 255 (generalized-vector-ref bv 0))
+           (= 127 (generalized-vector-ref bv 1)))))
+
+  (pass-if-exception "generalized-vector-ref [index out-of-range]"
+    exception:out-of-range
+    (let ((bv #vu8(1 2)))
+      (generalized-vector-ref bv 2)))
+
+  (pass-if "generalized-vector-set!"
+    (let ((bv (make-bytevector 2)))
+      (generalized-vector-set! bv 0 255)
+      (generalized-vector-set! bv 1 77)
+      (equal? '(255 77)
+              (bytevector->u8-list bv))))
+
+  (pass-if-exception "generalized-vector-set! [index out-of-range]"
+    exception:out-of-range
+    (let ((bv (make-bytevector 2)))
+      (generalized-vector-set! bv 2 0)))
+
+  (pass-if-exception "generalized-vector-set! [value out-of-range]"
+    exception:out-of-range
+    (let ((bv (make-bytevector 2)))
+      (generalized-vector-set! bv 0 256)))
+
+  (pass-if "array-type"
+    (eq? 'vu8 (array-type #vu8())))
+
+  (pass-if "array-contents"
+    (let ((bv (u8-list->bytevector (iota 10))))
+      (eq? bv (array-contents bv))))
+
+  (pass-if "array-ref"
+    (let ((bv (u8-list->bytevector (iota 10))))
+      (equal? (iota 10)
+              (map (lambda (i) (array-ref bv i))
+                   (iota 10)))))
+
+  (pass-if "array-set!"
+    (let ((bv (make-bytevector 10)))
+      (for-each (lambda (i)
+                  (array-set! bv i i))
+                (iota 10))
+      (equal? (iota 10)
+              (bytevector->u8-list bv))))
+
+  (pass-if "make-typed-array"
+    (let ((bv (make-typed-array 'vu8 77 33)))
+      (equal? bv (u8-list->bytevector (make-list 33 77)))))
+
+  (pass-if-exception "make-typed-array [out-of-range]"
+    exception:out-of-range
+    (make-typed-array 'vu8 256 77))
+
+  (pass-if "uniform-array->bytevector"
+    (let ((bv #vu8(0 1 128 255)))
+      (equal? bv (uniform-array->bytevector bv)))))
+
+
+;;; Local Variables:
+;;; coding: latin-1
+;;; mode: scheme
+;;; End:
diff --git a/test-suite/tests/c-api.test b/test-suite/tests/c-api.test
index 4a165d4cb..7c1b3bbd1 100644
--- a/test-suite/tests/c-api.test
+++ b/test-suite/tests/c-api.test
@@ -3,20 +3,19 @@
 ;;;;
 ;;;; 	Copyright (C) 1999, 2006 Free Software Foundation, Inc.
 ;;;; 
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
 ;;;; 
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define srcdir (cdr (assq 'srcdir %guile-build-info)))
 
diff --git a/test-suite/tests/chars.test b/test-suite/tests/chars.test
index f14c832dd..b52b384c5 100644
--- a/test-suite/tests/chars.test
+++ b/test-suite/tests/chars.test
@@ -3,21 +3,19 @@
 ;;;;
 ;;;; 	Copyright (C) 2000, 2006 Free Software Foundation, Inc.
 ;;;; 
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
 ;;;; 
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
-
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (use-modules (test-suite lib))
 
diff --git a/test-suite/tests/common-list.test b/test-suite/tests/common-list.test
index c6f659b1e..dae806844 100644
--- a/test-suite/tests/common-list.test
+++ b/test-suite/tests/common-list.test
@@ -4,7 +4,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/test-suite/tests/compiler.test b/test-suite/tests/compiler.test
new file mode 100644
index 000000000..f9fabd7bc
--- /dev/null
+++ b/test-suite/tests/compiler.test
@@ -0,0 +1,55 @@
+;;;; compiler.test --- tests for the compiler      -*- scheme -*-
+;;;; Copyright (C) 2008, 2009 Free Software Foundation, Inc.
+;;;; 
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (test-suite tests compiler)
+  :use-module (test-suite lib)
+  :use-module (test-suite guile-test)
+  :use-module (system base compile))
+
+
+
+(with-test-prefix "basic"
+
+  (pass-if "compile to value"
+    (equal? (compile 1) 1)))
+
+
+(with-test-prefix "psyntax"
+
+  (pass-if "redefinition"
+    ;; In this case the locally-bound `round' must have the same value as the
+    ;; imported `round'.  See the same test in `syntax.test' for details.
+    (begin
+      (compile '(define round round))
+      (compile '(eq? round (@@ (guile) round)))))
+
+  (pass-if "compile in current module"
+    (let ((o (begin
+               (compile '(define-macro (foo) 'bar))
+               (compile '(let ((bar 'ok)) (foo))))))
+      (and (module-ref (current-module) 'foo)
+           (eq? o 'ok))))
+
+  (pass-if "compile in fresh module"
+    (let* ((m  (let ((m (make-module)))
+                 (beautify-user-module! m)
+                 m))
+           (o  (begin
+                 (compile '(define-macro (foo) 'bar) #:env m)
+                 (compile '(let ((bar 'ok)) (foo)) #:env m))))
+      (and (module-ref m 'foo)
+           (eq? o 'ok)))))
diff --git a/test-suite/tests/continuations.test b/test-suite/tests/continuations.test
index 7d76b762b..20a7a5ac1 100644
--- a/test-suite/tests/continuations.test
+++ b/test-suite/tests/continuations.test
@@ -3,20 +3,19 @@
 ;;;;
 ;;;; Copyright (C) 2003, 2006 Free Software Foundation, Inc.
 ;;;; 
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
 ;;;; 
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-suite test-continuations)
   :use-module (test-suite lib))
diff --git a/test-suite/tests/dynamic-scope.test b/test-suite/tests/dynamic-scope.test
index d7a06a411..08cf1c4e1 100644
--- a/test-suite/tests/dynamic-scope.test
+++ b/test-suite/tests/dynamic-scope.test
@@ -1,33 +1,30 @@
 ;;;;                                                          -*- scheme -*-
 ;;;; dynamic-scop.test --- test suite for dynamic scoping constructs
 ;;;;
-;;;; Copyright (C) 2001, 2006 Free Software Foundation, Inc.
+;;;; Copyright (C) 2001, 2006, 2009 Free Software Foundation, Inc.
 ;;;; 
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
 ;;;; 
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-suite test-dynamic-scope)
   :use-module (test-suite lib))
 
 
-(define exception:missing-expr
-  (cons 'syntax-error "Missing expression"))
-(define exception:bad-binding
-  (cons 'syntax-error "Bad binding"))
+(define exception:syntax-error
+  (cons 'syntax-error "failed to match"))
 (define exception:duplicate-binding
-  (cons 'syntax-error "Duplicate binding"))
+  (cons 'syntax-error "duplicate"))
 
 (define global-a 0)
 (define (fetch-global-a) global-a)
@@ -49,17 +46,17 @@
 	  (interaction-environment)))
 
   (pass-if-exception "@bind missing expression"
-    exception:missing-expr
+    exception:syntax-error
     (eval '(@bind ((global-a 1)))
 	  (interaction-environment)))
 
   (pass-if-exception "@bind bad bindings"
-    exception:bad-binding
+    exception:syntax-error
     (eval '(@bind (a) #f)
 	  (interaction-environment)))
 
   (pass-if-exception "@bind bad bindings"
-    exception:bad-binding
+    exception:syntax-error
     (eval '(@bind ((a)) #f)
 	  (interaction-environment)))
 
diff --git a/test-suite/tests/elisp.test b/test-suite/tests/elisp.test
index 067f7b16f..fd028dac6 100644
--- a/test-suite/tests/elisp.test
+++ b/test-suite/tests/elisp.test
@@ -4,7 +4,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -19,6 +19,13 @@
   :use-module (test-suite lib)
   :use-module (ice-9 weak-vector))
 
+(define *old-stack-level* (and=> (memq 'stack (debug-options)) cadr))
+(if *old-stack-level*
+    (debug-set! stack (* 2 *old-stack-level*)))
+
+(define *old-%load-should-autocompile* %load-should-autocompile)
+(set! %load-should-autocompile #f)
+
 ;;;
 ;;; elisp
 ;;;
@@ -274,6 +281,19 @@
 				(write (eval-elisp expr))))))
 		   (string=? calc expected))))
       
+      (define (elisp-pass-if/maybe-error key expr expected)
+	(pass-if (with-output-to-string (lambda () (write expr)))
+		 (string=?
+                  (catch key
+                         (lambda ()
+                           (with-output-to-string
+                             (lambda () (write (eval-elisp expr)))))
+                         (lambda (k . args)
+                           (format (current-error-port)
+                                   "warning: caught ~a: ~a\n" k args)
+                           (throw 'unresolved)))
+                  expected)))
+
       (elisp-pass-if '(and #f) "#f")
       (elisp-pass-if '(and #t) "#t")
       (elisp-pass-if '(and nil) "#nil")
@@ -323,12 +343,17 @@
       ;; loading the macro definition of lambda in subr.el.
       (elisp-pass-if '(function (lambda (x y &optional o &rest r) (list x y o r))) "(lambda (x y &optional o &rest r) (list x y o r))")
       (elisp-pass-if '(funcall (lambda (x y &optional o &rest r) (list x y o r)) 1 2 3 4) "(1 2 3 (4))")
-      (elisp-pass-if '(apply (lambda (x y &optional o &rest r) (list x y o r)) 1 2 3 nil) "(1 2 3 #nil)")
 
+      (elisp-pass-if '(apply (lambda (x y &optional o &rest r) (list x y o r)) 1 2 3 nil)
+                     "(1 2 3 #nil)")
+      
       (elisp-pass-if '(setq x 3) "3")
       (elisp-pass-if '(defvar x 4) "x")
       (elisp-pass-if 'x "3")
 
       ))
 
+(set! %load-should-autocompile *old-%load-should-autocompile*)
+(debug-set! stack *old-stack-level*)
+
 ;;; elisp.test ends here
diff --git a/test-suite/tests/encoding-escapes.test b/test-suite/tests/encoding-escapes.test
new file mode 100644
index 000000000..ea7a821e7
--- /dev/null
+++ b/test-suite/tests/encoding-escapes.test
@@ -0,0 +1,140 @@
+;;;; encoding-escapes.test --- test suite for Guile's string encodings -*- mode: scheme; coding: utf-8 -*-
+;;;;
+;;;; Copyright (C) 2009 Free Software Foundation, Inc.
+;;;; 
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2, or (at your option)
+;;;; any later version.
+;;;; 
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; GNU General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this software; see the file COPYING.  If not, write to
+;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;;;; Boston, MA 02110-1301 USA
+
+(define-module (test-strings)
+  #:use-module (test-suite lib)
+  #:use-module (srfi srfi-1))
+
+(define exception:conversion
+  (cons 'misc-error "^cannot convert to output locale"))
+
+;; Create a string from integer char values, eg. (string-ints 65) => "A"
+(define (string-ints . args)
+  (apply string (map integer->char args)))
+
+(define s1 "última")
+(define s2 "cédula")
+(define s3 "años")
+(define s4 "羅生門")
+
+(with-test-prefix "internal encoding"
+
+  (pass-if "ultima"
+	   (string=? s1 (string-ints #xfa #x6c #x74 #x69 #x6d #x61)))
+  
+  (pass-if "cedula"
+	   (string=? s2 (string-ints #x63 #xe9 #x64 #x75 #x6c #x61)))
+  
+  (pass-if "anos"
+	   (string=? s3 (string-ints #x61 #xf1 #x6f #x73)))
+  
+  (pass-if "Rashomon"
+	   (string=? s4 (string-ints #x7f85 #x751f #x9580))))
+
+(with-test-prefix "chars"
+ 
+  (pass-if "ultima"
+	   (list= eqv? (string->list s1)
+		  (list #\372 #\l #\t #\i #\m #\a)))
+  
+  (pass-if "cedula"
+	   (list= eqv? (string->list s2)
+		  (list #\c #\351 #\d #\u #\l #\a)))
+  
+  (pass-if "anos"
+	   (list= eqv? (string->list s3)
+		  (list #\a #\361 #\o #\s)))
+  
+  (pass-if "Rashomon"
+	   (list= eqv? (string->list s4)
+		  (list #\77605 #\72437 #\112600))))
+
+
+;; Check that an error is flagged on display output when the output
+;; error strategy is 'error
+
+(with-test-prefix "display output errors"
+
+  (pass-if-exception "ultima"
+		     exception:conversion
+		     (let ((pt (open-output-string)))
+		       (set-port-encoding! pt "ASCII")
+		       (set-port-conversion-strategy! pt 'error)
+		       (display s1 pt)))
+
+  (pass-if-exception "Rashomon"
+		     exception:conversion
+		     (let ((pt (open-output-string)))
+		       (set-port-encoding! pt "ASCII")
+		       (set-port-conversion-strategy! pt 'error)
+		       (display s4 pt))))
+
+;; Check that questions marks or substitutions appear when the conversion
+;; mode is substitute
+(with-test-prefix "display output substitutions"
+
+  (pass-if "ultima"
+	   (let ((pt (open-output-string)))
+	     (set-port-encoding! pt "ASCII")
+	     (set-port-conversion-strategy! pt 'substitute)
+	     (display s1 pt)
+	     (string=? "?ltima"
+		       (get-output-string pt))))
+
+  (pass-if "Rashomon"
+	   (let ((pt (open-output-string)))
+	     (set-port-encoding! pt "ASCII")
+	     (set-port-conversion-strategy! pt 'substitute)
+	     (display s4 pt)
+	     (string=? "???"
+		       (get-output-string pt)))))
+
+
+;; Check that hex escapes appear in the write output and that no error
+;; is thrown.  The output error strategy should be irrelevant here.
+(with-test-prefix "display output escapes"
+
+  (pass-if "ultima"
+	   (let ((pt (open-output-string)))
+	     (set-port-encoding! pt "ASCII")
+	     (set-port-conversion-strategy! pt 'escape)
+	     (display s1 pt)
+	     (string=? "\\xfaltima"
+		       (get-output-string pt))))
+  (pass-if "Rashomon"
+    (let ((pt (open-output-string)))
+      (set-port-encoding! pt "ASCII")
+      (set-port-conversion-strategy! pt 'escape)
+      (display s4 pt)
+      (string=? "\\u7F85\\u751F\\u9580"
+                (get-output-string pt)))))
+
+(with-test-prefix "input escapes"
+
+  (pass-if "última"
+    (with-locale "en_US.utf8"
+                 (string=? "última"
+                           (with-input-from-string "\"\\xfaltima\"" read))))
+
+  (pass-if "羅生門"
+    (with-locale "en_US.utf8"
+                 (string=? "羅生門"
+                           (with-input-from-string 
+                               "\"\\u7F85\\u751F\\u9580\"" read)))))
+
diff --git a/test-suite/tests/encoding-iso88591.test b/test-suite/tests/encoding-iso88591.test
new file mode 100644
index 000000000..d4de5e534
--- /dev/null
+++ b/test-suite/tests/encoding-iso88591.test
@@ -0,0 +1,139 @@
+;;;; strings.test --- test suite for Guile's string functions    -*- mode: scheme; coding: iso-8859-1 -*-
+;;;;
+;;;; Copyright (C) 2009 Free Software Foundation, Inc.
+;;;; 
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2, or (at your option)
+;;;; any later version.
+;;;; 
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; GNU General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this software; see the file COPYING.  If not, write to
+;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;;;; Boston, MA 02110-1301 USA
+
+(define-module (test-strings)
+  #:use-module (test-suite lib)
+  #:use-module (srfi srfi-1))
+
+(define exception:conversion
+  (cons 'misc-error "^cannot convert to output locale"))
+
+;; Create a string from integer char values, eg. (string-ints 65) => "A"
+(define (string-ints . args)
+  (apply string (map integer->char args)))
+
+;; Set locale to the environment's locale, so that the prints look OK.
+(define oldlocale #f)
+(if (defined? 'setlocale)
+    (set! oldlocale (setlocale LC_ALL "")))
+
+(define s1 "�ltima")
+(define s2 "c�dula")
+(define s3 "a�os")
+(define s4 "�C�mo?")
+
+(with-test-prefix "string length"
+
+  (pass-if "�ltima"
+	   (eq? (string-length s1) 6))
+    
+  (pass-if "c�dula"
+	   (eq? (string-length s2) 6))
+
+  (pass-if "a�os"
+	   (eq? (string-length s3) 4))
+
+  (pass-if "�C�mo?"
+	   (eq? (string-length s4) 6)))
+
+(with-test-prefix "internal encoding"
+
+  (pass-if "�ltima"
+	   (string=? s1 (string-ints #xfa #x6c #x74 #x69 #x6d #x61)))
+
+  (pass-if "c�dula"
+	   (string=? s2 (string-ints #x63 #xe9 #x64 #x75 #x6c #x61)))
+
+  (pass-if "a�os"
+	   (string=? s3 (string-ints #x61 #xf1 #x6f #x73)))
+ 
+  (pass-if "�C�mo?"
+	   (string=? s4 (string-ints #xbf #x43 #xf3 #x6d #x6f #x3f))))
+
+(with-test-prefix "chars"
+ 
+  (pass-if "�ltima"
+	   (list= eqv? (string->list s1)
+		  (list #\� #\l #\t #\i #\m #\a)))
+  
+  (pass-if "c�dula"
+	   (list= eqv? (string->list s2)
+		  (list #\c #\� #\d #\u #\l #\a)))
+
+  (pass-if "a�os"
+	   (list= eqv? (string->list s3)
+		  (list #\a #\� #\o #\s)))
+
+  (pass-if "�C�mo?"
+	   (list= eqv? (string->list s4)
+		  (list #\� #\C #\� #\m #\o #\?))))
+
+;; Check that the output is in ISO-8859-1 encoding
+(with-test-prefix "display"
+ 
+  (pass-if "s1"
+	   (let ((pt (open-output-string)))
+	     (set-port-encoding! pt "ISO-8859-1")
+	     (display s1 pt)
+	     (list= eqv? 
+		    (list #xfa #x6c #x74 #x69 #x6d #x61)
+		    (u8vector->list
+		     (get-output-locale-u8vector pt)))))
+
+  (pass-if "s2"
+	   (let ((pt (open-output-string)))
+	     (set-port-encoding! pt "ISO-8859-1")
+	     (display s2 pt)
+	     (list= eqv? 
+		    (list #x63 #xe9 #x64 #x75 #x6c #x61)
+		    (u8vector->list
+		     (get-output-locale-u8vector pt))))))
+
+(with-test-prefix "symbols == strings"
+
+  (pass-if "�ltima"
+	   (eq? (string->symbol s1) '�ltima))
+
+  (pass-if "c�dula"
+	   (eq? (string->symbol s2) 'c�dula))
+
+  (pass-if "a�os"
+	   (eq? (string->symbol s3) 'a�os))
+ 
+  (pass-if "�C�mo?"
+	   (eq? (string->symbol s4) '�C�mo?)))
+
+(with-test-prefix "non-ascii variable names"
+
+  (pass-if "1"
+	   (let ((� 1)
+		 (� 2))
+	     (eq? (+ � �) 3))))
+
+(with-test-prefix "output errors"
+
+  (pass-if-exception "char 256" exception:conversion
+		     (let ((pt (open-output-string)))
+		       (set-port-encoding! pt "ISO-8859-1")
+		       (set-port-conversion-strategy! pt 'error)
+		       (display (string-ints 256) pt))))
+
+;; Reset locales
+(if (defined? 'setlocale)
+    (setlocale LC_ALL oldlocale))
diff --git a/test-suite/tests/encoding-iso88597.test b/test-suite/tests/encoding-iso88597.test
new file mode 100644
index 000000000..22212690c
--- /dev/null
+++ b/test-suite/tests/encoding-iso88597.test
@@ -0,0 +1,139 @@
+;;;; strings.test --- test suite for Guile's string functions    -*- mode: scheme; coding: iso-8859-7 -*-
+;;;;
+;;;; Copyright (C) 2009 Free Software Foundation, Inc.
+;;;; 
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2, or (at your option)
+;;;; any later version.
+;;;; 
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; GNU General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this software; see the file COPYING.  If not, write to
+;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;;;; Boston, MA 02110-1301 USA
+
+(define-module (test-strings)
+  #:use-module (test-suite lib)
+  #:use-module (srfi srfi-1))
+
+(define exception:conversion
+  (cons 'misc-error "^cannot convert to output locale"))
+
+;; Create a string from integer char values, eg. (string-ints 65) => "A"
+(define (string-ints . args)
+  (apply string (map integer->char args)))
+
+(define oldlocale #f)
+(if (defined? 'setlocale)
+    (set! oldlocale (setlocale LC_ALL "")))
+
+(define s1 "����")
+(define s2 "���")
+(define s3 "��������")
+(define s4 "���")
+
+(with-test-prefix "string length"
+
+  (pass-if "s1"
+	   (eq? (string-length s1) 4))
+  
+  (pass-if "s2"
+	   (eq? (string-length s2) 3))
+  
+  (pass-if "s3"
+	   (eq? (string-length s3) 8))
+  
+  (pass-if "s4" 
+	   (eq? (string-length s4) 3)))
+
+(with-test-prefix "internal encoding"
+
+  (pass-if "s1"
+	   (string=? s1 (string-ints #x03a0 #x03b5 #x03c1 #x03af)))
+  
+  (pass-if "s2"
+	   (string=? s2 (string-ints #x03c4 #x03b7 #x03c2)))
+  
+  (pass-if "s3"
+	   (string=? s3 (string-ints #x03ba #x03c1 #x03b9 #x03c4 #x03b9 #x03ba #x03ae #x03c2)))
+  
+  (pass-if "s4"
+	   (string=? s4 (string-ints #x03ba #x03b1 #x03b9))))
+
+(with-test-prefix "chars"
+ 
+  (pass-if "s1"
+	   (list= eqv? (string->list s1)
+		  (list #\� #\� #\� #\�)))
+  
+  (pass-if "s2"
+	   (list= eqv? (string->list s2)
+		  (list #\� #\� #\�)))
+  
+  (pass-if "s3"
+	   (list= eqv? (string->list s3)
+		  (list #\� #\� #\� #\� #\� #\� #\� #\�)))
+  
+  (pass-if "s4"
+	   (list= eqv? (string->list s4)
+		  (list #\� #\� #\�))))
+
+;; Testing that the display of the string is output in the ISO-8859-7
+;; encoding
+(with-test-prefix "display"
+ 
+  (pass-if "s1"
+	   (let ((pt (open-output-string)))
+	     (set-port-encoding! pt "ISO-8859-7")
+	     (display s1 pt)
+	     (list= eqv? 
+		    (list #xd0 #xe5 #xf1 #xdf)
+		    (u8vector->list 
+		     (get-output-locale-u8vector pt)))))
+  (pass-if "s2"
+	   (let ((pt (open-output-string)))
+	     (set-port-encoding! pt "ISO-8859-7")
+	     (display s2 pt)
+	     (list= eqv? 
+		    (list #xf4 #xe7 #xf2)
+		    (u8vector->list 
+		     (get-output-locale-u8vector pt))))))
+
+(with-test-prefix "symbols == strings"
+
+  (pass-if "����"
+	   (eq? (string->symbol s1) '����))
+
+  (pass-if "���"
+	   (eq? (string->symbol s2) '���))
+  
+  (pass-if "��������"
+	   (eq? (string->symbol s3) '��������))
+  
+  (pass-if "���"
+	   (eq? (string->symbol s4) '���)))
+
+(with-test-prefix "non-ascii variable names"
+
+  (pass-if "1"
+	   (let ((� 1)
+		 (� 2))
+	     (eq? (+ � �) 3))))
+
+(with-test-prefix "output errors"
+
+  (pass-if-exception "char #x0400"
+		     exception:conversion
+		     (let ((pt (open-output-string)))
+		       (set-port-encoding! pt "ISO-8859-7")
+		       (set-port-conversion-strategy! pt 'error)
+		       (display (string-ints #x0400) pt))))
+
+;; Reset locale
+(if (defined? 'setlocale)
+    (setlocale LC_ALL oldlocale))
diff --git a/test-suite/tests/encoding-utf8.test b/test-suite/tests/encoding-utf8.test
new file mode 100644
index 000000000..a2613f1d7
--- /dev/null
+++ b/test-suite/tests/encoding-utf8.test
@@ -0,0 +1,108 @@
+;;;; strings.test --- test suite for Guile's string functions    -*- mode: scheme; coding: utf-8 -*-
+;;;;
+;;;; Copyright (C) 2009 Free Software Foundation, Inc.
+;;;; 
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2, or (at your option)
+;;;; any later version.
+;;;; 
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; GNU General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this software; see the file COPYING.  If not, write to
+;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;;;; Boston, MA 02110-1301 USA
+
+(define-module (test-strings)
+  #:use-module (test-suite lib)
+  #:use-module (srfi srfi-1))
+
+(define exception:conversion
+  (cons 'misc-error "^cannot convert to output locale"))
+
+;; Create a string from integer char values, eg. (string-ints 65) => "A"
+(define (string-ints . args)
+  (apply string (map integer->char args)))
+
+(define oldlocale #f)
+(if (defined? 'setlocale)
+    (set! oldlocale (setlocale LC_ALL "")))
+
+(define s1 "última")
+(define s2 "cédula")
+(define s3 "años")
+(define s4 "羅生門")
+
+(with-test-prefix "string length"
+
+  (pass-if "última"
+	   (eq? (string-length s1) 6))
+    
+  (pass-if "cédula"
+	   (eq? (string-length s2) 6))
+
+  (pass-if "años"
+	   (eq? (string-length s3) 4))
+
+  (pass-if "羅生門"
+	   (eq? (string-length s4) 3)))
+
+(with-test-prefix "internal encoding"
+
+  (pass-if "última"
+	   (string=? s1 (string-ints #xfa #x6c #x74 #x69 #x6d #x61)))
+
+  (pass-if "cédula"
+	   (string=? s2 (string-ints #x63 #xe9 #x64 #x75 #x6c #x61)))
+
+  (pass-if "años"
+	   (string=? s3 (string-ints #x61 #xf1 #x6f #x73)))
+ 
+  (pass-if "羅生門"
+	   (string=? s4 (string-ints #x7f85 #x751f #x9580))))
+
+(with-test-prefix "chars"
+ 
+  (pass-if "última"
+	   (list= eqv? (string->list s1)
+		  (list #\ú #\l #\t #\i #\m #\a)))
+
+  (pass-if "cédula"
+	   (list= eqv? (string->list s2)
+		  (list #\c #\é #\d #\u #\l #\a)))
+
+  (pass-if "años"
+	   (list= eqv? (string->list s3)
+		  (list #\a #\ñ #\o #\s)))
+
+  (pass-if "羅生門"
+	   (list= eqv? (string->list s4)
+		  (list #\羅 #\生 #\門))))
+
+(with-test-prefix "symbols == strings"
+
+  (pass-if "última"
+	   (eq? (string->symbol s1) 'última))
+
+  (pass-if "cédula"
+	   (eq? (string->symbol s2) 'cédula))
+
+  (pass-if "años"
+	   (eq? (string->symbol s3) 'años))
+ 
+  (pass-if "羅生門"
+	   (eq? (string->symbol s4) '羅生門)))
+
+(with-test-prefix "non-ascii variable names"
+
+  (pass-if "1"
+	   (let ((芥川龍之介  1)
+		 (ñ 2))
+	     (eq? (+  芥川龍之介 ñ) 3))))
+
+(if (defined? 'setlocale)
+    (setlocale LC_ALL oldlocale))
diff --git a/test-suite/tests/environments.nottest b/test-suite/tests/environments.nottest
index 46883849a..90ef80f63 100644
--- a/test-suite/tests/environments.nottest
+++ b/test-suite/tests/environments.nottest
@@ -4,7 +4,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/test-suite/tests/eval.test b/test-suite/tests/eval.test
index 5299b0406..47d7ca99f 100644
--- a/test-suite/tests/eval.test
+++ b/test-suite/tests/eval.test
@@ -4,7 +4,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -24,6 +24,9 @@
 (define exception:bad-expression
   (cons 'syntax-error "Bad expression"))
 
+(define exception:failed-match
+  (cons 'syntax-error "failed to match any pattern"))
+
 
 ;;;
 ;;; miscellaneous
@@ -85,17 +88,19 @@
     ;; Macros are accepted as function parameters.
     ;; Functions that 'apply' macros are rewritten!!!
 
-    (expect-fail-exception "macro as argument"
-      exception:wrong-type-arg
-      (let ((f (lambda (p a b) (p a b))))
-	(f and #t #t)))
+    (pass-if-exception "macro as argument"
+      exception:failed-match
+      (primitive-eval
+       '(let ((f (lambda (p a b) (p a b))))
+          (f and #t #t))))
 
-    (expect-fail-exception "passing macro as parameter"
-      exception:wrong-type-arg
-      (let* ((f (lambda (p a b) (p a b)))
-	     (foo (procedure-source f)))
-	(f and #t #t)
-	(equal? (procedure-source f) foo)))
+    (pass-if-exception "passing macro as parameter"
+      exception:failed-match
+      (primitive-eval
+       '(let* ((f (lambda (p a b) (p a b)))
+               (foo (procedure-source f)))
+          (f and #t #t)
+          (equal? (procedure-source f) foo))))
 
     ))
 
@@ -214,7 +219,11 @@
 ;;
 (define foo-closure (lambda () "hello"))
 (define bar-closure foo-closure)
-(define foo-pws (make-procedure-with-setter car set-car!))
+;; make sure that make-procedure-with-setter returns an anonymous
+;; procedure-with-setter by passing it an anonymous getter.
+(define foo-pws (make-procedure-with-setter
+                 (lambda (x) (car x))
+                 (lambda (x y) (set-car! x y))))
 (define bar-pws foo-pws)
 
 (with-test-prefix "define set procedure-name"
@@ -223,7 +232,7 @@
     (eq? 'foo-closure (procedure-name bar-closure)))
 
   (pass-if "procedure-with-setter"
-    (eq? 'foo-pws (pk (procedure-name bar-pws)))))
+    (eq? 'foo-pws (procedure-name bar-pws))))
 
 (if old-procnames-flag
     (debug-enable 'procnames)
diff --git a/test-suite/tests/exceptions.test b/test-suite/tests/exceptions.test
index 4a9c1cb55..c2ec5f48d 100644
--- a/test-suite/tests/exceptions.test
+++ b/test-suite/tests/exceptions.test
@@ -4,7 +4,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test
index b9913c2f2..a6bfb6eb5 100644
--- a/test-suite/tests/filesys.test
+++ b/test-suite/tests/filesys.test
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/test-suite/tests/format.test b/test-suite/tests/format.test
index cc3b6684b..04b31f138 100644
--- a/test-suite/tests/format.test
+++ b/test-suite/tests/format.test
@@ -3,20 +3,19 @@
 ;;;;
 ;;;; 	Copyright (C) 2001, 2003, 2004, 2006 Free Software Foundation, Inc.
 ;;;; 
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
 ;;;; 
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-format)
   #:use-module (test-suite lib)
diff --git a/test-suite/tests/fractions.test b/test-suite/tests/fractions.test
index 0e1a4d6c1..3ee1347d8 100644
--- a/test-suite/tests/fractions.test
+++ b/test-suite/tests/fractions.test
@@ -1,17 +1,18 @@
 ;;;; Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc.
 ;;;;
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License version 2 as
-;;;; published by the Free Software Foundation; see file GNU-GPL.
-;;;;
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this program; if not, write to the Free Software Foundation,
-;;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 ;;;; Based in part on code from GNU CLISP, Copyright (C) 1993 Michael Stoll
 
diff --git a/test-suite/tests/ftw.test b/test-suite/tests/ftw.test
index a61850af2..847fb9ff4 100644
--- a/test-suite/tests/ftw.test
+++ b/test-suite/tests/ftw.test
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -25,18 +25,19 @@
 ;; what ice-9/posix.scm stat:dev and stat:ino do (which in turn match
 ;; libguile/filesys.c of course)
 
-(or (equal? (procedure-source stat:dev)
-	    '(lambda (f) (vector-ref f 0)))
-    (error "oops, unexpected stat:dev definition"))
 (define (stat:dev! st dev)
   (vector-set! st 0 dev))
-
-(or (equal? (procedure-source stat:ino)
-	    '(lambda (f) (vector-ref f 1)))
-    (error "oops, unexpected stat:ino definition"))
 (define (stat:ino! st ino)
   (vector-set! st 1 ino))
 
+(let* ((s (stat "/"))
+       (i (stat:ino s))
+       (d (stat:dev s)))
+  (stat:ino! s (1+ i))
+  (stat:dev! s (1+ d))
+  (if (not (and (= (stat:ino s) (1+ i))
+                (= (stat:dev s) (1+ d))))
+      (error "unexpected definitions of stat:dev and stat:ino")))
 
 ;;
 ;; visited?-proc
diff --git a/test-suite/tests/gc.test b/test-suite/tests/gc.test
index 407c4a286..063dad6d1 100644
--- a/test-suite/tests/gc.test
+++ b/test-suite/tests/gc.test
@@ -4,7 +4,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/test-suite/tests/getopt-long.test b/test-suite/tests/getopt-long.test
index fe4a8872b..2c6f41515 100644
--- a/test-suite/tests/getopt-long.test
+++ b/test-suite/tests/getopt-long.test
@@ -3,20 +3,19 @@
 ;;;;
 ;;;; 	Copyright (C) 2001, 2006 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,
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (use-modules (test-suite lib)
              (ice-9 getopt-long)
diff --git a/test-suite/tests/goops.test b/test-suite/tests/goops.test
index fa53fd216..c060d12a6 100644
--- a/test-suite/tests/goops.test
+++ b/test-suite/tests/goops.test
@@ -2,20 +2,19 @@
 ;;;;
 ;;;; Copyright (C) 2001,2003,2004, 2006, 2008, 2009 Free Software Foundation, Inc.
 ;;;; 
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
 ;;;; 
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-suite test-goops)
   #:use-module (test-suite lib)
@@ -191,7 +190,15 @@
                 (and (struct? x)
                      (eq? (struct-ref x 0) 'hello)
                      (eq? (struct-ref x 1) 'world)))
-             (current-module)))))
+             (current-module)))
+
+     (pass-if "with accessors"
+              (eval '(define-class <qux> ()
+                       (x #:accessor x #:init-value 123)
+                       (z #:accessor z #:init-value 789))
+                    (current-module))
+              (eval '(equal? (x (make <qux>)) 123) (current-module)))))
+     
 
 (with-test-prefix "defining generics"
 
@@ -253,6 +260,19 @@
              (method-more-specific? m1 m2 '()))
           (current-module))))
 
+(with-test-prefix "the method cache"
+  (pass-if "defining a method with a rest arg"
+    (let ((m (current-module)))
+      (eval '(define-method (foo bar . baz)
+               (cons bar baz))
+            m)
+      (eval '(foo 1)
+            m)
+      (eval '(foo 1 2)
+            m)
+      (eval '(equal? (foo 1 2) '(1 2))
+            m))))
+
 (with-test-prefix "defining accessors"
 
   (with-test-prefix "define-accessor"
diff --git a/test-suite/tests/guardians.test b/test-suite/tests/guardians.test
index 8e72d4106..470de4569 100644
--- a/test-suite/tests/guardians.test
+++ b/test-suite/tests/guardians.test
@@ -3,20 +3,19 @@
 ;;;;
 ;;;; 	Copyright (C) 1999, 2001, 2006 Free Software Foundation, Inc.
 ;;;; 
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
 ;;;; 
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 ;;; These tests make some questionable assumptions.
 ;;;
diff --git a/test-suite/tests/hash.test b/test-suite/tests/hash.test
index ccfd24ece..d2bde481c 100644
--- a/test-suite/tests/hash.test
+++ b/test-suite/tests/hash.test
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/test-suite/tests/hooks.test b/test-suite/tests/hooks.test
index f8ed39919..68c724704 100644
--- a/test-suite/tests/hooks.test
+++ b/test-suite/tests/hooks.test
@@ -4,7 +4,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/test-suite/tests/i18n.test b/test-suite/tests/i18n.test
index 78d7e54fb..c4777c21c 100644
--- a/test-suite/tests/i18n.test
+++ b/test-suite/tests/i18n.test
@@ -6,13 +6,13 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
-;;;;
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 ;;;; Lesser General Public License for more details.
-;;;;
+;;;; 
 ;;;; You should have received a copy of the GNU Lesser General Public
 ;;;; License along with this library; if not, write to the Free Software
 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
diff --git a/test-suite/tests/import.test b/test-suite/tests/import.test
index 4c4be02b2..1f2d26445 100644
--- a/test-suite/tests/import.test
+++ b/test-suite/tests/import.test
@@ -4,7 +4,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/test-suite/tests/interp.test b/test-suite/tests/interp.test
index a091515b9..5f3e2aaf7 100644
--- a/test-suite/tests/interp.test
+++ b/test-suite/tests/interp.test
@@ -2,20 +2,19 @@
 ;;;;
 ;;;; 	Copyright (C) 1999, 2001, 2006 Free Software Foundation, Inc.
 ;;;; 
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
 ;;;; 
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (pass-if "Internal defines 1"
 	 (letrec ((foo (lambda (arg)
diff --git a/test-suite/tests/list.test b/test-suite/tests/list.test
index 7dc0ef0f8..d7b7801c9 100644
--- a/test-suite/tests/list.test
+++ b/test-suite/tests/list.test
@@ -4,7 +4,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/test-suite/tests/load.test b/test-suite/tests/load.test
index a71a34716..59f9dbb61 100644
--- a/test-suite/tests/load.test
+++ b/test-suite/tests/load.test
@@ -3,20 +3,19 @@
 ;;;;
 ;;;; 	Copyright (C) 1999, 2001, 2006 Free Software Foundation, Inc.
 ;;;; 
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
 ;;;; 
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-suite test-load)
   :use-module (test-suite lib)
diff --git a/test-suite/tests/modules.test b/test-suite/tests/modules.test
index 43e35d8b7..f22cfe9c1 100644
--- a/test-suite/tests/modules.test
+++ b/test-suite/tests/modules.test
@@ -1,17 +1,17 @@
 ;;;; modules.test --- exercise some of guile's module stuff -*- scheme -*-
 
-;;;; Copyright (C) 2006, 2007 Free Software Foundation, Inc.
+;;;; Copyright (C) 2006, 2007, 2009 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
-;;;;
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 ;;;; Lesser General Public License for more details.
-;;;;
+;;;; 
 ;;;; You should have received a copy of the GNU Lesser General Public
 ;;;; License along with this library; if not, write to the Free Software
 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
@@ -34,6 +34,13 @@
 
 (with-test-prefix "foundations"
 
+  (pass-if "modules don't remain anonymous"
+    ;; This is a requirement for `psyntax': it stores module names and relies
+    ;; on being able to `resolve-module' them.
+    (let ((m (make-module)))
+      (and (module-name m)
+           (eq? m (resolve-module (module-name m))))))
+
   (pass-if "module-add!"
     (let ((m (make-module))
           (value (cons 'x 'y)))
diff --git a/test-suite/tests/multilingual.nottest b/test-suite/tests/multilingual.nottest
index 46a3ee2d3..cc911a108 100644
--- a/test-suite/tests/multilingual.nottest
+++ b/test-suite/tests/multilingual.nottest
@@ -4,20 +4,19 @@
 ;;;;
 ;;;; 	Copyright (C) 1999, 2006 Free Software Foundation, Inc.
 ;;;; 
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
 ;;;; 
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (use-modules (test-suite lib))
 
diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test
index 32627ed8c..774e228a7 100644
--- a/test-suite/tests/numbers.test
+++ b/test-suite/tests/numbers.test
@@ -4,7 +4,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -22,6 +22,7 @@
 ;;;
 ;;; miscellaneous
 ;;;
+(setbinary)
 
 (define exception:numerical-overflow
   (cons 'numerical-overflow "^Numerical overflow"))
@@ -1365,7 +1366,14 @@
                 ("1@0" 1.0) ("1@+0" 1.0) ("1@-0" 1.0)
                 ("2+3i" ,(+ 2 (* 3 +i))) ("4-5i" ,(- 4 (* 5 +i)))
                 ("1+i" 1+1i) ("1-i" 1-1i) ("+1i" 0+1i) ("-1i" 0-1i)
-                ("+i" +1i) ("-i" -1i)))
+                ("+i" +1i) ("-i" -1i)
+		("1.0+.1i" 1.0+0.1i)
+		("1.0-.1i" 1.0-0.1i)
+		(".1+.0i" 0.1)
+		("1.+.0i" 1.0)
+		(".1+.1i" 0.1+0.1i)
+		("1e1+.1i" 10+0.1i)
+		))
     #t)
 
   (pass-if-exception "exponent too big"
diff --git a/test-suite/tests/optargs.test b/test-suite/tests/optargs.test
index 040b68ba4..5929ce909 100644
--- a/test-suite/tests/optargs.test
+++ b/test-suite/tests/optargs.test
@@ -3,20 +3,19 @@
 ;;;;
 ;;;; 	Copyright (C) 2001, 2006 Free Software Foundation, Inc.
 ;;;; 
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
 ;;;; 
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-suite test-optargs)
   :use-module (test-suite lib)
diff --git a/test-suite/tests/options.test b/test-suite/tests/options.test
index f2f87143b..a795109ce 100644
--- a/test-suite/tests/options.test
+++ b/test-suite/tests/options.test
@@ -2,20 +2,19 @@
 ;;;;
 ;;;; 	Copyright (C) 2002, 2006 Free Software Foundation, Inc.
 ;;;; 
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
 ;;;; 
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (use-modules (test-suite lib))
 
diff --git a/test-suite/tests/pairs.test b/test-suite/tests/pairs.test
index af2f3e275..a317307b2 100644
--- a/test-suite/tests/pairs.test
+++ b/test-suite/tests/pairs.test
@@ -2,20 +2,19 @@
 ;;;; 
 ;;;; Copyright (C) 2003, 2006 Free Software Foundation, Inc.
 ;;;; 
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
 ;;;; 
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 
 (use-modules (test-suite lib))
diff --git a/test-suite/tests/poe.test b/test-suite/tests/poe.test
index 6c7625602..707dc0272 100644
--- a/test-suite/tests/poe.test
+++ b/test-suite/tests/poe.test
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/test-suite/tests/popen.test b/test-suite/tests/popen.test
index 1dd2bc78e..0a20cff7a 100644
--- a/test-suite/tests/popen.test
+++ b/test-suite/tests/popen.test
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -73,20 +73,46 @@
 	      (open-input-pipe "echo hello"))))))
     #t)
   
+  (pass-if "open-input-pipe process gets (current-input-port) as stdin"
+    (let* ((p2c (pipe))
+           (port (with-input-from-port (car p2c)
+                   (lambda ()
+                     (open-input-pipe "read line && echo $line")))))
+      (display "hello\n" (cdr p2c))
+      (force-output (cdr p2c))
+      (let ((result (eq? (read port) 'hello)))
+	(close-port (cdr p2c))
+	(close-pipe port)
+	result)))
+
   ;; After the child closes stdout (which it indicates here by writing
-  ;; "closed" to stderr), the parent should see eof.  In Guile 1.6.4 and
-  ;; earlier a duplicate of stdout existed in the child, meaning eof was not
-  ;; seen.
+  ;; "closed" to stderr), the parent should see eof.  In Guile 1.6.4
+  ;; and earlier a duplicate of stdout existed in the child, meaning
+  ;; eof was not seen.
+  ;;
+  ;; Note that the objective here is to test that the parent sees EOF
+  ;; while the child is still alive.  (It is obvious that the parent
+  ;; must see EOF once the child has died.)  The use of the `p2c'
+  ;; pipe, and `echo closed' and `read' in the child, allows us to be
+  ;; sure that we are testing what the parent sees at a point where
+  ;; the child has closed stdout but is still alive.
   (pass-if "no duplicate"
-    (let* ((pair (pipe))
-	   (port (with-error-to-port (cdr pair)
+    (let* ((c2p (pipe))
+	   (p2c (pipe))
+	   (port (with-error-to-port (cdr c2p)
 		   (lambda ()
-		     (open-input-pipe
-		      "exec 1>/dev/null; echo closed 1>&2; exec 2>/dev/null; sleep 999")))))
-      (close-port (cdr pair))   ;; write side
-      (and (char? (read-char (car pair))) ;; wait for child to do its thing
-	   (char-ready? port)
-	   (eof-object? (read-char port))))))
+		     (with-input-from-port (car p2c)
+		       (lambda ()
+			 (open-input-pipe
+			  "exec 1>/dev/null; echo closed 1>&2; exec 2>/dev/null; read")))))))
+      (close-port (cdr c2p))   ;; write side
+      (let ((result (eof-object? (read-char port))))
+	(display "hello!\n" (cdr p2c))
+	(force-output (cdr p2c))
+	(close-pipe port)
+	result)))
+
+  )
 
 ;;
 ;; open-output-pipe
@@ -121,27 +147,47 @@
     #t)
   
   ;; After the child closes stdin (which it indicates here by writing
-  ;; "closed" to stderr), the parent should see a broken pipe.  We setup to
-  ;; see this as EPIPE (rather than SIGPIPE).  In Guile 1.6.4 and earlier a
-  ;; duplicate of stdin existed in the child, preventing the broken pipe
-  ;; occurring.
+  ;; "closed" to stderr), the parent should see a broken pipe.  We
+  ;; setup to see this as EPIPE (rather than SIGPIPE).  In Guile 1.6.4
+  ;; and earlier a duplicate of stdin existed in the child, preventing
+  ;; the broken pipe occurring.
+  ;;
+  ;; Note that the objective here is to test that the parent sees a
+  ;; broken pipe while the child is still alive.  (It is obvious that
+  ;; the parent will see a broken pipe once the child has died.)  The
+  ;; use of the `c2p' pipe, and the repeated `echo closed' in the
+  ;; child, allows us to be sure that we are testing what the parent
+  ;; sees at a point where the child has closed stdin but is still
+  ;; alive.
+  ;;
+  ;; Note that `with-epipe' must apply only to the parent and not to
+  ;; the child process; we rely on the child getting SIGPIPE, to
+  ;; terminate it (and avoid leaving a zombie).
   (pass-if "no duplicate"
-    (with-epipe
-     (lambda ()
-       (let* ((pair (pipe))
-	      (port (with-error-to-port (cdr pair)
-		      (lambda ()
-			(open-output-pipe
-			 "exec 0</dev/null; echo closed 1>&2; exec 2>/dev/null; sleep 999")))))
-	 (close-port (cdr pair))   ;; write side
-	 (and (char? (read-char (car pair))) ;; wait for child to do its thing
-	      (catch 'system-error
-		(lambda ()
-		  (write-char #\x port)
-		  (force-output port)
-		  #f)
-		(lambda (key name fmt args errno-list)
-		  (= (car errno-list) EPIPE)))))))))
+    (let* ((c2p (pipe))
+	   (port (with-error-to-port (cdr c2p)
+		   (lambda ()
+		     (open-output-pipe
+		      "exec 0</dev/null; while true; do echo closed 1>&2; done")))))
+      (close-port (cdr c2p))   ;; write side
+      (with-epipe
+       (lambda ()
+	 (let ((result
+		(and (char? (read-char (car c2p))) ;; wait for child to do its thing
+		     (catch 'system-error
+			    (lambda ()
+			      (write-char #\x port)
+			      (force-output port)
+			      #f)
+			    (lambda (key name fmt args errno-list)
+			      (= (car errno-list) EPIPE))))))
+	   ;; Now close our reading end of the pipe.  This should give
+	   ;; the child a broken pipe and so allow it to exit.
+	   (close-port (car c2p))
+	   (close-pipe port)
+	   result)))))
+
+  )
 
 ;;
 ;; close-pipe
diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index f1ba80be0..76b3e5656 100644
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -3,20 +3,19 @@
 ;;;;
 ;;;; 	Copyright (C) 1999, 2001, 2004, 2006, 2007 Free Software Foundation, Inc.
 ;;;; 
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
 ;;;; 
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-suite test-ports)
   :use-module (test-suite lib)
@@ -34,6 +33,9 @@
 
 ;;;; Some general utilities for testing ports.
 
+;;; Make sure we are set up for 8-bit data
+(setbinary)
+
 ;;; Read from PORT until EOF, and return the result as a string.
 (define (read-all port)
   (let loop ((chars '()))
diff --git a/test-suite/tests/posix.test b/test-suite/tests/posix.test
index e93d1689f..06b70baa0 100644
--- a/test-suite/tests/posix.test
+++ b/test-suite/tests/posix.test
@@ -2,20 +2,19 @@
 ;;;;
 ;;;; Copyright 2003, 2004, 2006, 2007 Free Software Foundation, Inc.
 ;;;;
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU 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,
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-suite test-posix)
   :use-module (test-suite lib))
diff --git a/test-suite/tests/procprop.test b/test-suite/tests/procprop.test
index 5ab585058..6af73f6bb 100644
--- a/test-suite/tests/procprop.test
+++ b/test-suite/tests/procprop.test
@@ -3,20 +3,19 @@
 ;;;;
 ;;;; 	Copyright (C) 2009 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,
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-procpop)
   :use-module (test-suite lib))
diff --git a/test-suite/tests/q.test b/test-suite/tests/q.test
index 5c24e5202..03f1bebe9 100644
--- a/test-suite/tests/q.test
+++ b/test-suite/tests/q.test
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/test-suite/tests/r4rs.test b/test-suite/tests/r4rs.test
index e47364c66..e26fdada3 100644
--- a/test-suite/tests/r4rs.test
+++ b/test-suite/tests/r4rs.test
@@ -4,7 +4,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/test-suite/tests/r5rs_pitfall.test b/test-suite/tests/r5rs_pitfall.test
index 8fa78e9c1..0bae630b5 100644
--- a/test-suite/tests/r5rs_pitfall.test
+++ b/test-suite/tests/r5rs_pitfall.test
@@ -4,7 +4,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -27,15 +27,15 @@
   (syntax-rules ()
     ((_ test-id value expression)
      (run-test test-id #t (lambda ()
-			    (false-if-exception
-			     (equal? expression value)))))))
+                            (false-if-exception
+                             (equal? expression value)))))))
 
 (define-syntax should-be-but-isnt
   (syntax-rules ()
     ((_ test-id value expression)
      (run-test test-id #f (lambda ()
-			    (false-if-exception
-			     (equal? expression value)))))))
+                            (false-if-exception
+                             (equal? expression value)))))))
 
 (define call/cc call-with-current-continuation)
 
@@ -65,7 +65,7 @@
 (should-be 1.2 #t
   (letrec ((x (call/cc list)) (y (call/cc list)))
     (cond ((procedure? x) (x (pair? y)))
-	  ((procedure? y) (y (pair? x))))
+          ((procedure? y) (y (pair? x))))
     (let ((x (car x)) (y (car y)))
       (and (call/cc x) (call/cc y) (call/cc x)))))
 
@@ -75,11 +75,11 @@
 ;; http://groups.google.com/groups?selm=19890302162742.4.ALAN%40PIGPEN.AI.MIT.EDU
 (should-be 1.3 #t
   (letrec ((x (call-with-current-continuation
-		  (lambda (c)
-		    (list #T c)))))
+                  (lambda (c)
+                    (list #T c)))))
       (if (car x)
-	  ((cadr x) (list #F (lambda () x)))
-	  (eq? x ((cadr x))))))
+          ((cadr x) (list #F (lambda () x)))
+          (eq? x ((cadr x))))))
 
 ;; Section 2: Proper call/cc and procedure application
 
@@ -300,12 +300,12 @@
     (define res1 #f)
     (define res2 #f)
     (set! res1 (map (lambda (x)
-		      (if (= x 0)
-			  (call/cc (lambda (k) (set! cont k) 0))
-			  0))
-		    '(1 0 2)))
+                      (if (= x 0)
+                          (call/cc (lambda (k) (set! cont k) 0))
+                          0))
+                    '(1 0 2)))
     (if (not executed-k)           
-	(begin (set! executed-k #t) 
-	       (set! res2 res1)
-	       (cont 1)))
+        (begin (set! executed-k #t) 
+               (set! res2 res1)
+               (cont 1)))
     res2))
diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test
new file mode 100644
index 000000000..c2b0755f8
--- /dev/null
+++ b/test-suite/tests/r6rs-ports.test
@@ -0,0 +1,459 @@
+;;;; r6rs-ports.test --- Exercise the R6RS I/O port API.
+;;;;
+;;;; Copyright (C) 2009 Free Software Foundation, Inc.
+;;;; Ludovic Court�s
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (test-io-ports)
+  :use-module (test-suite lib)
+  :use-module (srfi srfi-1)
+  :use-module (srfi srfi-11)
+  :use-module (rnrs io ports)
+  :use-module (rnrs bytevector))
+
+;;; All these tests assume Guile 1.8's port system, where characters are
+;;; treated as octets.
+
+;;; Set the default encoding of future ports to be binary
+(setbinary)
+
+
+(with-test-prefix "7.2.5 End-of-File Object"
+
+  (pass-if "eof-object"
+    (and (eqv? (eof-object) (eof-object))
+         (eq?  (eof-object) (eof-object)))))
+
+
+(with-test-prefix "7.2.8 Binary Input"
+
+  (pass-if "get-u8"
+    (let ((port (open-input-string "A")))
+      (and (= (char->integer #\A) (get-u8 port))
+           (eof-object? (get-u8 port)))))
+
+  (pass-if "lookahead-u8"
+    (let ((port (open-input-string "A")))
+      (and (= (char->integer #\A) (lookahead-u8 port))
+           (not (eof-object? port))
+           (= (char->integer #\A) (get-u8 port))
+           (eof-object? (get-u8 port)))))
+
+  (pass-if "get-bytevector-n [short]"
+    (let* ((port (open-input-string "GNU Guile"))
+           (bv (get-bytevector-n port 4)))
+      (and (bytevector? bv)
+           (equal? (bytevector->u8-list bv)
+                   (map char->integer (string->list "GNU "))))))
+
+  (pass-if "get-bytevector-n [long]"
+    (let* ((port (open-input-string "GNU Guile"))
+           (bv (get-bytevector-n port 256)))
+      (and (bytevector? bv)
+           (equal? (bytevector->u8-list bv)
+                   (map char->integer (string->list "GNU Guile"))))))
+
+  (pass-if-exception "get-bytevector-n with closed port"
+    exception:wrong-type-arg
+
+    (let ((port (%make-void-port "r")))
+
+      (close-port port)
+      (get-bytevector-n port 3)))
+
+  (pass-if "get-bytevector-n! [short]"
+    (let* ((port (open-input-string "GNU Guile"))
+           (bv   (make-bytevector 4))
+           (read (get-bytevector-n! port bv 0 4)))
+      (and (equal? read 4)
+           (equal? (bytevector->u8-list bv)
+                   (map char->integer (string->list "GNU "))))))
+
+  (pass-if "get-bytevector-n! [long]"
+    (let* ((str  "GNU Guile")
+           (port (open-input-string str))
+           (bv   (make-bytevector 256))
+           (read (get-bytevector-n! port bv 0 256)))
+      (and (equal? read (string-length str))
+           (equal? (map (lambda (i)
+                          (bytevector-u8-ref bv i))
+                        (iota read))
+                   (map char->integer (string->list str))))))
+
+  (pass-if "get-bytevector-some [simple]"
+    (let* ((str  "GNU Guile")
+           (port (open-input-string str))
+           (bv   (get-bytevector-some port)))
+      (and (bytevector? bv)
+           (equal? (bytevector->u8-list bv)
+                   (map char->integer (string->list str))))))
+
+  (pass-if "get-bytevector-some [only-some]"
+    (let* ((str   "GNU Guile")
+           (index 0)
+           (port  (make-soft-port
+                   (vector #f #f #f
+                           (lambda ()
+                             (if (>= index (string-length str))
+                                 (eof-object)
+                                 (let ((c (string-ref str index)))
+                                   (set! index (+ index 1))
+                                   c)))
+                           (lambda () #t)
+                           (lambda ()
+                             ;; Number of readily available octets: falls to
+                             ;; zero after 4 octets have been read.
+                             (- 4 (modulo index 5))))
+                   "r"))
+           (bv    (get-bytevector-some port)))
+      (and (bytevector? bv)
+           (= index 4)
+           (= (bytevector-length bv) index)
+           (equal? (bytevector->u8-list bv)
+                   (map char->integer (string->list "GNU "))))))
+
+  (pass-if "get-bytevector-all"
+    (let* ((str   "GNU Guile")
+           (index 0)
+           (port  (make-soft-port
+                   (vector #f #f #f
+                           (lambda ()
+                             (if (>= index (string-length str))
+                                 (eof-object)
+                                 (let ((c (string-ref str index)))
+                                   (set! index (+ index 1))
+                                   c)))
+                           (lambda () #t)
+                           (let ((cont? #f))
+                             (lambda ()
+                               ;; Number of readily available octets: falls to
+                               ;; zero after 4 octets have been read and then
+                               ;; starts again.
+                               (let ((a (if cont?
+                                            (- (string-length str) index)
+                                            (- 4 (modulo index 5)))))
+                                 (if (= 0 a) (set! cont? #t))
+                                 a))))
+                   "r"))
+           (bv    (get-bytevector-all port)))
+      (and (bytevector? bv)
+           (= index (string-length str))
+           (= (bytevector-length bv) (string-length str))
+           (equal? (bytevector->u8-list bv)
+                   (map char->integer (string->list str)))))))
+
+
+(define (make-soft-output-port)
+  (let* ((bv (make-bytevector 1024))
+         (read-index  0)
+         (write-index 0)
+         (write-char (lambda (chr)
+                       (bytevector-u8-set! bv write-index
+                                           (char->integer chr))
+                       (set! write-index (+ 1 write-index)))))
+    (make-soft-port
+     (vector write-char
+             (lambda (str)   ;; write-string
+               (for-each write-char (string->list str)))
+             (lambda () #t)  ;; flush-output
+             (lambda ()      ;; read-char
+               (if (>= read-index (bytevector-length bv))
+                   (eof-object)
+                   (let ((c (bytevector-u8-ref bv read-index)))
+                     (set! read-index (+ read-index 1))
+                     (integer->char c))))
+             (lambda () #t)) ;; close-port
+     "rw")))
+
+(with-test-prefix "7.2.11 Binary Output"
+
+  (pass-if "put-u8"
+    (let ((port (make-soft-output-port)))
+      (put-u8 port 77)
+      (equal? (get-u8 port) 77)))
+
+  (pass-if "put-bytevector [2 args]"
+    (let ((port (make-soft-output-port))
+          (bv   (make-bytevector 256)))
+      (put-bytevector port bv)
+      (equal? (bytevector->u8-list bv)
+              (bytevector->u8-list
+               (get-bytevector-n port (bytevector-length bv))))))
+
+  (pass-if "put-bytevector [3 args]"
+    (let ((port  (make-soft-output-port))
+          (bv    (make-bytevector 256))
+          (start 10))
+      (put-bytevector port bv start)
+      (equal? (drop (bytevector->u8-list bv) start)
+              (bytevector->u8-list
+               (get-bytevector-n port (- (bytevector-length bv) start))))))
+
+  (pass-if "put-bytevector [4 args]"
+    (let ((port  (make-soft-output-port))
+          (bv    (make-bytevector 256))
+          (start 10)
+          (count 77))
+      (put-bytevector port bv start count)
+      (equal? (take (drop (bytevector->u8-list bv) start) count)
+              (bytevector->u8-list
+               (get-bytevector-n port count)))))
+
+  (pass-if-exception "put-bytevector with closed port"
+    exception:wrong-type-arg
+
+    (let* ((bv   (make-bytevector 4))
+           (port (%make-void-port "w")))
+
+      (close-port port)
+      (put-bytevector port bv))))
+
+
+(with-test-prefix "7.2.7 Input Ports"
+
+  ;; This section appears here so that it can use the binary input
+  ;; primitives.
+
+  (pass-if "open-bytevector-input-port [1 arg]"
+    (let* ((str "Hello Port!")
+           (bv (u8-list->bytevector (map char->integer
+                                         (string->list str))))
+           (port (open-bytevector-input-port bv))
+           (read-to-string
+            (lambda (port)
+              (let loop ((chr (read-char port))
+                         (result '()))
+                (if (eof-object? chr)
+                    (apply string (reverse! result))
+                    (loop (read-char port)
+                          (cons chr result)))))))
+
+      (equal? (read-to-string port) str)))
+
+  (pass-if-exception "bytevector-input-port is read-only"
+    exception:wrong-type-arg
+
+    (let* ((str "Hello Port!")
+           (bv (u8-list->bytevector (map char->integer
+                                         (string->list str))))
+           (port (open-bytevector-input-port bv #f)))
+
+      (write "hello" port)))
+
+  (pass-if "bytevector input port supports seeking"
+    (let* ((str "Hello Port!")
+           (bv (u8-list->bytevector (map char->integer
+                                         (string->list str))))
+           (port (open-bytevector-input-port bv #f)))
+
+      (and (port-has-port-position? port)
+           (= 0 (port-position port))
+           (port-has-set-port-position!? port)
+           (begin
+             (set-port-position! port 6)
+             (= 6 (port-position port)))
+           (bytevector=? (get-bytevector-all port)
+                         (u8-list->bytevector
+                          (map char->integer (string->list "Port!")))))))
+
+  (pass-if-exception "make-custom-binary-input-port [wrong-num-args]"
+    exception:wrong-num-args
+
+    ;; Prior to Guile-R6RS-Libs 0.2, the last 3 arguments were wrongfully
+    ;; optional.
+    (make-custom-binary-input-port "port" (lambda args #t)))
+
+  (pass-if "make-custom-binary-input-port"
+    (let* ((source (make-bytevector 7777))
+           (read! (let ((pos 0)
+                        (len (bytevector-length source)))
+                    (lambda (bv start count)
+                      (let ((amount (min count (- len pos))))
+                        (if (> amount 0)
+                            (bytevector-copy! source pos
+                                              bv start amount))
+                        (set! pos (+ pos amount))
+                        amount))))
+           (port (make-custom-binary-input-port "the port" read!
+                                                #f #f #f)))
+
+      (bytevector=? (get-bytevector-all port) source)))
+
+  (pass-if "custom binary input port does not support `port-position'"
+    (let* ((str "Hello Port!")
+           (source (open-bytevector-input-port
+                    (u8-list->bytevector
+                     (map char->integer (string->list str)))))
+           (read! (lambda (bv start count)
+                    (let ((r (get-bytevector-n! source bv start count)))
+                      (if (eof-object? r)
+                          0
+                          r))))
+           (port (make-custom-binary-input-port "the port" read!
+                                                #f #f #f)))
+      (not (or (port-has-port-position? port)
+               (port-has-set-port-position!? port)))))
+
+  (pass-if "custom binary input port supports `port-position'"
+    (let* ((str "Hello Port!")
+           (source (open-bytevector-input-port
+                    (u8-list->bytevector
+                     (map char->integer (string->list str)))))
+           (read! (lambda (bv start count)
+                    (let ((r (get-bytevector-n! source bv start count)))
+                      (if (eof-object? r)
+                          0
+                          r))))
+           (get-pos (lambda ()
+                      (port-position source)))
+           (set-pos! (lambda (pos)
+                       (set-port-position! source pos)))
+           (port (make-custom-binary-input-port "the port" read!
+                                                get-pos set-pos! #f)))
+
+      (and (port-has-port-position? port)
+           (= 0 (port-position port))
+           (port-has-set-port-position!? port)
+           (begin
+             (set-port-position! port 6)
+             (= 6 (port-position port)))
+           (bytevector=? (get-bytevector-all port)
+                         (u8-list->bytevector
+                          (map char->integer (string->list "Port!")))))))
+
+  (pass-if "custom binary input port `close-proc' is called"
+    (let* ((closed?  #f)
+           (read!    (lambda (bv start count) 0))
+           (get-pos  (lambda () 0))
+           (set-pos! (lambda (pos) #f))
+           (close!   (lambda () (set! closed? #t)))
+           (port     (make-custom-binary-input-port "the port" read!
+                                                    get-pos set-pos!
+                                                    close!)))
+
+      (close-port port)
+      (gc) ; Test for marking a closed port.
+      closed?)))
+
+
+(with-test-prefix "8.2.10 Output ports"
+
+  (pass-if "open-bytevector-output-port"
+    (let-values (((port get-content)
+                  (open-bytevector-output-port #f)))
+      (let ((source (make-bytevector 7777)))
+        (put-bytevector port source)
+        (and (bytevector=? (get-content) source)
+             (bytevector=? (get-content) (make-bytevector 0))))))
+
+  (pass-if "open-bytevector-output-port [put-u8]"
+    (let-values (((port get-content)
+                  (open-bytevector-output-port)))
+      (put-u8 port 77)
+      (and (bytevector=? (get-content) (make-bytevector 1 77))
+           (bytevector=? (get-content) (make-bytevector 0)))))
+
+  (pass-if "open-bytevector-output-port [display]"
+    (let-values (((port get-content)
+                  (open-bytevector-output-port)))
+      (display "hello" port)
+      (and (bytevector=? (get-content) (string->utf8 "hello"))
+           (bytevector=? (get-content) (make-bytevector 0)))))
+
+  (pass-if "bytevector output port supports `port-position'"
+    (let-values (((port get-content)
+                  (open-bytevector-output-port)))
+      (let ((source (make-bytevector 7777))
+            (overwrite (make-bytevector 33)))
+        (and (port-has-port-position? port)
+             (port-has-set-port-position!? port)
+             (begin
+               (put-bytevector port source)
+               (= (bytevector-length source)
+                  (port-position port)))
+             (begin
+               (set-port-position! port 10)
+               (= 10 (port-position port)))
+             (begin
+               (put-bytevector port overwrite)
+               (bytevector-copy! overwrite 0 source 10
+                                 (bytevector-length overwrite))
+               (= (port-position port)
+                  (+ 10 (bytevector-length overwrite))))
+             (bytevector=? (get-content) source)
+             (bytevector=? (get-content) (make-bytevector 0))))))
+
+  (pass-if "make-custom-binary-output"
+    (let ((port (make-custom-binary-output-port "cbop"
+                                                (lambda (x y z) 0)
+                                                #f #f #f)))
+      (and (output-port? port)
+           (binary-port? port)
+           (not (port-has-port-position? port))
+           (not (port-has-set-port-position!? port)))))
+
+  (pass-if "make-custom-binary-output-port [partial writes]"
+    (let* ((source   (uint-list->bytevector (iota 333)
+                                            (native-endianness) 2))
+           (sink     (make-bytevector (bytevector-length source)))
+           (sink-pos 0)
+           (eof?     #f)
+           (write!   (lambda (bv start count)
+                       (if (= 0 count)
+                           (begin
+                             (set! eof? #t)
+                             0)
+                           (let ((u8 (bytevector-u8-ref bv start)))
+                             ;; Get one byte at a time.
+                             (bytevector-u8-set! sink sink-pos u8)
+                             (set! sink-pos (+ 1 sink-pos))
+                             1))))
+           (port     (make-custom-binary-output-port "cbop" write!
+                                                     #f #f #f)))
+      (put-bytevector port source)
+      (and (= sink-pos (bytevector-length source))
+           (not eof?)
+           (bytevector=? sink source))))
+
+  (pass-if "make-custom-binary-output-port [full writes]"
+    (let* ((source   (uint-list->bytevector (iota 333)
+                                            (native-endianness) 2))
+           (sink     (make-bytevector (bytevector-length source)))
+           (sink-pos 0)
+           (eof?     #f)
+           (write!   (lambda (bv start count)
+                       (if (= 0 count)
+                           (begin
+                             (set! eof? #t)
+                             0)
+                           (begin
+                             (bytevector-copy! bv start
+                                               sink sink-pos
+                                               count)
+                             (set! sink-pos (+ sink-pos count))
+                             count))))
+           (port     (make-custom-binary-output-port "cbop" write!
+                                                     #f #f #f)))
+      (put-bytevector port source)
+      (and (= sink-pos (bytevector-length source))
+           (not eof?)
+           (bytevector=? sink source)))))
+
+
+;;; Local Variables:
+;;; coding: latin-1
+;;; mode: scheme
+;;; End:
diff --git a/test-suite/tests/ramap.test b/test-suite/tests/ramap.test
index d923bc1f2..948a77870 100644
--- a/test-suite/tests/ramap.test
+++ b/test-suite/tests/ramap.test
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/test-suite/tests/reader.test b/test-suite/tests/reader.test
index b068c716d..0eb851508 100644
--- a/test-suite/tests/reader.test
+++ b/test-suite/tests/reader.test
@@ -6,13 +6,13 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
-;;;;
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 ;;;; Lesser General Public License for more details.
-;;;;
+;;;; 
 ;;;; You should have received a copy of the GNU Lesser General Public
 ;;;; License along with this library; if not, write to the Free Software
 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
@@ -35,6 +35,8 @@
   (cons 'read-error "end of file in string constant$"))
 (define exception:illegal-escape
   (cons 'read-error "illegal character in escape sequence: .*$"))
+(define exception:missing-expression
+  (cons 'read-error "no expression after #;"))
 
 
 (define (read-string s)
@@ -165,6 +167,11 @@
          (with-read-options '(keywords postfix)
            (lambda ()
              (read-string "keyword:")))))
+  (pass-if "long postfix keywords"
+    (eq? #:keyword0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789
+         (with-read-options '(keywords postfix)
+           (lambda ()
+             (read-string "keyword0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789:")))))
   (pass-if "`:' is not a postfix keyword (per SRFI-88)"
     (eq? ':
          (with-read-options '(keywords postfix)
@@ -189,3 +196,36 @@
       (and (equal? (source-property sexp 'line) 0)
            (equal? (source-property sexp 'column) 0)))))
 
+(with-test-prefix "#;"
+  (for-each
+   (lambda (pair)
+     (pass-if (car pair)
+       (equal? (with-input-from-string (car pair) read) (cdr pair))))
+
+   '(("#;foo 10". 10)
+     ("#;(10 20 30) foo" . foo)
+     ("#;   (10 20 30) foo" . foo)
+     ("#;\n10\n20" . 20)))
+  
+  (pass-if "#;foo"
+    (eof-object? (with-input-from-string "#;foo" read)))
+  
+  (pass-if-exception "#;"
+    exception:missing-expression
+    (with-input-from-string "#;" read))
+  (pass-if-exception "#;("
+    exception:eof
+    (with-input-from-string "#;(" read)))
+
+(with-test-prefix "#'"
+  (for-each
+   (lambda (pair)
+     (pass-if (car pair)
+       (equal? (with-input-from-string (car pair) read) (cdr pair))))
+
+   '(("#'foo". (syntax foo))
+     ("#`foo" . (quasisyntax foo))
+     ("#,foo" . (unsyntax foo))
+     ("#,@foo" . (unsyntax-splicing foo)))))
+
+
diff --git a/test-suite/tests/receive.test b/test-suite/tests/receive.test
index 4b55bdf9f..3fb4abe20 100644
--- a/test-suite/tests/receive.test
+++ b/test-suite/tests/receive.test
@@ -2,20 +2,19 @@
 ;;;;
 ;;;; Copyright (C) 2004, 2006 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,
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-suite test-receive)
   #:use-module (test-suite lib)
diff --git a/test-suite/tests/regexp.test b/test-suite/tests/regexp.test
index 15f77a34c..730839970 100644
--- a/test-suite/tests/regexp.test
+++ b/test-suite/tests/regexp.test
@@ -3,20 +3,19 @@
 ;;;;
 ;;;; 	Copyright (C) 1999, 2004, 2006, 2007, 2008 Free Software Foundation, Inc.
 ;;;; 
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
 ;;;; 
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-suite test-regexp)
   #:use-module (test-suite lib)
diff --git a/test-suite/tests/socket.test b/test-suite/tests/socket.test
index 4bfc41557..7626ceebf 100644
--- a/test-suite/tests/socket.test
+++ b/test-suite/tests/socket.test
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/test-suite/tests/sort.test b/test-suite/tests/sort.test
index a49c04857..292836d88 100644
--- a/test-suite/tests/sort.test
+++ b/test-suite/tests/sort.test
@@ -1,20 +1,19 @@
 ;;;; sort.test --- tests Guile's sort functions    -*- scheme -*-
 ;;;; Copyright (C) 2003, 2006, 2007 Free Software Foundation, Inc.
 ;;;; 
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
 ;;;; 
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (use-modules (test-suite lib))
 
diff --git a/test-suite/tests/srcprop.test b/test-suite/tests/srcprop.test
index 5bfe68080..17d8ae2d9 100644
--- a/test-suite/tests/srcprop.test
+++ b/test-suite/tests/srcprop.test
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -36,11 +36,51 @@
       (not (null? (source-properties s))))))
 
 ;;;
+;;; set-source-property!
+;;;
+
+(with-test-prefix "set-source-property!"
+  (read-enable 'positions)
+
+  (pass-if "setting the breakpoint property works"
+    (let ((s (read (open-input-string "(+ 3 4)"))))
+      (set-source-property! s 'breakpoint #t)
+      (let ((current-trap-opts (evaluator-traps-interface))
+	    (current-debug-opts (debug-options-interface))
+	    (trap-called #f))
+	(trap-set! enter-frame-handler (lambda _ (set! trap-called #t)))
+	(trap-enable 'traps)
+	(debug-enable 'debug)
+	(debug-enable 'breakpoints)
+	(with-traps (lambda ()
+		      (primitive-eval s)))
+	(evaluator-traps-interface current-trap-opts)
+	(debug-options-interface current-debug-opts)
+	trap-called))))
+
+;;;
 ;;; set-source-properties!
 ;;;
 
 (with-test-prefix "set-source-properties!"
   (read-enable 'positions)
+
+  (pass-if "setting the breakpoint property works"
+    (let ((s (read (open-input-string "(+ 3 4)"))))
+      (set-source-properties! s '((breakpoint #t)))
+      (let ((current-trap-opts (evaluator-traps-interface))
+	    (current-debug-opts (debug-options-interface))
+	    (trap-called #f))
+	(trap-set! enter-frame-handler (lambda _ (set! trap-called #t)))
+	(trap-enable 'traps)
+	(debug-enable 'debug)
+	(debug-enable 'breakpoints)
+	(with-traps (lambda ()
+		      (primitive-eval s)))
+	(evaluator-traps-interface current-trap-opts)
+	(debug-options-interface current-debug-opts)
+	trap-called)))
+
   (let ((s (read (open-input-string "(1 . 2)"))))
     
     (with-test-prefix "copied props"
@@ -48,7 +88,7 @@
 	(let ((t (cons 3 4)))
 	  (set-source-properties! t (source-properties s))
 	  (number? (source-property t 'line))))
-      
+
       (pass-if "visible to source-properties"
 	(let ((t (cons 3 4)))
 	  (set-source-properties! t (source-properties s))
diff --git a/test-suite/tests/srfi-1.test b/test-suite/tests/srfi-1.test
index 4f2838744..c163e7b69 100644
--- a/test-suite/tests/srfi-1.test
+++ b/test-suite/tests/srfi-1.test
@@ -2,20 +2,19 @@
 ;;;;
 ;;;; Copyright 2003, 2004, 2005, 2006, 2008 Free Software Foundation, Inc.
 ;;;;
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; 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,
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-srfi-1)
   #:use-module (test-suite lib)
diff --git a/test-suite/tests/srfi-10.test b/test-suite/tests/srfi-10.test
index 248c04ff7..ab3cb884e 100644
--- a/test-suite/tests/srfi-10.test
+++ b/test-suite/tests/srfi-10.test
@@ -3,20 +3,19 @@
 ;;;;
 ;;;; Copyright (C) 2001, 2006 Free Software Foundation, Inc.
 ;;;; 
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
 ;;;; 
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (use-modules (srfi srfi-10))
 
diff --git a/test-suite/tests/srfi-11.test b/test-suite/tests/srfi-11.test
index ec2ed86c8..40563dc18 100644
--- a/test-suite/tests/srfi-11.test
+++ b/test-suite/tests/srfi-11.test
@@ -2,20 +2,19 @@
 ;;;;
 ;;;; Copyright 2004, 2006 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,
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-suite test-srfi-11)
   #:use-module (test-suite lib)
diff --git a/test-suite/tests/srfi-13.test b/test-suite/tests/srfi-13.test
index 89759d0d3..d8e379959 100644
--- a/test-suite/tests/srfi-13.test
+++ b/test-suite/tests/srfi-13.test
@@ -3,20 +3,19 @@
 ;;;;
 ;;;; Copyright (C) 2001, 2004, 2005, 2006 Free Software Foundation, Inc.
 ;;;;
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU 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,
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-strings)
   #:use-module (test-suite lib)
@@ -31,6 +30,9 @@
 (define (string-ints . args)
   (apply string (map integer->char args)))
 
+;; Some abbreviations
+;; BMP - Basic Multilingual Plane (codepoints below U+FFFF)
+;; SMP - Suplementary Multilingual Plane (codebpoints from U+10000 to U+1FFFF)
 
 ;;;
 ;;; string-any
@@ -54,6 +56,12 @@
     (pass-if "one match"
       (string-any #\C "abCde"))
 
+    (pass-if "one match: BMP"
+      (string-any (integer->char #x0100) "ab\u0100de"))
+
+    (pass-if "one match: SMP"
+      (string-any (integer->char #x010300) "ab\U010300de"))
+
     (pass-if "more than one match"
       (string-any #\X "abXXX"))
 
@@ -152,7 +160,9 @@
     (pass-if (string=? ""       (string-append/shared ""    "")))
     (pass-if (string=? "xyz"    (string-append/shared "xyz" "")))
     (pass-if (string=? "xyz"    (string-append/shared ""    "xyz")))
-    (pass-if (string=? "abcxyz" (string-append/shared "abc" "xyz"))))
+    (pass-if (string=? "abcxyz" (string-append/shared "abc" "xyz")))
+    (pass-if (string=? "abc\u0100\u0101" 
+                       (string-append/shared "abc" "\u0100\u0101"))))
 
   (with-test-prefix "three args"
     (pass-if (string=? ""   	(string-append/shared ""   ""   "")))
@@ -192,7 +202,10 @@
   (pass-if-exception "improper 1" exception:wrong-type-arg
     (string-concatenate '("a" . "b")))
 
-  (pass-if (equal? "abc" (string-concatenate '("a" "b" "c")))))
+  (pass-if (equal? "abc" (string-concatenate '("a" "b" "c"))))
+
+  (pass-if "concatenate BMP"
+    (equal? "a\u0100" (string-concatenate '("a" "\u0100")))))
 
 ;;
 ;; string-compare
@@ -235,7 +248,10 @@
   (pass-if-exception "improper 1" exception:wrong-type-arg
     (string-concatenate/shared '("a" . "b")))
 
-  (pass-if (equal? "abc" (string-concatenate/shared '("a" "b" "c")))))
+  (pass-if (equal? "abc" (string-concatenate/shared '("a" "b" "c"))))
+
+  (pass-if "BMP" 
+    (equal? "a\u0100c" (string-concatenate/shared '("a" "\u0100" "c")))))
 
 ;;;
 ;;; string-every
@@ -268,6 +284,9 @@
     (pass-if "all match"
       (string-every #\X "XXXXX"))
 
+    (pass-if "all match BMP"
+      (string-every #\200000 "\U010000\U010000"))
+
     (pass-if "no match at all, start index"
       (not (string-every #\X "Xbcde" 1)))
 
@@ -387,6 +406,9 @@
 
    (pass-if "nonempty, start index"
      (= (length (string->list "foo" 1 3)) 2))
+
+   (pass-if "nonempty, start index, BMP"
+     (= (length (string->list "\xff\u0100\u0300" 1 3)) 2))
   )
 
 (with-test-prefix "reverse-list->string"
@@ -395,8 +417,10 @@
      (string-null? (reverse-list->string '())))
 
   (pass-if "nonempty"
-     (string=? "foo" (reverse-list->string '(#\o #\o #\f)))))
+     (string=? "foo" (reverse-list->string '(#\o #\o #\f))))
 
+  (pass-if "nonempty, BMP"
+     (string=? "\u0100\u0101\u0102" (reverse-list->string '(#\402 #\401 #\400)))))
 
 (with-test-prefix "string-join"
 
@@ -437,6 +461,11 @@
      (string=? "bla|delim|fasel" (string-join '("bla" "fasel") "|delim|"
 					      'infix)))
 
+  (pass-if "two strings, explicit infix, BMP"
+     (string=? "\u0100\u0101::\u0102\u0103" 
+               (string-join '("\u0100\u0101" "\u0102\u0103") "::"
+                            'infix)))
+
   (pass-if-exception "empty list, strict infix"
      exception:strict-infix-grammar
      (string-join '() "|delim|" 'strict-infix))
@@ -485,9 +514,15 @@
   (pass-if "full string"
     (string=? "foo-bar" (string-copy "foo-bar")))
 
+  (pass-if "full string, BMP"
+    (string=? "foo-\u0100\u0101" (string-copy "foo-\u0100\u0101")))
+
   (pass-if "start index"
     (string=? "o-bar" (string-copy "foo-bar" 2)))
 
+  (pass-if "start index"
+    (string=? "o-bar" (string-copy "\u0100\u0101o-bar" 2)))
+
   (pass-if "start and end index"
     (string=? "o-ba" (string-copy "foo-bar" 2 6)))
 )
@@ -520,6 +555,9 @@
   (pass-if "non-empty string"
     (string=? "foo " (string-take "foo bar braz" 4)))
 
+  (pass-if "non-empty string BMP"
+    (string=? "\u0100oo " (string-take "\u0100oo \u0101ar braz" 4)))
+
   (pass-if "full string"
     (string=? "foo bar braz" (string-take "foo bar braz" 12))))
 
@@ -531,6 +569,9 @@
   (pass-if "non-empty string"
     (string=? "braz" (string-take-right "foo bar braz" 4)))
 
+  (pass-if "non-empty string"
+    (string=? "braz" (string-take-right "foo ba\u0100 braz" 4)))
+
   (pass-if "full string"
     (string=? "foo bar braz" (string-take-right "foo bar braz" 12))))
 
@@ -542,6 +583,9 @@
   (pass-if "non-empty string"
     (string=? "braz" (string-drop "foo bar braz" 8)))
 
+  (pass-if "non-empty string BMP"
+    (string=? "braz" (string-drop "foo \u0100\u0101\u0102 braz" 8)))
+
   (pass-if "full string"
     (string=? "foo bar braz" (string-drop "foo bar braz" 0))))
 
@@ -553,6 +597,9 @@
   (pass-if "non-empty string"
     (string=? "foo " (string-drop-right "foo bar braz" 8)))
 
+  (pass-if "non-empty string BMP"
+    (string=? "foo " (string-drop-right "foo \u0100\u0101\u0102 braz" 8)))
+
   (pass-if "full string"
     (string=? "foo bar braz" (string-drop-right "foo bar braz" 0))))
 
diff --git a/test-suite/tests/srfi-14.test b/test-suite/tests/srfi-14.test
index fc6307149..56c944a42 100644
--- a/test-suite/tests/srfi-14.test
+++ b/test-suite/tests/srfi-14.test
@@ -1,22 +1,22 @@
-;;;; srfi-14.test --- Test suite for Guile's SRFI-14 functions.
+;;;; srfi-14.test          -*- mode:scheme; coding: iso-8859-1 -*-
+;;;; --- Test suite for Guile's SRFI-14 functions.
 ;;;; Martin Grabmueller, 2001-07-16
 ;;;;
 ;;;; Copyright (C) 2001, 2006 Free Software Foundation, Inc.
 ;;;; 
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
 ;;;; 
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-suite test-srfi-14)
   :use-module (srfi srfi-14)
@@ -30,6 +30,30 @@
 (define exception:non-char-return
   (cons 'misc-error "returned non-char"))
 
+
+(with-test-prefix "char set contents"
+
+  (pass-if "empty set"
+    (list= eqv? 
+           (char-set->list (char-set))
+           '()))
+
+  (pass-if "single char"
+    (list= eqv?
+           (char-set->list (char-set #\a))
+           (list #\a)))
+
+  (pass-if "contiguous chars"
+    (list= eqv?
+           (char-set->list (char-set #\a #\b #\c))
+           (list #\a #\b #\c))) 
+
+  (pass-if "discontiguous chars"
+    (list= eqv?
+           (char-set->list (char-set #\a #\c #\e))
+           (list #\a #\c #\e))))
+          
+
 (with-test-prefix "char-set?"
 
   (pass-if "success on empty set"
@@ -114,7 +138,7 @@
 (with-test-prefix "char-set cursor"
 
   (pass-if-exception "invalid character cursor" 
-     exception:invalid-char-set-cursor
+     exception:wrong-type-arg
      (let* ((cs (char-set #\B #\r #\a #\z))
 	    (cc (char-set-cursor cs)))
        (char-set-ref cs 1000)))
@@ -149,30 +173,33 @@
      (= (char-set-size (char-set-fold (lambda (c cs) (char-set-adjoin cs c)) 
 				      (char-set) (char-set #\a #\b))) 2)))
 
+(define char-set:256 
+  (string->char-set (apply string (map integer->char (iota 256)))))
+
 (with-test-prefix "char-set-unfold"
 
   (pass-if "create char set"
-     (char-set= char-set:full
+     (char-set= char-set:256
 		(char-set-unfold (lambda (s) (= s 256)) integer->char
 				 (lambda (s) (+ s 1)) 0)))
   (pass-if "create char set (base set)"
-     (char-set= char-set:full
+     (char-set= char-set:256
 		(char-set-unfold (lambda (s) (= s 256)) integer->char
 				 (lambda (s) (+ s 1)) 0 char-set:empty))))
 
 (with-test-prefix "char-set-unfold!"
 
   (pass-if "create char set"
-     (char-set= char-set:full
+     (char-set= char-set:256
 		(char-set-unfold! (lambda (s) (= s 256)) integer->char
 				 (lambda (s) (+ s 1)) 0
 				 (char-set-copy char-set:empty))))
 
   (pass-if "create char set"
-     (char-set= char-set:full
+     (char-set= char-set:256
 		(char-set-unfold! (lambda (s) (= s 32)) integer->char
 				 (lambda (s) (+ s 1)) 0
-				 (char-set-copy char-set:full)))))
+				 (char-set-copy char-set:256)))))
 
 
 (with-test-prefix "char-set-for-each"
@@ -187,9 +214,15 @@
 
 (with-test-prefix "char-set-map"
 
-  (pass-if "upper case char set"
-     (char-set= (char-set-map char-upcase char-set:lower-case)
-		char-set:upper-case)))
+  (pass-if "upper case char set 1"
+     (char-set= (char-set-map char-upcase 
+                              (string->char-set "abcdefghijklmnopqrstuvwxyz"))
+                (string->char-set "ABCDEFGHIJKLMNOPQRSTUVWXYZ")))
+
+  (pass-if "upper case char set 2"
+     (char-set= (char-set-map char-upcase 
+                              (string->char-set "�����������������������������"))
+                (string->char-set "�����������������������������"))))
 
 (with-test-prefix "string->char-set"
 
@@ -198,42 +231,104 @@
        (char-set= (list->char-set chars)
 		  (string->char-set (apply string chars))))))
 
-;; Make sure we get an ASCII charset and character classification.
-(if (defined? 'setlocale) (setlocale LC_CTYPE "C"))
+(with-test-prefix "char-set->string"
+
+  (pass-if "some char set"
+     (let ((cs (char-set #\g #\u #\i #\l #\e)))
+       (string=? (char-set->string cs)
+                 "egilu"))))
 
 (with-test-prefix "standard char sets (ASCII)"
 
+  (pass-if "char-set:lower-case"
+     (char-set<= (string->char-set "abcdefghijklmnopqrstuvwxyz")
+                 char-set:lower-case))
+
+  (pass-if "char-set:upper-case"
+     (char-set<= (string->char-set "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+                 char-set:upper-case))
+
+  (pass-if "char-set:title-case"
+     (char-set<= (string->char-set "")
+                 char-set:title-case))
+
   (pass-if "char-set:letter"
-     (char-set= (string->char-set
-		 (string-append "abcdefghijklmnopqrstuvwxyz"
-				"ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
-		char-set:letter))
+     (char-set<= (char-set-union
+                  (string->char-set "abcdefghijklmnopqrstuvwxyz")
+                  (string->char-set "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
+                 char-set:letter))
 
-  (pass-if "char-set:punctuation"
-     (char-set= (string->char-set "!\"#%&'()*,-./:;?@[\\]_{}")
-		char-set:punctuation))
+  (pass-if "char-set:digit"
+     (char-set<= (string->char-set "0123456789")
+                 char-set:digit))
 
-  (pass-if "char-set:symbol"
-     (char-set= (string->char-set "$+<=>^`|~")
-		char-set:symbol))
+  (pass-if "char-set:hex-digit"
+     (char-set<= (string->char-set "0123456789abcdefABCDEF")
+                 char-set:hex-digit))
 
   (pass-if "char-set:letter+digit"
-     (char-set= char-set:letter+digit
-                (char-set-union char-set:letter char-set:digit)))
+     (char-set<= (char-set-union
+                  (string->char-set "abcdefghijklmnopqrstuvwxyz")
+                  (string->char-set "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+                  (string->char-set "0123456789"))
+                 char-set:letter+digit))
 
-  (pass-if "char-set:graphic"
-     (char-set= char-set:graphic
-                (char-set-union char-set:letter char-set:digit
-                                char-set:punctuation char-set:symbol)))
+  (pass-if "char-set:punctuation"
+     (char-set<= (string->char-set "!\"#%&'()*,-./:;?@[\\]_{}")
+                 char-set:punctuation))
 
-  (pass-if "char-set:printing"
-      (char-set= char-set:printing
-                 (char-set-union char-set:whitespace char-set:graphic))))
+  (pass-if "char-set:symbol"
+     (char-set<= (string->char-set "$+<=>^`|~")
+                 char-set:symbol))
 
+  (pass-if "char-set:graphic"
+     (char-set<= (char-set-union
+                  (string->char-set "abcdefghijklmnopqrstuvwxyz")
+                  (string->char-set "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+                  (string->char-set "0123456789")
+                  (string->char-set "!\"#%&'()*,-./:;?@[\\]_{}")
+                  (string->char-set "$+<=>^`|~"))
+                 char-set:graphic))
+
+  (pass-if "char-set:whitespace"
+     (char-set<= (string->char-set 
+                  (string
+                   (integer->char #x09)
+                   (integer->char #x0a)
+                   (integer->char #x0b)
+                   (integer->char #x0c)
+                   (integer->char #x0d)
+                   (integer->char #x20)))
+                 char-set:whitespace))
+                                  
+  (pass-if "char-set:printing"
+     (char-set<= (char-set-union
+                  (string->char-set "abcdefghijklmnopqrstuvwxyz")
+                  (string->char-set "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+                  (string->char-set "0123456789")
+                  (string->char-set "!\"#%&'()*,-./:;?@[\\]_{}")
+                  (string->char-set "$+<=>^`|~")
+                  (string->char-set (string
+                                     (integer->char #x09)
+                                     (integer->char #x0a)
+                                     (integer->char #x0b)
+                                     (integer->char #x0c)
+                                     (integer->char #x0d)
+                                     (integer->char #x20))))
+                 char-set:printing))
+
+  (pass-if "char-set:iso-control"
+     (char-set<= (string->char-set 
+                  (apply string 
+                         (map integer->char (append 
+                                             ;; U+0000 to U+001F
+                                             (iota #x20)
+                                             (list #x7f)))))
+                 char-set:iso-control)))
 
 
 ;;;
-;;; 8-bit charsets.
+;;; Non-ASCII codepoints
 ;;;
 ;;; Here, we only test ISO-8859-1 (Latin-1), notably because behavior of
 ;;; SRFI-14 for implementations supporting this charset is well-defined.
@@ -242,76 +337,105 @@
 (define (every? pred lst)
   (not (not (every pred lst))))
 
-(define (find-latin1-locale)
-  ;; Try to find and install an ISO-8859-1 locale.  Return `#f' on failure.
-  (if (defined? 'setlocale)
-      (let loop ((locales (map (lambda (lang)
-				 (string-append lang ".iso88591"))
-			       '("de_DE" "en_GB" "en_US" "es_ES"
-				 "fr_FR" "it_IT"))))
-	(if (null? locales)
-	    #f
-	    (if (false-if-exception (setlocale LC_CTYPE (car locales)))
-		(car locales)
-		(loop (cdr locales)))))
-      #f))
+(define oldlocale #f)
+(if (defined? 'setlocale)
+    (set! oldlocale (setlocale LC_ALL "")))
 
+(with-test-prefix "Latin-1 (8-bit charset)"
 
-(define %latin1 (find-latin1-locale))
+  (pass-if "char-set:lower-case"
+    (char-set<= (string->char-set
+                 (string-append "abcdefghijklmnopqrstuvwxyz"
+                                "���������������������������������")
+                 char-set:lower-case)))
 
-(with-test-prefix "Latin-1 (8-bit charset)"
+  (pass-if "char-set:upper-case"
+    (char-set<= (string->char-set
+                 (string-append "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+                                "������������������������������")
+                 char-set:lower-case)))
 
-  ;; Note: the membership tests below are not exhaustive.
-
-  (pass-if "char-set:letter (membership)"
-     (if (not %latin1)
-	 (throw 'unresolved)
-	 (let ((letters (char-set->list char-set:letter)))
-	   (every? (lambda (8-bit-char)
-		     (memq 8-bit-char letters))
-		   (append '(#\a #\b #\c)             ;; ASCII
-			   (string->list "���������") ;; French
-			   (string->list "���������"))))))
-
-  (pass-if "char-set:letter (size)"
-     (if (not %latin1)
-	 (throw 'unresolved)
-	 (= (char-set-size char-set:letter) 117)))
-
-  (pass-if "char-set:lower-case (size)"
-     (if (not %latin1)
-	 (throw 'unresolved)
-	 (= (char-set-size char-set:lower-case) (+ 26 33))))
-
-  (pass-if "char-set:upper-case (size)"
-     (if (not %latin1)
-	 (throw 'unresolved)
-	 (= (char-set-size char-set:upper-case) (+ 26 30))))
-
-  (pass-if "char-set:punctuation (membership)"
-     (if (not %latin1)
-	 (throw 'unresolved)
-	 (let ((punctuation (char-set->list char-set:punctuation)))
-	   (every? (lambda (8-bit-char)
-		     (memq 8-bit-char punctuation))
-		   (append '(#\! #\. #\?)            ;; ASCII
-			   (string->list "��")       ;; Castellano
-			   (string->list "��"))))))  ;; French
+  (pass-if "char-set:title-case"
+    (char-set<= (string->char-set "")
+                char-set:title-case))
+
+  (pass-if "char-set:letter"
+    (char-set<= (string->char-set
+                 (string-append 
+                  ;; Lowercase
+                  "abcdefghijklmnopqrstuvwxyz" 
+                  "���������������������������������"
+                  ;; Uppercase
+                  "ABCDEFGHIJKLMNOPQRSTUVWXYZ" 
+                  "������������������������������"
+                  ;; Uncased
+                  "��")) 
+                char-set:letter))
+  
+  (pass-if "char-set:digit"
+    (char-set<= (string->char-set "0123456789")
+                char-set:digit))
+
+  (pass-if "char-set:hex-digit"
+    (char-set<= (string->char-set "0123456789abcdefABCDEF")
+                char-set:hex-digit))
 
   (pass-if "char-set:letter+digit"
-     (char-set= char-set:letter+digit
-                (char-set-union char-set:letter char-set:digit)))
+    (char-set<= (char-set-union
+                 char-set:letter
+                 char-set:digit)
+                char-set:letter+digit))
 
-  (pass-if "char-set:graphic"
-     (char-set= char-set:graphic
-                (char-set-union char-set:letter char-set:digit
-                                char-set:punctuation char-set:symbol)))
+  (pass-if "char-set:punctuation"
+    (char-set<= (string->char-set 
+                 (string-append "!\"#%&'()*,-./:;?@[\\]_{}"
+                                "�����"))
+                char-set:punctuation))
 
+  (pass-if "char-set:symbol"
+    (char-set<= (string->char-set 
+                 (string-append "$+<=>^`|~"
+                                "������������������"))
+                char-set:symbol))
+
+  ;; Note that SRFI-14 itself is inconsistent here.  Characters that
+  ;; are non-digit numbers (such as category No) are clearly 'graphic'
+  ;; but don't occur in the letter, digit, punct, or symbol charsets.
+  (pass-if "char-set:graphic"
+    (char-set<= (char-set-union
+                 char-set:letter
+                 char-set:digit
+                 char-set:punctuation
+                 char-set:symbol)
+                char-set:graphic))
+
+  (pass-if "char-set:whitespace"
+    (char-set<= (string->char-set 
+                 (string
+                  (integer->char #x09)
+                  (integer->char #x0a)
+                  (integer->char #x0b)
+                  (integer->char #x0c)
+                  (integer->char #x0d)
+                  (integer->char #x20)
+                  (integer->char #xa0)))
+                char-set:whitespace))
+                                  
   (pass-if "char-set:printing"
-     (char-set= char-set:printing
-                (char-set-union char-set:whitespace char-set:graphic))))
-
-;; Local Variables:
-;; mode: scheme
-;; coding: latin-1
-;; End:
+    (char-set<= (char-set-union char-set:graphic char-set:whitespace)
+                char-set:printing))
+
+  (pass-if "char-set:iso-control"
+    (char-set<= (string->char-set 
+                 (apply string 
+                        (map integer->char (append 
+                                            ;; U+0000 to U+001F
+                                            (iota #x20)
+                                            (list #x7f)
+                                            ;; U+007F to U+009F
+                                            (map (lambda (x) (+ #x80 x))
+                                                 (iota #x20))))))
+                char-set:iso-control)))
+
+(if (defined? 'setlocale)
+    (setlocale LC_ALL oldlocale))
diff --git a/test-suite/tests/srfi-17.test b/test-suite/tests/srfi-17.test
index fbacb15a3..d9e0054ba 100644
--- a/test-suite/tests/srfi-17.test
+++ b/test-suite/tests/srfi-17.test
@@ -2,20 +2,19 @@
 ;;;;
 ;;;; Copyright (C) 2001, 2003, 2005, 2006 Free Software Foundation, Inc.
 ;;;; 
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
 ;;;; 
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-suite test-srfi-17)
   :use-module (test-suite lib)
@@ -50,6 +49,9 @@
 
 (define %some-variable #f)
 
+(define exception:bad-quote
+  '(syntax-error . "quote: bad syntax"))
+
 (with-test-prefix "set!"
 
   (with-test-prefix "target is not procedure with setter"
@@ -59,7 +61,7 @@
       (set! (symbol->string 'x) 1))
 
     (pass-if-exception "(set! '#f 1)"
-      exception:bad-variable
+      exception:bad-quote
       (eval '(set! '#f 1) (interaction-environment))))
 
   (with-test-prefix "target uses macro"
@@ -72,7 +74,7 @@
     ;; The `(quote x)' below used to be memoized as an infinite list before
     ;; Guile 1.8.3.
     (pass-if-exception "(set! 'x 1)"
-      exception:bad-variable
+      exception:bad-quote
       (eval '(set! 'x 1) (interaction-environment)))))
 
 ;;
diff --git a/test-suite/tests/srfi-18.test b/test-suite/tests/srfi-18.test
index fa309e6ce..b769ce1a2 100644
--- a/test-suite/tests/srfi-18.test
+++ b/test-suite/tests/srfi-18.test
@@ -3,26 +3,30 @@
 ;;;;
 ;;;; Copyright (C) 2007, 2008 Free Software Foundation, Inc.
 ;;;; 
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
 ;;;; 
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-suite test-srfi-18)
   #:use-module (test-suite lib))
 
-(and (provided? 'threads)
-     (use-modules (srfi srfi-18))
+;; two expressions so that the srfi-18 import is in effect for expansion
+;; of the rest
+(if (provided? 'threads)
+    (use-modules (srfi srfi-18)))
+
+(and
+ (provided? 'threads)
 
 (with-test-prefix "current-thread"
 
diff --git a/test-suite/tests/srfi-19.test b/test-suite/tests/srfi-19.test
index 259a88a4e..f48ce6286 100644
--- a/test-suite/tests/srfi-19.test
+++ b/test-suite/tests/srfi-19.test
@@ -3,20 +3,19 @@
 ;;;;
 ;;;; 	Copyright (C) 2001, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
 ;;;;
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
-;;;;
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 ;; SRFI-19 overrides current-date, so we have to do the test in a
 ;; separate module, or later tests will fail.
diff --git a/test-suite/tests/srfi-31.test b/test-suite/tests/srfi-31.test
index bd6977333..6d65ce2bc 100644
--- a/test-suite/tests/srfi-31.test
+++ b/test-suite/tests/srfi-31.test
@@ -5,7 +5,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -23,7 +23,7 @@
 (with-test-prefix "rec special form"
 
   (pass-if-exception "bogus variable" '(misc-error . ".*")
-    (rec #:foo))
+    (sc-expand '(rec #:foo)))
 
   (pass-if "rec expressions"
     (let ((ones-list (rec ones (cons 1 (delay ones)))))
diff --git a/test-suite/tests/srfi-34.test b/test-suite/tests/srfi-34.test
index 2195d9471..17864b642 100644
--- a/test-suite/tests/srfi-34.test
+++ b/test-suite/tests/srfi-34.test
@@ -2,20 +2,19 @@
 ;;;;
 ;;;; 	Copyright (C) 2003, 2004, 2006, 2008 Free Software Foundation, Inc.
 ;;;;
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
-;;;;
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-suite test-srfi-34)
   :duplicates (last)  ;; avoid warning about srfi-34 replacing `raise'
diff --git a/test-suite/tests/srfi-35.test b/test-suite/tests/srfi-35.test
index 83efd61d9..24ee60248 100644
--- a/test-suite/tests/srfi-35.test
+++ b/test-suite/tests/srfi-35.test
@@ -3,20 +3,19 @@
 ;;;;
 ;;;; 	Copyright (C) 2007, 2008 Free Software Foundation, Inc.
 ;;;;
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
-;;;;
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-srfi-35)
   :use-module (test-suite lib)
diff --git a/test-suite/tests/srfi-37.test b/test-suite/tests/srfi-37.test
index d7745876d..1f739c5c5 100644
--- a/test-suite/tests/srfi-37.test
+++ b/test-suite/tests/srfi-37.test
@@ -2,20 +2,19 @@
 ;;;;
 ;;;; 	Copyright (C) 2007, 2008 Free Software Foundation, Inc.
 ;;;;
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
-;;;;
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-srfi-37)
   #:use-module (test-suite lib)
diff --git a/test-suite/tests/srfi-39.test b/test-suite/tests/srfi-39.test
index 277a3c60d..0153e58b4 100644
--- a/test-suite/tests/srfi-39.test
+++ b/test-suite/tests/srfi-39.test
@@ -2,20 +2,19 @@
 ;;;;
 ;;;; Copyright (C) 2004, 2005, 2006, 2008 Free Software Foundation, Inc.
 ;;;; 
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
 ;;;; 
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-srfi-39)
   #:use-module (test-suite lib)
diff --git a/test-suite/tests/srfi-4.test b/test-suite/tests/srfi-4.test
index ee773a3f9..8a9d53a61 100644
--- a/test-suite/tests/srfi-4.test
+++ b/test-suite/tests/srfi-4.test
@@ -3,20 +3,19 @@
 ;;;;
 ;;;; Copyright (C) 2001, 2006 Free Software Foundation, Inc.
 ;;;; 
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
 ;;;; 
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (use-modules (srfi srfi-4)
 	     (test-suite lib))
diff --git a/test-suite/tests/srfi-6.test b/test-suite/tests/srfi-6.test
index 217fc9f78..68fc70dff 100644
--- a/test-suite/tests/srfi-6.test
+++ b/test-suite/tests/srfi-6.test
@@ -2,20 +2,19 @@
 ;;;;
 ;;;; 	Copyright (C) 2003, 2006 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,
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (use-modules (test-suite lib))
 
diff --git a/test-suite/tests/srfi-60.test b/test-suite/tests/srfi-60.test
index fff89f1ca..940934f3e 100644
--- a/test-suite/tests/srfi-60.test
+++ b/test-suite/tests/srfi-60.test
@@ -2,20 +2,19 @@
 ;;;;
 ;;;; Copyright 2005, 2006 Free Software Foundation, Inc.
 ;;;;
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU 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,
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-srfi-60)
   #:duplicates (last)  ;; avoid warning about srfi-60 replacing `bit-count'
diff --git a/test-suite/tests/srfi-69.test b/test-suite/tests/srfi-69.test
index 1d240d28c..e99b76c6d 100644
--- a/test-suite/tests/srfi-69.test
+++ b/test-suite/tests/srfi-69.test
@@ -2,20 +2,19 @@
 ;;;;
 ;;;; 	Copyright (C) 2007 Free Software Foundation, Inc.
 ;;;;
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
-;;;;
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-srfi-69)
   #:use-module (test-suite lib)
diff --git a/test-suite/tests/srfi-88.test b/test-suite/tests/srfi-88.test
index 63f40cc40..b879941b2 100644
--- a/test-suite/tests/srfi-88.test
+++ b/test-suite/tests/srfi-88.test
@@ -3,20 +3,19 @@
 ;;;;
 ;;;; 	Copyright (C) 2008 Free Software Foundation, Inc.
 ;;;;
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
-;;;;
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-srfi-88)
   :use-module (test-suite lib)
diff --git a/test-suite/tests/srfi-9.test b/test-suite/tests/srfi-9.test
index c212ea6aa..f8cb0b491 100644
--- a/test-suite/tests/srfi-9.test
+++ b/test-suite/tests/srfi-9.test
@@ -3,20 +3,19 @@
 ;;;;
 ;;;; Copyright (C) 2001, 2006, 2007 Free Software Foundation, Inc.
 ;;;; 
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
 ;;;; 
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-suite test-numbers)
   #:use-module (test-suite lib)
diff --git a/test-suite/tests/srfi-98.test b/test-suite/tests/srfi-98.test
new file mode 100644
index 000000000..ac0d5178e
--- /dev/null
+++ b/test-suite/tests/srfi-98.test
@@ -0,0 +1,37 @@
+;;;; srfi-98.test --- Test suite for Guile's SRFI-98 functions. -*- scheme -*-
+;;;;
+;;;; Copyright 2009 Free Software Foundation, Inc.
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (test-srfi-98)
+  #:use-module (srfi srfi-98)
+  #:use-module (test-suite lib))
+
+(with-test-prefix "get-environment-variable"
+  (pass-if "get-environment-variable retrieves binding"
+    (putenv "foo=bar")
+    (equal? (get-environment-variable "foo") "bar"))
+
+  (pass-if "get-environment-variable #f on unbound name"
+    (unsetenv "foo")
+    (not (get-environment-variable "foo"))))      
+
+(with-test-prefix "get-environment-variables"
+
+  (pass-if "get-environment-variables contains binding"
+    (putenv "foo=bar")
+    (equal? (assoc-ref (get-environment-variables) "foo") "bar")))
+
diff --git a/test-suite/tests/streams.test b/test-suite/tests/streams.test
index 92277c19c..780021c7e 100644
--- a/test-suite/tests/streams.test
+++ b/test-suite/tests/streams.test
@@ -2,20 +2,19 @@
 ;;;;
 ;;;; Copyright (C) 2004, 2006 Free Software Foundation, Inc.
 ;;;; 
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
 ;;;; 
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-suite test-streams)
   :use-module (test-suite lib)
diff --git a/test-suite/tests/strings.test b/test-suite/tests/strings.test
index 51f163254..c78fe55ff 100644
--- a/test-suite/tests/strings.test
+++ b/test-suite/tests/strings.test
@@ -1,34 +1,222 @@
 ;;;; strings.test --- test suite for Guile's string functions    -*- scheme -*-
 ;;;; Jim Blandy <jimb@red-bean.com> --- August 1999
 ;;;;
-;;;; Copyright (C) 1999, 2001, 2004, 2005, 2006, 2008 Free Software Foundation, Inc.
+;;;; Copyright (C) 1999, 2001, 2004, 2005, 2006, 2008, 2009 Free Software Foundation, Inc.
 ;;;; 
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
 ;;;; 
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-strings)
   #:use-module (test-suite lib))
 
-
 (define exception:read-only-string
   (cons 'misc-error "^string is read-only"))
+(define exception:illegal-escape
+  (cons 'read-error "illegal character in escape sequence"))
+;; Wrong types may have either the 'wrong-type-arg key when
+;; interpreted or 'vm-error when compiled.  This matches both.
+(define exception:wrong-type-arg
+  (cons #t "Wrong type"))
 
 ;; Create a string from integer char values, eg. (string-ints 65) => "A"
 (define (string-ints . args)
   (apply string (map integer->char args)))
 
+;;
+;; string internals
+;;
+
+;; Some abbreviations
+;; BMP - Basic Multilingual Plane (codepoints below U+FFFF)
+;; SMP - Suplementary Multilingual Plane (codebpoints from U+10000 to U+1FFFF)
+
+(with-test-prefix "string internals"
+
+  (pass-if "new string starts at 1st char in stringbuf"
+    (let ((s "abc"))
+      (= 0 (assq-ref (%string-dump s) 'start))))
+
+  (pass-if "length of new string same as stringbuf"
+    (let ((s "def"))
+      (= (string-length s) (assq-ref (%string-dump s) 'stringbuf-length))))
+
+  (pass-if "contents of new string same as stringbuf"
+    (let ((s "ghi"))
+      (string=? s (assq-ref (%string-dump s) 'stringbuf-chars))))
+
+  (pass-if "writable strings are not read-only"
+    (let ((s "zyx"))
+      (not (assq-ref (%string-dump s) 'read-only))))
+
+  (pass-if "read-only strings are read-only"
+    (let ((s (substring/read-only "zyx" 0)))
+      (assq-ref (%string-dump s) 'read-only)))
+
+  (pass-if "new Latin-1 encoded strings are not shared"
+    (let ((s "abc"))
+      (not (assq-ref (%string-dump s) 'stringbuf-shared))))
+
+  (pass-if "new UCS-4 encoded strings are not shared"
+    (let ((s "\u0100bc"))
+      (not (assq-ref (%string-dump s) 'stringbuf-shared))))
+
+  ;; Should this be true? It isn't currently true.
+  (pass-if "null shared substrings are shared"
+    (let* ((s1 "")
+           (s2 (substring/shared s1 0 0)))
+      (throw 'untested)
+      (eq? (assq-ref (%string-dump s2) 'shared)
+           s1)))
+
+  (pass-if "ASCII shared substrings are shared"
+    (let* ((s1 "foobar")
+           (s2 (substring/shared s1 0 3)))
+      (eq? (assq-ref (%string-dump s2) 'shared)
+           s1)))
+
+  (pass-if "BMP shared substrings are shared"
+    (let* ((s1 "\u0100\u0101\u0102\u0103\u0104\u0105")
+           (s2 (substring/shared s1 0 3)))
+      (eq? (assq-ref (%string-dump s2) 'shared)
+           s1)))
+
+  (pass-if "null substrings are not shared"
+    (let* ((s1 "")
+           (s2 (substring s1 0 0)))
+      (not (eq? (assq-ref (%string-dump s2) 'shared)
+                s1))))
+
+  (pass-if "ASCII substrings are not shared"
+    (let* ((s1 "foobar")
+           (s2 (substring s1 0 3)))
+      (not (eq? (assq-ref (%string-dump s2) 'shared)
+                s1))))
+
+  (pass-if "BMP substrings are not shared"
+    (let* ((s1 "\u0100\u0101\u0102\u0103\u0104\u0105")
+           (s2 (substring s1 0 3)))
+      (not (eq? (assq-ref (%string-dump s2) 'shared)
+                s1))))
+
+  (pass-if "ASCII substrings share stringbufs before copy-on-write"
+    (let* ((s1 "foobar")
+           (s2 (substring s1 0 3)))
+      (assq-ref (%string-dump s1) 'stringbuf-shared)))
+
+  (pass-if "BMP substrings share stringbufs before copy-on-write"
+    (let* ((s1 "\u0100\u0101\u0102\u0103\u0104\u0105")
+           (s2 (substring s1 0 3)))
+      (assq-ref (%string-dump s1) 'stringbuf-shared)))
+
+  (pass-if "ASCII substrings don't share stringbufs after copy-on-write"
+    (let* ((s1 "foobar")
+           (s2 (substring s1 0 3)))
+      (string-set! s2 0 #\F)
+      (not (assq-ref (%string-dump s2) 'stringbuf-shared))))
+
+  (pass-if "BMP substrings don't share stringbufs after copy-on-write"
+    (let* ((s1 "\u0100\u0101\u0102\u0103\u0104\u0105")
+           (s2 (substring s1 0 3)))
+      (string-set! s2 0 #\F)
+      (not (assq-ref (%string-dump s2) 'stringbuf-shared))))
+
+  (with-test-prefix "encodings"
+
+    (pass-if "null strings are Latin-1 encoded"
+      (let ((s ""))
+        (not (assq-ref (%string-dump s) 'stringbuf-wide))))
+
+    (pass-if "ASCII strings are Latin-1 encoded"
+      (let ((s "jkl"))
+        (not (assq-ref (%string-dump s) 'stringbuf-wide))))
+
+    (pass-if "Latin-1 strings are Latin-1 encoded"
+      (let ((s "\xC0\xC1\xC2"))
+        (not (assq-ref (%string-dump s) 'stringbuf-wide))))
+
+    (pass-if "BMP strings are UCS-4 encoded"
+      (let ((s "\u0100\u0101\x0102"))
+        (assq-ref (%string-dump s) 'stringbuf-wide)))
+
+    (pass-if "SMP strings are UCS-4 encoded"
+      (let ((s "\U010300\u010301\x010302"))
+        (assq-ref (%string-dump s) 'stringbuf-wide)))
+
+    (pass-if "null list->string is Latin-1 encoded"
+      (let ((s (string-ints)))
+        (not (assq-ref (%string-dump s) 'stringbuf-wide))))
+
+    (pass-if "ASCII list->string is Latin-1 encoded"
+      (let ((s (string-ints 65 66 67)))
+        (not (assq-ref (%string-dump s) 'stringbuf-wide))))
+
+    (pass-if "Latin-1 list->string is Latin-1 encoded"
+      (let ((s (string-ints #xc0 #xc1 #xc2)))
+        (not (assq-ref (%string-dump s) 'stringbuf-wide))))
+
+    (pass-if "BMP list->string is UCS-4 encoded"
+      (let ((s (string-ints #x0100 #x0101 #x0102)))
+        (assq-ref (%string-dump s) 'stringbuf-wide)))
+
+    (pass-if "SMP list->string is UCS-4 encoded"
+      (let ((s (string-ints #x010300 #x010301 #x010302)))
+        (assq-ref (%string-dump s) 'stringbuf-wide)))
+
+    (pass-if "encoding of string not based on escape style"
+      (let ((s "\U000040"))
+        (not (assq-ref (%string-dump s) 'stringbuf-wide))))))
+
+(with-test-prefix "hex escapes"
+
+  (pass-if-exception "non-hex char in two-digit hex-escape"
+    exception:illegal-escape                     
+    (with-input-from-string "\"\\x0g\"" read))
+
+  (pass-if-exception "non-hex char in four-digit hex-escape"
+    exception:illegal-escape                     
+    (with-input-from-string "\"\\u000g\"" read))
+
+  (pass-if-exception "non-hex char in six-digit hex-escape"
+    exception:illegal-escape                     
+    (with-input-from-string "\"\\U00000g\"" read))
+
+  (pass-if-exception "premature termination of two-digit hex-escape"
+    exception:illegal-escape                     
+    (with-input-from-string "\"\\x0\"" read))
+
+  (pass-if-exception "premature termination of four-digit hex-escape"
+    exception:illegal-escape                     
+    (with-input-from-string "\"\\u000\"" read))
+
+  (pass-if-exception "premature termination of six-digit hex-escape"
+    exception:illegal-escape                     
+    (with-input-from-string "\"\\U00000\"" read))
+
+  (pass-if "extra hex digits ignored for two-digit hex escape"
+    (eqv? (string-ref "--\xfff--" 2)
+          (integer->char #xff)))
+
+  (pass-if "extra hex digits ignored for four-digit hex escape"
+    (eqv? (string-ref "--\u0100f--" 2)
+          (integer->char #x0100)))
+
+  (pass-if "extra hex digits ignored for six-digit hex escape"
+    (eqv? (string-ref "--\U010300f--" 2)
+          (integer->char #x010300)))
+
+  (pass-if "escaped characters match non-escaped ASCII characters"
+    (string=? "ABC" "\x41\u0042\U000043")))
 
 ;;
 ;; string=?
@@ -182,8 +370,20 @@
     exception:out-of-range
     (string-ref "hello" -1))
 
-  (pass-if "regular string"
-    (char=? (string-ref "GNU Guile" 4) #\G)))
+  (pass-if "regular string, ASCII char"
+    (char=? (string-ref "GNU Guile" 4) #\G))
+
+  (pass-if "regular string, hex escaped Latin-1 char"
+    (char=? (string-ref "--\xff--" 2) 
+            (integer->char #xff)))
+
+  (pass-if "regular string, hex escaped BMP char"
+    (char=? (string-ref "--\u0100--" 2) 
+            (integer->char #x0100)))
+
+  (pass-if "regular string, hex escaped SMP char"
+    (char=? (string-ref "--\U010300--" 2) 
+            (integer->char #x010300))))
 
 ;;
 ;; string-set!
@@ -211,12 +411,37 @@
     exception:read-only-string
     (string-set! (substring/read-only "abc" 0) 1 #\space))
 
-  (pass-if "regular string"
+  (pass-if "regular string, ASCII char"
     (let ((s (string-copy "GNU guile")))
       (string-set! s 4 #\G)
-      (char=? (string-ref s 4) #\G))))
+      (char=? (string-ref s 4) #\G)))
 
+  (pass-if "regular string, Latin-1 char"
+    (let ((s (string-copy "GNU guile")))
+      (string-set! s 4 (integer->char #xfe))
+      (char=? (string-ref s 4) (integer->char #xfe))))
+
+  (pass-if "regular string, BMP char"
+    (let ((s (string-copy "GNU guile")))
+      (string-set! s 4 (integer->char #x0100))
+      (char=? (string-ref s 4) (integer->char #x0100))))
 
+  (pass-if "regular string, SMP char"
+    (let ((s (string-copy "GNU guile")))
+      (string-set! s 4 (integer->char #x010300))
+      (char=? (string-ref s 4) (integer->char #x010300)))))
+
+;;
+;; list->string
+;;
+(with-test-prefix "string"
+
+  (pass-if-exception "convert circular list to string"
+     exception:wrong-type-arg
+     (let ((foo (list #\a #\b #\c)))
+       (set-cdr! (cddr foo) (cdr foo))
+       (apply string foo))))
+ 
 (with-test-prefix "string-split"
 
   ;; in guile 1.6.7 and earlier, character >=128 wasn't matched in the string
diff --git a/test-suite/tests/structs.test b/test-suite/tests/structs.test
index 127115eb2..e114abb1a 100644
--- a/test-suite/tests/structs.test
+++ b/test-suite/tests/structs.test
@@ -3,20 +3,19 @@
 ;;;;
 ;;;; Copyright (C) 2006, 2007 Free Software Foundation, Inc.
 ;;;;
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU 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,
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-suite test-structs)
   :use-module (test-suite lib))
diff --git a/test-suite/tests/symbols.test b/test-suite/tests/symbols.test
index 3fe3402f8..c87aa21d1 100644
--- a/test-suite/tests/symbols.test
+++ b/test-suite/tests/symbols.test
@@ -1,21 +1,20 @@
 ;;;; symbols.test --- test suite for Guile's symbols    -*- scheme -*-
 ;;;;
-;;;; Copyright (C) 2001, 2006, 2008 Free Software Foundation, Inc.
+;;;; Copyright (C) 2001, 2006, 2008, 2009 Free Software Foundation, Inc.
 ;;;; 
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
 ;;;; 
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-suite test-symbols)
   #:use-module (test-suite lib)
@@ -32,6 +31,60 @@
 (define (documented? object)
   (not (not (object-documentation object))))
 
+(define (symbol-length s)
+  (string-length (symbol->string s)))
+
+;;
+;; symbol internals
+;;
+
+(with-test-prefix "symbol internals"
+
+  (pass-if "length of new symbol same as stringbuf"
+    (let ((s 'def))
+      (= (symbol-length s) (assq-ref (%symbol-dump s) 'stringbuf-length))))
+
+  (pass-if "contents of new symbol same as stringbuf"
+    (let ((s 'ghi))
+      (string=? (symbol->string s) 
+                (assq-ref (%symbol-dump s) 'stringbuf-chars))))
+
+
+  (with-test-prefix "hashes"
+  
+    (pass-if "equal symbols have equal hashes"
+      (let ((s1 'mux)
+            (s2 'mux))
+        (= (assq-ref (%symbol-dump s1) 'hash)
+           (assq-ref (%symbol-dump s2) 'hash))))
+
+    (pass-if "different symbols have different hashes"
+      (let ((s1 'mux)
+            (s2 'muy))
+        (not (= (assq-ref (%symbol-dump s1) 'hash)
+                (assq-ref (%symbol-dump s2) 'hash))))))
+
+  (with-test-prefix "encodings"
+
+    (pass-if "the null symbol is Latin-1 encoded"
+      (let ((s '#{}#))
+        (not (assq-ref (%symbol-dump s) 'stringbuf-wide))))
+
+    (pass-if "ASCII symbols are Latin-1 encoded"
+      (let ((s 'jkl))
+        (not (assq-ref (%symbol-dump s) 'stringbuf-wide))))
+
+    (pass-if "Latin-1 symbols are Latin-1 encoded"
+      (let ((s (string->symbol "\xC0\xC1\xC2")))
+        (not (assq-ref (%symbol-dump s) 'stringbuf-wide))))
+
+    (pass-if "BMP symbols are UCS-4 encoded"
+      (let ((s (string->symbol "\u0100\u0101\x0102")))
+        (assq-ref (%symbol-dump s) 'stringbuf-wide)))
+
+    (pass-if "SMP symbols are UCS-4 encoded"
+      (let ((s (string->symbol "\U010300\u010301\x010302")))
+        (assq-ref (%symbol-dump s) 'stringbuf-wide)))))
 
 ;;;
 ;;; symbol?
@@ -48,6 +101,16 @@
   (pass-if "symbol"
     (symbol? 'foo)))
 
+;;;
+;;; wide symbols
+;;;
+
+(with-test-prefix "BMP symbols"
+
+  (pass-if "BMP symbol's string"
+    (and (= 4 (string-length "abc\u0100"))
+         (string=? "abc\u0100" 
+                   (symbol->string (string->symbol "abc\u0100"))))))
 
 ;;;
 ;;; symbol->string
diff --git a/test-suite/tests/syncase.test b/test-suite/tests/syncase.test
index c681fc381..4cd93369a 100644
--- a/test-suite/tests/syncase.test
+++ b/test-suite/tests/syncase.test
@@ -2,20 +2,19 @@
 ;;;;
 ;;;; 	Copyright (C) 2001, 2006 Free Software Foundation, Inc.
 ;;;; 
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
 ;;;; 
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 ;; These tests are in a module so that the syntax transformer does not
 ;; affect code outside of this file.
diff --git a/test-suite/tests/syntax.test b/test-suite/tests/syntax.test
index 1277e5204..282072b5b 100644
--- a/test-suite/tests/syntax.test
+++ b/test-suite/tests/syntax.test
@@ -1,26 +1,30 @@
 ;;;; syntax.test --- test suite for Guile's syntactic forms    -*- scheme -*-
 ;;;;
-;;;; Copyright (C) 2001,2003,2004, 2005, 2006 Free Software Foundation, Inc.
+;;;; Copyright (C) 2001,2003,2004, 2005, 2006, 2009 Free Software Foundation, Inc.
 ;;;; 
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
 ;;;; 
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-suite test-syntax)
   :use-module (test-suite lib))
 
 
+(define exception:generic-syncase-error
+  (cons 'syntax-error "source expression failed to match"))
+(define exception:unexpected-syntax
+  (cons 'syntax-error "unexpected syntax"))
+
 (define exception:bad-expression
   (cons 'syntax-error "Bad expression"))
 
@@ -29,22 +33,32 @@
 (define exception:missing-expr
   (cons 'syntax-error "Missing expression"))
 (define exception:missing-body-expr
-  (cons 'syntax-error "Missing body expression"))
+  (cons 'syntax-error "no expressions in body"))
 (define exception:extra-expr
   (cons 'syntax-error "Extra expression"))
 (define exception:illegal-empty-combination
   (cons 'syntax-error "Illegal empty combination"))
 
+(define exception:bad-lambda
+  '(syntax-error . "bad lambda"))
+(define exception:bad-let
+  '(syntax-error . "bad let "))
+(define exception:bad-letrec
+  '(syntax-error . "bad letrec "))
+(define exception:bad-set!
+  '(syntax-error . "bad set!"))
+(define exception:bad-quote
+  '(syntax-error . "quote: bad syntax"))
 (define exception:bad-bindings
   (cons 'syntax-error "Bad bindings"))
 (define exception:bad-binding
   (cons 'syntax-error "Bad binding"))
 (define exception:duplicate-binding
-  (cons 'syntax-error "Duplicate binding"))
+  (cons 'syntax-error "duplicate bound variable"))
 (define exception:bad-body
   (cons 'misc-error "^bad body"))
 (define exception:bad-formals
-  (cons 'syntax-error "Bad formals"))
+  '(syntax-error . "invalid parameter list"))
 (define exception:bad-formal
   (cons 'syntax-error "Bad formal"))
 (define exception:duplicate-formal
@@ -67,13 +81,13 @@
   (with-test-prefix "Bad argument list"
 
     (pass-if-exception "improper argument list of length 1"
-      exception:wrong-num-args
+      exception:generic-syncase-error
       (eval '(let ((foo (lambda (x y) #t)))
 	       (foo . 1))
 	    (interaction-environment)))
 
     (pass-if-exception "improper argument list of length 2"
-      exception:wrong-num-args
+      exception:generic-syncase-error
       (eval '(let ((foo (lambda (x y) #t)))
 	       (foo 1 . 2))
 	    (interaction-environment))))
@@ -88,7 +102,7 @@
 
     ;; Fixed on 2001-3-3
     (pass-if-exception "empty parentheses \"()\""
-      exception:illegal-empty-combination
+      exception:unexpected-syntax
       (eval '()
 	    (interaction-environment)))))
 
@@ -106,28 +120,32 @@
   (with-test-prefix "unquote-splicing"
 
     (pass-if-exception "extra arguments"
-      exception:missing/extra-expr
-      (quasiquote ((unquote-splicing (list 1 2) (list 3 4)))))))
+      '(syntax-error . "unquote-splicing takes exactly one argument")
+      (eval '(quasiquote ((unquote-splicing (list 1 2) (list 3 4))))
+            (interaction-environment)))))
 
 (with-test-prefix "begin"
 
   (pass-if "legal (begin)"
-    (begin)
-    #t)
+    (eval '(begin (begin) #t) (interaction-environment)))
 
   (with-test-prefix "unmemoization"
 
+    ;; FIXME. I have no idea why, but the expander is filling in (if #f
+    ;; #f) as the second arm of the if, if the second arm is missing. I
+    ;; thought I made it not do that. But in the meantime, let's adapt,
+    ;; since that's not what we're testing.
+
     (pass-if "normal begin"
-      (let ((foo (lambda () (if (= 1 1) (begin (+ 1) (+ 2))))))
-        (foo) ; make sure, memoization has been performed
+      (let ((foo (lambda () (if (= 1 1) (begin (+ 1) (+ 2)) #f))))
         (equal? (procedure-source foo)
-                '(lambda () (if (= 1 1) (begin (+ 1) (+ 2)))))))
+                '(lambda () (if (= 1 1) (begin (+ 1) (+ 2)) #f)))))
 
     (pass-if "redundant nested begin"
-      (let ((foo (lambda () (if (= 1 1) (begin (+ 1) (begin (+ 2) (+ 3)))))))
+      (let ((foo (lambda () (if (= 1 1) (begin (+ 1) (begin (+ 2) (+ 3))) #f))))
         (foo) ; make sure, memoization has been performed
         (equal? (procedure-source foo)
-                '(lambda () (if (= 1 1) (begin (+ 1) (begin (+ 2) (+ 3))))))))
+                '(lambda () (if (= 1 1) (begin (+ 1) (begin (+ 2) (+ 3))) #f)))))
 
     (pass-if "redundant begin at start of body"
       (let ((foo (lambda () (begin (+ 1) (+ 2))))) ; should be optimized
@@ -135,10 +153,20 @@
         (equal? (procedure-source foo)
                 '(lambda () (begin (+ 1) (+ 2)))))))
 
-  (expect-fail-exception "illegal (begin)"
-    exception:bad-body
-    (if #t (begin))
-    #t))
+  (pass-if-exception "illegal (begin)"
+    exception:generic-syncase-error
+    (eval '(begin (if #t (begin)) #t) (interaction-environment))))
+
+(define-syntax matches?
+  (syntax-rules (_)
+    ((_ (op arg ...) pat)   (let ((x (op arg ...)))
+                              (matches? x pat)))
+    ((_ x ())               (null? x))
+    ((_ x (a . b))          (and (pair? x)
+                                 (matches? (car x) a)
+                                 (matches? (cdr x) b)))
+    ((_ x _)                #t) 
+    ((_ x pat)              (equal? x 'pat))))
 
 (with-test-prefix "lambda"
 
@@ -146,30 +174,28 @@
 
     (pass-if "normal lambda"
       (let ((foo (lambda () (lambda (x y) (+ x y)))))
-        ((foo) 1 2) ; make sure, memoization has been performed
-        (equal? (procedure-source foo)
-                '(lambda () (lambda (x y) (+ x y))))))
+        (matches? (procedure-source foo)
+                  (lambda () (lambda (_ _) (+ _ _))))))
 
     (pass-if "lambda with documentation"
       (let ((foo (lambda () (lambda (x y) "docstring" (+ x y)))))
-        ((foo) 1 2) ; make sure, memoization has been performed
-        (equal? (procedure-source foo)
-                '(lambda () (lambda (x y) "docstring" (+ x y)))))))
+        (matches? (procedure-source foo)
+                  (lambda () (lambda (_ _) "docstring" (+ _ _)))))))
 
   (with-test-prefix "bad formals"
 
     (pass-if-exception "(lambda)"
-      exception:missing-expr
+      exception:bad-lambda
       (eval '(lambda)
 	    (interaction-environment)))
 
     (pass-if-exception "(lambda . \"foo\")"
-      exception:bad-expression
+      exception:bad-lambda
       (eval '(lambda . "foo")
 	    (interaction-environment)))
 
     (pass-if-exception "(lambda \"foo\")"
-      exception:missing-expr
+      exception:bad-lambda
       (eval '(lambda "foo")
 	    (interaction-environment)))
 
@@ -179,22 +205,22 @@
 	    (interaction-environment)))
 
     (pass-if-exception "(lambda (x 1) 2)"
-      exception:bad-formal
+      exception:bad-formals
       (eval '(lambda (x 1) 2)
 	    (interaction-environment)))
 
     (pass-if-exception "(lambda (1 x) 2)"
-      exception:bad-formal
+      exception:bad-formals
       (eval '(lambda (1 x) 2)
 	    (interaction-environment)))
 
     (pass-if-exception "(lambda (x \"a\") 2)"
-      exception:bad-formal
+      exception:bad-formals
       (eval '(lambda (x "a") 2)
 	    (interaction-environment)))
 
     (pass-if-exception "(lambda (\"a\" x) 2)"
-      exception:bad-formal
+      exception:bad-formals
       (eval '(lambda ("a" x) 2)
 	    (interaction-environment))))
 
@@ -202,20 +228,20 @@
 
     ;; Fixed on 2001-3-3
     (pass-if-exception "(lambda (x x) 1)"
-      exception:duplicate-formal
+      exception:bad-formals
       (eval '(lambda (x x) 1)
 	    (interaction-environment)))
 
     ;; Fixed on 2001-3-3
     (pass-if-exception "(lambda (x x x) 1)"
-      exception:duplicate-formal
+      exception:bad-formals
       (eval '(lambda (x x x) 1)
 	    (interaction-environment))))
 
   (with-test-prefix "bad body"
 
     (pass-if-exception "(lambda ())"
-      exception:missing-expr
+      exception:bad-lambda
       (eval '(lambda ())
 	    (interaction-environment)))))
 
@@ -225,9 +251,8 @@
 
     (pass-if "normal let"
       (let ((foo (lambda () (let ((i 1) (j 2)) (+ i j)))))
-        (foo) ; make sure, memoization has been performed
-        (equal? (procedure-source foo)
-                '(lambda () (let ((i 1) (j 2)) (+ i j)))))))
+        (matches? (procedure-source foo)
+                  (lambda () (let ((_ 1) (_ 2)) (+ _ _)))))))
 
   (with-test-prefix "bindings"
 
@@ -238,42 +263,42 @@
   (with-test-prefix "bad bindings"
 
     (pass-if-exception "(let)"
-      exception:missing-expr
+      exception:bad-let
       (eval '(let)
 	    (interaction-environment)))
 
     (pass-if-exception "(let 1)"
-      exception:missing-expr
+      exception:bad-let
       (eval '(let 1)
 	    (interaction-environment)))
 
     (pass-if-exception "(let (x))"
-      exception:missing-expr
+      exception:bad-let
       (eval '(let (x))
 	    (interaction-environment)))
 
     (pass-if-exception "(let ((x)))"
-      exception:missing-expr
+      exception:bad-let
       (eval '(let ((x)))
 	    (interaction-environment)))
 
     (pass-if-exception "(let (x) 1)"
-      exception:bad-binding
+      exception:bad-let
       (eval '(let (x) 1)
 	    (interaction-environment)))
 
     (pass-if-exception "(let ((x)) 3)"
-      exception:bad-binding
+      exception:bad-let
       (eval '(let ((x)) 3)
 	    (interaction-environment)))
 
     (pass-if-exception "(let ((x 1) y) x)"
-      exception:bad-binding
+      exception:bad-let
       (eval '(let ((x 1) y) x)
 	    (interaction-environment)))
 
     (pass-if-exception "(let ((1 2)) 3)"
-      exception:bad-variable
+      exception:bad-let
       (eval '(let ((1 2)) 3)
 	    (interaction-environment))))
 
@@ -287,12 +312,12 @@
   (with-test-prefix "bad body"
 
     (pass-if-exception "(let ())"
-      exception:missing-expr
+      exception:bad-let
       (eval '(let ())
 	    (interaction-environment)))
 
     (pass-if-exception "(let ((x 1)))"
-      exception:missing-expr
+      exception:bad-let
       (eval '(let ((x 1)))
 	    (interaction-environment)))))
 
@@ -307,19 +332,19 @@
   (with-test-prefix "bad bindings"
 
     (pass-if-exception "(let x (y))"
-      exception:missing-expr
+      exception:bad-let
       (eval '(let x (y))
 	    (interaction-environment))))
 
   (with-test-prefix "bad body"
 
     (pass-if-exception "(let x ())"
-      exception:missing-expr
+      exception:bad-let
       (eval '(let x ())
 	    (interaction-environment)))
 
     (pass-if-exception "(let x ((y 1)))"
-      exception:missing-expr
+      exception:bad-let
       (eval '(let x ((y 1)))
 	    (interaction-environment)))))
 
@@ -329,19 +354,16 @@
 
     (pass-if "normal let*"
       (let ((foo (lambda () (let* ((x 1) (y 2)) (+ x y)))))
-        (foo) ; make sure, memoization has been performed
-        (equal? (procedure-source foo)
-                '(lambda () (let* ((x 1) (y 2)) (+ x y))))))
+        (matches? (procedure-source foo)
+                  (lambda () (let ((_ 1)) (let ((_ 2)) (+ _ _)))))))
 
     (pass-if "let* without bindings"
       (let ((foo (lambda () (let ((x 1) (y 2))
                               (let* ()
                                 (and (= x 1) (= y 2)))))))
-        (foo) ; make sure, memoization has been performed
-        (equal? (procedure-source foo)
-                '(lambda () (let ((x 1) (y 2))
-                              (let* ()
-                                (and (= x 1) (= y 2)))))))))
+        (matches? (procedure-source foo)
+                  (lambda () (let ((_ 1) (_ 2))
+                               (if (= _ 1) (= _ 2) #f)))))))
 
   (with-test-prefix "bindings"
 
@@ -361,59 +383,59 @@
   (with-test-prefix "bad bindings"
 
     (pass-if-exception "(let*)"
-      exception:missing-expr
+      exception:generic-syncase-error
       (eval '(let*)
 	    (interaction-environment)))
 
     (pass-if-exception "(let* 1)"
-      exception:missing-expr
+      exception:generic-syncase-error
       (eval '(let* 1)
 	    (interaction-environment)))
 
     (pass-if-exception "(let* (x))"
-      exception:missing-expr
+      exception:generic-syncase-error
       (eval '(let* (x))
 	    (interaction-environment)))
 
     (pass-if-exception "(let* (x) 1)"
-      exception:bad-binding
+      exception:generic-syncase-error
       (eval '(let* (x) 1)
 	    (interaction-environment)))
 
     (pass-if-exception "(let* ((x)) 3)"
-      exception:bad-binding
+      exception:generic-syncase-error
       (eval '(let* ((x)) 3)
 	    (interaction-environment)))
 
     (pass-if-exception "(let* ((x 1) y) x)"
-      exception:bad-binding
+      exception:generic-syncase-error
       (eval '(let* ((x 1) y) x)
 	    (interaction-environment)))
 
     (pass-if-exception "(let* x ())"
-      exception:bad-bindings
+      exception:generic-syncase-error
       (eval '(let* x ())
 	    (interaction-environment)))
 
     (pass-if-exception "(let* x (y))"
-      exception:bad-bindings
+      exception:generic-syncase-error
       (eval '(let* x (y))
 	    (interaction-environment)))
 
     (pass-if-exception "(let* ((1 2)) 3)"
-      exception:bad-variable
+      exception:generic-syncase-error
       (eval '(let* ((1 2)) 3)
 	    (interaction-environment))))
 
   (with-test-prefix "bad body"
 
     (pass-if-exception "(let* ())"
-      exception:missing-expr
+      exception:generic-syncase-error
       (eval '(let* ())
 	    (interaction-environment)))
 
     (pass-if-exception "(let* ((x 1)))"
-      exception:missing-expr
+      exception:generic-syncase-error
       (eval '(let* ((x 1)))
 	    (interaction-environment)))))
 
@@ -423,9 +445,8 @@
 
     (pass-if "normal letrec"
       (let ((foo (lambda () (letrec ((i 1) (j 2)) (+ i j)))))
-        (foo) ; make sure, memoization has been performed
-        (equal? (procedure-source foo)
-                '(lambda () (letrec ((i 1) (j 2)) (+ i j)))))))
+        (matches? (procedure-source foo)
+                  (lambda () (letrec ((_ 1) (_ 2)) (+ _ _)))))))
 
   (with-test-prefix "bindings"
 
@@ -437,47 +458,47 @@
   (with-test-prefix "bad bindings"
 
     (pass-if-exception "(letrec)"
-      exception:missing-expr
+      exception:bad-letrec
       (eval '(letrec)
 	    (interaction-environment)))
 
     (pass-if-exception "(letrec 1)"
-      exception:missing-expr
+      exception:bad-letrec
       (eval '(letrec 1)
 	    (interaction-environment)))
 
     (pass-if-exception "(letrec (x))"
-      exception:missing-expr
+      exception:bad-letrec
       (eval '(letrec (x))
 	    (interaction-environment)))
 
     (pass-if-exception "(letrec (x) 1)"
-      exception:bad-binding
+      exception:bad-letrec
       (eval '(letrec (x) 1)
 	    (interaction-environment)))
 
     (pass-if-exception "(letrec ((x)) 3)"
-      exception:bad-binding
+      exception:bad-letrec
       (eval '(letrec ((x)) 3)
 	    (interaction-environment)))
 
     (pass-if-exception "(letrec ((x 1) y) x)"
-      exception:bad-binding
+      exception:bad-letrec
       (eval '(letrec ((x 1) y) x)
 	    (interaction-environment)))
 
     (pass-if-exception "(letrec x ())"
-      exception:bad-bindings
+      exception:bad-letrec
       (eval '(letrec x ())
 	    (interaction-environment)))
 
     (pass-if-exception "(letrec x (y))"
-      exception:bad-bindings
+      exception:bad-letrec
       (eval '(letrec x (y))
 	    (interaction-environment)))
 
     (pass-if-exception "(letrec ((1 2)) 3)"
-      exception:bad-variable
+      exception:bad-letrec
       (eval '(letrec ((1 2)) 3)
 	    (interaction-environment))))
 
@@ -491,12 +512,12 @@
   (with-test-prefix "bad body"
 
     (pass-if-exception "(letrec ())"
-      exception:missing-expr
+      exception:bad-letrec
       (eval '(letrec ())
 	    (interaction-environment)))
 
     (pass-if-exception "(letrec ((x 1)))"
-      exception:missing-expr
+      exception:bad-letrec
       (eval '(letrec ((x 1)))
 	    (interaction-environment)))))
 
@@ -508,17 +529,17 @@
       (let ((foo (lambda (x) (if x (+ 1) (+ 2)))))
         (foo #t) ; make sure, memoization has been performed
         (foo #f) ; make sure, memoization has been performed
-        (equal? (procedure-source foo)
-                '(lambda (x) (if x (+ 1) (+ 2))))))
+        (matches? (procedure-source foo)
+                  (lambda (_) (if _ (+ 1) (+ 2))))))
 
-    (pass-if "if without else"
+    (expect-fail "if without else"
       (let ((foo (lambda (x) (if x (+ 1)))))
         (foo #t) ; make sure, memoization has been performed
         (foo #f) ; make sure, memoization has been performed
         (equal? (procedure-source foo)
                 '(lambda (x) (if x (+ 1))))))
 
-    (pass-if "if #f without else"
+    (expect-fail "if #f without else"
       (let ((foo (lambda () (if #f #f))))
         (foo) ; make sure, memoization has been performed
         (equal? (procedure-source foo)
@@ -527,12 +548,12 @@
   (with-test-prefix "missing or extra expressions"
 
     (pass-if-exception "(if)"
-      exception:missing/extra-expr
+      exception:generic-syncase-error
       (eval '(if)
 	    (interaction-environment)))
 
     (pass-if-exception "(if 1 2 3 4)"
-      exception:missing/extra-expr
+      exception:generic-syncase-error
       (eval '(if 1 2 3 4)
 	    (interaction-environment)))))
 
@@ -594,78 +615,77 @@
 	(eq? 'ok (cond (#t identity =>) (else #f)))))
 
     (pass-if-exception "missing recipient"
-      '(syntax-error . "Missing recipient")
+      '(syntax-error . "cond: wrong number of receiver expressions")
       (cond (#t identity =>)))
 
     (pass-if-exception "extra recipient"
-      '(syntax-error . "Extra expression")
+      '(syntax-error . "cond: wrong number of receiver expressions")
       (cond (#t identity => identity identity))))
 
   (with-test-prefix "unmemoization"
 
+    ;; FIXME: the (if #f #f) is a hack!
     (pass-if "normal clauses"
-      (let ((foo (lambda (x) (cond ((= x 1) 'bar) ((= x 2) 'baz)))))
-        (foo 1) ; make sure, memoization has been performed
-        (foo 2) ; make sure, memoization has been performed
+      (let ((foo (lambda () (cond ((= x 1) 'bar) ((= x 2) 'baz)))))
         (equal? (procedure-source foo)
-                '(lambda (x) (cond ((= x 1) 'bar) ((= x 2) 'baz))))))
+                '(lambda () (if (= x 1) 'bar (if (= x 2) 'baz (if #f #f)))))))
 
     (pass-if "else"
       (let ((foo (lambda () (cond (else 'bar)))))
-        (foo) ; make sure, memoization has been performed
         (equal? (procedure-source foo)
-                '(lambda () (cond (else 'bar))))))
+                '(lambda () 'bar))))
 
+    ;; FIXME: the (if #f #f) is a hack!
     (pass-if "=>"
       (let ((foo (lambda () (cond (#t => identity)))))
-        (foo) ; make sure, memoization has been performed
-        (equal? (procedure-source foo)
-                '(lambda () (cond (#t => identity)))))))
+        (matches? (procedure-source foo)
+                  (lambda () (let ((_ #t))
+                               (if _ (identity _) (if #f #f))))))))
 
   (with-test-prefix "bad or missing clauses"
 
     (pass-if-exception "(cond)"
-      exception:missing-clauses
+      exception:generic-syncase-error
       (eval '(cond)
 	    (interaction-environment)))
 
     (pass-if-exception "(cond #t)"
-      exception:bad-cond-clause
+      exception:generic-syncase-error
       (eval '(cond #t)
 	    (interaction-environment)))
 
     (pass-if-exception "(cond 1)"
-      exception:bad-cond-clause
+      exception:generic-syncase-error
       (eval '(cond 1)
 	    (interaction-environment)))
 
     (pass-if-exception "(cond 1 2)"
-      exception:bad-cond-clause
+      exception:generic-syncase-error
       (eval '(cond 1 2)
 	    (interaction-environment)))
 
     (pass-if-exception "(cond 1 2 3)"
-      exception:bad-cond-clause
+      exception:generic-syncase-error
       (eval '(cond 1 2 3)
 	    (interaction-environment)))
 
     (pass-if-exception "(cond 1 2 3 4)"
-      exception:bad-cond-clause
+      exception:generic-syncase-error
       (eval '(cond 1 2 3 4)
 	    (interaction-environment)))
 
     (pass-if-exception "(cond ())"
-      exception:bad-cond-clause
+      exception:generic-syncase-error
       (eval '(cond ())
 	    (interaction-environment)))
 
     (pass-if-exception "(cond () 1)"
-      exception:bad-cond-clause
+      exception:generic-syncase-error
       (eval '(cond () 1)
 	    (interaction-environment)))
 
     (pass-if-exception "(cond (1) 1)"
-      exception:bad-cond-clause
+      exception:generic-syncase-error
       (eval '(cond (1) 1)
 	    (interaction-environment))))
 
@@ -683,7 +703,7 @@
   (with-test-prefix "case is hygienic"
 
     (pass-if-exception "bound 'else is handled correctly"
-      exception:bad-case-labels
+      exception:generic-syncase-error
       (eval '(let ((else #f)) (case 1 (else #f)))
             (interaction-environment))))
 
@@ -691,79 +711,83 @@
 
     (pass-if "normal clauses"
       (let ((foo (lambda (x) (case x ((1) 'bar) ((2) 'baz) (else 'foobar)))))
-        (foo 1) ; make sure, memoization has been performed
-        (foo 2) ; make sure, memoization has been performed
-        (foo 3) ; make sure, memoization has been performed
-        (equal? (procedure-source foo)
-                '(lambda (x) (case x ((1) 'bar) ((2) 'baz) (else 'foobar))))))
+        (matches? (procedure-source foo)
+                  (lambda (_)
+                    (if ((@@ (guile) memv) _ '(1))
+                        'bar
+                        (if ((@@ (guile) memv) _ '(2))
+                            'baz
+                            'foobar))))))
 
     (pass-if "empty labels"
       (let ((foo (lambda (x) (case x ((1) 'bar) (() 'baz) (else 'foobar)))))
-        (foo 1) ; make sure, memoization has been performed
-        (foo 2) ; make sure, memoization has been performed
-        (foo 3) ; make sure, memoization has been performed
-        (equal? (procedure-source foo)
-                '(lambda (x) (case x ((1) 'bar) (() 'baz) (else 'foobar)))))))
+        (matches? (procedure-source foo)
+                  (lambda (_)
+                    (if ((@@ (guile) memv) _ '(1))
+                        'bar
+                        (if ((@@ (guile) memv) _ '())
+                            'baz
+                            'foobar)))))))
 
   (with-test-prefix "bad or missing clauses"
 
     (pass-if-exception "(case)"
-      exception:missing-clauses
+      exception:generic-syncase-error
       (eval '(case)
 	    (interaction-environment)))
 
     (pass-if-exception "(case . \"foo\")"
-      exception:bad-expression
+      exception:generic-syncase-error
       (eval '(case . "foo")
 	    (interaction-environment)))
 
     (pass-if-exception "(case 1)"
-      exception:missing-clauses
+      exception:generic-syncase-error
       (eval '(case 1)
 	    (interaction-environment)))
 
     (pass-if-exception "(case 1 . \"foo\")"
-      exception:bad-expression
+      exception:generic-syncase-error
       (eval '(case 1 . "foo")
 	    (interaction-environment)))
 
     (pass-if-exception "(case 1 \"foo\")"
-      exception:bad-case-clause
+      exception:generic-syncase-error
       (eval '(case 1 "foo")
 	    (interaction-environment)))
 
     (pass-if-exception "(case 1 ())"
-      exception:bad-case-clause
+      exception:generic-syncase-error
       (eval '(case 1 ())
 	    (interaction-environment)))
 
     (pass-if-exception "(case 1 (\"foo\"))"
-      exception:bad-case-clause
+      exception:generic-syncase-error
       (eval '(case 1 ("foo"))
 	    (interaction-environment)))
 
     (pass-if-exception "(case 1 (\"foo\" \"bar\"))"
-      exception:bad-case-labels
+      exception:generic-syncase-error
       (eval '(case 1 ("foo" "bar"))
 	    (interaction-environment)))
 
     (pass-if-exception "(case 1 ((2) \"bar\") . \"foo\")"
-      exception:bad-expression
+      exception:generic-syncase-error
       (eval '(case 1 ((2) "bar") . "foo")
 	    (interaction-environment)))
 
     (pass-if-exception "(case 1 ((2) \"bar\") (else))"
-      exception:bad-case-clause
+      exception:generic-syncase-error
       (eval '(case 1 ((2) "bar") (else))
 	    (interaction-environment)))
 
     (pass-if-exception "(case 1 (else #f) . \"foo\")"
-      exception:bad-expression
+      exception:generic-syncase-error
       (eval '(case 1 (else #f) . "foo")
 	    (interaction-environment)))
 
     (pass-if-exception "(case 1 (else #f) ((1) #t))"
-      exception:misplaced-else-clause
+      exception:generic-syncase-error
       (eval '(case 1 (else #f) ((1) #t))
 	    (interaction-environment)))))
 
@@ -780,36 +804,27 @@
       (eval '(define round round) m)
       (eq? (module-ref m 'round) round)))
 
-  (with-test-prefix "currying"
-
-    (pass-if "(define ((foo)) #f)"
-      (eval '(begin
-               (define ((foo)) #t)
-               ((foo)))
-            (interaction-environment))))
-
   (with-test-prefix "unmemoization"
 
     (pass-if "definition unmemoized without prior execution"
-      (eval '(begin 
-               (define (blub) (cons ('(1 . 2)) 2))
-               (equal?
-                 (procedure-source blub)
-                 '(lambda () (cons ('(1 . 2)) 2))))
-            (interaction-environment)))
+      (primitive-eval '(begin 
+                         (define (blub) (cons ('(1 . 2)) 2))
+                         (equal?
+                          (procedure-source blub)
+                          '(lambda () (cons ('(1 . 2)) 2))))))
+    
 
     (pass-if "definition with documentation unmemoized without prior execution"
-      (eval '(begin 
-               (define (blub) "Comment" (cons ('(1 . 2)) 2))
-               (equal?
-                 (procedure-source blub)
-                 '(lambda () "Comment" (cons ('(1 . 2)) 2))))
-            (interaction-environment))))
-
+      (primitive-eval '(begin 
+                         (define (blub) "Comment" (cons ('(1 . 2)) 2))
+                         (equal?
+                          (procedure-source blub)
+                          '(lambda () "Comment" (cons ('(1 . 2)) 2)))))))
+  
   (with-test-prefix "missing or extra expressions"
 
     (pass-if-exception "(define)"
-      exception:missing-expr
+      exception:generic-syncase-error
       (eval '(define)
 	    (interaction-environment)))))
 
@@ -880,40 +895,15 @@
           (interaction-environment)))
 
   (pass-if "unmemoization"
-    (eval '(begin
-             (define (foo) 
-               (define (bar)
-                 'ok)
-               (bar))
-             (foo)
-             (equal?
-              (procedure-source foo)
-              '(lambda () (letrec ((bar (lambda () (quote ok)))) (bar)))))
-          (interaction-environment))))
-
-(with-test-prefix "do"
-
-  (with-test-prefix "unmemoization"
-
-    (pass-if "normal case"
-      (let ((foo (lambda () (do ((i 1 (+ i 1)) (j 2))
-                                ((> i 9) (+ i j))
-                              (identity i)))))
-        (foo) ; make sure, memoization has been performed
-        (equal? (procedure-source foo)
-                '(lambda () (do ((i 1 (+ i 1)) (j 2))
-                                ((> i 9) (+ i j))
-                              (identity i))))))
-
-    (pass-if "reduced case"
-      (let ((foo (lambda () (do ((i 1 (+ i 1)) (j 2 j)) ; redundant step for j
-                                ((> i 9) (+ i j))
-                              (identity i)))))
-        (foo) ; make sure, memoization has been performed
-        (equal? (procedure-source foo)
-                '(lambda () (do ((i 1 (+ i 1)) (j 2)) ; no redundancy here
-                                ((> i 9) (+ i j))
-                              (identity i))))))))
+    (primitive-eval '(begin
+                       (define (foo) 
+                         (define (bar)
+                           'ok)
+                         (bar))
+                       (foo)
+                       (matches?
+                        (procedure-source foo)
+                        (lambda () (letrec ((_ (lambda () (quote ok)))) (_))))))))
 
 (with-test-prefix "set!"
 
@@ -922,50 +912,50 @@
     (pass-if "normal set!"
       (let ((foo (lambda (x) (set! x (+ 1 x)))))
         (foo 1) ; make sure, memoization has been performed
-        (equal? (procedure-source foo)
-                '(lambda (x) (set! x (+ 1 x)))))))
+        (matches? (procedure-source foo)
+                  (lambda (_) (set! _ (+ 1 _)))))))
 
   (with-test-prefix "missing or extra expressions"
 
     (pass-if-exception "(set!)"
-      exception:missing/extra-expr
+      exception:bad-set!
       (eval '(set!)
 	    (interaction-environment)))
 
     (pass-if-exception "(set! 1)"
-      exception:missing/extra-expr
+      exception:bad-set!
       (eval '(set! 1)
 	    (interaction-environment)))
 
     (pass-if-exception "(set! 1 2 3)"
-      exception:missing/extra-expr
+      exception:bad-set!
       (eval '(set! 1 2 3)
 	    (interaction-environment))))
 
   (with-test-prefix "bad variable"
 
     (pass-if-exception "(set! \"\" #t)"
-      exception:bad-variable
+      exception:bad-set!
       (eval '(set! "" #t)
 	    (interaction-environment)))
 
     (pass-if-exception "(set! 1 #t)"
-      exception:bad-variable
+      exception:bad-set!
       (eval '(set! 1 #t)
 	    (interaction-environment)))
 
     (pass-if-exception "(set! #t #f)"
-      exception:bad-variable
+      exception:bad-set!
       (eval '(set! #t #f)
 	    (interaction-environment)))
 
     (pass-if-exception "(set! #f #t)"
-      exception:bad-variable
+      exception:bad-set!
       (eval '(set! #f #t)
 	    (interaction-environment)))
 
     (pass-if-exception "(set! #\\space #f)"
-      exception:bad-variable
+      exception:bad-set!
       (eval '(set! #\space #f)
 	    (interaction-environment)))))
 
@@ -974,12 +964,12 @@
   (with-test-prefix "missing or extra expression"
 
     (pass-if-exception "(quote)"
-      exception:missing/extra-expr
+      exception:bad-quote
       (eval '(quote)
 	    (interaction-environment)))
 
     (pass-if-exception "(quote a b)"
-      exception:missing/extra-expr
+      exception:bad-quote
       (eval '(quote a b)
 	    (interaction-environment)))))
 
@@ -1010,46 +1000,27 @@
     (do ((n 0 (1+ n)))
 	((> n 5))
       (pass-if n
-	(let ((cond (make-iterations-cond n)))
-	  (while (cond)))
-	#t)))
+	(eval `(letrec ((make-iterations-cond
+                         (lambda (n)
+                           (lambda ()
+                             (cond ((not n)
+                                    (error "oops, condition re-tested after giving false"))
+                                   ((= 0 n)
+                                    (set! n #f)
+                                    #f)
+                                   (else
+                                    (set! n (1- n))
+                                    #t))))))
+                 (let ((cond (make-iterations-cond ,n)))
+                   (while (cond))
+                   #t))
+              (interaction-environment)))))
   
   (pass-if "initially false"
     (while #f
       (unreachable))
     #t)
   
-  (with-test-prefix "in empty environment"
-
-    ;; an environment with no bindings at all
-    (define empty-environment
-      (make-module 1))
-
-    ;; these tests are 'unresolved because to work with ice-9 syncase it was
-    ;; necessary to drop the unquote from `do' in the implementation, and
-    ;; unfortunately that makes `while' depend on its evaluation environment
-      
-    (pass-if "empty body"
-      (throw 'unresolved)
-      (eval `(,while #f)
-	    empty-environment)
-      #t)
-    
-    (pass-if "initially false"
-      (throw 'unresolved)
-      (eval `(,while #f
-	       #f)
-	    empty-environment)
-      #t)
-    
-    (pass-if "iterating"
-      (throw 'unresolved)
-      (let ((cond (make-iterations-cond 3)))
-	(eval `(,while (,cond)
-		 123 456)
-	      empty-environment))
-      #t))
-  
   (with-test-prefix "iterations"
     (do ((n 0 (1+ n)))
 	((> n 5))
@@ -1063,8 +1034,9 @@
   (with-test-prefix "break"
     
     (pass-if-exception "too many args" exception:wrong-num-args
-      (while #t
-	(break 1)))
+      (eval '(while #t
+               (break 1))
+            (interaction-environment)))
     
     (with-test-prefix "from cond"
       (pass-if "first"
@@ -1135,8 +1107,9 @@
   (with-test-prefix "continue"
     
     (pass-if-exception "too many args" exception:wrong-num-args
-      (while #t
-	(continue 1)))
+      (eval '(while #t
+               (continue 1))
+            (interaction-environment)))
     
     (with-test-prefix "from cond"
       (do ((n 0 (1+ n)))
diff --git a/test-suite/tests/threads.test b/test-suite/tests/threads.test
index caace7fd4..26efe8580 100644
--- a/test-suite/tests/threads.test
+++ b/test-suite/tests/threads.test
@@ -2,25 +2,38 @@
 ;;;;
 ;;;; Copyright 2003, 2006, 2007 Free Software Foundation, Inc.
 ;;;;
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU 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,
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-threads)
   :use-module (ice-9 threads)
   :use-module (test-suite lib))
 
+(define (asyncs-still-working?)
+  (let ((a #f))
+    (system-async-mark (lambda ()
+			 (set! a #t)))
+    ;; The point of the following (equal? ...) is to go through
+    ;; primitive code (scm_equal_p) that includes a SCM_TICK call and
+    ;; hence gives system asyncs a chance to run.  Of course the
+    ;; evaluator (eval.i.c) also calls SCM_TICK regularly, but in the
+    ;; near future we may be using the VM instead of the traditional
+    ;; compiler, and then we will still want asyncs-still-working? to
+    ;; work.  (The VM should probably have SCM_TICK calls too, but
+    ;; let's not rely on that here.)
+    (equal? '(a b c) '(a b c))
+    a))
 
 (if (provided? 'threads)
     (begin
@@ -101,6 +114,9 @@
 
       (with-test-prefix "n-for-each-par-map"
 
+	(pass-if "asyncs are still working 2"
+	  (asyncs-still-working?))
+
 	(pass-if "0 in limit 10"
 	  (n-for-each-par-map 10 noop noop '())
 	  #t)
@@ -143,12 +159,18 @@
 
       (with-test-prefix "lock-mutex"
 
+	(pass-if "asyncs are still working 3"
+	  (asyncs-still-working?))
+
 	(pass-if "timed locking fails if timeout exceeded"
 	  (let ((m (make-mutex)))
 	    (lock-mutex m)
 	    (let ((t (begin-thread (lock-mutex m (+ (current-time) 1)))))
 	      (not (join-thread t)))))
 
+	(pass-if "asyncs are still working 6"
+	  (asyncs-still-working?))
+
         (pass-if "timed locking succeeds if mutex unlocked within timeout"
 	  (let* ((m (make-mutex))
 		 (c (make-condition-variable))
@@ -164,7 +186,12 @@
 	      (unlock-mutex cm)
 	      (sleep 1)
 	      (unlock-mutex m)
-	      (join-thread t)))))
+	      (join-thread t))))
+
+	(pass-if "asyncs are still working 7"
+	  (asyncs-still-working?))
+
+	)
 
       ;;
       ;; timed mutex unlocking
@@ -172,12 +199,18 @@
 
       (with-test-prefix "unlock-mutex"
 
+	(pass-if "asyncs are still working 5"
+	  (asyncs-still-working?))
+
         (pass-if "timed unlocking returns #f if timeout exceeded"
           (let ((m (make-mutex))
 		(c (make-condition-variable)))
 	    (lock-mutex m)
 	    (not (unlock-mutex m c (current-time)))))
 
+	(pass-if "asyncs are still working 4"
+	  (asyncs-still-working?))
+
         (pass-if "timed unlocking returns #t if condition signaled"
 	  (let ((m1 (make-mutex))
 		(m2 (make-mutex))
@@ -226,7 +259,36 @@
 
 	(pass-if "timed joining succeeds if thread exits within timeout"
           (let ((t (begin-thread (begin (sleep 1) #t))))
-	    (join-thread t (+ (current-time) 2)))))
+	    (join-thread t (+ (current-time) 2))))
+
+	(pass-if "asyncs are still working 1"
+	  (asyncs-still-working?))
+
+	;; scm_join_thread_timed has a SCM_TICK in the middle of it,
+	;; to allow asyncs to run (including signal delivery).  We
+	;; used to have a bug whereby if the joined thread terminated
+	;; at the same time as the joining thread is in this SCM_TICK,
+	;; scm_join_thread_timed would not notice and would hang
+	;; forever.  So in this test we are setting up the following
+	;; sequence of events.
+        ;;   T=0  other thread is created and starts running
+	;;   T=2  main thread sets up an async that will sleep for 10 seconds
+        ;;   T=2  main thread calls join-thread, which will...
+        ;;   T=2  ...call the async, which starts sleeping
+        ;;   T=5  other thread finishes its work and terminates
+        ;;   T=7  async completes, main thread continues inside join-thread.
+	(pass-if "don't hang when joined thread terminates in SCM_TICK"
+	  (let ((other-thread (make-thread sleep 5)))
+	    (letrec ((delay-count 10)
+		     (aproc (lambda ()
+			      (set! delay-count (- delay-count 1))
+			      (if (zero? delay-count)
+				  (sleep 5)
+				  (system-async-mark aproc)))))
+	      (sleep 2)
+	      (system-async-mark aproc)
+	      (join-thread other-thread)))
+	  #t))
 
       ;;
       ;; thread cancellation
diff --git a/test-suite/tests/time.test b/test-suite/tests/time.test
index d5639eb68..da7a48c04 100644
--- a/test-suite/tests/time.test
+++ b/test-suite/tests/time.test
@@ -3,20 +3,19 @@
 ;;;;
 ;;;; 	Copyright (C) 1999, 2004, 2006, 2007, 2008 Free Software Foundation, Inc.
 ;;;; 
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
 ;;;; 
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-suite test-time)
   #:use-module (test-suite lib)
@@ -203,6 +202,11 @@
       (string=? (strftime "%Z" t)
                 "ZOW")))
 
+  (pass-if "strftime passes wide characters"
+    (let ((t (localtime (current-time))))
+      (string=? (substring (strftime "\u0100%Z" t) 0 1)
+                "\u0100")))
+
   (with-test-prefix "C99 %z format"
 
     ;; %z here is quite possibly affected by the same tm:gmtoff vs current
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
new file mode 100644
index 000000000..ee5e4d352
--- /dev/null
+++ b/test-suite/tests/tree-il.test
@@ -0,0 +1,591 @@
+;;;; tree-il.test --- test suite for compiling tree-il   -*- scheme -*-
+;;;; Andy Wingo <wingo@pobox.com> --- May 2009
+;;;;
+;;;; 	Copyright (C) 2009 Free Software Foundation, Inc.
+;;;; 
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (test-suite tree-il)
+  #:use-module (test-suite lib)
+  #:use-module (system base compile)
+  #:use-module (system base pmatch)
+  #:use-module (system base message)
+  #:use-module (language tree-il)
+  #:use-module (language glil)
+  #:use-module (srfi srfi-13))
+
+;; Of course, the GLIL that is emitted depends on the source info of the
+;; input. Here we're not concerned about that, so we strip source
+;; information from the incoming tree-il.
+
+(define (strip-source x)
+  (post-order! (lambda (x) (set! (tree-il-src x) #f))
+               x))
+
+(define-syntax assert-scheme->glil
+  (syntax-rules ()
+    ((_ in out)
+     (let ((tree-il (strip-source
+                     (compile 'in #:from 'scheme #:to 'tree-il))))
+       (pass-if 'in
+                (equal? (unparse-glil (compile tree-il #:from 'tree-il #:to 'glil))
+                        'out))))))
+
+(define-syntax assert-tree-il->glil
+  (syntax-rules ()
+    ((_ in out)
+     (pass-if 'in
+              (let ((tree-il (strip-source (parse-tree-il 'in))))
+                (equal? (unparse-glil (compile tree-il #:from 'tree-il #:to 'glil))
+                        'out))))))
+
+(define-syntax assert-tree-il->glil/pmatch
+  (syntax-rules ()
+    ((_ in pat test ...)
+     (let ((exp 'in))
+       (pass-if 'in
+         (let ((glil (unparse-glil
+                      (compile (strip-source (parse-tree-il exp))
+                               #:from 'tree-il #:to 'glil))))
+           (pmatch glil
+             (pat (guard test ...) #t)
+             (else #f))))))))
+
+(with-test-prefix "void"
+  (assert-tree-il->glil
+   (void)
+   (program 0 0 0 () (void) (call return 1)))
+  (assert-tree-il->glil
+   (begin (void) (const 1))
+   (program 0 0 0 () (const 1) (call return 1)))
+  (assert-tree-il->glil
+   (apply (primitive +) (void) (const 1))
+   (program 0 0 0 () (void) (call add1 1) (call return 1))))
+
+(with-test-prefix "application"
+  (assert-tree-il->glil
+   (apply (toplevel foo) (const 1))
+   (program 0 0 0 () (toplevel ref foo) (const 1) (call goto/args 1)))
+  (assert-tree-il->glil/pmatch
+   (begin (apply (toplevel foo) (const 1)) (void))
+   (program 0 0 0 () (call new-frame 0) (toplevel ref foo) (const 1) (mv-call 1 ,l1)
+            (call drop 1) (branch br ,l2)
+            (label ,l3) (mv-bind () #f) (unbind)
+            (label ,l4)
+            (void) (call return 1))
+   (and (eq? l1 l3) (eq? l2 l4)))
+  (assert-tree-il->glil
+   (apply (toplevel foo) (apply (toplevel bar)))
+   (program 0 0 0 () (toplevel ref foo) (call new-frame 0) (toplevel ref bar) (call call 0)
+            (call goto/args 1))))
+
+(with-test-prefix "conditional"
+  (assert-tree-il->glil/pmatch
+   (if (const #t) (const 1) (const 2))
+   (program 0 0 0 () (const #t) (branch br-if-not ,l1)
+            (const 1) (call return 1)
+            (label ,l2) (const 2) (call return 1))
+   (eq? l1 l2))
+  
+  (assert-tree-il->glil/pmatch
+   (begin (if (const #t) (const 1) (const 2)) (const #f))
+   (program 0 0 0 () (const #t) (branch br-if-not ,l1) (branch br ,l2)
+            (label ,l3) (label ,l4) (const #f) (call return 1))
+   (eq? l1 l3) (eq? l2 l4))
+
+  (assert-tree-il->glil/pmatch
+   (apply (primitive null?) (if (const #t) (const 1) (const 2)))
+   (program 0 0 0 () (const #t) (branch br-if-not ,l1)
+            (const 1) (branch br ,l2)
+                    (label ,l3) (const 2) (label ,l4)
+                    (call null? 1) (call return 1))
+   (eq? l1 l3) (eq? l2 l4)))
+
+(with-test-prefix "primitive-ref"
+  (assert-tree-il->glil
+   (primitive +)
+   (program 0 0 0 () (toplevel ref +) (call return 1)))
+
+  (assert-tree-il->glil
+   (begin (primitive +) (const #f))
+   (program 0 0 0 () (const #f) (call return 1)))
+
+  (assert-tree-il->glil
+   (apply (primitive null?) (primitive +))
+   (program 0 0 0 () (toplevel ref +) (call null? 1)
+            (call return 1))))
+
+(with-test-prefix "lexical refs"
+  (assert-tree-il->glil
+   (let (x) (y) ((const 1)) (lexical x y))
+   (program 0 0 1 ()
+            (const 1) (bind (x #f 0)) (lexical #t #f set 0)
+            (lexical #t #f ref 0) (call return 1)
+            (unbind)))
+
+  (assert-tree-il->glil
+   (let (x) (y) ((const 1)) (begin (lexical x y) (const #f)))
+   (program 0 0 1 ()
+            (const 1) (bind (x #f 0)) (lexical #t #f set 0)
+            (const #f) (call return 1)
+            (unbind)))
+
+  (assert-tree-il->glil
+   (let (x) (y) ((const 1)) (apply (primitive null?) (lexical x y)))
+   (program 0 0 1 ()
+            (const 1) (bind (x #f 0)) (lexical #t #f set 0)
+            (lexical #t #f ref 0) (call null? 1) (call return 1)
+            (unbind))))
+
+(with-test-prefix "lexical sets"
+  (assert-tree-il->glil
+   ;; unreferenced sets may be optimized away -- make sure they are ref'd
+   (let (x) (y) ((const 1))
+        (set! (lexical x y) (apply (primitive 1+) (lexical x y))))
+   (program 0 0 1 ()
+            (const 1) (bind (x #t 0)) (lexical #t #t box 0)
+            (lexical #t #t ref 0) (call add1 1) (lexical #t #t set 0)
+            (void) (call return 1)
+            (unbind)))
+
+  (assert-tree-il->glil
+   (let (x) (y) ((const 1))
+        (begin (set! (lexical x y) (apply (primitive 1+) (lexical x y)))
+               (lexical x y)))
+   (program 0 0 1 ()
+            (const 1) (bind (x #t 0)) (lexical #t #t box 0)
+            (lexical #t #t ref 0) (call add1 1) (lexical #t #t set 0)
+            (lexical #t #t ref 0) (call return 1)
+            (unbind)))
+
+  (assert-tree-il->glil
+   (let (x) (y) ((const 1))
+     (apply (primitive null?)
+            (set! (lexical x y) (apply (primitive 1+) (lexical x y)))))
+   (program 0 0 1 ()
+            (const 1) (bind (x #t 0)) (lexical #t #t box 0)
+            (lexical #t #t ref 0) (call add1 1) (lexical #t #t set 0) (void)
+            (call null? 1) (call return 1)
+            (unbind))))
+
+(with-test-prefix "module refs"
+  (assert-tree-il->glil
+   (@ (foo) bar)
+   (program 0 0 0 ()
+            (module public ref (foo) bar)
+            (call return 1)))
+
+  (assert-tree-il->glil
+   (begin (@ (foo) bar) (const #f))
+   (program 0 0 0 ()
+            (module public ref (foo) bar) (call drop 1)
+            (const #f) (call return 1)))
+
+  (assert-tree-il->glil
+   (apply (primitive null?) (@ (foo) bar))
+   (program 0 0 0 ()
+            (module public ref (foo) bar)
+            (call null? 1) (call return 1)))
+
+  (assert-tree-il->glil
+   (@@ (foo) bar)
+   (program 0 0 0 ()
+            (module private ref (foo) bar)
+            (call return 1)))
+
+  (assert-tree-il->glil
+   (begin (@@ (foo) bar) (const #f))
+   (program 0 0 0 ()
+            (module private ref (foo) bar) (call drop 1)
+            (const #f) (call return 1)))
+
+  (assert-tree-il->glil
+   (apply (primitive null?) (@@ (foo) bar))
+   (program 0 0 0 ()
+            (module private ref (foo) bar)
+            (call null? 1) (call return 1))))
+
+(with-test-prefix "module sets"
+  (assert-tree-il->glil
+   (set! (@ (foo) bar) (const 2))
+   (program 0 0 0 ()
+            (const 2) (module public set (foo) bar)
+            (void) (call return 1)))
+
+  (assert-tree-il->glil
+   (begin (set! (@ (foo) bar) (const 2)) (const #f))
+   (program 0 0 0 ()
+            (const 2) (module public set (foo) bar)
+            (const #f) (call return 1)))
+
+  (assert-tree-il->glil
+   (apply (primitive null?) (set! (@ (foo) bar) (const 2)))
+   (program 0 0 0 ()
+            (const 2) (module public set (foo) bar)
+            (void) (call null? 1) (call return 1)))
+
+  (assert-tree-il->glil
+   (set! (@@ (foo) bar) (const 2))
+   (program 0 0 0 ()
+            (const 2) (module private set (foo) bar)
+            (void) (call return 1)))
+
+  (assert-tree-il->glil
+   (begin (set! (@@ (foo) bar) (const 2)) (const #f))
+   (program 0 0 0 ()
+            (const 2) (module private set (foo) bar)
+            (const #f) (call return 1)))
+
+  (assert-tree-il->glil
+   (apply (primitive null?) (set! (@@ (foo) bar) (const 2)))
+   (program 0 0 0 ()
+            (const 2) (module private set (foo) bar)
+            (void) (call null? 1) (call return 1))))
+
+(with-test-prefix "toplevel refs"
+  (assert-tree-il->glil
+   (toplevel bar)
+   (program 0 0 0 ()
+            (toplevel ref bar)
+            (call return 1)))
+
+  (assert-tree-il->glil
+   (begin (toplevel bar) (const #f))
+   (program 0 0 0 ()
+            (toplevel ref bar) (call drop 1)
+            (const #f) (call return 1)))
+
+  (assert-tree-il->glil
+   (apply (primitive null?) (toplevel bar))
+   (program 0 0 0 ()
+            (toplevel ref bar)
+            (call null? 1) (call return 1))))
+
+(with-test-prefix "toplevel sets"
+  (assert-tree-il->glil
+   (set! (toplevel bar) (const 2))
+   (program 0 0 0 ()
+            (const 2) (toplevel set bar)
+            (void) (call return 1)))
+
+  (assert-tree-il->glil
+   (begin (set! (toplevel bar) (const 2)) (const #f))
+   (program 0 0 0 ()
+            (const 2) (toplevel set bar)
+            (const #f) (call return 1)))
+
+  (assert-tree-il->glil
+   (apply (primitive null?) (set! (toplevel bar) (const 2)))
+   (program 0 0 0 ()
+            (const 2) (toplevel set bar)
+            (void) (call null? 1) (call return 1))))
+
+(with-test-prefix "toplevel defines"
+  (assert-tree-il->glil
+   (define bar (const 2))
+   (program 0 0 0 ()
+            (const 2) (toplevel define bar)
+            (void) (call return 1)))
+
+  (assert-tree-il->glil
+   (begin (define bar (const 2)) (const #f))
+   (program 0 0 0 ()
+            (const 2) (toplevel define bar)
+            (const #f) (call return 1)))
+
+  (assert-tree-il->glil
+   (apply (primitive null?) (define bar (const 2)))
+   (program 0 0 0 ()
+            (const 2) (toplevel define bar)
+            (void) (call null? 1) (call return 1))))
+
+(with-test-prefix "constants"
+  (assert-tree-il->glil
+   (const 2)
+   (program 0 0 0 ()
+            (const 2) (call return 1)))
+
+  (assert-tree-il->glil
+   (begin (const 2) (const #f))
+   (program 0 0 0 ()
+            (const #f) (call return 1)))
+
+  (assert-tree-il->glil
+   (apply (primitive null?) (const 2))
+   (program 0 0 0 ()
+            (const 2) (call null? 1) (call return 1))))
+
+(with-test-prefix "lambda"
+  (assert-tree-il->glil
+   (lambda (x) (y) () (const 2))
+   (program 0 0 0 ()
+            (program 1 0 0 ()
+                     (bind (x #f 0))
+                     (const 2) (call return 1))
+            (call return 1)))
+
+  (assert-tree-il->glil
+   (lambda (x x1) (y y1) () (const 2))
+   (program 0 0 0 ()
+            (program 2 0 0 ()
+                     (bind (x #f 0) (x1 #f 1))
+                     (const 2) (call return 1))
+            (call return 1)))
+
+  (assert-tree-il->glil
+   (lambda x y () (const 2))
+   (program 0 0 0 ()
+            (program 1 1 0 ()
+                     (bind (x #f 0))
+                     (const 2) (call return 1))
+            (call return 1)))
+
+  (assert-tree-il->glil
+   (lambda (x . x1) (y . y1) () (const 2))
+   (program 0 0 0 ()
+            (program 2 1 0 ()
+                     (bind (x #f 0) (x1 #f 1))
+                     (const 2) (call return 1))
+            (call return 1)))
+
+  (assert-tree-il->glil
+   (lambda (x . x1) (y . y1) () (lexical x y))
+   (program 0 0 0 ()
+            (program 2 1 0 ()
+                     (bind (x #f 0) (x1 #f 1))
+                     (lexical #t #f ref 0) (call return 1))
+            (call return 1)))
+
+  (assert-tree-il->glil
+   (lambda (x . x1) (y . y1) () (lexical x1 y1))
+   (program 0 0 0 ()
+            (program 2 1 0 ()
+                     (bind (x #f 0) (x1 #f 1))
+                     (lexical #t #f ref 1) (call return 1))
+            (call return 1)))
+
+  (assert-tree-il->glil
+   (lambda (x) (x1) () (lambda (y) (y1) () (lexical x x1)))
+   (program 0 0 0 ()
+            (program 1 0 0 ()
+                     (bind (x #f 0))
+                     (program 1 0 0 ()
+                              (bind (y #f 0))
+                              (lexical #f #f ref 0) (call return 1))
+                     (lexical #t #f ref 0)
+                     (call vector 1)
+                     (call make-closure 2)
+                     (call return 1))
+            (call return 1))))
+
+(with-test-prefix "sequence"
+  (assert-tree-il->glil
+   (begin (begin (const 2) (const #f)) (const #t))
+   (program 0 0 0 ()
+            (const #t) (call return 1)))
+
+  (assert-tree-il->glil
+   (apply (primitive null?) (begin (const #f) (const 2)))
+   (program 0 0 0 ()
+            (const 2) (call null? 1) (call return 1))))
+
+;; FIXME: binding info for or-hacked locals might bork the disassembler,
+;; and could be tightened in any case
+(with-test-prefix "the or hack"
+  (assert-tree-il->glil/pmatch
+   (let (x) (y) ((const 1))
+        (if (lexical x y)
+            (lexical x y)
+            (let (a) (b) ((const 2))
+                 (lexical a b))))
+   (program 0 0 1 ()
+            (const 1) (bind (x #f 0)) (lexical #t #f set 0)
+            (lexical #t #f ref 0) (branch br-if-not ,l1)
+            (lexical #t #f ref 0) (call return 1)
+            (label ,l2)
+            (const 2) (bind (a #f 0)) (lexical #t #f set 0)
+            (lexical #t #f ref 0) (call return 1)
+            (unbind)
+            (unbind))
+   (eq? l1 l2))
+
+  ;; second bound var is unreferenced
+  (assert-tree-il->glil/pmatch
+   (let (x) (y) ((const 1))
+        (if (lexical x y)
+            (lexical x y)
+            (let (a) (b) ((const 2))
+                 (lexical x y))))
+   (program 0 0 1 ()
+            (const 1) (bind (x #f 0)) (lexical #t #f set 0)
+            (lexical #t #f ref 0) (branch br-if-not ,l1)
+            (lexical #t #f ref 0) (call return 1)
+            (label ,l2)
+            (lexical #t #f ref 0) (call return 1)
+            (unbind))
+   (eq? l1 l2)))
+
+(with-test-prefix "apply"
+  (assert-tree-il->glil
+   (apply (primitive @apply) (toplevel foo) (toplevel bar))
+   (program 0 0 0 () (toplevel ref foo) (toplevel ref bar) (call goto/apply 2)))
+  (assert-tree-il->glil/pmatch
+   (begin (apply (primitive @apply) (toplevel foo) (toplevel bar)) (void))
+   (program 0 0 0 ()
+            (call new-frame 0) (toplevel ref apply) (toplevel ref foo) (toplevel ref bar) (mv-call 2 ,l1)
+            (call drop 1) (branch br ,l2) (label ,l3) (mv-bind () #f) (unbind)
+            (label ,l4)
+            (void) (call return 1))
+   (and (eq? l1 l3) (eq? l2 l4)))
+  (assert-tree-il->glil
+   (apply (toplevel foo) (apply (toplevel @apply) (toplevel bar) (toplevel baz)))
+   (program 0 0 0 ()
+            (toplevel ref foo)
+            (call new-frame 0) (toplevel ref bar) (toplevel ref baz) (call apply 2)
+            (call goto/args 1))))
+
+(with-test-prefix "call/cc"
+  (assert-tree-il->glil
+   (apply (primitive @call-with-current-continuation) (toplevel foo))
+   (program 0 0 0 () (toplevel ref foo) (call goto/cc 1)))
+  (assert-tree-il->glil/pmatch
+   (begin (apply (primitive @call-with-current-continuation) (toplevel foo)) (void))
+   (program 0 0 0 ()
+            (call new-frame 0) (toplevel ref call-with-current-continuation) (toplevel ref foo) (mv-call 1 ,l1)
+            (call drop 1) (branch br ,l2) (label ,l3) (mv-bind () #f) (unbind)
+            (label ,l4)
+            (void) (call return 1))
+   (and (eq? l1 l3) (eq? l2 l4)))
+  (assert-tree-il->glil
+   (apply (toplevel foo)
+          (apply (toplevel @call-with-current-continuation) (toplevel bar)))
+   (program 0 0 0 ()
+            (toplevel ref foo)
+            (toplevel ref bar) (call call/cc 1)
+            (call goto/args 1))))
+
+
+(with-test-prefix "tree-il-fold"
+
+  (pass-if "empty tree"
+    (let ((leaf? #f) (up? #f) (down? #f) (mark (list 'mark)))
+      (and (eq? mark
+                (tree-il-fold (lambda (x y) (set! leaf? #t) y)
+                              (lambda (x y) (set! down? #t) y)
+                              (lambda (x y) (set! up? #t) y)
+                              mark
+                              '()))
+           (not leaf?)
+           (not up?)
+           (not down?))))
+
+  (pass-if "lambda and application"
+    (let* ((leaves '()) (ups '()) (downs '())
+           (result (tree-il-fold (lambda (x y)
+                                   (set! leaves (cons x leaves))
+                                   (1+ y))
+                                 (lambda (x y)
+                                   (set! downs (cons x downs))
+                                   (1+ y))
+                                 (lambda (x y)
+                                   (set! ups (cons x ups))
+                                   (1+ y))
+                                 0
+                                 (parse-tree-il
+                                  '(lambda (x y) (x1 y1)
+                                     (apply (toplevel +)
+                                            (lexical x x1)
+                                            (lexical y y1)))))))
+      (and (equal? (map strip-source leaves)
+                   (list (make-lexical-ref #f 'y 'y1)
+                         (make-lexical-ref #f 'x 'x1)
+                         (make-toplevel-ref #f '+)))
+           (= (length downs) 2)
+           (equal? (reverse (map strip-source ups))
+                   (map strip-source downs))))))
+
+
+;;;
+;;; Warnings.
+;;;
+
+;; Make sure we get English messages.
+(setlocale LC_ALL "C")
+
+(define (call-with-warnings thunk)
+  (let ((port (open-output-string)))
+    (with-fluid* *current-warning-port* port
+      thunk)
+    (let ((warnings (get-output-string port)))
+      (string-tokenize warnings
+                       (char-set-complement (char-set #\newline))))))
+
+(define %opts-w-unused
+  '(#:warnings (unused-variable)))
+
+
+(with-test-prefix "warnings"
+
+   (pass-if "unknown warning type"
+     (let ((w (call-with-warnings
+                (lambda ()
+                  (compile #t #:opts '(#:warnings (does-not-exist)))))))
+       (and (= (length w) 1)
+            (number? (string-contains (car w) "unknown warning")))))
+
+   (with-test-prefix "unused-variable"
+
+     (pass-if "quiet"
+       (null? (call-with-warnings
+                (lambda ()
+                  (compile '(lambda (x y) (+ x y))
+                           #:opts %opts-w-unused)))))
+
+     (pass-if "let/unused"
+       (let ((w (call-with-warnings
+                  (lambda ()
+                    (compile '(lambda (x)
+                                (let ((y (+ x 2)))
+                                  x))
+                             #:opts %opts-w-unused)))))
+         (and (= (length w) 1)
+              (number? (string-contains (car w) "unused variable `y'")))))
+
+     (pass-if "shadowed variable"
+       (let ((w (call-with-warnings
+                  (lambda ()
+                    (compile '(lambda (x)
+                                (let ((y x))
+                                  (let ((y (+ x 2)))
+                                    (+ x y))))
+                             #:opts %opts-w-unused)))))
+         (and (= (length w) 1)
+              (number? (string-contains (car w) "unused variable `y'")))))
+
+     (pass-if "letrec"
+       (null? (call-with-warnings
+                (lambda ()
+                  (compile '(lambda ()
+                              (letrec ((x (lambda () (y)))
+                                       (y (lambda () (x))))
+                                y))
+                           #:opts %opts-w-unused)))))
+
+     (pass-if "unused argument"
+       ;; Unused arguments should not be reported.
+       (null? (call-with-warnings
+                (lambda ()
+                  (compile '(lambda (x y z) #t)
+                           #:opts %opts-w-unused)))))))
diff --git a/test-suite/tests/unif.test b/test-suite/tests/unif.test
index 576a9286c..5d584e86e 100644
--- a/test-suite/tests/unif.test
+++ b/test-suite/tests/unif.test
@@ -1,11 +1,11 @@
 ;;;; unif.test --- tests guile's uniform arrays     -*- scheme -*-
 ;;;;
-;;;; Copyright 2004, 2006 Free Software Foundation, Inc.
+;;;; Copyright 2004, 2006, 2009 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -17,7 +17,7 @@
 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-suite test-unif)
-  #:use-module (test-suite lib))
+    #:use-module (test-suite lib))
 
 ;;;
 ;;; array?
diff --git a/test-suite/tests/vectors.test b/test-suite/tests/vectors.test
index 738a0828a..22434bfc6 100644
--- a/test-suite/tests/vectors.test
+++ b/test-suite/tests/vectors.test
@@ -2,20 +2,19 @@
 ;;;;
 ;;;; Copyright (C) 2003, 2006 Free Software Foundation, Inc.
 ;;;; 
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
 ;;;; 
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-suite vectors)
   :use-module (test-suite lib))
diff --git a/test-suite/tests/version.test b/test-suite/tests/version.test
index b2a491950..5b7acc93d 100644
--- a/test-suite/tests/version.test
+++ b/test-suite/tests/version.test
@@ -3,20 +3,19 @@
 ;;;;
 ;;;; 	Copyright (C) 2000, 2001, 2006 Free Software Foundation, Inc.
 ;;;; 
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
 ;;;; 
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (use-modules (test-suite lib))
 
diff --git a/test-suite/tests/weaks.test b/test-suite/tests/weaks.test
index 7bb77b07c..b469887c2 100644
--- a/test-suite/tests/weaks.test
+++ b/test-suite/tests/weaks.test
@@ -4,7 +4,7 @@
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;; 
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/testsuite/Makefile.am b/testsuite/Makefile.am
new file mode 100644
index 000000000..2bc78142c
--- /dev/null
+++ b/testsuite/Makefile.am
@@ -0,0 +1,27 @@
+TESTS_ENVIRONMENT = \
+	$(top_builddir)/meta/guile \
+	-l $(srcdir)/run-vm-tests.scm -e run-vm-tests
+
+TESTS =						\
+      t-basic-contructs.scm			\
+      t-global-bindings.scm			\
+      t-catch.scm				\
+      t-call-cc.scm				\
+      t-closure.scm				\
+      t-closure2.scm				\
+      t-closure3.scm				\
+      t-closure4.scm				\
+      t-do-loop.scm				\
+      t-literal-integers.scm			\
+      t-macros.scm				\
+      t-macros2.scm				\
+      t-map.scm					\
+      t-or.scm					\
+      t-proc-with-setter.scm			\
+      t-quasiquote.scm				\
+      t-values.scm				\
+      t-records.scm				\
+      t-match.scm				\
+      t-mutual-toplevel-defines.scm
+
+EXTRA_DIST = run-vm-tests.scm $(TESTS)
diff --git a/testsuite/run-vm-tests.scm b/testsuite/run-vm-tests.scm
new file mode 100644
index 000000000..39e7bf117
--- /dev/null
+++ b/testsuite/run-vm-tests.scm
@@ -0,0 +1,91 @@
+;;; run-vm-tests.scm -- Run Guile-VM's test suite.
+;;;
+;;; Copyright 2005, 2009 Free Software Foundation, Inc.
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 3 of
+;;; the License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
+
+
+(use-modules (system vm vm)
+	     (system base compile)
+	     (system base language)
+             (language scheme spec)
+             (language objcode spec)
+	     (srfi srfi-1)
+	     (ice-9 r5rs))
+
+
+(define (fetch-sexp-from-file file)
+  (with-input-from-file file
+    (lambda ()
+      (let loop ((sexp (read))
+		 (result '()))
+	(if (eof-object? sexp)
+	    (cons 'begin (reverse result))
+	    (loop (read) (cons sexp result)))))))
+
+(define (compile-to-objcode sexp)
+  "Compile the expression @var{sexp} into a VM program and return it."
+  (compile sexp #:from scheme #:to objcode))
+
+(define (run-vm-program objcode)
+  "Run VM program contained into @var{objcode}."
+  (vm-load (the-vm) objcode))
+
+(define (compile/run-test-from-file file)
+  "Run test from source file @var{file} and return a value indicating whether
+it succeeded."
+  (run-vm-program (compile-to-objcode (fetch-sexp-from-file file))))
+
+
+(define-macro (watch-proc proc-name str)
+  `(let ((orig-proc ,proc-name))
+     (set! ,proc-name
+	   (lambda args
+	     (format #t (string-append ,str "...  "))
+	     (apply orig-proc args)))))
+
+(watch-proc fetch-sexp-from-file  "reading")
+(watch-proc compile-to-objcode    "compiling")
+(watch-proc run-vm-program        "running")
+
+
+;; The program.
+
+(define (run-vm-tests files)
+  "For each file listed in @var{files}, load it and run it through both the
+interpreter and the VM (after having it compiled).  Both results must be
+equal in the sense of @var{equal?}."
+  (let* ((res (map (lambda (file)
+		     (format #t "running `~a'...  " file)
+		     (if (catch #t
+				(lambda ()
+				  (equal? (compile/run-test-from-file file)
+					  (primitive-eval (fetch-sexp-from-file file))))
+				(lambda (key . args)
+				  (format #t "[~a/~a] " key args)
+				  #f))
+			 (format #t "ok~%")
+			 (begin (format #t "FAILED~%") #f)))
+		   files))
+	 (total (length files))
+	 (failed (length (filter not res))))
+
+    (if (= 0 failed)
+        (exit 0)
+	(begin
+	  (format #t "~%~a tests failed out of ~a~%"
+		  failed total)
+	  (exit failed)))))
+
diff --git a/testsuite/t-basic-contructs.scm b/testsuite/t-basic-contructs.scm
new file mode 100644
index 000000000..53ee81dcd
--- /dev/null
+++ b/testsuite/t-basic-contructs.scm
@@ -0,0 +1,16 @@
+;;; Basic RnRS constructs.
+
+(and (eq? 2 (begin (+ 2 4) 5 2))
+     ((lambda (x y)
+	(and (eq? x 1) (eq? y 2)
+	     (begin
+	       (set! x 11) (set! y 22)
+	       (and (eq? x 11) (eq? y 22)))))
+      1 2)
+     (let ((x 1) (y 3))
+       (and (eq? x 1) (eq? y 3)))
+     (let loop ((x #t))
+       (if (not x)
+	   #t
+	   (loop #f))))
+
diff --git a/testsuite/t-call-cc.scm b/testsuite/t-call-cc.scm
new file mode 100644
index 000000000..05e4de98c
--- /dev/null
+++ b/testsuite/t-call-cc.scm
@@ -0,0 +1,16 @@
+(let ((set-counter2 #f))
+  (define (get-counter2)
+    (call/cc
+     (lambda (k)
+       (set! set-counter2 k)
+       1)))
+  (define (loop counter1)
+    (let ((counter2 (get-counter2)))
+      (set! counter1 (1+ counter1))
+      (cond ((not (= counter1 counter2))
+             (error "bad call/cc behaviour" counter1 counter2))
+            ((> counter1 10)
+             #t)
+            (else
+             (set-counter2 (1+ counter2))))))
+  (loop 0))
diff --git a/testsuite/t-catch.scm b/testsuite/t-catch.scm
new file mode 100644
index 000000000..9cc3e0e14
--- /dev/null
+++ b/testsuite/t-catch.scm
@@ -0,0 +1,10 @@
+;; Test that nonlocal exits of the VM work.
+
+(begin
+  (define (foo thunk)
+    (catch #t thunk (lambda args args)))
+  (foo
+   (lambda ()
+     (let ((a 'one))
+       (1+ a)))))
+       
diff --git a/testsuite/t-closure.scm b/testsuite/t-closure.scm
new file mode 100644
index 000000000..3d791979e
--- /dev/null
+++ b/testsuite/t-closure.scm
@@ -0,0 +1,8 @@
+(define func
+  (let ((x 2))
+    (lambda ()
+      (let ((x++ (+ 1 x)))
+	(set! x x++)
+	x++))))
+
+(list (func) (func) (func))
diff --git a/testsuite/t-closure2.scm b/testsuite/t-closure2.scm
new file mode 100644
index 000000000..fd1df34fd
--- /dev/null
+++ b/testsuite/t-closure2.scm
@@ -0,0 +1,10 @@
+
+(define (uid)
+  (let* ((x 2)
+	 (do-uid (lambda ()
+		   (let ((x++ (+ 1 x)))
+		     (set! x x++)
+		     x++))))
+    (do-uid)))
+
+(list (uid) (uid) (uid))
diff --git a/testsuite/t-closure3.scm b/testsuite/t-closure3.scm
new file mode 100644
index 000000000..2295a511a
--- /dev/null
+++ b/testsuite/t-closure3.scm
@@ -0,0 +1,7 @@
+(define (stuff)
+  (let* ((x 2)
+	 (chbouib (lambda (z)
+		    (+ 7 z x))))
+    (chbouib 77)))
+
+(stuff)
diff --git a/testsuite/t-closure4.scm b/testsuite/t-closure4.scm
new file mode 100644
index 000000000..61258012f
--- /dev/null
+++ b/testsuite/t-closure4.scm
@@ -0,0 +1,22 @@
+(define (extract-symbols exp)
+  (define (process x out cont)
+    (cond ((pair? x)
+           (process (car x)
+                    out
+                    (lambda (car-x out)
+                      ;; used to have a bug here whereby `x' was
+                      ;; modified in the self-tail-recursion to (process
+                      ;; (cdr x) ...), because we didn't allocate fresh
+                      ;; externals when doing self-tail-recursion.
+                      (process (cdr x)
+                               out
+                               (lambda (cdr-x out)
+                                 (cont (cons car-x cdr-x)
+                                       out))))))
+          ((symbol? x)
+           (cont x (cons x out)))
+          (else
+           (cont x out))))
+  (process exp '() (lambda (x out) out)))
+
+(extract-symbols '(a b . c))
diff --git a/testsuite/t-do-loop.scm b/testsuite/t-do-loop.scm
new file mode 100644
index 000000000..6455bcdb2
--- /dev/null
+++ b/testsuite/t-do-loop.scm
@@ -0,0 +1,5 @@
+(let ((n+ 0))
+  (do ((n- 5  (1- n-))
+       (n+ n+ (1+ n+)))
+      ((= n- 0))
+    (format #f "n- = ~a~%" n-)))
diff --git a/testsuite/t-global-bindings.scm b/testsuite/t-global-bindings.scm
new file mode 100644
index 000000000..c8ae3692c
--- /dev/null
+++ b/testsuite/t-global-bindings.scm
@@ -0,0 +1,13 @@
+;; Are global bindings reachable at run-time?  This relies on the
+;; `object-ref' and `object-set' instructions.
+
+(begin
+
+  (define the-binding "hello")
+
+  ((lambda () the-binding))
+
+  ((lambda () (set! the-binding "world")))
+
+  ((lambda () the-binding)))
+
diff --git a/testsuite/t-literal-integers.scm b/testsuite/t-literal-integers.scm
new file mode 100644
index 000000000..bf015a4ff
--- /dev/null
+++ b/testsuite/t-literal-integers.scm
@@ -0,0 +1,5 @@
+;; Check whether literal integers are correctly signed.
+
+(and (=  4294967295 (- (expt 2 32) 1))      ;; unsigned
+     (= -2147483648 (- (expt 2 31)))        ;; signed
+     (=  2147483648 (expt 2 31)))           ;; unsigned
diff --git a/testsuite/t-macros.scm b/testsuite/t-macros.scm
new file mode 100644
index 000000000..bb44b46b7
--- /dev/null
+++ b/testsuite/t-macros.scm
@@ -0,0 +1,4 @@
+;; Are built-in macros well-expanded at compilation-time?
+
+(false-if-exception (+ 2 2))
+(read-options)
diff --git a/testsuite/t-macros2.scm b/testsuite/t-macros2.scm
new file mode 100644
index 000000000..4cc258278
--- /dev/null
+++ b/testsuite/t-macros2.scm
@@ -0,0 +1,17 @@
+;; Are macros well-expanded at compilation-time?
+
+(defmacro minus-binary (a b)
+  `(- ,a ,b))
+
+(define-macro (plus . args)
+  `(let ((res (+ ,@args)))
+     ;;(format #t "plus -> ~a~%" res)
+     res))
+
+
+(plus (let* ((x (minus-binary 12 7)) ;; 5
+	     (y (minus-binary x 1))) ;; 4
+	(plus x y 5)) ;; 14
+      12              ;; 26
+      (expt 2 3))     ;; => 34
+
diff --git a/testsuite/t-map.scm b/testsuite/t-map.scm
new file mode 100644
index 000000000..76bf1730f
--- /dev/null
+++ b/testsuite/t-map.scm
@@ -0,0 +1,10 @@
+; Currently, map is a C function, so this is a way of testing that the
+; VM is reentrant.
+
+(begin
+
+  (define (square x)
+    (* x x))
+
+  (map (lambda (x) (square x))
+       '(1 2 3)))
diff --git a/testsuite/t-match.scm b/testsuite/t-match.scm
new file mode 100644
index 000000000..ed56ae7ef
--- /dev/null
+++ b/testsuite/t-match.scm
@@ -0,0 +1,26 @@
+;;; Pattern matching with `(ice-9 match)'.
+;;;
+
+(use-modules (ice-9 match)
+             (srfi srfi-9))  ;; record type (FIXME: See `t-records.scm')
+
+(define-record-type <stuff>
+  (%make-stuff chbouib)
+  stuff?
+  (chbouib stuff:chbouib stuff:set-chbouib!))
+
+(define (matches? obj)
+;  (format #t "matches? ~a~%" obj)
+  (match obj
+	 (($ stuff) #t)
+;	 (blurps    #t)
+	 ("hello"   #t)
+	 (else #f)))
+
+
+;(format #t "go!~%")
+(and (matches? (%make-stuff 12))
+     (matches? (%make-stuff 7))
+     (matches? "hello")
+;     (matches? 'blurps)
+     (not (matches? 66)))
diff --git a/testsuite/t-mutual-toplevel-defines.scm b/testsuite/t-mutual-toplevel-defines.scm
new file mode 100644
index 000000000..795c74423
--- /dev/null
+++ b/testsuite/t-mutual-toplevel-defines.scm
@@ -0,0 +1,8 @@
+(define (even? x)
+  (or (zero? x)
+      (not (odd? (1- x)))))
+
+(define (odd? x)
+  (not (even? (1- x))))
+
+(even? 20)
diff --git a/testsuite/t-or.scm b/testsuite/t-or.scm
new file mode 100644
index 000000000..0c581e9c7
--- /dev/null
+++ b/testsuite/t-or.scm
@@ -0,0 +1,29 @@
+;; all the different permutations of or
+(list
+ ;; not in tail position, no args
+ (or)
+ ;; not in tail position, one arg
+ (or 'what)
+ (or #f)
+ ;; not in tail position, two arg
+ (or 'what 'where)
+ (or #f 'where)
+ (or #f #f)
+ (or 'what #f)
+ ;; not in tail position, value discarded
+ (begin (or 'what (error "two")) 'two)
+ ;; in tail position (within the lambdas)
+ ((lambda ()
+    (or)))
+ ((lambda ()
+    (or 'what)))
+ ((lambda ()
+    (or #f)))
+ ((lambda ()
+    (or 'what 'where)))
+ ((lambda ()
+    (or #f 'where)))
+ ((lambda ()
+    (or #f #f)))
+ ((lambda ()
+    (or 'what #f))))
diff --git a/testsuite/t-proc-with-setter.scm b/testsuite/t-proc-with-setter.scm
new file mode 100644
index 000000000..f6ffe15b0
--- /dev/null
+++ b/testsuite/t-proc-with-setter.scm
@@ -0,0 +1,20 @@
+(define the-struct (vector 1 2))
+
+(define get/set
+  (make-procedure-with-setter
+   (lambda (struct name)
+     (case name
+       ((first)  (vector-ref struct 0))
+       ((second) (vector-ref struct 1))
+       (else     #f)))
+   (lambda (struct name val)
+     (case name
+       ((first)  (vector-set! struct 0 val))
+       ((second) (vector-set! struct 1 val))
+       (else     #f)))))
+
+(and (eq? (vector-ref the-struct 0) (get/set the-struct 'first))
+     (eq? (vector-ref the-struct 1) (get/set the-struct 'second))
+     (begin
+       (set! (get/set the-struct 'second) 77)
+       (eq? (vector-ref the-struct 1) (get/set the-struct 'second))))
diff --git a/testsuite/t-quasiquote.scm b/testsuite/t-quasiquote.scm
new file mode 100644
index 000000000..08e306c39
--- /dev/null
+++ b/testsuite/t-quasiquote.scm
@@ -0,0 +1,12 @@
+(list
+  `()
+  `foo
+  `(foo)
+  `(foo bar)
+  `(1 2)
+  (let ((x 1)) `,x)
+  (let ((x 1)) `(,x))
+  (let ((x 1)) ``(,x))
+  (let ((head '(a b))
+        (tail 'c))
+    `(,@head . ,tail)))
diff --git a/testsuite/t-records.scm b/testsuite/t-records.scm
new file mode 100644
index 000000000..0cb320da3
--- /dev/null
+++ b/testsuite/t-records.scm
@@ -0,0 +1,15 @@
+;;; SRFI-9 Records.
+;;;
+
+(use-modules (srfi srfi-9))
+
+(define-record-type <stuff>
+  (%make-stuff chbouib)
+  stuff?
+  (chbouib stuff:chbouib stuff:set-chbouib!))
+
+
+(and (stuff? (%make-stuff 12))
+     (= 7 (stuff:chbouib (%make-stuff 7)))
+     (not (stuff? 12))
+     (not (false-if-exception (%make-stuff))))
diff --git a/testsuite/t-values.scm b/testsuite/t-values.scm
new file mode 100644
index 000000000..f4c0516a3
--- /dev/null
+++ b/testsuite/t-values.scm
@@ -0,0 +1,13 @@
+(list (call-with-values
+          (lambda () (values 1 2))
+        (lambda (x y) (cons x y)))
+      
+      ;; the start-stack forces a bounce through the interpreter
+      (call-with-values
+          (lambda () (start-stack 'foo (values 1 2)))
+        list)
+
+      (call-with-values
+          (lambda () (apply values '(1)))
+        list))
+
diff --git a/testsuite/the-bug.txt b/testsuite/the-bug.txt
new file mode 100644
index 000000000..95683f445
--- /dev/null
+++ b/testsuite/the-bug.txt
@@ -0,0 +1,95 @@
+-*- Outline -*-
+
+Once (system vm assemble) is compiled, things start to fail in
+unpredictable ways.
+
+* `compile-file' of non-closure-using programs works
+
+$ guile-disasm t-records.go > t-records.ref.asm
+...
+$ diff -uBb t-macros.*.asm
+$ diff -uBb t-records.*.asm
+$ diff -uBb t-global-bindings.*.asm
+
+* `compile-file' of closure-using programs fails
+
+ERROR: During compiling t-closure.scm:
+ERROR: VM: Wrong type to apply: #(<venv> ((parent . #(<venv> ((parent . #f) (nexts . 1) (closure? . #f)))) (nexts . 0) (closure? . #f))) [IP offset: 28]
+
+guile> (vm-debugger (the-vm))
+debug> bt
+#1 #<variable 30b12468 value: (#(<glil-asm> #(<glil-vars> ((nargs . 0) (nrest . 0) (nlocs . 0) (nexts . 1))) (#(<glil-const> 2) #(<glil-bind> ((x external 0))) #(<glil-external> set 0 0) #(<glil-asm> #(<glil-vars> ((nargs . 0) (nrest . 0) (nlocs . 1) (nexts . 0))) (#(<glil-module> ref #f +) #(<glil-const> 1) #(<glil-external> ref 1 0) #(<glil-call> call 2) #(<glil-source> (2 . 15)) #(<glil-bind> ((x++ local 0))) #(<glil-local> set 0) #(<glil-local> ref 0) #(<glil-external> set 1 0) #(<glil-local> ref 0) #(<glil-call> return 0) #(<glil-unbind>))) #(<glil-call> return 0) #(<glil-unbind>))) #<directory (guile-user) 100742d0> ())>
+#2 (#<program 30ae74b8> #(<glil-vars> ...) (#(<glil-const> ...) #(<glil-bind> ...) ...))   
+#3 (#<program 30af7090>)
+#4 (#<program 30af94c0> #(<glil-vars> ...) (#(<glil-module> ...) #(<glil-const> ...) ...)) 
+#5 (#<program 30b00108>)
+#6 (#<program 30b02590> ref ...)
+#7 (_l 1 #(<venv> ...))
+guile> (vm-debugger (the-vm))
+debug> stack
+(#t closure? #(<venv> ((parent . #(<venv> ((parent . #f) (nexts . 1) (closure? . #f)))) (nexts . 0) (closure? . #f))) #<procedure #f (struct name val)> #<primitive-generic map> #<primitive-generic map> #<program 30998470>)
+
+* Compiling anything "by hand" fails
+
+** Example 1:  the read/compile/run loop
+
+guile> (set! %load-path (cons "/home/ludo/src/guile-vm/module" %load-path))
+guile> (use-modules (system vm assemble)(system vm core)(system repl repl))
+guile> (start-repl 'scheme)
+Guile Scheme interpreter 0.5 on Guile 1.7.2
+Copyright (C) 2001 Free Software Foundation, Inc.
+
+Enter `,help' for help.
+scheme@guile-user> (use-modules (ice-9 match)
+	     (system base syntax)
+	     (system vm assemble))
+
+(define (%preprocess x e)
+  (match x
+    (($ <glil-asm> vars body)
+     (let* ((venv (<venv> :parent e :nexts (slot vars 'nexts) :closure? #f))
+	    (body (map (lambda (x) (preprocess x venv)) body)))
+       (<vm-asm> :venv venv :glil x :body body)))
+    (($ <glil-external> op depth index)
+     (do ((d depth (1- d))
+	  (e e (slot e 'parent)))
+	 ((= d 0))
+       (set! (slot e 'closure?) #t))
+     x)
+    (else x)))
+
+scheme@guile-user> preprocess
+#<procedure preprocess (x e)>
+scheme@guile-user> (getpid)
+470
+scheme@guile-user> (set! preprocess %preprocess)
+scheme@guile-user> preprocess
+ERROR: VM: Unbound variable: #<variable 30a0d5e0 value: #<undefined>>
+scheme@guile-user> getpid
+ERROR: VM: Unbound variable: #<variable 30a0d5e0 value: #<undefined>>
+scheme@guile-user>
+
+
+** Example 2:  the test suite (which also reads/compiles/runs)
+
+All the closure-using tests fail.
+
+ludo@lully:~/src/guile-vm/testsuite $ make check
+../src/guile-vm -L ../module            \
+            -l run-vm-tests.scm -e run-vm-tests \
+            t-global-bindings.scm t-closure.scm t-closure2.scm t-closure3.scm t-do-loop.scm t-macros.scm t-proc-with-setter.scm t-values.scm t-records.scm t-match.scm
+
+running `t-global-bindings.scm'...  reading...  compiling...  running...  ok
+running `t-closure.scm'...  reading...  compiling...  [vm-error/(vm-run VM: Wrong type to apply: ~S [IP offset: ~a] (#(<venv> ((parent . #(<venv> ((parent . #f) (nexts . 1) (closure? . #f)))) (nexts . 0) (closure? . #f))) 28))] FAILED
+running `t-closure2.scm'...  reading...  compiling...  [vm-error/(vm-run VM: Wrong type to apply: ~S [IP offset: ~a] (#(<venv> ((parent . #(<venv> ((parent . #(<venv> ((parent . #f) (nexts . 0) (closure? . #f)))) (nexts . 1) (closure? . #f)))) (nexts . 0) (closure? . #f))) 28))] FAILED
+running `t-closure3.scm'...  reading...  compiling...  [vm-error/(vm-run VM: Wrong ype to apply: ~S [IP offset: ~a] (#(<venv> ((parent . #(<venv> ((parent . #(<venv> ((parent . #f) (nexts . 0) (closure? . #f)))) (nexts . 1) (closure? . #f)))) (nexts . 0) (closure? . #f))) 28))] FAILED
+running `t-do-loop.scm'...  reading...  compiling...  [vm-error/(vm-run VM: Wrong type to apply: ~S [IP offset: ~a] (#(<venv> ((parent . #(<venv> ((parent . #f) (nexts . 1) (closure? . #f)))) (nexts . 0) (closure? . #f))) 28))] FAILED
+running `t-macros.scm'...  reading...  compiling...  running...  ok
+running `t-proc-with-setter.scm'...  reading...  compiling...  running...  ok
+running `t-values.scm'...  reading...  compiling...  running...  ok
+running `t-records.scm'...  reading...  compiling...  running...  ok
+running `t-match.scm'...  reading...  compiling...  running...  ok
+
+4 tests failed out of 10
+make: *** [check] Error 4
+